! 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(TIMER=EXTERNAL(SIX12))= BEGIN ! SYNTAX MODULE ! ------------- ! ! C. WEINSTOCK ! C. GESCHKE ! W. WULF ! D. WILE ! P. KNUEVEN ! R. JOHNSSON ! ! THIS MODULE IS THE SYNTAX ANALYZER. ! ! SWITCHES NOLIST; REQUIRE COMMON.BEG; REQUIRE PREDEF.BEG; REQUIRE GTST.BEG; REQUIRE GTX.BEG; REQUIRE ST.BEG; REQUIRE LDSFT.BEG; SWITCHES LIST; REQUIRE LDSF.BEG; SWITCHES NOLIST; REQUIRE ERROR.BEG; REQUIRE STRUCT.BEG; REQUIRE TN.BEG; REQUIRE FLOW.BEG; BEGIN SWITCHES LIST; MACRO BYTES(STE)=(.STE[SIZEF]/8)$; BIND MACRCOMSEL=#777777; ! NOTE THE ABOVE 2 DEFINITIONS APPEAR IN LEXAN.BLI. BIND STVEC STSYM=SYM[ADDRF]; !************** NOTE, THE ABOVE ADDED HERE BECAUSE NOT SURE WHERE ********** GLOBAL ROUTINE SYNINIT(TOG)= BEGIN EXTERNAL SKAN1; IF .TOG THEN (SKAN1(); RUND(QLLEXEME)); RUND(QLLEXEME) END; ! MISC. EXTERNALS FOR SYNTAX ONLY ! ------------------------------- EXTERNAL ! ELSTK, ELTOS, AND LASTELMARK CONSTITUTE THE 'ENABLE STACK'. ITS ! ARE ANALOGOUS IN BEHAVIOR TO STK, TOS, AND LASTMARK; VALUES PUSHED ! ONTO THE STACK ARE NOT LEXEMES, HOWEVER, BUT RUN-TIME-STACK HEIGHT ! VALUES - WHEN AN ENABLE FRAME IS DECLARED, ITS HEIGHT IS PUSHED ONTO ! THE STACK. ELSTK, ELTOS, LASTELMARK, STVEC COMPLAB: ! DUMMY LABEL ON CURRENT ENABLED BLOCK GLOLAB, ! DUMMY LABEL ON CURRENT LOOP ENABFLG, ! TRUE IF CURRENT BLOCK IS ENABLED F0,F1,F2,F3,F4,F5,F6,F7, ! ROUTINES FROM FLOWAN F8,F9,F10,F11,F12,F13,F14, F15,F16,F17,F18,F19,F20, F21,F22,F23,F24,F25,F26,F27, NUMPARMS; ! SIMULATED DYNAMIC STACK HEIGHT FORWARD PUSHELSTK,POPELSTK,MARKELSTK; EXTERNAL ! FROM DECLAR DCLARE, ERRDECL, INCRDECRREG, PROCPARMS, QNATOLEX, SPLIT, ! FROM FLOWAN BINDPCSTHREAD, ENTVCHGLST, ENTVUSELST, GENPRLG, MRKDOTNODE, MARKMMNODES, NONBOGUS, NOTELEVEL, POPANDDUMP; GLOBAL ROUTINE GETLABEL=LABELNO_.LABELNO+1; FORWARD ! IN ORDER OF APPEARANCE SERROROP, SMODERR, EXPRESSION, SCOMPOUND, SOPERATOR, SIF, SWU, SDO, SREP, SSQOPEN, SPAR, SSPECIALOP, SCASE, SSELECT, SPOINTER, SELABEL, SFLABEL, SESCAPE, SLABEL, SLEAVE, SCREATE, SINLINE, SENABLE, SSIGNAL; BIND SYNLST=PLIT( MAXOPERATOR+1: SOPERATOR, ! THE OPS! SOPERATOR, ! _ SERROROP, SCASE, 0, 0, SFLABEL, SFLABEL, 0, SCOMPOUND, SFLABEL, SFLABEL, SIF, SFLABEL, SFLABEL, SCREATE, 0, SSELECT, SESCAPE, 0, SMODERR, SPLIT, SPAR, SPOINTER, SSQOPEN, SLEAVE, 0, 0, SINLINE, SENABLE, SSIGNAL, ); ! GENERAL GRAPH TABLE ROUTINES ! ---------------------------- MACRO LINIT=LOCAL LOBRAC,SAVEL;LOBRAC_.NDEL$, INIT=LINIT;MARKSTK()$, FIN(P,Q)=(PRERUEX(Q);LCBRAC_.NDEL;SYM_GENGT(P);POSTRUEX(Q))$, XFIN(N,Q)=(PRERUEX(Q);SYM_DELETEALLBUTONE((N));POSTRUEX(Q);LCBRAC_.NDEL)$, XCTSYNTAX=(@SYNLST[.DEL[HSYNTYP]])()$; ROUTINE RUEX=(EXPRESSION();PUSH(.SYM)); MACRO EXPUSH(Q)=(PRERUEX(Q);RUEX();POSTRUEX(Q))$, RUEXPUSH(Q)=(PRERUEX(Q);RUND(QLLEXEME);RUEX();POSTRUEX(Q))$, CONSTPUSH(P,Q)=(SYM_P;PRERUEX(Q);PUSH(.SYM);POSTRUEX(Q))$; FORWARD GENGT,GTSEARCH; GLOBAL ROUTINE PUSH(WORD)= !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. BEGIN MAP LEXEME WORD; IF .ERRORFOUND NEQ 0 THEN RETURN; %[1.A]% IF .WORD[LTYPF] EQL BNDVAR THEN IF NOT ISEXP(WORD) THEN (ERRINFO[0]_.WORD; WARNEM(.NSYM,BADSYMERR); WORD_ZERO); IF .WORD EQL HEMPTY THEN WORD_ZERO; %[1.C]% STK[TOS_.TOS+1]_.WORD; NOVALUE END; ROUTINE PUSH1(WORD)= ! SUBSTITUTE FOR PUSH, WHICH ALLOWS PUSHING OF ! LINKAGE TYPES AND LABELS ONTO THE STACK. CALLED ! BY SPAR, SELABEL, SLABEL, SLEAVE, SESCAPE, SENABLE. BEGIN MAP LEXEME WORD; IF .ERRORFOUND NEQ 0 THEN RETURN; STK[TOS_.TOS+1]_.WORD; NOVALUE END; GLOBAL ROUTINE MARKSTK= !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. BEGIN IF .ERRORFOUND NEQ 0 THEN RETURN; %[1.A]% STK[TOS_.TOS+1]_.LASTMARK; %[1.B]% LASTMARK_.TOS %[1.C]% END; ROUTINE POPTOMARK(TOO)= !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. BEGIN MAP GTVEC TOO; IF .ERRORFOUND NEQ 0 THEN RETURN; %[1.A]% IF .TOS NEQ .LASTMARK THEN %[1.B](4)% MOVECORE(STK[.LASTMARK+1], TOO[OPERAND(0)], .TOS-.LASTMARK); TOS_.LASTMARK-1; %[1.C]% LASTMARK_.STK[.LASTMARK] %[1.D]% END; ROUTINE DELETETOMARK= ! DELETE ALL STACK ELEMENTS ABOVE THE LAST MARK (TOS_.LASTMARK-1; LASTMARK_.STK[.LASTMARK]); MACRO DELETEALLBUTONE(I)=(IF .ERRORFOUND EQL 0 THEN (DELETETOMARK(); .STK[.TOS+(I)+2]) ELSE ZERO)$, ISALIT(Q)=(BIND LEXEME Z=Q; .Z[LTYPF] EQL LITTYP)$, LITRESULT=(.SYM[LTYPF] EQL LITTYP)$, NEGATE(Q)=LITLEXEME(-LITVALUE(.Q))$, ALLCONSTANT=(INCR I FROM .LASTMARK+1 TO .TOS DO IF NOT ISALIT(STK[.I]) THEN EXITLOOP 0)$; REQUIRE CSWO.RTN; ROUTINE CKNAMEDIFF(OPLEX,OP1,OP2)= ! ! HANDLE N-N ! BEGIN MAP LEXEME OPLEX, STVEC OP1:OP2; IF .OPLEX[HSYNTYP] NEQ SMINOP THEN RETURN 0; IF BASESYM(.OP1) NEQ BASESYM(.OP2) THEN RETURN 0; ! ! 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. ! DELETETOMARK(); SYM_LITLEXEME(.OP1[OFFSETF]-.OP2[OFFSETF]); 1 END; ROUTINE CKANDDONAME(OPLEX)= ! ! HANDLE N+L,N-L,L+N ! BEGIN MACRO COMBINE(TYPE1,TYPE2)=((TYPE1)^5 + (TYPE2)) $; MAP LEXEME OPLEX; LOCAL LEXEME O1:O2, SWAPPED; BIND STVEC OP1=O1; IF .OPLEX[HSYNTYP] NEQ SADDOP AND .OPLEX[HSYNTYP] NEQ SMINOP THEN RETURN 0; O1_.STK[.LASTMARK+1]; O2_.STK[.LASTMARK+2]; SELECT COMBINE(.O1[LTYPF],.O2[LTYPF]) OF NSET COMBINE(BNDVAR,LITTYP): (SWAPPED_FALSE; EXITSELECT); COMBINE(LITTYP,BNDVAR): (SWAPPED_TRUE; SWAP(O1,O2); EXITSELECT); COMBINE(BNDVAR,BNDVAR): RETURN CKNAMEDIFF(.OPLEX,.O1,.O2); ALWAYS: RETURN 0; TESN; IF .OPLEX[HSYNTYP] EQL SMINOP THEN IF .SWAPPED THEN RETURN 0 ELSE O2_NEGATE(O2); IF .OP1[TYPEF] EQL LOCALT THEN IF .OP1[REGF] GEQ 8 THEN WARNEM(.NSYM,WALOCERR); DELETETOMARK(); SYM_CREATESWO(.O1,.O2); 1 END; ROUTINE SPLMULCASE(LEX)= BEGIN MAP LEXEME LEX; REGISTER LEXEME L1:L2; L2_.STK[.LASTMARK+2]; IF .L2[LTYPF] NEQ LITTYP THEN BEGIN IF .LEX[HSYNTYP] EQL SDIVOP THEN RETURN 0; L1_.STK[.LASTMARK+1]; END ELSE (L1_.L2; L2_.STK[.LASTMARK+1]); IF .L1[LTYPF] EQL LITTYP THEN IF LITVALUE(.L1) EQL 1 THEN BEGIN SYM_.L2; DELETETOMARK(); 1 END ELSE IF EXTEND(LITVALUE(.L1)) EQL -1 THEN BEGIN SYM_HNEG; DELETETOMARK(); MARKSTK(); PUSH(.L2); 2 END ELSE 0 ELSE 0 END; ROUTINE SPLADDCASE(LEX)= BEGIN MAP LEXEME LEX; REGISTER LEXEME L1:L2; L1_.STK[.LASTMARK+1]; L2_.STK[.LASTMARK+2]; IF .L2[LTYPF] EQL LITTYP THEN IF LITVALUE(.L2) EQL 0 THEN BEGIN SYM_.L1; DELETETOMARK(); 1 END ELSE 0 ELSE IF .L1[LTYPF] EQL LITTYP THEN IF LITVALUE(.L1) EQL 0 THEN IF .LEX[HSYNTYP] EQL SADDOP THEN BEGIN SYM_.L2; DELETETOMARK(); 1 END ELSE BEGIN SYM_HNEG; DELETETOMARK(); MARKSTK(); PUSH(.L2); 2 END ELSE 0 END; ROUTINE CKANDDOK(OPLEX)= BEGIN LOCAL R; MAP LEXEME OPLEX; ! ! CHECK-AND-DO-CONSTANT ARITHMETIC ! IF .OPLEX[HSYNTYP] GEQ SCARRYOP THEN 0 ELSE IF .OPLEX[HSYNTYP] EQL SPLUSOP THEN (SYM_DELETEALLBUTONE(0); 1) ELSE IF .OPLEX[HSYNTYP] EQL SROTOP THEN 0 ELSE ! ROT USES CARRY BIT IF .OPLEX[HSYNTYP] EQL SDOTOP THEN 0 ELSE IF ALLCONSTANT THEN BEGIN REGISTER LEXEME O1:O2; LOCAL O3,O4; O1_EXTEND((O3_LITVALUE(.STK[.LASTMARK+1]))); IF (.TOS-.LASTMARK) GTR 1 THEN O2_EXTEND((O4_LITVALUE(.STK[.LASTMARK+2]))); DELETETOMARK(); R_CASE .OPLEX[HSYNTYP] OF SET .O1+.O2; !+ .O1^8 + .O2<8,8>; !SWAB .O1/.O2; !/ 0; !. .O1-.O2; !- .O1 MOD .O2; ! MOD .O1*.O2; !* -.O1; !- .O1; !+ .O1^.O2; !^ 0; ! BIT .O1 GTR .O2; ! GTR .O1 LEQ .O2; ! LEQ .O1 LSS .O2; ! LSS .O1 GEQ .O2; ! GEQ .O1 EQL .O2; ! EQL .O1 NEQ .O2; ! NEQ NOT .O1; ! NOT .O1 EQV .O2; ! EQV .O1 AND .O2; ! AND .O1 OR .O2; ! OR .O1 XOR .O2; ! XOR 0; ! FAD 0; ! FDV 0; ! FIX 0; ! FLOAT 0; ! FMP 0; ! FNEG 0; ! FSB .O3 GTR .O4; ! GTRU .O3 LEQ .O4; ! LEQU .O3 LSS .O4; ! LSSU .O3 GEQ .O4; ! GEQU .O3 EQL .O4; ! EQLU .O3 NEQ .O4; ! NEQU 0; ! ROT IF .O1 GTR .O2 THEN .O1 ELSE .O2; !MAX IF .O2 GTR .O1 THEN .O1 ELSE .O2; !MIN TES; SYM_LITLEXEME(.R); 1 END ELSE (R_SELECT .OPLEX[HSYNTYP] OF NSET SADDOP : SPLADDCASE(.OPLEX); SMINOP : SPLADDCASE(.OPLEX); SMULOP : SPLMULCASE(.OPLEX); SDIVOP : SPLMULCASE(.OPLEX); OTHERWISE : 0 TESN; IF .R EQL 0 THEN CKANDDONAME(.OPLEX) ELSE .R) END; ! ROUTINES TO IDENTIFY NAMES TO BE USED AS CSE'S ! ---------------------------------------------- REQUIRE NCSE.RTN; ROUTINE NCINIT= BEGIN CLEARCORE(NCSE,NCSIZ*2); FLSTK[BASE]_0; NOVALUE END; ROUTINE NCINSERT(X)= BEGIN MAP LEXEME X; REGISTER N; N_NCSEARCH(.X); IF .N EQL -1 THEN RETURN NOVALUE; IF .N LSS 0 THEN NCSE[NCNDX(.N),NCST]_.X[LEXPART]; NOVALUE END; MACRO CTNDX(X)= ((X) AND (CTSIZ-1))$; MACRO CTHASH(X)= (CTNDX((X)^(-3)))$; ROUTINE CTSEARCH(CTTABLE,X)= BEGIN MAP LEXEME X; REGISTER N,E; BIND NCARY CTTBL[CTSIZ,2]=.CTTABLE; E_N_CTHASH(.X); DO IF .CTTBL[.N,CTST] EQL .X[LEXPART] THEN RETURN .N ELSE IF .CTTBL[.N,CTST] EQL 0 THEN RETURN (1^35) OR .N WHILE CTNDX(N_.N+1) NEQ .E; -1 END; ROUTINE CTINSERT(CTTABLE,X)= BEGIN MAP LEXEME X; REGISTER N; BIND NCARY CTTBL[CTSIZ,2]=.CTTABLE; N_CTSEARCH(CTTBL,.X); IF .N EQL -1 THEN RETURN -1; IF .N LSS 0 THEN CTTBL[CTNDX(.N),CTST]_.X[LEXPART]; CTNDX(.N) END; ROUTINE NAMECOUNT(CTTABLE,CHAIN)= BEGIN REGISTER STVEC L, LEXEME NAME, N; BIND NCARY CTTBL[CTSIZ,2]=.CTTABLE; L_GTHASH[.CHAIN]; WHILE .L NEQ 0 DO BEGIN SELECT .CHAIN OF NSET SSTOROP: NAME_.L[DOTTEDTHING]; SYNPAR: IF .GT[.L[OPR1],LNKGTF] EQL HBLISLNKGT THEN EXITCOMPOUND L_.L[GTHREAD] ELSE NAME_.L[OPR2] TESN; IF .NAME[LTYPF] EQL BNDVAR THEN BEGIN N_CTINSERT(CTTBL,.NAME); IF .N GEQ 0 THEN BEGIN LOCAL STVEC S,C; S_.L; C_0; DO (C_.C+1) UNTIL (S_.S[FSTHREAD]) EQL 0; CTTBL[.N,CTCNT]_.CTTBL[.N,CTCNT]+.C; END; END; L_.L[GTHREAD]; END; NOVALUE END; ROUTINE NCCOST(L)= BEGIN MAP LEXEME L; BIND STVEC N=L; REGISTER GTVEC TN; MACRO NOTPICRETURN(X) = IF .PICSW ! UNTIL SPECS FOR PIC ARE AGREED UPON THEN RETURN 0 ELSE RETURN (X) $; IF .L[LTYPF] EQL BNDVAR THEN CASE .N[TYPEF]-LOWNAMETYPE OF SET % LOCALT % IF (TN_.N[REGF]) LEQ 8 THEN RETURN 5 ELSE IF .TN[REQD] EQL SLREQDB THEN RETURN 5 ELSE RETURN 0; % OWNT % NOTPICRETURN(3); % REGT % RETURN 0; % FORMALT % IF .N[REGF] EQL SP THEN RETURN 5 ELSE RETURN 0; % EXTERNALT % NOTPICRETURN(3); % GLOBALT % NOTPICRETURN(3); 0; 0; 0; % ROUTINET, GROUTINET, FORWT % NOTPICRETURN(3); NOTPICRETURN(3); NOTPICRETURN(3) TES; 0 END; GLOBAL ROUTINE GETNCSE= BEGIN REGISTER GTVEC L,N; LOCAL GTVEC S:T,K,C; BIND NCARY CTTBL[CTSIZ,2]=GETSPACE(GT,CTSIZ*2); NCINIT(); IF FAST THEN RETURN; IF .ANYENAB OR .NPTFLG THEN RETURN; NAMECOUNT(CTTBL,SYNPAR); NAMECOUNT(CTTBL,SSTOROP); L_.GTHASH[SDOTOP]; WHILE .L NEQ 0 DO BEGIN T_NONBOGUS(.L); T_.T[OPR1]; IF (K_NCCOST(.T)) NEQ 0 THEN BEGIN S_.L; C_0; DO BEGIN REGISTER GTVEC M; M_.S; C_.C+(1-.M[BOGUSBIT]); UNTIL (M_.M[CSTHREAD]) EQL 0 DO (C_.C+.M[MUSTGENCODE]); END UNTIL (S_.S[FSTHREAD]) EQL 0; IF .C GEQ .K THEN NCINSERT(.T) ELSE BEGIN N_CTSEARCH(CTTBL,.T); IF .N GEQ 0 THEN BEGIN IF .C+.CTTBL[.N,CTCNT] GEQ .K THEN NCINSERT(.T); CTTBL[.N,CTST]_0; END; END; END; L_.L[GTHREAD]; END; DECR I FROM CTSIZ-1 TO 0 DO IF .CTTBL[.I,CTST] NEQ 0 THEN IF (K_NCCOST(.CTTBL[.I,CTST])) GTR 0 THEN IF .CTTBL[.I,CTCNT] GEQ .K THEN NCINSERT(.CTTBL[.I,CTST]); RELEASESPACE(GT,CTTBL,CTSIZ*2); NOVALUE END; ! GRAPH TABLE NODE BUILDING ROUTINES ! ---------------------------------- GLOBAL ROUTINE MAKGT(L,NODE)= !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. BEGIN REGISTER GTVEC L1,SIZE; MAP LEXEME NODE; MAP GTVEC L; EXTERNAL ABCOUNT,LEVEL; SIZE_.TOS-.LASTMARK+BASEGTNODESIZE; L1_GETSPACE(GT,.SIZE); %[1.B]% L1[NODESIZEF]_.TOS-.LASTMARK; %[1.C]% L1[NODEX]_.NODE[HSYNTYP]; %[1.D]% L1[TYPEF]_GRAPHT; L1[OCCF]_1; L1[OFFSETF]_LZERO; L1[ABCF]_.ABCOUNT; IF FAST THEN BEGIN L1[CSPARENT]_L1[FPARENT]_.L1; END ELSE IF .L EQL 0 THEN BEGIN L1[GTLDF]_L1[XGTLDF]_.LOOPDEPTH; L1[FP]_1; L1[CSP]_1; L1[FPARENT]_L1[CSPARENT]_.L1; L1[GTHREAD]_.GTHASH[.NODE[HSYNTYP]]; GTHASH[.NODE[HSYNTYP]]_.L1 END ELSE IF .L LSS 0 THEN BEGIN L_-.L; L1[GTLDF]_L1[XGTLDF]_.LOOPDEPTH; L1[CSP]_1; L1[FPARENT]_.L; L1[CSPARENT]_.L1; L1[FSTHREAD]_.L[FSTHREAD]; L[FSTHREAD]_.L1 END ELSE BEGIN REGISTER GTVEC LCS:LFP; LCS_.L AND #777777; LFP_.L^(-18); L1[GTLDF]_.LCS[XGTLDF]; L1[FPARENT]_.LFP; L1[CSPARENT]_.LCS; L1[CSTHREAD]_.LCS[CSTHREAD]; LCS[CSTHREAD]_.L1 END; IF .NODE[HSYNTYP] GTR MAXOPERATOR THEN L1[RM]_1; L1[CRLEVEL]_.LEVEL; POPTOMARK(.L1); %[1.E]% .L1 %[1.F]% END; GLOBAL ROUTINE DECROCC(CSNODE)= ! CALLED BY GENGT TO DECREASE THE OCCURRENCE ! COUNT ON THE SUBNODES OF CSNODE BEGIN MAP GTVEC CSNODE; LOCAL GTVEC L1; WHILE .CSNODE[BOGUSBIT] DO IF (CSNODE_.CSNODE[CSTHREAD]) EQL 0 THEN RETURN; DECR I FROM .CSNODE[NODESIZEF]-1 TO 0 DO BEGIN BIND LEXEME L1LEX=L1; L1_.CSNODE[OPERAND(.I)]; IF .L1LEX[LTYPF] EQL GTTYP THEN (L1_.L1[CSPARENT]; IF .L1[OCCF] GTR 0 THEN L1[OCCF]_.L1[OCCF]-1) END; END; GLOBAL ROUTINE PDETACH(NODE)= ! ! DETACHES A NODE FROM GT HASH TABLE; ! WORKS ONLY IF THE NODE CAN HAVE NO CSPARENTS, CSE USES. ! BEGIN MAP GTVEC NODE; LOCAL GTVEC L:M; IF FAST THEN RETURN; NODE_.NODE; L_M_.GTHASH[.NODE[NODEX]]; IF .L EQL .NODE THEN BEGIN ! SPECIAL CASE - NODE IS TOP OF GTHREAD CHAIN IF .NODE[FSTHREAD] EQL 0 THEN (GTHASH[.NODE[NODEX]]_.NODE[GTHREAD]; RETURN NOVALUE); L_GTHASH[.NODE[NODEX]]_.NODE[FSTHREAD]; L[GTHREAD]_.NODE[GTHREAD]; UNTIL (M_.M[FSTHREAD]) EQL 0 DO M[FPARENT]_.L; RETURN NOVALUE END; CONTINUOUSLY DO ! FIRST LOOK DOWN L'S FSTHREAD, BEGIN ! THEN TRY NEXT NODE ON GTHREAD CHAIN MACRO ITERATE=EXITBLOCK$; IF .M[FSTHREAD] EQL 0 THEN BEGIN M_.L[GTHREAD]; IF .M EQL .NODE THEN BEGIN IF .NODE[FSTHREAD] EQL 0 THEN (L[GTHREAD]_.NODE[GTHREAD]; RETURN NOVALUE); L[GTHREAD]_.NODE[FSTHREAD]; L_.L[GTHREAD]; L[GTHREAD]_.NODE[GTHREAD]; UNTIL (M_.M[FSTHREAD]) EQL 0 DO M[FPARENT]_.L; RETURN NOVALUE END; L_.M; ITERATE END; IF .M[FSTHREAD] EQL .NODE THEN (M[FSTHREAD]_.NODE[FSTHREAD]; RETURN NOVALUE); M_.M[FSTHREAD] END END; ROUTINE CHECKONELOCAL(I)= BEGIN LOCAL LEXEME L; BIND STVEC NODE=L; L_.STK[.I]; IF .L[LTYPF] EQL GTTYP THEN IF .NODE[NODEX] EQL SYNPOI THEN BEGIN LOCAL LEXEME LEX; LEX_.NODE[OPR1]; IF .NODE[OPR2] EQL ZERO THEN IF LITVALUE(.NODE[OPR3]) MOD 8 EQL 0 THEN BEGIN PDETACH(.L); RELEASESPACE(GT,.NODE,BASEGTNODESIZE+3); STK[.I]_.LEX; CHECKONELOCAL(.I); RETURN END; WARNEM(0,ERILLPTR); RETURN END; IF .L[LTYPF] NEQ BNDVAR THEN RETURN; IF .NODE[TYPEF] EQL REGT THEN (ERRINFO[0]_.NODE; WARNEM(0,BADSYMERR); STK[.I]_ZERO; RETURN); IF .NODE[TYPEF] NEQ LOCALT THEN RETURN; IF .NODE[REGF] LSS 8 THEN RETURN; NODE_.NODE[REGF]; NODE[REQD]_SLREQDB; NODE[LONLU]_NODE[FONLU]_ -2; % ETERNITY - 1 % NOVALUE END; ROUTINE CHECKLOCALS(L)= BEGIN SELECT .L OF NSET HDOT: RETURN; HPOINTOPEN: RETURN; HMOVP: RETURN; HSTORE: RETURN CHECKONELOCAL(.LASTMARK+2); ALWAYS: DECR I FROM .TOS TO .LASTMARK+(SELECT .L OF NSET HINCR: EXITSELECT 2; HDECR: EXITSELECT 2; ALWAYS: 1 TESN) DO CHECKONELOCAL(.I); TESN END; FORWARD BINDBIND; ROUTINE GENGT(LEX)= ! ! GENERATE A GT-LEXEME FOR THE LEXEMES AT THE TOP ! OF 'STK'. THIS MAY INVOLVE EITHER RE-RECOGNITION ! OF AN EXISTING NODE OR GENERATION OF A NEW ONE. ! BEGIN MACRO NOCSESYM(LEX) = ! ! TRUE IF .'LEX' MAY NOT BE A COMMON SUB-EXPRESSION ! BEGIN MAP LEXEME LEX; BIND GTVEC NODE=LEX; IF .LEX[LTYPF] EQL BNDVAR THEN IF .NODE[SIZEF] NEQ 16 THEN TRUE ELSE IF (SELECT .LEX[ADDRF] OF NSET .VVREG: 0; .SPREG: 0; .PCREG: 0 TESN) EQL 0 THEN TRUE END $; MAP LEXEME LEX; REGISTER GTVEC NEW; LOCAL L,GTVEC L1; BIND GTVEC CSNODE=L; IF .ERRORFOUND NEQ 0 THEN RETURN ZERO; IF .NOTREE THEN (DELETETOMARK(); RETURN ZERO); INCR I FROM .LASTMARK+1 TO .TOS DO STK[.I]_BINDBIND(.STK[.I]); CASE CKANDDOK(.LEX) OF SET 0; RETURN(.SYM); LEX_.SYM TES; CHECKLOCALS(.LEX); L_GTSEARCH(.LEX); NEW_MAKGT(.L,.LEX); IF SLOW THEN SELECT .LEX OF NSET HDOT : EXITSELECT BEGIN L1_.NEW[DOTTEDTHING]; IF NOCSESYM(L1) THEN NEW[RM]_1; ENTVUSELST(.NEW[DOTTEDTHING],.NEW); END; HSTORE : BEGIN MRKDOTNODES(.NEW[STOREDINTHING]); ENTVCHGLST(.NEW[STOREDINTHING],.NEW) END TESN; GENPRLG(.NEW); IF .L LEQ 0 THEN (NEW[MUSTGENCODE]_1;RETURN FASTLEXOUT(GTTYP,.NEW)); DECROCC(.CSNODE); L1_.CSNODE[CSPARENT]; L1[OCCF]_.L1[OCCF]+1; FASTLEXOUT(GTTYP,.NEW) END; ROUTINE FPARSEARCH(LEX)= ! SEARCHES TREE FOR FORMALLY IDENTICAL PARENT OF OPERATOR-OPERAND(S) ! SUBTREE. RETURNS INDEX OF PARENT IF IT SUCCEEDS, -1 OTHERWISE. BEGIN MAP LEXEME LEX; MACRO SIZE=.TOS-.LASTMARK-1$; LOCAL FPARINDEX, LEXEME STKLEX:NODELEX; REGISTER GTVEC L:M; M_.GTHASH[.LEX]; FPARINDEX_0; WHILE .M NEQ 0 DO BEGIN L_NONBOGUS(.M); IF ((SIZE)+1) EQL .L[NODESIZEF] THEN FPARINDEX_ DECR J FROM SIZE TO 0 DO BEGIN BIND GTVEC STKLEXPTR=STKLEX, GTVEC NODELEXPTR=NODELEX; STKLEX_.STK[.LASTMARK+.J+1]; NODELEX_.L[OPERAND(.J)]; IF .STKLEX[LTYPF] NEQ .NODELEX[LTYPF] THEN EXITLOOP 0; IF .STKLEX[LTYPF] GEQ LOWFLOLSTTYPE THEN EXITBLOCK; IF .STKLEX[LTYPF] EQL GTTYP THEN (IF .STKLEXPTR[FPARENT] NEQ .NODELEXPTR[FPARENT] THEN EXITLOOP 0) ELSE (IF .STKLEX NEQ .NODELEX THEN EXITLOOP 0) END; IF .FPARINDEX LSS 0 THEN RETURN .M; M_.M[GTHREAD] END END; ROUTINE GTSEARCH(LEX)= ! SEARCHES TREE FOR POTENTIAL C-S-E GIVEN IT HAS FOUND FORMAL PARENT ! (VIA FPARSEARCH). IT RETURNS VALUES AS FOLLOWS: ! NO FORMAL PARENT: 0 ! NOT C-S-E: -(FORMAL-PARENT-INDEX) ! C-S-E: FORMAL-PARENT-INDEX,,C-S-E-INDEX BEGIN MAP LEXEME LEX; REGISTER GTVEC L,F; LOCAL GTVEC FPARINDEX:CSINDEX; IF FAST THEN RETURN 0; FPARINDEX_L_FPARSEARCH(.LEX); IF .FPARINDEX LSS 0 THEN RETURN 0; IF .LEX[HSYNTYP] GTR MAXOPERATOR THEN RETURN (-.FPARINDEX); F_.FLOOR[CVAL]; CSINDEX_ DO BEGIN IF NOT .L[PURGEBIT] THEN IF NOT .L[RM] THEN IF .L[CRLEVEL] GEQ .F THEN EXITLOOP .L END WHILE (L_.L[FSTHREAD]) NEQ 0; IF .CSINDEX LSS 0 THEN RETURN (-.FPARINDEX); IF .CSINDEX[BOGUSBIT] THEN IF .CSINDEX[OCCF] EQL 0 THEN BINDPCSTHREAD(.CSINDEX); (.FPARINDEX^18) OR (.CSINDEX AND #777777) END; GLOBAL ROUTINE FAKECSE(NODE)= BEGIN ! FAKE A CSE MAP GTVEC NODE; REGISTER GTVEC X:CPNODE; IF .NOTREE THEN RETURN ZERO; CPNODE_.NODE[CSPARENT]; IF (CPNODE[OCCF]_.CPNODE[OCCF]+1) EQL 1 THEN RETURN .NODE; X_GETSPACE(GT,BASEGTNODESIZE); MOVECORE(.NODE,.X,BASEGTNODESIZE); X[NODEX]_SYNNULL; X[NODESIZEF]_0; CPNODE[DONTUNLINK]_TRUE; ! NOT NECESSARY, BUT SAVES TIME IN UNDOCSE. X[CSTHREAD]_.CPNODE[CSTHREAD]; CPNODE[CSTHREAD]_.X; X[CRLEVEL]_.CPNODE[CRLEVEL]; X[FPARENT]_IF .CPNODE[NODEX] EQL SFPARM THEN .CPNODE ELSE .CPNODE[FPARENT]; FASTLEXOUT(GTTYP,.X) END; GLOBAL ROUTINE BINDBIND(LEX)= BEGIN MAP LEXEME LEX; BIND STVEC LEXST=LEX; IF .LEX[LTYPF] EQL BNDVAR THEN IF .LEXST[TYPEF] EQL MBINDT THEN BEGIN LEX_.LEXST[BINDLEXF]; IF .LEX[LTYPF] EQL GTTYP THEN LEX_FAKECSE(.LEX) END; RETURN .LEX END; GLOBAL ROUTINE DYNBIND= BEGIN MARKSTK(); PUSH(.SYM); SYM_GENGT(HFPARM); PUSH(.SYM); STSYM[RM]_0; END; BIND ! 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, 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, FENABLAB=36, FENAB0=37, FENAB1=38, FXXX=0; MACRO PRERUEX(QQ)= IF .ERRORFOUND EQL 0 THEN CASE (QQ) OF SET 0; !0 F20(); !1 F8(); !2 F8(); !3 F5(); !4 F1(); !5 0; !6 F9(); !7 F1(); !8 0; !9 F9(); !10 F10(); !11 F6(); !12 0; !13 0; !14 0; !15 F8(); !16 F5(); !17 0; !18 0; !19 0; !20 F0(); !21 0; !22 0; !23 F0(); !24 F12(); !25 0; !26 0; !27 0; !28 0; !29 0; !30 0; !31 0; !32 0; !33 0; !34 0; !35 0; !36 F22(); !37 0; !38 TES;$; MACRO POSTRUEX(QQ)= IF .ERRORFOUND EQL 0 THEN CASE (QQ) OF SET 0; !0 F15(); !1 F4(); !2 F4(); !3 0; !4 F19(); !5 0; !6 F18(); !7 F9(); !8 F26(); !9 F16(); !10 F17(); !11 0; !12 F9(); !13 F11(); !14 F27(); !15 F4(); !16 0; !17 F9(); !18 0; !19 0; !20 F7(); !21 0; !22 0; !23 F14(); !24 0; !25 F9(); !26 F9(); !27 F9(); !28 F13(); !29 F3(); !30 0; !31 F4(); !32 F24(); !33 F25(); !34 F2(); !35 F21(); !36 0; !37 F23(); !38 TES;$; ! GENERAL ERROR HANDLING CONSTUCTS ! -------------------------------- MACRO ERROR(A,B,C,D)=ERRORR(D,C,B,A)$, RERR=RETURN ERROR$; FORWARD RUNC; GLOBAL ROUTINE ERRORR(NUM,TYPE,POS,LASTOPEN)= !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". BEGIN STRUCTURE STOPMATRIX[I,J]=(.STOPMATRIX+(.I-1)*J+(.J-1))<0,36>; BIND STOPMATRIX PANICSTOP[17,3]=PLIT( HSEMICOLON,HPARACLOSE,-1, ! ERRORS BETWEEN "(" AND ")" ! (BLOCK) HSEMICOLON,HEND,-1, ! ERRORS BETWEEN "BEGIN" AND "END" HOF,-1,-1, ! ERRORS BETWEEN "CASE" (OR "SELECT") AND "OF" HTES,-1,-1, ! MISSING "OF" OR "SET" HTES,HSEMICOLON,-1, ! ERRORS BETWEEN "SET" AND "TES" HTESN,-1,-1, ! MISSING "OF" OR "NSET" HTESN,HCOLON,HSEMICOLON, ! ERRORS BETWEEN "NSET" AND "TESN" HELBANE,HCOLON,HSEMICOLON, ! ERRORS BETWEEN "ENABLE" AND "ELBANE" HCOMMA,HSEMICOLON,-1, ! ERRORS BETWEEN "[" AND ";" HCOMMA,HSQBCLOSE,-1, ! ERRORS BETWEEN ";" (OR "[") AND "]" HCOMMA,HPARACLOSE,-1, ! ERRORS BETWEEN "(" AND ")" ! (ROUTINE CALL OR PLIT) HPARACLOSE,-1,-1, ! ERRORS BETWEEN "(" AND ")" ! (LINKAGE DECLARATION) ! OR MISSING ")" IN BLOCK HDOCLOSE,-1,-1, ! ERRORS BETWEEN "INCR" (OR "DECR" OR ! "WHILE" OR "UNTIL") AND "DO" HWHILECLOS,HUNTILCLOS,-1, ! ERRORS BETWEEN "DO" AND "WHILE" (OR "UNTIL") HTHEN,-1,-1, ! ERRORS BETWEEN "IF" (OR "LENGTH") AND "THEN" HCRAT,-1,-1, ! ERRORS BETWEEN "CREATE" AND "AT" HLENGTH,-1,-1, ! ERRORS BETWEEN "AT" AND "LENGTH" HSEMICOLON,-1,-1, ! ERRORS IN DECLARATIONS HPOINCLOSE,-1,-1, ! ERRORS IN STRUCTURE EXPANSION HEND,-1,-1 ); ! MISSING "END" LOCAL SAVERL; SAVERL_.ERRLEVEL; ERRPRNT(.LASTOPEN,.POS,.NUM); %[1.A]% ERRLEVEL_1; RUNC(1); %[1.B]% WHILE (IF .LINCNT LEQ .LASTLINE THEN IF .TYPE NEQ 0 THEN IF .DEL NEQ .PANICSTOP[.TYPE,1] THEN IF .DEL NEQ .PANICSTOP[.TYPE,2] THEN .DEL NEQ .PANICSTOP[.TYPE,3]) DO (RUND(QLLEXEME); RUNC(0)); ERRLEVEL_.SAVERL; RETURN 1 !NOT SURE THIS IS USEFUL END; ROUTINE RUNC(FIRSTRUNC)= !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. CONTINUOUSLY DO CASE .DEL[HCLASS] OF SET % OPENBRAC % BEGIN EXTERNAL SPLITB; IF .FIRSTRUNC THEN IF .DEL EQL HMODULE OR .DEL EQL HRETURN OR .DEL EQL HEXITLOOP THEN (RUND(QLLEXEME); EXITCASE); ERRLEVEL_0; IF .INDECL THEN SELECT .DEL OF NSET HCOMPOPEN: (LOCAL DUMMY; SPLITB(DUMMY); EXITCOND); HSQBOPEN: (DO (RUND(QLLEXEME); EXPRESSION()) UNTIL .DEL EQL HSQBCLOSE; RUND(QLLEXEME); EXITCOND); HPOINTOPEN: (DO (RUND(QLLEXEME); EXPRESSION()) UNTIL .DEL EQL HPOINCLOSE; RUND(QLLEXEME); EXITCOND); OTHERWISE: XCTSYNTAX TESN ELSE XCTSYNTAX; ERRLEVEL_1; END; % OP % IF .DEL EQL HSTORE THEN RETURN ELSE RUND(QLLEXEME); % CLOBRAC % RETURN; % DCLRTR % (ERRLEVEL_0; ERRDECL(); ERRLEVEL_1) TES; ROUTINE SERROROP = ERROR(.NDEL,.NDEL,.LASTEND,NOOPERATOR); ROUTINE SMODERR = ERROR(.NDEL,.NDEL,.LASTEND,ERSYINVMDEC); GLOBAL ROUTINE RUNDE= (RUND(QLLEXEME); IF .SYM NEQ HEMPTY THEN (ERROR(.NSYM,.NSYM,.LASTEND,ERSYMFOL); 1)); ! GENERAL SYNTAX ROUTINES ! ----------------------- ! UTILITY BOOLEAN ROUTINES ROUTINE SEFOLLOWS= .DEL[HSE] AND (.SYM EQL HEMPTY XOR .DEL[HMT]); ROUTINE AEFOLLOWS= .DEL[HAE] AND (.SYM EQL HEMPTY XOR .DEL[HMT]); ! MACROS TO SAVE (RESTORE) GLOBALS AT ROUTINE & BLOCK ENTRY (EXIT) MACRO SAVEGLOBALS(LOCALBLOCK,GLOBALSLIST,LENTH)= DECR I FROM LENTH-1 TO 0 DO (LOCALBLOCK+.I)_..(GLOBALSLIST+.I)$, RESTGLOBALS(LOCALBLOCK,GLOBALSLIST,LENTH)= DECR I FROM LENTH-1 TO 0 DO .(GLOBALSLIST+.I)_.(LOCALBLOCK+.I)$; GLOBAL ROUTINE RNAMEFOLLOWS(RNAME)= BEGIN BIND DOGARB=2; MAP STVEC RNAME; LOCAL SAVEBLOCK[10]; EXTERNAL LEVELINC; BIND SAVEPLIT=PLIT(ANYENAB, CURROUT, LASTPUR, RBLOCKLEVEL, MAXLOCALS, NUMPARMS, MAXPARMS, NEXTLOCAL, LEVELINC, TNCHAIN); BIND LEXEME RRNAME=RNAME; EXTERNAL CLEANUPFLOW; INIT; SAVEGLOBALS(SAVEBLOCK,SAVEPLIT,10); LASTPUR_.PURGED; ANYENAB_0; TNCHAIN<18,18>_TNCHAIN<0,18>_TNCHAIN; NEXTLOCAL_MAXLOCALS_0; NUMPARMS_MAXPARMS_0; BLOCKLEVEL_RBLOCKLEVEL_.BLOCKLEVEL+1; IF PROCPARMS(.RNAME) THEN BEGIN IF .DEL NEQ HEQUAL THEN EXITCOMPOUND ERROR(.LOBRAC,.NDEL,.LASTEND,ERREQRDEC); CURROUT_.RRNAME[ADDRF]; MARKELSTK(); RUEXPUSH(FBODY0); LASTELMARK_POPELSTK(); PUSH(LEXOUT(BNDVAR,.RNAME)); IF .DEL EQL HCOMMA THEN FSYMPROTECT(); BLOCKPURGE(); GETNCSE(); FIN(DCROUTINE,FBODY1); GENIT(); CLEANUPFLOW(); IF .GARBCNT LSS 0 THEN (GARBAGECOLLECT();GARBCNT_DOGARB); END; RESTGLOBALS(SAVEBLOCK,SAVEPLIT,10); END; GLOBAL ROUTINE EXPRESSION= !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. BEGIN LABEL L; LINIT; INEXP; IF .DEL EQL HCOLON %[1.A]% THEN IF SLABEL() THEN (RESINDECL; RETURN); WHILE .DEL[HCLASS] NEQ CLOBRAC DO %[1.B]% L: IF AEFOLLOWS() %[1.B.1]% THEN XCTSYNTAX %[1.B.1.A]% ELSE IF .DEL[HCLASS] EQL DCLRTR THEN (ERRPRNT(.LOBRAC,.NDEL,DCLERR); %[1.B.1.B.1](4)% DO (ERRDECL(); RUND(QLLEXEME)) UNTIL .DEL[HCLASS] NEQ DCLRTR; LEAVE L) ELSE ERROR(.LOBRAC,.NDEL,.LASTEND,EXPRERR); %[1.B.1.B.2]% RESINDECL; LCBRAC_.NDEL END; ROUTINE GETBLOCKNAME(DEST,ISBEGIN)= ! 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 ")". BEGIN .DEST_0; IF .DEL NEQ HBACKSLASH THEN RETURN; IF .SYM NEQ HEMPTY THEN RERR(.LOBRAC,.NSYM,.LASTEND,ERINVBNSYN); RUND(QLQNAME); IF .SYM[LTYPF] EQL UNBNDVAR THEN SYM_LEXOUT(BNDVAR,.STSYM[SYMLINK]) ELSE IF .SYM[LTYPF] NEQ BNDVAR THEN RERR(.LOBRAC,.NSYM,.LASTEND,ERINVBNARG); IF .DEL NEQ HBACKSLASH THEN RERR(.LOBRAC,.NDEL,.LASTEND,ERINVBNSYN); .DEST_.SYM; IF .ISBEGIN THEN RUND(QLLEXEME) ELSE RUNDE() END; ROUTINE SCOMPOUND= !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. BEGIN LOCAL DCLR; LOCAL BNAME,ENAME,SAVEND; LOCAL SAVEBLOCK[8]; EXTERNAL ABCOUNT; BIND SAVEPLIT= PLIT (ENABFLG, INDECL, NEXTLOCAL, XSAVEPLIT NAMES NOTREE, FLAGS, STRUDEFV, DFLTLNKGLX, SAVLAB INDEXES COMPLAB); REGISTER WHICHTYPE; BIND CHOICEPLIT=PLIT( PSTYPE NAMES PSENDSEM,PSPARSEM, SPSTYPE NAMES PSEND,PSPAR, CLOSEDEL NAMES HEND,HPARACLOSE, XCLOSEDEL NAMES HPARACLOSE,HEND ); INIT; SAVEGLOBALS(SAVEBLOCK,SAVEPLIT,3); ENABFLG_0; WHICHTYPE_.DEL[HUNIQ]/2; ! 0 FOR BEGIN, 1 FOR LEFT PAREN NEWLASTEND(.PSTYPE[.WHICHTYPE]); RUND(QLLEXEME); GETBLOCKNAME(BNAME,TRUE); IF DCLR_(.DEL[HCLASS] EQL DCLRTR) THEN (SAVEGLOBALS(SAVEBLOCK[3],XSAVEPLIT,5); DCLARE(); MARKMMNODES()); INCABC; WHILE (EXPUSH(FNULL); .DEL EQL HSEMICOLON) DO (MARKMMNODES(); RUND(QLLEXEME)); IF .DCLR THEN (IF .DEL NEQ .CLOSEDEL[.WHICHTYPE] THEN FSYMPROTECT(); BLOCKPURGE(); RESTGLOBALS(SAVEBLOCK[3],XSAVEPLIT,4)); IF .NEXTLOCAL GTR .MAXLOCALS THEN MAXLOCALS_.NEXTLOCAL; IF .NDEL GTR .LASTLINE THEN (DEL_.CLOSEDEL[.WHICHTYPE]; ERRPRNT(.LOBRAC,.LOBRAC,ERMSEND); ERRLEVEL_1) ELSE IF .DEL NEQ .CLOSEDEL[.WHICHTYPE] THEN IF .DEL EQL .XCLOSEDEL[.WHICHTYPE] THEN RETURN ERRPRNT(.LOBRAC,.NDEL,BRACERR) ELSE ERROR(.LOBRAC,.NDEL,.SPSTYPE[.WHICHTYPE],ERMSEND); RESLASTEND; SAVEND_.NDEL; RUNDE(); GETBLOCKNAME(ENAME,FALSE); IF (.BNAME OR .ENAME) NEQ 0 THEN IF .BNAME NEQ .ENAME THEN (ERRINFO[0]_.BNAME; ERRINFO[1]_.ENAME; WARNEM(.SAVEND,WABLKMTCH)); IF .ENABFLG THEN BEGIN FIN(HCOMP2,FNULL); STSYM[ENABIT]_TRUE; PUSH(.SYM); POSTRUEX(FLAB0); SELABEL(.COMPLAB); FIN(HLABUSE,FENABLAB); COMPLAB[LINKFLD]_.SYM; COMPLAB[LEFTBIT]_TRUE; COMPLAB_.SAVEBLOCK[SAVLAB]; POPELSTK(); END ELSE IF .TOS-.LASTMARK GTR 1 THEN FIN(HCOMP,FNULL) ELSE XFIN(0,FNULL); RESTGLOBALS(SAVEBLOCK,SAVEPLIT,3); END; ROUTINE SOPERATOR= !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. BEGIN LOCAL LEXEME OP,AOFLAG; INIT; OP_.DEL; IF (.SYM EQL HEMPTY) XOR (NOT .OPNOTUNARY) %[2.A]% THEN (WARNEM(.NDEL,OPERR1); SYM_ZERO); IF .OPNOTUNARY THEN PUSH(.SYM); %[2.B]% AOFLAG_ .OP EQL HAND OR .OP EQL HOR; IF .AOFLAG THEN F0(); ! KLUDGE TO PREVENT CSE CREATION IN FLOW BOOLEANS. RUND(QLLEXEME); WHILE (.DEL[HPRIORITY] LEQ .OP[HPRIORITY]) DO %[3.A](7)% BEGIN IF .DEL[HPRIORITY] EQL .OP[HPRIORITY] THEN IF NOT .OP[HFORCER2L] THEN EXITLOOP; IF SEFOLLOWS() THEN XCTSYNTAX ELSE ERROR(.LOBRAC,.NDEL,.LASTEND, IF NOT .DEL[HSE] THEN OPERR2 ELSE OPERR3); END; IF .SYM EQL HEMPTY THEN RERR(.LOBRAC,.NDEL,.LASTEND,OPERR4); PUSH(.SYM); %[4.A]% FIN(.OP,FNULL); IF .AOFLAG THEN F14(); ! KLUDGE TO PREVENT CSE CREATION IN FLOW BOOLEANS. END; ROUTINE SIF= ! !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. BEGIN LOCAL C1,C2; INIT; NEWLASTEND(PSTHEN); RUEXPUSH(FIF0); %[2.A]% SYM_STK[.TOS]_BINDBIND(.SYM); IF (C1_ISALIT(SYM)) THEN BEGIN IF .ERRORFOUND EQL 0 THEN (POPANDDUMP(CEILING); RELLST(.STK[.TOS-1]); STK[.TOS-1]_.STK[.TOS]; TOS_.TOS-1); IF NOT (C2_LITVALUE(.SYM)) THEN NOCODE; END; RESLASTEND; IF .DEL NEQ HTHEN %[3.A](2)% THEN RERR(.LOBRAC,.NDEL,.LASTEND,IFERR) ELSE IF .C1 THEN RUEXPUSH(FNULL) ELSE RUEXPUSH(FIF1); %[3.B]% IF .C1 THEN IF .C2 THEN NOCODE ELSE RESNOTREE; IF .DEL NEQ HELSE %[4.A](3)% THEN CONSTPUSH(ZERO,FIF2) ELSE IF .C1 THEN RUEXPUSH(FNULL) ELSE RUEXPUSH(FIF2); IF .C1 THEN (IF .C2 THEN RESNOTREE; XFIN(2-.C2<0,1>,FCIF)) ELSE FIN(HIF,FIF3) END; ROUTINE SWU= ! !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. BEGIN LOCAL SWUTYPE; INIT; NEWLASTEND(PSDO); SWUTYPE_.DEL; %[1.A]% LOOPDEPTH_.LOOPDEPTH+1; RUEXPUSH(FWUD0); %[2.A]% RESLASTEND; IF .DEL NEQ HDOCLOSE %[3.A](2)% THEN RERR(.LOBRAC,.NDEL,.LASTEND,WUERR); RUEXPUSH(FWUD1); %[3.B]% LOOPDEPTH_.LOOPDEPTH-1; MARKSTK(); FIN(HNULL,FNULL); PUSH(.SYM); FIN(.SWUTYPE,FWUD2) END; ROUTINE SDO= ! !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. BEGIN LOCAL SDOTYPE; INIT; NEWLASTEND(PSWU); LOOPDEPTH_.LOOPDEPTH+1; RUEXPUSH(FDWU0); %[2.A]% RESLASTEND; IF .DEL NEQ HDOWHILE AND .DEL NEQ HDOUNTIL %[3.A](2)% THEN RERR(.LOBRAC,.NDEL,.LASTEND,DOERR); SDOTYPE_.DEL; %[3.B]% RUEXPUSH(FDWU1); %[3.C]% LOOPDEPTH_.LOOPDEPTH-1; MARKSTK(); FIN(HNULL,FNULL); PUSH(.SYM); FIN(.SDOTYPE,FDWU2) END; ROUTINE SREP= ! !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. BEGIN LOCAL L1,L2,SREPTYPE,EXECUTE,FROMPART,TOPART; INIT; SREPTYPE_.DEL; %[1.A]% IF NOT INCRDECRREG() THEN RETURN; QNATOLEX(); PUSH(.SYM); NEWLASTEND(PSDO); IF .DEL NEQ HFROM %[2.A](3)% THEN PUSH(DFROM) ELSE RUEXPUSH(FID00); FROMPART_.STK[.TOS]; IF .DEL NEQ HTO %[2.B](3)% THEN PUSH(IF .SREPTYPE NEQ HDECR THEN DTOI ELSE DTOD) ELSE RUEXPUSH(FID00); TOPART_.STK[.TOS]; EXECUTE_TRUE; IF ISALIT(FROMPART) THEN IF ISALIT(TOPART) THEN BEGIN FROMPART_EXTEND(LITVALUE(.FROMPART)); TOPART_EXTEND(LITVALUE(.TOPART)); IF (IF .SREPTYPE EQL HINCR THEN .FROMPART GTR .TOPART ELSE .FROMPART LSS .TOPART) THEN (EXECUTE_FALSE; IF .ERRORFOUND EQL 0 THEN TOS_.TOS-3); END; IF .DEL NEQ HBY %[2.C](3)% THEN PUSH(DBY) ELSE RUEXPUSH(FID00); RESLASTEND; IF .DEL NEQ HDOCLOSE %[3.A](2)% THEN RERR(.LOBRAC,.NDEL,.LASTEND,REPERR2); IF .EXECUTE THEN BEGIN LOOPDEPTH_.LOOPDEPTH+1; RUEXPUSH(FID0); %[3.B]% LOOPDEPTH_.LOOPDEPTH-1; END ELSE BEGIN NOCODE; RUEXPUSH(FNULL); RESNOTREE; STK[.TOS]_MINONE; END; BLOCKPURGE(); IF .EXECUTE %[3.C]% THEN FIN(.SREPTYPE,FID1) ELSE FIN(HCOMP,FNULL) END; ROUTINE DC= ! CALLED BY STRUPICKOFF,SSQOPEN BEGIN SYM_BINDBIND(.SYM); IF .SYM[LTYPF] EQL GTTYP THEN (BIND CSPPTR CSYM=SYM; CSYM[OCCF]_.CSYM[OCCF]-1) ELSE -1 END; GLOBAL ROUTINE STRUPICKOFF(CLOSEDEL, ACTUALS, MAXSIZE, DEFAULT, LITERAL)= BEGIN MACRO CLOSEBRACKET=(.DEL EQL .CLOSEDEL)$; MAP STVEC ACTUALS; LOCAL INDEX, RUNDAGAIN, FILLAGAIN; LINIT; INDEX_0; RUNDAGAIN_NOT CLOSEBRACKET; FILLAGAIN_.MAXSIZE NEQ 0; NEWLASTEND(IF .CLOSEDEL EQL HSQBCLOSE THEN PSCOMSQBC ELSE PSCOMSEM); DO BEGIN IF .RUNDAGAIN THEN BEGIN RUND(QLLEXEME); IF (.SYM EQL HEMPTY) AND (CLOSEBRACKET OR (.DEL EQL HCOMMA)) THEN (IF CLOSEBRACKET THEN RUNDAGAIN_FALSE; SYM_.DEFAULT) ELSE (IF NOT .FILLAGAIN THEN IF .MANYACTS EQL 0 THEN (WARNEM(.NSYM,ERXACTS); MANYACTS_1); EXPRESSION(); DC(); IF .LITERAL THEN (IF NOT LITRESULT THEN (WARNEM(.NSYM,ERMBADEXP); SYM_.DEFAULT); SIZE_.SIZE*LITVALUE(.SYM)); IF CLOSEBRACKET THEN RUNDAGAIN_FALSE ELSE IF .DEL NEQ HCOMMA THEN RERR(.LOBRAC,.NDEL,RESLASTEND,ERMAPLD)) END ELSE SYM_.DEFAULT; IF .FILLAGAIN THEN (FILLAGAIN_.INDEX LSS (.MAXSIZE-1); ACTUALS[.INDEX,0,36]_.SYM; INDEX_.INDEX+1) END WHILE .FILLAGAIN OR .RUNDAGAIN; MANYACTS_0; RESLASTEND; END; ROUTINE SSQOPEN= BEGIN LOCAL STVEC STRUCT:INCACTS:ACTUALS, NUMACTS, BYTESVAL, SVMNACTS; MACRO GETACTSPACE=(ACTUALS_GETSPACE(ST,2*((NUMACTS_.STRUCT[NUMPARM])+1)+1); ACTUALS[STKLEN]_2*(.NUMACTS+1); ACTUALS[STKNEXT]_0)$; INCACTS_0; SVMNACTS_.MANYACTS; MANYACTS_0; IF (IF .SYM[LTYPF] NEQ BNDVAR THEN BEGIN STRUCT_.STRUDEFV; BYTESVAL_LITLEXEME(2); TRUE END ELSE BEGIN MAP STVEC SYM; IF .SYM[TYPEF] EQL STRUCTURET THEN (STRUCT_.SYM; GETACTSPACE; RUND(QLLEXEME); BYTESVAL_LITLEXEME(2); SELECT .DEL OF NSET HBYTE: IF .SYM EQL HEMPTY THEN (BYTESVAL_ONE; EXITSELECT RUND(QLLEXEME)); HWORD: IF .SYM EQL HEMPTY THEN (EXITSELECT RUND(QLLEXEME)) TESN; EXPRESSION(); IF DC() EQL 0 THEN SYM[ADDRF]_.STSYM[CSPARENT]; ACTUALS[1,0,36]_.SYM; ACTUALS[2,0,36]_.BYTESVAL; STRUPICKOFF(HSEMICOLON,.ACTUALS+3,.NUMACTS,ONE,FALSE); FALSE) ELSE (BYTESVAL_LITLEXEME(BYTES(SYM)); MANYACTS_.SYM[UNLIMACTS]; IF .SYM[HAVNOACTS] THEN STRUCT_IF .SYM[STRUORIACT] EQL 0 THEN .STRUDEFV ELSE .SYM[STRUORIACT] ELSE (INCACTS_.SYM[STRUORIACT]; STRUCT_.INCACTS[STRUCF]); TRUE) END) THEN BEGIN GETACTSPACE; IF .INCACTS EQL 0 THEN SETCORE(ACTUALS[2],.NUMACTS+1,ONE) ELSE MOVECORE(INCACTS[1],ACTUALS[2],.NUMACTS+1); IF DC() EQL 0 THEN SYM[ADDRF]_.STSYM[CSPARENT]; ACTUALS[1,0,36]_.SYM; IF .INCACTS EQL 0 THEN ACTUALS[2,0,36]_.BYTESVAL; END; STRUPICKOFF(HSQBCLOSE,.ACTUALS+3+.NUMACTS,.NUMACTS,ZERO,FALSE); MANYACTS_.SVMNACTS; ESTRU(.STRUCT[BODYSTRM],.ACTUALS,.STRUCT,0); STRMRELEASE(.ACTUALS) END; ROUTINE SPAR= ! !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. BEGIN LOCAL LNKG,RTNAME,SAVNP,LIMIT,PLENDED; INIT; PLENDED_FALSE; LIMIT_STKSIZE; ! SEE TN.BEG IF .SYM[LTYPF] NEQ BNDVAR THEN (LNKG_.DFLTLNKGLX; RTNAME_.SYM) ELSE SELECT .STSYM[TYPEF] OF NSET LNKGNMT: BEGIN LNKG_.SYM; IF .STSYM[LNKGTF] EQL IOTLNKGT THEN RTNAME_ZERO ! IOT HAS NO ROUTINE 'NAME' ELSE BEGIN RUND(QLLEXEME); EXPRESSION(); RTNAME_.SYM; PLENDED_(.DEL EQL HPARACLOSE) END END; SPECFUNT: BEGIN MAP STVEC LNKG; IF .STSYM[WHICHF] GEQ 4 ! SWAB,CARRY,OVERFLOW THEN RETURN SSPECIALOP(.STSYM[WHICHF]-4); LNKG_LEXOUT(BNDVAR,.STSYM[LNKGNMF]); RTNAME_.SYM; LIMIT_.ST[.LNKG[LNKGDESCF],LNKGSIZEF]+.NUMPARMS END; OTHERWISE: BEGIN IF NOT ISEXP(SYM) THEN (WARNEM(.NSYM,BADSYMERR); RTNAME_ZERO; LNKG_.DFLTLNKGLX) ELSE (RTNAME_.SYM; LNKG_LEXOUT(BNDVAR,.STSYM[LNKGNMF])) END TESN; PUSH1(.LNKG); %[0.A]% PUSH1(.RTNAME); %[1.A]% NEWLASTEND(PSPARCOM); IF NOT .PLENDED THEN (RUND(QLLEXEME); IF .SYM EQL HEMPTY THEN IF .DEL EQL HPARACLOSE THEN PLENDED_TRUE); IF NOT .PLENDED THEN WHILE 1 DO BEGIN MARKSTK(); %[2.A.1](6)% IF .NUMPARMS EQL .LIMIT THEN (WARNEM(.NDEL,WATMPARMS); NOCODE); EXPUSH(FCALL0); SYM_GENGT(HFPARM); PUSH(.SYM); NUMPARMS_.NUMPARMS+1; IF .DEL NEQ HCOMMA THEN EXITLOOP; %[2.A.2]% RUND(QLLEXEME) %[2.A.3]% END; IF .ERRORFOUND EQL 0 THEN BEGIN IF .NUMPARMS GTR .MAXPARMS THEN MAXPARMS_.NUMPARMS; IF .NUMPARMS GTR .LIMIT THEN (RESNOTREE; TOS_.TOS-(.NUMPARMS-.LIMIT); NUMPARMS_.LIMIT); NUMPARMS_.NUMPARMS-(.TOS-.LASTMARK-2); END; RESLASTEND; IF .DEL NEQ HPARACLOSE THEN RERR(.LOBRAC,.NDEL,.LASTEND,PARAERR); RUNDE(); %[3.A]% FIN(HPARAOPEN,FCALL1); %[3.B]% MARKSTK(); PUSH(.SYM); SYM_GENGT(HFSTORE) END; ROUTINE SSPECIALOP(INDEX)= ! ! 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 ! BEGIN LOCAL TYPE; LINIT; IF ONEOF(.INDEX,BIT2(1,2)) ! THEN (WARNEM(.NSYM,NOTIMPL); NOCODE); ! NEWLASTEND(PSPAR); IF ONEOF(.INDEX,BIT2(1,2)) THEN RUEXPUSH(FCARRYOV0) ELSE RUEXPUSH(FNULL); RESLASTEND; IF .DEL NEQ HPARACLOSE THEN RERR(.LOBRAC,.NDEL,.LASTEND,PARAERR); IF .INDEX GEQ 3 THEN (PUSH(LITLEXEME(.INDEX-3)); INDEX_3); RUNDE(); CASE .INDEX OF SET FIN(HSWAB,FNULL); FIN(HCARRY,FCARRYOV1); FIN(HOVFLOW,FCARRYOV1); FIN(HMOVP,FNULL) TES; IF ONEOF(.INDEX,BIT2(1,2)) THEN RESNOTREE; ! END; ROUTINE SCASE= ! !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. BEGIN LOCAL C1,C2,T,SAVNDEL; INIT; NEWLASTEND(PSOF); MARKSTK(); RUEXPUSH(FNULL); PUSH(ONE); FIN(HSHIFT,FCASE0); PUSH(.SYM); IF (C1_ISALIT(SYM)) THEN BEGIN IF .ERRORFOUND EQL 0 THEN (POPANDDUMP(CEILING); RELLST(.STK[.TOS-1]); STK[.TOS-1]_.STK[.TOS]; TOS_.TOS-1); C2_LITVALUE(.SYM)/2; T_-1; NOCODE; END; LASTEND_PSTES; IF .DEL NEQ HOF THEN RERR(.LOBRAC,.NDEL,.LASTEND,CASERR1); IF RUNDE() THEN RETURN; IF .DEL NEQ HSET %[3.A]% THEN RERR(.LOBRAC,.NDEL,.LASTEND,CASERR2); LASTEND_PSTESSEM; UNTIL .DEL EQL HTES DO %[3.C]% BEGIN IF .C1 THEN IF (T_.T+1) EQL .C2 THEN RESNOTREE; IF .C1 THEN RUEXPUSH(FNULL) ELSE RUEXPUSH(FCASE1); %[3.C.1]% IF .DEL NEQ HSEMICOLON AND %[3.C.2]% .DEL NEQ HTES THEN RERR(.LOBRAC,.NDEL,(RESLASTEND),CASERR3); IF .C1 THEN IF .T EQL .C2 THEN NOCODE; END; RESLASTEND; SAVNDEL_.NDEL; RUNDE(); %[3.D]% IF AEFOLLOWS() THEN RERR(.LOBRAC,.SAVNDEL,.LASTEND,OPERR2); IF .C1 THEN (IF .C2 LSS 0 THEN C2_0; RESNOTREE; XFIN((.C2+1),FCCASE)) ELSE FIN(HCASE,FCASE2) %[5.A]% END; ROUTINE SSELECT= ! !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. BEGIN LOCAL TOG,SAVNDEL; INIT; NEWLASTEND(PSOF); RUEXPUSH(FSEL0); LASTEND_PSTESN; IF .DEL NEQ HOF THEN RERR(.LOBRAC,.NDEL,.LASTEND,SELERR1); OLDDELI_MACRCOMSEL; IF RUNDE() THEN RETURN; IF .DEL NEQ HNSET %[3.A]% THEN RERR(.LOBRAC,.NDEL,.LASTEND,SELERR2); LASTEND_PSTESNCOLSEM; UNTIL .DEL EQL HTESN DO %[3.C]% BEGIN RUND(QLLEXEME); %[3.C.1]% IF .DEL EQL HTESN THEN EXITLOOP; IF (TOG_(.DEL EQL HALWAYS)) OR %[3.C.2](4)% .DEL EQL HOTHERWISE THEN (PUSH(LEXOUT(SELTYP,.TOG));RUND(QLLEXEME)) ELSE (EXPRESSION();PUSH(.SYM);MARKMMNODES()); IF .DEL NEQ HCOLON %[3.C.3]% THEN RERR(.LOBRAC,.NDEL,(RESLASTEND),SELERR3); RUEXPUSH(FSEL3); %[3.C.4]% IF .DEL NEQ HSEMICOLON AND %[3.C.5]% .DEL NEQ HTESN THEN RERR(.LOBRAC,.NDEL,(RESLASTEND),SELERR4); END; PUSH(ZERO); PUSH(ZERO); RESLASTEND; SAVNDEL_.NDEL; RUNDE(); %[3.D]% IF AEFOLLOWS() THEN RERR(.LOBRAC,.SAVNDEL,.LASTEND,OPERR2); FIN(HSELECT,FSEL4) %[5.A]% END; ROUTINE CALCNEXT(DELIM,DEFAULT)= !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). ! BEGIN RUND(QLLEXEME); EXPRESSION(); %[1.A]% IF .DEL NEQ .DELIM THEN RETURN -1; IF .SYM EQL HEMPTY THEN RETURN .DEFAULT; SYM_BINDBIND(.SYM); IF NOT LITRESULT THEN (WARNEM(.NSYM,ERMBADEXP); RETURN .DEFAULT); SYM_LITVALUE(.SYM); IF .SYM LSS 0 OR .SYM GTR (IF .DEFAULT EQL 16 THEN 16 ELSE 15) THEN RETURN -2 ELSE RETURN .SYM; END; MACRO MOD2N(X,Y)=(IF Y EQL (Y AND -Y) THEN X AND (Y-1) ELSE X MOD Y)$; ROUTINE SPOINTER= ! !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. ! BEGIN LOCAL LEXEME PBAS,PPOS,PSIZ,POFF; BIND STVEC NODE=PBAS; INIT; PBAS_.SYM; PPOS_CALCNEXT(HCOMMA,0); IF .PPOS EQL -1 THEN RERR(.LOBRAC,.NDEL,.LASTEND,PERR1) ELSE IF .PPOS EQL -2 THEN (WARNEM(.NSYM,PERR1); PPOS_0); PSIZ_CALCNEXT(HPOINCLOSE,16); IF .PSIZ EQL -1 THEN RERR(.LOBRAC,.NDEL,.LASTEND,PERR2) ELSE IF .PSIZ EQL -2 THEN (WARNEM(.NSYM,PERR1); PSIZ_16); RUNDE(); POFF_(.PPOS/WRDSZ)*(WRDSZ/BYTSZ); IF .POFF GTR 0 THEN WARNEM(.NDEL,WAPOSOVFL); PPOS_MOD2N(.PPOS,WRDSZ); IF .PPOS+.PSIZ GTR WRDSZ THEN (WARNEM(.NDEL,WAPSOVFL); PSIZ_WRDSZ-.PPOS); % IF MOD2N(.PPOS,BYTSZ)+.PSIZ LEQ BYTSZ ! CAN'T DO THIS YET. THEN (POFF_.POFF+.PPOS/BYTSZ; ! SOMEDAY BE SURE TO DO IT!! PPOS_MOD2N(.PPOS,BYTSZ)); % IF .PBAS[LTYPF] EQL GTTYP THEN IF .NODE[NODEX] EQL SYNPOI THEN BEGIN MAP STVEC POFF; POFF_.NODE; NODE_.NODE[OPR1]; PDETACH(.POFF); RELEASESPACE(GT,.POFF,BASEGTNODESIZE+3) END; IF (.PPOS NEQ 0) OR (.PSIZ NEQ 16) THEN BEGIN PUSH(.PBAS); PUSH(LITLEXEME(.PPOS)); PUSH(LITLEXEME(.PSIZ)); FIN(HPOINTOPEN,FNULL) END ELSE BEGIN SYM_.PBAS; IF .ERRORFOUND EQL 0 THEN DELETETOMARK() END END; ROUTINE SCLABEL= BEGIN LOCAL STVEC L1,T1,PTR1,PTR2,SACC[2]; L1_GETLABEL(); SACC[0]_.ACCUM[0]; SACC[1]_.ACCUM[1]; ACCUM[0]_ACCUM[1]_-2; ACCUM<22,14>_"U$"; PTR1_L1<24,3>; PTR2_ACCUM<22,7>; INCR I FROM 1 TO 8 DO IF (T1_SCANI(PTR1)) NEQ 0 THEN (REPLACEI(PTR2,.T1+#60);EXITLOOP T1_.I); INCR I FROM .T1+1 TO 8 DO REPLACEI(PTR2,SCANI(PTR1)+#60); L1_SEARCH(UNDECTYPE); L1_STINSERT(.L1,LABELT,0); ACCUM[0]_.SACC[0]; ACCUM[1]_.SACC[1]; L1[OFFSETF]_LZERO; L1[ALIVEF]_1; LEXOUT(BNDVAR,.L1) END; ROUTINE SELABEL(LAB)= BEGIN MAP STVEC LAB; LAB[DEADF]_TRUE; LAB[ENABLOCF]_0; ! BECAUSE THIS IS ALSO LOC[LABCELLF] PUSH1(.LAB) END; ROUTINE SFLABEL= BEGIN LOCAL SAVLAB; INIT; SAVLAB_.GLOLAB; GLOLAB_SCLABEL(); GLOLAB[ENABLOCF]_.ELTOS; NOTELEVEL(.GLOLAB); PRERUEX(FLAB0); SELECT .DEL[HSYNTYP] OF NSET SYNWDO:SWU(); SYNUDO:SWU(); SYNINCR:SREP(); SYNDECR:SREP(); SYNDOW:SDO(); SYNDOU:SDO() TESN; IF .SYM EQL HEMPTY THEN SYM_LZERO; PUSH(.SYM); POSTRUEX(FLAB0); SELABEL(.GLOLAB); FIN(HLABUSE,FLAB1); GLOLAB[LINKFLD]_.SYM; GLOLAB_.SAVLAB; END; ROUTINE EXITCLEANUP(LAB,OP)= ! ! CALLED AT END OF SESCAPE,SLEAVE ! ! PUSHES A THIRD SUBNODE ONTO THE "ESCAPE" NODE ! WHICH INDICATES HOW TO ADJUST SIGREG WHEN IT IS EXECUTED. ! ! ALSO, EXECUTES THE APPROPRIATE VERSION OF "FIN". ! BEGIN MAP STVEC LAB; IF .OP EQL HLEAVE THEN BEGIN IF .LAB[ENABLOCF] EQL .ELTOS THEN PUSH(ZERO) ELSE PUSH(.ELSTK[.LAB[ENABLOCF]+1]); FIN(HLEAVE,FLEAV1) END ELSE BEGIN IF .LASTELMARK EQL .ELTOS THEN PUSH(ZERO) ELSE PUSH(.ELSTK[.LASTELMARK+1]); FIN(HRLEAVE,FRTRN) END END; ROUTINE SESCAPE= BEGIN LOCAL OP,LEXEME LAB; INIT; IF .DEL EQL HEXITLOOP THEN (OP_HLEAVE; LAB_.GLOLAB) ELSE (OP_HRLEAVE; LAB_.CURROUT); IF .LAB EQL 0 THEN RERR(.LOBRAC,.NDEL,.LASTEND,EXITERR1); LAB[LTYPF]_BNDVAR; RUEXPUSH(FLEAV0); PUSH1(.LAB); EXITCLEANUP(.LAB,.OP) END; ROUTINE SLABEL= ! !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. BEGIN IF .SYM[LTYPF] EQL BNDVAR THEN IF .STSYM[TYPEF] EQL LABELT THEN BEGIN LOCAL STVEC SAVLABEL; INIT; SAVLABEL_.SYM; %[1.A.1]% SAVLABEL[ENABLOCF]_.ELTOS; IF .SAVLABEL[ALIVEF] THEN ERRPRNT(.LOBRAC,.NSYM,LABUSERR) ELSE SAVLABEL[ALIVEF]_1; %[1.A.2]% NOTELEVEL(.SAVLABEL); RUEXPUSH(FLAB0); %[1.A.3]% SELABEL(.SAVLABEL); %[1.A.4]% FIN(HLABUSE,FLAB1); SAVLABEL[LINKFLD]_.SYM; RETURN 1; END; RETURN 0; END; ROUTINE SLEAVE= ! !SYNTAX: LEAVE