!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 GTR 0) AND (.?.JBSYM 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]_CT[GETSPACE(LTSIZE^(-1)),0]; %2.9% RBASE_.LTBASE[.TNUM]; %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] 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_.VALUE; END ELSE BEGIN L1_LITLEX2; L1_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_.BLOCKLEVEL; LEX_.FUNCTIONLEVEL; LEX_.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] 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]_.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]; 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 ! 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 ! ! THE VALUE RETURNED BY THE ROUTINE IS: ! ! 0: NO SCANNING PERFORMED ! 1: FOUND (IT IS IN ACCUM) ! 2: 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) EQL 0 DO BEGIN (.TEMPFORGET)_0; FORGET_.(.TEMPFORGET); (.TEMPFORGET)_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_.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 EQL HREQUIRE THEN TYPE_1 ELSE BEGIN WHILE ( TYPE_.SYM[0]) EQL ABSOLUTET OR (.TYPE EQL GABSOLUTET) DO IF .SYM[1] THEN SYM_.SYM[1] ELSE (FUTSYM_0; FUTSYM_.SYM[1]; RETURN 1) END; WHEN(LEXEMT, FUTSYM_.ST[.SYM[1],0]) ELSE % 12-21-77 TREAT REGISTER TYPE AS LOCALS. WHEN(REGT, IF (NOT .INDECS OR .REGASSN ) THEN IF .TGRBLEVEL GEQ .SYM[0] AND .FCNSTATE EQL 3 THEN (ERROR(.NFUTSYM,#40); FUTSYM_0; REALFS_0) ELSE (FUTSYM_.SYM[1]; FUTSYM_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] THEN (FUTSYM_1; FUTSYM_36); FUTSYM_.SYM; IF .TYPE EQL BINDT THEN FUTSYM_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]; 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 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 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) EQL 0 DO ((.COED)_0; FORGET_.(.COED); (.COED)_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 THEN (IF .ST[DFORMAL_.FUTSYM,0] EQL STRFPT THEN %5.200.21% DOSTRFPT: (USERDOT_.DEL EQL HDOT; CANADDRESS_CHKULA(.DFORMAL); ISSTRNAME_.ST[IFORMAL_.ST[.DFORMAL,0],0] EQL STRT; %DIRTY CODE--DEPENDS ON ST STRUCTURE!!!% %5.200.21% IF (.ISSTRNAME AND NOT .USERDOT) OR (.TSBLEVEL NEQ .ST[.DFORMAL,0]) %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] THEN #431 ELSE #430); %5.200.21% LEAVE DOSTRFPT); PREVEMPTY_.LXT[.CSTI,2] EQL 0; %FIX THIS% OPENBFOLLOWS_.FUTDEL 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_1; FUTSYM_1; FUTSYM_.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]_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])); ! NEG STACK OFFSET FOR NORMAL FORMAL IF .STRDEF THEN IF (ROFFSET_.ST[.STRDEF,.STRDEF+2-.OFFST]) EQL 0 THEN NEWIV_0 ELSE LXT[.ROFFSET,0]_.LXT[.ROFFSET,0]+1; .OFFST); -(#777777000000 OR .ST[.IFORMAL,1]) ! 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]_GETSPACE(2)); END; IF (LXT[.CSTI,0]_.NEWIV) GEQ 0 THEN ST[.STRDEF,.STRDEF+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] THEN (REALFS_.ST[.L,8]; 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 THEN (REALFS_.FUTSYM; IDFIXFS()); FUTSYM_.FUTSYM<0,34>+DOTM; %% % FOR NEXT TWO, NOTE E.G.: STRUCTURE A[X,Y,Z,0]=... ACTUALS: OFFSET REPRESENTS FUTSYM=-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)]; 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]; TES; CURSTE_.LXT[.CURSTE,1]; 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 EQL HSESEMCOL THEN (SESTOG_.SESTOG OR 8; FUTDEL_HSEMCOL; RETURN); IF .FUTSYM EQL HEMPTY AND .DEL NEQ HEND AND .DEL NEQ HPTCLO AND .DEL NEQ HROCLO AND .DEL NEQ HTES AND .DEL NEQ HTESN THEN BEGIN IF .FUTDEL EQL HPAROPEN THEN (FUTDEL_NSCOMPOUND<0,0>; FUTDEL_HROPEN) ELSE IF .FUTDEL EQL HMIN AND .DEL NEQ HSQCLO THEN (FUTDEL_NGNEG<0,0>;FUTDEL_HNEG) ELSE IF .FUTDEL EQL HPLUS AND .DEL NEQ HSQCLO THEN BEGIN LOCAL A,B;A_.SYM;B_.DEL; WRUND(1);SYM_.A;DEL_.B END END %V2H% ELSE IF .FUTDEL EQL HCOLON %V2H% THEN %V2H% BEGIN %V2H% IF .FUTSYM THEN %V2H% IF .ST[.FUTSYM,0] 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 EQL HWHILE OR .FUTDEL EQL HUNTIL OR .FUTDEL EQL HDOOPEN THEN (FUTDEL_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