Trailing-Edge
-
PDP-10 Archives
-
BB-H138C-BM
-
language-sources/lx0n.bli
There are 18 other files named lx0n.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: LOLEXA.BLI
!DATE: 18 OCTOBER 73 MGM/FLD
! REVISION HISTORY :
! 12-21-77 ROUTINE IDFIXFS IS MODIFIED TO ALLOW REGISTERS WITH SAME
! NAMES DEFINED IN NESTED GLOBAL ROUTINES.
!
! 9-19-77 ROUTINE SKAN IS MODIFIED TO FIX BUGS#40,41.
! ROUTINE IDFIXER IS MODIFIED SO THAT MACRO NAME
! IS ALLOWED AS PART OF THE REQUIRE FILE NAME.
!
! 7-15-77 ROUTINE IDFIXFS IS MODIFIED TO ALLOW REGISTER BIND TO
! BIND VARIABLE AND ASSIGNMENT TO OWN AND GLOBAL VARIABLES.
! 5-9-77 ROUTINES IDFIXFS,IDFIXER,SKAN ARE MODIFIED TO
! 6-6-77 ROUTINE IDFIXER IS MODIFIED SO THAT REQUIRE FILE
! NAME CAN BE A MACRO NAME AND NO MACRO EXPANSION AND
! NO ERROR MESSAGE.
!
! FIX BUGS REQUIRE FILE NAME,MACRO X=!!$; AND
! #-14 VALUE (BIND A=#-14).
!
%5.200.1: CHANGE TO WATCH FOR OFF-END-OF-15BIT-ADDRESSING/ PAB%
%3.2% GLOBAL BIND LOLEV=6; !MODULE VERSION NUMBER
EXTERNAL REGASSN; ! 7-8-77
OWN REDO; ! USED TO CHANGE RECUR. TO IT. IN HRUND
FORWARD WRUND;
! LEXICAL ANALYZER
! --------------------------------------
! SUPPORT ROUTINES
!-------------------
%3.1% GLOBAL ROUTINE LEXERR=
! THIS ROUTINE IS CALLED ONLY FOR SOME QUEER
! ERRORS WHERE A DELIMITER WAS NOT PLACED BETWEEN
! TWO OPERANDS.
BEGIN ERROR(.NDEL,#776); HRUND();
SYM_LITLEXEME(0)
END;
%3.1% GLOBAL ROUTINE PUNT(ERR)=
!
! THIS ROUTINE IS CALLED FOR CATISTROPHIC COMPILER
! ERRORS WHICH FORCE US TO DO A COMPLETE RESTART. WE
! GIVE AN ERROR TO THE USER AND JRST BACK TO REINIT
! THE MAIN LOOP. SORRY FOLKS!!
!
BEGIN EXTERNAL FINIO;
ERROR(.NDEL,.ERR); EOCHAR(#77); EOCHAR(#11); EMESSAGE("PUNT!",1);
%2.19% !ZERO XREFLG SO THAT WE WON'T GET INTO AN INFINITE LOOP
%2.19% !BETWEEN XEOB AND PUNT.
%2.19% ENEWLINE(); FINIO(); XREFLG_0; NDRIVER();
END;
! DYNAMIC STORAGE MANAGEMENT
!-----------------------------
GLOBAL ROUTINE DOCOREUUO (UUOARG) =
!DO A STANDARD CORE UUO WITH ARG OF .UUOARG.
!RETURN 0 IF SUCCESS, ELSE (-1)
BEGIN
REGISTER R;
%3.31% MACHOP CALLI = #047, TDZA = #634, SETOI = #475;
R_.UUOARG;
CALLI (R,#11); !CORE UUO
TDZA (R,R); !ERROR RETURN
%3.31% SETOI (R,0); !SUCCESSFUL RETURN
%3.31% COREGONE_ NOT .R
END;
%3.1% GLOBAL ROUTINE CALLEXECFORSPACE=
BEGIN
REGISTER R;
MACHOP HLRO=#564;
EXTERNAL ?.JBREL,?.JBSYM,?.JBDDT;
%3.31% IF DOCOREUUO(.?.JBREL<0,18> + #2000) THEN PUNT(#770);
ENDOFSPACE _ .ENDOFSPACE + #2000/TIMXMF;
%5.200.1% IF .ENDOFSPACE GTR #100000 THEN
EMESSAGE("WARNI","NG: E","NDOFS","PACE ",
"HAS E","XCEED","ED 2*","*15 ",8);
IF
(.?.JBSYM<RIGHTHALF> GTR 0) AND (.?.JBSYM<RIGHTHALF> LSS #400000)
THEN
BEGIN
BIND
L=NOT HLRO(R,?.JBSYM),
NEWSYM=(.?.JBREL<,18>)[-L],
OLDSYM=(.?.JBSYM<,18>)[0];
DECR I FROM L TO 0 DO
NEWSYM[.I] _ .OLDSYM[.I];
?.JBSYM<,18> _ NEWSYM
END
END;
ROUTINE GARBAGECOLLECT=
BEGIN REGISTER R1, LST;
! ENEWLINE();EMESSAGE("G IN ",1);
NOGBGCOL_.NOGBGCOL+1;
R1_.FREEHEAD;
DECR I FROM (.TOPOFTABLE^(-4-TIMXGF)) TO 0 DO (AVL+.I)<0,36>_0;
DO AVL[.R1/TIMXGF]_1 UNTIL (R1_.TABLE[.R1,1]) LEQ 1;
LST_R1_0;
WHILE (R1_.R1+TIMXGF) LEQ .TOPOFTABLE DO
IF .AVL[.R1/TIMXGF] THEN
BEGIN
TABLE[.LST,1]_.R1; LST_.R1;
WHILE (R1_.R1+(TIMXGF*.TABLE[.R1,0]); .AVL[.R1/TIMXGF]) DO
TABLE[.LST,0]_.TABLE[.LST,0]+.TABLE[.R1,0];
END;
TABLE[.LST,1]_0;
! EMESSAGE("G OUT",1);
END;
ROUTINE ZEROIT(LOC,NUM)=
BEGIN
INCR I FROM .LOC TO .LOC+2*(.NUM-1) BY 2 DO
TABLE[.I,0]_TABLE[.I,1]_0;
.LOC
END;
%3.1% GLOBAL ROUTINE RELEASESPACE(LOC,NUM)=
BEGIN
TABLE[.LOC,0]_.NUM; TABLE[.LOC,1]_.FREEHEAD;
FREEHEAD_.LOC; AMNTFREE_.AMNTFREE+.NUM
END;
ROUTINE GETTER(NUM)=
BEGIN LOCAL L,LL,N,M;
L_.FREEHEAD; LL_0; AMNTFREE_.AMNTFREE-.NUM;
WHILE .L GTR 1 DO
IF (M_.TABLE[.L,0]) LSS .NUM
THEN (LL_.L; L_.TABLE[.L,1])
ELSE IF .M EQL .NUM
THEN (TABLE[.LL,1]_.TABLE[.L,1]; RETURN .L)
ELSE (M_TABLE[.L,0]_.M-.NUM; RETURN .L+.M*TIMXGF );
AMNTFREE_.AMNTFREE+.NUM; RETURN -1
END;
ROUTINE GET12(NUM)=
BEGIN LOCAL L,LL,N,M;
L_.FREEHEAD; LL_0; AMNTFREE_.AMNTFREE-.NUM;
WHILE .L GTR 1 DO
IF .TABLE[.L,0] NEQ .NUM
THEN (LL_.L; L_.TABLE[.L,1])
ELSE (TABLE[.LL,1]_.TABLE[.L,1]; RETURN .L);
AMNTFREE_.AMNTFREE+.NUM; RETURN -1
END;
%3.1% GLOBAL ROUTINE GETSPACE(NUM)=
BEGIN LOCAL X;EXTERNAL CALLEXECFORSPACE,RETOT;
IF .NUM LEQ 2 THEN IF (X_GET12(.NUM)) GTR 0
THEN RETURN ZEROIT(.X,.NUM);
IF (X_GETTER(.NUM)) GTR 0 THEN RETURN ZEROIT(.X,.NUM);
IF .AMNTFREE GTR .NUM*4 THEN ! IF AVAIL SPACE IIS 4*REQUEST
IF .AMNTFREE GTR (.ENDOFSPACE-.TOPOFTABLE) THEN
BEGIN
GARBAGECOLLECT();
IF (X_GETTER(.NUM)) GTR 0 THEN RETURN ZEROIT(.X,.NUM);
END;
WHILE (.TOPOFTABLE+TIMXGF*.NUM) GTR .ENDOFSPACE DO CALLEXECFORSPACE();
X_.TOPOFTABLE; TOPOFTABLE_.TOPOFTABLE+TIMXGF*.NUM;
%5.200.1% IF .TOPOFTABLE GTR #100000 THEN
(EMESSAGE("WARNI","NG: T","OPOFT","ABLE ","HAS E",
"XCEED","ED 2*","*15 ",8);COREGONE_1;PUNT(#770););
ZEROIT(.X,.NUM)
END;
! LITERAL TABLE MANAGEMENT AND LIT-LEXEMES
!---------------------------------------------
%2.9% GLOBAL ROUTINE LTINSERT(LIT)=
%2.9% !LTINSERT RETURNS AS ITS VALUE THE INDEX INTO THE
%2.9% !LT WHERE THE LITERAL .LIT IS STORED.
%2.9% !.LIT IS A LITERAL VALUE.
%2.9% BEGIN
%2.9% !ALWAYS RETURN THE LARGEST POSSIBLE OFFSET FOR THE LITERAL 0.
%2.9% IF .LIT EQL 0 THEN RETURN #37777;
%2.9% BEGIN
%2.9% REGISTER R1, !INDEX THRU LT SEARCH
%2.9% R2, !HASH FUNCTION VALUE
%2.9% TVAL, !LT ENTRY FOR COMPARISONS WITH .LIT
%2.9% RBASE; !BASE ADDRES OF CURRENT LT MODULE
%2.9% !FIRST COMPUTE THE HASH FUNCTION
%2.9% R2_((.LIT +.LIT^(-9) +.LIT^(-18) +.LIT^(-27)) AND LTMASK);
%2.9% !NOW SEARCH EACH MODULE FROM NUMBER LTNUM-1 TO 0
%2.28% INCR TNUM FROM 0 TO LTNUM - 1 DO
%2.9% BEGIN
%2.9% !IF WE HAVEN'T SET UP THIS MODULE YET, WE DO SO
%2.9% IF .LTBASE[.TNUM] EQL 0
%2.9% THEN LTBASE[.TNUM]<RIGHTHALF>_CT[GETSPACE(LTSIZE^(-1)),0];
%2.9% RBASE_.LTBASE[.TNUM]<RIGHTHALF>;
%2.9% R1_.R2;
%2.9% !NOW LET'S SEARCH THIS PARTICULAR MODULE.
%2.9% WHILE 1 DO
%2.9% BEGIN
%2.9% !IF THIS ENTRY EQUALS .LIT RETURN WITH THE APPROP INDEX
%2.9% IF ((TVAL_@(@RBASE)[R1_((.R1+1) AND LTMASK)]) EQL .LIT)
%2.9% THEN
%2.9% RETURN (.R1 + .TNUM*LTSIZE);
%2.9% !IF THIS ENTRY IS 0, WE INSERT THE LITERAL HERE IF WE
%2.9% !HAVE NOT YET EXCEEDED LTLIM FOR THIS MODULE.
%2.9% IF .TVAL EQL 0
%2.9% THEN IF .LTBASE[.TNUM]<LEFTHALF> LEQ LTLIM
%2.9% THEN
%2.9% BEGIN
%2.9% LTBASE[.TNUM]_.LTBASE[.TNUM]+1^18; !UP COUNT
%2.9% (@RBASE)[.R1]<0,36>_.LIT; !INSERT LIT
%2.9% RETURN (.R1 + .TNUM*LTSIZE); !RETURN INDEX
%2.9% END
%2.9% ELSE EXITLOOP !TO %B%
%2.9% ELSE EXITCOMPOUND !TO %A%
%2.9% END; !%A% TO HERE IF ENTRY IS NOT THE RIGHT LIT
%2.9% END; !%B% TO HERE IF HAVE FINISHED THIS MODULE
%2.9% END;
%2.9% END;
%2.9% GLOBAL ROUTINE GETLITVAL(IND)=
%2.9% !RETURNS THE 36 BIT VALUE OF THE LITERAL WHOSE INDEX IS IND
%2.9% IF .IND EQL #37777 THEN RETURN 0 ELSE
%2.9% .(.LTBASE[(.IND)/LTSIZE])[(.IND AND LTMASK)]<0,36>;
%3.1% GLOBAL ROUTINE LITLEXEME(VALUE)=
BEGIN
LOCAL L1;
!
! THIS ROUTINE CREATES, AND RETURNS, A LEXEME FOR THE
! LITERAL WHOSE VALUE IS IN 'VALUE'.
!
IF .VALUE LEQ #37777 AND .VALUE GTR 0
THEN
BEGIN
L1_LITLEX1; L1<LTEF>_.VALUE;
END
ELSE
BEGIN
L1_LITLEX2; L1<LTEF>_LTINSERT(.VALUE);
END;
.L1
END;
! SYMBOL TABLE ROUTINES
!------------------------
%3.1% GLOBAL ROUTINE HASH(SYMBOL)=
!
! THIS ROUTINE COMPUTES THE HASH FUNCTION OF SYMBOL
!
%3.29% ABS(.SYMBOL MOD HTSIZE);
%3.1% GLOBAL ROUTINE STINSERT(LEX,ADDINFO)=
BEGIN LOCAL L1,L2;
!
! THIS ROUTINE CREATES A ST ENTRY AT THE CURRENT BLOCK
! AND FUNCTION LEVELS. THE SYMBOL IS ASSUMED TO BE IN
! ACCUM.
!
L1_HASH(.ACCUM);
L2_GETSPACE(2);
LEX<BLF>_.BLOCKLEVEL;
LEX<FLF>_.FUNCTIONLEVEL;
LEX<LINKF>_.HT[.L1];
HT[.L1]_.L2;
ST[.L2,0]_.LEX;
ST[.L2,1]_.ADDINFO;
ST[.L2,2]_.ACCUM;
ST[.L2,3]_.(ACCUM+1);
IF .XREFLG THEN XREFINS(.LEX);
.L2
END;
GLOBAL ROUTINE GLOBALCHECK(STINDEX) =
!CHECK TO SEE IF THIS NAME HAS BEEN DECLARED GLOBAL AT ANY
!BLOCKLEVEL. IF SO, RETURN THE INDEX OF THE STE, OTHERWISE 0.
!IF NOT, MAKE AN ENTRY IN THE GST FOR THIS SYMBOL.
!STINDEX IS THE ST INDEX OF THE NAME WE CURRENTLY WISH TO
!DECLARE GLOBAL.
BEGIN
REGISTER L1;
!LOOK THRU GLOBAL SYMBOL TABLE FOR MATCH IN FIRST 6 CHARS
%2.31% L1_.GLLIST;
WHILE .L1 NEQ 0 DO
BEGIN
IF .ST[.STINDEX,2] EQL .ST[.L1,2] THEN !IF NAME IS ...
%2.31% IF (((.ST[.STINDEX,3] XOR .ST[.L1,3]) AND
%2.31% #774000^18) EQL 0) THEN !THE SAME IN THE FIRST SIX CHARS
RETURN(.L1);
L1_.ST[.L1,0]<LINKF>
END;
RETURN(0); !TO INDICATE THAT WE DIDN'T FIND ENTRY
END;
%2.34% GLOBAL ROUTINE GSTINSERT(IND)=
%2.34% !INSERT STE WITH INDEX .IND INTO GLOBAL SYMBOL TABLE ALSO.
%2.34% !FOR NOW, THE ADDINFO WORD OF THIS ENTRY WILL BE LEFT NULL.
%2.34%
%2.34% BEGIN
%2.34%
%2.34% REGISTER GIND; !INDEX OF GLOBAL STE
%2.34%
%2.34% !FIRST SEE IF IT'S ALREADY THERE
%2.34% IF(GIND_GLOBALCHECK(.IND)) NEQ 0 THEN
%2.34% BEGIN
%2.34% WARNEM(.NFUTSYM,ERREDGLOBAL);
%2.34% RETURN .GIND;
%2.34% END;
%2.34%
%2.34% !SINCE WE DIDN'T FIND ONE, LET'S MAKE ONE
%2.34% GIND_GETSPACE(2); !FIRST GET CELL FOR NEW GSTE
%2.34% DECR I FROM 3 TO 0 DO !COPY THE ST INFO INTO THE GST CELL
%2.34% CT[.GIND,.I]_.CT[.IND,.I];
%2.34%
%2.34% CT[.GIND,0]<LINKF>_.GLLIST; !PUT THIS GSTE INTO LIST
%2.34% GLLIST_.GIND; !LINK TO NEW CELL
%2.34%
%2.34% RETURN(0); !TO INDICATE THAT WE MADE A NEW ENTRY
%2.34%
END; !OF ROUTINE GTINSERT
GLOBAL ROUTINE SEARCH=
BEGIN LOCAL L1;
%5.200.31% GLOBAL XREFERASE;
!
! THIS ROUTINE SEARCHES FOR THE SYMBOL IN ACCUM, AND RETURNS
! ITS SYMBOL TABLE INDEX. NOTE THAT IF NOT FOUND AN "UNDECLARED"
! ENTRY IS MADE IN THE SYMBOL TABLE.
!
L1_.HT[HASH(.ACCUM)];
WHILE .L1 NEQ 0 DO
BEGIN
IF .ACCUM EQL .ST[.L1,2] THEN
IF .(ACCUM+1) EQL .ST[.L1,3] THEN
BEGIN
%5.200.31% IF .XREFERASE THEN XREFERASE_0 ELSE
IF .XREFLG THEN XLINE();
RETURN .L1;
END;
L1_.ST[.L1,0]<LINKF>;
END;
RETURN(STINSERT(.UNDECLEX,0));
END;
! CHARACTER SCAN ROUTINES
!--------------------------
%3.1% GLOBAL ROUTINE SKAN(COED)=
BEGIN
%5.200.37% EXTERNAL EOLCONTEXT;
%5.200.4% MACRO STORNCOUNT=IF .ACCUMLENGTH LSS 140 THEN
(ACCUMLENGTH_.ACCUMLENGTH+1;
REPLACEI(PACCUM,.CHAR));
SCANNER()$;
! THIS ROUTINE DOES THE PRIMARY CHARACTER SCANNING FOR
! THE COMPILER. THE ACTION OF THE ROUTINE DEPENDS UPON
! THE VALUE OF THE PARAMETER 'COED' AS FOLLOWS (WHERE
! 'CODE' IS XXX0YZ):
!
! Z=1 : READ A NEW (LOGICAL) LINE BEFORE SCANNING
! Y=1 : DEBLANK BEFORE SCANNING
! XXX=0 : DO NOTHING (OTHER THAN AS SPECIFIED BY 'YZ')
! 1 : SCAN FOR NEXT ATOM
! 2 : CONTINUE SCAN FOR <IDENTIFIER>
! 3 : CONTINUE SCAN FOR DECIMAL NUMBER
! 4 : CONTINUE SCAN FOR OCTAL NUMBER
! 5 : CONTINUE SCAN FOR QUOTED STRING
%3.17% ! 6 : (CONTINUE) SCAN FOR SPECIAL <IDENTIFIER>
!
! THE VALUE RETURNED BY THE ROUTINE IS:
!
! 0: NO SCANNING PERFORMED
! 1: <IDENTIFIER> FOUND (IT IS IN ACCUM)
! 2: <LITERAL> FOUND (VALUE IN VAL)
! 3: (LONG) STRING FOUND (CHAR COUNT IN VAL,
! STRING IN STRING)
! 4: SPECIAL CHARACTER FOUND
!
!
! THE LENGTH OF THE ITEM SCANNED IS RECORDED IN
! "ACCUMLENGTH".
IF .COED THEN UNTIL .CHAR EQL EOL DO SCANNER();
IF .CHAR EQL EOL THEN SCANNER();
IF .COED^(-1) THEN WHILE .CHAR LEQ #40 DO SCANNER();
CASE .COED^(-3) OF
SET
RETURN 0; ! XXX=0, WE DO NOTHING ELSE
BEGIN ! XXX=1, SCAN FOR NEXT ATOM
VAL_ACCUMLENGTH_STRINFIXED_STRING_0;
PACCUM_(ACCUM-1)<1,7>;
ACCUM_(ACCUM+1)_-2;
CASE .TYPE OF
SET
(SKAN(#30);2); ! DIGITS 0-7
(SKAN(#30);2); ! DIGITS 8,9
(SKAN(#20);1); ! LETTERS
BEGIN ! QUOTED STRING
%5.200.37% EXTERNAL EOLCONTEXT;LOCAL OLDCONTEXT;
%5.200.37% LOCAL OUTPUT;
%5.200.37% OLDCONTEXT_.EOLCONTEXT;
%5.200.37% EOLCONTEXT_"S";
QUOTETYPE_.CHAR;
%5.200.37% SCANNER(); OUTPUT_SKAN(#50);
%5.200.37% EOLCONTEXT_.OLDCONTEXT;
%5.200.37% .OUTPUT
END;
BEGIN ! OCTAL NUMBER (#)
SCANNER();
IF .CHAR LSS #60 OR .CHAR GTR #71
THEN WARNEM(.NFUTSYM,#764);
SKAN(#40);
2
END;
BEGIN !FOR ! OR EOL(#15)
DO SKAN(3) UNTIL .TYPE NEQ 5;
SKAN(#10)
END;
BEGIN ! COMMENT (%)
%5.200.37% LOCAL OLDEOL; EXTERNAL EOLCONTEXT;
%5.200.37% OLDEOL_.EOLCONTEXT;
%5.200.37% EOLCONTEXT_"%";
DO SCANNER() UNTIL .CHAR EQL "%";
%5.200.37% EOLCONTEXT_.OLDEOL;
SCANNER(); SKAN(#12)
END;
BEGIN ! SPECIAL DELIMITER
REPLACEI(PACCUM,.CHAR);
VAL_.CHAR-(
IF .CHAR LEQ #57 THEN #40 ELSE
IF .CHAR LEQ #100 THEN #52 ELSE
#104);
SCANNER();
4
END;
BEGIN ! SUPER ESCAPE (?)
%3.17% SCANNER();
%3.17% IF (.TYPE NEQ 2) AND (.CHAR NEQ "%") AND (.CHAR NEQ ".")
%3.17% AND (.CHAR NEQ "$") THEN RETURN SKAN(.COED);
%3.17% SKAN(#60); !PICK UP SPECIAL IDENTIFIER
%3.17% 1
END;
BEGIN ! MACRO FORMAL (FORMALT)
REPLACEI(PACCUM,.CHAR);
SCANNER(); ACCUMLENGTH_1;
SKAN(#20);
1
END;
0; ! INVALID TYPE-CODE
0; ! INVALID TYPE-CODE
0; ! INVALID TYPE-CODE
0; ! INVALID TYPE-CODE
0; ! INVALID TYPE-CODE
(SCANNER();SKAN(#12)); ! IGNORE CHARACTER
TES
END; ! THIS IS THE END OF XXX=1
BEGIN ! XXX=2, CONTINUE SKAN FOR IDENTIFIER
WHILE .TYPE LEQ 2 DO
BEGIN
%5.200.7% LOCAL TEMPFORGET;
EXTERNAL QUOTESEEN; ! IN MA1N/BODY A205.1
%5.200.4% IF .ACCUMLENGTH LSS 140 THEN
(ACCUMLENGTH_.ACCUMLENGTH+1;
IF ( .QUOTESEEN eql 0) THEN IF .CHAR GEQ "a" THEN IF .CHAR LEQ "z" THEN ! A205.1
CHAR=.CHAR-#40; %9-19-77% ! A205.1
IF ( .QUOTESEEN eql 0) THEN IF .CHAR EQL "&" THEN
CHAR="." ELSE IF .CHAR EQL "_" THEN
CHAR="%"; %9-19-77%
REPLACEI(PACCUM,.CHAR));
%5.200.7% UNTIL (TEMPFORGET_.FORGET<LEFTF>) EQL 0 DO
BEGIN
(.TEMPFORGET)<INUSEBIT>_0;
FORGET<LEFTF>_.(.TEMPFORGET)<LEFTF>;
(.TEMPFORGET)<LEFTF>_0
END;
SCANNER();
END;
END;
BEGIN ! XXX=3, CONTINUE SKAN FOR DECIMAL CONSTANT
WHILE .TYPE LEQ 1 DO
BEGIN
VAL _ .VAL*10+ (.CHAR-"0");
%5.200.4% STORNCOUNT
END;
%NOW LOOK FOR FLOATING VALUES%
IF .CHAR EQL "." THEN
BEGIN LOCAL SCALE,ONETENTH,EXP,M1,M2,SIGNUM;
ONETENTH_SCALE_(#175631463146);
%2.21% VAL _ FLOAT (.VAL);
SCANNER();
WHILE .TYPE LEQ 1 DO
(VAL_.VAL FADR .SCALE FMPR
(FLOAT (.CHAR - "0"));
SCALE _ .SCALE FMPR .ONETENTH;
SCANNER()
);
IF .CHAR EQL "E" THEN %WE HAVE AN EXPONENT%
BEGIN
SCANNER();
SIGNUM_0;
IF .CHAR EQL "+" THEN SCANNER()
ELSE IF .CHAR EQL "-" THEN(SIGNUM_1;SCANNER());
EXP_0;
ACCUMLENGTH_0;
WHILE .TYPE LEQ 1 DO
(ACCUMLENGTH_.ACCUMLENGTH+1;
EXP_.EXP*10+(.CHAR-"0");
SCANNER()
);
IF .ACCUMLENGTH EQL 0 THEN WARNEM(.NFUTDEL,#200);
M1_#201400^18; !FLOATING ONE
M2_#204500^18; !FLOATIMG TEN
WHILE .EXP NEQ 0 DO
(IF .EXP THEN M1_.M1 FMPR .M2;
M2_.M2 FMPR .M2;
EXP_.EXP^(-1)
);
VAL_IF .SIGNUM THEN .VAL FDVR .M1
ELSE .VAL FMPR .M1;
END
END
;
END;
BEGIN ! XXX=4, CONTINUE SKAN FOR OCTAL CONSTANT
WHILE .TYPE EQL 0 DO
BEGIN
VAL _ .VAL ^3+(.CHAR-"0");
%5.200.4% STORNCOUNT;
END;
END;
BEGIN ! XXX=5. FINISH SCAN FOR QUOTED STRING
LOCAL ZBIT, COED, SIZES, CALLFORDEL;
MACRO NOCHAR=.SIZES<0,18>$,
BSIZE=.SIZES<18,18>$,
SEVENBIT=(.COED EQL 0)$,
SIXBITS=(.COED EQL 1)$,
RAD50=(.COED EQL 2)$;
ROUTINE PRWORD(COED,SIZES)=
BEGIN
LOCAL RV;
MACRO INRANGE(X,Y)=(.CHAR GEQ X AND .CHAR LEQ Y)$,
CONVERT=(CASE .COED OF
SET
IF .CHAR NEQ #77 THEN .CHAR ELSE ! QUESTION MARK
(SCANNER();
IF INRANGE("A","_") THEN .CHAR-"A"+1 ELSE
IF .CHAR EQL "0" THEN 0 ELSE
IF .CHAR EQL "1" THEN #177 ELSE
IF .CHAR EQL #77 THEN #77 ELSE
(WARNEM(.NFUTSYM,ERSYIQC); .CHAR));
.CHAR+(IF NOT INRANGE(("A"+#40),("Z"+#40)) THEN #40);
IF INRANGE("0","9") THEN 1+.CHAR-"0" ELSE
IF INRANGE("A","Z") THEN #13+.CHAR-"A" ELSE
IF .CHAR EQL "." THEN #45 ELSE
IF .CHAR EQL #44 THEN #46 ELSE
IF .CHAR EQL #45 THEN #47 ELSE 0
TES)$;
PSTRING_STRING[-1]<1,BSIZE>;
STRING_0;
RV_INCR I FROM 0 TO NOCHAR DO
BEGIN
IF .CHAR EQL .QUOTETYPE
THEN (SCANNER();
IF .CHAR NEQ .QUOTETYPE THEN EXITLOOP (NOCHAR-.I);
IF .I EQL NOCHAR THEN CHAR_.CHAR+128);
IF .I EQL NOCHAR THEN EXITLOOP (-1);
IF .CHAR EQL (.QUOTETYPE+128) THEN CHAR_.QUOTETYPE;
REPLACEI(PSTRING,CONVERT);
SCANNER()
END;
IF .QUOTETYPE NEQ "'" THEN
STRING_.STRING^(-(SEVENBIT+(IF .RV LSS 0 THEN 0 ELSE BSIZE*.RV)));
IF RAD50 THEN
BEGIN
REGISTER AC;
AC_0;
PSTRING_STRING[-1]<1,6>;
INCR I FROM 1 TO 5 DO AC_(.AC+SCANI(PSTRING))*#50;
STRING_.AC+SCANI(PSTRING)
END;
.RV EQL -1
END; ! ROUTINE PRWORD
MACRO BL(A)='A' AND -2$,
BS(N,A)='A' OR ((-1)^(-N*7) AND -2)$;
BIND KEY= PLIT (
BL(ASCIZ),-2,
BL(ASCII),-2,
BL(SIXBI),BS(1,T),
BL(RADIX),BS(2,50));
MAP STVEC REALFS;
LOCAL SPEC;
% SET UP CODE, SIZES, AND ZBIT. %
SPEC_IF .REALFS NEQ 0 THEN
(INCR I FROM 0 TO 3 DO
IF .REALFS[2] EQL .KEY[2*.I] THEN
IF .REALFS[3] EQL .KEY[2*.I+1] THEN EXITLOOP .I) ELSE -1;
IF .SPEC GEQ 0 THEN CALLFORDEL_1 ELSE (SPEC_1; CALLFORDEL_0);
COED_IF ZBIT_(.SPEC EQL 0) THEN 0 ELSE .SPEC-1;
SIZES _ IF .COED EQL 0 THEN 7^18+5 ELSE 6^18+6;
% PROCESS SHORT OR LONG STRINGS. %
SPEC_0;
IF (SPEC_PRWORD(.COED,.SIZES)) OR
(.ZBIT AND ((.STRING AND #377) NEQ 0)) THEN
BEGIN
ACCUMLENGTH_0;
FSTRHED_HEADER(0,0,0);
DO CT[NEWBOT(.FSTRHED,1),1]_.STRING !NOTE: NORELOC=0(!)
WHILE (IF .SPEC
THEN (SPEC_PRWORD(.COED,.SIZES); 1)
ELSE IF .ZBIT THEN
IF (.STRING AND #377) NEQ 0 THEN (STRING_0; 1))
AND
(ACCUMLENGTH_.ACCUMLENGTH+1) LSS LONGESTPLIT;
IF (FSTRHED<LEFTHALF>_.ACCUMLENGTH) GEQ LONGESTPLIT THEN
(ERROR(.NFUTSYM,ERSYMRQ); PUNT(0));
STRING_0
END;
VAL_.STRING;
2+.CALLFORDEL
END; ! END CASE XXX=5.
%3.17% BEGIN ! XXX=6 (CONTINUE) SCAN FOR SPECIAL IDENTIFIER
%3.17% WHILE ((.TYPE LEQ 2) OR
%3.17% (.CHAR EQL "%") OR (.CHAR EQL "$") OR (.CHAR EQL "."))
%3.17% %5.200.4% DO (
%7C(223)% IF .CHAR GEQ "a" THEN
%7C(223)% IF .CHAR LEQ "z"
%7C(223)% THEN CHAR = .CHAR - #40; %9-19-77%
STORNCOUNT
);
%3.17% END; ! CASE XXX=6.
TES
END;
! PRINCIPAL LEXICAL PROCESSOR
!------------------------------
GLOBAL ROUTINE IDFIXFS=
BEGIN
! THIS ROUTINE IS CALLED TO FIX FUTSYM ONLY. NO DEPENDENCY
! ON RUND IS REQUIRED EXCEPT THAT REALFS BE FILLED. IT SHOULD
! BE CALLED AFTER ALL THE DECLARATIONS FOR A BLOCK HAVE BEEN
! MADE.
MACRO WHEN(T,X)=IF T EQL .TYPE THEN (X; RETURN 1)$;
LOCAL STVEC SYM, TYPE;
IF (SYM_.REALFS) EQL 0 THEN RETURN 0;
!MAKE REQUIRE FILE NAME AS UNDECLARED SYMBOL --- 4-22-77
IF .DEL<LEFTHALF> EQL HREQUIRE THEN TYPE_1
ELSE
BEGIN
WHILE ( TYPE_.SYM[0]<TYPEF>) EQL ABSOLUTET OR (.TYPE EQL GABSOLUTET)
DO IF .SYM[1]<LSF>
THEN SYM_.SYM[1]<STEF>
ELSE (FUTSYM_0;
FUTSYM<ADDRESSF>_.SYM[1]<ADDRESSF>;
RETURN 1)
END;
WHEN(LEXEMT, FUTSYM_.ST[.SYM[1]<ADDRESSF>,0]) ELSE
% 12-21-77 TREAT REGISTER TYPE AS LOCALS.
WHEN(REGT, IF (NOT .INDECS OR .REGASSN ) THEN
IF .TGRBLEVEL GEQ .SYM[0]<BLF> AND .FCNSTATE EQL 3
THEN (ERROR(.NFUTSYM,#40); FUTSYM_0; REALFS_0)
ELSE (FUTSYM_.SYM[1]<ADDRESSF>; FUTSYM<VEF>_1)) ELSE
%
%5.200.24% IF (.TYPE GEQ UNDEDT AND .TYPE LEQ GPLITT) OR (.TYPE EQL STRT) OR (.TYPE EQL LINKAGET)
OR (.TYPE EQL MACHT) OR (.TYPE EQL SPLFT) OR (.TYPE EQL SPUNOPT)
THEN
BEGIN
FUTSYM_0;
IF .SYM[0]<LSF> THEN (FUTSYM<LSF>_1; FUTSYM<POSNSIZEF>_36);
FUTSYM<STEF>_.SYM;
IF .TYPE EQL BINDT THEN FUTSYM<DOTF>_1;
RETURN 1
END;
0
END;
%3.1% GLOBAL ROUTINE IDFIXER(COED,WRND1FLG)=
BEGIN LOCAL L1,L2;
! THIS ROUTINE TAKES CARE OF SEARCHING FOR ID'S AND
! BUILDING THE APPROPRIATE LEXEME IN FUTSYM.
L1_.ST[L2_SEARCH(),0]<TYPEF>;
IF .COED NEQ 0 THEN IF .L1 NEQ DELMT THEN REALFS_.L2;
IF .L1 EQL DELMT
THEN
BEGIN ! DELIMITER
FUTDEL_.ST[.L2,1]; HOLD_0;
RETURN
END;
IF .COED EQL 0 THEN IF .L1 NEQ MACROT
THEN
BEGIN ! ERROR, 2ND NAME NOT A DELIMITER
FUTDEL_ERRLEX;
RETURN
END;
% 9-13-77 ALLOW MACRO NAME IN REQUIRE FILE.
IF .L1 EQL MACROT AND .DEL<LEFTHALF> EQL HREQUIRE THEN
L1_1; !6-6-77 REQUIRE FILE NAME CAN BE MACRO NAME
%
IF .L1 EQL MACROT
THEN
BEGIN ! MACRO IDENTIFIER
EXTERNAL EXPMCR;
IF .COED NEQ 0 THEN REALFS_0;
EXPMCR(.L2);
HOLD_0;
IF .COED GEQ 0 THEN
IF .WRND1FLG
THEN REDO=(IF .COED EQL 1 THEN 2 ELSE .COED)
ELSE WRUND(IF .COED EQL 1 THEN 2 ELSE .COED);
RETURN
END;
IF .COED NEQ 0 THEN
(IF IDFIXFS() THEN (IF .COED GEQ 0 THEN
(HOLD_0; WRUND(0);
!IF .FUTSYM IS A SPECIAL FUNCTION (SPLFT) OR A SPECIAL
!UNARY OPERATOR (SPUNOPT) THEN .FUTDEL MUST BE AN OPEN
!PAREN. OTHERWISE WE HAVE A FATAL SYNTAX ERROR IN WHICH
!CASE WE OUTPUT THE ERROR MESSAGE, ZERO FUTSYM, AND RETURN.
%7-JUN-77% IF ((.L1 EQL SPLFT) AND (.ST[.L2,1] LSS 10)) OR .L1 EQL SPUNOPT
THEN IF .FUTDEL <LEFTHALF> NEQ HPAROPEN
THEN (ERROR(.NCBUFF,ERRUNOP); FUTSYM_REALFS_0);
);RETURN));
ERROR(.NSYM,#776); IF .COED GEQ 0 THEN ( HOLD_0; WRUND(.COED));
END;
ROUTINE WRUND1(COED)=
BEGIN LOCAL L1,L2;
%5.200.31% EXTERNAL XREFERASE; !DEALS WITH HELD IDENTIFIERS; SEE SEARCH
!
! RUND (READ-UNTIL-NEXT-DELIMITER) IS CALLED TO
! FILL "FUTSYM" AND "FUTDEL". THE ROUTINE CALLS
! ITSELF RECURSIVELY IN THE EVENT THAT THE FIRST
! ATOM SCANNED IS NOT A DELIMITER.
!
% THE PARAMETER 'CODE' CAUSES THE FOLLOWING:
=0 THEN FIND A DELIMITER FOR FUTDEL,
=1 THEN MOVE WINDOW AND FIND A DELIMITER FOR FUTDEL AND
POSSIBLY ALSO A SYMBOL FOR FUTSYM,
=2 THEN LIKE 1 EXCEPT DON'T MOVE WINDOW.
%
IF .COED THEN
BEGIN
IF .STRHED NEQ 0 THEN ERROR (.NSYM,ERSMLONG);
STRHED_.FSTRHED; FSTRHED_0;
DEL_.FUTDEL; SYM_.FUTSYM; FUTSYM_0; NSYM_.NFUTSYM; NDEL_.NFUTDEL;
NFUTSYM_.NCBUFF; REALS_.REALFS; REALFS_0;
END;
NFUTDEL_.NCBUFF;
!V2G- BECAUSE OF THE ROUGH HANDLING OF ACCUM ELSEWHERE IN
!V2G- THE COMPILER, IT SEEMS ADVANTAGEOUS TO SAVE ITS CONTENTS
!V2G- HERE SO THAT WE CAN RECOVER THEM SAFELY IN THE CASE OF
!V2G- LEXICAL SCAN AFTER AN IMPLICIT MAP. THIS FIXES A BUG
!V2G- CAUSED BY THE CLOBBERING OF ACCUM DURING PLIT BUILDING.
!V2G- THE CODE (IN TEST T026)
!V2G- BIND A=PLIT(0,1,2),
!V2G- VECTOR B=1;
!V2G- RESULTED IN GENERATION OF A SPURIOUS ALREADY DEFINED
!V2G- SYMBOL ERROR.
IF .HOLD EQL 0 THEN (HOLD_SKAN(#12); SACCUM_.ACCUM; SACCUM[1]_.ACCUM[1]) !V2G-
%5.200.31% ELSE (ACCUM_.SACCUM; ACCUM[1]_.SACCUM[1];XREFERASE_1); !V2G-
CASE .HOLD OF
SET
0; ! ERROR, SKAN SHOULD NOT RETURN THIS VALUE
IDFIXER(.COED,-1); !CASE ONE, IDINTIFIER FOUND BY SKAN
BEGIN ! CASE TWO, LITERAL FOUND BY SKAN
IF .COED GEQ 1
THEN
BEGIN ! FIRST CALL, LITERALS ARE ACCEPTIBLE
FUTSYM_LITLEXEME(.VAL);
HOLD_0; WRUND(0);
END
ELSE
BEGIN ! 2ND CALL, LITERALS ARE IN ERROR
FUTDEL_ERRLEX;
END;
END;
BEGIN ! CASE 3, PREFIXED (ASCII,ASCIZ,SIXBIT,RADIX50) STRING
REALFS_0; FUTSYM_LITLEXEME(.VAL);
HOLD_0; WRUND(.COED);
END;
BEGIN ! CASE FOUR, SPECIAL CHARACTER
HOLD_0;
IF (FUTDEL_.DT[.VAL]) EQL 0 THEN (ERROR(.NSYM,#776); WRUND(.COED))
END;
TES;
%NOW IS OKAY TO FORGET ANY INUSEBITS ON MACROS THAT
HAVE TERMINATED SINCE WE ENTERED WRUND.%
IF .REDO GEQ 0 THEN RETURN;
UNTIL (COED_.FORGET<LEFTF>) EQL 0 DO
((.COED)<INUSEBIT>_0;
FORGET<LEFTF>_.(.COED)<LEFTF>;
(.COED)<LEFTF>_0
);
END;
%SMLA-B%
%3.1% GLOBAL ROUTINE WRUND2 =
BEGIN
! EXTERNAL CSTIL; ! LAST LEXEME STREAM POINTER
! EXTERNAL CSTI; ! CURRENT LEXEME STREAM (INPUT) POINTER
! EXTERNAL INDECS; ! WE ARE PROCESSING DECLARATIONS--USE DOTTED FORMAL
LOCAL SIMPLE, ! NO STRUCTURE FORMAL IN FUTSYM
USERDOT, ! USER HAS DOTTED THE SYMBOL IN FUTSYM
CANADDRESS, ! ABLE TO ADDRESS THE FORMAL AT THE CURRENT BLOCKLEVEL
ISSTRNAME, ! THE FORMAL IS THE STRUCTURE NAME (AND HENCE NOT
! AVAILABLE AS AN INCARNATION ACTUAL EVEN UNDOTTED)
PREVEMPTY, ! PREVIOUS SYMBOL (SYM) WAS EMPTY
OPENBFOLLOWS, ! OPEN BRACKET FOLLOWS THIS SYMBOL
MUSTDOT; ! WE MUST TURN DOTTED BIT OF LEXEME BEFORE COPY AND
! POSSIBLE IN GENERATION.
LOCAL NEWFUTSYM, ! FUTURE SYMBOL FOR COPY
OFFST, ! PARAMETER OFFSET FOR LEXEME
ROFFSET, ! PARAMETER OFFSET FOR ACTUALS TABLE
NEWIV, ! VALUE OF WORD 0 OF LXT ENTRY
DFORMAL, ! DOTTEF FORMAL STE INDEX
IFORMAL, ! INCARNATION FORMAL STE INDEX
TYPECODE; ! CODE FOR FORMALS IN LEXEME TABLE
%5.200.21% LABEL DOSTRFPT;
%5.200.21% EXTERNAL TSBLEVEL;
% ASSUME SIMPLE %
SIMPLE _ 1;
% SET BOOLEANS IF WE HAVE A SYMBOL AND THAT SYMBOL IS A STRUCTURE FORMAL %
IF .FUTSYM<LSF> THEN
(IF .ST[DFORMAL_.FUTSYM<STEF>,0]<TYPEF> EQL STRFPT THEN
%5.200.21% DOSTRFPT: (USERDOT_.DEL<LEFTHALF> EQL HDOT;
CANADDRESS_CHKULA(.DFORMAL);
ISSTRNAME_.ST[IFORMAL_.ST[.DFORMAL,0]<LINKF>,0]<TYPEF>
EQL STRT; %DIRTY CODE--DEPENDS ON ST STRUCTURE!!!%
%5.200.21% IF (.ISSTRNAME AND NOT .USERDOT) OR (.TSBLEVEL NEQ .ST[.DFORMAL,0]<BLF>)
%5.200.21% THEN ( FUTSYM_ZERO;
%5.200.21% REALFS_0;
%5.200.21% SIMPLE_1;
%5.200.21% ERROR(.NFUTSYM,IF .TSBLEVEL NEQ .ST[.DFORMAL,0]<BLF> THEN #431 ELSE #430);
%5.200.21% LEAVE DOSTRFPT);
PREVEMPTY_.LXT[.CSTI,2] EQL 0; %FIX THIS%
OPENBFOLLOWS_.FUTDEL<LEFTHALF> EQL HSQOPEN;
SIMPLE_0;
% DETERMINE WHETHER CURRENT LEXEME IN FUTSYM NEEDS MODIFICATION,
EVEN IF WE ARE NOT COPYING THE LEXEME STREAM ANY MORE; WE MODIFY
IT BY TURNING ON THE DOT BIT OF THE INCARNATION FORMAL. %
IF MUSTDOT_ 1 - (.USERDOT OR
.ISSTRNAME OR
.OPENBFOLLOWS OR
.INDECS)
THEN (FUTSYM<DOTF>_1; FUTSYM<LSF>_1;
FUTSYM<STEF>_.IFORMAL);)
% EXIT FROM DOSTRFPT % );
% IF NOT COPYING LEXEMES FOR THE STRUCTURE, LEAVE. %
IF NOT .STRDEF THEN RETURN;
NEWIV_-1; %WORD 0 OF LXT ENTRY IS NORMALLY -1 %
% DETERMINE WHERE TO COPY THE LEXEMES AND THE VALUE OF NEWFUTSYM %
IF .SIMPLE
THEN (CSTIL_.CSTI;
LXT[.CSTIL,1]<NEXTF>_CSTI_GETSPACE(2);
NEWFUTSYM_IF.REALFS NEQ 0 THEN .REALFS+LSM ELSE .FUTSYM) ELSE
BEGIN
% DETERMINE THE 2 BIT CODE INDICATING THE TYPE OF LEXEME FOR
THE GENERATION:
00--NO MODIFICATION
01--TURN ON DOT BIT WHEN GENERATING (UNADDRESSABLE FORMALS)
10--USE ACTUAL AS PARAMETER
11--USE INCARNATION ACTUAL AS PARAMETER %
NEWFUTSYM_0;
NEWFUTSYM<0,34>_
CASE
(NEWFUTSYM<34,2>_TYPECODE_
(IF .CANADDRESS
THEN (IF (.USERDOT OR .ISSTRNAME)
THEN 2 ELSE 3)
ELSE .MUSTDOT))
OF
SET
(.DFORMAL+LSM); !NORMAL FORMAL
(.IFORMAL+LSM); ! DOTTED INCARNATION FORMAL
(OFFST_(-(#777777000000 OR .ST[.DFORMAL,1]<ADDRESSF>)); ! NEG STACK OFFSET FOR NORMAL FORMAL
IF .STRDEF<TACCESS> THEN
IF (ROFFSET_.ST[.STRDEF<LEFTHALF>,.STRDEF<NPF>+2-.OFFST]) EQL 0
THEN NEWIV_0
ELSE LXT[.ROFFSET,0]_.LXT[.ROFFSET,0]+1;
.OFFST);
-(#777777000000 OR .ST[.IFORMAL,1]<ADDRESSF>) ! NEG OF STACK OFFSET FOR INC FORMAL
TES;
% DETERMINE WHETHER OR NOT TO GENERATE A NEW LEXEME TABLE ENTRY %
IF NOT .PREVEMPTY AND .USERDOT THEN TYPECODE_0;
IF .TYPECODE NEQ 2
THEN (CSTIL_.CSTI;
CSTI_LXT[.CSTI,1]<NEXTF>_GETSPACE(2));
END;
IF (LXT[.CSTI,0]_.NEWIV) GEQ 0 THEN
ST[.STRDEF<LEFTHALF>,.STRDEF<NPF>+2-.OFFST]_.CSTI;
LXT[.CSTI,1]_0;
LXT[.CSTI,2]_.NEWFUTSYM;
LXT[.CSTI,3]_.FUTDEL;
END;
ROUTINE WRUND3 =
BEGIN
%%
% CODE FOR LEXEME EXPANSION. INSTEAD OF COPYING FROM THE INPUT STREAM, WE
GRAB THE LEXEMES FROM THE CURRENT LEXEME STREAM, INDEXED BY CURSTE. THE ONLY
"ODD" OCCURRENCE WOULD BE INDICATED BY THE NEW FUTSYM<34,2> BEING NONZERO:
IN PARTICULAR THE CODE BELOW HAVE THE INDICATED MEANING:
1--MUST TURN ON THE "DOTTED" BIT BEFORE PASSING IT ON;
2--THIS IS A STRUCTURE NORMAL FORMAL PARAMETER--SUBSTITUTE NORMAL ACTUAL LEXEME;
3--THIS IS AN INCARNATION FORMAL PARAMETER--SUBSTITUTE INCARNATION ACTUAL VALUE.
%
%%
SYM_.FUTSYM; DEL_.FUTDEL;
NSYM_.NFUTSYM; NDEL_.NFUTDEL;
REALS_.REALFS; REALFS_0;
IF .CURSTE EQL 0
THEN %END OF LEXEME STREAM--RESTORE EXPANSION VARIABLES%
BEGIN
REGISTER L;;
L_.SSTREX;
SSTREX_.ST[.L,0];
STREXP_.ST[.L,1];
CURSTE_.ST[.L,2];
CURSTAP_.ST[.L,3];
CURSTIP_.ST[.L,4];
CURSTNP_.ST[.L,5];
IF .ST[.L,8]<LSF>
THEN (REALFS_.ST[.L,8]<STEF>; IDFIXFS())
ELSE (REALFS_0; FUTSYM_.ST[.L,8]);
FUTDEL_.ST[.L,9];
NFUTSYM_.ST[.L,10];
NFUTDEL_.ST[.L,11];
RELEASESPACE(.L,6);
% WE JUST DID THE RUND ! %
END
ELSE
BEGIN
LOCAL SFUTSYM;
MAP STVEC CURSTAP;
% DECREASE OCCF. AND USE ON GT ENTRIES WHOSE USE IS UP
BECAUSE THEY ARE DOTTED STRUCTURE FORMALS, BUT FOR
WHICH NO CODE IS BEING GENERATED BECAUSE OF A CONSTANT
IF OR CASE EXPRESSION. IT IS IMPORTANT THAT CODETOG
BE ACCURATE FOR THE SYMBOL IN "FUTSYM" (MOVING INTO SYM)!!!!!%
IF (.MUSTDU NEQ 0) AND NOT .CODETOG
THEN CURSTAP[.MUSTDU]_FOCGPH(.CURSTAP[.MUSTDU],-1);
MUSTDU_0;
% GENERATE A LEXEME PAIR INTO FUTSYM AND FUTDEL %
REALFS_0;
FUTSYM_.LXT[.CURSTE,2];
FUTDEL_.LXT[.CURSTE,3];
CASE .FUTSYM<34,2> OF
SET
IF .FUTSYM<LSF> THEN (REALFS_.FUTSYM<STEF>; IDFIXFS());
FUTSYM_.FUTSYM<0,34>+DOTM;
%%
% FOR NEXT TWO, NOTE E.G.: STRUCTURE A[X,Y,Z,0]=...
ACTUALS: OFFSET REPRESENTS FUTSYM<ADDRESSF>=-STACK OFFSET
0 .A 5
1 .X 4
2 .Y 3
3 .Z 2
INCARNATION ACTUALS:
0 ---- ---
1 X 8
2 Y 7
3 Z 6
%
%%
(FUTSYM_.ST[.CURSTAP,.CURSTNP+2-(SFUTSYM_.FUTSYM<ADDRESSF>)];
IF NOT .STREXP<1,1> THEN
(MUSTDU_.CURSTNP+2-.SFUTSYM;
IF .LXT[.CURSTE,0] NEQ -1
THEN FUTSYM_CURSTAP[.MUSTDU]_
FOCGPH(.FUTSYM,.LXT[.CURSTE,0])););
FUTSYM_.ST[.CURSTIP,(.CURSTNP^1)+3-.FUTSYM<ADDRESSF>];
TES;
CURSTE_.LXT[.CURSTE,1]<NEXTF>;
END;
END; % END OF IF STATEMENT THAT IS WRUND3 %
GLOBAL ROUTINE WRUND(COED)=
BEGIN
LOCAL RETVAL,OCOED;
OCOED=.COED;
DO
BEGIN
REDO=-1;
RETVAL=(IF NOT .STREXP
THEN % NOT EXPANDING A STRUCTURE--BUT WE MAY BE DECLARING ONE %
BEGIN
WRUND1(.COED); %O L D W R U N D C A L L %
IF .REDO LSS 0 THEN
IF .OCOED AND .STRDEF NEQ 0 THEN WRUND2();
END
ELSE
WRUND3());
COED=.REDO;
END
WHILE .REDO GEQ 0;
.RETVAL
END;
%3.1% GLOBAL ROUTINE HRUND =
BEGIN
!
! THIS ROUTINE IS THE SYNTAX ANALYSERS INTERFACE TO THE
! LEXICAL ANALYZER .. IN PARTICULAR, 'HRUND' CALLS 'WRUND'
! AND THEN MAKES UNIQUE LEXEMES FOR SOME OF THE AMBIGUOUS
! ONES. FOR EXAMPLE, 'DO' MAY BE USED IN THE CONTEXT
! ' WHILE E DO E '
! OR
! ' DO E WHILE E '
!SIMILARLY AN OPEN-PAREN, '(', CAN BE USED AS A COMPOUND-
! EXPRESSION OPENER -- OR AS A FUNCTION CALLER. 'HRUND'
! SORTS ALL THIS TYPE OF STUFF OUT FROM MINIMAL CONTEXT.
!
WRUND(1);
IF .FUTDEL<LEFTHALF> EQL HSESEMCOL
THEN (SESTOG_.SESTOG OR 8; FUTDEL<LEFTHALF>_HSEMCOL; RETURN);
IF .FUTSYM EQL HEMPTY AND
.DEL<LEFTHALF> NEQ HEND AND
.DEL<LEFTHALF> NEQ HPTCLO AND
.DEL<LEFTHALF> NEQ HROCLO AND
.DEL<LEFTHALF> NEQ HTES AND
.DEL<LEFTHALF> NEQ HTESN
THEN BEGIN
IF .FUTDEL<LEFTHALF> EQL HPAROPEN
THEN (FUTDEL_NSCOMPOUND<0,0>; FUTDEL<LEFTHALF>_HROPEN)
ELSE IF .FUTDEL<LEFTHALF> EQL HMIN
AND .DEL<LEFTHALF> NEQ HSQCLO
THEN (FUTDEL_NGNEG<0,0>;FUTDEL<LEFTHALF>_HNEG)
ELSE IF .FUTDEL<LEFTHALF> EQL HPLUS
AND .DEL<LEFTHALF> NEQ HSQCLO
THEN BEGIN LOCAL A,B;A_.SYM;B_.DEL;
WRUND(1);SYM_.A;DEL_.B
END
END
%V2H% ELSE IF .FUTDEL<LEFTHALF> EQL HCOLON
%V2H% THEN
%V2H% BEGIN
%V2H% IF .FUTSYM<LSF> THEN
%V2H% IF .ST[.FUTSYM<STEF>,0]<TYPEF> EQL LABELT !WE HAVE A LABEL.
%V2H% THEN FUTDEL_HLABCOLON^18+SLABEL<0,0>; !SO USE LABEL TYPE LEXEME.
%V2H% END
%V2H% ELSE
%V2H% IF .FUTDEL<LEFTHALF> EQL HWHILE OR
.FUTDEL<LEFTHALF> EQL HUNTIL OR
.FUTDEL<LEFTHALF> EQL HDOOPEN
THEN (FUTDEL<HPRIORITY>_32; FUTDEL<24,1>_0)
END;
%MERGE% GLOBAL ROUTINE SRUND(FUNC)=
BEGIN LOCAL SVAL;
SYM_ .FUTSYM; DEL_ .FUTDEL; VAL_ ACCUMLENGTH_ HOLD_ 0;
PACCUM_ ACCUM<36,7>; ACCUM_ ACCUM[1]_ -2;
SKAN(.FUNC); SACCUM_ .ACCUM; SACCUM[1]_ .ACCUM[1]; SVAL_ .VAL;
IF .ACCUMLENGTH EQL 0 THEN
RETURN (FUTDEL_ .DT[.VAL]; FUTSYM_ 0; 1); ! SPECIAL CHARACTER
HOLD_ SKAN(#12); ! GRAB DELIMETER
WRUND1(0); VAL_ .SVAL; ! AND FIX FUTDEL
1
END;
!END OF LOLEXA.BLI