Trailing-Edge
-
PDP-10 Archives
-
BB-4172G-BM
-
language-sources/sn1n.bli
There are 18 other files named sn1n.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
!COPYRIGHT (C) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
!FILENAME: H1SYNT.BLI
!DATE: 10 JANUARY 74 MGM/FLD/KR
! REVISION HISTORY :
!
! 12-28-77 ROUTINES UPLEVELCHECK,IDCHECKER,SSPUNOP,SSPLF,
! SML ARE MODIFIED AND SYMVALUE OWN VARIABLE IS ADDED
! TO FIX BUG#4.
!
! 12-27-77 ROUTINE UPLEVELCHECK IS ADDED TO CHECK REGISTER
! DECLARATIONS AND USAGES INSIDE ROUTINES AND IMBEDDED
! ROUTINES (GLOBAL ALSO). REPLACE REGISTER LEXEME BY
! REGISTER VALUE IF VALID IN A CONTEXT.
!
! 12-21-77 ROUTINE IDCHECKER IS MODIFIED TO FIX BUG#4.
! NESTED GLOBAL ROUTINES DECLARING REGISTERS WITH SAME
! NAME.
!
! 9-19-77 ROUTINE CONSTCASE,SIF ARE MODIFIED
! TO FIX BUG#46,NESTED IF EXPRESSIONS OR CASE EXPR.
!
! 7-15-77 ROUTINE FIXBADEXP IS MODIFIED SO THAT AN UNDEFINED
! SYMBOL IN A BLOCK IS TREATED AS AN EXTERNAL AFTER
! GIVING FIRST WARNING MESSAGE.THIS WILL NOT GIVE ANYMORE
! MESSAGE FOR THIS SYMBOL IN THIS BLOCK WHEREEVER USED.
! THIS WILL ELIMINATE LOTS OF ERROR MESSAGES AND NOTIFIES
! THE USER ONCE ONLY.
! 6-2-77 ROUTINE SCOMPOUND IS MODIFIED SO THAT NO LOCALS
! ARE ADDED AND SUBTRACTED AT BLOCK LEVEL.IT DONE
! ONLY AT THE BEGINING OF ROUTINE ENTRY AND EXIT.
! IF LOCALS ARE DEFINED AT MODULE LEVEL AND NO ROUTINES
! INT THAT MODULE ,IT IS SAME AS OLD METHOD.
! THIS WILL NOT CLOBBER STACK FOR LOCALS AND PUSH.
!
! 5-27-77 MACRO CLOSEBR IS MODIFIED TO FIX BUG#11 IN
! BLISS10.DOC.THIS RECOGNIZES THE CASE X[]_.X[] +1.
! IT SETS A FLAG TO BE USED IN GTGOTM IN GT1.BLI.
!
! 5-16-77 FIX ROUTINE SSPLF TO CALL FIXSIDEEFFECTS FOR
! CHARACTER HANDLING SPECIAL FUNCTIONS. FIXES
! BUG 30.
!
! 5-15-77 FIX ROUTINE SUSERCALL AND SCOMPOUND TO ALLOW
! THE LATTER TO KEEP TRACK OF THE NUMBER OF ACTUAL
! ARGUMENTS THAT ARE ON THE STACK WHEN A BLOCK
! IS PROCESSED. LOCALS IN SUCH A BLOCK USED TO
! OVERWRITE ACTUAL ARGUMENTS ALREADY PUSHED ON THE
! STACK. FIXES BUG 26.
!
! 5-9-77 ROUTINE SPLIT CALLS SPLIT1.THE CHANGE IS DUE TO
! OWN OR GLOBAL INITIALIZATION.THEY ARE HANDLED AS
! PLITS IN SOME SENSE.SPLIT1 IS MODIFIED TO DO THIS.
! ROUTINE TUPLEITEM AND SUSERCALL WERE MODIFIED TO FIX
! BUGS REPLICATION COUNT LSS 0 AND LAST ARGUMENT
! OF A ROUTINE CALL IN A STRUCTURE.
! ROUTINE SPLIT1 IS SAME AS SPLIT EXCEPT FEW CHANGES.
!
%%
%
F I X E S
5.200.2 - IN SPTR, CAUSES A NON ZERO TO BE LEFT
IN SYM, CORRECTING THE BUG
WHERE A<> IS COMPILED UNDER /X (CODETOG=0)
FIXBADEXP ADDED TO TEST FOR UNDECLARED NAMES
AND FOR STRUCTURE, LINKAGE, LABEL NAMES
APPEARING IN EXPRESSIONS.
%
%%
%3.40% GLOBAL BIND H1SYV=4; !MODULE VERSION NUMBER
! SYNTAX ANALYSIS ROUTINES
! ---------------------------------------
! FORWARD REFERENCE DECLARATIONS
!--------------------------------
OWN SYMVALUE; %SYM VALUE IS RETURNED. USED IN UPLEVELCHECK,SML,SSPLF,SSPUNOP AND FIX BUG#4 DEC-28-77 %
FORWARD SCOMPOUND,SOPERATOR,SML;
! INIT CODE FOR SYNTAX
!----------------------
%3.1% GLOBAL ROUTINE INITSYNTAX=
( ERRORFOUND_ERRLEVEL_0; HRUND(); HRUND());
! BOOLEAN PREDICATES AND SMALL MISC. SERVICE ROUTINES
!-----------------------------------------------------
ROUTINE SEFOLLOWS=
(.DEL<26,1> AND (IF .SYM EQL HEMPTY THEN
NOT(.DEL<25,1>) ELSE .DEL<25,1>));
ROUTINE AEFOLLOWS=
(.DEL<24,1> AND (IF .SYM EQL HEMPTY THEN
NOT(.DEL<25,1>) ELSE .DEL<25,1>));
ROUTINE FUTAE=
(.FUTDEL<24,1> AND ( IF .FUTSYM EQL HEMPTY THEN
NOT(.FUTDEL<25,1>) ELSE .FUTDEL<25,1>));
ROUTINE CORRECTP1=
BEGIN
.FUTSYM EQL HEMPTY AND
(.FUTDEL<HCLASS> EQL CLOBRAC OR .FUTDEL<HCLASS> EQL OPRTR
OR .FUTDEL<LEFTHALF> EQL HPAROPEN
OR .FUTDEL<LEFTHALF> EQL HSQOPEN
OR .FUTDEL<LEFTHALF> EQL HPTOPEN)
END;
ROUTINE HDELCLASS=
(IF .DEL<HCLASS> EQL 1 THEN SOPERATOR() ELSE (@DEL)());
ROUTINE SUCCESSIVERELATIONALS(OP)=
(.OP<HPRIORITY> EQL #30 AND .DEL<HPRIORITY> EQL #30);
ROUTINE FIXBADEXP=
IF BADEXPTYPE^(-.ST[.SYM<STEF>,0]<TYPEF>)
THEN (
EMESSAGE("ERROR"," FOR ","THE S","YMBOL"," : ",5);
EOSTN(.SYM<STEF>);
ENEWLINE();
!MAKE UNDEFINED SYMBOLS AS EXTERNAL IN A BLOCK 6-21-77
! GIVE WARNINGS ONCE ONLY FOR A SYMBOL IN A BLOCK
WARNEM(.NSYM,
IF .ST[.SYM<STEF>,0]<TYPEF> EQL UNDEDT
THEN (ST[.SYM<STEF>,0]<TYPEF>_EXTRNT;#437)
ELSE ERRBADSYM);
SYM_ZERO);
ROUTINE NOERRORS=(.ERRORFOUND EQL 0);
ROUTINE SHUTOFFCODE= CODETOG_.CODETOG^1;
ROUTINE TURNONCODE= IF .CODETOG NEQ 0 THEN CODETOG_.CODETOG^(-1);
ROUTINE FIXFUTDEL=
IF .FUTSYM EQL HEMPTY THEN
BEGIN
IF .FUTDEL<LEFTHALF> EQL HMIN THEN
(FUTDEL_NGNEG<0,0>; FUTDEL<LEFTHALF>_HNEG) ELSE
IF .FUTDEL<LEFTHALF> EQL HPLUS THEN
(LOCAL A,B; A_.SYM; B_.DEL; WRUND(1);
SYM_.A; DEL_.B) ELSE
0
END;
! SYNTAX ERROR REPORTING AND RECOVERY ROUTINES
!----------------------------------------------
%3.1% GLOBAL ROUTINE RECOVER(POSN,M) =
BEGIN !
! THIS ROUTINE IS CALLED TO REPORT AN ERROR AND RECOVER TO
! A SENSIBLE POINT --- WHERE SENSIBLE IS DEFINED TO BE ANY
! UNMATCHED CLOSE BRACKET. ANY OPEN BRACKET SEEN ALONG THE
! WAY TO OUR UNMATCHED CLOSE IS USED TO TRIGGER SYNTAX ANALYSIS
! OF ITS INTERIOR.
!
ERROR(.POSN,.M);
!IF CALLED WITH _ IN DEL, WE LOOP FOREVER UNLESS WE MOVE
!THE WINDOW BEFORE ENTERING THE UNIL LOOP
IF .DEL <LEFTHALF> EQL HSTO THEN HRUND();
UNTIL .DEL<LEFTHALF> EQL HSTO OR .DEL<HCLASS> EQL CLOBRAC DO
BEGIN IF .DEL<HCLASS> EQL OPENBRACKET AND .DEL<ADDRESSF> NEQ 0
THEN BEGIN
ERRLEVEL_0;
(.DEL)();
ERRLEVEL_1
END
ELSE HRUND()
END
END;
ROUTINE DEMAND(PPOSN,ERR,TYPE)=
BEGIN
!
! THIS ROUTINE IS SIMILAR TO RECOVER IN THAT IT REPORTS
! AN ERROR THEN ATTEMPTS TO SCAN AHEAD AND RECOVER. IT
! DIFFERS IN THAT ONLY CERTAIN TYPES OF CLOSING DELIMITERS
! ARE ACCEPTABLE. THE ROUTINE IS CALLED ONLY FROM SPECIFIED
! "DEMAND RECOVERY" POINTS -- EG. COMPOUND STMTS.
!
DO (HRUND(); RECOVER(.PPOSN,.ERR)) UNTIL
CASE .TYPE OF
SET
%0% .DEL<LEFTHALF> EQL HSEMCOL OR .DEL<LEFTHALF> EQL HROCLO;
%1% .DEL<LEFTHALF> EQL HSEMCOL OR .DEL<LEFTHALF> EQL HEND;
TES
END;
ROUTINE UPLEVELCHECK(XXX)=
BEGIN
% XXX - ST POINTER OF REGISTER LEXEME.
SYMVALUE - REGISTER NAME IS RETURNED.
RETURNS REGISTER NAME IF THE REGISTER USAGE IS VALID IN
A CONTEXT.
DEC-27-1977
%
LOCAL STVEC TEMP;
TEMP=.XXX<STEF>;
IF .TEMP[0]<TYPEF> EQL REGT THEN
BEGIN
IF .TGRBLEVEL GEQ .TEMP[0]<BLF> AND .FCNSTATE EQL 3
THEN ERROR(.NSYM,#40)
ELSE
( SYMVALUE=.TEMP[1]<ADDRESSF>;
SYMVALUE<VEF>=1;
RETURN 1
);
END;
RETURN 0
END;
%3.1% GLOBAL ROUTINE IDCHECKER(P,N)=
BEGIN LOCAL L,TEMP; %12-21-77%
INCR I FROM 1 TO .N DO
BEGIN
L_@(@P-@I);
TEMP=(@P-@I); %12-21-77%
IF .L<LSF> THEN
BEGIN
CHECKEXTER(.L<LINKF>);
IF NOT CHKULA(.L<LINKF>) THEN ERROR(.NSYM,#40);
%THE FOLLOWING 1 LINE WERE ADDED ON 12-21-77 TO FIX BUG=#4 %
IF UPLEVELCHECK(.L) THEN .TEMP=.SYMVALUE;
END;
END;
END;
! ACTUAL SYNTAX ROUTINES FOLLOW
!-------------------------------
%V2H% GLOBAL ROUTINE SLABEL=
%V2H% !WE HAVE ENCOUNTERED A LABEL FOLLOWED BY COLON; THE LABEL
%V2H% !LEXEME IS IN SYM, COLON LEXEME IN DEL. READ ALL LABELS UNTIL
%V2H% !WE RUN OUT. CHAIN ALL LABEL STES TOGETHER AND PUT CHAIN
%V2H% !INDEX INTO GLOBAL LABIND.
%V2H% BEGIN
%V2H% REGISTER STIND; !TO HOLD INDEX OF LABEL STE
%V2H% DO
%V2H% BEGIN
%V2H% IF .ST[STIND_.SYM<STEF>,1]<DEADALIVEF> NEQ 0
%V2H% THEN EXITCOMPOUND WARNEM(.NSYM,ERALUSEDLAB);
%V2H% ST[.STIND,1]_.LABIND; !STORE INDEX TO PREVIOUS LABEL
%V2H% LABIND_.STIND; !SAVE INDEX TO CHAIN OF LABELS
%V2H% END
%V2H% UNTIL (HRUND(); .DEL<LEFTHALF> NEQ HLABCOLON); !UNTIL NO MORE LABELS
%V2H% IF .DEL<HCLASS> NEQ 0 %OPEN BRACKET% !LABELS MUST PRECEDE OPEN BRACKET
%V2H% THEN (LABIND_0; WARNEM(.NDEL,ERCANTLABEL));
%V2H% END;
%V2H% ROUTINE BIRTHLABEL(HIND)=
%V2H% !HIND - IS THE INDEX OF THE HEADER CELL OF THE EXPRESSION WHICH
%V2H% !IS TO BE LABELLED BY THOSE LABELS IN THE CHAIN POINTED TO BY
%V2H% !GLOBAL LOCATION LABIND.
%V2H% !BIRTHLABEL STORES .HIND INTO THE PREVF OF THE ADDINFO WORD OF
%V2H% !ALL LABEL STES AND TURNS ON THE ALIVE BITS IN ALL STES TO
%V2H% !INDICATE THAT THERE ARE NO LABELS WHICH HAVE BEEN READ,
%V2H% !BUT NOT LINKED TO AN EXPRESSION.
%V2H% !BIRTHLABEL RETURNS THE INDEX TO THE STE CHAIN AS ITS VALUE.
%V2H% !ALL STES UPON ENTRY TO BIRTHLABEL MUST BE IN DORMANT
%V2H% !STATE: DEADB=ALIVEB=0.
%V2H% !THEY WILL BE IN ALIVE STATE ON EXIT FROM BIRTHLABEL: ALIVEB=1.
%V2H% BEGIN
%V2H% REGISTER NEWSTUFF, !WILL CONTAIN ALIVEM(ASK) + INDEX
%V2H% !TO LABELLED EXPR TO BE ADDED TO
%V2H% !ALL STES.
%V2H% STIND; !INDEX OF CURRENT STE.
%V2H% NEWSTUFF_ALIVEM+.HIND^15; !HIND GOES IN PREVF
%V2H% STIND_.LABIND; !GET INDEX TO FIRST STE.
%V2H% DO
%V2H% BEGIN
%V2H% ST[.STIND,1]_.ST[.STIND,1]+.NEWSTUFF; !UPDATE STE
%V2H% STIND_.ST[.STIND,1]<NEXTF>; !GET INDEX TO NEXT STE
%V2H% END
%V2H% UNTIL .STIND EQL 0; !SIGNIFYING END OF THE CHAIN.
%V2H% STIND_.LABIND; LABIND_0; !ZERO LABIND
%V2H% RETURN .STIND; !AND RETURN THE INDEX TO THE CHAIN.
%V2H% END;
%V2H% ROUTINE KILLLABEL(CHAIN)=
%V2H% !WE HAVE FINISHED COMPILING THE EXPRESSION WHICH WAS
%V2H% !LABELLED BY THE STES IN THE CHAIN POINTED TO BY CHAIN.
%V2H% !NOW WE WANT TO TURN ON ALL DEADBITS IN THE
%V2H% !CHAIN SO THAT LEAVE EXPRESSIONS WILL NOT BE ABLE TO REFERENCE
%V2H% !THE NOW DEFUNCT LABELS. THIS ASSUMES ALL LABELS ARE IN
%V2H% !ALIVE STATE. IT LEAVES ALL LABELS IN DEAD STATE.
%V2H% BEGIN
%V2H% REGISTER STIND; !HOLDS CURRENT STE INDEX
%V2H% STIND_.CHAIN; !GET INDEX TO FIRST STE
%V2H% DO
%V2H% BEGIN
%V2H% ST[.STIND,1]<DEADALIVEF>_1; !DEADB ON, ALIVEB OFF
%V2H% STIND_.ST[.STIND,1]<NEXTF>; !GET INDEX TO NEXT STE
%V2H% END
%V2H% UNTIL .STIND EQL 0; !SIGNIFYING END OF THE CHAIN
%V2H% END;
%3.1% GLOBAL ROUTINE EXPRESSION(TOG)=
BEGIN LOCAL SAVDEC; EXTERNAL INDECS;
!
! THIS ROUTINE, WHEN CALLED, WILL COMPILE THE CODE
! FOR A SIMPLE EXPRESSION -- IT IS CALLED FROM A
! VARIETY OF PLACES IN THE SYNTAX ANALYZER TO DO
! JUST THAT. ON EXIT A CLOSE BRACKET OF SOME FORM
! IS IN 'DEL', AND THE LEXEME FOR THE VALUE OF
! THE EXPRESSION IS IN 'SYM'.
! THE PARAMETER 'TOG' IS SIMPLY PASSED ON TO
! 'GENCODE' TO CONTROL ACTUAL CODE GENERATION.
!
!
%V2H% IF .DEL<LEFTHALF> EQL HLABCOLON !THEN WE HAVE ONE OR MORE LABELS.
%V2H% THEN SLABEL(); !GO PROCESS THEM
SAVDEC_.INDECS; INDECS_0;
WHILE .DEL<HCLASS> NEQ CLOBRAC DO
IF AEFOLLOWS()
THEN HDELCLASS()
ELSE IF .DEL<HCLASS> EQL DCLRTR
THEN RECOVER(.NDEL,21)
ELSE RECOVER(.NDEL,1);
%5.200.19% IF .SYM<LSF> THEN FIXBADEXP();
SYM_GENCODE(.SYM,.TOG);
INDECS_.SAVDEC; REALS_0;
END;
%3.1% GLOBAL ROUTINE SCOMPOUND=
% PRINCIPLE: READ UNTIL THE MATCHING CLOSING BRACKET(END OR ROCLO)
1.READ ONCE SO THAT THE NEXT DELIMITER IS IN DEL.
2.PROCESS THE DECLARATIONS.
3.PROCESS THE EXPRESSIONS IN SUCCESSION.
4.ACCEPT AN ARBITRARY EXPRESSION IN SUCCESSION.
5.WHEN A SEMICOLON IS FOUND SKIP AND START ALL OVER AGAIN.
6. IF THE CLOSING BRACKET IS FOLLOWED BY AN HEMPTY FUTSYM
(IT SHOULD BE HEMPTY) PUT RESULT IN FUTSYM AND READ ONCE MORE%
%V2H% BEGIN LOCAL BRAC,NOPEN, SEMCNT, NXTLOC, BLKP,CPPSAVER,SESSAVER,STPOVEC,OLDMAPTB,LFLAGS,LLABIND;
EXTERNAL MAXLOCAL,MAPTB,UNMAP,PTOVECTOR,INDECS,STRDEF,FLAGS,CODEPROP;
BRAC_ .DEL<LEFTHALF>; SEMCNT_0;SESSAVER_.SESTOG; NOPEN_.NDEL;
CPPSAVER_.CODEPROP; CODEPROP_0;
INDECS_BLKP_.FUTDEL<HCLASS> EQL DCLRTR;LFLAGS_.FLAGS;
IF .CODETOG THEN GCE0(.BLKP);
IF .BLKP THEN
BEGIN
%V2H% SETLABSIFNECESSARY(BEC);
BLOCKLEVEL_ .BLOCKLEVEL + 1;
STPOVEC_.PTOVECTOR; OLDMAPTB_.MAPTB;
MAPTB_0; STRDEF_.STRDEF AND -2;
%V2H% END
%V2H% ELSE SETLABSIFNECESSARY(CMPEXC);
NXTLOC_ .NEXTLOCAL;
WHILE .FUTDEL<HCLASS> EQL DCLRTR DO
BEGIN
HRUND();
IF .SYM NEQ HEMPTY THEN WARNEM(.NSYM,#105);
(@DEL)(); IF .DEL<LEFTHALF> NEQ HSEMCOL
THEN DEMAND(.NDEL,#100,1);
END;
INDECS_0;
IF .REALFS NEQ 0 THEN IDFIXFS();
HRUND();
BEGIN
UNTIL .DEL<LEFTHALF> EQL .BRAC+#375240 DO
BEGIN
SESTOG_0;
EXPRESSION(2*( .SEMCNT GTR 0 ));
SESSAVER_.SESSAVER OR .SESTOG;
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .DEL<LEFTHALF> EQL HSEMCOL
THEN
BEGIN
IF .CODETOG THEN
BEGIN
IF (SEMCNT_.SEMCNT+1) EQL 1
THEN ( SYM_GENCODE(.SYM,2));
GCE1(.SYM);
FIXSIDEEFFECTS();
END;
HRUND();
END
ELSE IF .DEL<LEFTHALF> NEQ .BRAC+#375240
!ALLOW ELSE TO CLOSE THE COMPOUND EXPRESSION OR BLOCK AFTER
!WE OUTPUT A PAIR OF FATAL ERROR MESSAGES. #30 POINTS
!ROUGHLY TO THE OPEN DELIMITER AND ERNOCBDEL POINTS ROUGHLY
!TO THE ELSE.
!ON RECOVERY, ACT AS IF THE PROPER CLOSE BRACKET APPEARED
!BEFORE THE ELSE AND GO ON.
THEN
BEGIN
IF .DEL<LEFTHALF> EQL HELSE
THEN
BEGIN
ERROR(.NOPEN,#30);
ERROR(.NDEL,ERNOCBDEL);
ERRLEVEL_0;
EXITCOMPOUND[4]
END
ELSE
(ERROR(.NOPEN,24);DEMAND(.NDEL,25,.BRAC EQL HBEGIN))
END;
ERRLEVEL_0;
END;
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .CODETOG THEN IF (.SEMCNT GEQ 1 OR .BLKP OR .CODEPROP)
THEN SYM_GCE2(GENCODE(.SYM,2),( IF .BLKP THEN
IF .FUTDEL<LEFTHALF> EQL HELUDOM THEN %6-2-77%
(.NXTLOC-(IF .NEXTLOCAL GTR .MAXLOCAL THEN .NEXTLOCAL ELSE .MAXLOCAL) -1)
ELSE -1 ELSE 0))
ELSE GCE2(ZERO,0); !5-26-77
IF CORRECTP1() THEN FUTSYM_.SYM
ELSE(IF FUTAE() THEN RECOVER(.NFUTDEL,3) ELSE RECOVER(.NFUTSYM,12); ERRLEVEL_1);
IF .ERRLEVEL EQL 0 THEN HRUND();
END;
SESTOG_.SESTOG OR .SESSAVER; CODEPROP_.CODEPROP OR .CPPSAVER;
IF .BLKP THEN
BEGIN
UNMAP(); MAPTB_.OLDMAPTB; FLAGS<18,16>_.LFLAGS<LEFTHALF>;
IF .NEXTLOCAL GTR .MAXLOCAL THEN MAXLOCAL_.NEXTLOCAL;
BLOCKLEVEL_.BLOCKLEVEL-1; BLOCKPURGE(.BLOCKLEVEL);
PTOVECTOR_.STPOVEC;
NEXTLOCAL_.NXTLOC;
END;
%V2H% KILLLABSIFNECESSARY;
END;
%3.1% GLOBAL ROUTINE SSET(TYPE)=
%PRINCIPLE:READ UNTIL THE CLOSING BRACKET "TES"
1.READ SO THAT THE NEXT DELIMITER IS IN DEL(THE CASE EXPR USES THIS ROUTINE TOO)
2.PROCESS THE INNER EXPRESSION IN SUCCESSION.
3.SKIP A SEMICOLON AND START ALL OVER AGAIN.
4.ACCEPT AN ARBITRARY EXPRESSION.
5.IF FUTSYM FOLLOWING TES IS HEMPTY(AS IT SHOULD BE),TRANSMIT
THE RESULT TO FUTSYM AND READ ONCE MORE IN ORDER TO DELETE TES%
BEGIN LOCAL CASETYPE; CASETYPE_(.DEL<LEFTHALF> EQL HOF);
IF .TYPE THEN CLEARRTGT();
IF .CASETYPE THEN HRUND() ELSE (IF .CODETOG THEN GCE0(0););HRUND();
UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HSEMCOL DO
BEGIN
EXPRESSION(0); VTARGET_2; SYM_GENCODE(.SYM,2);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .DEL<LEFTHALF> EQL HSEMCOL
THEN BEGIN
IF .CODETOG THEN
IF NOT.CASETYPE THEN SYM_GCE1(.SYM) ELSE
IF .TYPE
THEN (SYM_GCOST3(.SYM);CLEARSOME();GTPURGE(1))
ELSE (SYM_GCOST3(.SYM);GTPURGE(1);RESRT(0));
HRUND()
END;
ERRLEVEL_0;
END;
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .DEL<LEFTHALF> EQL HTES
THEN
BEGIN
IF .CODETOG THEN
IF NOT.CASETYPE THEN SYM_GCE2(.SYM,0) ELSE
IF .TYPE
THEN (SYM_GCOST4(.SYM); CLEARSOME(); GTPURGE(1))
ELSE (SYM_GCOST4(.SYM); RESRT(1); CLEARSOME();
GTPURGE(2); LIVR(.SYM); GTDECR());
END
ELSE (RECOVER(.NDEL,2);RETURN ERRLEVEL_1);
IF .FUTSYM EQL HEMPTY AND .FUTDEL<HCLASS> EQL CLOBRAC
THEN FUTSYM_.SYM
ELSE (IF FUTAE() THEN RECOVER(.NFUTDEL,3) ELSE RECOVER(.NFUTSYM,12); ERRLEVEL_1);
IF .ERRLEVEL EQL 0 THEN HRUND()
END;
ROUTINE SOPERATOR=
%OPERATOR IN QUESTION IS IN DEL;
1. STORE LEFTOPERAND AND OPERATOR;
2.TEST IF LEFT OPERAND IS LEGAL;
3.READ SO THAT NEXTDEL IS IN DEL.
4.IF DEL GOES FIRST THEN (CALL ROUTINE FOR DEL,RETURN TO 4)
5.CHECK IF RIGHT OPERAND IS LEGAL.
6.COMPUTE RESULT.%
IF .DEL<LEFTHALF> NEQ HSTO
THEN BEGIN LOCAL LEFTOP, OP;
%5.200.19% IF .SYM<LSF> THEN FIXBADEXP();
LEFTOP_.SYM; OP_.DEL;
IF (.SYM EQL HEMPTY) XOR .OP<HUNARY>
THEN(RECOVER(.NDEL,6);RETURN(ERRLEVEL_1));
HRUND();
%V2H% !CHECK TO SEE IF WE HAVE A LABELLED EXPRESSION. IF SO,
%V2H% !GET RID OF ALL LABELS BEFORE CHECKING PRIORITY OF NEXT DELIMITER.
%V2H% IF .DEL<LEFTHALF> EQL HLABCOLON THEN SLABEL();
WHILE .DEL<HPRIORITY> LSS .OP<HPRIORITY>
OR(.DEL<HPRIORITY> EQL .OP<HPRIORITY> AND .OP<HUNARY>) DO
BEGIN
IF SEFOLLOWS()
THEN HDELCLASS()
ELSE (IF .DEL<HCLASS> EQL OPENBRACKET
THEN RECOVER(.NDEL,7) ELSE RECOVER(.NDEL,4); ERRLEVEL_1);
IF .ERRLEVEL THEN RETURN
END;
IF SUCCESSIVERELATIONALS(.OP) THEN WARNEM(.NDEL,5);
%5.200.19% IF .SYM<LSF> THEN FIXBADEXP();
IF (.SYM EQL HEMPTY AND (NOT( SEFOLLOWS())))
THEN (RECOVER(.NFUTDEL,4); ERRLEVEL_1)
ELSE SYM_IF .OP<HUNARY>
THEN GENGRAPH(.SYM,.OP,1)
ELSE GENGRAPH(.LEFTOP,.SYM,.OP,2);
END
ELSE %HERE FOLLOWS THE STORE OPERATOR%
BEGIN LOCAL L,LEFTPARTLIST[8],OP; L_-1;OP_.DEL;
WHILE .OP<HPRIORITY> GEQ .DEL<HPRIORITY> DO
BEGIN IF .SYM EQL HEMPTY AND
(NOT (.DEL<HUNARY> OR .DEL<HCLASS> EQL OPENBRACKET))
THEN (RECOVER (.NDEL,8); ERRLEVEL_1)
ELSE IF .OP<HPRIORITY> GTR .DEL<HPRIORITY>
THEN
%5.200.19% (IF .SYM<LSF> THEN FIXBADEXP();
%5.200.8% IF AEFOLLOWS() THEN HDELCLASS()
%5.200.8% ELSE IF .DEL<HCLASS> EQL DCLRTR THEN RECOVER(.NDEL,21)
%5.200.8% ELSE RECOVER(.NDEL,1))
ELSE BEGIN
%5.200.19% IF .SYM<LSF> THEN FIXBADEXP();
L_.L+1; %ANOTHER _ HAS BEEN FOUND%
IF .L EQL 8 THEN ERROR(.NSYM,9)
ELSE LEFTPARTLIST[.L]_.SYM;
%V2H% HRUND();
%V2H% IF .DEL<LEFTHALF> EQL HLABCOLON THEN SLABEL();
END;
IF .ERRLEVEL THEN RETURN
END; % NOW IS L=# OF LEFTARROWS%
IF NOT AEFOLLOWS() AND .SYM EQL HEMPTY THEN (RECOVER(.NFUTDEL,10);ERRLEVEL_1)
ELSE %THE LEFTPARTS HAVE BEEN COMPUTED SO THAT THERE IS NO HARM
IN ASSIGNING FROM RIGHT TO LEFT%
WHILE .L GEQ 0 DO
BEGIN
SYM_GENGRAPH(@(LEFTPARTLIST[.L]),.SYM,.OP,2);
L_.L-1;
END
END;
ROUTINE SUSERCALL(CREAT)=
% CREAT IS 1 FOR COROUTINE CREATION, 0 FOR CALL.
PRINCIPLE: READ UNTIL THE RIGHT PARENTHESIS
1.SAVE THE NAME AND INITIATE THE NUMBER OF PARAMETERS.
2.READ IN ORDER TO GET THE FIRST PARAMETER'S,BEGIN IN SYM AND DEL.
3.TREAT THE PARAMETERS SUCCESSIVELY.
4.WHEN A COMMA IS FOUND STSRT WITH NEXT PARAMETER.
5.IF FUTSYM FOLLOWING THE RIGHT PARENTHESIS IS HEMPTY
(AS IT SHOULD BE) TRANSMIT SYM TO FUTSYM AND READ ONCE MORE.%
BEGIN LOCAL FU,M; %4-12-77%
IF .REALS NEQ 0
THEN (CHECKEXTER(.REALS);
IF NOT CHKULA(.REALS) THEN ERROR(.NSYM,#40));
FU_SYM_GENCODE(.SYM,1); M_1;
% M IS INITIATED WITH 1 TO COUNT THE LAST PARAMETER%
IF .CREAT THEN
IF .DEL<LEFTHALF> NEQ HPAROPEN THEN
(RECOVER(.NDEL,#72); RETURN ERRLEVEL _ 1);
HRUND();
UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA DO
BEGIN
EXPRESSION(2);
IF .DEL<LEFTHALF> EQL HCOMMA
THEN BEGIN M_.M+1; IF .SYM EQL HEMPTY THEN ERROR(.NSYM,11);
IF .CODETOG THEN (IF .CREAT THEN GCREA1(.SYM)
ELSE GFRC1(.SYM));
HRUND();
FIXSIDEEFFECTS();
END;
ERRLEVEL_0
END; %NOW IS M = 1+# OF COMMAS%
IF .SYM EQL HEMPTY
THEN IF .M EQL 1 THEN M_0 ELSE ERROR(.NSYM,11);
IF .DEL<LEFTHALF> EQL HROCLO
THEN (IF .SYM<LEFTHALF> EQL GTLEX THEN EXPRESSION(2); %4-14-77 %
SYM _ IF .CODETOG THEN
(IF .CREAT THEN GCREA2(.SYM,.FU,.M)
ELSE GFRC2(.SYM,.FU,.M))
ELSE ZERO)
ELSE (RECOVER(.NDEL,2);RETURN ERRLEVEL_1);
FIXSIDEEFFECTS();
IF CORRECTP1() THEN FUTSYM_.SYM
ELSE (RECOVER(.NFUTSYM,IF FUTAE() THEN 3 ELSE 12);ERRLEVEL_1);
IF .ERRLEVEL EQL 0 THEN HRUND();
.M
END;
%3.1% GLOBAL ROUTINE SCREATE =
%_CALLS SUSERCALL TO DO THE FUNCTION-CALL LIKE PART.
OTHERWISE STRAIGHTFORWARD.
_%
BEGIN
LOCAL NPAR,SAVVAL;
HRUND(); ! READ PAST 'CREATE'.
GCREA0();
CLEARRTGT();
NPAR _ SUSERCALL(1);
SAVVAL _ .SYM;
IF .DEL<LEFTHALF> NEQ HCRAT THEN
(RECOVER(.NDEL,#67); RETURN ERRLEVEL _ 1);
HRUND(); ! READ PAST 'AT'.
CLEARRTGT();
EXPRESSION(2);
IF .SYM EQL HEMPTY OR .DEL<LEFTHALF> NEQ HLENGTH THEN
( RECOVER(.NDEL,#70); RETURN ERRLEVEL _ 1)
ELSE
IF .CODETOG THEN GCREA3(.SYM);
HRUND(); ! READ PAST 'LENGTH'.
EXPRESSION(2);
IF .SYM EQL HEMPTY OR .DEL<LEFTHALF> NEQ HTHEN THEN
( RECOVER(.NDEL,#71); RETURN ERRLEVEL _ 1)
ELSE
IF .CODETOG THEN GCREA4(.SYM);
HRUND(); ! READ PAST 'THEN'.
CLEARRTGT();
EXPRESSION(2);
IF .SYM EQL HEMPTY THEN SYM _ ZERO;
IF .CODETOG THEN GCREA5(.SYM);
CLEARRTGT();
LIVR(SYM _ .SAVVAL)
END; ! END OF SCREATE.
%3.1% GLOBAL ROUTINE SEXCHJ =
%_STRAIGHTFORWARD ANALYSIS OF EXCHJ.
EMPTY VALUE-EXPRESSION ALLOWED, WITH OR WITHOUT COMMA.
THE CODE FOR THE PROCESS-EXPRESSION IS NOT GENERATED UNTIL IT
CAN BE DETERMINED IF IT CAN BE OBTAINED WITH A SINGLE MOVE, AND AFTER
THE VALUE-EXPRESSION. TO DO THIS, INSPECT VALUES OF CODEPROP.
_%
BEGIN
LOCAL SAVECP,PPCP;
! WINDOW: XXX EXCHJ 0 (
IF (.FUTSYM NEQ HEMPTY) OR (.FUTDEL<LEFTHALF> NEQ HROPEN) THEN
( HRUND(); RECOVER(.NFUTDEL,#64); RETURN ERRLEVEL _ 1)
ELSE (HRUND(); HRUND()); ! READ PAST '('.
CODEPROP _ 0; ! TO SEE IF PROC IS ONE-MOVER.
EXPRESSION(2); ! COMPILE PROCESS EXPRESSION.
PPCP _ .CODEPROP;
IF .SYM EQL HEMPTY THEN
( RECOVER(.NSYM,#65); RETURN ERRLEVEL _ 1)
ELSE IF .CODETOG THEN SAVECP _ GEXCH0(.SYM);
CODEPROP _ 0;
SYM _ HEMPTY; ! PREPARE FOR TEST BELOW.
CLEARRTGT();
IF .DEL<LEFTHALF> EQL HCOMMA THEN
( HRUND(); EXPRESSION(2)); ! COMPILE VALUE-EXPRESSION.
IF .DEL<LEFTHALF> NEQ HROCLO THEN
( RECOVER(.NDEL,#66); RETURN ERRLEVEL _ 1)
ELSE
IF .SYM EQL HEMPTY THEN SYM _ ZERO;
IF CORRECTP1() THEN
( IF .CODETOG THEN
FUTSYM _ GEXCH1(.SYM,(IF NOT (.PPCP OR .CODEPROP) THEN .SAVECP ELSE 0)))
ELSE
( RECOVER(.NDEL,IF FUTAE() THEN 3 ELSE 12); RETURN ERRLEVEL _ 1);
HRUND(); ! READ PAST ')'.
CLEARRTGT();
CODEPROP _ 1
END; ! END OF SEXCHJ.
%3.1% GLOBAL ROUTINE SSQOPEN=
%PRINCIPLE:READ UNTIL SQUCLOSE AND COLLECT THE SUBSCRIPTS
1.DISTINQUISH BETWEEN THE SIMPLE AND NON-SIMPLE STRUCTURE
(AS DESCRIBED BY BILL); THE NON-SIMPLE A[I,J,0] WITH MAP STRUCTURE
:A IS TREATED AS STRUC(A,I,J) AND THE SYNTAX CODE FOR IT IS THE
SAME AS FOR SPAROPEN.
THE SIMPLE A[I,.....,J,0] IS TREATED AS FOLLOWS.
2.SAVE STRUCTURE NAME AND READ ONCE TO GET THE BEGINNING OF THE
FIRST SUBSCRIPT
3.WHENEVER A COMMA IS FOUND ,BOOK SUBSCRIPT AND DELETE COMMA
4.IF FUTSYM IS 0 FOLLOWING SQUCLO(AS IT SHOULD BE)
TRANSMIT SYM TO FUTSYM AND READ ONCE MORE.RESULT IS P1.%
BEGIN
LOCAL ACTUALS, ! STE INDEX OF ACTUAL PARAMETER BLOCK
INCACTS, ! " " " INCARNATION ACTUALS BLOCK
CPTOSYM, ! CHARACTER POINTER TO SYM IN CASE OF EXPANSION ERRORS
NUMPARMS, ! NUMBER OF PARAMETERS ALLOWED
STRUCT, ! STE INDEX OF STRUCTURE
SAVELAST, ! LAST PARAMETER WHEN EXTRAS PASSED
DEFAULT, ! DEFAULT VECTOR STRUCTURE USED
SIMPLE; ! TRADITIONAL MISNOMER FOR MACRO-TYPE EXPANSION.
REGISTER T; LOCAL PSZ;
LOCAL L;
MAP STVEC ACTUALS:INCACTS:REALS:STRUCT;
MACRO DEFAULT0=IF .SYM EQL HEMPTY THEN SYM_ZERO$;
% IF WE DO NOT HAVE A SYMBOL IN SYM, OR THE SYMBOL HAS NOT
BEEN MAPPED, WE DEFAULT THE VECTOR STRUCTURE WITH ACTUAL OF 1%
IF DEFAULT_
(IF .REALS EQL 0
THEN 1
ELSE
(CHECKEXTER(.REALS);
IF MAPPABLE((.REALS[0]<TYPEF>))
THEN (INCACTS_.REALS[1]<STRF>) EQL 0
ELSE 1))
THEN INCACTS_MKDUMINCA(.PTOVECTOR);
STRUCT_.INCACTS[0]<STRXF>;
NUMPARMS_.STRUCT[1]<NPARMF>; %USED TO CALCULATE DISPLACEMENT IN PARS.%
DEFAULT0;
ACTUALS_GETSPACE(PSZ_.INCACTS[0]<PSZF>);
IF SIMPLE_.STRUCT[1]<SIMBITAF>
THEN CPTOSYM_.NSYM
ELSE INCR I FROM 1 TO .NUMPARMS DO
IF .CODETOG THEN GFRC1(.INCACTS[.I]);
BEGIN
LOCAL NOMORE;
MACRO CLOSEBR=
(IF .DEL<LEFTHALF> EQL HSQCLO AND
.FUTDEL<LEFTHALF> EQL HSTO THEN STUTYPE_1;
IF .DEL<LEFTHALF> EQL HCOMMA
AND .FUTSYM EQL HEMPTY
AND .FUTDEL<LEFTHALF> EQL HSQCLO
THEN (HRUND(); 1)
ELSE .DEL<LEFTHALF> EQL HSQCLO)$,
MOREACTS=
(IF NOMORE_CLOSEBR
THEN .NUMPARMS GTR .L
ELSE
(IF .DEL<LEFTHALF> NEQ HCOMMA
THEN (RECOVER(.NDEL,2);
RETURN ERRLEVEL_1);
HRUND();
EXPRESSION(0);
DEFAULT0;
1))$,
ACT=IF .NOMORE THEN ZERO ELSE .SYM$;
DEL<LEFTHALF>_HCOMMA;
L_-1;
NOMORE_0;
DO IF (L_.L+1) LEQ .NUMPARMS
THEN ACTUALS[.L]_ACT
ELSE WARNEM(.NSYM,ERSMEXACT)
WHILE MOREACTS;
!V2G- IF NOT USING THE DEFAULT STRUCTURE WARN IF LESS THAN THE SPECIFIED
!V2G- NUMBER OF ACTUALS IS PASSED.
IF .L LSS .NUMPARMS THEN IF NOT .DEFAULT THEN WARNEM(.NSYM,ERFEWERACT); !V2G-
IF .SIMPLE
THEN GSSA(.ACTUALS,.INCACTS,.STRUCT,1,.CPTOSYM)
ELSE
BEGIN
IF NOT .CODETOG THEN EXITBLOCK;
INCR I FROM 0 TO .NUMPARMS-1 DO
GFRC1(SYM_GENCODE(.ACTUALS[.I],2));
SYM_GFRC2(SYM_GENCODE(.ACTUALS[.NUMPARMS],2), .STRUCT+LSM,
.NUMPARMS^1+1)
END;
END;
IF CORRECTP1() THEN FUTSYM_.SYM
ELSE (RECOVER(.NDEL,IF FUTAE() THEN 3 ELSE 12);ERRLEVEL_1);
IF .ERRLEVEL EQL 0 THEN HRUND();
IF .DEFAULT THEN RELEASESPACE(.INCACTS,.PSZ);
RELEASESPACE(.ACTUALS, .PSZ);
END;
%3.1% GLOBAL ROUTINE SPTR=
%PRINCIPLE: READ UNTIL THE MATCHING POINTER CLOSE
1. INITIATE THE POINTER PARAMETERS WITH THEIR DEFAULT
VALUES AND SAVE NAME.
2. READ ONCE TO START WITH THE FIRST POINTER PARAMETER
3.READ THE PARAMETERS SUCCESSIVELY,IF A PARAMETER IS HEMPTY
THEN GO ON TO THE NEXT ONE, THE DEFAULT VALUE HAS ALREADY
BEEN SET.
4.THE FINISHING PART IS EXACTLY LIKE THAT OF THESUSERCALL
OR SQUOPEN %
BEGIN LOCAL NAME, PAR[4], L; NAME_.SYM; PAR[1]_36;
PAR_L_PAR[2]_PAR[3]_0;
HRUND();
UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA DO
BEGIN
EXPRESSION(0);
IF .DEL<LEFTHALF> EQL HCOMMA
THEN BEGIN
IF .SYM NEQ HEMPTY THEN PAR[.L]_.SYM;
L_.L+1; HRUND()
END;
IF .L GTR 4 THEN (ERROR(.NSYM,#41); L_4);
ERRLEVEL_0
END;
PAR[.L] _ .SYM;
IF .DEL<LEFTHALF> EQL HPOINTCLO
THEN (IF .CODETOG THEN SYM_GENGRAPH(.NAME,.PAR,.PAR[1],
.PAR[2],.PAR[3],HPTOPEN^18+(NGPTR<0,0> AND #777777),5)
%5.200.2% ELSE SYM_.NAME)
ELSE (RECOVER(.NDEL,2);RETURN ERRLEVEL_1);
IF CORRECTP1() THEN FUTSYM_.SYM
ELSE (RECOVER (.NFUTDEL,IF FUTAE() THEN 3 ELSE 12); ERRLEVEL_1);
IF .ERRLEVEL EQL 0 THEN HRUND()
END;
%3.1% GLOBAL ROUTINE SCASE=
%THE ROUTINE CONSISTS OF TWO PARTS,THE "SIMPLE CASE" AND THE
"GENERAL CASE". A SIMPLE CASE HAS THE FORM
CASE<CONSTANT> OF SET E0;E1;.....EN TES
AND IF CONSTANT =I THEN IT IS COMPILED AS(EI),I.E.
ALL THE OTHER EXPRESSION ARE SIMPLY SKIPPED%
BEGIN
ROUTINE CONSTCASE=
BEGIN LOCAL VAL,EN,SVTARGET; EN_LITV(.SYM);VAL_0;
!!! THE FOLLOWING 4 STATEMENTS UNDO THE CASE SKELETON
ACPR2(); ! --> C1
ERASEBOT(.CODEPTR);
CODEPTR_.CT[.CODEPTR,0]<PREVF>; ! --> C0
UNTEMPLATE();
IF .FUTDEL<LEFTHALF> NEQ HSET OR .FUTSYM NEQ HEMPTY
THEN (RECOVER(.NFUTSYM,16);RETURN ERRLEVEL_1);
HRUND(); SHUTOFFCODE(); ! WINDOW: (0,"SET", EX1S, EX1D)
SVTARGET=.VTARGET;
UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HSEMCOL DO
BEGIN
IF .EN EQL 0 AND .CODETOG NEQ 0 THEN (TURNONCODE(); GCE0(0);VTARGET=0);
HRUND(); ! WINDOW: (EX1S, EX1D, EX1FS, EX1FD)
EXPRESSION(0); ! WINDOW: (EXPR, (";"/"TES"),...)
IF .DEL<LEFTHALF> EQL HSEMCOL THEN
BEGIN IF .EN EQL 0 AND .CODETOG
THEN (IF .SYM EQL HEMPTY THEN SYM_ZERO; VAL_GCE2(.SYM,0);SHUTOFFCODE(););
EN_.EN-1;
END
ELSE IF .CODETOG NEQ 0 AND .EN EQL 0 THEN SHUTOFFCODE();
ERRLEVEL_0
END;
TURNONCODE();
IF .SYM EQL HEMPTY OR .EN GTR 0 THEN SYM_ZERO;
IF .DEL<LEFTHALF> EQL HTES
THEN(IF .CODETOG AND .EN EQL 0 THEN VAL_GCE2(.SYM,0))
ELSE(RECOVER(.NDEL,2);RETURN ERRLEVEL_1);
IF .FUTSYM EQL HEMPTY AND .FUTDEL<HCLASS> EQL CLOBRAC
THEN FUTSYM_.VAL ELSE (IF FUTAE() THEN RECOVER(.NFUTDEL,3)
ELSE RECOVER(.NFUTSYM,12);ERRLEVEL_1);
IF .ERRLEVEL EQL 0 THEN HRUND();
VTARGET=.SVTARGET
END;
% PRINCIPLE: READ IN FIRST LOOP TILL OF AND IN
SECOND SET EXPR.
1.INITIATE THE NUMBER OF CASE EXPRESSION AT ZERO
2.READ ONCE IN ORDER TO START THE ANALYSIS OF THE FIRST
CASE EXPRESSION.
3. WHEN COMMA IS FOUND INCREASE N AND START WITH NEXT
CASE EXPRESSION
4.WHEN OF IS FOUND TEST IF IT IS FOLLOWED BY SET
5. ANALYSE THE SET EXPRESSION SIMILAR AS IN ROUTINE SSET%
%V2H% BEGIN LOCAL LLABIND, N; N_1; IF .CODETOG THEN GCOST0(); SETLABSIFNECESSARY(COSTC); HRUND();
DO
BEGIN
EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,2);
IF .DEL<LEFTHALF> EQL HCOMMA
THEN BEGIN N_.N+1;IF .SYM EQL HEMPTY THEN ERROR(.NDEL,15);
IF .CODETOG THEN GCOST1(.SYM);
HRUND();
FIXSIDEEFFECTS();
END;
ERRLEVEL_0
END %N=1+ # OF COMMAS%
UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA;
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .DEL<LEFTHALF> EQL HOF
%V2H% THEN (IF .CODETOG THEN(IF LITP(.SYM) AND .N EQL 1 THEN RETURN (CONSTCASE(); KILLLABSIFNECESSARY) ELSE
GCOST2(.SYM,.N);
IF .N EQL 1 THEN (GTPURGE(0);GTINCR();SAVRT(0))))
%V2H% ELSE (RECOVER(.NDEL,2);RETURN (ERRLEVEL_1; KILLLABSIFNECESSARY));
FIXSIDEEFFECTS();
IF .FUTDEL<LEFTHALF> NEQ HSET OR .FUTSYM NEQ HEMPTY
THEN (RECOVER(.NFUTDEL,16);ERRLEVEL_1);
%V2H% SSET(.N GTR 1);
%V2H% KILLLABSIFNECESSARY;
END
END;
%3.1% GLOBAL ROUTINE SREP=
BEGIN LOCAL LLABIND, J, DEC;
!
! THIS ROUTINE COMPILES THE CODE FOR INCR/DECR LOOPS.
!
ROUTINE IDDEL=
BEGIN LOCAL X;
IF (X_.DEL<LEFTHALF> ) EQL HFROM THEN 1 ELSE
IF .X EQL HTO THEN 2 ELSE
IF .X EQL HBY THEN 3 ELSE
IF .X EQL HDO THEN 4 ELSE 0
END;
DEC_.DEL<LEFTHALF>; HRUND();
SYM_DECLTEMPREG(.SYM,1);
IF .CODETOG THEN GID0(.SYM);
%V2H% SETLABSIFNECESSARY(IDFTDC);
INCR I FROM 1 TO 4 DO
BEGIN
IF (J_IDDEL()) LSS .I
%V2H% THEN (RECOVER(.NDEL,36); RETURN (ERRLEVEL_1; KILLLABSIFNECESSARY))
ELSE IF .J GTR .I THEN
INCR K FROM .I TO .J-1 DO
IF .CODETOG THEN
CASE .K OF
SET
0;
GID1(ZERO);
GID2(LITLEXEME(IF .DEC EQL HDECR THEN (1^35) ELSE NOT(1^35)));
(GID3(LITLEXEME(1),.DEC EQL HDECR);CLEARRTGT());
%V2H% (RECOVER(.NDEL,37); RETURN(ERRLEVEL_1; KILLLABSIFNECESSARY));
TES;
HRUND(); EXPRESSION(0); VTARGET_IF .I NEQ 4 THEN -1 ELSE 0; SYM_GENCODE(.SYM,1);
I_.J;
IF .SYM EQL HEMPTY THEN ERROR(.NSYM,40);
IF .CODETOG THEN
CASE .I OF
SET
0;
SYM_GID1(.SYM);
SYM_GID2(.SYM);
(SYM_GID3(.SYM,.DEC EQL HDECR);CLEARRTGT());
SYM_GID4(.SYM,.DEC EQL HDECR);
TES;
FIXSIDEEFFECTS();
END;
DECLTEMPREG(0,0); CLEARRTGT();
%V2H% KILLLABSIFNECESSARY;
END;
%V2H% GLOBAL ROUTINE SLEAVE=
%V2H% !ENTER WITH WINDOW: XXX LEAVE XXX XXX
%V2H% ! SYM DEL FUTSYM FUTDEL
%V2H% !
%V2H% !FUTSYM MUST BE DECLARED A LABELT SYMBOL AND MUST BE IN ALIVE
%V2H% !STATE: ALIVEB=1.
%V2H% BEGIN
%V2H% REGISTER HIND; !TO HOLD INDEX OF LABELLED HEADER
%V2H% BEGIN
%V2H% !FIRST MAKE SURE THAT .FUTSYM IS A PROPER LABEL.
%V2H% IF .ST[HIND_.FUTSYM<STEF>,0]<TYPEF> NEQ LABELT
%V2H% THEN EXITCOMP (ERROR(.NFUTSYM,ERIMPLABEL); ERRLEVEL_1);
%V2H% IF NOT .ST[.HIND,1]<ALIVEB> THEN EXITCOMP( ERROR(.NFUTSYM,EROUTLABSCOPE); ERRLEVEL_1);
%V2H% !NOW GET THE INDEX TO THE LABELLED HEADER
%V2H% HIND_.ST[.FUTSYM<STEF>,1]<PREVF>;
%V2H% END;
%V2H% !NOW MOVE WINDOW TO CHECK FOR "WITH" EXPRESSION
%V2H% HRUND(); !GET NEXT DEL INTO DEL
%V2H% IF .DEL<LEFTHALF> EQL HWITH
%V2H% THEN (HRUND(); EXPRESSION(0))
%V2H% ELSE SYM_ZERO;
%V2H% !NOW GET AND CHECK THE RESULT EXPRESSION
%V2H% VTARGET_2; SYM_GENCODE(.SYM,2); IF .ERRLEVEL THEN RETURN;
%V2H% IF .SYM EQL HEMPTY THEN SYM_ZERO;
%V2H% IF .CODETOG THEN (SYM_ GLEAVE(.SYM,.HIND));
%V2H% END;
%3.1% GLOBAL ROUTINE SESCAPE=
BEGIN
!
! THIS ROUTINE HANDLES COMPILATION OF ALL ESCAPE EXPRESSIONS.
!
LOCAL ESC, D;
ESC_ IF (D_.DEL<LEFTHALF>) EQL HRETURN THEN 0 ELSE
IF .D EQL HEXIT THEN 1 ELSE
IF .D EQL HEXITLOOP THEN 2 ELSE
IF .D EQL HEXITBLOCK THEN 3 ELSE
IF .D EQL HEXITCOMP THEN 4 ELSE
IF .D EQL HEXITCOND THEN 5 ELSE
IF .D EQL HEXITSELECT THEN 6 ELSE
IF .D EQL HEXITCASE THEN 7 ELSE
IF .D EQL HEXITSET THEN 8 ELSE -1;
HRUND();
D_LITLEXEME(1);
IF .DEL<LEFTHALF> EQL HSQOPEN AND .SYM EQL HEMPTY THEN
BEGIN HRUND(); EXPRESSION(2);
IF NOT LITP(D_.SYM) OR .D EQL HEMPTY THEN ERROR(.NSYM,41);
IF .DEL<LEFTHALF> NEQ HSQCLO THEN
(RECOVER(.NDEL,42); RETURN ERRLEVEL_1);
FIXFUTDEL(); ! KLUDGE TO HANDLE UNARY OP AFTER ].
HRUND();
END;
EXPRESSION(0); VTARGET_2; SYM_GENCODE(.SYM,2);
IF .ERRLEVEL THEN RETURN;
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .CODETOG THEN
SYM_CASE .ESC OF
SET
GRETURN(.SYM);
GEXIT(.SYM,.D);
GXLOOP(.SYM,.D);
GXBLOCK(.SYM,.D);
GXCMPEX(.SYM,.D);
GXCOND (.SYM,.D);
GXSELECT(.SYM,.D);
GXCASE(.SYM,.D);
GXSET(.SYM,.D);
TES;
END;
GLOBAL ROUTINE SSPUNOP=
BEGIN LOCAL TYPE,P;
!THIS ROUTINE HANDLES SPECIAL UNARY OPERATORS(FUNCTIONS) IMPLEMENTED
!TO ALLOW USE OF OPCODES SUCH AS JFFO AND MOVM AND ACCORDING TO USER PRESSURE.
TYPE_.ST[.SYM<STEF>,1];
HRUND();
EXPRESSION(2);
IF (P_.SYM) EQL HEMPTY THEN P_ZERO;
IF .DEL<LEFTHALF> NEQ HROCLO THEN
(RECOVER(.NDEL,44); RETURN ERRLEVEL_1)
%3.7% ELSE IF .CODETOG THEN
% THE FOLLOWING 7 LINES ARE ADDED TO FIX BUG#4 %
(
IF NOT LITP(.P) THEN
IF .P<LSF> THEN
IF UPLEVELCHECK(.P) THEN
P=.SYMVALUE;
SYM=GSPUNOP(.TYPE,.P);
);
IF CORRECTP1() THEN FUTSYM_.SYM
ELSE (RECOVER(.NFUTSYM,IF FUTAE() THEN 3 ELSE 12);
ERRLEVEL_1);
HRUND()
END;
ROUTINE SSPLF=
BEGIN LOCAL T, O, P1, P2;
! THIS ROUTINE HANDLES THE COMPILATION OF THE SPECIAL
! CHARACTER HANDLING FUNCTIONS.
!
T_.ST[.SYM<STEF>,1];
P1_P2_0;
HRUND();
EXPRESSION(2);
IF (P1_.SYM) EQL HEMPTY THEN ERROR(.NSYM,43);
IF .DEL<LEFTHALF> EQL HCOMMA THEN
BEGIN
HRUND(); EXPRESSION(2);
IF (P2_.SYM) EQL HEMPTY THEN ERROR(.NSYM,43);
END;
IF .DEL<LEFTHALF> NEQ HROCLO
THEN (RECOVER(.NDEL,44);RETURN ERRLEVEL_1)
%3.7% ELSE IF .CODETOG THEN
% THE FOLLOWING 9 LINES ARE ADDED TO FIX BUG#4 %
BEGIN
INCR I FROM 0 TO 1 DO
( IF NOT LITP(.P1[.I]) THEN
IF .P1[.I]<LSF> THEN
IF UPLEVELCHECK(.P1[.I]) THEN
P1[.I]=.SYMVALUE;
);
SYM=GSPLF(.T,.P1,.P2);
END;
IF CORRECTP1()
THEN FUTSYM_.SYM
ELSE (RECOVER(.NFUTSYM,IF FUTAE() THEN 3 ELSE 12); ERRLEVEL_1);
IF .T LSS 10 THEN
IF .T GEQ 6 THEN FIXSIDEEFFECTS()
ELSE IF NOT .T THEN FIXSIDEEFFECTS(); %5-16-77%
HRUND();
END;
%3.1% GLOBAL ROUTINE SSELECT=
%V2H% BEGIN LOCAL LLABIND, N;
!
! THIS ROUTINE ANALYZES THE SYNTAX OF SELECT EXPRESSIONS
!
HRUND();
N_0;
IF .CODETOG THEN GSE0();
%V2H% SETLABSIFNECESSARY(SELECTC);
UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA DO
BEGIN
EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,2);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .DEL<LEFTHALF> EQL HCOMMA THEN
(N_.N+1; IF .CODETOG THEN GSE1(.SYM); HRUND());
FIXSIDEEFFECTS();
ERRLEVEL_0;
END;
IF .SYM EQL HEMPTY THEN (SYM_ZERO; ERROR(.NSYM,50));
%V2H% IF .DEL<LEFTHALF> NEQ HOF THEN (RECOVER(.NDEL,45); RETURN(ERRLEVEL_1; KILLLABSIFNECESSARY));
%3.39% IF .CODETOG THEN (GSE2(.N+1,.SYM); GTPURGE(0); GTINCR(); SAVRT(0));
HRUND();
FIXSIDEEFFECTS();
%V2H% IF .DEL<LEFTHALF> NEQ HNSET THEN (RECOVER(.NDEL,46); RETURN(ERRLEVEL_1; KILLLABSIFNECESSARY));
HRUND();
UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HSEMCOL AND
.DEL<LEFTHALF> NEQ HCOLON AND .DEL<LEFTHALF> NEQ HALWAYS AND
.DEL<LEFTHALF> NEQ HOTHERWISE DO
BEGIN
%3.39% IF .DEL<LEFTHALF> EQL HOTHERWISE THEN (HRUND(); IF .CODETOG THEN (GSE3O(); CLEARSOME(); GTPURGE(1))) ELSE
%3.39% IF .DEL<LEFTHALF> EQL HALWAYS THEN (HRUND(); IF .CODETOG THEN (GSE3A(); CLEARSOME(); GTPURGE(1))) ELSE
BEGIN
EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,1);
IF .SYM EQL HEMPTY THEN (ERROR(.NSYM,47); SYM_ZERO);
%3.39% IF .CODETOG THEN (GSE3(.SYM); CLEARSOME(); GTPURGE(1))
END;
%V2H% IF .DEL<LEFTHALF> NEQ HCOLON THEN (RECOVER(.NDEL,48); RETURN( ERRLEVEL_0; KILLLABSIFNECESSARY));
HRUND();
EXPRESSION(0); VTARGET_2; SYM_GENCODE(.SYM,2);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
!OTHERWISE AND ALWAYS DON'T REQUIRE A FOLLOWING SEMICOLON. IF IT
!IS MISSING, PRINT A WARNING AND ASSUME IT IS THERE
BEGIN
IF .DEL<LEFTHALF> EQL HOTHERWISE OR
.DEL<LEFTHALF> EQL HALWAYS
THEN
BEGIN
WARNEM(.NSYM,ERNOSEMI);
IF .CODETOG THEN
%3.39% (GSE4(.SYM); CLEARSOME(); GTPURGE(1); EXITCOMPOUND[3]) !TO %A%
END;
IF .DEL<LEFTHALF> EQL HSEMCOL THEN
%3.39% ( IF .CODETOG THEN (GSE4(.SYM); CLEARSOME(); GTPURGE(1)); HRUND())
ELSE IF .DEL<LEFTHALF> NEQ HTESN THEN EXITLOOP;
%A% END;
ERRLEVEL_0;
END;
%V2H% IF .DEL<LEFTHALF> NEQ HTESN THEN (RECOVER(.NDEL,49); RETURN (ERRLEVEL_0; KILLLABSIFNECESSARY));
%3.39% IF .CODETOG THEN (SYM_GSE5(.SYM); RESRT(1); CLEARSOME(); GTPURGE(2); LIVR(.SYM); GTDECR());
IF .FUTSYM EQL HEMPTY AND .FUTDEL<HCLASS> EQL CLOBRAC
THEN FUTSYM_.SYM
ELSE (IF FUTAE() THEN RECOVER(.NFUTDEL,3) ELSE RECOVER(.NFUTSYM,12); ERRLEVEL_1);
IF .ERRLEVEL EQL 0 THEN HRUND();
%V2H% KILLLABSIFNECESSARY;
END;
%3.1% GLOBAL ROUTINE SIF=
BEGIN
%V2H% LOCAL LLABIND; !HOLDS INDEX TO LABEL CHAIN IF ANY
!
! THIS ROUTINE COMPILES THE IF-THEN-ELSE FORM OF CONTROL EXPRESSION.
!
%V2H% ROUTINE CONSTIF(TRIP)=
BEGIN LOCAL RESULT,SVTARGET;
IF .CODETOG THEN GCE0(0);
IF NOT .TRIP THEN SHUTOFFCODE();
SVTARGET=.VTARGET;
VTARGET = 0; %9-19-77%
HRUND();
EXPRESSION(0); %9-19-77%
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .TRIP
THEN (RESULT_.SYM; SHUTOFFCODE())
ELSE TURNONCODE();
IF .DEL<LEFTHALF> EQL HELSE THEN
BEGIN HRUND(); EXPRESSION(1); END;
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF NOT .TRIP THEN RESULT_.SYM ELSE TURNONCODE();
IF .CODETOG THEN SYM_GCE2(.RESULT,0);
CODEPTR_LOCATE(ITEC,5);
CLASSLAB();
UNTEMPLATE();
VTARGET=.SVTARGET
END;
%V2H% !IF WE HAVE LABELS ON THIS IF THEN ELSE, STORE SKELETON HEADER
%V2H% !IN LABEL STES.
LOCAL SKIPTOG;
LOCAL NESTEDIF; EXTERNAL NOIFOPT; %9-19-77%
NESTEDIF=.NOIFOPT; %9-19-77%
SKIPTOG_.DEL<LEFTHALF> EQL HIFSKIP;
IF .CODETOG THEN GITE0();
%V2H% SETLABSIFNECESSARY(ITEC); !IF THIS ITE LABELED, TURN LABELS ON.
IF .NESTEDIF EQL 2 THEN NOIFOPT=1; %9-19-77%
%V2H% HRUND(); EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,2);
NOIFOPT = 2; %9-19-77%
IF .SYM EQL HEMPTY THEN(ERROR(.NSYM,38); SYM_1) ELSE
IF .DEL<LEFTHALF> EQL HTHEN AND LITP(.SYM) AND .CODETOG THEN
%V2H% RETURN( CONSTIF(LITV(.SYM));NOIFOPT=.NESTEDIF; KILLLABSIFNECESSARY); %9-19-77%
IF .CODETOG THEN ( GITE1(.SYM,.SKIPTOG); GTPURGE(0); GTINCR(); SAVRT(0));
IF .DEL<LEFTHALF> NEQ HTHEN
THEN RECOVER(.NDEL,39)
ELSE
BEGIN HRUND(); EXPRESSION(2);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .CODETOG THEN (GITE2(.SYM);GTPURGE(1); RESRT(0))
END;
IF .DEL<LEFTHALF> NEQ HELSE
THEN (IF .CODETOG THEN
(SYM_ZERO; SYM_GITE3(.SYM); RESRT(1);CLEARSOME();GTPURGE(2);LIVR(.SYM);GTDECR()))
ELSE
BEGIN HRUND(); EXPRESSION(2);
IF .CODETOG THEN
(SYM_GITE3(.SYM); RESRT(1); CLEARSOME(); GTPURGE(2); LIVR(.SYM);GTDECR());
END;
%V2H% KILLLABSIFNECESSARY;
NOIFOPT = .NESTEDIF; %9-19-77%
END;
%3.1% GLOBAL ROUTINE SDO=
%PRINCIPLE: CONSIDER WHILE (OR UNTIL) AS A SPECIAL SORT OF
COMMA AND READ UNTIL THE END OF THE WHOLE SO
EXPRESSION.
1. BOOK THAT THE ANALYSIS OF THE DO PART HAS STARTED
(IN VARIABLE COM)
2. READ IN ORDERRTO START WITH THE DO EXPRESSION
3. VERY SIMILAR TO THE REP ROUTINE R10 %
%V2H% BEGIN LOCAL LLABIND, COM, SORT; COM_0; IF .CODETOG THEN GDWU0();
%V2H% SETLABSIFNECESSARY(DWUC);
HRUND(); CLEARRTGT();
EXPRESSION(1);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .CODETOG THEN GDWU1(.SYM);
FIXSIDEEFFECTS();
SORT_.DEL<LEFTHALF>;
IF .SORT NEQ HUNTLCLO AND .SORT NEQ HWHLCLO
%V2H% THEN (RECOVER(.NDEL,2); RETURN( ERRLEVEL_1; KILLLABSIFNECESSARY)) ELSE HRUND();
EXPRESSION(1);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .CODETOG THEN SYM_GDWU2(.SYM,.SORT EQL HWHLCLO);
ERRLEVEL_0; CLEARRTGT();
%V2H% KILLLABSIFNECESSARY;
END;
%3.1% GLOBAL ROUTINE SWU=
%ALMOST THE SAME AS SDO EXCEPT THAT DIRECT AT THE BEGINNING
THE DISTINCTION IS FOUND BETWEEN WHILE AND UNTIL EXPRESSIONS.
DO IS CONSIDERED AS SORT OF A COMMA%
%V2H% BEGIN LOCAL LLABIND, SORT, COM; SORT_.DEL<LEFTHALF>; COM_0;
%V2H% IF .CODETOG THEN GWUD0(); SETLABSIFNECESSARY(WUDC); HRUND(); CLEARRTGT();
EXPRESSION(0); VTARGET_-1; SYM_GENCODE(.SYM,1);
IF .SYM EQL HEMPTY THEN (SYM_ZERO; ERROR(.NSYM,31));
IF .CODETOG THEN GWUD1(.SYM,.SORT EQL HUNTIL);
FIXSIDEEFFECTS();
IF .DEL<LEFTHALF> EQL HDO
%V2H% THEN HRUND() ELSE (RECOVER(.NDEL,2); RETURN( ERRLEVEL_1; KILLLABSIFNECESSARY));
EXPRESSION(1);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
IF .CODETOG THEN SYM_GWUD2(.SYM);
ERRLEVEL_0; CLEARRTGT();
%V2H% KILLLABSIFNECESSARY;
END;
%3.1% GLOBAL ROUTINE SPAROPEN =
BEGIN
%THIS ROUTINE ACTS AS A SWITCH TO
THE APPROPRIATE ROUTINE TO HANDLE: (1)USER FUNCTION/
ROUTINE CALLS, OR (2) SPECIAL FUNCTIONS.%
IF .SYM<LSF> THEN
BEGIN
IF .ST[.SYM<STEF>,0]<TYPEF> EQL MACHT THEN SML() ELSE
IF .ST[.SYM<STEF>,0]<TYPEF> EQL SPLFT THEN SSPLF() ELSE
IF .ST[.SYM<STEF>,0]<TYPEF> EQL SPUNOPT THEN SSPUNOP() ELSE
SUSERCALL(0)
END ELSE SUSERCALL(0);
END;
ROUTINE SML=
BEGIN LOCAL OP, N, P1,P2, P3, P4;
%THIS ROUTINE HANDLES THE ANALYSIS OF THE MACHINE LANGUAGE
SPECIAL FUNCTIONS. %
OP_.ST[.SYM<STEF>,1]; N_P1_P2_P3_P4_0; HRUND();
UNTIL .DEL<HCLASS> EQL CLOBRAC AND .DEL<LEFTHALF> NEQ HCOMMA DO
BEGIN
EXPRESSION(2);
IF .DEL<LEFTHALF> EQL HCOMMA
THEN (P1[.N]_.SYM; N_ .N+1; HRUND());
ERRLEVEL_0;
END;
P1[.N]_.SYM; ! IF NOT LITP(.P1) THEN ERROR(.NSYM,#146);
% THE FOLLOWING 6 LINES ARE ADDED TO FIX REGISTER
DECLARATIONS AND USAGE IN NESTED GLOBAL ROUTINES 12-27-77 %
IF NOT LITP(.P1) THEN
IF .P1<LSF> THEN
BEGIN
IF UPLEVELCHECK(.P1) THEN P1=.SYMVALUE
ELSE ERROR(.NSYM,#146);
END;
IF .DEL<LEFTHALF> EQL HROCLO
THEN (IF .CODETOG THEN
% THE FOLLOWING 10 LINES ARE ADDED TO FIX BUG#4 %
BEGIN
INCR I FROM 0 TO 2 DO
( IF NOT LITP(.P2[.I]) THEN
IF .P2[.I]<LSF> THEN
IF UPLEVELCHECK(.P2[.I]) THEN
P2[.I]=.SYMVALUE;
);
SYM=GML(.OP,.P1,.P2,.P3,.P4)
END
)
ELSE (RECOVER(.NDEL,#150); RETURN ERRLEVEL_1);
IF CORRECTP1() THEN FUTSYM_.SYM
ELSE(RECOVER(.NFUTSYM,IF FUTAE() THEN 3 ELSE 12); ERRLEVEL_1);
HRUND();
END;
%3.1% GLOBAL ROUTINE DECLTEMPREG(SYMBLEX,SWIT)=
% THIS ROUTINE DECLARES (AND UN-DECLARES) A TEMPORARY
REGISTER FOR USE IN INCR-DECR LOOPS. SWIT=1 IMPLIES
MAKE DECLAR,SWIT=0 SIMPLY DOES A BLOCKPURGE. IN CASE
OF A DECLARATION WE RETURN THE LEXEME FOR THE NEW
REGISTER VARIABLE.
%
BEGIN LOCAL L1;
IF .SWIT THEN
BEGIN BLOCKLEVEL_.BLOCKLEVEL+1; L1_.REALS;
IF .SYMBLEX<LSF> NEQ 1 AND .L1 EQL 0 THEN ERROR(.NSYM,#36) ELSE
BEGIN
ACCUM_.ST[.L1,2]; ACCUM+1_.ST[.L1,3];
L1_STINSERT(.UNDECLEX,0);
ST[.L1,0]<TYPEF>_REGT;
SYMBLEX_ST[.L1,1]_LTINSERT(ACQUIRE(-.L1,1)<0,36>);
ST[.L1,1]<NRF>_1;
SYMBLEX<VEF>_1;
.SYMBLEX
END
END ELSE BLOCKPURGE(BLOCKLEVEL_.BLOCKLEVEL-1)
END;
%%
% PLIT SYNTAX PROCESSING ROUTINES. THE SYNTAX FOR PLITS IS AS
FOLLOWS:
<PLIT> ::= PLIT <PLITARG>
<PLITARG> ::= <LOAD TIME EXPRESSION> !
<LONG STRING> !
<TUPLE>
<TUPLE> ::= (<TUPLE ITEM LIST>)
<TUPLE ITEM LIST> ::= <TUPLE ITEM> !
<TUPLE ITEM>,<TUPLE ITEM LIST>
<TUPLE ITEM> ::= <LOAD TIME EXPRESSION> !
<LONG STRING> !
<DUPLICATION FACTOR>:<PLITARG>
<DUPLICATION FACTOR> ::= <COMPILE TIME EXPRESSION>
[NOTE: <LOAD TIME EXPRESSION> ::= <PLIT> ! ...]
GENERALLY PLITS ARE TREATED EXACTLY AS GLOBALS. A FAKE SYMBOL
TABLE ENTRY OF TYPE "PLITT" IS ENTERED IN THE SYMBOL TABLE;
ITS ADDITIONAL INFORMATION WORD IS ITS OFFSET FROM THE PLIT REGION
BASE. OF COURSE, A NEW RELOCATION TYPE FOR PLITS IS REQUIRED.
INTERNALLY THE ELEMENTS OF ALL PLITS ARE HUNG OFF A HEADER
POINTED TO BY "PLHEAD". EACH ELEMENT IS A POINTER TABLE TYPE
ELEMENT, WITH TWO EXCEPTIONS:
1. LITERALS ARE ALSO PUT IN, WITH RELOCATION TYPE "NORELOC";
2. DUPLICATED SUBLISTS ARE ENTERED AS 2 CELL HEADERS; WORD 2
CONTAINS THE REPETITION FACTOR.
"PLHEAD" IS PROCESSED BY THE LOADER INTERFACE AT THE END OF
THE COMPILATION. THE SYNTAX PROCESSING ROUTINES FOR THE PLITS
GENERALLY CORRESPOND TO THE NON-TERMINAL PRODUCTIONS OF THE SYNTAX.
EACH ROUTINE IS PASSED A HEADER ONTO WHICH THE RESULTING CHAIN OF
POINTER TYPE ENTRIES IS LINKED. EACH RETURNS THE LENGTH OF THE
SPACE OCCUPIED BY THE PARTICULAR NON-TERMINAL IN ORDER THAT THE
"PLNEXT" (NEXT PLIT OFFSET) MAY BE UPDATED CORRECTLY.
%
%%
MAP STVEC PLHEAD; ! CT HEADER FOR THE SYSTEM PLITS
FORWARD PLITARG, PLITLEX, FINNAMES;
GLOBAL ROUTINE SPLIT1(A) =
BEGIN
! IF .A EQL 0 THEN IT IS PLIT OR UPLIT.
! IF .A EQL 2 THEN CALLED FROM OWNEQL.
! IF .A EQL 1 THEN CALLED FROM GLOEQL.
! (5.200.13) INTRODUCES UPLIT, UNCOUNTED PLIT
! (5.200.13) BIND PLITLENGTH=1;
%5.200.13% LOCAL PLITLENGTH;
LOCAL STVEC TEMPHEAD:NEXTCELL:FIRSTCELL, OFFST, LOCGPV, NAMESINDEX;
PUSHGPV(0,PLBOOL)_1;
NAMESINDEX_0;
TEMPHEAD_HEADER(0,0,0);
IF .A EQL 0 THEN
%5.200.13% IF .DEL<LEFTHALF> THEN PLITLENGTH_0 ! UPLIT IS ODD
%5.200.13% ELSE PLITLENGTH_1; ! PLIT IS EVEN
%5.200.13% IF (.PLITLENGTH EQL 1 OR .A GEQ 1) THEN FIRSTCELL_NEWBOT(.TEMPHEAD,1);
OFFST_PLITARG(NAMESINDEX,.TEMPHEAD,0);
%5.200.13% IF .NAMESINDEX NEQ 0 THEN FINNAMES(.NAMESINDEX,.PLITLENGTH);
%5.200.13% IF (.PLITLENGTH EQL 1 OR .A GEQ 1) THEN FIRSTCELL[1]_.OFFST;
IF .A EQL 0 THEN (
%5.200.13% SYM_PLITLEX(.PLNEXT+.PLITLENGTH);
%5.200.13% PLNEXT_.PLNEXT+.OFFST+.PLITLENGTH;
SYM<POSNSIZEF>_36);
CASE .A OF SET
PUSHBOT(.PLHEAD,.TEMPHEAD);
PUSHBOT(.GLOHEAD,.TEMPHEAD);
PUSHBOT(.OWNHEAD,.TEMPHEAD)
TES;
FLATTEN(.TEMPHEAD);
POPGPV(0,PLBOOL);
IF .A EQL 0 THEN .SYM ELSE .FIRSTCELL
END;
GLOBAL ROUTINE SPLIT=SPLIT1(0);
%5.200.13% ROUTINE FINNAMES(NAMESINDEX,PLITLSW)= !FINISH NAMES BINDING IN PLITS
BEGIN
LOCAL L,LL;
%5.200.16% LOCAL GSW;
WHILE .NAMESINDEX NEQ 0 DO
BEGIN
%5.200.16% LL_.ST[.NAMESINDEX,1]<18,15>;
!THE LEFT HALF HOLDS A FORWARD INDEX AND, NOW (5.200.16), A GLOBAL SWITCH
%5.200.16% GSW_.ST[.NAMESINDEX,1]<35,1>;
ST[.NAMESINDEX,1]<LEFTHALF>_0;
%5.200.13% ST[.NAMESINDEX,1]_.ST[.NAMESINDEX,1]+.PLNEXT+.PLITLSW;
%5.200.16% ST[.NAMESINDEX,0]<TYPEF>_
%5.200.16% IF .GSW THEN GPLITT ELSE PLITT;
! %5.200.16% IF .ST[.NAMESINDEX,0]<TYPEF> EQL GPLITT
%5.200.16% IF .GSW
THEN DEFGLLEX(.NAMESINDEX);
NAMESINDEX_.LL
END
END;
FORWARD TUPLEITEM, LSORLE;
ROUTINE PLITARG(NAMESINDEX,HEAD,DUPPLITFL) =
!HEAD IS INDEX TO LIST OF PLIT ARGS
!NAMESINDEX CONTAINS ADDRESS OF WORD TO RECEIVE STINDEX OF NAME TO
!BE BOUND VIA A NAMES OR INDEXES BIND
!DUPPLITFL EQL 1 <=> DUPPLICATION FACTOR MAKES A NAMES OF
!INDEXES BIND ILLEGAL AT THIS POINT.
BEGIN
HRUND();
IF .SYM EQL HEMPTY AND .DEL<LEFTHALF> EQL HROPEN
THEN
BEGIN
LOCAL LENTH, !LENGTH OF PLIT IN WORDS, NOT COUNTING PLIT[-1]
LNAMESINDEX, !INDEX TO NAMES BIND ST ENTRY CHAIN
LNSYM; !CONTAINS .NSYM IN CASE WE MUST HRUND ON A GLOBAL BIND
REGISTER PLITFLAGS, !PLIT FLAGS EXPLAINED IN MACROS BELOW
RSTE; !STE INDEX OF NAME TO BE BOUND
MACRO CHAIN(X)=ST[X,1]<18,18>_.LNAMESINDEX;
LNAMESINDEX_X;$;
MACRO NAMESFL=PLITFLAGS<0,1>$, !1 -> NAMES BIND, 0-> INDEXES BIND
GLOBALFL=PLITFLAGS<1,1>$; !1<-> GLOBAL BIND
PLITFLAGS_LNAMESINDEX_LENTH_0;
%A% DO (HRUND();
!LOOP UNTIL THERE ARE NO MORE NAMES OR INDEXES BINDS
%B% WHILE (NAMESFL_(.DEL<LEFTHALF> EQL HNAMES)) OR
(.DEL<LEFTHALF> EQL HINDEXES) OR
(GLOBALFL_(.DEL<LEFTHALF> EQL HGLOBALLY))
DO
BEGIN
BEGIN
LNSYM_.NSYM;
IF .DUPPLITFL THEN (WARNEM(.LNSYM,ERNOBINDDUP);EXITCOMPOUND[2]); %C%
IF NOT .SYM<LSF> THEN (WARNEM(.LNSYM,ERNONAME); EXITCOMPOUND[2]); %C%
RSTE_.SYM<STEF>; !STE INDEX OF NAME TO BE BOUND
%2.20% IF .GLOBALFL THEN HRUND(); !TO MOVE OVER GLOBALLY LEXEME
IF NOT ((.DEL<LEFTHALF> EQL HINDEXES) OR (NAMESFL_(.DEL<LEFTHALF> EQL HNAMES)))
THEN (WARNEM(.NDEL,ERDMBIN); EXITLOOP %EXIT LOOP -B-%);
IF .ST[.RSTE,0]<BLF> EQL .BLOCKLEVEL !IF NAME ALREADY DECLARED AT THIS BLOCK LEVEL
THEN (IF .ST[.RSTE,0]<TYPEF> NEQ UNDEDT THEN (WARNEM(.LNSYM,ERNMPREV); EXITCOMPOUND[3])) %C%
ELSE RSTE_DECSYQ(.RSTE,0,0);
%2.34% IF .GLOBALFL THEN IF GSTINSERT(.RSTE) NEQ 0
%2.20% THEN (WARNEM(.LNSYM,ERALDECGL); GLOBALFL_0);
ST[.RSTE,1]_.LENTH; !SAVE OFFSET IN ALL CASES
ST[.RSTE,0]<TYPEF>_CASE .PLITFLAGS OF SET
ABSOLUTET; !INDEXES
%5.200.16% (CHAIN(.RSTE);%PLITT% UNDEDT); !NAMES
(DEFGBC(.RSTE,.LENTH);GABSOLUTET); !GLOBALLY INDEXES
%5.200.16% (CHAIN(.RSTE);ST[.RSTE,1]<35,1>_1;%GPLITT% UNDEDT) !GLOBALLY NAMES
TES
%C% END;
HRUND();
END; !OF WHILE-DO LOOP %B%
.NAMESINDEX_.LNAMESINDEX;
LENTH_.LENTH+TUPLEITEM(.HEAD);) !END OF DO PORTION OF DO-WHILE LOOP
WHILE .DEL<LEFTHALF> EQL HCOMMA; !END OF DO-WHILE LOOP %A%
IF .DEL<LEFTHALF> NEQ HROCLO OR .FUTSYM NEQ HEMPTY
THEN RETURN RECOVER(.NDEL,ERSYPLMRP);
HRUND();
.LENTH
END
ELSE LSORLE(.HEAD)
END;
ROUTINE TUPLEITEM(HEAD) =
BEGIN
EXPRESSION(1);
IF .DEL<LEFTHALF> EQL HCOLON
THEN
BEGIN
LOCAL LEN, STVEC NEWHEAD, NAMESINDEX;
IF NOT LITP(.SYM) THEN (ERROR(.NSYM,ERSMPLNLI); SYM_ZERO);
NEWHEAD_HEADER(2,0,1);
!THE FOLLOWING THREE LINES WILL CHECK FOR NEGATIVE
!RELICATION COUNT IN A PLIT AND WARN THEM. 3-28-77
LEN_LITV(.SYM);
IF .LEN LSS 0 THEN (LEN_0;WARNEM(.NSYM,#763));
NEWHEAD[2]<RIGHTHALF>_.LEN;
PUSHBOT(.HEAD,.NEWHEAD);
LEN_.LEN*PLITARG(NAMESINDEX,.NEWHEAD,1);
.LEN
END
ELSE LSORLE(.HEAD)
END;
FORWARD LEXTOP;
MACRO UNDER(A,B)=
BEGIN
MAP STVEC A:B;
CT[.A[1]<PREVF>,0]<NEXTF>_.B[1]<NEXTF>;
CT[.B[1]<NEXTF>,0]<PREVF>_.A[1]<PREVF>;
A[1]<PREVF>_.B[1]<PREVF>;
CT[.B[1]<PREVF>,0]<NEXTF>_.A;
RELEASESPACE(.B,1)
END$;
ROUTINE LSORLE(HEAD)=
%5.200.18%BEGIN LOCAL WHICHB;
IF .STRHED NEQ 0
THEN
BEGIN
LOCAL RLEN, LSHEAD;
LSHEAD_.STRHED<RIGHTHALF>;
RLEN_.STRHED<LEFTHALF>;
STRHED_0;
%5.200.34 - CHANGE FOR UPLIT... %
IF .CT[.HEAD,1]<NEXTF> EQL .HEAD THEN
BEGIN
LOCAL FSW,LSW;
FSW=.CT[.LSHEAD,1]<NEXTF>;
LSW=.CT[.LSHEAD,1]<PREVF>;
CT[.HEAD,1]<NEXTF>=.FSW;
CT[.FSW,0]<PREVF>=.HEAD;
CT[.HEAD,1]<PREVF>=.LSW;
CT[.LSW,0]<NEXTF>=.HEAD;
RELEASESPACE(.LSHEAD,1);
END
ELSE UNDER(HEAD,LSHEAD);
% .... 5.200.34%
.RLEN
END
ELSE
%5.200.18% (WHICHB_WHICHBIND();
%5.200.18% IF .WHICHB GTR 1 THEN WHICHB_3-.WHICHB;
%5.200.18% IF .WHICHB EQL 0
%5.200.18% THEN (ERROR(.NSYM, ERSMPLNLO); LEXTOP(.HEAD,ZERO)) ! 0 - RUNTIME CODE MADE / 3 - RUNTIME ADDRESS
%5.200.18% ELSE (LEXTOP(.HEAD,.SYM))) ! 1 - LITERAL / 2 - LOADTIME ADDRESS
%5.200.18%END;
ROUTINE LEXTOP(HEAD,LEX) =
BEGIN
LOCAL STVEC CELL, CODE3;
CELL_GETSPACE(1);
CELL[0]_.CELL^15+.CELL;
IF .LEX<LSF>
THEN
BEGIN
CODE3_
IF PTRTYPP(.LEX)
THEN MADDRFRPTRTYP(.LEX)
ELSE FSA(.LEX<STEF>);
CELL[0]<RELOCF>_.CODE3<RELOCF>;
CELL[1]_
%3.40% IF PTRTYPP(.LEX)
THEN VALPTRTYP(.LEX<STEF>)
ELSE .LEX<POSNSIZEF>^24 OR (.CODE3 AND IXYM);
END
ELSE
BEGIN
CELL[0]<RELOCF>_NORELOC;
CELL[1]_LITV(.LEX);
END;
PUSHBOT(.HEAD,.CELL);
1
END;
ROUTINE PLITLEX(OFFST)=
BEGIN
ACCUM[0]_0; ACCUM[1]_-1;
(STINSERT((PLITT^TYPEFP)+LSM,.OFFST)+LSM)
END;
!END OF H1SYNT.BLI