!****************************************************************************
! PREPRO.BAS    Assembler Preprocessor
!
!       Eliminates "lengthy" labels and symbols from a version 2.0 .M68
!       file so that the file may be assembled with older versions of an
!       assembler.
!
! by DAVE HEYLIGER - AMUS Staff         08-29-86
!
! NOTE: WILL NOT REPLACE TWO-WORDED SYMBOLS SEPARATED BY A SPACE. YOU MUST
!       CREATE ALL MULTIPLE WORDED SYMBOLS LIKE "THE.LONG.SYMBOL" - NOT
!       "THE LONG SYMBOL".
!
!                  NOT GUARANTEED FOR ALL FILES - WORKS 99%
!             (no danger of file distruction if it doesn't work)
!
!                 HEAVY COMMENTS TO MAKE DEGUBBING A SNAP
!***************************************************************************

MAP1    labels(100),S,32                ! array of lengthy labels
MAP1    l'pointer,F                     ! pointer into label array
MAP1    consts(100),S,32                ! similar....
MAP1    c'pointer,F
MAP1    vars(100),S,32
MAP1    v'pointer,F
MAP1    dat(100),S,32
MAP1    d'pointer,F
MAP1    macro(100),S,32
MAP1    m'pointer,F
MAP1    file'in,S,10                    ! input file name (assumes .M68)
MAP1    file'out,S,10                   ! converted output file (.M68)
MAP1    long,S,130                      ! input line
MAP1    temp'name,S,32                  ! name of string needing replacement
MAP1    i,F                             ! various counters...
MAP1    j,F
MAP1    k,F
MAP1    s,F
MAP1    m,F
MAP1    x,F
MAP1    colon'loc,F                     ! location of string needing replace.
MAP1    i'val,S,3                       ! portion of replacement string
MAP1    r'string,S,6                    ! replacement string
MAP1    r'string'length,F               ! length of longest replacement string
MAP1    file'lines,F                    ! number of lines in .M68 file
MAP1    search'string,S,32              ! string needing replacement
MAP1    blanks,s,40,"                                        "


START:
! Initialize, set up screen, etc....
!------------------------------------
       ? TAB(-1,0)
       ? TAB(2,3)"============================================================================"
       ? TAB(3,3)"| Assembly Preprocessor - removes long labels from a .M68 source code file |"
       ? TAB(4,3)"|                         to allow older version assemblers to function.   |"
       ? TAB(5,3)"============================================================================"
       ? TAB(8,20);:INPUT LINE "Enter file to be preprocessed: ",file'in
       ? TAB(9,20);:INPUT LINE "Enter new name for above file: ",file'out
       file'in = UCS(file'in)
       IF RIGHT$(file'in,4) <> ".M68" THEN file'in = file'in + ".M68"
       ? TAB(-1,29);TAB(4,8)"searching";
       OPEN #1,file'in,INPUT
       l'pointer = c'pointer = v'pointer = d'pointer = m'pointer = k = 1
       x = 10
       file'lines = 0
       r'string'length = 0


NEXT'LINE:
! Read in a line, "fancy" screen work
!
! Variables:    file'lines       = total lines in source file
!               long             = line of source code
!               k,x              = counters for screen output
!------------------------------------------------------------
       INPUT LINE #1,long
       file'lines = file'lines + 1
       k = k + 1
       IF x = k THEN ? TAB(4,8)"         ";
       IF k > 20 THEN k = 0 : x = 10 : ? TAB(4,8)"searching";
       IF EOF(1) THEN GOTO OUT'STRINGS

DATA'DEFINE:
! Searching for the following examples:
!       DEFINE {macro name "a"}={macro name "b"}        type code [1]
!       ESC=33                                          type code [2]
! Bypassing the following examples:
!       source line     ; blah blah = blah blah         type code [3]
!       MOV     #'=,D1                                  type code [4]
!
! Variables:    long            = source code line
!               m               = location of search string "="
!               colon'loc       = location of a ":" in source line
!               temp'name       = long label, var, const, or macro
!               r'string'length = length of longest temp'name
!               c'pointer       = constant array pointer value
!               consts          = array of lengthy constants found
!-------------------------------------------------------------------------
       IF INSTR(1,long,"DEFINE") <> 0 &
          THEN IF INSTR(1,long,"=") = 0 THEN GOTO MACROS               ![1]
       m = INSTR(1,long,"=")                                           ![1,2]
       IF m = 0 THEN GOTO OFDEF
       IF INSTR(1,long,";") = 0 THEN GOTO L8                           ![3]
       IF INSTR(1,long,"=") >= INSTR(1,long,";") THEN GOTO OFDEF       ![3]
L8:     IF INSTR(1,long,",") = 0 THEN GOTO L9                           ![4]
       IF INSTR(1,long,",") < INSTR(1,long,"=") THEN GOTO OFDEF        ![4]
L9:     colon'loc = m
       CALL GET'NAME
       IF LEN(temp'name) <= 6 THEN GOTO NEXT'LINE
       IF LEN(temp'name) > r'string'length &
          THEN r'string'length = LEN(temp'name)
L10:    c'pointer = c'pointer + 1
       consts(c'pointer) = temp'name
       GOTO NEXT'LINE

OFDEF:
! Searching for the following examples:
!       .OFDEF {variable name}                          type code [5]
! Bypassing the following examples:
!       source line     ;get the .OFDEF junk            type code [6]
!
! Variables:    long            = source code line
!               temp'name       = long label, var, const, or macro
!               m               = location of search string
!---------------------------------------------------------------------------
       m = INSTR(1,long,".OFDEF")                                      ![5]
       IF m = 0 THEN GOTO FIND'MARK
       IF INSTR(1,long,";") <> 0 &
         THEN IF INSTR(1,long,".OFDEF") >= INSTR(1,long,";") &
            THEN GOTO NEXT'LINE                                        ![6]
       m = m + 7
       IF long[m;1] = " " THEN m = m + 1
       IF long[m;1] = CHR(9) THEN m = m + 1
       temp'name = long[m;1]
L6:     m = m + 1
       IF long[m;1] = "," THEN GOTO L5
       IF long[m;1] = "=" THEN GOTO L5
       temp'name = temp'name + long[m;1]
       GOTO L6

FIND'MARK:
! Searching for the following:
!       LABEL:
! Bypassing the followng:
!       ; semi-colon at line position 1
!
! Variables:    long            = source code line
!----------------------------------------------------------------------

       FOR i = 1 TO LEN(long)
         IF long[i;1] = ":" THEN GOTO DECIPHER
         IF long[i;1] = ";" THEN GOTO NEXT'LINE
         NEXT i
         GOTO NEXT'LINE

DECIPHER:
! Searching for the following
!       LABEL:  RAD50
!       LABEL:  ASCII
!       LABEL:  BLKB (BLKW or BLKL)
!       LABEL:  BYTE
!
! Variables:    long            = source code line
!               colon'loc       = location of a ":" in source line
!               temp'name       = long label, var, const, or macro
!               r'string'length = length of longest temp'name
!               l'pointer       = label array pointer value
!               labels          = array of lengthy labels found
!------------------------------------------------------------------------
       IF INSTR(1,LEFT$(long,i-1)," ") <> 0 THEN GOTO NEXT'LINE
       IF INSTR(1,LEFT$(long,i-1),CHR(9)) <> 0 THEN GOTO NEXT'LINE
       IF i = LEN(long) THEN colon'loc = i : GOTO L1   !(MUST be a label)
       CALL WHITE'SPACE
       IF long[i;3] = "ASC" THEN GOTO FOUND'CONST
       IF long[i;3] = "RAD" THEN GOTO FOUND'CONST
       IF long[i;3] = "BYT" THEN GOTO FOUND'CONST
       IF long[i;3] = "BLK" THEN GOTO FOUND'VAR
L1:     CALL GET'NAME
       IF LEN(temp'name) <= 6 THEN GOTO NEXT'LINE
       IF LEN(temp'name) > r'string'length &
          THEN r'string'length = LEN(temp'name)
       l'pointer = l'pointer + 1
       labels(l'pointer) = temp'name
       GOTO NEXT'LINE

FOUND'CONST:
! DECIPHER figured it was a constant, so store the name if "lengthy"
!
! Variables:    temp'name       = long label, var, const, or macro
!               r'string'length = length of longest temp'name
!               c'pointer       = constant array pointer value
!               consts          = array of lengthy constants found
!-------------------------------------------------------------------
       CALL GET'NAME
       IF LEN(temp'name) <= 6 THEN GOTO NEXT'LINE
       IF LEN(temp'name) > r'string'length &
          THEN r'string'length = LEN(temp'name)
       c'pointer = c'pointer + 1
       consts(c'pointer) = temp'name
       GOTO NEXT'LINE

FOUND'VAR:
! DECIPHER figured it was a variable, so store the name if "lengthy"
!
! Variables:    temp'name       = long label, var, const, or macro
!               r'string'length = length of longest temp'name
!               v'pointer       = variable array pointer value
!               vars            = array of lengthy variables found
!-------------------------------------------------------------------
       CALL GET'NAME
L5:     IF LEN(temp'name) <= 6 THEN GOTO NEXT'LINE
       IF LEN(temp'name) > r'string'length &
          THEN r'string'length = LEN(temp'name)
       v'pointer = v'pointer + 1
       vars(v'pointer) = temp'name
       GOTO NEXT'LINE

WHITE'SPACE:
! Get rid of tabs and " "'s after the LABEL:
!
! Variables:    long            = source code line
!               colon'loc       = location of a ":" in source line
!               i               = cursor position variable
!--------------------------------------------------------------------
       colon'loc = i
LOOP1:  i = i+1
       IF i = LEN(long) THEN RETURN
       IF long[i;1] = CHR(9) THEN GOTO LOOP1
       IF long[i;1] = CHR(32) THEN GOTO LOOP1
       RETURN

MACROS:
! Found a MACRO definition, so get the name & store if "lengthy"
!
! Variables:    long            = source code line
!               i               = cursor position variable
!               temp'name       = long label, var, const, or macro
!               r'string'length = length of longest temp'name
!               m'pointer       = macro array pointer value
!               macro           = array of lengthy macros found
!---------------------------------------------------------------
       temp'name = ""
       i = INSTR(1,long,"DEFINE")
       i = i + 6
       CALL WHITE'SPACE
L11:    temp'name = temp'name + long[i;1]
       i = i + 1
       IF long[i;1] <> CHR(9) &
          THEN IF long[i;1] <> CHR(32) &
             THEN IF i <= LEN(long) THEN GOTO L11
       IF LEN(temp'name) <= 6 THEN GOTO NEXT'LINE
       IF LEN(temp'name) > r'string'length &
          THEN r'string'length = LEN(temp'name)
       m'pointer = m'pointer + 1
       macro(m'pointer) = temp'name
       GOTO NEXT'LINE


GET'NAME:
! Retrieves the name of the string found
!
! Variables:    long            = source code line
!               i,j             = cursor position variables
!               colon'loc       = location of a ":" in source line
!               temp'name       = long label, var, const, or macro
!---------------------------------------
       i = colon'loc
       j = i-1
LOOP2:
       IF long[j;1] = CHR(9) &
          THEN IF j <> 1 THEN i= j : j = j-1 : GOTO LOOP2 &
                         ELSE temp'name = long[j+1,i-1] : RETURN
       IF long[j;1] = " " THEN temp'name = long[j+1,i-1] : RETURN
       IF j = 1 THEN temp'name = long[j,i-1] : RETURN
       j = j-1
       GOTO LOOP2


OUT'STRINGS:
!
! Display "lengthy" culprets
!
! Variables:    x               = row counter variable for output to screen
!               i               = array index value for all arrays
!               labels, etc     = arrays of all strings found too long
!--------------------------------------------------------------------------
       ? TAB(4,8)"         "
       x = 0
       ? TAB(8,20)blanks;TAB(9,20)blanks
       ? TAB(6,1);"Oversized text:"
       ?
       FOR  i = 1 to 98
         x = x + 1
         IF labels(i) = "" THEN GOTO l2
         IF x > 28 THEN ? TAB(8+(x-30),50)labels(i) &
                   ELSE IF x > 14 THEN ? TAB(8+(x-15),25)labels(i) &
                                  ELSE ? labels(i)
         NEXT i
l2:
       FOR  i = 1 to 98
         x = x + 1
         IF consts(i) = "" THEN GOTO l3
         IF x > 28 THEN ? TAB(8+(x-30),50)consts(i) &
                   ELSE IF x > 14 THEN ? TAB(8+(x-15),25)consts(i) &
                                  ELSE ? consts(i)
         NEXT i
l3:
       FOR  i = 1 to 98
         x = x + 1
         IF vars(i) = "" THEN GOTO l4
         IF x > 28 THEN ? TAB(8+(x-30),50)var(i) &
                   ELSE IF x > 14 THEN ? TAB(8+(x-15),25)vars(i) &
                                  ELSE ? vars(i)
         NEXT i
l4:
       FOR  i = 1 to 98
         x = x + 1
         IF dat(i) = "" THEN GOTO l12
         IF x > 28 THEN ? TAB(8+(x-30),50)dat(i) &
                   ELSE IF x > 14 THEN ? TAB(8+(x-15),25)dat(i) &
                                  ELSE ? dat(i)
         NEXT i
l12:
       FOR  i = 1 to 98
         x = x + 1
         IF macro(i) = "" THEN GOTO l7
         IF x > 28 THEN ? TAB(8+(x-30),50)macro(i) &
                   ELSE IF x > 14 THEN ? TAB(8+(x-15),25)macro(i) &
                                  ELSE ? marco(i)
         NEXT i

l7:     ?

       CLOSE #1

SEARCH'REPLACE:
! Now begin searching each line of the file, replace strings when found
! TRICKY: must replace longest found strings first else errors!
!
! Variables:    long            = source code line
!               x               = dot counter for screen output effects
!               k               = string length (longest ---> shortest)
!               i               = index pointer into array of long strings
!               j               = line number in source file
!               s               = funny screen counter (you'll see...)
!               r'string'length = length of longest temp'name
!               l'pointer       = label array pointer value
!               labels          = array of lengthy labels found
!               search'string   = string needing replacement
!----------------------------------------------------------------------
       x = s = 0
       OPEN #1,file'in,INPUT
       OPEN #2,file'out,OUTPUT
       ?
       ? TAB(-1,28) TAB(21,1)"Replacing strings, creating new file..";

FOR j = 1 to file'lines
        x = x + 1 : s = s + 1
        INPUT LINE #1,long
        CALL NO'COMMENTS
        IF x = 40 THEN ? TAB(21,39)blanks; TAB(21,39);: x = 0 &
                  ELSE ? ".";
        IF s = 80 THEN ? TAB(4,6) "Sorry I'm so slow! ";
        IF s = 240 THEN ? TAB(4,6)"Write shorter code!";
        IF s = 400 THEN ? TAB(4,6)"I'm getting bored. ";
        IF s = 560 THEN ? TAB(4,6)"Go get some coffee.";
        IF s = 720 THEN ? TAB(4,6)"I'm burning out!!! ";
  FOR k = r'string'length TO 1 STEP -1
     r'string = "L00"
     FOR i = 1 to 98
       IF LEN(labels(i)) = k &
           THEN search'string = labels(i) : CALL STRING'MATCH
       IF labels(i) = "" THEN GOTO LL2
       NEXT i

LL2:  r'string = "C00"
     FOR i = 1 to 98
       IF LEN(consts(i)) = k &
           THEN search'string = consts(i) : CALL STRING'MATCH
       IF consts(i) = "" THEN GOTO LL3
       NEXT i

LL3:  r'string = "V00"
     FOR i = 1 to 98
       IF LEN(vars(i)) = k &
           THEN search'string = vars(i) : CALL STRING'MATCH
       IF vars(i) = "" THEN GOTO LL4
       NEXT i

LL4:  r'string = "D00"
     FOR i = 1 to 98
       IF LEN(dat(i)) = k &
           THEN search'string = dat(i) : CALL STRING'MATCH
       IF dat(i) = "" THEN GOTO LL5
       NEXT i

LL5:  r'string = "M00"
     FOR i = 1 to 98
       IF LEN(marco(i)) = k &
           THEN search'string = macro(i) : CALL STRING'MATCH
       IF macro(i) = "" THEN GOTO LL6
       NEXT i

LL6:
       NEXT k
       ? #2,long
     NEXT j
     GOTO HALT

STRING'MATCH:
! Replaces lengthy strings
!
! Variables:    long            = source code line
!               search'string   = lengthy string needing replacement
!------------------------------------------------------------------
           i'val = i
           IF long = search'string THEN long = search'string : RETURN
           m = INSTR(1,long,search'string)
           IF m = 0 THEN RETURN
           IF m = 1 THEN CALL FAR'LEFT : RETURN
           IF (LEFT$(long,m)+search'string) = long &
              THEN CALL FAR'RIGHT : RETURN
           mid'length = LEN(search'string)
           CALL MID
           RETURN


NO'COMMENTS:
! Strips off comment lines
!
! Variables:    long            = source code line
!               m               = position of ";"
!-------------------------------------------------
       m = INSTR(1,long,";")
       IF m < 2 THEN RETURN
       long = LEFT$(long,m-1)
       RETURN

FAR'LEFT:
! Swaps string if found at very far left
!
! Variables:    r'string        = 1/2 replacement string for lengthy string
!               long            = source code line
!               i'val           = second 1/2 of above
!               k               = length of original lengthy string
!---------------------------------------------------------------------------
long = r'string + i'val + MID$(long,k+1,LEN(long))
       RETURN

FAR'RIGHT:
! Swaps string if found at very far right
!
! Variables:    long            = source code line
!               m               = location of string needing replacement
!------------------------------------------------------------------------
       long = LEFT$(long,m) + r'string + i'val
       RETURN

MID:
!
! Swaps string if found in middle of line
!
! Variables:    long            = source code file line
!               m               = location of string needing replacement
!               r'string        = 1/2 of replacement string
!               i'val           = second half of above
!               mid'length      = length of string needing replacement
!-----------------------------------------------------------------------
       long = LEFT$(long,m-1) + r'string + i'val + MID$(long,m+mid'length,LEN(long))
       RETURN

HALT:   CLOSE #1
       CLOSE #2
       ? TAB(4,6)"    Whew!!          "
       ? TAB(22,1)"File conversion complete, "file'out" created!"
       END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.