Directory of image this file is from
This file as a plain text file
TITLE LEX - PPL LEXICAL ANALYZER AND TRANSLATOR /EAT/20-SEP-72 HISEG SEARCH PPL ;LEX(T,PN) ;LEXICALLY ANALYZE THE ASCII TEXT IN TEXT BLOCK T, USING PRODUCTION ;RULES PN. LEXEMES WILL BE GENERATED UNLESS SYSTEM ;FLAG LEXCHK IS SET. RETURNS: ; (1) A LEXICAL ERROR WAS DETECTED ; (2) LINE OK. IF LEXCHK IS CLEAR, THE APPROPRIATE BUFFER CONTAINS ; THE TRANSLATED LINE, AS FOLLOWS: ;PN=0: TRANSLATE A NORMAL EXECUTABLE LINE, RESULT IN LXMBUF. ON RETURN, ; R CONTAINS THE NUMBER OF LEXEMES. ALL ID'S ARE CONSIDERED TO ; BE GLOBAL AT THIS TIME. LABELS ARE RECOGNIZED AND APPENDED ; TO L0BUF AND LBLBUF. ;PN=1: TRANSLATE A FUNCTION HEADER. L0BUF IS INITIALIZED AND PACKED ; WITH COUNTER WORD, PROCID, FORMALS, AND LOCALS. ;PN=2: TRANSLATE A DDEF. LXMBUF IS PACKED AS FOLLOWS: ; FIRST WORD: LH - DDEF BLOCK TYPE (B.ALT,B.SEQ,B.VSEQ,B.STRUCT) ; RH - INTERNAL NAME OF DDEF ; 2ND THRU NTH: CONTENTS OF BLOCK. (N IS RETURNED IN R) ;****** AC'S 1-14 ARE SAVED AND RESTORED BY LEX ********
;LOCALLY USED AC'S T== AC1 ;ARG - ASCII TEXT TO BE TRANSLATED PN== AC2 ;ARG - PRODUCTION RULES PR== AC3 ;TEMP T1== AC4 ;AC'S 3-7 MAY BE CLOBBERED BY ACTION ROUTINES ;AC'S 5-7 ARE NOT CLOBBERED BY THE PRODUCTION INTERPRETER ;AC'S COMMON TO ALL LEXICAL ANALYSIS ROUTINES BP== AC10 ;BYTE POINTER TO CURRENT TEXT CHARACTER C== AC11 ;CURRENT ASCII CHARACTER LXP== AC12 ;NUMBER OF LEXEMES TRANSLATED CT== AC13 ;CHARACTER TYPE BITS LXPC== AC14 ;REL ADDR OF CURRENT PRODUCTION
;DEFINE SYMBOLS USED AS ARGS TO A0 ACTION. ;THESE SPECIFY THE TYPE OF LEXEME TO BE RECOGNIZED. DEFINE LXDEFS < LXDEF (ID) ;;IDENTIFIER OR SPECIAL SYNTAX TOKEN LXDEF (STRING) ;;STRING CONSTANT LXDEF (CHAR) ;;CHARACTER CONSTANT LXDEF (OP) ;;OPERATOR OR SPECIAL SYNTAX TOKEN LXDEF (RELOC) ;;RELOCATABLE INTEGER CONSTANT LXDEF (INT) ;;INTEGER CONSTANT LXDEF (OCTINT) ;;OCTAL INTEGER CONSTANT LXDEF (REAL) ;;REAL OR DBL CONSTANT LXDEF (DEMAND) ;;DEMAND SYMBOL LEXEME LXDEF (SDEMAND) ;;STRING DEMAND (?") LXDEF (LBL) ;;LABEL (NOT A LEXEME REALLY) LXDEF (PROCID) ;;PROCEDURE IDENTIFIER LXDEF (FORML) ;;FORMAL PARAMETER LXDEF (LCL) ;;LOCAL VARIABLE LXDEF (DEFNAM) ;;NAME OF DATA DEFINITION LXDEF (SEQLB) ;;LOWER BOUND OF SEQUENCE DEFINITION LXDEF (SEQUB) ;;UPPER BOUND OF SEQUENCE DEFINITION LXDEF (ELTYPE) ;;ELEMENT TYPE NAME OF SEQ OR VSEQ LXDEF (SELNAM) ;;SELECTOR NAME OF A STRUCT LXDEF (TYPNAM) ;;ELEMENT TYPE NAME OF A STRUCT LXDEF (ALTNAM) ;;TYPE NAME IN AN ALTERNATE DEFINITION LXDEF (RPAD) ;;RIGHT PAD - ENDS EVERY STATEMENT > ;ASSIGN SEQUENTIAL INTEGER VALUES TO THE NAMES SEQIND (LX,%%,0)
SUBTTL LEXICAL PRODUCTION INTERPRETER LEX: PUSHJ P,SAVALL ;STACK ALL THE AC'S MOVEM P,LEXPDP ;SAVE P FOR ERROR RECOVERY LEX0: MOVSI BP,(POINT 7,(T1),35) MOVEM BP,THSLXP SETZB C,CT ;INITIALIZE ASCII UNPACKING HRRZ LXPC,PRULES(PN) ;GET START ADDRESS OF DESIRED PRODUCTIONS HLLZ LXP,PRULES(PN) ;GET LIMIT ON # OF LEXEMES SETZM LEXSAV ;INDICATE NO PROTECTED LEXEMES AT FIRST JUMPN PN,.+3 ;TRANSLATING EXECUTABLE LINE? CALL ALOCLX ;YES, THROW AWAY FIRST CELL IN LXMBUF SETZM LXMBUF ; SO THAT INDEXING STARTS AT 1 IDPB T,PZSAV ;PROTECT THE INPUT TEXT FROM GARBAGE COLLECTION NXTPRD: MOVE PR,PRODTB(LXPC) ;GET A PRODUCTION LDB T1,[POINT 12,PR,29] ;GET TEST FIELD TLNE PR,40 ;IS IT A CHAR. OR A SET OF CLASS BITS JRST TYPTST CAME C,T1 ;A CHAR. MAKE THE TEST AOJA LXPC,NXTPRD ;NOT A MATCH, DO NEXT PRODUCTION JRST DOPROD ;MATCHED, DO THE ACTION TYPTST: JUMPE T1,DOPROD ;CLASS BITS: ZERO=DO UNCONDITIONALLY LSH T1,6 ;NONZERO: PREPARE TO TEST TRNN CT,(T1) ;CHAR BELONG TO ONE OF THE TEST CLASSES? AOJA LXPC,NXTPRD ;NO, CONTINUE TO NEXT PRODUCTION DOPROD: LDB T1,[POINT 5,PR,17] ;OK, GET ACTION ARG ANDI PR,77 ;MAKE IT A HALFWORD ACTION INDEX ROT PR,-1 JUMPGE PR,.+2 SKIPA PR,ACDSPT(PR) ;PR[RH] _ CORRECT DISPATCH ADDRESS MOVS PR,ACDSPT(PR) JRST (PR) ;GO DO THE ACTION; RETURN TO NXTPR0 NXTPR0: HRRZ T1,(T) ;RETRIEVE ABS. TEXT POINTER SKIPGE PR,PRODTB(LXPC) ;GET CURRENT PRODUCTION AGAIN PUSHJ P,SCAN ;BIT 0: SCAN FORWARD TO NEXT CHAR. TLNE PR,200000 PUSHJ P,UNSCAN ;BIT 1: SCAN BACKWARDS 1 CHARACTER CAIE C,3 ;PERCENT SIGN SOMETIMES STORED AS ^C JRST .+3 MOVEI C,"%" PUSHJ P,GETCT LDB LXPC,[POINT 9,PR,11] ;GET PRODUCTION JUMP ADDRESS JRST NXTPRD ;INITIALIZATION CONSTANTS PRULES: XWD -LXMBSZ,INITLZ-PRODTB ;0 - NORMAL EXECUTABLE LINE XWD -L0BSIZ,FNHD-PRODTB ;1 - FUNCTION HEADER XWD -LXMBSZ,DDEF0-PRODTB ;2 - DATA DEFINITION
REPEAT 0,< ******* PRODUCTION WORD FORMAT ******** THE PRODUCTION FORM: LABEL TEST ! ACTION(ARG) * NEXTLBL IS REPRESENTED BY THE 'PROD' MACRO AS FOLLOWS: LABEL: PROD( TEST , ACTION(ARG) ,*, NXTLBL ) THE FIELDS MAY BE AS FOLLOWS: TEST FIELD: EITHER A CHARACTER (NUMERIC CODE OR QUOTED CHARACTER), OR A GROUP OF CLASSES OR'ED TOGETHER IN ANGLE BRACKETS. EXAMPLES: "A" 47 <LETTR!DIGIT> ACTION: THE NAME OF SOME ACTION DEFINED BY THE ACTDEF MACRO. EXAMPLE: ACTION A0 HAS BEEN ASSOCIATED BY THE ACTDEF MACRO WITH AN INTEGER PRDA0 AND AN ACTION ROUTINE LABELLED ACTA0. ARG: AN INTEGER LESS THAN 2^5. SCAN FIELD: EITHER BLANK (NO SCAN), * (SCAN FORWARD), OR _ (SCAN REVERSE). NXTLBL: THE LABEL OF THE NEXT PRODUCTION TO BE EXECUTED. THE INTERNAL FORMAT IS ONE WORD: BIT 0: SCAN WILL TAKE PLACE 1: REVERSE SCAN WILL TAKE PLACE 2-11: ADDRESS OF NEXT PRODUCTION RELATIVE TO START OF TABLE 12: 0 - BITS 18-29 CONTAIN AN ASCII CHARACTER. 1 - BITS 18-29 CONTAIN CLASS BITS, EQUIVALENT TO THE LEXICAL CHARACTERISTICS OF BITS 18-29 IN REGISTER CT. 13-17: NUMERIC ARGUMENT TO ACTION, IF ANY. 18-29: CHARACTER OR CLASS BITS. 30-35: ACTION NUMBER. > IF1,< DEFINE PROD(A,B,C,D) <Z>> IF2,< DEFINE PROD(A,B,C,D) < PR1== A IFE PR1-<@>,< PR1== 1B12> IFN PR1&777600,<PR1== PR1!1B12> IFE PR1&1B12,< PR1== PR1_6> PR2== 0 IFNB <B>,< PR2== Z PRD'B> IFIDN <C><*>,< PR2== PR2!1B0> IFIDN <C><_>,< PR2== PR2!1B1> IFNB <D>,< PR1== PR1+<D-PRODTB>B11> EXP PR1+PR2 >>
SUBTTL PRODUCTIONS FOR TRANSLATING A NORMAL EXECUTABLE LINE PRODTB: INITLZ: PROD( @ , ,*,SEP ) SEP: PROD( <SEPRTR> , ,*,SEP ) PROD( <LETTR> ,A2 , ,LBL0 ) ENTER0: PROD( <LETTR> ,A2 , ,ID0 ) PROD( <DIGIT> ,A3 , ,DECNUM ) PROD( 42 ,A4 ,*,STRNG ) PROD( "'" , ,*,CHR0 ) PROD( "." , ,*,PER ) PROD( "$" , ,*,ENTER1 ) PROD( 0 ,A0(%%RPAD) , , ) PROD( "?" , ,*,DEMA0 ) PROD( <SPTYP> , ,*,SP0 ) PROD( <PUNCT> ,A9 , ,OP0 ) PROD( @ , ,*,ENTER0 ) ENTER1: PROD( <LETTR> ,A1 , ,ID0 ) PROD( <DIGIT> ,A3 , ,OCTNUM ) PROD( @ ,A9 ,_,OP1 ) ID0: PROD( "." , ,*,ID2 ) ID1: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,ID0 ) PROD( @ ,A0(%%ID) , ,ENTER0 ) ID2: PROD( <LETTR!DIGIT> , ,_,ID1 ) PROD( @ ,A0(%%ID) ,_,ENTER0 ) STRNG: PROD( 42 , ,*,S2 ) PROD( 0 ,ERROR(0) , , ) PROD( 12 ,A7 ,*,STRNG ) PROD( @ ,A6 ,*,STRNG ) S2: PROD( 42 ,A6 ,*,STRNG ) PROD( @ ,A0(%%STRING) , ,ENTER0 ) PER: PROD( "." , ,*,PER1 ) SP0: PROD( <DIGIT> , ,_,SP2 ) SP1: PROD( @ ,A9 ,_,OP0 ) SP2: PROD( "." ,A3 , ,DECNUM ) PROD( "%" ,A3 ,*,RELOC0 ) PER1: PROD( "." ,A0(%%RPAD) , , ) PROD( @ , ,_,SP1 ) OP0: PROD( "." , ,*,C0 ) OP05: PROD( <SPTYP> , ,*,OP2 ) PROD( "$" , ,*,OP5 ) OP1: PROD( <PUNCT> ,A8 ,*,OP0 ) PROD( @ ,A0(%%OP) , ,ENTER0 ) OP2: PROD( <DIGIT> ,A0(%%OP) ,_,SP2 ) PROD( @ , ,_,OP1 ) OP5: PROD( <LETTR!DIGIT> ,A0(%%OP) , ,ENTER1 ) PROD( @ , ,_,OP1 ) C0: PROD( "." , ,*,C2 ) C1: PROD( @ , ,_,OP05 ) C2: PROD( "." ,A0(%%OP) , ,PER1 ) PROD( @ , ,_,C1 )
LBL0: PROD( "." , ,*,LBL2 ) LBL1: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,LBL0 ) LBL3: PROD( <SEPRTR> , ,*,LBL3 ) PROD( ":" ,A0(%%LBL) ,*,SEP ) PROD( @ ,A0(%%ID) , ,ENTER0 ) LBL2: PROD( <LETTR!DIGIT> , ,_,LBL1 ) PROD( @ ,A0(%%ID) ,_,ENTER0 ) RELOC0: PROD( <DIGIT> ,A10(^D10) ,*,RELOC0 ) PROD( @ ,A0(%%RELOC) , ,ENTER0 ) OCTNUM: PROD( <ODIGIT> ,A10(^D8) ,*,OCTNUM ) PROD( <DIGIT> ,ERROR(1) , , ) PROD( @ ,A0(%%OCTINT) , ,ENTER0 ) DECNUM: PROD( "." ,A11 ,*,DECFRC ) PROD( <DIGIT> ,A10(^D10) ,*,DECNUM ) PROD( <LETDE> , , ,EXP00 ) PROD( @ ,A0(%%INT) , ,ENTER0 ) DECFRC: PROD( <DIGIT> ,A10(^D10) ,*,DECFRC ) EXP00: PROD( "E" ,A11 ,*,EXP0 ) PROD( "D" ,A13 ,*,EXP0 ) PROD( 145 ,A11 ,*,EXP0 ) PROD( 144 ,A13 ,*,EXP0 ) PROD( @ ,A0(%%REAL) , ,ENTER0 ) EXP0: PROD( <PLSMIN> ,A14 ,*,E0 ) E0: PROD( <DIGIT> ,A12 , ,E1 ) PROD( @ ,ERROR(2) , , ) E1: PROD( <DIGIT> ,A15 ,*,E1 ) PROD( @ ,A0(%%REAL) , ,ENTER0 ) CHR0: PROD( 0 ,ERROR(27) , , ) PROD( @ ,A0(%%CHAR) ,*,ENTER0 ) DEMA0: PROD( 42 ,A0(%%SDEMA) ,*,ENTER0 ) PROD( @ ,A0(%%DEMAND) , ,ENTER0 )
SUBTTL PRODUCTIONS FOR RECOGNIZING A FUNCTION HEADER FNHD: PROD( @ , ,*,FNHD1 ) FNHD1: PROD( <SEPRTR> , ,*,FNHD1 ) PROD( "$" , ,*,FNHDR1 ) PROD( @ ,ERROR(13) , , ) FNHDR1: PROD( <SEPRTR> , ,*,FNHDR1 ) PROD( <LETTR> ,A2 , ,FID0 ) PROD( @ ,ERROR(13) , , ) FID0: PROD( "." , ,*,FID2 ) FID1: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,FID0 ) PROD( @ ,A0(%%PROCID) , ,FNHDR2 ) FID2: PROD( <LETTR!DIGIT> , ,_,FID1 ) CC0: PROD( @ ,A0(%%PROCID) , ,CC1 ) CC1: PROD( "." , ,*,CC2 ) CC2: PROD( "." ,EXIT , , ) PROD( @ ,ERROR(13) , , ) FNHDR2: PROD( <SEPRTR> , ,*,FNHDR2 ) PROD( 0 ,EXIT , , ) PROD( "." , ,*,CC1 ) PROD( 73 , , ,LCLS ) PROD( 50 , ,*,ARGS ) PROD( @ ,ERROR(13) , , ) ARGS: PROD( <SEPRTR> , ,*,ARGS ) PROD( "$" , ,*,ARGDLR ) PROD( "[" , ,*,ABRK ) PROD( <LETTR> ,A2 , ,AID0 ) ARGDLR: PROD( <LETTR> ,A1 , ,AID0 ) PROD( @ ,ERROR(13) , , ) AID0: PROD( "." , ,*,AID2 ) AID1: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,AID0 ) PROD( @ ,A0(%%FORML) , ,AID3 ) AID2: PROD( <LETTR!DIGIT> , ,_,AID1 ) PROD( @ ,ERROR(13) , , ) AID3: PROD( <SEPRTR> , ,*,AID3 ) PROD( 54 , ,*,ARGS ) PROD( 51 ,A20 ,*,LCLS ) PROD( @ ,ERROR(13) , , ) ABRK: PROD( <LETTR> ,A2 , ,ABK0 ) PROD( @ ,ERROR(13) , , ) ABK0: PROD( "." , ,*,ABK2 ) ABK1: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,ABK0 ) PROD( @ ,A0(%%FORML) , ,ABK3 ) ABK2: PROD( <LETTR!DIGIT> , ,_,ABK1 ) PROD( @ ,ERROR(13) , , ) ABK3: PROD( <SEPRTR> , ,*,ABK3 ) PROD( 51 ,A21 ,*,LCLS ) PROD( @ ,ERROR(13) , , ) LCLS: PROD( <SEPRTR> , ,*,LCLS ) PROD( 0 ,EXIT , , ) PROD( "." , ,*,CC1 ) PROD( 73 , ,*,LCL1 ) PROD( 54 , ,*,LCL1 ) PROD( @ ,ERROR(13) , , ) LCL1: PROD( <SEPRTR> , ,*,LCL1 ) PROD( <LETTR> ,A2 , ,LID0 ) PROD( @ ,ERROR(13) , , ) LID0: PROD( "." , ,*,LID2 ) LID1: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,LID0 ) PROD( @ ,A0(%%LCL) , ,LCLS ) LID2: PROD( <LETTR!DIGIT> , ,_,LID1 ) PROD( @ ,A0(%%LCL) , ,CC1 )
SUBTTL PRODUCTIONS FOR RECOGNIZING A DATA DEFINITION DDEF0: PROD( @ , ,*,DDEF1 ) DDEF1: PROD( <SEPRTR> , ,*,DDEF1 ) PROD( "$" , ,*,DDEF2 ) PROD( @ ,ERROR(21) , , ) DDEF2: PROD( <SEPRTR> , ,*,DDEF2 ) PROD( <LETTR> ,A2 , ,DDEF3 ) PROD( @ ,ERROR(21) , , ) DDEF3: PROD( "." , ,*,DDEF5 ) DDEF4: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,DDEF3 ) PROD( @ ,A0(%%DEFNAM) , ,DDEF6 ) DDEF5: PROD( <LETTR!DIGIT> , ,_,DDEF4 ) PROD( @ ,ERROR(21) , , ) DDEF6: PROD( <SEPRTR> , ,*,DDEF6 ) PROD( "=" , ,*,DDEF7 ) PROD( @ ,ERROR(21) , , ) DDEF7: PROD( <SEPRTR> , ,*,DDEF7 ) PROD( "[" ,A18 ,*,DDEF8 ) PROD( <LETTR> , , ,ALTDEF ) PROD( @ ,ERROR(21) , , ) DDEF8: PROD( <SEPRTR> , ,*,DDEF8 ) PROD( <LETTR> , , ,STRDEF ) SEQDF0: PROD( <SEPRTR> , ,*,SEQDF0 ) PROD( <PLSMIN> ,A14 ,*,SEQDF1 ) SEQDF1: PROD( <DIGIT> , , ,SEQDF2 ) PROD( @ ,ERROR(21) , , ) SEQDF2: PROD( <DIGIT> ,A19 ,*,SEQDF2 ) PROD( @ ,A0(%%SEQLB) , ,SEQDF3 ) SEQDF3: PROD( <SEPRTR> , ,*,SEQDF3 ) PROD( ":" ,A18 ,*,SEQDF4 ) PROD( @ ,ERROR(21) , , ) SEQDF4: PROD( <SEPRTR> , ,*,SEQDF4 ) PROD( "]" , ,*,SEQDF8 ) PROD( <PLSMIN> ,A14 ,*,SEQDF5 ) SEQDF5: PROD( <DIGIT> , , ,SEQDF6 ) PROD( @ ,ERROR(21) , , ) SEQDF6: PROD( <DIGIT> ,A19 ,*,SEQDF6 ) PROD( @ ,A0(%%SEQUB) , ,SEQDF7 ) SEQDF7: PROD( <SEPRTR> , ,*,SEQDF7 ) PROD( "]" , ,*,SEQDF8 ) PROD( @ ,ERROR(21) , , ) SEQDF8: PROD( <SEPRTR> , ,*,SEQDF8 ) PROD( <LETTR> ,A2 , ,SEQDF9 ) PROD( @ ,ERROR(21) , , ) SEQDF9: PROD( "." , ,*,SEQD11 ) SEQD10: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,SEQDF9 ) PROD( @ ,A0(%%ELTYPE) , ,STRDF9 ) SEQD11: PROD( <LETTR!DIGIT> , ,_,SEQD10 ) PROD( @ ,ERROR(21) , , )
STRDEF: PROD( <SEPRTR> , ,*,STRDEF ) PROD( <LETTR> ,A2 , ,STRDF0 ) PROD( @ ,ERROR(21) , , ) STRDF0: PROD( "." , ,*,STRDF2 ) STRDF1: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,STRDF0 ) PROD( @ ,A0(%%SELNAM) , ,STRDF3 ) STRDF2: PROD( <LETTR!DIGIT> , ,_,STRDF1 ) PROD( @ ,ERROR(21) , , ) STRDF3: PROD( <SEPRTR> , ,*,STRDF3 ) PROD( ":" , ,*,STRDF4 ) PROD( @ ,ERROR(21) , , ) STRDF4: PROD( <SEPRTR> , ,*,STRDF4 ) PROD( <LETTR> ,A2 , ,STRDF5 ) PROD( @ ,ERROR(21) , , ) STRDF5: PROD( "." , ,*,STRDF7 ) STRDF6: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,STRDF5 ) PROD( @ ,A0(%%TYPNAM) , ,STRDF8 ) STRDF7: PROD( <LETTR!DIGIT> , ,_,STRDF6 ) PROD( @ ,ERROR(21) , , ) STRDF8: PROD( <SEPRTR> , ,*,STRDF8 ) PROD( "]" , ,*,STRDF9 ) PROD( 54 , ,*,STRDEF ) PROD( @ ,ERROR(21) , , ) STRDF9: PROD( <SEPRTR> , ,*,STRDF9 ) PROD( "$" , ,*,STRD10 ) STRD10: PROD( <SEPRTR> , ,*,STRD10 ) PROD( 0 ,EXIT , , ) PROD( @ ,ERROR(21) , , ) ALTDEF: PROD( <SEPRTR> , ,*,ALTDEF ) PROD( <LETTR> ,A2 , ,ALTDF0 ) PROD( @ ,ERROR(21) , , ) ALTDF0: PROD( "." , ,*,ALTDF2 ) ALTDF1: PROD( <LETTR!DIGIT!PERIOD> ,A5 ,*,ALTDF0 ) PROD( @ ,A0(%%ALTNAM) , ,ALTDF3 ) ALTDF2: PROD( <LETTR!DIGIT> , ,_,ALTDF1 ) PROD( @ ,ERROR(21) , , ) ALTDF3: PROD( <SEPRTR> , ,*,ALTDF3 ) PROD( "!" , ,*,ALTDEF ) PROD( @ , , ,STRDF9 )
SUBTTL ACTION DEFINITIONS ;AN ACTION CALLED X MUST BE GIVEN THE INTEGRAL INDEX PRDX AND THE ;DISPATCH ADDRESS ACTX (A POINTER TO THE ACTION ROUTINE) DEFINE ACTDEF(A) < ACTN== 1 IRP A <PRD'A==ACTN ACTN== ACTN+1> ACTN== 1 ACTLH== NXTPR0 ACDSPT: IRP A <IFN ACTN,< XWD ACTLH,ACT'A> IFE ACTN,< ACTLH== ACT'A> ACTN== 1-ACTN> IFN ACTN,<XWD ACTLH,0> > ACTDEF <EXIT,ERROR,A0,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13,A14,A15,A18,A19,A20,A21> ACTEXI: HRRZ R,LXP ;RETURN SIZE OF TRANSLATED BUFFER LXX0: AOS -14(P) ;SKIP RETURN LXX: SOS PZSAV ;REMOVE INPUT TEXT FROM PROTECTION STACK MOVE P,LEXPDP ;RESTORE P IN CASE THERE WAS AN ERROR JRST RSTALL ;RESTORE AC1-14 AND RETURN
SUBTTL ACTION ROUTINES ;TEMP AC'S USED BY SOME ACTIONS - NOT CLOBBERED BY PRODUCTION INTERPRETER BP1== AC5 ;BYTE POINTER FOR PACKING N== AC6 ;COUNTER ;A1 - INITIALIZE UNPACKING OF $ID ACTA1: TROA FF,DLRFLG ;SET $ FLAG ;A2 - INITIALIZE UNPACKING OF ID ACTA2: TRZ FF,DLRFLG MOVE BP1,[POINT 6,LXBUF,5] MOVNI N,LXBSIZ*6-1 ; - MAX SIZE JRST NXTPR0 ;A5 - PACK AN ID CHARACTER ACTA5: CAIG C,140 ;SKIP IF SMALL LETTER TRC C,40 ;CONV TO SIXBIT IDPB C,BP1 ;STORE IT AOJL N,NXTPR0 LEXERR 1,3 ;ID TOO LONG ;A4 - INITIALIZE FOR STRING CONSTANT ACTA4: MOVE BP1,[POINT 7,LXBUF-1,35] MOVNI N,LXBSIZ*5 JRST NXTPR0 ;A7 - PACK CR/LF INTO STRING ACTA7: MOVEI C,15 ;CR IDPB C,BP1 AOJGE N,ACTA6+2 MOVEI C,12 ;LF ;A6 - PACK STRING CHARACTER ACTA6: TLNN BP1,760000 ;OVERFLOWING THIS WORD? SETZM 1(BP1) ;YES, CLEAR NEXT WORD IDPB C,BP1 AOJL N,NXTPR0 LEXERR 1,4 ;ASCII STRING TOO LONG ;A9 - INIT FOR OPERATOR STRING ACTA9: MOVE BP1,[POINT 6,LXBUF] MOVNI N,LXBSIZ*6 JRST NXTPR0
;A8 - PACK AN OPERATOR CHARACTER ACTA8: TRC C,40 ;CONV. TO SIXBIT IDPB C,BP1 AOJL N,NXTPR0 LEXERR 1,5 ;OPERATOR TOO LONG ;AC'S FOR NUMBER DECODING NSD== AC5 ;LH = NUMBER OF TRAILING ZEROES ;RH = TOTAL DIGITS SEEN, NOT INCLUDING LEADING ZEROES DEXP== AC6 ;DECIMAL CONVERSION FLACTOR UEXP== AC7 ;USER-SPECIFIED EXPONENT ;A3 - INITIALIZE FOR ANY SORT OF NUMBER ACTA3: SETZB R,R2 ;CLEAR RESULTS SETZB NSD,DEXP ;CLEAR COUNTERS MOVEI UEXP,0 ;CLEAR USER-SPECIFIED EXPONENT TRZ FF,RFLG+DBLFLG+EXPSGN ;CLEAR FLAGS ;A12 - INITIALIZE FOR EXPONENT ACTA12: JRST NXTPR0 ;(NOTHING TO DO) ;A13 - SET REAL AND DOUBLE FLAGS ACTA13: TROA FF,DBLFLG+RFLG ;A11 - SET REAL FLAG ACTA11: TRO FF,RFLG JRST NXTPR0 ;A14 - SET EXP SIGN FLAG (+ OR -) ACTA14: CAIN C,"-" ;NEGATIVE? TRO FF,EXPSGN ;YES,SET FLAG JRST NXTPR0 ;A15 - PROCESS AN EXPONENT DIGIT ACTA15: CAILE UEXP,^D9999 ;CHECK FOR GROSS OVERFLOW LEXERR 1,7 IMULI UEXP,^D10 ;OK, PUT ON DIGIT ADDI UEXP,-60(C) JRST NXTPR0
;A10 - PROCESS A DIGIT ACTA10: CAIN C,"0" ;IS DIGIT A ZERO? JUMPE NSD,IGZER ;YES, IGNORE IF LEADING ZERO TRNE NSD,777760 ;NO, SIGNIFICANCE EXCEEDED (NSD>15)? JRST A10.1 ;YES, GO HANDLE AN OVERFLOW DIGIT IMUL R,AC4 ;NO, MULTIPLY RUNNING PRODUCT BY 8 OR 10 MOVE AC2,R ;SAVE HIGH ORDER MOVE R,R2 ;MULTIPLY LOW ORDER MUL R,AC4 ADD R,AC2 ;CARRY TO HIGH ORDER ADDI R2,-"0"(C) ;ADD VALUE OF NEW DIGIT TLZE R2,400000 ;OVERFLOW? ADDI R,1 ;YES, CARRY TO HIGH ORDER SUBI DEXP,1 ;CORRECT DECIMAL SCALE FACTOR A10.1: TRNN FF,RFLG ;HAS A PERIOD BEEN SEEN YET? ADDI DEXP,1 ;NO, INCREMENT DECIMAL SCALE CAIN C,"0" ;WAS DIGIT A ZERO? AOBJP NSD,NXTPR0 ;YES, INC TRAILING ZERO AND TOTAL DIGIT COUNTS HLLI NSD, ;NO. CLEAR TRAILING ZERO COUNT CAIN NSD,^D16 ;IS THIS THE 17TH NONZERO DIGIT? CAIGE C,"5" ;YES, IS IT GE 5? AOJA NSD,NXTPR0 ;NO TO EITHER. INC TOTAL DIGIT COUNT ADDI R2,1 ;YES, ROUND UP BY ADDING 1 TO LOW ORDER TLZE R2,400000 ;OVERFLOW? ADDI R,1 ;YES CARRY TO HIGH ORDER AOJA NSD,NXTPR0 ;INCREMENT TOTAL DIGIT COUNT ;HERE TO IGNORE A LEADING ZERO IGZER: TRNE FF,RFLG ;HAS A DECIMAL POINT BEEN SEEN? SUBI DEXP,1 ;YES, DECREMENT DECIMAL SCALE JRST NXTPR0
;A0(TYPE) - TERMINATE CONSTRUCTION OF LEXEME AND PACK IT ACTA0: SAVE <BP> ;SAVE CURRENT BYTE PTR SKIPL PR,PRODTB(LXPC) ;FETCH CURRENT PRODUCTION AGAIN CALL BACKBP ;IF"*" NOT SPECIFIED, BACKUP TLNE PR,200000 CALL BACKBP ;IF "_" SPECIFIED, BACKUP AGAIN MOVEM BP,THSLXP ;STORE PTR TO LAST CHAR OF THIS LEXEME RESTORE <BP> ;RESTORE CURRENT BYTE PTR ROT AC4,-1 ;BRANCH ON LX TYPE JUMPGE AC4,.+2 SKIPA AC4,A0TAB(AC4) MOVS AC4,A0TAB(AC4) JRST (AC4) LXN== 0 DEFINE LXDEF(A) < IFE LXN,< LXW== EXP A0'A> IFN LXN,< XWD LXW,A0'A> LXN== 1-LXN > ;DISPATCH TABLE A0TAB: LXDEFS IFN LXN,< XWD LXW,0 >
;A18 - INITIALIZE FOR SEQUENCE DEF BOUND ACTA18: MOVEI R,0 ;CLEAR NUMBER REGISTER TRZ FF,EXPSGN ;CLEAR SIGN FLAG JRST NXTPR0 ;A19 - PROCESS A SEQUENCE DEF BOUND DIGIT ACTA19: IMULI R,^D10 ;PUT ON ANOTHER DIGIT ADDI R,-60(C) CAILE R,377777 ;CHECK THAT MAGNITUDE IS < 2^17 LEXERR 1,26 ;TOO LARGE JRST NXTPR0 ; A20 - COME HERE ONLY TO SET FLAG FOR TUPLE ARGS ACTA20: TRZA FF,TUPARG ;SET FLAG FOR NORMAL ARG ACTA21: TRO FF,TUPARG ;SET FLAG FOR TUPLE ARG JRST NXTPR0
;STRING DEMAND LEXEME - ?" A0SDEM: MOVE R,[LXM(STAK,DEMAND,1)] ;SETUP STRING DEMAND LEXEME JRST A0END ;STORE IT ;RELOC LEXEME A0RELO: JUMPN R,.+2 ;MUST BE LESS TNAH 1000 CAILE R2,^D999 LEXERR 11 ;RELOC CONST OVERFLOW HRRZ R,R2 ;OK, MAKE A LEXEME OUT OF IT TLOA R,(LXM(STAK,RELOC)) ;DEMAND SYMBOL LEXEME A0DEMA: MOVSI R,(LXM(STAK,DEMAND)) A0END: MOVE AC1,R ;PICKUP COMPLETED LEXEME PUSHJ P,MSTOK ;ALLOCATE ROOM FOR IT AND STORE IT ; RETURN SYNTAX TOKEN IN R MOVEI R2,V$TERM ;SET TERMINAL "A" VOCAB # A0END1: MOVE AC1,@PZSAV ;RESTORE PZADR OF INPUT TEXT PUSHJ P,LEXSWP ;CORETURN TO PARSER JRST NXTPR0 ;RESUME LEXICAL ANALYSIS ;OCTAL INTEGER - NUMBER IS 36-BIT A0OCTI: TRZE R,1 ;WOULD BIT 0 BE SET? TLO R2,400000 ;YES, SET IT AND REMOVE BIT FROM HIGH WORD ;INTEGER LEXEME A0INT: JUMPE R,.+2 LEXERR 6 ;INTEGER OVERFLOW TRNE FF,LEXCHK ;JUST CHECKING? JRST A0CON1 ;YES, DON'T MAKE BLOCK MOVE AC1,R2 ;NO. GET VALUE FROM R2 MOVEI AC3,U.INT ;SETUP TYPE IN AC3 A0ATM: CALL ATOM ;CONSTRUCT ATOM (SHARING IF POSSIBLE) SKIPA AC1,@PZSAV ;RESTORE IMPORTANT AC A0CONS: MOVEM AC4,1(R2) ;STORE CONSTANT A0CON1: HRLI R,(LXM(STAK,CONST)) JRST A0END ;ROUTINE TO STORE LEXEME SUPPLIED IN AC1, AND RETURN A SYNTAX ;TOKEN POINTING TO IT MSTOK: CALL ALOCLX ;ALLOCATE LEXEME AND STORE AC1 LSH R,^D35-BGNPFP ;SHIFT PTR INTO BGN PTR FIELD STORE (R2,R,ENDPF) ;COPY PTR INTO END PTR FIELD RETURN
;REAL OR DOUBLE LEXEME A0REAL: HLRZ AC2,NSD ;FETCH TRAILING ZERO COUNT HLLI NSD, ;CLEAR LH SUBI NSD,(AC2) ;SUBTRACT TRAILING ZEROES FROM DIGIT COUNT CAILE NSD,^D8 ;>8 SIGNIFICANT DIGITS? TRO FF,DBLFLG ;YES, SET DBL FLAG MOVE AC3,R ;FETCH HIGH-ORDER WORD JFFO AC3,A0RL1 ;COUNT LEADING ZEROES MOVE AC3,R2 ;HIGH ORDER ALL ZEROES, FETCH LOW JFFO AC3,.+2 ;COUNT LEADING ZEROES IN LOW WORD JRST A0RLX ;WHOLE NUMBER ZERO, SKIP SCALING ENTIRELY ADDI AC4,^D35 ;ADJUST COUNT FOR NULL HIGH WORD A0RL1: ASHC R,-2(AC4) ;SHIFT LEFT SO AS TO BE ALMOST NORMALIZED ; (FIRST 1 IN BIT 2 OF HIGH WORD) TRNE FF,EXPSGN ;WAS EXPONENT NEGATIVE? MOVN UEXP,UEXP ;YES, NEGATE EXPLICIT EXPONENT ADD DEXP,UEXP ;COMBINE EXPONENT AND SCALE MOVM UEXP,DEXP ;TAKE MAGNITUDE CAILE UEXP,^D55 ;ENSURE RESULT WITHIN LIMIT OF TABLES LEXERR 7 ;DECIMAL EXPONENT ASSUREDLY OUT OF RANGE MOVE AC1,TENH(UEXP) ;FETCH HIGH-ORDER POWER OF TEN MOVE AC2,TENL(UEXP) ;FETCH LOW-ORDER POWER OF TEN JUMPL DEXP,.+3 ;JUMP IF EXPONENT IS NEGATIVE CALL DBLMUL ;POSITIVE. MULTIPLY BY 10^(DEXP) JRST .+2 CALL DBLDIV ;NEGATIVE. DIVIDE BY 10^-(DEXP) IMULI DEXP,3245 ;COMPUTE BINARY EXPONENT BY ASH DEXP,-9 ; FLOOR(E*LOG2(10)) JUMPGE DEXP,.+2 ;NEGATIVE? SUBI DEXP,1 ;YES, CORRECT FOR ASH MOVE AC1,R ;NORMALIZE THE NUMBER AGAIN JFFO AC1,.+1 ASHC R,-9(AC2) ;LEAVE ROOM FOR EXPONENT ASH R2,-8 ADDI AC4,(AC2) ;COMBINE RESULTS OF NORMALIZATIONS HRREI AC4,-^D74(AC4) SUB DEXP,AC4 ;COMPUTE BINARY EXPONENT CAIG DEXP,177 ;CHECK EXPONENT AGAINST LIMITS CAMGE DEXP,[-200] LEXERR 7 ;EXPONENT OVERFLOW FSC R,200(DEXP) ;OK, INSERT BINARY CHARACTERISTIC FSC R2,200-^D27(DEXP)
;HERE WITH NORMALIZED DOUBLE-PRECISION FLOATING POINT NUMBER IN (R,R2) A0RLX: TRNE FF,LEXCHK ;JUST CHECKING? JRST A0CON1 ;YES, DON'T GENERATE ATOM MOVE AC1,R ;NO, PICK UP HIGH-ORDER RESULT TRNE FF,DBLFLG ;DOUBLE-PRECISION? JRST A0RLD ;YES FADR AC1,R2 ;NO, USE LOW ORDER TO ROUND HIGH ORDER MOVEI AC3,U.REAL ;SETUP REAL TYPE CODE JRST A0ATM ;GO CONSTRUCT LEXEME A0RLD: FADL AC1,R2 ;DBL, FETCH LOW ORDER AND ENSURE NORMAL FORM MOVEI AC3,U.DBL ;SETUP DBL TYPE CODE JRST A0ATM ;GO CONSTRUCT LEXEME ;STRING LEXEME A0STRI: TRNE FF,LEXCHK ;JUST CHECKING? JRST A0CON1 ;YES, DON'T MAKE THE STRING BLOCK EXCH AC1,BP1 ;CLEAR REST OF LAST WORD PUSHJ P,CLRBYT EXCH AC1,BP1 ADDI N,LXBSIZ*5 ;COMPUTE CHARACTER COUNT MOVEI AC4,4(N) ;CONVERT TO WORD COUNT IDIVI AC4,5 PUSHJ P,MKBLK ;MAKE A BLOCK OF SIZE+2 BLKARG U.STRING,2(AC4) JUMPE N,A0CON1 ;SKIP ALL THIS IF NULL STRING MOVEM N,1(R2) ;STORE UPPER BOUND ADDI AC4,1(R2) ;COMPUTE ABS POSITION OF LAST WORD ADDI R2,2 ;MAKE BLT POINTER FOR STRING HRLI R2,LXBUF BLT R2,(AC4) JRST A0CON1 ;PACK STRING LEXEME (CONSTANT) ;CHAR LEXEME A0CHAR: PUSHJ P,MKBLK ;COME HERE TO MAKE A CHAR BLKARG U.CHAR,2 MOVEM C,1(R2) ;STORE THE CHARACTER IN THE BLOCK JRST A0CON1 ;GO STUFF IT IN BLOCK AND RETURN
;ID LEXEME A0ID: PUSHJ P,TERMI1 ;TERMINATE,LOOKUP. SPECIAL SYNTAX TOKEN? JRST A0SYNT ;YES, GO HANDLE IT HRLI R,(LXM(STAK,ID));NO, REGULAR ID TRZE FF,DLRFLG ;WAS '$' SEEN BEFORE IT? HRLI R,(LXM(STAK,$ID)) ;YES, MAKE SPECIAL $ID JRST A0END ;RETURN LEXEME ;HERE WHEN ID RECOGNIZED AS SYNTAX TOKEN. RETURN CORRECT VOCAB NUMBER A0SYNT: HRRZ R2,(R2) ;FETCH VOCAB# FROM RH OF STE (PTR RETURNED ; BY TERMI1) SETZ R, ;ZERO SYNTAX TOKEN JRST A0END1 ;NO, RETURN TOKEN AND VOCAB# NOW ;ROUTINE TO TERMINATE AND LOOK UP ID. ERROR IF IT IS A SPECIAL SYNTAX TOKEN. ;ARG N - CHAR COUNT FROM ID PACKING CODE ; BP1 - BYTE PTR ;RETURNS R=REL ADR OF ID, R2=ABS ADR TERMID: CALL TERMI1 ;TERMINATE,LOOKUP. SPECIAL SYNTAX TOKEN? LEXERR 30 ;YES, IMPROPER USE RETURN ;NO, OK ;ROUTINE TO TERMINATE AND LOOK UP ID ;SKIP UNLESS IT IS A SPECIAL SYNTAX TOKEN. TERMI1: ADDI N,LXBSIZ*6+^D11 ;TERMINATE THE ID STRING IDIVI N,6 DPB N,[POINT 6,LXBUF,5] MOVE AC1,BP1 ;CLEAR REST OF LAST WORD PUSHJ P,CLRBYT PUSHJ P,FINDID ;LOOK FOR AND/OR ENTER ID IN IDT JFCL ;(ALREADY EXISTED) MOVE R2,@IDTP ;GET ABS ADR OF IDT ADDI R2,(R) ;COMPUTE ABS ADR OF STE FOR ID HLRZ N,(R2) ;GET ID TYPE CAIE N,I.SYNTOK ;A SPECIAL SYNTAX TOKEN? AOS (P) ;NO, SKIP RETURN MOVE AC1,@PZSAV ;RESTORE CLOBBERED AC RETURN
;OP LEXEME A0OP: ADDI N,LXBSIZ*6 ;COMPUTE CHARACTER COUNT MOVE AC7,[POINT 6,LXBUF] ;PREPARE TO UNPACK OP STRING SETZB AC1,AC2 OPFILL: JUMPN AC2,.+2 ;CHECK FO R END OF OP STRING JUMPLE N,OPXIT JUMPE AC2,OPCHK ;SHIFT LEFTOVER FROM LAST TEST LSHC AC1,6 JRST .-2 OPCHK: TLNE AC1,77 ;HAVE 4 CHARACTERS LOADED? JRST OPLOOK ;YES, GO FIND LARGEST HEAD JUMPLE N,OPLOOK ;NO CHOICE IF NO CHARACTERS LEFT ILDB AC2,AC7 ;ADD ON A CHARACTER LSH AC2,^D30 LSHC AC1,6 SOJA N,OPCHK ;DECREASE CHAR COUNT AND CONTINUE OPLOOK: PUSHJ P,TOKSRC ;IS THIS A SPECIAL OPERATOR-TYPE TOKEN? JRST OPLK1 ;NO, TRY OP TABLE SETZ R, ;YES. ZERO SYNTAX TOKEN TO BE RETURNED JRST OPFND1 OPLK1: PUSHJ P,FINDOP ;SEARCH OPT FOR OPERATOR JRST OPNOTF ;NOT FOUND, TRY SHORTER HEAD HRLI R,(LXM(OP)) ;OK, CONSTRUCT LEXEME MOVE AC1,R PUSHJ P,MSTOK ;ALLOCATE SPACE IN LXMBUF, RETURN SYNTAX TOKEN MOVEI R2,V$OP ;RETURN VOCAB# FOR "OP" OPFND1: PUSHJ P,LEXSWP ;CORETURN TO PARSER SETZ AC1, ;ZERO OP JUST FOUND JRST OPFILL ;AND TRY SOME MORE OPNOTF: LSHC AC1,-6 ;NOT IN OPT, TRY SHORTER HEAD JUMPN AC1,OPLOOK LEXERR 12 OPXIT: MOVE AC1,@PZSAV ;RESTORE CLOBBERED AC1 JRST NXTPR0 ;OP STRING FINISHED, NEXT PRODUCTION
;ROUTINE TO SEARCH FOR A SPECIAL OPERATOR-TYPE TOKEN. ; MOVE AC1, RIGHT-JUSTIFIED SIXBIT OPERATOR ; PUSHJ P,TOKSRC ; RETURN - NOT FOUND ; RETURN - TOKEN FOUND. ASSOCIATED VOCAB# IN R2 TOKSRC: MOVSI R,-NOPTOK ;PUT -NUMBER OF TOKENS IN LH TOKSR1: HRLOI R2,77 ;PREPARE TO MASK 4-CHARACTER OPERATOR AND R2,OPTOKT(R) ;FETCH TOKEN FROM TABLE CAME R2,AC1 ;IS IT THE ONE? AOBJN R,TOKSR1 ;NO, TRY NEXT JUMPGE R,CPOPJ ;JUMP IF NOT FOUND LDB R2,[POINT 6,OPTOKT(R),5] ;FETCH VOCAB# JRST CPOPJ1 ;SKIP RETURN ;TABLE OF SPECIAL TOKENS THAT LOOK LIKE OPS DEFINE OPTOK(OP,V) < BYTE(6)^D'V(30)''OP'' > OPTOKT: OPTOK <;>,1 OPTOK ::,2 OPTOK <(>,4 OPTOK <)>,5 OPTOK <[>,6 OPTOK <]>,7 OPTOK =>,11 OPTOK <,>,14 OPTOK :,15 OPTOK <;;>,16 NOPTOK==.-OPTOKT ;NUMBER OF ENTRIES
;LABEL LEXEME A0LBL: TRNN FF,FOPN ;IS A FUNCTION OPEN FOR EDITING? LEXERR 33 ;NO, LABEL IN DIRECT STMT IS IMPROPER TRNE FF,LEXCHK ;JUST CHECKING? JRST OPXIT ;YES, DON'T BOTHER TRANSLATING LABEL PUSHJ P,TERMID ;NO, TERMINATE AND LOOK UP ID NAME LDB AC4,[POINT 12,L0BUF,11] ;GET # FORMLS HRRZ AC1,R ;GET INTERNAL NAME OF ID PUSHJ P,SRCHL0 ;SEARCH FOR IT IN PARAMETER LIST IN L0BUF JRST INSLBL ;NOT THERE, ADD A NEW LOCAL CAIG R,2(AC4) ;FOUND, MAKE SURE IT'S NOT PROCID OR FORML LEXERR 14 ;WRONG USE OF PROCID OR FORML ADDLBL: SUBI R,2 ;CONV. TO FORMAL PARAM # HRLZM AC1,L0BUF+2(R) ;STORE LABEL NAME AS LH OF PARAMETER HRRM R,L0BUF+2(R) ;STORE PARAMETER NUMBER AOS AC1,L0BUF ;INCR. AND GET ASGNMT COUNT ANDI AC1,7777 CAILE AC1,LBLBSZ ;CHECK FOR TOO MANY ASGNMTS LEXERR 15 MOVNI AC4,-1(AC1) ;GET # OF PRESENT ASGNMTS HRLZ AC4,AC4 ;CHECK FOR DUPLICATE LABEL JUMPE AC4,LBLOK HLRZ R2,LBLBUF(AC4) ;COMPARE TO LH OF ASGNMT CAMN R2,R JRST LEXE16 ;MULTIPLY DEFINED LABEL NAME AOBJN AC4,.-3 LBLOK: HRLZM R,LBLBUF-1(AC1) ;STORE PARAMETER NUMBER LDB R2,[POINT 10,LINENO,28] ;STORE LINE # OF THIS ASGNMT HRRM R2,LBLBUF-1(AC1) JRST OPXIT ;RESTORE SOME AC'S ;COME HERE TO CREATE A NEW LOCAL INSLBL: CAILE R,L0BSIZ ;CHECK FOR LINE 0 OVERFLOW LEXERR 17 MOVEI AC4,10000 ;OK, ADD ONE TO LCL COUNT ADDM AC4,L0BUF JRST ADDLBL LEXE16: SOS L0BUF ;HERE ON MUL DEF LABEL. DECR. LABEL COUNT LEXERR 16 ; AND COMPLAIN ;RIGHT PAD LEXEME A0RPAD: MOVEI R2,V$RPAD ;VOCAB# SETZ R, ;NO SYNTAX TOKEN PUSHJ P,LEXSWP ;CORETURN TO PARSER JRST A0RPAD ;SUPPLY ANOTHER RPAD IF CALLED AGAIN
;PROCEDURE ID A0PROC: PUSHJ P,TERMID ;TERMINATE AND LOOK UP ID HRLZM R,L0BUF+2 ;STORE IN PROCID SLOT SETZM L0BUF ;CLEAR COUNTERS AND ATTRIBUTES MOVSI R,SUBATR ;STORE SUBROUTINE ATTRIBUTE MOVEM R,L0BUF+1 ;IN LINE 0 ADD LXP,[XWD 3,3] ;POINT TO NEXT FREE SLOT JRST NXTPR0 ;FORMAL PARAMETER A0FORM: MOVEI AC4,-2(LXP) ;COMPUTE PARAMETER NUMBER TRNE FF,DLRFLG ;SEEN A $ IN ARG? IORI AC4,CBRBIT ;YES. SET CALL-BY-REFERENCE BIT MOVEM AC4,L0BUF(LXP) ;INITIALIZE CELL FOR FORML MOVSI AC4,(1B11) ;ADD ONE TO FORMAL COUNT A0PRAM: PUSHJ P,TERMID ;TERMINATE NAME AND LOOK IT UP MOVE AC1,R ;SEARCH FOR INTERNAL NAME AMONG PARAMETERS PUSHJ P,SRCHL0 JRST .+2 LEXERR 20 ;MUL DEF PARAMETER HRLM AC1,L0BUF(LXP) ;OK, STORE PARAMETER NAME ADDM AC4,L0BUF ;UPDATE APPROPRIATE COUNT AOBJN LXP,OPXIT LEXERR 17 ;TOO MANY PARAMETERS ;LOCAL PARAMETER A0LCL: MOVEI R,-2(LXP) ;STORE PARAMETER NUMBER HRRM R,L0BUF(LXP) MOVEI AC4,10000 ;INCREMENT LCL COUNT JRST A0PRAM
;DDEF NAME A0DEFN: CALL TERMID ;TERMINATE ID NAME, RETURN INTERNAL NAME TRZ FF,ALTF ;CLEAR ALT STORAGE FLAG MOVEM R,LXMBUF ;SAVE INTERNAL NAME ADD R,@IDTP ;GET STE FROM IDT HLRZ R,(R) JUMPE R,DEFNOK ;OK IF NO PREVIOUS DEFINITION EXISTED ;****** NOTE - EVENTUALLY REDEFINITIONS OF DDEFS WILL BE OK ***** LEXERR 23 ;ILLEGAL REDEFINITION DEFNOK: AOBJN LXP,NXTPR0 ;OK, INCREMENT POINTER AND CONTINUE LEXERR 24 ;TOO MANY ITEMS IN DDEF ;SELECTOR NAME A0SELN: CALL TERMID ;TERMINATE ID, RETURN INTERNAL NAME MOVSM R,LXMBUF(LXP) ;STORE SELECTOR NAME ADD R,@IDTP ;CHECK STE FOR THIS NAME HLRZ R2,(R) ;GET LH OF STE JUMPN R2,.+3 ;IF NOT YET DEFINED, MAKE IT A SEL MOVEI R2,I.SEL HRLM R2,(R) CAIE R2,I.SEL ;CHECK THAT IDENTIFIER IS A SEL LEXERR 25 ;BAD - ALREADY USED NAME MOVEI R,B.STRUCT(SYSBIT) ;OK, IDENTIFY THIS DDEF AS A STRUCT HRLM R,LXMBUF MOVEI R2,(LXP) ;FETCH NUMBER OF SELECTORS SO FAR SELCK: SOJLE R2,NXTPR0 ;DONE IF OUT OF SELECTORS HLLZ R,LXMBUF(R2) ;PICK UP A PREVIOUS SELECTOR NAME CAME R,LXMBUF(LXP) ;SAME AS NEW ONE? JRST SELCK ;NO, TRY NEXT LEXERR 23 ;YES, ERROR
;ELEMENT TYPE NAME IN A STRUCT A0TYPN: CALL TERMID ;TERMINATE ID, RETURN INTERNAL NAME HRRM R,LXMBUF(LXP) ;STORE TYPE NAME CALL CHKTYP ;CHECK THAT NAME IS AN ATOM,DDEF, OR UNDEFINED JRST DEFNOK ;OK ;TYPE NAME IN AN ALT A0ALTN: CALL TERMID ;TERMINATE ID, RETURN INTERNAL NAME MOVEI R2,B.ALT(SYSBIT) ;IDENTIFY DDEF AS AN ALT HRLM R2,LXMBUF CALL CHKTYP ;CHECK THAT NAME IS ATOM,DDEF, OR UNDEFINED TRCE FF,ALTF ;OK, CHECK ON WHICH HALF TO STORE JRST .+3 HRLZM R,LXMBUF(LXP) ;STORE TYPE NAME IN LH JRST DEFNOK ;INDICATE SLOT STARTED BUT NOT FINISHED HRRM R,LXMBUF-1(LXP) ;STORE TYPE NAME IN RH JRST NXTPR0 ;AND CONTINUE
;ELEMENT TYPE IN A SEQ OR VSEQ A0ELTY: CALL TERMID ;TERMINATE ID, RETURN INTERNAL NAME CALL CHKTYP ;CHECK THAT IT IS ATOM,DDEF, OR UNDEFINED HRRM R,LXMBUF+1 ;STORE TYPE NAME JRST NXTPR0 ;LOWER BOUND FOR SEQ OR VSEQ A0SEQL: TRZE FF,EXPSGN ;APPLY SIGN TO INTEGER MOVN R,R HRLM R,LXMBUF+1 ;STORE LOWER BOUND MOVEI R2,B.VSEQ(SYSBIT) ;SAY IT IS A VSEQ FOR NOW HRLM R2,LXMBUF JRST DEFNOK ;SEQUENCE TO NEXT SLOT AND CONTINUE ;UPPER BOUND FOR SEQ A0SEQU: TRZE FF,EXPSGN ;APPLY SIGN TO INTEGER MOVN R,R HRRZM R,LXMBUF+2 ;STORE UPPER BOUND HLRE R2,LXMBUF+1 ;CHECK THAT UPPER>=LOWER CAMGE R,R2 LEXERR 26 ;UGH MOVEI R2,B.SEQ(SYSBIT) ;OK, INDICATE THIS IS A SEQ HRLM R2,LXMBUF JRST DEFNOK ;CHKTYP ;CHECK THAT THE ID WHOSE INTERNAL NAME IS IN R IS AN ATOM, DDEF, OR ;UNDEFINED SYMBOL. R IS NOT CLOBBERED CHKTYP: HRRZ R2,@IDTP ;GET STE FOR NAMED ID ADD R2,R HLRZ R2,(R2) JUMPE R2,CHKTPX ;OK IF PREVIOUSLY UNDEFINED CAIE R2,I.ATOM ;OK IF ATOM CAIN R2,I.DDEF ;OK IF DATA DEFINITION CHKTPX: RETURN ;ALL OK CAIN R2,I.RESW ;OK IF A RESERVED WORD RETURN POP P,(P) ;THROW AWAY RETURN FOR ERROR LEXERR 22 ;ILLEGAL TYPE NAME
REPEAT 0,< FORMAT OF BUFFERS DURING OPERATION OF LEX LXMBUF: 1ST TRANSLATED LEXEME 2ND TRANSLATED LEXEME ... NTH TRANSLATED LEXEME ;N IN LXP[RH] AND RETURNED IN R L0BUF: BYTE(12) # FORMLS, # LCLS, # ASGNMTS 0 ;SPACE FOR ATTRIBUTES PROCID FORML 1 ... FORML N LCL N+1 ... LCL N+M ;LOCALS AND LABEL NAMES LBLBUF: ASGNMT 1 ;LH=FORML PARAMETER #, RH=LINE # ... ASGNMT K > ;SRCHL0(I) ;SEARCH L0BUF FOR THE ID (INTERNAL NAME) CONTAINED IN I. SKIP IF FOUND, ;RETURNING ITS RELATIVE POSITION (WHICH IS ALSO ITS INTERNAL PARAMETER ;NUMBER + 2 IF IT IS NOT A FORML). IF NOT FOUND, RETURN THE REL POSITION ;OF THE FIRST FREE SPACE IN L0BUF I== AC1 ;ARG - ID (INTERNAL NAME) SRCHL0: LDB R,[POINT 12,L0BUF,11] ;GET # FORMLS LDB R2,[POINT 12,L0BUF,23] ;GET # LCLS+LBLS ADDI R,1(R2) ;INCLUDE PROCID IN COUNT MOVN R,R HRLZ R,R HLRZ R2,L0BUF+2(R) ;GET A PARAMETER CAMN R2,I ;MATCH NAME? AOSA (P) ;YES, WILL SKIP EXIT AOBJN R,.-3 ;NO, ANDVANCE DOWN PARAMETER LIST SRCHLX: MOVEI R,2(R) ;RETURN REL POSITION POPJ P,
SUBTTL ERROR REPORTING ;THE FOLLOWING CODE HANDLES ERRORS FOR LEX AND PARSE. IT ATTEMPTS TO ; PINPOINT THE POSITION OF THE ERROR AND INDICATE IT TO THE USER ; BY REPRINTING HIS INPUT LINE, THEN PRINTING AN ARROW POINTING ; TO THE ERROR. FINALY, WE TAKE THE ERROR RETURN TO THE CALLER ; OF LEX OR PARSE AS THE CASE MAY BE. ;SYNERR AND LEXERR UUO'S COME HERE. ; NOTE: FOR LEXERR, IF THE AC FIELD IS ZERO, IT IS ASSUMED THE ; ERROR IS IN THE LAST LEXEME RECOGNIZED, WHEREAS IF IT IS NONZERO, ; THE ERROR IS IN THE CURRENT CHARACTER BEING SCANNED. XSYNER: LXERR: MOVE AC4,JOBUUO ;FETCH THE LEXERR OR SYNERR UUO JUST EXECUTED TLNN AC4,(Z 17,) ;AC FIELD ZERO? MOVE BP,THSLXP ;USE PTR TO MOST RECENTLY-RECOGNIZED LEXEME ;ACTION "ERROR" IN PRODUCTION TABLE COMES HERE ACTERR: MOVE P,LEXPDP ;RESTORE INITIAL CONTROL PD LEVEL CALL KILLIO ;RESET FILE I/O MOVE AC5,AC4 ;REMEMBER ERROR NUMBER HRRZ T1,-13(P) ;FETCH PZADR OF INPUT TEXT HRRZ T1,(T1) ;COMPUTE DZADR MOVSI AC2,(POINT 7,(T1),35) ;INIT BYTE PTR FOR LINE HLRZ R,OUTPOS ;CHAR POSITION AT END OF PROMPT TRNN FF,DNTRTP ;UNLESS RETYPING INPUT LXERR1: MOVEI R,8 ; IN WHICH CASE IT'S ALWAYS 8 SPACES MOVE AC3,AC2 ;REMEMBER PTR TO START OF CONTINUATION BEING ; SCANNED LXERR2: CAMN AC2,BP ;REACHED POSITION OF ERROR? JRST LXERR3 ;YES CALL LXGRAB ;NO, UNPACK A CHARACTER CAIN C,LF ;BEGINNING OF CONTINUATION? JRST LXERR1 ;YES, RESET POINTER CAIN C,TAB ;A TAB? IORI R,7 ;YES, INC TO NEXT TAB STOP -1 AOJA R,LXERR2 ;INC CHAR COUNT AND CONTINUE SCAN
;HAVING DETERMINED THE (CONTINUATION) LINE IN WHICH THE ERROR OCCURRED, ; PRINT IT OUT LXERR3: TRZE FF,DNTRTP ;DON'T RETYPE FLAG ON? JRST LXE4A ;YES, WE CAN POINT TO THE LINE THE USER TYPED TTOS [SIXBIT/#/] ;NO, DO EXTRA CRLF SAVE <R> ;REMEMBER ERROR POSITION SKIPE AC1,LINENO ;FETCH CURRENT LINE NO. IF ANY CALL TYPLNO ;TYPE IT OUT SKIPN LINENO TTOI TAB ;SUPPLY TAB IF NONE RESTOR <R> ;RESTORE ERROR POSITION SKIPA AC2,AC3 ;FETCH BYTE PTR TO START OF LINE LXERR4: TTOI (C) ;OUTPUT A CHARACTER CALL LXGRAB ;FETCH NEXT CHARACTER CAIE C,LF ;LINE FEED? JUMPN C,LXERR4 ;OR END OF LINE? TTOS [SIXBIT/#/] ;YES, GO TO NEXT LINE
;NOW OUTPUT THE MESSAGE AND AN ARROW SHOWING THE POSITION OF THE ERROR. ; IF IT WILL FIT, WE PUT THE MESSAGE TO THE LEFT OF THE ARROW, ELSE ; TO THE RIGHT. LXE4A: TLO FF,NOCRLF ;TELL TTOS TO SUPPRESS CRLF ON # HLRZ AC1,LXERAD(AC5) ;FETCH LENGTH OF MESSAGE HRRZ R2,LXERAD(AC5) ;FETCH ADR OF MESSAGE CAIGE R,5(AC1) ;ROOM FOR MSG TO LEFT OF ERROR? SOJA R,LXERR5 ;NO, PUT IT TO RIGHT TTOS (R2) ;YES, OUTPUT MESSAGE NOW TTOI "-" ;THE PRINT "-" OVER TO ERROR CAIE R,2(AC1) ;ONE BEFORE ERROR POSITION YET? AOJA AC1,.-2 ;NO TTOI "^" ;YES, TYPE ARROW JRST LXERR9 ;EXIT LEX LXERR5: TTOI " " ;OUTPUT SPACES UP TO POSITION OF ERROR SOJG R,.-1 TTOS [SIXBIT/^---!/] ;POINT TO ERROR TTOS (R2) ;OUTPUT ERROR MESSAGE LXERR9: TLZ FF,NOCRLF ;END # SUPPRESSION TTOS [SIXBIT/#/] ;CRLF SETZM LEXSAV ;UNPROTECT SAVED LEXEMES JRST LXX ;EXIT LEX ;ROUTINE TO FETCH NEXT CHAR FROM ERROR LINE. THIS DOES THE CORRECT ; DIDDLING FOR RELOC LINE NUMBERS (SEE TEXT) LXGRAB: ILDB C,AC2 ;FETCH CHARACTER JUMPL T1,LXGRB1 ;RELOC BEEN STARTED? CAIE C,3 ;NO, CHAR A ^C? (RELOC ESCAPE) RETURN ;NO MOVEI C,"%" ;YES, SUBSTITUTE CORRECT CHARACTER TLO T1,400000 ;SET RELOC FLAG RETURN LXGRB1: TLZ T1,400000 ;CLEAR RELOC FLAG CAIN C,"0" ;A LEADING ZERO? ILDB C,AC2 ;YES, SKIP IT CAIN C,"0" ;ANOTHER? ILDB C,AC2 ;YES, SKIP IT RETURN
;ERROR MESSAGE TABLE DEFINE EMES(S,N) < IFNB <N>,< %EML'N##,,MSG(S) > IFB <N>,< ZZ== 0 IRPC S< ZZ== ZZ+1> ZZ ,, [SIXBIT\S!\] >> LXERAD: EMES (UTSTR,0) ;UNTERMINATED STRING EMES (NODIG,1) ;NOT OCTAL DIGIT EMES (MDECC,2) ;MALFORMED DECIMAL CONSTANT EMES (IDTLN,3) ;IDENTIFIER TOO LONG EMES (STRTL,4) ;STRING TOO LONG EMES (OPSTL,5) ;OPERATOR SEQUENCE TOO LONG EMES (INTOV,6) ;INTEGER OVERFLOW EMES (FLTOV,7) ;FLOATING OVERFLOW EMES (TMLEX,10) ;TOO MANY LEXEMES EMES (ILLIN,11) ;ILLEGAL LINE NUMBER EMES (UNDOP,12) ;UNDEFINED OPERATOR EMES (MFFNH,13) ;MALFORMED FUNCTION HEADER EMES (LBLER,14) ;LABEL SAME AS FN NAME OR PARAMETER EMES (TMLBL,15) ;TOO MANY LABELS IN THIS FN EMES (MDLBL,16) ;MULTIPLY-DEFINED LABEL EMES (TMPAR,17) ;TOO MANY PARAMETERS AND/OR LOCALS EMES (MDPAR,20) ;MULTIPLY-DEFINED PARAMETER EMES (MALDD,21) ;MALFORMED DATA DEFINITION EMES (IMPTY,22) ;IMPROPER TYPE NAME EMES (FNAIU,23) ;NAME ALREADY IN USE EMES (TMITM,24) ;TOO MANY ITEMS EMES (IMSLN,25) ;IMPROPER SELECTOR NAME EMES (IMBND,26) ;IMPROPER BOUND EMES (IMCHR,27) ;IMPROPER CHARACTER EMES (IMWRD,30) ;IMPROPER USE OF SPECIAL WORD EMES (SYNTAX ERROR) EMES (NOARR,32) ;NO "_" IN PRECEDING "FOR" EMES (DILBL,33) ;DIRECT STMT MAY NOT BE LABELLED LIT END