Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50325/syntax.bli
There are no other files named syntax.bli in the archive.
! 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<ADDRF>;
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<LEFTPART>, 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<LEFTPART> 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 <VAR> <FROMEXP> <TOEXP> <BYEXP> DO
! DECR <VAR> <FROMEXP> <TOEXP> <BYEXP> DO
!
! <FROMEXP>::= / FROM <EXPRESSION>
! <TOEXP> ::= / TO <EXPRESSION>
! <BYEXP> ::= / BY <EXPRESSION>
!
!I. GENERAL:
!
! 1. THIS ROUTINE PROCESSES "INCR" AND "DECR"
! STATEMENTS OF THE ABOVE SYNTAX FORMS.
!
! 2. PROCESS <FROMEXP>, <TOEXP>, AND <BYEXP> 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<LEFTPART>_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<LEFTPART>_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<RIGHTPART>_.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: <NAME>(<EXPRESSION>)
!
! 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 <CASE EXP> OF SET <SET-TES EXP> TES
!
! <CASE EXP> ::= E1;E2;...;EN
! <SET-TES EXP> ::= 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 <SELECT EXP> OF NSET <NSET-TESN EXP> TESN
!
! <SELECT EXP> ::= E1;E2;...;EN
! <NSET-TESN EXP> ::=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 <POSITION,SIZE>.
!
! 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<E1,E2>
!
!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: <LABEL1>:<LABEL2>:...<LABELN>: <EXPRESSION>
!
!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 <LABEL>
! LEAVE <LABEL> WITH <EXPRESSION>
!
!I. GENERAL:
!
! 1. THIS ROUTINE PROCESSES A "LEAVE" EXPRESSION WITH
! THE ABOVE SYNTAX.
!
! 2. CHECK THAT REFERENCE TO <LABEL> IN THIS CONTEXT
! IS LEGAL.
!
! 3. PROCESS THE EXPRESSION FOLLOWING, IF ANY.
!
! 4. ON EXIT, THE WINDOW IS IN THE SAME POSITION AS
! AFTER "EXPRESSION" RETURNS, IE AFTER THE
! EXPRESSION WAS PROCESSED.
!
!II. SPECIFIC:
!
! 1 *
!
! A. MOVE THE WINDOW TO GET <LABEL> IN "SYM".
!
! 2. *
!
! A. IF "SYM" IS NOT A LABEL, THEN ERROR.
!
! B. WAS THE LABEL USED ON THIS EXPRESSION?
! IF NOT, GIVE AN ERROR.
!
! C. PUSH THE LABEL ONTO THE STACK
! FOR THE "LEAVE" NODE.
!
! 3. *
!
! A. MOVE THE WINDOW, PROCESS THE RETURN VALUE
! EXPRESSION, AND PUSH ITS LEXEME ON THE STACK.
!
! B. FINISH THE NODE.
BEGIN
LOCAL SAVLAB,OP;
INIT;
OP_HLEAVE;
RUND(QLLEXEME); %[1.A]%
IF NOT ONEOF(.STSYM[TYPEF],BIT4(LABELT,ROUTINET,GROUTINET,FORWT)) %[2.A]%
THEN RERR(.LOBRAC,.NDEL,.LASTEND,LABELERR);
IF .STSYM[TYPEF] EQL LABELT
THEN BEGIN
IF .STSYM[DEADF] %[2.B]%
THEN RERR(.LOBRAC,.NDEL,.LASTEND,EXITERR0)
ELSE (IF NOT .STSYM[ALIVEF]
THEN RERR(.LOBRAC,.NDEL,.LASTEND,NOFOUNDEXERR));
IF .STSYM[BLF] LEQ .RBLOCKLEVEL
THEN (WARNEM(.NSYM,ERUPLVL);
SYM[ADDRF]_.CURROUT;
OP_HRLEAVE)
END
ELSE BEGIN
OP_HRLEAVE;
IF .SYM[ADDRF] NEQ .CURROUT
THEN WARNEM(.NDEL,NOTIMPL);
END;
SAVLAB_.SYM;
IF .DEL NEQ HWITH
THEN CONSTPUSH(ZERO,FNULL)
ELSE RUEXPUSH(FLEAV0);
PUSH1(.SAVLAB); %[2.C]%
EXITCLEANUP(.SAVLAB,.OP)
END;
ROUTINE SCREATE=
!
! SYNTAX: CREATE E0(E1,E2,...) AT E3 LENGTH E4 THEN E5
!
! THE ROUTINE-CALL NODE FOR E0(E1,E2,...) IS GENERATED, BUT THEN
! ITS PARAMETER SUBNODES ARE PLUCKED OFF AND MADE INTO PARAMETERS
! OF A CALL ON THE CREATE ROUTINE, WHICH IS AN EXTERNAL SUPPORT
! ROUTINE. E0,E3,E4,AND E5 ARE ALSO MADE PARAMETERS.
!
BEGIN
LOCAL GTVEC OP1;
ROUTINE R1(X)=(MARKSTK(); PUSH(.X); SYM_GENGT(HFPARM); PUSH(.SYM));
ROUTINE R2=(MARKSTK(); RUEXPUSH(FCALL0); SYM_GENGT(HFPARM); PUSH(.SYM));
INIT;
PUSH1(.DFLTLNKGLX);
PUSH(.LEXCREATE);
NEWLASTEND(PSAT);
RUEXPUSH(FNULL);
IF NOT (IF .SYM[LTYPF] EQL GTTYP THEN .STSYM[NODEX] EQL HFSTORE)
THEN ERRPRNT(.LOBRAC,.NSYM,CREATERR1)
ELSE
BEGIN
BIND TMPSYM=.SYM;
OP1_.STSYM[OPR1];
SIZE_.OP1[NODESIZEF];
TOS_.TOS-1;
INCR I FROM 2 TO .SIZE-1 DO
PUSH(.OP1[OPERAND(.I)]);
R1(LITLEXEME((.SIZE-2)*2));
R1(.OP1[OPR2]);
PDETACH(TMPSYM);
RELEASESPACE(GT,TMPSYM,BASEGTNODESIZE+1);
PDETACH(.OP1);
RELEASESPACE(GT,.OP1,BASEGTNODESIZE+.SIZE);
END;
IF .DEL NEQ HCRAT THEN RERR(.LOBRAC,.NDEL,RESLASTEND,CREATERR2);
LASTEND_PSLENGTH;
R2();
IF .DEL NEQ HLENGTH THEN RERR(.LOBRAC,.NDEL,RESLASTEND,CREATERR3);
LASTEND_PSTHEN;
R2();
RESLASTEND;
IF .DEL NEQ HTHEN THEN RERR(.LOBRAC,.NDEL,.LASTEND,CREATERR4);
R2();
FIN(HPARAOPEN,FCALL1);
LEXCREATE[PRNEXF]_TRUE;
MARKSTK();
PUSH(.SYM);
SYM_GENGT(HFSTORE)
END;
ROUTINE SINLINE=
!
! SYNTAX: INLINE(LITERAL)
! INLINE(LONGSTRING)
!
BEGIN
LOCAL ISCOM;
INIT;
ISCOM_(.DEL EQL HINLINECOM);
RUND(QLLEXEME);
IF .DEL NEQ HPARAOPEN AND
.DEL NEQ HCOMPOPEN
THEN RERR(.LOBRAC,.NDEL,.LASTEND,INERR1);
RUND(QLLSLEX);
IF NOT ONEOF(.SYM[LTYPF],BIT2(LSLEXTYP,LITTYP))
THEN (WARNEM(.NSYM,INERR2); SYM_LITLEXEME(" "^8 + " "));
IF .DEL NEQ HPARACLOSE
THEN RERR(.LOBRAC,.NDEL,.LASTEND,INERR1);
IF NOT .ISCOM THEN
WARNEM(.LOBRAC,INERR3);
PUSH(.SYM);
RUND(QLLEXEME);
FIN(HINLINE,FINLINE0);
STSYM[ISCOMBIT]_.ISCOM;
END;
ROUTINE PUSHELSTK(X)=ELSTK[ELTOS_.ELTOS+1]_.X;
ROUTINE POPELSTK=(ELTOS_.ELTOS-1;.ELSTK[.ELTOS+1]);
ROUTINE MARKELSTK=(PUSHELSTK(.LASTELMARK);LASTELMARK_.ELTOS);
GLOBAL ROUTINE SENABLE=
BEGIN
MAP STVEC LXSIGV:LXSIGR:LXSIG1:LXENAB;
LOCAL LOFF;
BIND NUMENABLOCALS=3;
INIT;
MARKSTK();
IF .ENABFLG THEN ERRPRNT(.LOBRAC,.NDEL,ENERR0);
ANYENAB_1;
IF .NEXTLOCAL THEN NEXTLOCAL_.NEXTLOCAL+1;
LOFF_LITLEXEME(-(NEXTLOCAL_.NEXTLOCAL+(NUMENABLOCALS*2)));
COMPLAB_SCLABEL();
LXSIGR[PRNEXF]_LXSIGV[PRNEXF]_LXSIG1[PRNEXF]_LXENAB[PRNEXF]_TRUE;
PRERUEX(FENAB0);
PUSH(LEXOUT(BNDVAR,.VVREG));
FIN(HDOT,FNULL);
MARKSTK();
PUSH(.SYM);
NEWLASTEND(PSELBCOLSEM);
UNTIL .DEL EQL HELBANE
DO BEGIN
RUND(QLLEXEME);
IF .DEL EQL HALWAYS OR .DEL EQL HOTHERWISE
THEN (PUSH(LEXALWAYS);RUND(QLLEXEME))
ELSE (EXPRESSION();PUSH(.SYM);MARKMMNODES());
IF .DEL NEQ HCOLON
THEN RERR(.LOBRAC,.NDEL,(RESLASTEND),ENERR1);
PRERUEX(FSEL3);
MARKSTK();
RUEXPUSH(FLEAV0);
PUSH1(.COMPLAB);
PUSH(ZERO);
FIN(HLEAVE,FNULL);
PUSH(.SYM);
POSTRUEX(FSEL3);
IF .DEL NEQ HSEMICOLON AND
.DEL NEQ HELBANE
THEN RERR(.LOBRAC,.NDEL,(RESLASTEND),ENERR2);
END;
PUSH(ZERO);
PUSH(ZERO);
RESLASTEND;
RUNDE();
FIN(HSELECT,FSEL4);
MARKSTK();
PUSH(.SYM);
PUSH(.LOFF);
FIN(HELBANE,FENAB1);
PUSHELSTK(.LOFF); ! TELL EVERYONE WE'RE IN AN 'ENABLED' BLOCK
PUSH(.SYM); ! SINCE DECLARE WON'T, MUST FAKE IT
ENABFLG_1;
END;
ROUTINE SSIGNAL=
BEGIN
MAP STVEC LXSIGL;
INIT;
LXSIGL[PRNEXF]_TRUE;
RUEXPUSH(FSIG0);
FIN(HSIGNAL,FNULL);
END;
END
END
ELUDOM