$OPTIONS A * * ITEM LAST UPDATED:18:17:49 05 NOV 1985 * * Item last updated: 17:44:20 10 MAR 1987 MIS.SNA.PROG.ATM DEVEL 12 * * * **-- MACRO COMPILER Rel. 1.00 **-- 11/01/85 * * * **-- SETUP OUR VARIABLES * * $INSERT DEVEL>UTILITIES>BP>MCP.COMMON.INS.IBAS * $INSERT DEVEL>UTILITIES>BP>MCP.TOKENS.INS.IBAS * OTHERS = 1 TRUE = 1 FALSE = 0 RESOLVE = 'RESOLVE' FIRST.CHAR = '' JUMP.TABLE = '' BEGINNERS = '' ENDERS = '' BEGINNERS<1> = MIF BEGINNERS<2> = MREMOVE BEGINNERS<3> = MBEGIN.CASE BEGINNERS<4> = MFOR BEGINNERS<5> = MLOOP * ENDERS<1> = MEND ENDERS<2> = MEND ENDERS<3> = MEND.CASE ENDERS<4> = MNEXT ENDERS<5> = MREPEAT * NUMBER.OF.OPERANDS = COUNT(OPERANDS,@FM)+(OPERANDS#'') COMMAND.LINE = TRIM(@COMMAND) SOURCE.FILE.NAME = FIELD(COMMAND.LINE,' ',2) SYMBOLS.NAME = '' SYMBOLS.TYPE = '' MAT SYMBOLS.DATA = 1 FOR I = 1 TO 200 SYMBOLS.USED = 1 NEXT I ON = 1 OFF = 0 VALID.CHARS = '' VALID.CHARS = VALID.CHARS : '.-$' FOR I = 48 TO 57 VALID.CHARS = VALID.CHARS : CHAR(I) NEXT I FOR I = 65 TO 90 VALID.CHARS = VALID.CHARS : CHAR(I) NEXT I FOR I = 97 TO 122 VALID.CHARS = VALID.CHARS : CHAR(I) NEXT I * **-- OPEN OUR FILES * FL = '' OPEN '','SYS.MACRO' TO SYS.MACRO.FILE ELSE FL = FL : 'SYS.MACRO ' OPEN '','USR.MACRO' TO USR.MACRO.FILE ELSE FL = FL : 'USR.MACRO ' OPEN '',SOURCE.FILE.NAME TO SOURCE.FILE ELSE FL = FL : SOURCE.FILE.NAME:' ' IF FL # '' THEN PRINT 'UNABLE TO TO OPEN THE FOLLOWING FILES...' PRINT '"':FL[1,LEN(FL)-1]:'"' STOP END PARMS = COUNT(COMMAND.LINE,' ')+(COMMAND.LINE # '') PRINT 'F.H.P. Software Development (MIS)' PRINT 'Macro Compiler Rel. 1.00 11/01/85' PRINT RECORD.NAMES = '' PRINTER.SWITCH = FALSE WRITE.SWITCH = TRUE IF PARMS > 2 THEN FOR I = 3 TO PARMS PARM = FIELD(COMMAND.LINE,' ',I) IF PARM[1,1] = '-' THEN BEGIN CASE CASE PARM = '-LPTR' PRINTER.SWITCH = TRUE CASE PARM = '-FORM' FORM.NAME = FIELD(COMMAND.LINE,' ',I+1) EXECUTE 'SETPTR ,,,,,,BRIEF,NFMT,BANNER M.C.P.,FORM ':FORM.NAME I = I + 1 CASE PARM = '-NOWRITE' WRITE.SWITCH = FALSE CASE OTHERS PRINT 'Unrecognizable compile option "':PARM:'"' STOP END CASE END ELSE RECORD.NAMES<-1> = PARM END NEXT I END ELSE FOUND = FALSE LOOP TEST = TRUE READNEXT KEY ELSE TEST = FALSE UNTIL NOT(TEST) DO RECORD.NAMES<-1> = KEY FOUND = TRUE REPEAT IF NOT(FOUND) THEN PRINT 'ENTER RECORD ID :':; INPUT ANS IF ANS = '' THEN STOP RECORD.NAMES = ANS END END NUMBER.OF.RECORDS = COUNT(RECORD.NAMES,@FM)+(RECORD.NAMES#'') IF PRINTER.SWITCH THEN PRINTER ON END FOR RECORD.COUNT = 1 TO NUMBER.OF.RECORDS KEY = RECORD.NAMES ABORT = '' SYMBOLS.NAME = '' SYMBOLS.TYPE = '' IF KEY[5] = '.IMAC' THEN PRINT 'Unable to compile "':KEY:'"....' PRINT '".IMAC" implies a compiled macro' PRINT OK.FLAG = FALSE END ELSE MACRO.FOUND = TRUE OK.FLAG = TRUE READ MACRO.RECORD FROM SOURCE.FILE, KEY ELSE FOUND = 0 IF NOT(MACRO.FOUND) THEN PRINT 'Unable to read "':KEY:'" from file' OK.FLAG = FALSE END ELSE IF TRIM(MACRO.RECORD<1>) # '&MACRO' THEN PRINT '"':KEY:'" is not a macro' OK.FLAG = FALSE END ELSE PRINT 'Compiling ':SOURCE.FILE.NAME:' ':KEY GOSUB COMPILE IF OK.FLAG AND WRITE.SWITCH THEN CONVERT @FM TO @VM IN SYMBOLS.NAME CONVERT @FM TO @VM IN SYMBOLS.TYPE MACRO.RECORD = SYMBOLS.NAME MACRO.RECORD = SYMBOLS.TYPE WRITE MACRO.RECORD ON SOURCE.FILE, KEY:'.IMAC' END PRINT END END END IF OK.FLAG THEN PRINT 'Compilation completed.' END ELSE PRINT 'Compilation aborted.' END NEXT RECORD.COUNT IF PRINTER.SWITCH THEN PRINTER OFF PRINTER CLOSE END STOP * **-- ROUTINE TO COMPILE * COMPILE: * **-- FIRST TOKENIZE EVERYTHING IN THE MACRO RECORD * LAST.MACRO.LINE = COUNT(MACRO.RECORD,@FM)+(MACRO.RECORD#'') FOR MACRO.LINE = 1 TO LAST.MACRO.LINE LINE = MACRO.RECORD RETURN.LINE = LINE GOSUB TOKENIZE MACRO.RECORD = RETURN.LINE IF ABORT # '' THEN GOSUB MACRO.FAILED PRINT '#': NEXT MACRO.LINE PRINT * **-- ADD JUMP TO TABLE AT THE END OF LINES * FOR MACRO.LINE = 1 TO LAST.MACRO.LINE PRINT '*': MACRO.STATEMENT = MACRO.RECORD FIRST.CHAR = MACRO.STATEMENT[1,1] IF MACRO.LINE = LAST.MACRO.LINE AND FIRST.CHAR # MMEND THEN ABORT = '&MEND not found in macro.' GOSUB MACRO.FAILED END IF MACRO.LINE # LAST.MACRO.LINE AND FIRST.CHAR = MMEND THEN ABORT = '&MEND encountered before the end of the macro.' GOSUB MACRO.FAILED END BEGIN CASE CASE MACRO.LINE = 2 COUNT.PRCNT = COUNT(MACRO.STATEMENT,'%') IF COUNT.PRCNT/2 # INT(COUNT.PRCNT/2) THEN ABORT = 'Uneven number of "%" found in the prototype statement.' GOSUB MACRO.FAILED END CASE FIRST.CHAR = MIF OR FIRST.CHAR = MREMOVE IF INDEX(MACRO.STATEMENT,MTHEN,1) THEN MACRO.STATEMENT<1,2,1> = MACRO.LINE MACRO.STATEMENT<1,2,2> = 1 MACRO.STATEMENT<1,2,3> = MEND FIND = MEND : @VM : MELSE GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,3,1> = CONTINUE.LINE MACRO.STATEMENT<1,3,2> = (MELSE = MACRO.RECORD[1,1]) MACRO.STATEMENT<1,3,3> = MEND END ELSE IF TRIMF(MACRO.RECORD)[1,1] = MTHEN THEN MACRO.STATEMENT<1,2,1> = MACRO.LINE + 1 JUMP.TABLE<-1> = MACRO.LINE + 1 MACRO.STATEMENT<1,2,2> = 1 MACRO.STATEMENT<1,2,3> = MEND FIND = MEND : @VM : MELSE GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,3,1> = CONTINUE.LINE MACRO.STATEMENT<1,3,2> = (MELSE = MACRO.RECORD[1,1]) MACRO.STATEMENT<1,3,3> = MEND END ELSE IF INDEX(MACRO.STATEMENT,MELSE,1) THEN MACRO.STATEMENT<1,3,1> = MACRO.LINE MACRO.STATEMENT<1,3,2> = 1 MACRO.STATEMENT<1,3,3> = MEND FIND = MEND GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,2,1> = CONTINUE.LINE MACRO.STATEMENT<1,2,2> = 0 MACRO.STATEMENT<1,2,3> = '' END ELSE IF TRIMF(MACRO.RECORD) = MELSE THEN MACRO.STATEMENT<1,3,1> = MACRO.LINE + 1 JUMP.TABLE<-1> = MACRO.LINE+1 MACRO.STATEMENT<1,3,2> = 1 MACRO.STATEMENT<1,3,3> = MEND FIND = MEND GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,2,1> = CONTINUE.LINE MACRO.STATEMENT<1,2,2> = 0 MACRO.STATEMENT<1,2,3> = '' END ELSE ABORT = 'No "&THEN" or "&ELSE" for conditional statement "':FIRST.CHAR:'"' GOSUB MACRO.FAILED END END END END CASE FIRST.CHAR = MTHEN OR FIRST.CHAR = MEND OR FIRST.CHAR = MNEXT OR FIRST.CHAR = MREPEAT LOCATE MACRO.LINE IN JUMP.TABLE<1> SETTING ABC ELSE ABORT = 'Misplaced "':FIRST.CHAR:'"' GOSUB MACRO.FAILED END CASE FIRST.CHAR = MGLOBAL CONVERT ' ' TO '' IN MACRO.STATEMENT TEMP.LINE = MACRO.STATEMENT[2,999999] LINE.LNGH = LEN(TEMP.LINE) FLOP.FLIP = OFF LOOP UNTIL TEMP.LINE = '' DO CHR = TEMP.LINE[1,1] BEGIN CASE CASE CHR = VARIABLE.TOKEN TEMP.LINE = TEMP.LINE[5,LEN(TEMP.LINE)] FLOP.FLIP = ON CASE CHR = COMMA TEMP.LINE = TEMP.LINE[2,LEN(TEMP.LINE)] FLOP.FLIP = OFF CASE OTHERS IF FLOP.FLIP = ON THEN ABORT<-1> = 'Found "':CHR:'", expected a COMMA' END ELSE ABORT<-1> = 'Found "':CHR:'", expected a VARIABLE SYMBOL' END TEMP.LINE = TEMP.LINE[2,LEN(TEMP.LINE)] END CASE REPEAT IF ABORT # '' THEN GOSUB MACRO.FAILED CASE FIRST.CHAR = MCASE IF INDEX(MACRO.STATEMENT,COMMA,1) OR INDEX(MACRO.STATEMENT,SEPERATOR,1) THEN ABORT<-1> = 'Invalid usage of a comma or semicolon' GOSUB MACRO.FAILED END FIND = MEND.CASE GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,4,1> = CONTINUE.LINE FIND = MEND.CASE : @VM : MCASE GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,3,1> = CONTINUE.LINE - 1 MACRO.STATEMENT<1,3,2> = 0 MACRO.STATEMENT<1,3,3> = MCASE MACRO.STATEMENT<1,2,1> = MACRO.LINE MACRO.STATEMENT<1,2,2> = 1 MACRO.STATEMENT<1,2,3> = MCASE CASE FIRST.CHAR = MELSE LOCATE MACRO.LINE IN JUMP.TABLE<1> SETTING ABC ELSE ABORT = 'Misplaced "':FIRST.CHAR:'"' GOSUB MACRO.FAILED END FIND = MEND GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,2,1> = CONTINUE.LINE MACRO.STATEMENT<1,2,2> = 0 MACRO.STATEMENT<1,2,3> = MEND CASE FIRST.CHAR = MFOR FIND = MNEXT GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,3,1> = CONTINUE.LINE MACRO.STATEMENT<1,3,2> = 0 MACRO.STATEMENT<1,3,3> = MNEXT CASE FIRST.CHAR = MLOOP FIND = MREPEAT GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED FIND = MWHILE : @VM : MUNTIL GOSUB CONTINUE.ON IF ABORT # '' THEN ABORT = 'No "&UNTIL" or "&WHILE" inside of a "&LOOP - &REPEAT" structure' GOSUB MACRO.FAILED END CASE FIRST.CHAR = MBEGIN.CASE FIND = MEND.CASE GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED CASE FIRST.CHAR = MWHILE FIND = MNEXT : @VM : MREPEAT GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,3,1> = CONTINUE.LINE CASE FIRST.CHAR = MUNTIL FIND = MNEXT : @VM : MREPEAT GOSUB CONTINUE.ON IF ABORT # '' THEN GOSUB MACRO.FAILED MACRO.STATEMENT<1,2,1> = CONTINUE.LINE CASE FIRST.CHAR = MREM MACRO.STATEMENT<1,1> = MREM END CASE MACRO.RECORD = MACRO.STATEMENT NEXT MACRO.LINE RETURN * ************************ * TOKENIZATION ROUTINE * ************************ * * TOKENIZE: * * **-- THIS SUBROUTINE TOKENIZES A LINE * * * **-- THE VARIABLE "LINE" CONTAINS THE MACRO LINE THAT IS TO BE **-- TOKENIZED. THE VARIABLE "RETURN.LINE" CONTAINS THE TOKENIZED **-- LINE. * * * **-- THE VARIABLE "OPERANDS" CONTAINS THE VECTOR OF VALID OPERANDS. **-- THE VARIALBE "OPERAND.TOKENS" CONTAINS THE VECTOR OF TOKENS **-- THAT CORRESPOND TO THE OPERAND IN THE "OPERANDS" VARIABLE. **-- THE VARIABLE "OPERAND.ARGUMENTS" CONTAINS INFORMATION ABOUT **-- HOW MANY, AND OF WHAT TYPE OF ARGUMENTS EACH DIRECTIVE MAY HAVE. **-- THE STRUCTURE OF THE "OPERAND.ARUGMENTS" VARIABLE IS AS FOLLOWS... * * "NUMBER.OF.ARGUMENTS}TYPE.OF.ARGUMENT|TYPE.OF.ARGUMENT..." * **-- THUS FOR EACH ARGUMENT SPECIFIED BY "NUMBER.OF.ARGUMENTS" THERE **-- WILL BE A CORRESPONDING "TYPE.OF.ARGUMENT" IN SUB-VALUES. * **-- THE VALID "TYPE.OF.ARGUMENTS" CURRENTLY SUPPORTED ARE AS FOLLOWS... * **-- 0 - EXPRESSION (THIS MAY BE ANYTHING, AND WILL BE **-- RESOLVED AT EXECUTION TIME BY THE **-- SUBROUTINE "RESOLVE".) **-- 1 - VARIABLE SYMBOL **-- "XX" - LITERAL EXPRESSION WHERE "XX" IS A LITERAL EXPRESSION **-- OF ANY LENGTH. * **-- IF "NUMBER OF ARGUMENTS" IS "0" THEN ANY NUMBER INFORMATION THAT **-- FOLLOWS THAT EXPRESSION WILL BE IGNORED AT EXECUTION TIME. * * **-- BEGIN TOKENIZATION OF THE LINE * TEMP.LINE = TRIMF(LINE) **-- IS THIS A MACRO DIRECTIVE LINE???, IF NOT THEN RETURN AND DONT TOKENIZE IF TEMP.LINE[1,1] = '&' OR MACRO.LINE = 2 THEN **-- FIRST GO THROUGH AND TOKENIZE DIRECTIVES... FOR I = 1 TO NUMBER.OF.OPERANDS DIRECTIVE = OPERANDS DIRECTIVE.LEN = LEN(DIRECTIVE) IF DIRECTIVE # '' THEN LOOP XX = INDEX(TEMP.LINE,DIRECTIVE,1) UNTIL (XX EQ 0) DO TEMP.LINE = TEMP.LINE[1,XX-1]:OPERAND.TOKENS:TEMP.LINE[XX+DIRECTIVE.LEN,99999] ;* REPEAT END NEXT I END **-- NOW SEE IF WE TOKENIZED SOMETHING INSIDE QUOTES, IF SO UNTOKENIZE LINE.LEN = LEN(TEMP.LINE) QUOTE.FLG = '' WORK = '' VALIDATE.VARIABLE.FLAG = OFF VALIDATE.VARIABLE = '' FRST.CHR = TEMP.LINE[1,1] IF FRST.CHR # MREM THEN FOR I = LINE.LEN TO 1 STEP -1 CHR = TEMP.LINE[I,1] IF CHR # ' ' THEN BEGIN CASE CASE CHR = '%' AND NOT(VALIDATE.VARIABLE.FLAG) VALIDATE.VARIABLE.FLAG = ON CASE CHR = '%' AND VALIDATE.VARIABLE.FLAG VALIDATE.VARIABLE.FLAG = OFF EXT.VARIABLE = VALIDATE.VARIABLE VALIDATE.VARIABLE = '' IF EXT.VARIABLE EQ '' THEN VARIABLE = '%' END ELSE GOSUB SETUP.VARIABLE END CHR = VARIABLE END CASE IF QUOTE.FLG # '' AND SEQ(CHR) > 127 THEN LOCATE CHR IN OPERAND.TOKENS<1> SETTING FOUND ELSE FOUND = 0 IF FOUND THEN CHR = OPERANDS END END IF CHR = "'" OR CHR = '"' THEN BEGIN CASE CASE CHR = '"' AND QUOTE.FLG = '' QUOTE.FLG = '"' IF VALIDATE.VARIABLE.FLAG THEN ABORT = 'Invalid variable symbol' RETURN END CASE CHR = '"' AND QUOTE.FLG = '"' QUOTE.FLG = '' VALIDATE.VARIABLE.FLAG = OFF VALIDATE.VARIABLE = '' CASE CHR = "'" AND QUOTE.FLG = '' QUOTE.FLG = "'" IF VALIDATE.VARIABLE.FLAG THEN ABORT = 'Invalid variable symbol' RETURN END CASE CHR = "'" AND QUOTE.FLG = "'" QUOTE.FLG = '' VALIDATE.VARIABLE.FLAG = OFF VALIDATE.VARIABLE = '' END CASE END END ELSE IF QUOTE.FLG THEN VALIDATE.VARIABLE.FLAG = OFF VALIDATE.VARIABLE = '' END ELSE IF VALIDATE.VARIABLE.FLAG THEN IF FRST.CHR = MREM OR SEQ(FRST.CHR) < 127 THEN CHR = CHR : VALIDATE.VARIABLE: '%' VALIDATE.VARIABLE.FLAG = 0 VALIDATE.VARIABLE = '' END ELSE ABORT = 'Invalid variable symbol' END END END END IF VALIDATE.VARIABLE.FLAG AND CHR # '%' THEN IF NOT(INDEX(VALID.CHARS,CHR,1)) THEN ABORT = 'Invalid variable symbol' RETURN END VALIDATE.VARIABLE = CHR : VALIDATE.VARIABLE END IF NOT(VALIDATE.VARIABLE.FLAG) THEN WORK = CHR : WORK END NEXT I END ELSE WORK = TEMP.LINE END RETURN.LINE = WORK IF MACRO.LINE > 2 THEN IF SEQ(RETURN.LINE[1,1]) > 127 AND SEQ(RETURN.LINE[1,1]) < FIRST.STARTING.TOKEN AND RETURN.LINE[1,1] # VARIABLE.TOKEN THEN ABORT<-1> = '"':RETURN.LINE[1,1]:'" is invalid at the beginning of a macro statement' END END **-- GET RIDE OF THROUGH AWAY TOKEN CONVERT THROW.AWAY.CHAR TO '' IN RETURN.LINE IF RETURN.LINE[1,1] = '&' THEN ABORT = 'Unrecognizable directive "':FIELD(RETURN.LINE,' ',1):'"' END * **-- SUBROUTINE TO CHECK THE SYNTAX OF A LINE * ITEM LAST UPDATED:15:41:10 28 OCT 1985 * * * * **-- THE VARIABLE OPA CONTAINS THE INFORMATION OF EACH ELEMENT IN **-- THE STATEMENT. THE IDEA HERE IS, THAT EACH VALUE POSITION **-- CONTAINS THE INFORMATION FOR EACH ITEM IN A STATEMENT. **-- THE FORMAT FOR A VALUE POSITION IS AS FOLLOWS... **-- **-- a b c d **-- **-- WHERE... **-- **-- IS A SUB-VALUE MARK **-- a IS THE MATCH PATTERN FOR THE ITEM BEING CHECKED **-- b IS A LOGICAL 1 OR 0, INDICATING REQUIRED OR NOT **-- c IS THE NEXT TOKEN **-- d OPTIONAL NEXT TOKEN (SUCH AS IN THE CASES OF THEN/ELSE) **-- FOUND = 1 LOCATE WORK[1,1] IN OPT<1> SETTING XX ELSE FOUND = 0 IF NOT(FOUND) THEN RETURN CHECKER = OPA VAL.COUNT = COUNT(CHECKER,@VM)+(CHECKER # '') CHECK.LINE = TRIMF(RETURN.LINE[2,9999]) * **-- CHECK TO SEE IF ALL REQUIRED TOKENS ARE PRESENT * FOR VAL = 1 TO VAL.COUNT STEP 2 ITEM = CHECKER<1,VAL,1> VAL.FOUND = INDEX(WORK,ITEM,1) IF NOT(VAL.FOUND) AND CHECKER<1,VAL,4> # '' THEN ITEM = CHECKER<1,VAL,4> VAL.FOUND = INDEX(WORK,ITEM,1) END IF NOT(VAL.FOUND) AND CHECKER<1,VAL,2> THEN ABORT<-1> = '"':ITEM:'" expected but not found' RETURN END NEXT VAL * **-- CHECK ARGUMENTS FOR TOKENS * FOR VAL = 2 TO VAL.COUNT STEP 2 MATCHER = CHECKER<1,VAL,1> MANDITORY = CHECKER<1,VAL,2> FIELD.1 = CHECKER<1,VAL,3> ALT.FIELD.1 = CHECKER<1,VAL,4> CHK.INDX = INDEX(CHECK.LINE,FIELD.1,1) IF CHK.INDX = 0 AND ALT.FIELD.1 # '' THEN CHK.INDX = INDEX(CHECK.LINE,ALT.FIELD.1,1) END IF FIELD.1 = '' AND ALT.FIELD.1 = '' THEN CHK.INDX = 0 IF CHK.INDX THEN ITEM = CHECK.LINE[1,CHK.INDX-1] CHECK.LINE = CHECK.LINE[CHK.INDX+1,9999] END ELSE ITEM = CHECK.LINE IF (ITEM = '') AND INDEX(WORK,CHECKER<1,VAL-1,1>,1) THEN ABORT<-1> = 'Argument for "':CHECKER<1,VAL-1,1>:'" not found' RETURN END CHECK.LINE = '' END IF MANDITORY AND ITEM = '' THEN ABORT<-1> = 'Argument for "':CHECKER<1,VAL-1,1>:'" not found' RETURN END ITEM = TRIMF(TRIMB(ITEM)) IF NOT(ITEM MATCHES MATCHER) AND ITEM # '' THEN ABORT<-1> = 'Invalid Argument for "':CHECKER<1,VAL-1,1>:'"...' ABORT<-1> = '"':ITEM:'"' IF MATCHER[2,1] = VARIABLE.TOKEN THEN ABORT<-1> = 'Expected a variable' END RETURN END ITEM.LNGTH = LEN(ITEM) FOR ITEM.CNT = 1 TO ITEM.LNGTH IF SEQ(ITEM[ITEM.CNT,1]) >= FIRST.NON.STARTING.TOKEN THEN ABORT<-1> = 'Misplaced or incorrectly used keyword: "':ITEM[ITEM.CNT,1]:'"' ABORT<-1> = 'in "':ITEM:'"' END NEXT ITEM.CNT STRING.TO.RESOLVE = ITEM RESOLVED.STRING = '' CALL @RESOLVE(STRING.TO.RESOLVE, RESOLVED.STRING, ABORT) NEXT VAL RETURN * *************************** * DE-TOKENIZATION ROUTINE * *************************** * * DE.TOKENIZE:* * * * * **-- THIS ROUTINE IS USED TO DE-TOKENIZE A LINE SO THAT A TOKENIZED **-- MESSAGE CAN BE DISPLAYED TO THE USER. * * **-- THE VARIABLE "LINE" IS THE VARIABLE THAT IS TO BE DE-TOKENIZED. **-- THE VARIABLE "RETURN.LINE" IS THE VARIABLE THAT IS THAT LINE **-- IN ITS' DE-TOKENIZED STATE(WHICH THIS ROUTINE RETURNS). * LINE.LNGTH = LEN(LINE) WORK = '' FOR I = LINE.LNGTH TO 1 STEP -1 CHR = LINE[I,1] IF SEQ(CHR) > 127 AND SEQ(CHR) < 252 THEN LOCATE CHR IN OPERAND.TOKENS<1> SETTING FOUND ELSE FOUND = 0 IF FOUND THEN CHR = OPERANDS END END WORK = CHR : WORK NEXT I COUNTX = COUNT(WORK,VARIABLE.TOKEN) FOR I = 1 TO COUNTX INDX = INDEX(WORK,VARIABLE.TOKEN,1) VAR = WORK[INDX+1,3] VAR.NAME = SYMBOLS.NAME WORK = WORK[1,INDX-1] : "%" : VAR.NAME : "%" : WORK[INDX + 4,99999] NEXT I RETURN.LINE = WORK RETURN CONTINUE.ON:* * * * **-- THIS ROUTINE SEARCHES AHEAD TO FIND THEN NEXT EXECUTABLE **-- DIRECTIVE WHILE PROCESSING A CONDITIONAL STATEMENT. * **-- THE VARIABLE "FIND" CONTAINS THE DIRECTIVE TO LOCATE, THAT **-- DETERMINES THE END OF THE CONDITIONAL STRUCTURE. "FIND" MAY **-- BE MULTIVALUED TO CONTIAN MULTIPLE ENDING DIRECTIVES, SUCH **-- AS "&ELSE}&END". * **-- THIS ROUTINE IS USEFULL TO STATEMENTS SUCH AS "IF-THEN-ELSE". * **-- THE VARIABLE "CONTINUE.LINE" IS THE LINE WHERE EXECUTION SHOULD **-- CONTINUE. * * **-- The idea here is to go line by line detecting if a level of **-- conditional statements has occured or not, and whether that level **-- was up or down. If we are at our level of conditional statement **-- and our variable "FIND" is found then we have found the end of **-- the conditional construct. * MACRO.LINE = MACRO.LINE + 1 CNDTL.LEVEL = 1 CONTINUE.LINE = 0 FOR CNDTL.CNT = MACRO.LINE TO LAST.MACRO.LINE XX = FIELD(TRIMF(MACRO.RECORD),' ',1) IF XX MATCHES FIND AND CNDTL.LEVEL = 1 THEN CONTINUE.LINE = CNDTL.CNT CNDTL.CNT = LAST.MACRO.LINE END ELSE LOCATE XX IN BEGINNERS<1> SETTING FOUND ELSE FOUND = 0 IF FOUND THEN CNDTL.LEVEL = CNDTL.LEVEL + 1 END ELSE LOCATE XX IN ENDERS<1> SETTING FOUND ELSE FOUND = 0 IF FOUND THEN CNDTL.LEVEL = CNDTL.LEVEL - 1 END END END NEXT CNDTL.CNT IF CNDTL.LEVEL # 1 OR CONTINUE.LINE = 0 THEN ABORT = 'Ending directive to conditional "':FIRST.CHAR:'" not found - "':FIND:'"' END MACRO.LINE = MACRO.LINE - 1 IF CONTINUE.LINE # 0 THEN JUMP.TABLE<-1> = CONTINUE.LINE RETURN * **-- MACRO FAILED ROUTINE * MACRO.FAILED: PRINT PRINT PRINT 'Fatal compile error found in macro "':KEY:'" line ':MACRO.LINE LINE = MACRO.RECORD GOSUB DE.TOKENIZE PRINT ('0000':MACRO.LINE)'R#4' : ' ': RETURN.LINE PRINT LINE = ABORT GOSUB DE.TOKENIZE COUNT.FTLS = COUNT(RETURN.LINE,@FM)+(RETURN.LINE # '') FOR FTLS = 1 TO COUNT.FTLS PRINT RETURN.LINE NEXT FTLS OK.FLAG = 0 ABORT = '' RETURN ************************* * ROUTINE TO SET UP * * EXTERNAL VARIABLE * * NAMES * ************************* * **-- THIS ROUTINE IS PASSED THE VARIABLE "EXT.NAME" AND RETURNS **-- THE INTERNAL VARIABLE NAME IN "VARIABLE". * SETUP.VARIABLE: IF NOT(EXT.VARIABLE[1,1] MATCHES "1A") THEN ABORT = 'Invalid variable symbol "':EXT.VARIABLE:'"' RETURN END TYPE = '' IF TEMP.LINE[1,1] = MGLOBAL THEN TYPE = 'G' IF TYPE = '' THEN TYPE = 'L' LOCATE EXT.VARIABLE IN SYMBOLS.NAME<1> SETTING FOUND ELSE FOUND = COUNT(SYMBOLS.NAME,@FM)+(SYMBOLS.NAME # '') + 1 SYMBOLS.NAME = EXT.VARIABLE SYMBOLS.TYPE = TYPE END IF TYPE = 'G' AND SYMBOLS.TYPE = 'L' THEN ABORT = 'Attempt to make the local variable "':EXT.VARIABLE:'" into a global variable' RETURN END VARIABLE = VARIABLE.TOKEN : (("000":FOUND)'R#3') RETURN END