Module SYNTAX = Begin ! SYNTAX MODULE ! ------------- ! ! THIS MODULE IS THE SYNTAX ANALYZER. ! ! Require 'Bliss'; Own flg_enable_block: Boolean, ELSTK : Vector[20], ELTOS : Integer, LASTELMARK : Integer, GLOLAB : Ref ST, COMPLAB : Ref ST; !************** 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, stmt_bracket : Novalue; Forward Routine PUSHELSTK : Novalue, POPELSTK, MARKELSTK : Novalue; Forward Routine ! IN ORDER OF APPEARANCE stmt_error : Novalue, stmt_module : Novalue, EXPRESSION : Novalue, stmt_compound : Novalue, stmt_operator : Novalue, stmt_if : Novalue, stmt_while : Novalue, stmt_do : Novalue, stmt_incr : Novalue, stmt_call : Novalue, stmt_special : Novalue, stmt_case : Novalue, stmt_select : Novalue, stmt_pointer : Novalue, SELABEL : Novalue, stmt_loop : Novalue, stmt_exitloop : Novalue, stmt_return : Novalue, stmt_label : Novalue, stmt_leave : Novalue, stmt_inline : Novalue, decl_enable : Novalue, stmt_signal : Novalue; Bind SYNLST = Uplit Long ( Rep MAXOPERATOR+1 Of (stmt_operator), ! THE OPS! stmt_operator, ! = stmt_error, stmt_case, 0, ! fparm 0, ! fstore stmt_loop, ! while stmt_loop, ! until 0, ! routine stmt_compound, stmt_loop, ! incr stmt_loop, ! decr stmt_if, stmt_loop, ! do_while stmt_loop, ! do_until 0, ! create 0, ! exchange stmt_select, stmt_exitloop, ! exitloop 0, ! label stmt_module, decl_plit, stmt_call, stmt_pointer, stmt_bracket, stmt_leave, stmt_return, ! return 0, ! null stmt_inline, decl_enable, stmt_signal ) : Vector[,Long]; ! GENERAL GRAPH TABLE ROUTINES ! ---------------------------- Macro FIN(P,Q)= Begin PRERUEX(Q); pos_good = .pos_del; SYM = GENGT(P); POSTRUEX(Q) End %, XFIN(N,Q)= Begin PRERUEX(Q); If .num_error Eql 0 Then Begin DELETETOMARK(); SYM = .STK[.TOS+(N)+2] End Else SYM = MakeLit(0); POSTRUEX(Q); pos_good = .pos_del End %, XCTSYNTAX=Bliss(.SYNLST[.DEL]) %; ! execute the syntax routine for DEL Global Routine execute_syntax : Novalue = Begin XCTSYNTAX End; Macro EXPUSH(Q)= Begin PRERUEX(Q); EXPRESSION(); Push(.SYM); POSTRUEX(Q) End %, RUEXPUSH(Q)= Begin PRERUEX(Q); RUND(QL_LEXEME); EXPRESSION(); Push(.SYM); POSTRUEX(Q) End %, CONSTPUSH(P,Q)= Begin SYM = P; PRERUEX(Q); Push(.SYM); POSTRUEX(Q) End %; Literal ! FLOW ACTION DEFN PARMS FNULL = 0, FIF0 = 1, FIF1 = 2, FIF2 = 3, FIF3 = 4, FWUD0 = 5, FWUD1 = 6, FWUD2 = 7, FDWU0 = 8, FDWU1 = 9, FDWU2 = 10, FID0 = 11, FID1 = 12, FCALL0 = 13, FCALL1 = 14, FCASE0 = 15, FCASE1 = 16, FCASE2 = 17, FSEL0 = 18, FSEL1 = 19, FSEL3 = 20, FSEL4 = 21, FLAB0 = 22, FLEAV0 = 23, FBODY0 = 24, FID00 = 25, FCIF = 26, FCCASE = 27, FBODY1 = 28, FINLINE0= 29, FSIG0 = 30, FLEAV1 = 31, FLAB1 = 32, FRTRN = 33, FENABLAB= 34, FENAB0 = 35, FENAB1 = 36; Macro POSTRUEX(QQ)= If .num_error Eql 0 Then Case (QQ) From 0 To 36 Of Set [Inrange]: 0; [ FIF0]: F15(); [ FIF1,FIF2,FCASE1]: F4(); [ FWUD0]: F19(); [ FWUD2]: F18(); [ FDWU0,FCALL0,FSEL0, FID00,FCIF,FCCASE]: F9(); [ FDWU1]: F26(); [FDWU2]: F16(); [FID0]: F17(); [FCALL1]: F11(); [FCASE0]: F27(); [FSEL3]: F7(); [FLEAV0]: F14(); [FBODY1]: F13(); [FINLINE0]: F3(); [FLEAV1]: F24(); [FLAB1]: F25(); [FRTRN]: F2(); [FENABLAB]: F21(); [FENAB1]: F23() Tes %; Macro PRERUEX(QQ)= If .num_error Eql 0 Then Case (QQ) From 0 To 36 Of Set [Inrange]: 0; [ FIF0]: F20(); [ FIF1,FIF2,FCASE1]: F8(); [ FIF3,FCASE2]: F5(); [ FWUD0,FDWU0]: F1(); [ FWUD2]: F9(); [FDWU2]: F9(); [FID0]: F10(); [FID1]: F6(); [FSEL3,FLEAV0]: F0(); [FBODY0]: F12(); [FENAB0]: F22() Tes %; ! GENERAL ERROR HANDLING CONSTUCTS ! -------------------------------- Routine stmt_error : Novalue = Begin ERROR(.pos_del,.pos_del,0,B11$_MISSING_OPERATOR) End; Routine stmt_module : Novalue = Begin ERROR(.pos_del,.pos_del,0,B11$_MODULE_FOUND) End; Global Routine RUNDE = Begin RUND(QL_LEXEME); If .SYM Neq NIL Then Begin ERROR(.pos_sym,.pos_sym,0,B11$_SUPERFLUOUS); Return TRUE End Else Return FALSE End; ! GENERAL SYNTAX ROUTINES ! ----------------------- ! UTILITY BOOLEAN ROUTINES Routine SEFOLLOWS = Begin Return .DEL And (.SYM Eql NIL Xor .DEL) End; Routine AEFOLLOWS = Begin Return .DEL And (.SYM Eql NIL Xor .DEL) End; Global Routine RNAMEFOLLOWS(RNAME : Ref ST) : Novalue = Begin Local pos_open : Integer, savel : Integer, SAVEBLOCK : Vector[10]; Own SAVEPLIT : Vector[10,Long] Preset( [0] = flg_enable, [1] = CURROUT, [2] = LASTPUR, [3] = level_routine, [4] = MAXLOCALS, [5] = NUMPARMS, [6] = MAXPARMS, [7] = NEXTLOCAL, [8] = LEVELINC, [9] = TNCHAIN); pos_open = .pos_del; Mark(); Incr I From 0 To 9 Do SAVEBLOCK[.I] = ..SAVEPLIT[.I]; TNCHAIN[itm_llink] = TNCHAIN; TNCHAIN[itm_rlink] = TNCHAIN; LASTPUR = .PURGED; flg_enable = FALSE; NEXTLOCAL = 0; MAXLOCALS = 0; NUMPARMS = 0; MAXPARMS = 0; RaiseScope(); level_routine = .level_block; If PROCPARMS(.RNAME) Then Begin If .DEL Neq TK_EQUAL Then ERROR(.pos_open,.pos_del,0,B11$_MISSING_EQUAL) Else Begin CURROUT = .RNAME; MARKELSTK(); RUEXPUSH(FBODY0); LASTELMARK = POPELSTK(); Push(.RNAME); LowerScope(); 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. 'B11$_EXPRESSION_CONTEXT'- EXPRESSION ! ERROR. Global Routine EXPRESSION : Novalue = Begin Local pos_open : Integer, SAVEL : Integer; ! initialize and note that we are in an expression (for error recovery) pos_open = .pos_del; INEXP; ! handle labels separately If .DEL Eql TK_COLON And .SYM[gt_type] Eql T_VARIABLE And .SYM[st_code] Neq S_LABEL Then Begin stmt_label(); RESINDECL; Return End; ! loop for all operators While .DEL Neq CL_CLOSE Do Begin ! if it's ok for this operator to start an expression If AEFOLLOWS() Then XCTSYNTAX ! if a mis-placed declaration Else If .DEL Eql CL_DECL Then Begin ERRPRNT(.pos_open,.pos_del,B11$_MISPLACED_DECLARATION); Do Begin ERRDECL(); RUND(QL_LEXEME) End Until .DEL Neq CL_DECL End ! usually an operator with a SYM mis-match Else ERROR(.pos_open,.pos_del,0,B11$_EXPRESSION_CONTEXT) End; RESINDECL; pos_good = .pos_del 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 'LowerScope' TO CLOSE IT. Routine stmt_compound : Novalue = Begin Local DCLR : Boolean, SAVEND : Integer, SAVEBLOCK : Vector[8], WHICHTYPE : Integer, SAVLAB : Ref ST, pos_open : Integer, SAVEL : Integer; Own SAVEPLIT : Vector[7,Long] Preset( [0] = flg_enable_block, [1] = INDECL, [2] = NEXTLOCAL, [3] = NOTREE, [4] = FLAGS, [5] = SYM_VECTOR, [6] = SYM_BLISS), CLOSEDEL : Vector[2,Long] Preset( [0] = TK_END, [1] = TK_RPAREN); ! initialize and mark the stack pos_open = .pos_del; savel = .lastend; Mark(); ! save the enable seen flag, in-declaration flag, and the stack level Incr I From 0 To 6 Do SAVEBLOCK[.I] = ..SAVEPLIT[.I]; SAVLAB = .COMPLAB; flg_enable_block = FALSE; ! 0 FOR BEGIN, 1 FOR LEFT PAREN WHICHTYPE = .DEL; lastend[PS_SEMICOLON] = TRUE; If .WHICHTYPE Then lastend[PS_PAREN] = TRUE Else lastend[PS_END] = TRUE; ! skip over the BEGIN/'(' RUND(QL_LEXEME); ! check for declarations and process the declarations if found DCLR = (.DEL Eql CL_DECL); If .DCLR Then Begin RaiseScope(); DCLARE(); MARKMMNODES() End; ! bump the atomic block count F29(); ! parse all the expressions in the block While TRUE Do Begin EXPUSH(FNULL); If .DEL Neq TK_SEMICOLON Then Exitloop; MARKMMNODES(); RUND(QL_LEXEME) End; ! release any declarations If .DCLR Then LowerScope(); ! note the highest stack depth If .NEXTLOCAL Gtr .MAXLOCALS Then MAXLOCALS = .NEXTLOCAL; ! if we ran off the end of file If .flg_eof Then Begin DEL = .CLOSEDEL[.WHICHTYPE]; ERRPRNT(.pos_open,.pos_open,B11$_MISSING_END); ERRLEVEL = TRUE End ! if a closing delimiter mis-match Else If .DEL Neq .CLOSEDEL[.WHICHTYPE] Then If .DEL Eql .CLOSEDEL[1-.WHICHTYPE] Then Return ERRPRNT(.pos_open,.pos_del,B11$_BRACE_MISMATCH) Else ERROR(.pos_open,.pos_del,0,B11$_MISSING_END); lastend = .savel; SAVEND = .pos_del; ! skip over the END/')' RUNDE(); ! an enable block is transformed internally to a labelled block. ! all cases in the enable block do a leave to this label. If .flg_enable_block Then Begin FIN(TK_COMPOUND,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 = .SAVLAB; POPELSTK(); End Else If .TOS-.LASTMARK Gtr 1 Then FIN(TK_COMPOUND,FNULL) ! if a single expression in the block then discard the compound wrapper Else XFIN(0,FNULL); ! restore all save variables Incr I From 0 To 6 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 stmt_operator : Novalue = Begin Local OP : Integer, AOFLAG : Boolean, pos_open : Integer, SAVEL : Integer; ! initialize and mark the stack pos_open = .pos_del; Mark(); ! remember this operator OP = .DEL; ! if a binary operator and no LHS -or- a unary operator and there is a lhs If (.SYM Eql NIL) Xor (Not .OP) Then Begin WARNEM(.pos_del,B11$_OPERATOR_CONTEXT); SYM = MakeLit(0) End; ! if a binary operator, stack the LHS If .OP Then Push(.SYM); ! note whether this is AND or OR for the kludges below AOFLAG = (.OP Eql TK_AND Or .OP Eql TK_OR); ! KLUDGE TO PREVENT CSE CREATION IN FLOW BOOLEANS. ! we don't know whether this AND/OR is for flow or value ! and so we assume the worse. If .AOFLAG Then F0(); ! skip over the operator RUND(QL_LEXEME); ! loop for all operators of a higher precedence While (.DEL Leq .OP) Do Begin If .DEL Eql .OP And Not .OP Then Exitloop; If SEFOLLOWS() Then XCTSYNTAX Else ERROR(.pos_open,.pos_del,0, If Not .DEL Then B11$_MUST_PARENTHESIZE Else B11$_MISSING_OPERAND) End; ! if missing the RHS If .SYM Eql NIL Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_OPERAND); SYM = MakeLit(0) 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 stmt_if : Novalue = Begin Local C1 : Boolean, C2 : Integer, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; savel = .lastend; Mark(); lastend[PS_THEN] = TRUE; RUEXPUSH(FIF0); SYM = STK[.TOS] = BINDBIND(.SYM); C1 = (.SYM[gt_type] Eql T_LITERAL); If .C1 Then Begin If .num_error Eql 0 Then Begin F28(); FreeList(.STK[.TOS-1]); STK[.TOS-1] = .STK[.TOS]; TOS = .TOS-1 End; C2 = .SYM[gt_disp]; If Not .C2 Then NOCODE End; lastend = .savel; If .DEL Neq TK_THEN Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_THEN); 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(MakeLit(0),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 stmt_while : Novalue = Begin Local SWUTYPE : Integer, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; savel = .lastend; Mark(); lastend[PS_DO] = TRUE; SWUTYPE = .DEL; LOOPDEPTH = .LOOPDEPTH+1; RUEXPUSH(FWUD0); lastend = .savel; If .DEL Neq TK_DO2 Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_DO); Return End; RUEXPUSH(FWUD1); LOOPDEPTH = .LOOPDEPTH-1; Mark(); 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 stmt_do : Novalue = Begin Local SDOTYPE : Integer, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; savel = .lastend; Mark(); lastend[PS_WHILE] = TRUE; lastend[PS_UNTIL] = TRUE; LOOPDEPTH = .LOOPDEPTH+1; RUEXPUSH(FDWU0); lastend = .savel; If .DEL Neq TK_WHILE2 And .DEL Neq TK_UNTIL2 Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_WHILE); Return End; SDOTYPE = .DEL; RUEXPUSH(FDWU1); LOOPDEPTH = .LOOPDEPTH-1; Mark(); 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 stmt_incr : Novalue = Begin Local SREPTYPE : Integer, EXECUTE : Boolean, FROMPART : Ref GT, TOPART : Ref GT, S : Ref GT, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; savel = .lastend; Mark(); SREPTYPE = .DEL; RaiseScope(); ! get and declare the loop variable. the loop variable is local to the loop. RUND(QL_NAME); S = decl_incr_variable(); If .S Eqla 0 Then Begin LowerScope(); Return End; Push(MakeVar(.S)); lastend[PS_DO] = TRUE; 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[gt_type] Eql T_LITERAL And .TOPART[gt_type] Eql T_LITERAL Then Begin FROMPART = .FROMPART[gt_disp]; TOPART = .TOPART[gt_disp]; 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); lastend = .savel; If .DEL Neq TK_DO2 Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_DO); Return End; If .EXECUTE Then Begin LOOPDEPTH = .LOOPDEPTH+1; RUEXPUSH(FID0); LOOPDEPTH = .LOOPDEPTH-1; End Else Begin NOCODE; RUEXPUSH(FNULL); RESNOTREE; STK[.TOS] = MAkeLit(-1); End; LowerScope(); If .EXECUTE Then FIN(.SREPTYPE,FID1) Else FIN(TK_COMPOUND,FNULL) 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 stmt_call : Novalue = Begin Local LNKG : Ref ST, RTNAME : Ref ST, SAVNP : Integer, LIMIT : Integer, PLENDED : Boolean, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; Mark(); LIMIT = STKSIZE; ! SEE TN.BEG ! if not a call through a symbol then use the default BLISS linkage If .SYM[gt_type] Neq T_VARIABLE Then Begin LNKG = .sym_bliss; RTNAME = .SYM End Else Begin LNKG = .SYM[gt_disp]; Selectone .SYM[st_code] Of Set ! calls through an override linkage [S_LINKAGE]: Begin FreeSym(); ! this hack disallows calls to an IOT procedure If .LNKG[st_lnk_type] Eql LNK_IOT Then RTNAME = MakeLit(0) ! IOT HAS NO ROUTINE 'NAME' Else Begin RUND(QL_LEXEME); EXPRESSION(); RTNAME = .SYM End End; ! calls to builtin function [S_SPECIAL]: Begin If .LNKG[st_which] Geq 4 Then ! SWAB,CARRY,OVERFLOW Begin stmt_special(.LNKG[st_which]-4); Return End; LNKG = .LNKG[st_var_linkage]; RTNAME = .SYM; LIMIT = .Block[.LNKG[st_lnk_desc],parm_size]+.NUMPARMS End; ! calls through a non-procedure symbol. should be a warning [LOWEXPTYPE To HIGHEXPTYPE]: Begin RTNAME = .SYM; LNKG = .Block[.SYM[gt_disp],st_var_linkage] End; ! call through neither a procedure nor a variable nort a constant [Otherwise]: Begin FreeSym(); WARNEM(.pos_sym,B11$_NON_ADDRESSABLE); RTNAME = MakeLit(0); LNKG = .sym_bliss End Tes End; ! stack the linkage and the routine being called. PUSH1(.LNKG); PUSH(.RTNAME); ! inform error recovery to stop on either a ')' or a ',' savel = .lastend; lastend[PS_PAREN] = TRUE; lastend[PS_COMMA] = TRUE; ! skip over the ')' unless we already hit it and check for '()' PLENDED = FALSE; If .DEL Neq TK_RPAREN Then Begin RUND(QL_LEXEME); If .SYM Eql NIL And .DEL Eql TK_RPAREN Then PLENDED = TRUE End; ! if arguments then collect them If Not .PLENDED Then While TRUE Do Begin Mark(); ! the builtin function only allow a certain number of parameters. ! it seems that it would be easier to just collect them all and ! discard the excess later. have to wait until FLOWAN is separated ! from SYNTAX If .NUMPARMS Eql .LIMIT Then Begin WARNEM(.pos_del,B11$_TOO_MANY_PARAMS); 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; lastend = .savel; ! check for the closing ')' If .DEL Neq TK_RPAREN Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_PAREN); Return End; ! skip over the ')' and disallow a symbol to follow it RUNDE(); FIN(TK_CALL,FCALL1); Mark(); Push(.SYM); SYM = GENGT(TK_FSTORE) End; ! ! CALLED TO PARSE THE SPECIAL FUNCTIONS (AT PRESENT SWAB AND M*P*). ! ! SYNTAX: () ! ! INDEX WILL BE: ! SWAB - 0 ! MFPI - 1 ! MFPD - 2 ! MTPI - 3 ! MTPD - 4 ! Routine stmt_special(INDEX : Integer) : Novalue = Begin Local TYPE : Integer, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; savel = .lastend; lastend[PS_PAREN] = TRUE; RUEXPUSH(FNULL); lastend = .savel; If .DEL Neq TK_RPAREN Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_PAREN); Return End; RUNDE(); If .INDEX Eql 0 Then FIN(TK_SWAB,FNULL) Else Begin Push(MakeLit(.INDEX-1)); FIN(TK_MOVP,FNULL) End 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 stmt_case : Novalue = Begin Local C1 : Boolean, C2 : Integer, T : Integer, SAVNDEL : Integer, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; savel = .lastend; Mark(); lastend[PS_OF] = TRUE; Mark(); ! get the case selector expression and multiply it by 2 using a shift RUEXPUSH(FNULL); Push(MAkeLit(1)); FIN(TK_SHIFT,FCASE0); Push(.SYM); ! note whether the case selector is a constant C1 = (.SYM[gt_type] 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(); FreeList(.STK[.TOS-1]); STK[.TOS-1] = .STK[.TOS]; TOS = .TOS-1 End; C2 = .SYM[gt_disp]/2; T = -1; NOCODE End; lastend = .savel; lastend[PS_TES] = TRUE; ! check for 'OF' and skip over it If .DEL Neq TK_OF Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_OF); 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,0,B11$_MISSING_SET); Return End; lastend[PS_SEMICOLON] = TRUE; 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 lastend = .savel; ERROR(.pos_open,.pos_del,0,B11$_MISSING_TES); Return End; If .C1 And .T Eql .C2 Then NOCODE End; lastend = .savel; SAVNDEL = .pos_del; RUNDE(); If AEFOLLOWS() Then Begin ERROR(.pos_open,.SAVNDEL,0,B11$_MUST_PARENTHESIZE); 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 'SET E1:E2;...;EM:EN TES'. ! ! 4. GENERATE THE NODE FOR THE BODY OF THE ! 'SET-TES' 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 'SET-TES'. ! ! C. PROCESS EACH PAIR OF EXPRESSIONS IN THE ! BODY UNTIL WE SEE 'TES'. ! ! 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 'TES'; ! 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 'SET-TES' 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 stmt_select : Novalue = Begin Local SAVNDEL : Integer, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; savel = .lastend; Mark(); lastend[PS_OF] = TRUE; RUEXPUSH(FSEL0); lastend = .savel; lastend[PS_TES] = TRUE; If .DEL Neq TK_OF Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_OF); Return End; If RUNDE() Then Return; If .DEL Neq TK_SET Then Begin ERROR(.pos_open,.pos_del,0,B11$_MISSING_SET); Return End; lastend[PS_COLON] = TRUE; lastend[PS_SEMICOLON] = TRUE; Until .DEL Eql TK_TES Do Begin RUND(QL_LEXEME); If .DEL Eql TK_TES Then Exitloop; If .DEL Eql TK_ALWAYS Then Begin Push1(.sym_always); RUND(QL_LEXEME) End Else If .DEL Eql TK_OTHERWISE Then Begin Push1(.sym_otherwise); RUND(QL_LEXEME) End Else Begin EXPRESSION(); Push(.SYM); MARKMMNODES() End; If .DEL Neq TK_COLON Then Begin lastend = .savel; ERROR(.pos_open,.pos_del,0,B11$_MISSING_COLON); Return End; RUEXPUSH(FSEL3); If .DEL Neq TK_SEMICOLON And .DEL Neq TK_TES Then Begin lastend = .savel; ERROR(.pos_open,.pos_del,0,B11$_MISSING_TES); Return End End; Push(MakeLit(0)); Push(MakeLit(0)); lastend = .savel; SAVNDEL = .pos_del; RUNDE(); If AEFOLLOWS() Then Begin ERROR(.pos_open,.SAVNDEL,0,B11$_MUST_PARENTHESIZE); 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 : Integer,DEFAULT : Integer) = Begin Local N : Integer; RUND(QL_LEXEME); EXPRESSION(); If .DEL Neq .DELIM Then Return -1; If .SYM Eql NIL Then Return .DEFAULT; SYM = BINDBIND(.SYM); If .SYM[gt_type] Neq T_LITERAL Then Begin WARNEM(.pos_sym,B11$_WANT_CTCE); Return .DEFAULT End; N = .SYM[gt_disp]; FreeSym(); If .N Gtru (If .DEFAULT Eql 16 Then 16 Else 15) Then Return -2 Else Return .N 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 stmt_pointer : Novalue = Begin Local PBAS : Ref GT, PPOS : Integer, PSIZ : Integer, POFF : Integer, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; Mark(); PBAS = .SYM; ! get the position number PPOS = CALCNEXT(TK_COMMA,0); If .PPOS Eql -1 Then Begin ERROR(.pos_open,.pos_del,0,B11$_INVALID_POSITION); Return End; If .PPOS Eql -2 Then Begin WARNEM(.pos_sym,B11$_INVALID_POSITION); PPOS = 0 End; ! get the size number PSIZ = CALCNEXT(TK_RANGLE,16); If .PSIZ Eql -1 Then Begin ERROR(.pos_open,.pos_del,0,B11$_INVALID_SIZE); Return End; If .PSIZ Eql -2 Then Begin WARNEM(.pos_sym,B11$_INVALID_SIZE); 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,B11$_POSITION_TOO_BIG); ! 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,B11$_POINTER_TOO_BIG); 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[gt_type] 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(MakeLit(.PPOS)); Push(MakeLit(.PSIZ)); FIN(TK_LANGLE,FNULL) End Else ! otherwise ignore the pointer Begin SYM = .PBAS; If .num_error Eql 0 Then DELETETOMARK() End End; !+ ! invent a label name for a loop construct !- Routine SCLABEL = Begin Local L1 : Ref ST, TEMP : Vector[8,Byte]; LABELNO = .LABELNO + 1; L1 = .LABELNO; 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_LABEL,0); L1[gt_disp] = 0; L1[st_lab_alive] = TRUE; Return .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; !+ ! process looping statements ! ! notes: ! internally, all looping constructs are converted from: ! ! loop-stmt ! ! to: ! ! U$xxx: loop-stmt ! ! if an EXITLOOP statement is found within the loop then ! it is converted to: ! ! LEAVE U$xxx Routine stmt_loop : Novalue = Begin Local SAVLAB : Ref ST, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; Mark(); SAVLAB = .GLOLAB; GLOLAB = SCLABEL(); GLOLAB[st_enable_loc] = .ELTOS; NOTELEVEL(.GLOLAB); PRERUEX(FLAB0); Selectone .DEL Of Set [OP_WHILE,OP_UNTIL]: stmt_while(); [OP_INCR,OP_DECR]: stmt_incr(); [OP_DO_WHILE,OP_DO_UNTIL]: stmt_do() Tes; If .SYM Eql NIL Then SYM = 0; Push(.SYM); POSTRUEX(FLAB0); SELABEL(.GLOLAB); FIN(TK_LABUSE,FLAB1); GLOLAB[st_lab_node] = .SYM; GLOLAB = .SAVLAB End; Routine stmt_exitloop : Novalue = Begin Local pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; Mark(); If .GLOLAB Eqla 0 Then Begin ERROR(.pos_open,.pos_del,0,B11$_NOT_IN_LOOP); Return End; RUEXPUSH(FLEAV0); PUSH1(.GLOLAB); If .GLOLAB[st_enable_loc] Eql .ELTOS Then Push(MakeLit(0)) Else Push(.ELSTK[.GLOLAB[st_enable_loc]+1]); FIN(TK_LEAVE,FLEAV1) End; Routine stmt_return : Novalue = Begin Local pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; Mark(); If .CURROUT Eqla 0 Then Begin ERROR(.pos_open,.pos_del,0,B11$_NOT_IN_ROUTINE); Return End; RUEXPUSH(FLEAV0); PUSH1(.CURROUT); If .LASTELMARK Eql .ELTOS Then Push(MakeLit(0)) 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 stmt_label : Novalue = Begin Local SAVLABEL : Ref ST, pos_open : Integer, SAVEL : Integer; pos_open = .pos_del; Mark(); SAVLABEL = .SYM[gt_disp]; FreeSym(); SAVLABEL[st_enable_loc] = .ELTOS; If .SAVLABEL[st_lab_alive] Then ERRPRNT(.pos_open,.pos_sym,B11$_LABEL_REDEFINED,.SYM) Else SAVLABEL[st_lab_alive] = TRUE; NOTELEVEL(.SAVLABEL); RUEXPUSH(FLAB0); SELABEL(.SAVLABEL); FIN(TK_LABUSE,FLAB1); SAVLABEL[st_lab_node] = .SYM End; ! !SYNTAX: LEAVE