Directory of image this file is from
This file as a plain text file
TITLE PARSE - PPL EXECUTABLE STATEMENT PARSER SUBTTL RHL/WDM/EAT/ESR -- 15 JUNE 74 HISEG SEARCH PPL COMMENT / THIS SUBPROGRAM PARSES EXECUTABLE PPL STATEMENTS ONLY. IT DOES NOT PARSE FUNCTION HEADERS OR DATA DEFINITIONS. CALLING SEQUENCE: MOVE AC1,PZADR OF INPUT TEXT BLOCK (TLINE) CALL PARSE ERROR RETURN - MESSAGE HAS BEEN PRINTED ALREADY NORMAL RETURN - R CONTAINS PZADR OF LINE BLOCK CONTAINING TRANSLATED POSTFIX STRING. NOTE: IF THE LEXCHK FLAG IS SET IN FF, THE GENERATION OF THE LINE BLOCK IS INHIBITED. PARSE SAVES ALL ITS AC'S. IT CALLS UPON LEX TO OPERATE AS A COROUTINE AND RETURN A SINGLE LEXEME UPON EACH CALL. PARSE IS DRIVEN BY THE CODED PARSE TABLES IN PARSTB.MAC. THESE PARSE TABLES WERE GENERATED BY A PROGRAM WRITTEN IN PPL BY JUDY TOWNLEY. THE ALGORITHM IS THAT OF F.L.DEREMER. / ;LOCAL ACCUMULATOR DEFINITIONS ST== AC7 ;CURRENT STATE NUMBER S== AC6 ;SYNTAX STACK POINTER RULE== AC5 ;RULE NUMBER OR ACTION BYTE POINTER NT== AC3 ;NEW TOP SYNTAX TOKEN BEING CREATED LXP== AC12 ;PTR TO FIRST FREE CELL IN LXMBUF (ALSO USED IN LEX ;OTHER PARAMETERS HGHCHN==6 ;MAX CHAIN SPEC +1 IN RULE TABLE
SUBTTL PARSER MAIN ROUTINE PARSE: PUSHJ P,SAVALL ;SAVE AC'S 1-14 ON THE STACK MOVEM P,LEXPDP ;SAVE CURRENT P FOR ERROR RECOVERY MOVEI R,LEX0 ;INIT LEX1 COROUTINE MOVEM R,LXSVPC MOVEI ST,1 ;SET TO FIRST STATE MOVE S,[IOWD SSLEN,SYNSTK] ;INIT SYNTAX STACK PTR TRZ FF,LKFLG ;CLEAR LOOKAHEAD FLAG MOVEM AC1,LXSV1 ;MAKE INPUT TEXT PZADR VISIBLE TO LEX SETZM LXSV2 ;FIRST CALL TO LEX HAS AC2=0 AS DESIRED
;HERE UPON ENTERING A NEW STATE. STATE NUMBER IS IN ST. PARSE1: LDB AC1,READF ;FETCH READ FIELD FOR THIS STATE JUMPE AC1,REDUCE ;PERFORM REDUCTION IF READ FIELD BLANK LDB AC1,LOOKF ;NONBLANK, FETCH LOOKAHEAD FIELD JUMPE AC1,READ1 ;ADEQUATE READ STATE IF BLANK PUSHJ P,LOOK ;INADEQUATE STATE. PERFORM LOOKAHEAD CAIE R2,V$OP ;IS IT AN OPERATOR BEING SCANNED? JRST NORMLK ;NO, NORMAL LOOKAHEAD CAIE ST,UINAD ;UNARY INADEQUATE STATE CAIN ST,BINAD ;OR BINARY INAD STATE JRST DIDDLE ;GO DO OPERATOR PRECEDENCE DIDDLE NORMLK: LDB AC1,LOOKF ;FETCH LOOKAHEAD FIELD AGAIN MOVEI AC2,1 ;RIGHT-JUSTIFY A BIT LSH AC2,-1(R2) ;POSITION INDEXED BY CODE FOR CHAR JUST READ TDNE AC2,LOOKB(AC1) ;IS THE CHARACTER IN THE LOOKAHEAD SET? JRST REDUCE ;YES, STAY IN SAME STATE AND REDUCE LDB AC2,LKCHR ;NO, TEST AGAINST EXTRA LOOKAHEAD CHAR CAIN AC2,(R2) ;IS IT THAT CHARACTER? JRST REDUC0 ;YES, ENTER SPECIAL STATE AND REDUCE ;HERE TO READ A LEXEME AND TRANSITION ACCORDING TO ITS CODE. READ1: PUSHJ P,LEX1 ;CALL LEXICAL ANALYZER COROUTINE HRRI R,(ST) ;TAG RETURNED SYNTAX TOKEN WITH CURRENT STATE PUSH S,R ;PUSH TOKEN ONTO SYNTAX STACK LDB AC1,READF ;FETCH READ FIELD AGAIN TRZE AC1,ACCCD1 ;TEST ACCESS CODE JRST RDACC1 ;ACCESS CODE 1 ;READ ACCESS CODE 0: BYTE VECTOR INDEXED BY CHARACTER NUMBER MOVEI R,-1(R2) ;LOAD INDEX-1 IDIVI R,5 ;R_WORD INDEX, R2_BYTE INDEX IMULI R2,7 ;R2_BYTE POSITION ADDI R,READB(AC1) ;COMPUTE ABS PTR TO WORD CONTAINING BYTE JRST RDAC0A ;ENTRY HERE FROM TOP VECTOR ACCESSING TPACC0: IDIVI R,5 ;R_WORD INDEX, R2_BYTE INDEX IN WORD IMULI R2,7 ;R2_BYTE POSITION ADDI R,TOPB(AC1) ;COMPUTE ABS PTR TO WORD CONTAINING BYTE RDAC0A: MOVE ST,(R) ;FETCH WORD ROT ST,7(R2) ;RIGHT-JUSTIFY SELECTED BYTE ANDI ST,177 ;CLEAR OTHER BITS JUMPN ST,PARSE1 ;ENTER NEXT STATE IF LEGAL TRANSITION SYNUGH: SYNERR 31 ;"SYNTAX ERROR" ;CODE TO ARBITRATE LOOKAHEAD BASED ON OPERATOR PRECEDENCE DIDDLE: FETCH (R2,-1(S),BGNPF) ;GET OLD OPERATOR FROM STACK MOVE R2,LXMBUF(R2) ADD R2,@OPTP ;GET ADDRESS OF OPERATOR MOVE R2,2(R2) ; AND VALUE OF PRECEDENCE WORD CAIE ST,BINAD ;WAS THIS OPERATOR UNARY OR BINARY? HLR R2,R2 ;ADJUST ACCORDINGLY ANDI R2,77777 ;REDUCE TO 15 BITS AND CLEAR ASSOC BIT FETCH (R,R,BGNPF) ;GET OPERATOR WE JUST GOT ON LOOKAHEAD MOVE R,LXMBUF(R) ADD R,@OPTP ;GET ADDRESS OF NEXT OPERATOR HRRZ R,2(R) ;AND VALUE OF BINARY PRECEDENCE LSHC R,1 ;ADJUST TO INCLUDE ASSOC IN SIMPLE COMPARE TLZE R,1 ;CHECK FOR RIGHT ASSOC AOJA R,.+2 ;YES, INCREASE STRENGTH SUBI R,1 ;NO, DECREASE IT CAML R2,R ;COMPARE STRENGTHS JRST REDUCE ;GO REDUCE JRST READ1 ;READ INSTEAD
;READ ACCESS CODE 1: UP TO 3 CHAR/STATE PAIRS RDACC1: ADD AC1,[POINT 5,READB] ;INIT BYTE PTR TO LEFT OF 1ST BYTE RDAC1N: ILDB R,AC1 ;FETCH CHARACTER BYTE TLO AC1,(POINT 2,,35) ;SET BYTE SIZE TO 7 ILDB ST,AC1 ;FETCH CORRESPONDING STATE BYTE TLZ AC1,(POINT 2,,35) ;SET BYTE SIZE TO 5 CAIN R,(R2) ;CURRENT CHAR MATCH TEST BYTE? JUMPN ST,PARSE1 ;YES, ENTER CORRESPONDING STATE TLNE AC1,760000 ;NO, REACHED END OF WORD? JRST RDAC1N ;NO, TRY NEXT CHAR/STATE PAIR SYNERR 31 ;"SYNTAX ERROR" ;HERE FROM LOOKAHEAD CODE IN EXTRA-STATE REDUCTIONS REDUC0: LDB ST,LKNST ;ENTER FUNNY NEW STATE ;HERE TO PERFORM A REDUCTION REDUCE: LDB RULE,RULEF ;FETCH RULE NUMBER FOR THIS REDUCTION SKIPN RULETB-1(RULE) ;NULL-ACTION REDUCTION JRST GETTOP ;YES, BYPASS CHAINING CODE ENTIRELY LDB AC4,NPOPF ;NO, FETCH NUMBER OF LEXEMES TO POP HRLI AC4,(AC4) ;DUPLICATE IN LH SUBM S,AC4 ;AC4 SAVES NEW STACK PTR FOR LATER HRRZ NT,1(AC4) ;INIT NEW TOP TOKEN BY REMEMBERING STATE ADD RULE,[POINT 7,RULETB-1] ;SETUP ACTION BYTE PTR PUSH P,ST ;SAVE CURRENT STATE MOVEI ST,NT ;SETUP BACK PTR TO START CHAIN
;START OF LOOP TO CHAIN FRAGMENTS TOGETHER CHAIN1: ILDB AC1,RULE ;FETCH NEXT CHAIN SPEC BYTE JUMPE AC1,CHAIN9 ;JUMP IF END OF THINGS TO CHAIN CAIL AC1,HGHCHN ;IS IT A STACK POSITION FOR CHAINING? JRST CHAIN3 ;NO, IT'S A CODEPIECE PTR SUBM S,AC1 ;YES, COMPUTE REQUIRED STACK POSITION -1 FETCH (R,1(AC1),BGNPF);FETCH BGN PTR FIELD OF TOKEN TO BE CHAINED FETCH (R2,1(AC1),ENDPF) ;FETCH END PTR FIELD JRST CHAIN4 ;GO CHAIN LEXEME POINTED TO BY R,R2 ;HERE WHEN A SPECIAL PARSER ACTION IS TO BE EXECUTED CHAIN3: PUSHJ P,CHNACT-HGHCHN(AC1) ;PERFORM SPECIFIED ACTION ROUTINE JRST .+2 ;TOKEN RETURNED IN R, CHAIN IT JRST CHAIN8 ;NOTHING TO CHAIN, PROCEED TO NEXT BYTE ;CHAIN A NEW FRAGMENT ONTO THE PREVIOUSLY CONSTRUCTED CHAIN CHAIN4: STORE (R,(ST),BGNPF) ;STORE PTR TO BEGINNING OF NEW FRAGMENT ; IN FWD PTR FIELD OF PREV LEXEME MOVEI ST,LXMBUF(R2) ;REMEMBER ADR OF LAST LEXEME IN CHAIN NOW CHAIN8: TLNE RULE,760000 ;OUT OF CHAIN BYTES FOR THIS RULE? JRST CHAIN1 ;NO, CONTINUE CHAINING ;HERE WHEN RULE TABLE ENTRY EXHAUSTED. COMPLETE NEW CHAIN. CHAIN9: SUBI ST,LXMBUF ;MAKE END PTR RELATIVE STORE (ST,NT,ENDPF) ;STORE PTR TO END OF CHAIN IN NEWTOP POP P,ST ;RESTORE CURRENT STATE MOVE S,AC4 ;GET BACK POPPED SYNTAX STACK PTR PUSH S,NT ;PUSH NEW TOP TOKEN ON SYNTAX STACK
;EXAMINE THE TOP SET FOR THIS STATE AND DETERMINE THE NEXT STATE. GETTOP: FETCH (R,(S),STATF) ;FETCH STATE NUMBER FROM TOP OF STACK LDB AC1,TOPF ;FETCH TOP VECTOR PTR FOR PRESENT STATE JUMPE AC1,ENDPRS ;JUMP IF NO TOP PTR (DONE?) TRZE AC1,ACCCD2 ;TEST ACCESS CODE SOJA R,TPACC2 ;ACCESS CODE 2, PROCESS BIT VECTOR TRZN AC1,ACCCD1 SOJA R,TPACC0 ;ACCESS CODE 0 - PROCESS LIKE READ VECTOR ;TOP ACCESS CODE 1: UP TO 5 OLD/NEW STATE PAIRS TPACC1: ADD AC1,[POINT 7,TOPB] ;INIT PTR TO LEFT OF 1ST BYTE MOVEI AC2,MXTOPP ;MAX NUMBER OF TOP PAIRS TPAC1N: ILDB R2,AC1 ;FETCH AN OLD STATE NUMBER ILDB ST,AC1 ;FETCH CORRESPONDING NEW STATE NUMBER CAIN R2,(R) ;DOES STACKED STATE MATCH? JUMPN ST,PARSE1 ;YES, ENTER CORRESPONDING NEW STATE SOJG AC2,TPAC1N ;NO, TRY NEXT PAIR IF ANY SYNERR 31 ;"SYNTAX ERROR" ;TOP ACCESS CODE 2: BIT VECTOR INDEXED BY OLD STATE NUMBER, PLUS ONE ;EXTRA TEST TPACC2: IDIVI R,^D36 ;R_WORD INDEX, R2_BIT INDEX ADDI R,TOPB(AC1) ;COMPUTE WORD POSITION OF DESIRED BIT MOVE AC2,(R) ;FETCH CORRECT WORD LSH AC2,(R2) ;PLACE DESIRED BIT IN SIGN ADD AC1,TOPNST ;FETCH POSSIBLE NEW STATE ;FETCH POSSIBLE NEW STATE LDB ST,AC1 JUMPL AC2,PARSE1 ;JUMP IF BIT MATCHING STACKED STATE IS ON FETCH (R,(S),STATF) ;NO, GET BACK STACKED STATE ILDB R2,AC1 ;FETCH FINAL OLD STATE TEST ILDB ST,AC1 ;CORRESPONDING NEW STATE CAIN R,(R2) ;CURRENT CHAR MATCH TEST BYTE JUMPN ST,PARSE1 ;YES, ENTER STATE SYNERR 31
;HERE WHEN A REDUCTION HAS BEEN PERFORMED AND THERE IS NO TOP VECTOR. ;THIS USUALLY INDICATES WE ARE FINISHED PARSING. ENDPRS: SOJN R,SYNUGH ;ERROR IF TOP STATE IS NOT 1 TRNE FF,LEXCHK ;PARSED! ARE WE JUST SYNTAX CHECKING? JRST LXX0 ;YES, SKIP EXIT IMMEDIATELY CALL MKBLK ;NO, CONSTRUCT A NEW LINE BLOCK BLKARG B.LINE+SYSBIT,2(LXP) ;SIZE 3 GREATER THAN NUMBER OF LEXEMES SETZM LEXSAV ;NO LONGER NEED TO PROTECT LXMBUF FROM GC MOVEI R2,1(R2) ;POINT TO LINE# SLOT (LEFT BLANK) FETCH (AC1,(S),BGNPF) ;FETCH PTR TO START OF LEXEME CHAIN MOVSI AC2,(BYTE(FCHNFS)-1) ;SETUP MASK TO CLEAR FWD CHAIN FIELD WITH CHNUNP: PUSH R2,LXMBUF(AC1) ;STORE LEXEME IN BLOCK ANDCAM AC2,(R2) ;CLEAR FORWARD CHAIN FIELD FETCH (AC1,LXMBUF(AC1),FCHNF) ;TRACE FORWARD CHAIN FIELD OF LEXEME JUMPN AC1,CHNUNP ;LOOP IF NONZERO MOVSI AC1,(LXM(RPAD)) ;END OF LINE, STORE A RIGHT PAD LEXEME MOVEM AC1,1(R2) ; FOR THE INTERPRETER JRST LXX0 ;GO RESTORE AC'S AND SKIP RETURN ;BYTE POINTERS FOR DECODING THE PARSE TABLE RULEF: POINT 6,PARSTB-1(ST), 5 ;RULE NUMBER FIELD NPOPF: POINT 3,PARSTB-1(ST), 8 ;NUMBER OF LEXEMES TO POP READF: POINT 9,PARSTB-1(ST),17 ;POINTER TO READ-TRANSITION SET TOPF: POINT 10,PARSTB-1(ST),27 ;POINTER TO TOP PAIR SET LOOKF: POINT 8,PARSTB-1(ST),35 ;POINTER TO LOOKAHEAD SET LKCHR: POINT 5,LOOKB(AC1), 4 ;EXTRACTS SPECIAL LOOKAHEAD TEST CHAR LKNST: POINT 7,LOOKB(AC1),11 ;EXTRACTS THE CORRESPONDING STATE TOPNSW==NSTATES/^D36 TOPNSB==NSTATES-TOPNSW*^D36+6 IFG TOPNSB-^D35,< TOPNSB==6 TOPNSW==TOPNSW+1 > TOPNST: POINT 7,TOPB+TOPNSW,TOPNSB
SUBTTL RULE ACTION TABLE ;ACTIONS ARE CODED INTO 7-BIT BYTES, EACH AS FOLLOWS: ; N=0 NO MORE ACTIONS ; N<=5 CHAIN IN STACK TOKEN N, WHERE THE TOP IS 1. ; N>5 PERFORM ACTION ROUTINE AT CHNACT+N-HGHCHN DEFINE RULE(RN,A<0>,B<0>,C<0>,D<0>,E<0>) < BYTE (7)PACT'A-CHNACT+HGHCHN,PACT'B-CHNACT+HGHCHN,PACT'C-CHNACT+HGHCHN,PACT'D-CHNACT+HGHCHN,PACT'E-CHNACT+HGHCHN > ;DEFINE RULE ACTIONS 0-5 TO DO CHAINING ZZ== -1 REPEAT 6,< CONC (PACT,\<ZZ==ZZ+1>,==ZZ+CHNACT-HGHCHN) >
;RULE TABLE RULETB: RULE ( 1 ,2) RULE ( 2 ,4,2,A) RULE ( 3 ,Q) RULE ( 4 ,2,B,1) RULE ( 5 ,4,C,3,D,1) RULE ( 6 ,Q,3,E,1,F) RULE ( 7 ,3,G,1) RULE ( 8 ) RULE ( 9 ,AA,3,BB,1,CC) RULE ( 10 ) RULE ( 11 ,3,G,1) RULE ( 12 ,4,C,3,D,1) RULE ( 13 ,Q,3,E,1,F) RULE ( 14 ,AA,3,BB,1,CC) RULE ( 15 ) RULE ( 16 ,1,I) RULE ( 17 ,1,W,X) RULE ( 18 ,W,Y) RULE ( 19 ,DD,3,EE,1,FF) RULE ( 20 ,1,J) RULE ( 21 ,1,3,K) RULE ( 22 ) RULE ( 23 ,2,4,L) RULE ( 24 ,2,4,M) RULE ( 25 ,2,N) RULE ( 26 ,O) RULE ( 27 ,3,P) RULE ( 28 ) RULE ( 29 ,2) RULE ( 30 ,2) RULE ( 31 ,2) RULE ( 32 ,1) RULE ( 33 ,1) RULE ( 34 ,U,1) RULE ( 35 ,V,3,1) RULE ( 36 ,S,R,1) RULE ( 37 ,T,3,1) RULE ( 38 ) RULE ( 39 )
SUBTTL SPECIAL PARSER ACTIONS CHNACT: ;BEGINNING OF TABLE. ; LENGTH LIMITED TO 123 INSTRUCTIONS! ;PARSER ACTION A - ALLOCATE "FOR STATEMENT" LEXEME PACTA: MOVSI AC1,(LXM(FORST)) ;CONSTRUCT LEXEME JRST ALOCLX ;GO ALLOCATE IT ;PARSER ACTION B - ALLOCATE "THEN SCOPE 1" LEXEME, WITH CORRECT COUNT PACTB: MOVSI AC1,(LXM(THNSC1)) ;CONSTRUCT LEXEME PACTBE: FETCH (AC2,(S),BGNPF) ;FETCH PTR TO STACK FRAGMENT 1 PACTBC: ADDI AC1,1 ;COUNT ALWAYS STARTS AT 1 PACTB1: ADDI AC1,1 ;INCREMENT LEXEME COUNT FETCH (AC2,LXMBUF(AC2),BGNPF) ;GET REL ADR OF NEXT LEXEME ON CHAIN JUMPN AC2,PACTB1 ;CONTINUE COUNT IF NONZERO HRRZM AC1,COUNT ;SAVE COUNT FOR FUTURE USE JRST ALOCLX ;GO ALLOCATE LEXEME ;PARSER ACTION C - ALLOCATE "THEN SCOPE 2" LEXEME, WITH CORRECT COUNT PACTC: MOVSI AC1,(LXM(THNSC2)) ;CONSTRUCT LEXEME FETCH (AC2,-2(S),BGNPF) ;FETCH PTR TO STACK FRAGMENT 3 AOJA AC1,PACTBC ;GO COUNT LENGTH OF FRAGMENT (START AT 1) ;PARSER ACTION D - ALLOCATE "ELSE SCOPE" LEXEME, WITH COUNT PACTD: MOVSI AC1,(LXM(ELSSCP)) ;CONSTRUCT LEXEME JRST PACTBE ;GO COUNT LENGTH OF FRAGMENT ;PARSER ACTION E - ALLOCATE "FOR SCOPE" LEXEME, WITH COUNT PACTE: MOVSI AC1,(LXM(FORSCP)) ;CONSTRUCT LEXEME AOJA AC1,PACTBE ;GO COUNT LENGTH OF FRAGMENT (START AT 1) ;PARSER ACTION F - ALLOCATE "END FOR SCOPE" LEXEME, WITH COUNT PACTF: MOVSI AC1,(LXM(ENDFOR)) ;CONSTRUCT LEXEME MOVN R,COUNT ;RETRIEVE SAVED COUNT (FROM ACTION E) HRRI AC1,2(R) ;PLACE IN RH OF NEW LEXEME JRST ALOCLX ;GO ALLOCATE LEXEME
;PARSER ACTION G - ALLOCATE "UNSTACK" LEXEME PACTG: MOVSI AC1,(LXM(UNSTAK)) ;CONSTRUCT LEXEME JRST ALOCLX ;GO ALLOCATE IT ;PARSER ACTION I - ALLOCATE "UNOP" LEXEME WITH PTR TO "GOTO". PACTI: MOVSI AC1,(LXM(UNOP,OP)) ;CONSTRUCT TYPE AND INT ACTION HRRI AC1,$UGOTO ;SETUP PTR TO OP TBL ENTRY FOR "-->" JRST ALOCLX ;ALLOCATE THE LEXEME ;PARSER ACTION J - ADD "UNOP" FIELD TO FRAGMENT 2. PACTJ: MOVSI AC1,(LXM(UNOP,OP)) ;CONSTRUCT TYPE AND INT ACTION PACTJK: FETCH (R,-1(S),BGNPF) ;FETCH PTRS TO THE LEXEME FETCH (R2,-1(S),ENDPF); AS IF IT HAD JUST BEEN ALLOCATED HLLM AC1,LXMBUF(R) ;STORE NEW TYPE AND INT ACTION FIELDS RETURN ;PARSER ACTION K - ADD "BINOP" FIELD TO FRAGMENT 2 PACTK: MOVSI AC1,(LXM(BINOP,OP)) ;CONST TYPE AND INT ACTION JRST PACTJK ;GO PERFORM "REALLOCATION" ;PARSER ACTIONS L,P - ALLOCATE "FN APP" LEXEME AND STORE LIST COUNT PACTL: PACTP: MOVSI AC1,(LXM(FNAPP)) ;CONST LEXEME PACTLM: FETCH (AC2,-1(S),AUXCF) ;EXTRACT LIST COUNT FROM TOP LEXEME HRR AC1,AC2 ;STORE IN LEXEME JRST ALOCLX ;ALLOCATE THE LEXEME ;PARSER ACTION M - ALLOCATE "SEL APP" LEXEME AND STORE LIST COUNT PACTM: MOVSI AC1,(LXM(SELAPP)) ;CONSTRUCT LEXEME JRST PACTLM ;GO GET LIST COUNT AND ALLOC LEXEME
;PARSER ACTIONS N,O - ALLOCATE "MAKE TUPLE" LXM WITH LIST COUNT PACTN: PACTO: MOVSI AC1,(LXM(MAKTUP)) ;CONSTRUCT LEXEME JRST PACTLM ;GO STORE LIST COUNT AND ALLOC LEXEME ;PARSER ACTION Q - ALLOCATE NULL LEXEME PACTQ: SKIPA AC1,NULLL ;FETCH NULL LEXEME ;PARSER ACTION R - ALLOCATE "1" IMPLICIT STEP LEXEME PACTR: MOVE AC1,[LXM(STAK,CONST,INTTAB+1)] ;CONST LEXEME JRST ALOCLX ;GO ALLOCATE AND CHAIN ;PARSER ACTION S - CONVERT ASSIGNMENT TO "FOR ASSIGNMENT" PACTS: FETCH (R,-2(S),BGNPF) ;FETCH PTRS TO FRAGMENT 3 FETCH (R2,-2(S),ENDPF) PACTST: HLRZ AC1,LXMBUF(R2) ;FETCH LAST LEXEME TYPE CAIE AC1,(LXM(BINOP,OP)) ;MUST BE AN OPERATOR SYNERR 32 ;IMPROPER FOR HRRZ AC1,LXMBUF(R2) ;GET INTERNAL NAME OF OP ADD AC1,@OPTP ;CONVERT TO ABS ADDRESS OF OPERATOR HRRZ AC1,1(AC1) ;GET BINARY DEFINITION CAIE AC1,%ASSIGN ;IS IT BOUND TO ASSIGNMENT? SYNERR 32 ;"SYNTAX ERROR - IMPROPER FOR?" MOVSI AC1,(LXM(FORASS)) ;OK, CONSTRUCT FOR-ASSIGNMENT LXM MOVEM AC1,LXMBUF(R2) ;REPLACE LEFT-ARROW LEXEME BY IT RETURN ;PARSER ACTION T - SAME AS S EXCEPT FOR STACK POSITION PACTT: FETCH (R,-4(S),BGNPF) ;FETCH PTRS TO FRAGMENT 5 FETCH (R2,-4(S),ENDPF) JRST PACTST ;GO VERIFY ASSIGNMENT ;PARSER ACTION U - BEGIN LIST COUNT IN TOP TOKEN PACTU: TRZ NT,<<1_AUXCFS>-1>B<AUXCFP> ;CLR AUX CNT FIELD IN NT TROA NT,1B<AUXCFP> ;INIT COUNT TO 1 ;PARSER ACTION V - INCREMENT LIST COUNT AT TOP-2 ON STACK PACTV: ADDI NT,1B<AUXCFP> ;INCREMENT LIST COUNT BY 1 JRST CPOPJ1 ;SKIP RETURN TO SIGNAL NO CHAINING ;PARSER ACTION W - ALLOCATE A LEXEME FOR SYSTEM RETURN PACTW: MOVE AC1,[LXM(STAK,ID,%SRETURN)] ;MAKE LEXEME JRST ALOCLX ;PARSER ACTIONS X,Y - GENERATE FNAPP(0) OR (1) LEXEMES PACTX: MOVEI AC1,1 ;ONE ARGUMENT CAIA PACTY: SETZ AC1, ;NO ARGUMENTS HRLI AC1,(LXM(FNAPP));APPLY FUNCTION JRST ALOCLX
;PARSER ACTION AA - FIRST COUNT IN WHILE DO ;ALSO ALLOCATES NULL LEXEME AS DEFAULT VALUE PACTAA: MOVNI AC1,1 ;COUNT LENGTH(EXP)-1 FETCH (AC2,-2(S),BGNPF) ;COUNT EXPRESSION PACAA1: ADDI AC1,1 ;INCREMENT COUNT FETCH (AC2,LXMBUF(AC2),BGNPF) ;CHAIN TO NEXT LEXEME JUMPN AC2,PACAA1 ;ALL DONE? HRRM AC1,COUNT ;SAVE VALUE AWAY FOR LATER JRST PACTQ ;GO ALLOCATE NULL LEXEME ;PARSER ACTION BB - ALLOCATES WHILE LEXEME AND DOES SECOND COUNT PACTBB: MOVEI AC1,2 ;START COUNT AT 2 FETCH (AC2,(S),BGNPF) ;COUNT FORM PACBB1: ADDI AC1,1 ;INCREMENT COUNT FETCH (AC2,LXMBUF(AC2),BGNPF) ;GET NEXT LEXEME JUMPN AC2,PACBB1 ;ALL DONE? ADDM AC1,COUNT ;ADD TO PREVIOUS VALUE HRLI AC1,(LXM(WHLSCP)) ;ALLOCATE WHILE SCP JRST ALOCLX ;PARSER ACTION CC - ALLOCATES ENDWHL SCOPE LEXEME AT END OF WHILE PACTCC: MOVN AC1,COUNT ;NEGATIVE ELSE JUMP HRLI AC1,(LXM(ENDWHL)) ;AND MAKE LEXEME JRST ALOCLX ;PARSER ACTION DD - COUNT UP LEXEMES IN FRAGMENTS FOR REPEAT UNTIL PACTDD: SETZ AC1, ;START AT 0 FETCH (AC2,(S),BGNPF) ;COUNT FRAGMENT 1 PACDD1: ADDI AC1,1 ;INCREMENT FETCH (AC2,LXMBUF(AC2),BGNPF) ;CHAIN TO NEXT LEXEME JUMPN AC2,PACDD1 ;AGAIN IF NOT ZERO FETCH (AC2,-2(S),BGNPF) ;SAME FOR FRAGMENT 3 PACDD2: ADDI AC1,1 FETCH (AC2,LXMBUF(AC2),BGNPF) JUMPN AC2,PACDD2 HRRM AC1,COUNT ;SAVE FOR LATER USE BY REPEAT JRST PACTQ ;GO STACK NULL LEXEME ;PARSER ACTION EE - ALLOCATES REPEAT SCOPE LEXEME PACTEE: HRLZI AC1,(LXM(RPTSCP)) ;GET LEXEME JRST ALOCLX ;AND ALLOCATE IT ;PARSER ACTION FF - RETURN SCOPE (WORK DONE BY ACTION DD) PACTFF: AOS AC1,COUNT ;GET COUNT HRLI AC1,(LXM(ENDRPT)) ;ALLOCATE END REPEAT LEXEME JRST ALOCLX
SUBTTL LEXICAL ANALYZER INTERFACE ;ROUTINE TO ALLOCATE A LEXEME IN LXMBUF. ;LXP IS EXPECTED TO CONTAIN XWD -#FREE,FIRST FREE RELATIVE TO LXMBUF ; MOVE AC1, CONTENTS OF LEXEME ; PUSHJ P,ALOCLX ;RETURNS IN R AND R2 A RELATIVE PTR TO THE LEXEME IN LXMBUF. ALOCLX: HRRZ R,LXP ;FETCH FREE PTR MOVEM AC1,LXMBUF(R) ;STORE THE NEW LEXEME MOVE R2,R ;RETURN PTRS TO LEXEME IN R,R2 SOS LEXSAV ;INCREASE SAVED LEXEME COUNT AOBJN LXP,CPOPJ ;RETURN IF NOT END OF SPACE LXMBFL: SYNERR 10 ;"TOO MANY LEXEMES" ;ROUTINE TO PERFORM A LOOKAHEAD. CAN ONLY LOOK ONE CHARACTER AHEAD!!! ; PUSHJ P,LOOK ;RETURNS VOCAB# IN R2 AND SYNTAX TOKEN IN R (WHERE APPLICABLE). LOOK: TROE FF,LKFLG ;TEST AND SET LOOKAHEAD FLAG JRST LXOLD ;WAS ALREADY SET. LOOK AT SAME CHAR AGAIN JRST LXNEW ;WAS CLEAR, GO FETCH ANOTHER CHAR ;ROUTINE TO READ THE NEXT CHARACTER ; PUSHJ P,LEX1 ;RETURNS VOCAB# IN R2 AND SYNTAX TOKEN IN R (WHERE APPLICABLE). ;CORETURNS TO LEX. LEX1: TRZE FF,LKFLG ;TEST AND CLEAR LOOKAHEAD FLAG JRST LXOLD ;WAS ALREADY SET. LOOK AT SAME CHAR AGAIN LXNEW: PUSHJ P,LEXSWP ;CORETURN TO LEXICAL ANALYZER MOVEM R,LXSVR ;SAVE RETURNED SYNTAX TOKEN MOVEM R2,LXSVR2 ; AND VOCAB NUMBER POPJ P, LXOLD: MOVE R,LXSVR ;HERE TO RE-USE A TOKEN AND VOCAB # MOVE R2,LXSVR2 POPJ P,
;ROUTINE TO SWAP CONTEXTS FOR CORETURNS BETWEEN PARSE AND LEX. ; PUSHJ P,LEXSWP ;AC'S 1,2,6,7 ARE PROTECTED, AC3 IS CLOBBERED. LEXSWP: EXCH AC1,LXSV1 ;SWAP ACCUMULATORS EXCH AC2,LXSV2 EXCH AC6,LXSV6 EXCH AC7,LXSV7 POP P,AC3 ;FETCH RETURN TO CALLER EXCH AC3,LXSVPC ;SWAP PC'S JRST (AC3) ;JUMP TO COROUTINE ;SPECIAL CONSTANTS NULLL: LXM (STAK,CONST,NULL) ;NULL LEXEME LIT END