'HEAD' LEXICAL PROCESSING C EDIT DATE 14JAN79 09:26 C SOURCE FILE LEXFTM.FS C AUTHOR A. J. HOWARD C CLUSTER 14 'OUTFILE' ADVANFTM.FR C C GET NEXT OPERAND-OPERATOR PAIR FROM INPUT STREAM C SUBROUTINE ADVAN EXTERNAL OLQOT INTEGER ENTNUM, SOPLST, SNMLST // EXTERNAL FUNCTIONS 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' SRCDFSFTM.IN, 'INCLUDE' OPERSAJH.IN, 'INCLUDE' STKDFA.IN, 'INCLUDE' STUFFAJH.IN, 'INCLUDE' NLNAMEFTM.IN, CALL CLRSTK (OPX) 'IF' (STUFFO .NE. 0) NEXTOP = STUFFO STUFFO = 0 NAMEX (OPX) = STUFFN RETURN 'ENDIF' CUROP = NEXTOP CFLAG = 0 CALL FNZS 'IF' (PSYMB .EQ. 0) CALL RDNAME (-1) // NAME, LOOK IT UP IN THE NAME LIST NAMEX (OPX) = SNMLST (DUMMY) 'ELSE' 'IF' (PSYMB .EQ. NINE) CALL RDNUM // NUMBER, CONVERT AND LOOK IT UP NAMEX (OPX) = ENTNUM (DUMMY) 'ELSE' 'IF' (PSYMB .EQ. QUOTE) C CALL OVLOD (OLQOT) CALL PQUOTE // PROCESS STRING TEXT 'ELSE' 'IF' (PSYMB .EQ. CONTRL) NEXTOP = CONTRL RETURN 'ENDIF' 'ENDIF' 'ENDIF' 'ENDIF' NEXTOP = PSYMB 'IF' (NEXTOP .EQ. GIZZY) CALL FNZS NAME (1) = 0 IF (PSYMB .NE. GIZZY) CALL RDNAME (-1) NEXTOP = SOPLST (DUMMY) 'ELSE' CALL CHEKCO (NEXTOP, J) 'ENDIF' RETURN END 'OUTFILE' CHEKCOFTM.FR C CHECK FOR ->, <=, >= OPERATORS AND REDEFINE FOR COMPILER SUBROUTINE CHEKCO (SYM, INDEX) 'INCLUDE' SRCDFSFTM.IN, 'INCLUDE' LOGOSAJH.IN, INTEGER SYM, INDEX, FIRST (3), SECOND (3), COMPOS (3) DATA FIRST /25, 21, 19/ // - < > INTERNAL DATA SECOND /62, 61, 61/ // > = = ASCII DATA COMPOS /23, 22, 20/ // -> <= >= INTERNAL 'DOLOOP' K = 1, 3 'IF' (SYM .EQ. FIRST (K) ^ .AND. SOURCE (INDEX) .EQ. SECOND (K) ) SYM = COMPOS (K) INDEX = INDEX + 1 'BREAK' 'ENDIF' 'END' RETURN END 'OUTFILE' FNZSFTM.FR C FINDS A NON-BLANK CHARACTER AND RETURNS COMPILER ID SUBROUTINE FNZS 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' SRCDFSFTM.IN, 'INCLUDE' SRCXDFFTM.IN, 'INCLUDE' SYMBOLFTM.IN, 'DO' 'IF' (J .GE. SRCEND) C END OF CURRENT LINE, PREPARE A NEW LINE C J = 1 CALL PSRENT 'IF' (CONTF .EQ. CONTRL) PSYMB = CONTRL 'BREAK' 'ENDIF' 'ENDIF' SYMBOL = SOURCE (J) J = J + 1 'IF' (SYMBOL .EQ. 32 .AND. NOTINQ) 'NEXT' 'ENDIF' 'IF' (SYMBOL .LT. 32 .OR. SYMBOL .GE. 97) 'IF' (SYMBOL .EQ. CONTRL) PSYMB = CONTRL // LEFT BY PEEK J = J - 1 'BREAK' 'ENDIF' C CHARACTER OUT OF TABLE LIMITS C CALL FAULTP (88) 'NEXT' 'ENDIF' C GET COMPILER ID FROM SYMBOL TABLE C PSYMB = SYMTBL (SYMBOL - 31) C CHECK FOR VALID DEFINITION IF NOT PROCESSING STRING DATA C 'WHILE' (PSYMB .LT. 0 .AND. NOTINQ) C PRINT "ILLEGAL SOURCE CHARACTER" MESSAGE C CALL FAULTP (88) 'END' C EXIT WITH VALID COMPILER ID IN PSYMB C RETURN END 'OUTFILE' RDNUMFTM.FR C SUBROUTINE RDNUM C C READS A NUMBER FROM THE INPUT STREAM; IF THERE IS C A LEADING ZERO, BASE IS HEX INSTEAD OF DECIMAL. C SUBROUTINE RDNUM INTEGER TS 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' OPERSAJH.IN, NUMBER = 0 'IF' (SYMBOL .NE. XZERO) 'DO' // DECIMAL CONVERT 'WHILE' (PSYMB .EQ. NINE) TS = SYMBOL - XZERO 'IF' ((NUMBER .EQ. 3276 .AND. TS .GE. 8) ^ .OR. NUMBER .GT. 3276) CALL FAULTP (86) 'ELSE' NUMBER = NUMBER*10 + TS 'ENDIF' CALL FNZS 'END' 'ELSE' 'DO' // HEXADECIMAL CONVERT 'IF' (PSYMB .NE. NINE) 'IF' (SYMBOL .LT. XA .OR. SYMBOL .GT. XF) 'BREAK' 'ENDIF' TS = SYMBOL - XA + 10 'ELSE' TS = SYMBOL - XZERO 'ENDIF' IF (IAND (NUMBER, -4096) .NE. 0) CALL FAULTP (86) NUMBER = IOR (ISHFT (NUMBER, 4), TS) CALL FNZS 'END' 'ENDIF' 'IF' (PSYMB .EQ. 0 .OR. PSYMB .GE. QUOTE) CALL FAULTP (26) CALL SCAN (COMMA, NINE, QUOTE) 'ENDIF' RETURN END 'OUTFILE' RDNAMEFTM.FR C C READS UP TO 16 ALPHANUMERIC CHARACTERS FROM THE INPUT C STREAM AND PLACES THEM IN ARRAY NAME, STARTING IN C BYTE 2. THE LENGTH OF THE NAME IS PLACED IN BYTE 1 C UPON NAME TERMINATION. C SUBROUTINE RDNAME (ACHAR) 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' SRCDFSFTM.IN, 'INCLUDE' NLISTCFTM.IN, 'INCLUDE' NLNAMEFTM.IN, 'INCLUDE' OPERSAJH.IN, INTEGER ACHAR NK = 1 NI = 0 PSYMB = 0 'DO' C NAME TERMINATED BY NON-ALPHANUMERIC CHARACTER 'WHILE' (PSYMB .LT. COMMA .OR. PSYMB .EQ. ACHAR) 'IF' (NI .LT. NSIZE) C STILL WITHIN NAME LIMIT, STORE CHARACTER NI = NI + 1 NK = NK + 1 CALL PCHAR (NAME, NK, SYMBOL) 'ENDIF' CALL FNZS 'END' C PUT NAME LENGTH IN CHARACTER POSITION 1 CALL PCHAR (NAME, 1, NI) NK = NK + 1 C PUT IN AN EXTRA BLANK FOR LAST WORD PADDING CALL PCHAR (NAME, NK, BLANK) C LEAVE (LENGTH IN WORDS) - 1 IN NK NK = (NI - 1)/2 'IF' (PSYMB .GE. QUOTE) C NOT A VALID TERMINATOR, "MISSING OPERATOR AFTER NAME" CALL FAULTP (20) CALL SCAN (RBRACE, NINE, RBRACE) 'ENDIF' RETURN END 'OUTFILE' PQUOTEFTM.FR N OVERLAY OLQOT C C BUILDS A QUOTE, THEN EITHER DEFINES IT IN THE NAME C LIST WITH A TEMPORARY NAME, OR, IF THE QUOTE IS C ONLY ONE CHARACTER LONG, DEFINES IT AS A NUMBER. C THIS ROUTINE INCLUDES BUILD QUOTE, GET QUOTE CHAR, C AND DEF QNAME. C SUBROUTINE PQUOTE 'INCLUDE' WFLAGSJHP.IN, 'INCLUDE' LOGOSAJH.IN, 'INCLUDE' OPERSAJH.IN, 'INCLUDE' NLISTCFTM.IN, 'INCLUDE' NLNAMEFTM.IN, 'INCLUDE' STKDFA.IN, 'INCLUDE' SRCXDFFTM.IN, 'INCLUDE' LCFUNCAJH.IN, INTEGER TS, QSYM, QLCI INTEGER SNMLST, INDNAM, NLOPS, ENTNUM LOGICAL NLTEST QVALUE = 1 QSYM = 0 SCOUNT = 0 NOTINQ = .FALSE. 'DO' CALL FNZS 'WHILE' (PSYMB .NE. QUOTE) 'IF' (PSYMB .EQ. LESS) C IMBEDDED CONSTANT NOTINQ = .TRUE. CALL FNZS 'IF' (PSYMB .EQ. 0) CALL RDNAME (-1) NLX = SNMLST (NAME) IF (.NOT. NLTEST (NLX, CBIT)) CALL FAULTP (11) SYMBOL = NLOPS (CVALUE, NLX) 'ELSE' CALL RDNUM SYMBOL = NUMBER 'ENDIF' 'IF' (PSYMB .NE. GTR) C CAN'T HAVE EXPRESSIONS CALL FAULTP (43) CALL SCAN (GTR, QUOTE - 1, QUOTE + 1) 'ENDIF' 'ENDIF' QSYM = IAND (SYMBOL, 255) C BUILD QUOTE 'IF' (QVALUE .GE. 0) C LONG QUOTE IF (PSYMB .EQ. QUOTE) GOTO 10 CALL PEEK IF (PEEKS .EQ. QUOTE) GOTO 10 QVALUE = -1 'IF' (LOGICF .NE. 0) QLCI = LCI CALL PCHAR (NAME, 1, 3) CALL PCHAR (NAME, 2, 34) // " NLX = INDNAM (QINDEX, DATALC, 0) CALL NLSET (NLX, STRBIT) 'ENDIF' 'ENDIF' CALL BLDBLK (QSYM, WF1) 10 NOTINQ = .FALSE. SCOUNT = SCOUNT + 1 'IF' (SCOUNT .GE. 216) CALL FAULTP (28) QMODE = 0 CALL SCAN (RBRACE, NINE, RBRACE) 'BREAK' 'ENDIF' 'END' 'IF' (QVALUE .LT. 0) 'IF' (LOGICF .NE. 0) CALL RBOTH (QLCI) 'ENDIF' 'ELSE' NUMBER = QSYM NLX = ENTNUM (DUMMY) 'ENDIF' NOTINQ = .TRUE. NAMEX (OPX) = NLX CALL FNZS 'IF' (PSYMB .LT. COMMA .OR. PSYMB .GE. QUOTE) CALL FAULTP (24) CALL SCAN (RBRACE, NINE, RBRACE) 'ENDIF' RETURN END