Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Line number stripper and jump label maker

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Line number stripper and jump label maker

    Code:
    'Minimal testing, but does 3 things with older DOS based GW, maybe also QB source for those using PB/CC.
    '
    '1. Encapsulates all code in PBMAIN function, with a preceding DEFINT A-Z statement.
    '2. Examines code for GOTO line number and THEN line number statements, converting them to jumpXXXX, where XXXX is the line number, and also converting those line numbers to the matching labels.
    '3. Eliminates all remaining line numbers.
    '
    'In so doing the program lets you choose the file to process using a standard Windows file dialog. The original source is renamed with a prefix "old".
    '
    'Obviously this is just one step in the conversion of some programs to PB/CC code.  However, it will help to move along the way.  Contributed to the public domain, change, enhance and test as you will.
    '
    
    #COMPILE EXE "strip_line_nums.exe"
    #DIM ALL
    #INCLUDE "ComDlg32.inc"
    '-----------------------------------------------------------------------------
    ' some token equates for BASIC keywords we want to look at
    $THEN = "THEN"
    $GOTO = "GOTO"
    $SGOTO = " GOTO"
    '-----------------------------------------------------------------------------
    'equates used to name abd thus retain old line number jumps
    $Jump = "Jump"
    $Colon = ":"
    '-----------------------------------------------------------------------------
    'since the following function appears before FUNCTION PBMAIN, where it is used,
    'we do not need an explicit DECLARE FUNCION .... entry, but the DECLARE statement
    'is preferred for more complex situations.
    '
    FUNCTION FileSelect()AS STRING
        LOCAL selectedfile$     'to setup the call to the OpenFileDialog and store it's return
    getafile:                   'label for second chance to spec a file
        selectedfile$="*.bas"   'preliminary spec, list all ,bas files in a directory
        'call the standard Windows file dialog, per function included in ComDlg32
        IF OpenFileDialog(0, "Select .BAS Source file", selectedfile$,CURDIR$, _
                             "BASIC Source File (*.bas)|*.bas|All Files|*.*", _
                             "bas", %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY OR _
                             %OFN_LONGNAMES OR %OFN_EXPLORER) THEN
            IF selectedfile$ = "" THEN          'no file selected .... really
                ? "You must select the BASIC source file to be processed"   'msg to user
                SLEEP 250                       'time for a quick read of msg ... (Smile)
                GOTO getafile                   'jump to repeat point for another try
            ELSE
                FUNCTION = selectedfile$        'we have a winner ... assign and
                EXIT FUNCTION                   'quick exit to bail out of the function
            END IF
        ELSE  'user cancels
            FUNCTION=""                         'nothing to returned, user canceled
        END IF                                  'function will bail out anyway,no EXIT needed
    END FUNCTION
    '-----------------------------------------------------------------------------
    FUNCTION PBMAIN () AS LONG              'ALWAYS required, or it's equivalent WINMAIN
        LOCAL a$,temp$,lnum$                'some basic use string vars
        LOCAL foo&,numrec&,i&,j&,k&,x&      'some basic use numeric vars
        a$ = FileSelect()                   'obtain the drive-path-filename spec to use.
        IF a$ = "" THEN EXIT FUNCTION       'no file, bail out!
        foo& = FREEFILE                     'get a file handle
        OPEN a$ FOR INPUT AS foo&           'open the source file
        FILESCAN #foo&, RECORDS TO numrec&  'find out how many lines are in the source
        DIM src(1 TO numrec&) AS STRING     'line numbered source will be loaded here
        LINE INPUT #foo&,src()              'load the whole GW or similar source to array
        CLOSE #foo&                         'leave no open files when done with them!
        '
        'now setup some arrays so we can handle GOTO labeling later, these will track
        'the src() array line by line based on the original line number
        DIM srclbls(1 TO numrec&) AS LONG   'we'll mark for lines that need labels
        DIM srcnums(1 TO numrec&) AS STRING 'we'll use for the old typed in line numbers
        'added, that srcnums() will lwt us retrieve the old number when we change any
        'GOTO's with labels, and actually insert the labels in the program later in
        'the form JumpXXXX:  where XXXX is the old line number.  This will be a shade
        'better for reference than just the old line number as a label.
        FOR i& = 1 TO numrec&       'parse and log any line numbers to srcnums() for ref.
            temp$= LTRIM$(src(i&))  'remove any leading spaces for now
            RESET lnum$             'set lnum$ = ""
            IF ASC(temp$,1) > 47 AND  ASC(temp$,1) < 59 THEN   'Is this a number?
                'yes it is a number so let's parse it out, character at a time
                FOR j& = 1 TO LEN(temp$)   'but only until number is completed
                    IF ASC(temp$,j&) > 47 AND  ASC(temp$,j&) < 59 THEN
                        'build a substring, slower but surer for older listings
                        lnum$ = lnum$ + MID$(temp$,j&,1) 'building the tru old line number
                    ELSE                        'now ready to bail out
                        srcnums(i&)=lnum$       'put into the srcnums()array
                        EXIT FOR                'bail out of for loop
                    END IF
                NEXT j&                         'loop the for
            END IF
        NEXT i&
        '
        'Need to do a pre-emptory check to fix any THEN #### constructs so the program
        'can properly handle them as THEN GOTO, the longer form to help catch all jumps
        'we will assume that any THEN XXXX is the last statement, and no ELSE exists
        'in this form, but code could be changed in line with the GOTO loop if there
        'are mixed statements on a line or multiple colon separated statements
        FOR i& = 1 TO numrec&                  'process all the records again, but is fast
            temp$= TRIM$(UCASE$(src(i&)))      'return trimmed UCASE a source line copy
            IF INSTR(temp$,$THEN) THEN         'is there a THEN here?
                j& = INSTR(temp$,$THEN)        'ok, get the position of then
                j& = j& + 4                    'add 4 to skip it
                IF j& > LEN(temp$) THEN EXIT IF  'THEN was last statment on the line
                FOR k&= j& TO LEN(temp$)         'ok, lets see if it is only a line number
                    IF ASC(temp$,k&)= 32 THEN ITERATE FOR  'skip spaces
                    IF ASC(temp$,k&) > 47 AND  ASC(temp$,k&) < 59 THEN   'a raw number found!
                        temp$ =  STRINSERT$(temp$,$SGOTO, k&-1)          'insert a GOTO
                        src(i&) = temp$                                  'change the src() line
                        EXIT FOR                    'any other problems will need a manual fix
                    ELSE
                        EXIT FOR        'not a lone number, was likely THEN END, THEN GOTO, ...
                    END IF
                NEXT k&                 'loop once more
            END IF
        NEXT i&
        '
        'now we'll check UCASE'd source lines for GOTO #### clauses and change them to the
        'new form GOTO JumpXXXX, as well as mark the appropriate srclbls() entry so later
        'a label "JumpXXXX: can be inserted in the code
        FOR i& = 1 TO numrec&                   'process all the records again, but is fast enough
            temp$= UCASE$(src(i&))              'UCASE a source line copy
            IF INSTR(temp$,$GOTO) > 0 THEN      'we have a live GOTO so time to go to work
                j&=1                            'assign j& = 1 so first INSTR starts at position 1
                DO                              'we'll loop until contions are met later
                    j& = INSTR(j&,temp$,$GOTO)  'get the position of the first (or next) GOTO
                    IF j& = 0 THEN EXIT LOOP    'bail out if there are no more GOTO's in the line
                    j&=j&+4                     'otherwise skip past
                    RESET lnum$                 'set lnum$ = ""
                    FOR k&= j& TO LEN(temp$)+1  'start from J& and work towards end of the string + 1
                        'but the next test will overtly avoid trying to read beyond the end of the line
                        IF k& > LEN(temp$) AND lnum$ <> "" THEN  'handles GOTO XXXX at end of the line
                            ARRAY SCAN srcnums(),= lnum$,TO x&
                            IF x& <> 0 THEN srclbls(x&)= 1
                            j& = INSTR(j&,temp$,lnum$)
                            temp$ =  STRINSERT$(src(i&), $Jump, j&)  'insert "Jump"
                            src(i&) = temp$      'assign the srce with the corrected line
                            EXIT LOOP            'already past the end of the current line, so jump out
                        ELSEIF k& > LEN(temp$) THEN
                            EXIT LOOP            'already past the end of the current line, so jump out
                        END IF
                        IF k& > LEN(temp$) THEN EXIT FOR
                        IF ASC(temp$,k&)= 32 THEN ITERATE FOR
                        IF ASC(temp$,k&) > 47 AND  ASC(temp$,k&) < 59 THEN
                            'build a substring, slower but surer for older listings
                            lnum$ = lnum$ + MID$(temp$,k&,1)
                        ELSE   'found a midstring GOTO, not end of string type
                            IF lnum$ <> "" THEN
                                ARRAY SCAN srcnums(),= lnum$,TO x&
                                IF x& <> 0 THEN srclbls(x&)= 1
                                j& = INSTR(j&,temp$,lnum$)
                                temp$ =  STRINSERT$(src(i&), $Jump, j&)  'insert "Jump"
                                src(i&) = temp$      'keep things current
                                j& = j& + 4          'skip past the add-in "Jump"
                                j& = j& + LEN(lnum$) 'skip past the line number portion
                            ELSE                     'lnum$ is empty, = ""
                                IF k& = LEN(temp) THEN EXIT LOOP 'done with this line
                                j& = k&-1               'not done, set j& for next INSTR search
                            END IF
                            EXIT FOR
                        END IF
                    NEXT k&                         'loop again ...
                LOOP
            END IF
        NEXT i&
        '
        'now strip the line numbers from the src() and we will be ready to get towards the final write
        FOR i& = 1 TO numrec&                       'process all lines again
            temp$= LTRIM$(src(i&))                  'strip any leading spaces
            IF ASC(temp$,1) = 39 THEN ITERATE FOR   'skip because is a comment
            FOR j& = 1 TO LEN(temp$)                'begin line number check
                IF ASC(temp$,1) = 32 THEN ITERATE FOR                'skip because is a space
                IF ASC(temp$,j&) > 47 AND  ASC(temp$,j&) < 59 THEN ITERATE FOR  'skip numbers
                'we can bail out because a characte that is not a space or number exists
                IF j&= 1 THEN EXIT FOR      'nothing to do
                temp$=LTRIM$(MID$(temp$,j&))   'return the string from this point on
                src(i&)= temp$              'assign to the src() array line
                EXIT FOR                    'bail out
            NEXT j&
        NEXT i&
        '
        i& = 0     'reset the i& counter variable
        k& = 1     'reset the k& counter variable
        DO         'count the labels, if any, so array can be expanded
            ARRAY SCAN srclbls(k&),= 1, TO j&   'look for a marked line
            IF j& = 0 THEN EXIT LOOP            'bail out if none or no more
            k& = k& + j&                        'set the next begin point
            INCR i&                             'increment the counter
            IF k& > numrec& THEN EXIT LOOP      'do not go past the upper bound of the array
        LOOP
    '''uncomment the next few lines if you change the program and want to run without save
    '  ? numrec&                                'should be the number of source lines
    '  ? i&                                     'should not be 0 if there were GOTO XXXX lines
    '  ? "Press any key to continue"            'needed to remind us why halted
    '  WAITKEY$                                 'waiting, waiting, waiting
    '  EXIT FUNCTION                            'exit's without save
        IF i& > 0 THEN                          'we need a larger array for changes
            REDIM PRESERVE src(1 TO numrec&+i&) 'make src()) larger, preserving current contents
            j&=1                                'reset j& = 1
            FOR i& = 1 TO numrec&               'need to process all the records in srclbls
                IF srclbls(i&) = 1 THEN         'we have a line that wants to have a label inserted
                    temp$=$Jump+srcnums(i&)     'creates "JumpXXXX"
                    temp$=temp$+$Colon          'completes "JumpXXXX:"
                    ARRAY INSERT src(j&),temp$  'inserts, so existing lines move toward new UBOUND of src()
                    INCR j&                     'points to original source line for a tracking src index
                END IF
                 INCR j&                         'tracking with increments to i&
             NEXT i&
        END IF
    
        i& = INSTR(-1,a$,"\")                   'OpenFileDialog returned a full path filespec to be parsed
        temp$=LEFT$(a$,i&)+"old_"+MID$(a$,i&+1) 'create name to rename the original source
        NAME a$ AS temp$                        'renames original source
    
        'now process and write a final file  ... the easy part? ... (Smile)
        foo& = FREEFILE                    'get a free file handel, avoid using explicit number assignments
        OPEN a$ FOR OUTPUT AS foo&                 'open the file, print addded and changed source code
        PRINT #foo&, "DEFINT A-Z                   'added for variables declaration"
        PRINT #foo&, "FUNCTION PBMAIN()            'enclosed the code as the PBMAIN function"
        PRINT #foo&, src()
        PRINT #foo&, "END FUNCTION"
        CLOSE #foo&                        'close and exit ... happy debugging!
    END FUNCTION
    ------------------
    Rick Angell

    [This message has been edited by Richard Angell (edited September 03, 2005).]
    Rick Angell
Working...
X