! File: SYNTAX.BLI ! ! This work was supported by the Advanced Research ! Projects Agency of the Office of the Secretary of ! Defense (F44620-73-C-0074) and is monitored by the ! Air Force Office of Scientific Research. ! Module SYNTAX= Begin ! SYNTAX MODULE ! ------------- ! ! C. WEINSTOCK ! C. GESCHKE ! W. WULF ! D. WILE ! P. KNUEVEN ! R. JOHNSSON ! ! THIS MODULE IS THE SYNTAX ANALYZER. ! ! Require 'Bliss'; External Routine NONBOGUS, GENGT; Own ENABFLG : Boolean, ELSTK : Vector[20], ELTOS : Integer, LASTELMARK : Integer, LABELNO : Integer, GLOLAB : Ref ST, COMPLAB : Ref ST; Macro BYTES(S)=(.S[gt_len]/8) %; Literal MACRCOMSEL=%x'7fffffff'; ! NOTE THE ABOVE 2 DEFINITIONS APPEAR IN LEXAN.BLI. !************** NOTE, THE ABOVE ADDED HERE BECAUSE NOT SURE WHERE ********** ! MISC. EXTERNALS FOR SYNTAX ONLY ! ------------------------------- External Routine F0 : Novalue, F1 : Novalue, F2 : Novalue, F3 : Novalue, F4 : Novalue, F5 : Novalue, F6 : Novalue, F7 : Novalue, ! ROUTINES FROM FLOWAN F8 : Novalue, F9 : Novalue, F10 : Novalue, F11 : Novalue, F12 : Novalue, F13 : Novalue, F14 : Novalue, F15 : Novalue, F16 : Novalue, F17 : Novalue, F18 : Novalue, F19 : Novalue, F20 : Novalue, F21 : Novalue, F22 : Novalue, F23 : Novalue, F24 : Novalue, F25 : Novalue, F26 : Novalue, F27 : Novalue, F28 : Novalue, F29 : Novalue; Forward Routine PUSHELSTK : Novalue, POPELSTK, MARKELSTK : Novalue; Global Routine GETLABEL = Begin Return LABELNO = .LABELNO+1 End; Forward Routine ! IN ORDER OF APPEARANCE SERROROP : Novalue, SMODERR : Novalue, EXPRESSION : Novalue, SCOMPOUND : Novalue, SOPERATOR : Novalue, SIF : Novalue, SWU : Novalue, SDO : Novalue, SREP : Novalue, SSQOPEN : Novalue, SPAR : Novalue, SSPECIALOP : Novalue, SCASE : Novalue, SSELECT : Novalue, SPOINTER : Novalue, SELABEL : Novalue, SFLABEL : Novalue, SEXITLOOP : Novalue, SRETURN : Novalue, SLABEL : Novalue, SLEAVE : Novalue, SCREATE : Novalue, SINLINE : Novalue, SENABLE : Novalue, SSIGNAL : Novalue; Bind SYNLST = Uplit Long ( Rep MAXOPERATOR+1 Of (SOPERATOR), ! THE OPS! SOPERATOR, ! = SERROROP, SCASE, 0, ! fparm 0, ! fstore SFLABEL, ! while SFLABEL, ! until 0, ! routine SCOMPOUND, SFLABEL, ! incr SFLABEL, ! decr SIF, SFLABEL, ! do_while SFLABEL, ! do_until SCREATE, 0, ! exchange SSELECT, SEXITLOOP, ! exitloop 0, ! label SMODERR, SPLIT, SPAR, SPOINTER, SSQOPEN, SLEAVE, SRETURN, ! return 0, ! null SINLINE, SENABLE, SSIGNAL ) : Vector[,Long]; ! GENERAL GRAPH TABLE ROUTINES ! ---------------------------- Macro LINIT=Local pos_open,SAVEL;pos_open = .pos_del %, INIT=LINIT;MARKSTK() %, FIN(P,Q)= Begin PRERUEX(Q); pos_good = .pos_del; SYM = GENGT(P); POSTRUEX(Q) End %, XFIN(N,Q)= Begin PRERUEX(Q); SYM = DELETEALLBUTONE((N)); POSTRUEX(Q); pos_good = .pos_del End %, XCTSYNTAX=Bliss(.SYNLST[.DEL]) %; ! read an expression and stack it Routine RUEX : Novalue = Begin EXPRESSION(); PUSH(.SYM) End; Macro EXPUSH(Q)= Begin PRERUEX(Q); RUEX(); POSTRUEX(Q) End %, RUEXPUSH(Q)= Begin PRERUEX(Q); RUND(QL_LEXEME); RUEX(); POSTRUEX(Q) End %, CONSTPUSH(P,Q)= Begin SYM = P; PRERUEX(Q); PUSH(.SYM); POSTRUEX(Q) End %; !I. GENERAL: ! ! 1. PUSHES LEXEME IN 'WORD' ONTO THE PARSE STACK ('STK') ! ! 2. GLOBALS: ! ! A. TOS -- TOP-OF-STACK ! !II. SPECIFIC: ! ! 1. * ! ! A. RETURN IF ANY ERRORS ! ! B. CHECK FOR LEXEMES THAT MAY NOT BE ! USED AS EXPRESSIONS, E.G. STRUCTURE NAMES ! ! C. IF WORD IS EMPTY (0) THEN PUSH A ! SPECIAL ZERO LEXEME. Global Routine PUSH(W : Ref GT) : Novalue = Begin If .num_error Neq 0 Then Return; If .W Eql T_SYMBOL Then If Not ISEXP(W) Then Begin ERRINFO[0] = .W; WARNEM(.pos_sym,BADSYMERR); W = ZERO End; If .W Eql TK_EMPTY Then W = ZERO; STK[TOS = .TOS+1] = .W End; ! SUBSTITUTE FOR PUSH, WHICH ALLOWS PUSHING OF ! LINKAGE TYPES AND LABELS ONTO THE STACK. CALLED ! BY SPAR, SELABEL, SLABEL, SLEAVE, SEXITLOOP, SENABLE. Routine PUSH1(W : Ref GT) : Novalue = Begin If .num_error Eql 0 Then STK[TOS = .TOS+1] = .W End; !I. GENERAL: ! ! 1. MARKS THE FLOOR OF THE CURRENT PORTION OF ! THE STACK. ! ! 2. GLOBALS: ! ! A. LASTMARK -- POINTS TO THE CURRENT FLOOR OF ! THE STACK, THE CURRENT FLOOR ! POINTS TO THE LAST FLOOR, ETC. ! BEHAVES JUST LIKE THE F- ! REGISTER AT RUNTIME. ! ! B. TOS -- TOP OF STACK. ! !II. SPECIFIC: ! ! 1. * ! ! A. IF ANY ERRORS AT THIS LEVEL, THEN RETURN. ! ! B. PUSH THE CURRENT FLOOR ONTO THE STACK. ! ! C. PUT THE NEW FLOOR HERE, AT THE TOP OF THE ! STACK. Global Routine MARKSTK : Novalue = Begin If .num_error Eql 0 Then Begin STK[TOS = .TOS+1] = .LASTMARK; LASTMARK = .TOS End End; !I. GENERAL: ! ! 1. THIS ROUTINE STARTS FROM THE CURRENT FLOOR OF THE ! STACK AND POPS ALL THE LEXEMES FROM IT INTO THE ! RESERVED GRAPH TABLE ENTRIES AT THE INDEX '.TOO'. ! ! 2. PARAMETERS: ! ! A. TOO -- CURRENT NODE INDEX INTO THE GRAPH ! TABLE. ! ! 3. GLOBALS: ! ! A. LASTMARK -- POINTS TO THE CURRENT FLOOR OF ! THE STACK. ! !II. SPECIFIC: ! ! 1. * ! ! A. IF ANY ERRORS, THEN RETURN. ! ! B. NEXT POP FROM CURRENT FLOOR UP TO TOP-OF- ! STACK INTO THE RESERVED GRAPH TABLE ENTRIES ! AT '.TOO'. ! ! C. NOW SET THE TOP-OF-STACK BELOW THE CURRENT ! FLOOR. ! ! D. RETURN THE POINTER 'LASTMARK' TO ITS LAST ! VALUE. Routine POPTOMARK(TOO : Ref GT) : Novalue = Begin If .num_error Eql 0 Then Begin If .TOS Neq .LASTMARK Then MOVECORE(STK[.LASTMARK+1], TOO[gt_arg1], .TOS-.LASTMARK); TOS = .LASTMARK-1; LASTMARK = .STK[.LASTMARK] End End; ! DELETE ALL STACK ELEMENTS ABOVE THE LAST MARK Global Routine DELETETOMARK : Novalue = Begin TOS = .LASTMARK-1; LASTMARK = .STK[.LASTMARK] End; Macro DELETEALLBUTONE(I)=(If .num_error Eql 0 Then (DELETETOMARK(); .STK[.TOS+(I)+2]) Else ZERO) %, ISALIT(Q)=(Bind X= Q; .X Eql T_LITERAL) %, ALLCONSTANT=(Incr I From .LASTMARK+1 To .TOS Do If Not ISALIT(STK[.I]) Then Exitloop 0) %; ! ! HANDLE N-N ! Routine CKNAMEDIFF(OPLEX : Ref GT,OP1 : Ref ST,OP2 : Ref ST) = Begin If .OPLEX Neq OP_SUB Then Return FALSE; If BASESYM(.OP1) Neq BASESYM(.OP2) Then Return FALSE; ! ! THE ABOVE TEST WILL BE LESS RESTRICTIVE WHEN WE ! FINALLY GET AROUND TO PUTTING OUT OWNS, ETC. IN ! THE ORDER IN WHICH THEY WERE DECLARED. ! ! that is, the base psect should be compared for OWN variables. DELETETOMARK(); SYM = LITLEXEME(.OP1[gt_disp]-.OP2[gt_disp]); Return TRUE End; ! ! HANDLE N+L,N-L,L+N ! Routine CKANDDONAME(OPLEX : Ref GT) = Begin Macro COMBINE(TYPE1,TYPE2)=((TYPE1)^5 + (TYPE2)) %; Local O1 : Ref GT, O2 : Ref GT, SWAPPED : Boolean; If .OPLEX Neq OP_ADD And .OPLEX Neq OP_SUB Then Return FALSE; O1 = .STK[.LASTMARK+1]; O2 = .STK[.LASTMARK+2]; Selectone COMBINE(.O1,.O2) Of Set [COMBINE(T_SYMBOL,T_LITERAL)]: SWAPPED = FALSE; [COMBINE(T_LITERAL,T_SYMBOL)]: Begin SWAPPED = TRUE; SWAP(O1,O2) End; [COMBINE(T_SYMBOL,T_SYMBOL)]: Return CKNAMEDIFF(.OPLEX,.O1,.O2); [Otherwise]: Return 0 Tes; If .OPLEX Eql OP_SUB Then If .SWAPPED Then Return FALSE Else O2 = LITLEXEME(-.O2); ! don't do address arithmetic on registers or locals which are 2 bytes ! in length because they have a TN assigned to them. If .O1[gt_type] Eql S_LOCAL And .O1[gt_reg] Gequ 8 Then WARNEM(.pos_sym,WALOCERR); DELETETOMARK(); SYM = CREATESWO(.O1,.O2); Return TRUE End; ! this handles the cases 'X * 1' and 'X * -1'. it does not handle ! 'X * 0' because 'X' may have side effects. Routine SPLMULCASE(LEX : Ref GT) = Begin Local L1 : Integer, L2 : Integer; L2 = .STK[.LASTMARK+2]; If .L2 Neq T_LITERAL Then Begin If .LEX Eql OP_DIV Then Return 0; L1 = .STK[.LASTMARK+1]; End Else Begin L1 = .L2; L2 = .STK[.LASTMARK+1] End; ! X * 1 => X If .L1 Eql T_LITERAL Then If .L1 Eql 1 Then Begin SYM = .L2; DELETETOMARK(); Return 1 End ! X * -1 => -X Else If .L1 Eql -1 Then Begin SYM = TK_NEG; DELETETOMARK(); MARKSTK(); PUSH(.L2); Return 2 End; Return 0 End; Routine SPLADDCASE(LEX : Ref GT) = Begin Local L1 : Integer, L2 : Integer; L1 = .STK[.LASTMARK+1]; L2 = .STK[.LASTMARK+2]; ! X +/- 0 => X If .L2 Eql T_LITERAL And .L2 Eql 0 Then Begin SYM = .L1; DELETETOMARK(); Return 1 End; ! 0 - X => -X If .L1 Eql T_LITERAL And .L1 Eql 0 Then If .LEX Eql OP_ADD Then Begin SYM = .L2; DELETETOMARK(); Return 1 End Else Begin SYM = TK_NEG; DELETETOMARK(); MARKSTK(); PUSH(.L2); Return 2 End; Return 0 End; Global Routine CKANDDOK(OPLEX : Ref GT) = Begin Local R, O1 : Integer, O2 : Integer, L1 : Ref GT, L2 : Ref GT; ! ! CHECK-AND-DO-CONSTANT ARITHMETIC ! If .OPLEX Geq OP_CARRY Then Return 0; ! +X => X If .OPLEX Eql OP_PLUS Then Begin SYM = DELETEALLBUTONE(0); Return 1 End; If .OPLEX Eql OP_ROT Then ! rot uses carry bit Return 0; If .OPLEX Eql OP_DOT Then Return 0; If ALLCONSTANT Then Begin L1 = .STK[.LASTMARK+1]; L2 = .STK[.LASTMARK+2]; O1 = .L1; O2 = .L2; DELETETOMARK(); R = (Case .OPLEX From 0 To 37 Of Set [Inrange,Outrange]: 0; [ 0]: .O1+.O2; ! + [ 1]: .O1^8 + .O2<8,8>; ! SWAB [ 2]: .O1/.O2; ! / [ 3]: 0; ! . [ 4]: .O1-.O2; ! - [ 5]: .O1 Mod .O2; ! MOD [ 6]: .O1*.O2; ! * [ 7]: -.O1; ! - [ 8]: .O1; ! + [ 9]: .O1^.O2; ! ^ [10]: 0; ! BIT [11]: .O1 Gtr .O2; ! GTR [12]: .O1 Leq .O2; ! LEQ [13]: .O1 Lss .O2; ! LSS [14]: .O1 Geq .O2; ! GEQ [15]: .O1 Eql .O2; ! EQL [16]: .O1 Neq .O2; ! NEQ [17]: Not .O1; ! NOT [18]: .O1 Eqv .O2; ! EQV [19]: .O1 And .O2; ! AND [20]: .O1 Or .O2; ! OR [21]: .O1 Xor .O2; ! XOR [22]: .O1 Gtru .O2; ! GTRU [23]: .O1 Lequ .O2; ! LEQU [24]: .O1 Lssu .O2; ! LSSU [25]: .O1 Gequ .O2; ! GEQU [26]: .O1 Eqlu .O2; ! EQLU [27]: .O1 Nequ .O2; ! NEQU [28]: 0; ! ROT [29]: Max(.O1,.O2); ! MAX [30]: Min(.O1,.O2); ! MIN Tes); SYM = LITLEXEME(.R); Return 1 End Else Begin R = (Select .OPLEX Of Set [OP_ADD]: SPLADDCASE(.OPLEX); [OP_SUB]: SPLADDCASE(.OPLEX); [OP_MUL]: SPLMULCASE(.OPLEX); [OP_DIV]: SPLMULCASE(.OPLEX); [Otherwise]: 0 Tes); If .R Eql 0 Then Return CKANDDONAME(.OPLEX) Else Return .R End End; ! GRAPH TABLE NODE BUILDING ROUTINES ! ---------------------------------- !I. GENERAL: ! ! 1. THE FUNCTION OF THIS ROUTINE IS TO GENERATE ! A NEW GRAPH TABLE NODE, USING THE LEXEMES ABOVE ! '.LASTMARK' ON THE STACK. ! !II. SPECIFIC: ! ! 1. * ! ! A. IF ANY ERRORS, RETURN. ! ! B. CALL 'GETSPACE' TO FIND SPACE IN THE GRAPH ! TABLE FOR A NODE OF LENGTH '.TOS-.LASTMARK ! +2' WORDS, IE THE NUMBER OF VALUES PUSHED ! ONTO THE STACK WHILE PROCESSING THE GIVEN ! NODE TYPE. 'GETSPACE' WILL RETURN THE ! INDEX OF THE FIRST WORD OF THE SPACE ! OBTAINED. ! ! C. USE THIS VALUE OF THE INDEX (RETURNED BY ! 'GETSPACE'), AND MAKE THE FIRST WORD OF ! THE GRAPH TABLE ENTRY HAVE THE VALUE OF THE ! NUMBER OF LEXEMES IN THAT ENTRY. ! ! D. THE NEXT WORD HAS THE VALUE '.NODE', IE THE ! TYPE OF NODE THIS IS. ! ! E. CALL 'POPTOMARK' TO ADD ALL THE VALUE ! LEXEMES FROM THE STACK INTO THE RESERVED ! SPACE FOR THE NODE AT '.L1'. ! ! F. RETURN A GRAPH TABLE LEXEME WITH THE ADDRESS ! OF THE GRAPH TABLE NODE. Global Routine MAKGT(L : Ref GT,OP : Integer) = Begin Local L1 : Ref GT, SIZE : Integer; OP = .OP; SIZE = .TOS-.LASTMARK+SZ_NODE; L1 = GETSPACE(.SIZE); L1[gt_argc] = .TOS-.LASTMARK; L1[gt_code] = .OP; L1[gt_type] = S_NODE; L1[gt_occ] = 1; L1[gt_disp] = 0; L1[gt_abc] = .ABCOUNT; If .swit_quick Then Begin L1[gt_csparent] = .L1; L1[gt_fparent] = .L1 End ! if this is a new formal parent Else If .L Eql 0 Then Begin L1[gt_depth] = .LOOPDEPTH; L1[gt_xdepth] = .LOOPDEPTH; L1[gt_v_fp] = TRUE; L1[gt_v_csp] = TRUE; L1[gt_fparent] = .L1; L1[gt_csparent] = .L1; L1[gt_gthread] = .GTHASH[.OP]; GTHASH[.OP] = .L1 End ! if this is not a formal parent but a CSE parent Else If .L Lss 0 Then Begin L = -.L; L1[gt_depth] = .LOOPDEPTH; L1[gt_xdepth] = .LOOPDEPTH; L1[gt_v_csp] = TRUE; L1[gt_fparent] = .L; L1[gt_csparent] = .L1; L1[gt_fsthread] = .L[gt_fsthread]; L[gt_fsthread] = .L1 End ! if this is a CSE usage Else Begin Local LCS : Ref GT, LFP : Ref GT; LCS = .L<0,32>; LFP = .L<32,32>; L1[gt_depth] = .LCS[gt_xdepth]; L1[gt_fparent] = .LFP; L1[gt_csparent] = .LCS; L1[gt_csthread] = .LCS[gt_csthread]; LCS[gt_csthread] = .L1 End; ! non-operators not available for CSE recognition If .OP Gtr MAXOPERATOR Then L1[gt_v_rm] = TRUE; L1[gt_crlevel] = .LEVEL; POPTOMARK(.L1); Return .L1 End; ! CALLED BY GENGT TO DECREASE THE OCCURRENCE ! COUNT ON THE SUBNODES OF CSNODE ! ! before a node is recognized as a CSE to another node, the ! children of the node were recognized as CSE's. this routine ! decrements the CSE occurence count of those children. Global Routine DECROCC(CSNODE : Ref GT) : Novalue = Begin Local L1 : Ref GT; While .CSNODE[gt_v_bogus] Do Begin CSNODE = .CSNODE[gt_csthread]; If .CSNODE Eql 0 Then Return End; Decr I From .CSNODE[gt_argc]-1 To 0 Do Begin L1 = .CSNODE[gt_argv(.I)]; If .L1 Eql T_NODE Then Begin L1 = .L1[gt_csparent]; If .L1[gt_occ] Gtr 0 Then L1[gt_occ] = .L1[gt_occ]-1 End End End; ! ! DETACHES A NODE FROM GT HASH TABLE; ! WORKS ONLY IF THE NODE CAN HAVE NO CSPARENTS, CSE USES. ! ! called by SPOINTER when two consecutive '<>' ! operators are used. ! ! called by BINDBIND and CHECKONELOCAL to remove useless ! '<>' operators. ! ! called by SCREATE to chuck extra nodes created during ! parsing. Global Routine PDETACH(NODE : Ref GT) : Novalue = Begin Local L : Ref GT, M : Ref GT; If .swit_quick Then Return; NODE = .NODE; L = M = .GTHASH[.NODE[gt_code]]; If .L Eql .NODE Then Begin ! SPECIAL CASE - NODE IS TOP OF GTHREAD CHAIN If .NODE[gt_fsthread] Eqla 0 Then Begin GTHASH[.NODE[gt_code]] = .NODE[gt_gthread]; Return End; L = GTHASH[.NODE[gt_code]] = .NODE[gt_fsthread]; L[gt_gthread] = .NODE[gt_gthread]; Until (M = .M[gt_fsthread]) Eqla 0 Do M[gt_fparent] = .L; Return End; While TRUE Do ! FIRST LOOK DOWN L'S FSTHREAD, Begin ! THEN TRY NEXT NODE ON GTHREAD CHAIN If .M[gt_fsthread] Eqla 0 Then Begin M = .L[gt_gthread]; If .M Eql .NODE Then Begin If .NODE[gt_fsthread] Eqla 0 Then Begin L[gt_gthread] = .NODE[gt_gthread]; Return End; L[gt_gthread] = .NODE[gt_fsthread]; L = .L[gt_gthread]; L[gt_gthread] = .NODE[gt_gthread]; Until (M = .M[gt_fsthread]) Eqla 0 Do M[gt_fparent] = .L; Return End; L = .M End Else Begin If .M[gt_fsthread] Eqla .NODE Then Begin M[gt_fsthread] = .NODE[gt_fsthread]; Return End; M = .M[gt_fsthread] End End End; Forward Routine BINDBIND; ! FAKE A CSE ! ! called by STRUFTOLEX for structure arguments which ! are nodes. ! ! called by BINDBIND for BIND symbols bound to an expression. Global Routine FAKECSE(NODE : Ref GT) = Begin Local X : Ref GT, CPNODE : Ref GT; If .NOTREE Then Return ZERO; CPNODE = .NODE[gt_csparent]; If (CPNODE[gt_occ] = .CPNODE[gt_occ]+1) Eql 1 Then Return .NODE; X = GETSPACE(SZ_NODE); MOVECORE(.NODE,.X,SZ_NODE); X[gt_code] = OP_FAKE_CSE; X[gt_argc] = 0; CPNODE[gt_v_dont_unlink] = TRUE; ! NOT NECESSARY, BUT SAVES TIME IN UNDOCSE. X[gt_csthread] = .CPNODE[gt_csthread]; CPNODE[gt_csthread] = .X; X[gt_crlevel] = .CPNODE[gt_crlevel]; X[gt_fparent] = (If .CPNODE[gt_code] Eql OP_FPARM Then .CPNODE Else .CPNODE[gt_fparent]); Return FASTLEXOUT(T_NODE,.X) End; ! binds BIND symbols, if present. Global Routine BINDBIND(LEX : Ref GT) = Begin If .LEX Eql T_SYMBOL And .LEX[gt_type] Eql S_BIND Then Begin LEX = .LEX[st_bind_data]; If .LEX Eql T_NODE Then LEX = FAKECSE(.LEX) End; Return .LEX End; ! called by WHICHBIND in DECLAR when a bind expression is found which ! requires code to be generated. Global Routine DYNBIND : Novalue = Begin MARKSTK(); PUSH(.SYM); SYM = GENGT(TK_FPARM); PUSH(.SYM); SYM[gt_v_rm] = FALSE End; Literal ! FLOW ACTION DEFN PARMS FNULL = 0, FCARRYOV0= 0, ! UNTIL FCARRYOV1= 0, ! IMPLEMENTED FIF0 = 1, FIF1 = 2, FIF2 = 3, FIF3 = 4, FWUD0 = 5, FWUD1 = 6, FWUD2 = 7, FDWU0 = 8, FDWU1 = 9, FDWU2 = 10, FID00 = 26, FID0 = 11, FID1 = 12, FCALL0 = 13, FCALL1 = 14, FCASE0 = 15, FCASE1 = 16, FCASE2 = 17, FSEL0 = 18, FSEL1 = 19, FSEL2 = 20, ! not used FSEL3 = 21, FSEL4 = 22, FLAB0 = 23, FLAB1 = 34, FLEAV0 = 24, FLEAV1 = 33, FRTRN = 35, FBODY0 = 25, FCIF = 27, FCCASE = 28, FBODY1 = 29, FINLINE0= 30, FSIG0 = 31, FIF4 = 32, ! not used FENABLAB= 36, FENAB0 = 37, FENAB1 = 38, FXXX = 0; ! not used Macro PRERUEX(QQ)= If .num_error Eql 0 Then Case (QQ) From 0 To 38 Of Set [Inrange]: 0; [ 1]: F20(); [ 2]: F8(); [ 3]: F8(); [ 4]: F5(); [ 5]: F1(); [ 7]: F9(); [ 8]: F1(); [10]: F9(); [11]: F10(); [12]: F6(); [16]: F8(); [17]: F5(); [21]: F0(); [24]: F0(); [25]: F12(); [37]: F22() Tes %; Macro POSTRUEX(QQ)= If .num_error Eql 0 Then Case (QQ) From 0 To 38 Of Set [Inrange]: 0; [ 1]: F15(); [ 2]: F4(); [ 3]: F4(); [ 5]: F19(); [ 7]: F18(); [ 8]: F9(); [ 9]: F26(); [10]: F16(); [11]: F17(); [13]: F9(); [14]: F11(); [15]: F27(); [16]: F4(); [18]: F9(); [21]: F7(); [24]: F14(); [26]: F9(); [27]: F9(); [28]: F9(); [29]: F13(); [30]: F3(); [32]: F4(); [33]: F24(); [34]: F25(); [35]: F2(); [36]: F21(); [38]: F23() Tes %; ! GENERAL ERROR HANDLING CONSTUCTS ! -------------------------------- Macro ERROR(A,B,C,D)=ERRORR(D,C,B,A) %; Forward Routine RUNC : Novalue; !I. GENERAL: ! ! 1. THIS ROUTINE WRITES AN ERROR MESSAGE, ATTEMPTS TO ! TO GET BACK INTO CONTEXT AFTER AN ERROR, AND ! RECORDS THAT AN ERROR HAS OCCURRED. ! ! 2. PARAMETERS: ! ! A. NUM - ERROR NUMBER; THIS IS JUST PASSED BY ! THIS ROUTINE TO 'ERRPRNT'. ! ! B. TYPE - TYPE OF CLOSING BRACKET REQUIRED TO ! RECOVER FROM ERROR. (SEE PART II.1.C) ! ! C. POS - POSITION OF ERROR; JUST PASSED TO ! 'ERRPRNT'. ! ! D. LASTOPEN - LOCATION OF THE LAST GOOD OPEN ! BRACKET. ! ! 3. EXTERNAL ROUTINES USED: ! ! A. ERRPRNT - ROUTINE TO PRINT ERROR MESSAGE. ! ! B. RUND - ROUTINE TO MOVE THE WINDOW. ! ! C. RUNC - ROUTINE FOR PROCESSING UNTIL ERROR ! RECOVERY. IGNORES MOST PROCESSING. ! !II. SPECIFIC: ! ! 1. * ! ! A. WRITE AN ERROR MESSAGE. ! ! B. SKIP TO THE FIRST CLOSING BRACKET, ! DISREGARDING ALL SYNTAX ANALYSIS AT THE ! LEVEL AT WHICH THE ERROR OCCURRED. NOTE ! HOWEVER, THAT IF AN OPEN BRACKET IS ! SPOTTED WHILE SKIPPING, THEN WE WILL ! PROCESS WHATEVER IS WITHIN THE SET OF ! BRACKETS (THE OPEN BRACKET SPOTTED AND ITS ! MATCHING CLOSING BRACKET), AND KEEP SKIPPING ! AFTER THAT IS PROCESSED. ! ! C. NOW THERE ARE THREE DISTINCT CASES WHICH WE ! CAN PERFORM DEPENDING ON THE PARAMETER 'TYPE' ! ! 1. DON'T DO ANY MORE SKIPPING, AND ! ATTEMPT TO KEEP GOING. ! ! 2. KEEP SKIPPING OVER THINGS IN THE SAME ! WAY AS ABOVE, UNTIL WE SEE EITHER ! A ';' OR ')'. ! ! 3. KEEP SKIPPING UNTIL WE SEE EITHER ! A ';' OR 'END'. Global Routine ERRORR(NUM,TYPE,POS,LASTOPEN) : Novalue = Begin Bind PANICSTOP = Uplit Long ( TK_SEMICOLON,TK_RPAREN,-1, ! BETWEEN '(' AND ')' (BLOCK) TK_SEMICOLON,TK_END,-1, ! BETWEEN 'BEGIN' AND 'END' TK_OF,-1,-1, ! BETWEEN 'CASE' (OR 'SELECT') AND 'OF' TK_TES,-1,-1, ! MISSING 'OF' OR 'SET' TK_TES,TK_SEMICOLON,-1, ! BETWEEN 'SET' AND 'TES' TK_TESN,-1,-1, ! MISSING 'OF' OR 'NSET' TK_TESN,TK_COLON,TK_SEMICOLON,! BETWEEN 'NSET' AND 'TESN' TK_ELBANE,TK_COLON,TK_SEMICOLON,! BETWEEN 'ENABLE' AND 'ELBANE' TK_COMMA,TK_SEMICOLON,-1, ! BETWEEN '[' AND ';' TK_COMMA,TK_RBRACKET,-1, ! BETWEEN ';' (OR '[') AND ']' TK_COMMA,TK_RPAREN,-1, ! BETWEEN '(' AND ')' ! (ROUTINE CALL OR PLIT) TK_RPAREN,-1,-1, ! BETWEEN '(' AND ')' ! (LINKAGE DECLARATION) ! OR MISSING ')' IN BLOCK TK_DO2,-1,-1, ! BETWEEN 'INCR' (OR 'DECR' OR ! 'WHILE' OR 'UNTIL') AND 'DO' TK_WHILE2,TK_UNTIL2,-1, ! BETWEEN 'DO' AND 'WHILE' (OR 'UNTIL') TK_THEN,-1,-1, ! BETWEEN 'IF' (OR 'LENGTH') AND 'THEN' TK_CRAT,-1,-1, ! BETWEEN 'CREATE' AND 'AT' TK_LENGTH,-1,-1, ! BETWEEN 'AT' AND 'LENGTH' TK_SEMICOLON,-1,-1, ! IN DECLARATIONS TK_RANGLE,-1,-1, ! IN STRUCTURE EXPANSION TK_END,-1,-1 ) ! MISSING 'END' : Vector[,Long]; Local SAVERL : Integer; SAVERL = .ERRLEVEL; ERRPRNT(.LASTOPEN,.POS,.NUM); ERRLEVEL = 1; RUNC(TRUE); While Not .flg_eof And .TYPE Neq 0 And .DEL Neq .PANICSTOP[.TYPE*3+0] And .DEL Neq .PANICSTOP[.TYPE*3+1] And .DEL Neq .PANICSTOP[.TYPE*3+2] Do Begin RUND(QL_LEXEME); RUNC(FALSE) End; ERRLEVEL = .SAVERL; Return 1 !NOT SURE THIS IS USEFUL End; !I. GENERAL: ! ! 1. THIS ROUTINE IS CALLED WHEN AN ERROR IS ENCOUNTERED. ! IT RUNS ALONG AT THE SAME LEVEL AS THE ERROR WAS ! FOUND AT, IGNORING THINGS UNTIL IT THINKS IT ! CAN GET BACK INTO CONTEXT. ! !II. SPECIFIC: ! ! 1. * ! ! A. KEEP READING AND MOVING THE WINDOW UNTIL ! ONE OF THREE (3) CASES HOLDS, WHEN PROCESSING ! WILL CONTINUE: ! ! 1.IF A ' = ' IS FOUND. IN THIS CASE, WE ! NOW KNOW WHERE THE VALUE OF THE ! EXPRESSION WILL BE, AND WE CAN ! RESUME PROCESSING AT THE LEVEL ! WHERE THE ERROR OCCURRED. ! ! 2. IF WE FIND THE MATCHING CLOSE ! BRACKET WHICH EXITS THE LEVEL WHERE ! THE ERROR WAS FOUND (IE, THE BRACKET ! WHICH MATCHES THE OPEN BRACKET FOR ! THIS LEVEL. ! ! 3. IF WE SEE AN OPEN BRACKET, THEN WE ! CAN PROCESS EVERYTHING WITHIN ! THAT BRACKET AND ITS MATCHING CLOSE, ! AT A LEVEL ONE DEEPER THAN THE ! LEVEL AT WHICH THE ERROR OCCURRED. ! WHEN WE RETURN FROM PROCESSING THE ! BRACKET PAIR, WE AGAIN SKIP UNTIL ONE ! OF THESE CONDITIONS IS SATISFIED. Routine RUNC(FIRSTRUNC : Boolean) : Novalue = Begin Local DUMMY; Label aaa; While TRUE Do Case .DEL From 0 To 3 Of Set [0]: ! OPENBRAC aaa: Begin If .FIRSTRUNC Then If .DEL Eql TK_MODULE Or .DEL Eql TK_RETURN Or .DEL Eql TK_EXITLOOP Then Begin RUND(QL_LEXEME); Leave aaa End; ERRLEVEL = 0; If .INDECL Then Selectone .DEL Of Set [TK_LPAREN]: SPLITB(DUMMY); [TK_LBRACKET]: Begin Do (RUND(QL_LEXEME); EXPRESSION()) Until .DEL Eql TK_RBRACKET; RUND(QL_LEXEME) End; [TK_LANGLE]: Begin Do (RUND(QL_LEXEME); EXPRESSION()) Until .DEL Eql TK_RANGLE; RUND(QL_LEXEME) End; [Otherwise]: XCTSYNTAX Tes Else XCTSYNTAX; ERRLEVEL = 1 End; [1]: ! OP If .DEL Eql TK_STORE Then Return Else RUND(QL_LEXEME); [2]: ! CLOBRAC Return; [3]: ! DCLRTR Begin ERRLEVEL = 0; ERRDECL(); ERRLEVEL = 1 End Tes End; Routine SERROROP : Novalue = Begin ERROR(.pos_del,.pos_del,.LASTEND,NOOPERATOR) End; Routine SMODERR : Novalue = Begin ERROR(.pos_del,.pos_del,.LASTEND,ERSYINVMDEC) End; Global Routine RUNDE= Begin RUND(QL_LEXEME); If .SYM Neq TK_EMPTY Then Begin ERROR(.pos_sym,.pos_sym,.LASTEND,ERSYMFOL); Return TRUE End Else Return FALSE End; ! GENERAL SYNTAX ROUTINES ! ----------------------- ! UTILITY BOOLEAN ROUTINES Routine SEFOLLOWS = Begin Return .DEL And (.SYM Eql TK_EMPTY Xor .DEL) End; Routine AEFOLLOWS = Begin Return .DEL And (.SYM Eql TK_EMPTY Xor .DEL) End; Global Routine RNAMEFOLLOWS(RNAME : Ref ST) : Novalue = Begin Local SAVEBLOCK : Vector[10]; Bind SAVEPLIT = Uplit Long ( flg_enable, CURROUT, LASTPUR, RBLOCKLEVEL, MAXLOCALS, NUMPARMS, MAXPARMS, NEXTLOCAL, LEVELINC, TNCHAIN) : Vector[,Long]; INIT; Incr I From 0 To 9 Do SAVEBLOCK[.I] = ..SAVEPLIT[.I]; LASTPUR = .PURGED; flg_enable = 0; TNCHAIN[itm_llink] = TNCHAIN; TNCHAIN[itm_rlink] = TNCHAIN; NEXTLOCAL = 0; MAXLOCALS = 0; NUMPARMS = 0; MAXPARMS = 0; BLOCKLEVEL = RBLOCKLEVEL = .BLOCKLEVEL+1; If PROCPARMS(.RNAME) Then Begin If .DEL Neq TK_EQUAL Then ERROR(.pos_open,.pos_del,.LASTEND,ERREQRDEC) Else Begin CURROUT = .RNAME; MARKELSTK(); RUEXPUSH(FBODY0); LASTELMARK = POPELSTK(); PUSH(LEXOUT(T_SYMBOL,.RNAME)); If .DEL Eql TK_COMMA Then FSYMPROTECT(); BLOCKPURGE(); GETNCSE(); FIN(OP_ROUTINE,FBODY1); GENIT(); CLEANUPFLOW() End End; Incr I From 0 To 9 Do .SAVEPLIT[.I] = .SAVEBLOCK[.I] End; !I. GENERAL: ! ! 1. THIS ROUTINE PRODUCES A TREE FOR AN EXPRESSION. ! ! 2. ON EXIT, A CLOSE BRACKET OF SOME FORM IS IN DEL. ! ! 3. THE LEXEME FOR THE VALUE OF THE EXPRESSION IS IN SYM. ! !II. SPECIFIC: ! ! 1. * ! ! A. IF WE SEE A COLON (':'), THEN TRY TO ! PROCESS A LABEL, AND IF IT IS A LABEL, ! RETURN. ! ! B. DO THE FOLLOWING THINGS FOR SYNTAX ANALYSIS ! UNTIL WE COME TO A CLOSING BRACKET: ! ! 1. IS THERE AN ARBITRARY EXPRESSION ! FOLLOWING? ! ! A. YES- THEN PROCESS THE SYNTAX ! OF THE EXPRESSION FOLLOWING. ! ! B. NO- GIVE ONE OF TWO (2) ! ERRORS: ! ! 1. 'DCLTRTR'- ! DECLARATOR ERROR. ! ! 2. 'EXPRERR'- EXPRESSION ! ERROR. Global Routine EXPRESSION : Novalue = Begin LINIT; INEXP; If .DEL Eql TK_COLON And .SYM Eql T_SYMBOL And .SYM[gt_type] Neq S_LABEL Then Begin SLABEL(); RESINDECL; Return End; While .DEL Neq CLOBRAC Do Begin If AEFOLLOWS() Then XCTSYNTAX Else If .DEL Eql DCLRTR Then Begin ERRPRNT(.pos_open,.pos_del,DCLERR); Do Begin ERRDECL(); RUND(QL_LEXEME) End Until .DEL Neq DCLRTR End Else ERROR(.pos_open,.pos_del,.LASTEND,EXPRERR) End; RESINDECL; pos_good = .pos_del End; ! PARSE BLOCK BEGIN & END NAMES ! ! SYNTAX: BEGIN \GORP\ ... END \GORP\ ! (\GORP\ ... )\GORP\ ! ! ARGUMENTS: ! DEST - POINTS TO A PLACE TO STORE THE NAME THAT IS SEEN ! ISBEGIN - TRUE AFTER BEGIN OR '('; FALSE AFTER END OR ')'. Routine GETBLOCKNAME(DEST,ISBEGIN) : Novalue = Begin .DEST = 0; If .DEL Neq TK_BACKSLASH Then Return; If .SYM Neq TK_EMPTY Then Begin ERROR(.pos_open,.pos_sym,.LASTEND,ERINVBNSYN); Return End; RUND(QL_NAME); If .SYM Eql T_NAME Then SYM = LEXOUT(T_SYMBOL,.SYM[nt_symb]) Else If .SYM Neq T_SYMBOL Then Begin ERROR(.pos_open,.pos_sym,.LASTEND,ERINVBNARG); Return End; If .DEL Neq TK_BACKSLASH Then Begin ERROR(.pos_open,.pos_del,.LASTEND,ERINVBNSYN); Return End; .DEST = .SYM; If .ISBEGIN Then RUND(QL_LEXEME) Else RUNDE() End; !I.GENERAL: ! ! 1. THIS ROUTINE PROCESSES A COMPOUND EXPRESSION OR ! BLOCK. ! ! 2. IT PROCESSES ANY DECLARATIONS WITHIN THE BLOCK. ! ! 3. IT PROCESSES ANY EXPRESSIONS WITHIN THE ! COMPOUND EXPRESSION OR BLOCK. ! ! 4. IT LEAVES THE WINDOW IN THE PROPER POSITION ON ! EXIT. ! ! 5. DO ANY NECESSARY BLOCK CLEANUP WORK, IF THIS WAS ! A BLOCK. ! !II.SPECIFIC: ! ! 1. * ! ! A. REMEMBER THE OPENING BRACKET TYPE. ! ! B. NEXT SEE IF WE HAVE A DECLARATION EXPRESSION ! IMMEDIATELY FOLLOWING THE OPEN BRACKET. ! ! 2. * ! ! A. IF WE HAVE A DECLARATION, THEN INCREMENT ! THE BLOCK LEVEL AND CALL 'DECLARE' TO PROCESS ! ALL THE DECLARATIONS FOR THAT BLOCK. ! ! 3. * ! ! A. THEN DO THE FOLLOWING UNTIL WE HAVE FOUND ! THE CLOSING BRACKET WHICH MATCHES THE OPEN ! ONE FROM [1.A]. ! ! 1. MOVE THE WINDOW, PROCESS AN ! EXPRESSION, AND PUSH THE ! RESULTING LEXEME. ! 2. IF THE DELIMITER NOW DOES NOT MATCH ! THE OPEN BRACKET, AND IT IS NOT A ! SEMICOLON ';', THEN WE HAVE AN ERROR ! CONDITION RESEMBLING THE FOLLOWING: ! ! BEGIN X;Y = .Z+3) ! ! 4. * ! ! A. IF THE FUTURE SYMBOL IS EMPTY, THEN WE ! MUST MOVE THE WINDOW. ! ! 5. * ! ! A. IF WE HAD ANY DECLARATIONS ABOVE IN ! [2.A] THEN WE HAVE OPENED A BLOCK, ! AND WE NOW CALL 'BLOCKPURGE' TO CLOSE IT. Routine SCOMPOUND : Novalue = Begin Local DCLR, BNAME : Boolean, ENAME : Boolean, SAVEND, SAVEBLOCK : Vector[8], WHICHTYPE; Literal SAVLAB = 7; Bind SAVEPLIT = Uplit Long (ENABFLG, INDECL, NEXTLOCAL) : Vector[,Long], XSAVEPLIT = Uplit Long (NOTREE, FLAGS, sym_vector, sym_bliss, COMPLAB) : Vector[,long], PSTYPE = Uplit Byte (PSENDSEM,PSPARSEM) : Vector[,Byte], SPSTYPE = Uplit Byte (PSEND,PSPAR) : Vector[,Byte], CLOSEDEL = Uplit Long (TK_END,TK_RPAREN) : Vector[,Long], XCLOSEDEL = Uplit Long (TK_RPAREN,TK_END) : Vector[,Long]; INIT; Incr I From 0 To 2 Do SAVEBLOCK[.I] = ..SAVEPLIT[.I]; ENABFLG = FALSE; ! 0 FOR BEGIN, 1 FOR LEFT PAREN WHICHTYPE = .DEL; NEWLASTEND(.PSTYPE[.WHICHTYPE]); RUND(QL_LEXEME); GETBLOCKNAME(BNAME,TRUE); DCLR = (.DEL Eql DCLRTR); If .DCLR Then Begin Incr I From 0 To 4 Do SAVEBLOCK[.I+3] = ..XSAVEPLIT[.I]; DCLARE(); MARKMMNODES() End; F29(); While TRUE Do Begin EXPUSH(FNULL); If .DEL Neq TK_SEMICOLON Then Exitloop; MARKMMNODES(); RUND(QL_LEXEME) End; If .DCLR Then Begin If .DEL Neq .CLOSEDEL[.WHICHTYPE] Then FSYMPROTECT(); BLOCKPURGE(); Incr I From 0 To 3 Do .XSAVEPLIT[.I] = .SAVEBLOCK[.I+3] End; If .NEXTLOCAL Gtr .MAXLOCALS Then MAXLOCALS = .NEXTLOCAL; If .flg_eof Then Begin DEL = .CLOSEDEL[.WHICHTYPE]; ERRPRNT(.pos_open,.pos_open,ERMSEND); ERRLEVEL = 1 End Else If .DEL Neq .CLOSEDEL[.WHICHTYPE] Then If .DEL Eql .XCLOSEDEL[.WHICHTYPE] Then Return ERRPRNT(.pos_open,.pos_del,BRACERR) Else ERROR(.pos_open,.pos_del,.SPSTYPE[.WHICHTYPE],ERMSEND); RESLASTEND; SAVEND = .pos_del; RUNDE(); GETBLOCKNAME(ENAME,FALSE); If (.BNAME Or .ENAME) Neq 0 Then If .BNAME Neq .ENAME Then Begin ERRINFO[0] = .BNAME; ERRINFO[1] = .ENAME; WARNEM(.SAVEND,WABLKMTCH) End; If .ENABFLG Then Begin FIN(TK_COMPOUND2,FNULL); SYM[gt_v_enable] = TRUE; PUSH(.SYM); POSTRUEX(FLAB0); SELABEL(.COMPLAB); FIN(TK_LABUSE,FENABLAB); COMPLAB[st_lab_node] = .SYM; COMPLAB[st_lab_left] = TRUE; COMPLAB = .SAVEBLOCK[SAVLAB]; POPELSTK(); End Else If .TOS-.LASTMARK Gtr 1 Then FIN(TK_COMPOUND,FNULL) Else XFIN(0,FNULL); Incr I From 0 To 2 Do .SAVEPLIT[.I] = .SAVEBLOCK[.I] End; !I.GENERAL: ! ! 1. THE OPERATOR IS IN 'DEL' ON ENTRY. ! ! 2. SEE IF THE OPERATION IS LEGAL. ! ! 3. TEST PRIORITIES BETWEEN THE OPERATOR ! IN 'DEL' AND THAT IN 'FUTDEL' AND DO ! THE APPROPRIATE THINGS. ! ! 4. FINISH THE OPERATION WITH THE OPERATOR IN 'DEL'. ! !II.SPECIFIC: ! ! 1. * ! ! A. SAVE THE OPERATOR FROM 'DEL' IN 'OP'. ! ! 2. * ! ! A. IF THE SYMBOL IS EMPTY AND THE OPERATOR IS ! BINARY THEN THERE IS A MISSING OPERAND: ! ! XX YY+ASDF; ! ! ALSO IF THE SYMBOL IS NON-EMPTY AND THE ! OPERATOR IS UNARY, THEN WE HAVE AN EXTRA ! OPERAND. ! ! B. IF THE OPERATOR IS BINARY, THEN SAVE THEN ! '.SYM' AS THE FIRST OPERAND OF THE ! BINARY OPERATOR. ! ! 3. * ! ! A. WHILE THE PRIORITY OF THE NEXT OPERATOR IS ! LESS THAN THAT OF THE OPERATOR SAVED ON ! ON ENTRANCE, WE MUST PERFORM THE ! APPROPRIATE SYNTAX WORK IN ORDER TO ! PROCESS THE RIGHT HAND OPERAND FOR THE ! OPERATOR ON ENTRANCE. ! ! 4. * ! ! A. NOW WE'VE COMPUTED THE RIGHT HAND SIDE OF ! THE OPERATOR, AND WE HAVE THIS IN 'SYM', ! SO WE PUSH 'SYM' ONTO THE STACK AND GENERATE ! A NODE FOR THE OPERATION WITH ITS TWO (2) ! OPERANDS IF BINARY, OR WITH ONE IF UNARY. Routine SOPERATOR : Novalue = Begin Local OP : Integer, AOFLAG : Boolean; INIT; OP = .DEL; If (.SYM Eql TK_EMPTY) Xor (Not .OP) Then Begin WARNEM(.pos_del,OPERR1); SYM = ZERO End; If .OP Then PUSH(.SYM); AOFLAG = (.OP Eql TK_AND Or .OP Eql TK_OR); ! KLUDGE TO PREVENT CSE CREATION IN FLOW BOOLEANS. If .AOFLAG Then F0(); RUND(QL_LEXEME); While (.DEL Leq .OP) Do Begin If .DEL Eql .OP Then If Not .OP Then Exitloop; If SEFOLLOWS() Then XCTSYNTAX Else ERROR(.pos_open,.pos_del,.LASTEND, If Not .DEL Then OPERR2 Else OPERR3) End; If .SYM Eql TK_EMPTY Then Begin ERROR(.pos_open,.pos_del,.LASTEND,OPERR4); Return End; PUSH(.SYM); FIN(.OP,FNULL); ! KLUDGE TO PREVENT CSE CREATION IN FLOW BOOLEANS. If .AOFLAG Then F14() End; ! !SYNTAX: IF E1 THEN E2 ELSE E3 ! IF E1 THEN E2 ! !I.GENERAL: ! ! 1. THIS ROUTINE PROCESSES AN IF STATEMENT. ! ! 2. GENERATE A TREE FOR E1 ! ! 3. GENERATE A TREE FOR E2 IF 'THEN' APPEARS. ! ! 4. IF 'ELSE' SPOTTED, THEN GENERATE A TREE FOR E3. ! !II. SPECIFIC: ! ! 2. * ! ! A. MOVE THE WINDOW AND GENERATE A TREE FOR ! THE EXPRESSION E1; PUSH THE RESULTING LEXEME ! ONTO THE STACK. ! ! 3. * ! ! A. IF NO 'THEN', THEN THERE IS AN ERROR, ! AND WE RETURN. ! ! B. OTHERWISE, MOVE THE WINDOW, AND PROCESS THE ! EXPRESSION FOR E2; PUSH THE RESULTING LEXEME ! ON THE STACK. ! ! 4. * ! ! A. IF WE HAVE NO 'ELSE', THEN PUSH A SPECIAL ! ZERO LEXEME ONTO THE STACK, OTHERWISE AGAIN ! MOVE THE WINDOW AND CALCULATE THE LEXEME ! RESULTING FROM THE EXPRESSION E3, AND PUSH ! THAT LEXEME ONTO THE STACK. Routine SIF : Novalue = Begin Local C1,C2; INIT; NEWLASTEND(PSTHEN); RUEXPUSH(FIF0); SYM = STK[.TOS] = BINDBIND(.SYM); C1 = (.SYM Eql T_LITERAL); If .C1 Then Begin If .num_error Eql 0 Then Begin F28(); RELLST(.STK[.TOS-1]); STK[.TOS-1] = .STK[.TOS]; TOS = .TOS-1 End; C2 = .SYM; If Not .C2 Then NOCODE End; RESLASTEND; If .DEL Neq TK_THEN Then Begin ERROR(.pos_open,.pos_del,.LASTEND,IFERR); Return End; If .C1 Then RUEXPUSH(FNULL) Else RUEXPUSH(FIF1); If .C1 Then If .C2 Then NOCODE Else RESNOTREE; If .DEL Neq TK_ELSE Then CONSTPUSH(ZERO,FIF2) Else If .C1 Then RUEXPUSH(FNULL) Else RUEXPUSH(FIF2); If .C1 Then Begin If .C2 Then RESNOTREE; XFIN(2-.C2<0,1>,FCIF) End Else FIN(TK_IF,FIF3) End; ! !SYNTAX: WHILE E1 DO E2 ! UNTIL E1 DO E2 ! !I. GENERAL: ! ! 1. THIS ROUTINE PROCESSES LOOPING CONSTRUCTS OF THE ! ABOVE SYNTAX FORMS. ! ! 2. GENERATE A TREE FOR E1. ! ! 3. GENERATE A TREE FOR E2. ! ! 4. FINISH UP THE 'LOOP' TREE. ! !II. SPECIFIC: ! ! 1. * ! ! A. WE MUST SAVE THE TYPE OF LOOP THIS IS: ! 'WHILE' OR 'UNTIL'. ON ENTRANCE, THIS ! IS IN 'DEL', AND WE SAVE IT IN THE ! LOCAL 'SWUTYPE'. ! ! 2. * ! ! A. MOVE THE WINDOW, PROCESS THE EXPRESSION E1, ! AND PUSH ITS LEXEME ONTO THE STACK. ! ! 3. * ! ! A. IF NO 'DO' APPEARS NEXT, THEN WE HAVE AN ERROR. ! ! B. MOVE THE WINDOW AGAIN AND PROCESS THE ! EXPRESSION E2; PUSH ITS LEXEME ONTO THE STACK. Routine SWU : Novalue = Begin Local SWUTYPE; INIT; NEWLASTEND(PSDO); SWUTYPE = .DEL; LOOPDEPTH = .LOOPDEPTH+1; RUEXPUSH(FWUD0); RESLASTEND; If .DEL Neq TK_DO2 Then Begin ERROR(.pos_open,.pos_del,.LASTEND,WUERR); Return End; RUEXPUSH(FWUD1); LOOPDEPTH = .LOOPDEPTH-1; MARKSTK(); FIN(TK_NULL,FNULL); PUSH(.SYM); FIN(.SWUTYPE,FWUD2) End; ! !SYNTAX: DO E1 WHILE E2 ! DO E1 UNTIL E2 ! !I. GENERAL: ! ! 1. THIS ROUTINE PROCESSES LOOPING CONSTRUCTS OF THE ! ABOVE SYNTAX FORMS. ! ! 2. GENERATE A TREE FOR E1. ! ! 3. GENERATE A TREE FOR E2. ! ! 4. FINISH UP THE 'LOOP' TREE. ! !II. SPECIFIC: ! ! 2. * ! A. MOVE THE WINDOW, PROCESS E1, AND PUSH THE ! LEXEME FOR E1 ONTO THE STACK. ! ! 3. * ! ! A. IF WE DON'T HAVE A 'WHILE' OR 'UNTIL' NEXT, ! THEN RETURN AN ERROR. ! ! B. OTHERWISE, REMEMBER WHETHER WE HAD ! A 'WHILE' OR 'UNTIL' IN THE LOCAL ! 'SDOTYPE'. ! ! C. PROCESS E2, AND PUSH ITS LEXEME. Routine SDO : Novalue = Begin Local SDOTYPE; INIT; NEWLASTEND(PSWU); LOOPDEPTH = .LOOPDEPTH+1; RUEXPUSH(FDWU0); RESLASTEND; If .DEL Neq TK_WHILE2 And .DEL Neq TK_UNTIL2 Then Begin ERROR(.pos_open,.pos_del,.LASTEND,DOERR); Return End; SDOTYPE = .DEL; RUEXPUSH(FDWU1); LOOPDEPTH = .LOOPDEPTH-1; MARKSTK(); FIN(TK_NULL,FNULL); PUSH(.SYM); FIN(.SDOTYPE,FDWU2) End; ! !SYNTAX: INCR DO ! DECR DO ! ! ::= / FROM ! ::= / TO ! ::= / BY ! !I. GENERAL: ! ! 1. THIS ROUTINE PROCESSES 'INCR' AND 'DECR' ! STATEMENTS OF THE ABOVE SYNTAX FORMS. ! ! 2. PROCESS , , AND ONE AT A ! TIME, AND USE DEFAULTS IF THEY ARE NOT SPECIFIED. ! ! 3. FINISH THE 'INCR' OR 'DECR' EXPRESSION. ! !II. SPECIFIC: ! ! 1. * ! ! A. SAVE EITHER 'INCR' OR 'DECR' AS TYPE OF LOOP ! CONSTRUCT. ! ! B. DECLARE THE LOOP INDEX VARIABLE AS A REGISTER ! ! 2. * ! ! A. IF NO 'FROM', THEN USE THE DEFAULT VALUE, ! OTHERWISE ANALYZE THE 'FROM' EXPRESSION, ! AND PUSH THE RESULTING LEXEME. ! ! B. IF NO 'TO', THEN USE THE DEFAULT VALUE, ! OTHERWISE ANALYZE THE 'TO' EXPRESSION, AND ! PUSH THE RESULTING LEXEME. ! ! C. IF NO 'BY', THEN USE THE DEFAULT, OTHERWISE ! ANALYZE THE 'BY' EXPRESSION, AND PUSH THE ! RESULTING LEXEME ONTO THE STACK. ! ! 3. * ! ! A. WE SHOULD NOW SEE 'DO'. IF WE DON'T, ! THEN GIVE AN ERROR AND RETURN. ! ! B. OTHERWISE, ANALYZE THE EXPRESSION FOLLOWING ! THE 'DO', AND PUSH ITS LEXEME. ! ! C. FINALLY, MAKE THE 'LOOP' NODE. Routine SREP : Novalue = Begin Local L1,L2, SREPTYPE, EXECUTE, FROMPART, TOPART; INIT; SREPTYPE = .DEL; If Not INCRDECRREG() Then Return; QNATOLEX(); PUSH(.SYM); NEWLASTEND(PSDO); If .DEL Neq TK_FROM Then PUSH(DFROM) Else RUEXPUSH(FID00); FROMPART = .STK[.TOS]; If .DEL Neq TK_TO Then PUSH(If .SREPTYPE Neq TK_DECR Then DTOI Else DTOD) Else RUEXPUSH(FID00); TOPART = .STK[.TOS]; EXECUTE = TRUE; If .FROMPART Eql T_LITERAL And .TOPART Eql T_LITERAL Then Begin FROMPART = .FROMPART; TOPART = .TOPART; If (If .SREPTYPE Eql TK_INCR Then .FROMPART Gtr .TOPART Else .FROMPART Lss .TOPART) Then Begin EXECUTE = FALSE; If .num_error Eql 0 Then TOS = .TOS-3 End End; If .DEL Neq TK_BY Then PUSH(DBY) Else RUEXPUSH(FID00); RESLASTEND; If .DEL Neq TK_DO2 Then Begin ERROR(.pos_open,.pos_del,.LASTEND,REPERR2); Return End; If .EXECUTE Then Begin LOOPDEPTH = .LOOPDEPTH+1; RUEXPUSH(FID0); LOOPDEPTH = .LOOPDEPTH-1; End Else Begin NOCODE; RUEXPUSH(FNULL); RESNOTREE; STK[.TOS] = MINONE; End; BLOCKPURGE(); If .EXECUTE Then FIN(.SREPTYPE,FID1) Else FIN(TK_COMPOUND,FNULL) End; Routine DC= ! CALLED BY STRUPICKOFF,SSQOPEN Begin Local P : Ref GT; SYM = BINDBIND(.SYM); If .SYM Neq T_NODE Then Return -1; P = .SYM[gt_csparent]; P[gt_occ] = .P[gt_occ] - 1; Return .P[gt_occ] End; Global Routine STRUPICKOFF(CLOSEDEL, ACTUALS : Ref Vector, MAXSIZE, DEFAULT, F_LIT) : Novalue = Begin Macro CLOSEBRACKET=(.DEL Eql .CLOSEDEL) %; Local INDEX, RUNDAGAIN, FILLAGAIN; LINIT; INDEX = 0; RUNDAGAIN = Not CLOSEBRACKET; FILLAGAIN = .MAXSIZE Neq 0; NEWLASTEND((If .CLOSEDEL Eql TK_RBRACKET Then PSCOMSQBC Else PSCOMSEM)); Do Begin If .RUNDAGAIN Then Begin RUND(QL_LEXEME); If (.SYM Eql TK_EMPTY) And (CLOSEBRACKET Or (.DEL Eql TK_COMMA)) Then Begin If CLOSEBRACKET Then RUNDAGAIN = FALSE; SYM = .DEFAULT End Else Begin If Not .FILLAGAIN And .MANYACTS Eql 0 Then Begin WARNEM(.pos_sym,ERXACTS); MANYACTS<1,1> = 1 End; EXPRESSION(); DC(); If .F_LIT Then Begin If .SYM Neq T_LITERAL Then Begin WARNEM(.pos_sym,ERMBADEXP); SYM = .DEFAULT End; unit_size = .unit_size * .SYM End; If CLOSEBRACKET Then RUNDAGAIN = FALSE Else If .DEL Neq TK_COMMA Then Begin ERROR(.pos_open,.pos_del,RESLASTEND,ERMAPLD); Return End End End Else SYM = .DEFAULT; If .FILLAGAIN Then Begin FILLAGAIN = .INDEX Lss (.MAXSIZE-1); ACTUALS[.INDEX] = .SYM; INDEX = .INDEX+1 End End While .FILLAGAIN Or .RUNDAGAIN; MANYACTS<1,1> = 0; RESLASTEND End; Routine SSQOPEN : Novalue = Begin Local STRUCT : Ref ST, INCACTS : Ref Vector, ACTUALS : Ref Vector, NUMACTS : Integer, BYTESVAL : Integer, SVMNACTS : Integer; ! actuals structure: ! ! wd 0 strm_size ! wd 1 strm_next ! wd 2 -> structure ! wd 3 byte size ! wd 4-n accessors ! wd n-m initializers Macro GETACTSPACE= Begin NUMACTS = .STRUCT[st_str_argc]; ACTUALS = GETSPACE(2*.NUMACTS+4); ACTUALS[strm_size] = 2*.NUMACTS+2; ACTUALS[strm_next] = 0 End %; INCACTS = 0; SVMNACTS = .MANYACTS; MANYACTS = 0; If ( If .SYM Neq T_SYMBOL Then Begin STRUCT = .sym_vector; BYTESVAL = LITLEXEME(2); TRUE End Else Begin If .SYM[gt_type] Eql S_STRUCTURE Then Begin STRUCT = .SYM; GETACTSPACE; RUND(QL_LEXEME); BYTESVAL = LITLEXEME(2); Selectone .DEL Of Set [TK_BYTE]: If .SYM Eql TK_EMPTY Then Begin BYTESVAL = ONE; RUND(QL_LEXEME) End; [TK_WORD]: If .SYM Eql TK_EMPTY Then RUND(QL_LEXEME) Tes; EXPRESSION(); If DC() Eql 0 Then SYM = .SYM[gt_csparent]; ACTUALS[2] = .SYM; ACTUALS[3] = .BYTESVAL; STRUPICKOFF(TK_SEMICOLON,ACTUALS[4],.NUMACTS,ONE,FALSE); FALSE End Else Begin BYTESVAL = LITLEXEME(BYTES(SYM)); MANYACTS<0,1> = .SYM[st_v_unlim_acts]; If .SYM[st_v_no_acts] Then STRUCT = (If .SYM[st_var_actuals] Eql 0 Then .sym_vector Else .SYM[st_var_actuals]) Else Begin INCACTS = .SYM[st_var_actuals]; STRUCT = .INCACTS[STRUCF] End; TRUE End End ) Then Begin ! actuals: ! ! 2 = sym ! 3 = byte/word size ! 4-n = initial values ! n+1-m = actual values GETACTSPACE; If .INCACTS Eqla 0 Then Begin Incr I From 2 To .NUMACTS+1 Do ACTUALS[.I+2] = ONE; ACTUALS[3] = .BYTESVAL End Else MOVECORE(INCACTS[2],ACTUALS[3],.NUMACTS+1); If DC() Eql 0 Then SYM = .SYM[gt_csparent]; ACTUALS[2] = .SYM; End; STRUPICKOFF(TK_RBRACKET,ACTUALS[4+.NUMACTS],.NUMACTS,ZERO,FALSE); MANYACTS = .SVMNACTS; ESTRU(.STRUCT[st_str_body],.ACTUALS,.STRUCT,0); STRMRELEASE(.ACTUALS) End; ! !SYNTAX: SYM() ! SYM(E1,E2,...,EN) ! !I. GENERAL: ! ! 1. THIS ROUTINE PROCESSES FUNCTION CALLS ! ! 2. PROCESS ALL PARAMETERS. ! ! 3. EXIT WITH THE WINDOW IN THE CORRECT POSITION. ! !II. SPECIFIC: ! ! 0. * ! ! A. PUSH LEXEME FOR CORRECT LINKAGE. THE ! DEFAULT LINKAGE IS USED IN THE CASE THAT ! SYM IS A LITERAL OR GT LEXEME; IF SYM IS ! A BOUND VARIABLE LEXEME, IT CAN POINT TO ! EITHER A LINKAGE NAME OR A VARIABLE NAME. ! IN THE CASE OF A LINKAGE NAME, STEP 1 IS ! USED TO ACCOMPLISH THE PUSH; IN THE CASE OF A ! VARIABLE NAME, THE ST ENTRY'S LINKAGE NAME ! FIELD IS USED FOR THE LINKAGE. ! ! 1. * ! ! A. PUSH THE LEXEME IN 'SYM', SINCE THIS IS THE ! LEXEME FOR THE ROUTINE TO BE CALLED. ! ! 2. * ! ! A. IF THE FUTURE SYMBOL IS NON-EMPTY, OR ! THE FUTURE DELIMITER IS NOT ')', THAT IS ! WE DIDN'T HAVE A CONSTRUCT OF THE FORM: ! ! XXX() ! ! THEN DO THE FOLLOWING THINGS FOR EACH ! PARAMETER UNTIL WE SEE ')' : ! ! 1. MOVE THE WINDOW, PROCESS A ! PARAMETER EXPRESSION, AND PUSH THE ! RESULTING LEXEME. ! ! 2. CHECK TO MAKE SURE THAT EVERY ! PARAMETER IS FOLLOWED BY EITHER A ! ',' OR ')', WHERE ')' INDICATES ! THE END OF THE CALL. ! ! 3. MOVE THE WINDOW TO PROCESS THE NEXT ! PARAMETER. ! ! 3. * ! ! A. MOVE THE WINDOW PAST THE ')'. ! ! B. FINISH THE NODE FOR THE CALL. Routine SPAR : Novalue = Begin Local LNKG : Ref ST, RTNAME, SAVNP, LIMIT, PLENDED; INIT; PLENDED = FALSE; LIMIT = STKSIZE; ! SEE TN.BEG If .SYM Neq T_SYMBOL Then Begin LNKG = .sym_bliss; RTNAME = .SYM End Else Selectone .SYM[gt_type] Of Set [S_LINKAGE]: Begin LNKG = .SYM; If .SYM[st_lnk_type] Eql LNK_IOT Then RTNAME = ZERO ! IOT HAS NO ROUTINE 'NAME' Else Begin RUND(QL_LEXEME); EXPRESSION(); RTNAME = .SYM; PLENDED = (.DEL Eql TK_RPAREN) End End; [S_SPECIAL]: Begin If .SYM[st_which] Geq 4 Then ! SWAB,CARRY,OVERFLOW Begin SSPECIALOP(.SYM[st_which]-4); Return End; LNKG = LEXOUT(T_SYMBOL,.SYM[st_var_linkage]); RTNAME = .SYM; LIMIT = .ST[.LNKG[st_lnk_desc],parm_size]+.NUMPARMS End; [Otherwise]: Begin If Not ISEXP(SYM) Then Begin WARNEM(.pos_sym,BADSYMERR); RTNAME = ZERO; LNKG = .sym_bliss End Else Begin RTNAME = .SYM; LNKG = LEXOUT(T_SYMBOL,.SYM[st_var_linkage]) End End Tes; PUSH1(.LNKG); PUSH1(.RTNAME); NEWLASTEND(PSPARCOM); If Not .PLENDED Then Begin RUND(QL_LEXEME); If .SYM Eql TK_EMPTY Then If .DEL Eql TK_RPAREN Then PLENDED = TRUE End; If Not .PLENDED Then While 1 Do Begin MARKSTK(); If .NUMPARMS Eql .LIMIT Then Begin WARNEM(.pos_del,WATMPARMS); NOCODE End; EXPUSH(FCALL0); SYM = GENGT(TK_FPARM); PUSH(.SYM); NUMPARMS = .NUMPARMS+1; If .DEL Neq TK_COMMA Then Exitloop; RUND(QL_LEXEME) End; If .num_error Eql 0 Then Begin If .NUMPARMS Gtr .MAXPARMS Then MAXPARMS = .NUMPARMS; If .NUMPARMS Gtr .LIMIT Then Begin RESNOTREE; TOS = .TOS-(.NUMPARMS-.LIMIT); NUMPARMS = .LIMIT End; NUMPARMS = .NUMPARMS-(.TOS-.LASTMARK-2) End; RESLASTEND; If .DEL Neq TK_RPAREN Then Begin ERROR(.pos_open,.pos_del,.LASTEND,PARAERR); Return End; RUNDE(); FIN(TK_CALL,FCALL1); MARKSTK(); PUSH(.SYM); SYM = GENGT(TK_FSTORE) End; ! ! CALLED TO PARSE THE SPECIAL FUNCTIONS (AT PRESENT ! SWAB, CARRY, OVERFLOW AND M*P*). ! ! SYNTAX: () ! ! INDEX WILL BE: ! SWAB - 0 ! CARRY - 1 ! OVERFLOW - 2 ! MFPI - 3 ! MFPD - 4 ! MTPI - 5 ! MTPD - 6 ! Routine SSPECIALOP(INDEX) : Novalue = Begin Local TYPE; LINIT; If ONEOF(.INDEX,1,2) Then Begin WARNEM(.pos_sym,NOTIMPL); NOCODE End; NEWLASTEND(PSPAR); If ONEOF(.INDEX,1,2) Then RUEXPUSH(FCARRYOV0) Else RUEXPUSH(FNULL); RESLASTEND; If .DEL Neq TK_RPAREN Then Begin ERROR(.pos_open,.pos_del,.LASTEND,PARAERR); Return End; If .INDEX Geq 3 Then Begin PUSH(LITLEXEME(.INDEX-3)); INDEX = 3 End; RUNDE(); Case .INDEX From 0 To 3 Of Set [0]: FIN(TK_SWAB,FNULL); [1]: FIN(TK_CARRY,FCARRYOV1); [2]: FIN(TK_OVERFLOW,FCARRYOV1); [3]: FIN(TK_MOVP,FNULL) Tes; If ONEOF(.INDEX,1,2) Then RESNOTREE End; ! !SYNTAX: CASE OF SET TES ! ! ::= E1;E2;...;EN ! ::= E1;E2;...;EM ! !I. GENERAL: ! ! 1. THIS ROUTINE PROCESSES THE 'CASE' EXPRESSION ! WITH THE ABOVE SYNTAX FORM. ! ! 2. PROCESS 'CASE E1;E2;...;EN OF' FIRST. ! ! 3. PROCESS 'SET E1;E2;...;EM TES' NEXT. ! ! 4. GENERATE THE NODE FOR THE BODY OF THE 'SET-TES'. ! ! 5. GENERATE THE NODE FOR THE 'CASE' EXPRESSION. ! !II. SPECIFIC: ! ! 2. * ! ! A. CALL 'CASEL' TO PROCESS 'CASE E1;E2;...EN OF' ! ! B. IF THE 'CASE E1;...;EN OF' IS IN ERROR ! THEN RETURN WITH AN ERROR. ! ! 3. * ! ! A. IF 'SET' IS MISSING THEN ERROR RETURN. ! ! B. MARK THE STACK FOR THE BODY OF THE 'SET-TES'. ! ! C. PROCESS EACH EXPRESSION IN THE BODY UNTIL WE ! FIND A 'TES'. ! ! 1. MOVE THE WINDOW, PROCESS AN ! EXPRESSION, AND PUSH ITS LEXEME. ! ! 2. IF THE DELIMITER AFTER THE ! THE EXPRESSION IN THE BODY IS NOT ! ';' AND IT IS ALSO NOT 'TES', THEN ! RECORD AN ERROR AND RETURN. ! ! D. MOVE THE WINDOW FOR THE EXIT. ! ! 4. * ! ! A. CALL 'GENGT' TO GENERATE A GRAPH ! TABLE NODE FOR THE BODY OF THE 'SET-TES' ! ! B. THEN PUSH THE LEXEME RETURNED FOR THIS NODE ! ONTO THE STACK FOR THE 'CASE' EXPRESSION ! NODE TO BE GENERATED. ! ! 5. * ! ! A. FINISH THE NODE FOR THE 'CASE' EXPRESSION. Routine SCASE : Novalue = Begin Local C1,C2,T,SAVNDEL; INIT; NEWLASTEND(PSOF); MARKSTK(); ! get the case selector expression and multiply it by 2 using a shift RUEXPUSH(FNULL); PUSH(ONE); FIN(TK_SHIFT,FCASE0); PUSH(.SYM); ! note whether the case selector is a constant C1 = (.SYM Eql T_LITERAL); ! if a constant selector then release what we've collected and get ! get case index (undoing the shift above) If .C1 Then Begin If .num_error Eql 0 Then Begin F28(); RELLST(.STK[.TOS-1]); STK[.TOS-1] = .STK[.TOS]; TOS = .TOS-1 End; C2 = .SYM/2; T = -1; NOCODE End; LASTEND = PSTES; ! check for 'OF' and skip over it If .DEL Neq TK_OF Then Begin ERROR(.pos_open,.pos_del,.LASTEND,CASERR1); Return End; If RUNDE() Then Return; ! check for 'SET' and skip over it If .DEL Neq TK_SET Then Begin ERROR(.pos_open,.pos_del,.LASTEND,CASERR2); Return End; LASTEND = PSTESSEM; Until .DEL Eql TK_TES Do Begin If .C1 Then If (T = .T+1) Eql .C2 Then RESNOTREE; If .C1 Then RUEXPUSH(FNULL) Else RUEXPUSH(FCASE1); If .DEL Neq TK_SEMICOLON And .DEL Neq TK_TES Then Begin ERROR(.pos_open,.pos_del,(RESLASTEND),CASERR3); Return End; If .C1 Then If .T Eql .C2 Then NOCODE End; RESLASTEND; SAVNDEL = .pos_del; RUNDE(); If AEFOLLOWS() Then Begin ERROR(.pos_open,.SAVNDEL,.LASTEND,OPERR2); Return End; If .C1 Then Begin If .C2 Lss 0 Then C2 = 0; RESNOTREE; XFIN((.C2+1),FCCASE) End Else FIN(TK_CASE,FCASE2) End; ! !SYNTAX: SELECT ::= E1;E2;...;EN ! ::=E1:E2;E3:E4;...;EM:EL ! !I. GENERAL: ! ! 1. THIS ROUTINE GENERATES A TREE FOR THE 'SELECT' ! EXPRESSION WITH THE ABOVE SYNTAX. ! ! 2. PROCESS 'SELECT E1;E2;...;EN OF'. ! ! 3. NEXT PROCESS 'NSET E1:E2;...;EM:EN TESN'. ! ! 4. GENERATE THE NODE FOR THE BODY OF THE ! 'NSET-TESN' PART OF THE EXPRESSION. ! ! 5. GENERATE THE NODE FOR THE 'SELECT' EXPRESSION. ! !II. SPECIFIC: ! ! 2. * ! ! A. CALL 'CASEL' TO PROCESS 'SELECT E1;..EN OF'. ! ! B. IF THE 'SELECT' PART IS IN ERROR, THEN ! RETURN WITH AN ERROR. ! ! 3. * ! ! A. IF 'NSET' IS MISSING THEN RETURN WITH AN ! ERROR. ! ! B. MARK THE STACK FOR THE BODY OF THE ! 'NSET-TESN'. ! ! C. PROCESS EACH PAIR OF EXPRESSIONS IN THE ! BODY UNTIL WE SEE 'TESN'. ! ! 1. MOVE THE WINDOW. ! ! 2. IF WE SEE 'ALWAYS' OR 'OTHERWISE', ! THEN PUSH THAT SPECIAL LEXEME; ! OTHERWISE PROCESS AN EXPRESSION, ! AND PUSH ITS RESULTING LEXEME. ! ! 3. WE MUST HAVE A COLON (':') AFTER THE ! FIRST EXPRESSION OF THE PAIR. ! ! 4. PROCESS THE EXPRESSION AFTER ':'. ! ! 5. NOW WE MUST HAVE ';' OR 'TESN'; ! IF WE DON'T, THEN RETURN WITH AN ! ERROR. ! ! D. MOVE THE WINDOW FOR THE PROPER EXIT POSITION. ! ! 4. * ! ! A. CALL 'GENGT' TO GENERATE THE NODE FOR THE ! BODY OF THE 'NSET-TESN' PART, AND THEN ! PUSH A LEXEME DESCRIBING THE BODY FOR LATER ! USE IN THE 'SELECT' NODE. ! ! 5. * ! ! A. GENERATE THE NODE FOR THE 'SELECT' ! EXPRESSION. Routine SSELECT : Novalue = Begin Local TOG,SAVNDEL; INIT; NEWLASTEND(PSOF); RUEXPUSH(FSEL0); LASTEND = PSTESN; If .DEL Neq TK_OF Then Begin ERROR(.pos_open,.pos_del,.LASTEND,SELERR1); Return End; OLDDELI = MACRCOMSEL; If RUNDE() Then Return; If .DEL Neq TK_NSET Then Begin ERROR(.pos_open,.pos_del,.LASTEND,SELERR2); Return End; LASTEND = PSTESNCOLSEM; Until .DEL Eql TK_TESN Do Begin RUND(QL_LEXEME); If .DEL Eql TK_TESN Then Exitloop; TOG = (.DEL Eql TK_ALWAYS); If .TOG Or .DEL Eql TK_OTHERWISE Then Begin PUSH(LEXOUT(T_SELECT,.TOG)); RUND(QL_LEXEME) End Else Begin EXPRESSION(); PUSH(.SYM); MARKMMNODES() End; If .DEL Neq TK_COLON Then Begin ERROR(.pos_open,.pos_del,(RESLASTEND),SELERR3); Return End; RUEXPUSH(FSEL3); If .DEL Neq TK_SEMICOLON And .DEL Neq TK_TESN Then Begin ERROR(.pos_open,.pos_del,(RESLASTEND),SELERR4); Return End End; PUSH(ZERO); PUSH(ZERO); RESLASTEND; SAVNDEL = .pos_del; RUNDE(); If AEFOLLOWS() Then Begin ERROR(.pos_open,.SAVNDEL,.LASTEND,OPERR2); Return End; FIN(TK_SELECT,FSEL4) End; !I. GENERAL: ! ! 1. PARSE EITHER POSITION OR SIZE IN . ! ! 2. DELIM IS EITHER COMMA OR RIGHT POINT BRACKET; ! DEFAULT IS EITHER 0 OR 16. ! !II. SPECIFIC: ! ! 1. * ! ! A. GET AN EXPRESSION AND A CLOSING DELIMITER. ! ! B. IF THE DELIMITER IS WRONG, RETURN -1; IF THE ! EXPRESSION IS NOT A COMPILE TIME CONSTANT ! OR IS NOT VALID AS A P OR S, RETURN -2. OTHERWISE ! RETURN THE LITERAL VALUE OF THE EXPRESSION (OR THE ! DEFAULT, IF THERE WAS NO SYMBOL). ! Routine CALCNEXT(DELIM,DEFAULT)= Begin RUND(QL_LEXEME); EXPRESSION(); If .DEL Neq .DELIM Then Return -1; If .SYM Eql TK_EMPTY Then Return .DEFAULT; SYM = BINDBIND(.SYM); If .SYM Neq T_LITERAL Then Begin WARNEM(.pos_sym,ERMBADEXP); Return .DEFAULT End; SYM = .SYM; If .SYM Gtru (If .DEFAULT Eql 16 Then 16 Else 15) Then Return -2 Else Return .SYM; End; ! !SYNTAX: SYM ! !I. GENERAL: ! ! 1. THIS ROUTINE PROCESSES A POINTER OF THE ABOVE ! SYNTAX FORM. ! ! 2. IT PROCESSES EACH EXPRESSION, USING DEFAULTS FOR ! THOSE NOT SPECIFIED. ! Routine SPOINTER : Novalue = Begin Local PBAS : Ref GT, PPOS : Integer, PSIZ : Integer, POFF : Integer; INIT; PBAS = .SYM; ! get the position number PPOS = CALCNEXT(TK_COMMA,0); If .PPOS Eql -1 Then Begin ERROR(.pos_open,.pos_del,.LASTEND,PERR1); Return End; If .PPOS Eql -2 Then Begin WARNEM(.pos_sym,PERR1); PPOS = 0 End; ! get the size number PSIZ = CALCNEXT(TK_RANGLE,16); If .PSIZ Eql -1 Then Begin ERROR(.pos_open,.pos_del,.LASTEND,PERR2); Return End; If .PSIZ Eql -2 Then Begin WARNEM(.pos_sym,PERR1); PSIZ = 16 End; ! skip over the '>' RUNDE(); ! compute the word offset in bytes POFF = (.PPOS/WRDSZ)*(WRDSZ/BYTSZ); ! for now, only allow operations on the direct word If .POFF Gtr 0 Then WARNEM(.pos_del,WAPOSOVFL); ! position within the word PPOS = .PPOS Mod WRDSZ; ! check for a field which spans a word If .PPOS+.PSIZ Gtr WRDSZ Then Begin WARNEM(.pos_del,WAPSOVFL); PSIZ = WRDSZ-.PPOS End; ! if the field fits within a single byte then adjust the ! byte offset and field position accordingly ! IF .PPOS Mod BYTSZ+.PSIZ LEQ BYTSZ ! CAN'T DO THIS YET. ! THEN (POFF = .POFF+.PPOS/BYTSZ; ! SOMEDAY BE SURE TO DO IT!! ! PPOS = .PPOS Mod BYTSZ); ! a pointer applied to a pointer means the inner pointer is discarded If .PBAS Eql T_NODE And .PBAS[gt_code] Eql OP_POINTER Then Begin Local P : Ref GT; P = .PBAS; PBAS = .PBAS[gt_arg1]; PDETACH(.P); RELEASESPACE(.P,SZ_NODE+3) End; ! generate a pointer only if something other than <0,16> If .PPOS Neq 0 Or .PSIZ Neq 16 Then Begin PUSH(.PBAS); PUSH(LITLEXEME(.PPOS)); PUSH(LITLEXEME(.PSIZ)); FIN(TK_LANGLE,FNULL) End Else ! otherwise ignore the pointer Begin SYM = .PBAS; If .num_error Eql 0 Then DELETETOMARK() End End; Routine SCLABEL = Begin Local L1 : Ref ST, TEMP : Vector[8,Byte]; L1 = GETLABEL(); TEMP[0] = 'U'; TEMP[1] = '$'; TEMP[2] = .L1<6,3> + '0'; TEMP[3] = .L1<3,3> + '0'; TEMP[4] = .L1<0,3> + '0'; TEMP[5] = 0; L1 = STINSERT(SEARCH(TEMP,S_UNDECLARE),S_LABEL,0); L1[gt_disp] = 0; L1[st_lab_alive] = TRUE; Return LEXOUT(T_SYMBOL,.L1) End; Routine SELABEL(LAB : Ref ST) : Novalue = Begin LAB[st_lab_dead] = TRUE; LAB[st_enable_loc] = 0; ! BECAUSE THIS IS ALSO LOC[LABCELLF] PUSH1(.LAB) End; Routine SFLABEL : Novalue = Begin Local SAVLAB; INIT; SAVLAB = .GLOLAB; GLOLAB = SCLABEL(); GLOLAB[st_enable_loc] = .ELTOS; NOTELEVEL(.GLOLAB); PRERUEX(FLAB0); Selectone .DEL Of Set [OP_WHILE,OP_UNTIL]: SWU(); [OP_INCR,OP_DECR]: SREP(); [OP_DO_WHILE,OP_DO_UNTIL]: SDO() Tes; If .SYM Eql TK_EMPTY Then SYM = 0; PUSH(.SYM); POSTRUEX(FLAB0); SELABEL(.GLOLAB); FIN(TK_LABUSE,FLAB1); GLOLAB[st_lab_node] = .SYM; GLOLAB = .SAVLAB End; Routine SEXITLOOP : Novalue = Begin INIT; If .GLOLAB Eql 0 Then Begin ERROR(.pos_open,.pos_del,.LASTEND,EXITERR1); Return End; RUEXPUSH(FLEAV0); PUSH1(LEXOUT(T_SYMBOL,.GLOLAB)); If .GLOLAB[st_enable_loc] Eql .ELTOS Then PUSH(ZERO) Else PUSH(.ELSTK[.GLOLAB[st_enable_loc]+1]); FIN(TK_LEAVE,FLEAV1) End; Routine SRETURN : Novalue = Begin INIT; If .CURROUT Eql 0 Then Begin ERROR(.pos_open,.pos_del,.LASTEND,EXITERR1); Return End; RUEXPUSH(FLEAV0); PUSH1(LEXOUT(T_SYMBOL,.CURROUT)); If .LASTELMARK Eql .ELTOS Then PUSH(ZERO) Else PUSH(.ELSTK[.LASTELMARK+1]); FIN(TK_RETURN,FRTRN) End; ! !SYNTAX: ::...: ! !I. GENERAL: ! ! 1. THIS ROUTINE PROCESSES A LABEL. ! ! 2. IT IS CALLED FROM EXPRESSION IF A COLON IS ! FOUND IN 'DEL'. ! ! 3. IT FIXES THE SYMBOL TABLE ENTRY TO POINT TO THE LABEL ! NODE IN THE GRAPH TABLE. ! !II. SPECIFIC: ! ! 1. * ! ! A. IF THE SYMBOL IN 'SYM' IS A LABEL, THEN: ! ! 1. SAVE THE SYMBOL IN A LOCAL ! 'SAVLABEL'. ! ! 2. THE LABEL MAY NOW BE USED IN THE ! EXPRESSION FOLLOWING, AS THE ! ARGUMENT IN A 'LEAVE' ! EXPRESSION, SO TURN ON THE 'ALIVE' ! FIELD. ! ! 3. PROCESS THE EXPRESSION FOLLOWING IT. ! ! 4. THE LABEL'S SCOPE HAS ENDED, SO ! TURN ON THE 'DEAD' FIELD. ! ! 3. * ! ! A. MAKE THE LINK FIELD OF THE LABEL SYMBOL ! TABLE ENTRY POINT TO THE NODE OF THE LABEL. Routine SLABEL : Novalue = Begin Local SAVLABEL : Ref ST; INIT; SAVLABEL = .SYM; SAVLABEL[st_enable_loc] = .ELTOS; If .SAVLABEL[st_lab_alive] Then ERRPRNT(.pos_open,.pos_sym,LABUSERR) Else SAVLABEL[st_lab_alive] = TRUE; NOTELEVEL(.SAVLABEL); RUEXPUSH(FLAB0); SELABEL(.SAVLABEL); FIN(TK_LABUSE,FLAB1); SAVLABEL[st_lab_node] = .SYM End; ! !SYNTAX: LEAVE