! File: LEXAN.BLI ! ! This work was supported by the Advanced Research ! Projects Agency of the Office of the Secretary of ! Defense (F44620-73-C-0074) and is monitored by the ! Air Force Office of Scientific Research. MODULE LEXAN(TIMER=EXTERNAL(SIX12))= BEGIN ! LEXAN MODULE ! ------------ ! ! D. WILE ! C. WEINSTOCK ! ! THIS MODULE IS THE LEXICAL ANALYZER. A PRIMARY FUNCTION IS ! THE HANDLING OF MACRO AND STRUCTURE CREATION AND EXPANSION. ! ! REQUIRE COMMON.BEG; REQUIRE PREDEF.BEG; REQUIRE IOMACS.BEG; REQUIRE GTST.BEG; REQUIRE ST.BEG; REQUIRE GTX.BEG; REQUIRE LDSFT.BEG; REQUIRE LDSF.BEG; REQUIRE STRUCT.BEG; REQUIRE ERROR.BEG; BEGIN MACRO ! COPIED FROM JBEG.BEG BOTF=-2,18,18$, NEXTF=-3,0,18$, PREVF=-3,18,18$, TOPF=-2,0,18$; !----------------------------------------------------- ! THE FOLLOWING ARE MISC. EXTERNALS FOR LEXAN ONLY EXTERNAL ACCUMLENGTH, ! LENGTH OF CURRENT STRING INAPLIT, ! TESTED BY DETBRACKET QUOTETYPE, ! DOUBLE OR SINGLE QUOTE - ALSO USED IN DRIVER MODULE SCHAR, ! SAVED CHAR BETWEEN CALLS ON SKAN STYPE, ! " TYPE " " " " STRING, ! CURRENT STRING, OR CHARACTER PAIR VAL; ! CURRENT LITERAL, SHORT STRING, OR DELIMITER EXTERNAL ! FROM SYNTAX BINDBIND, EXPRESSION, FAKECSE; FORWARD !IN ORDER OF APPEARANCE BLOCKPURGE, FSYMPROTECT, SKAN1, SKAN, DETBRACKET, STRMCONC, STRMPUSH, STRMPOP, STRMZTOP, STRMQUIT, STRMAPPEND, STRMNEXT, STRMTEOF, REMNEXT, REMTEOF, STRMRELEASE, RUND, SCANFOR, FILETAKE, STRMTAKE, HRUND, STRUFTOLEX, UNDCLTOLEX, QNATOLEX, SFCONVERT, SFEXPAND, LSERROR, MACRPICKOFF, SCANTO, ! DETRFI, ! DETREMAIN, MACRSWAP, EMACR, EMACRF, ESTRU, POPORIT, STRUCOPY, APPEND, STRUSC, OUTDEL, OUTSYM, OUTSTR, OUTWRD, OUT11STR, MACRTAPNDP, MACRTE, MACRTFPO, MACRTIV, MACRTLPO, MACRTPB, MACRTPBE, MACRTS, MACRTV, MACRTNULLV, OUTMHD; GLOBAL ROUTINE BLOCKPURGE= !I. GENERAL: ! ! 1. THIS ROUTINE DOES A CLEANUP AT THE END OF ! A BLOCK. ! !II. SPECIFIC: ! ! 1. * ! ! A. DO ALL THE FOLLOWING FOR EACH OF THE HASH ! TABLE ENTRIES. ! ! 1. GET THE THREAD FROM THE HASH TABLE ! ENTRY. ! ! 2. FOR EACH SYMBOL WHOSE LEVEL IS THE ! SAME AS THE CURRENT BLOCK LEVEL: ! ! A. CHANGE THE LINK OF THE NAME ! TABLE ENTRY TO POINT AT WHAT ! THE SYMBOL TABLE ENTRY POINTS ! AT. ! ! B. CHANGE THE HASH TABLE THREAD ! TO THE VALUE OF THE THREAD ! OF THE SYMBOL TABLE ENTRY. ! ! C. NOW ADD THE SYMBOL TABLE ! ENTRY TO A PURGED LIST. THE ! EXTERNAL VARIABLE "PURGED" ! CONTAINS THE LINK OF THE LAST ! ENTRY PURGED. SO WE MAKE THIS ! ENTRY POINT THE LAST ENTRY ! PURGED, AND MAKE "PURGED" ! POINT TO THIS NEWLY PURGED ! ENTRY. THUS, PURGED ENTRIES ! ARE LINKED THROUGH THEIR ! THREAD FIELDS. ! ! B. FINALLY, DECREMENT THE BLOCKLEVEL. BEGIN REGISTER NEXTSTE,STVEC STE; IF .ERRORFOUND GTR 0 THEN FSYMPROTECT(); INCR I FROM 0 TO HTSIZE-1 DO BEGIN STE_.HT[.I,THREADF]; WHILE .STE NEQ 0 DO BEGIN IF .STE[BLF] NEQ .BLOCKLEVEL THEN EXITLOOP; NT[.STE[NAMEPTR],SYMLINK]_.STE[STELINK]; NEXTSTE_HT[.I,THREADF]_.STE[THREAD]; STE[THREAD]_.PURGED; PURGED_.STE; IF ISSTVAR(STE) THEN IF .STE[LSTWORD] NEQ 0 THEN BEGIN RELLST(.STE[VCHGLSTF]); RELLST(.STE[VUSELSTF]); STE[LSTWORD]_0 END; STE_.NEXTSTE END; END; BLOCKLEVEL_.BLOCKLEVEL-1 END; GLOBAL ROUTINE FSYMPROTECT = ! ! PROTECT SYMBOL IN FUTWINDOW FROM THE EFFECTS OF BLOCKPURGE; ! NEEDED BECAUSE OF THE RATHER PECULIAR LOOK-AHEAD NATURE OF ! THE LEXICAL ANALYZER. ! BEGIN LOCAL LEXEME FUTLEX; BIND STVEC FUTSYM=FUTLEX; FUTLEX_SYMPART(.FUTWINDOW); IF .FUTLEX[LTYPF] EQL UNBNDVAR THEN BEGIN FUTSYM_.FUTSYM[SYMLINK]; IF .FUTSYM[BLF] EQL .BLOCKLEVEL THEN FUTSYM[BLF] _ .BLOCKLEVEL-1 END; NOVALUE END; MACRO ALLIGN(TABLE,NBYTE)=IF @TABLE AND NOT NBYTE THEN TABLE_@TABLE+1$, NEXTINTAB(TABLE,STE)=(STE[OFFSETF]_LTINSERT(@TABLE); TABLE_@TABLE+.STE[NCONTIGLOC])$, ! NOTE: BYTES MACRO DEFINITION ALSO APPEARS IN SYNTAX.BLI BYTES(STE)=(LITVALUE(.STE[SIZEF])/8)$; MACRO INRANGE(X,Y)=(.CHAR GEQ X AND .CHAR LEQ Y)$, FERROR(O,P,N)=(ERRPRNT(O,P,N))$; ! CHARACTER SCAN ROUTINES ! ----------------------- GLOBAL ROUTINE SKAN1= ! ! CALLED TO GET THINGS GOING AT THE BEGINNING OF A FILE. ! BEGIN SCHAR_EOL; SKAN(1) END; ROUTINE SKAN(FLAG)= %< THIS ROUTINE DOES THE PRIMARY CHARACTER SCANNING FOR THE COMPILER. THE VALUE RETURNED BY THE ROUTINE IS: 0: NO SCANNING PERFORMED 1: FOUND (THE 10 CHARACTERS ARE IN ACCUM[0:1]) 2: FOUND (VALUE IN VAL) 3: (LONG) STRING FOUND (LENGTH IN ACCUMLENGTH, STRING IN STRING) 4: SPECIAL CHARACTER FOUND 5: (SHORT) STRING FOUND (VALUE IN VAL) >% BEGIN LABEL MAINLOOP; MACRO RESULT = LEAVE MAINLOOP WITH $; REGISTER INDEX; REGISTER CHAR,TYPE; BIND ! TYPE VALUES ALPHNUM = 2, NUMERIC = 1, OCTAL = 0; ! SCANNER ROUTINE SCANNER = ! ! VERY LOW LEVEL INPUT. GETS A CHARACTER FROM INPUT ! BUFFER ("BUFF", POINTER "PBUFF"), PUTTING THE CHARACTER ! IN "CHAR" AND ITS TYPE IN "TYPE". ! BEGIN EXTERNAL READALINE; ! FROM DRIVER BIND VECTOR TYPETAB=PLIT( ! CHARACTER TYPE TABLE 15,15,15,14,15,15,15,9, ! 0-7 15,15,15,15,15,5,15,15, ! 10-17 8:15, ! 20-27 8:15, ! 30-37 15,5,3,4,9,6,15,3, ! 40-47 8:7, ! 50-57 8:0, ! 60-67 1,1,7,7,7,7,7,8, ! 70-77 7, 26:2, ! A-Z 7,7,7,7,7, ! 133-137 3, 26:2, ! A-Z 7,15,7,15,15 ! 173-177 ); IF .CHAR EQL EOL THEN READALINE(); CHAR_SCANI(PBUFF); IF .CHAR EQL HTAB THEN NCBUFF_.NCBUFF OR #7; NCBUFF<0,18>_.NCBUFF<0,18>+1; TYPE _ .TYPETAB[.CHAR]; NOVALUE END; ! OF SCANNER ! PRWORD ROUTINE PRWORD= ! ! SCAN FOR A PAIR OF CHARACTERS FOR A STRING, ! AND RETURN 0 IF THE STRING IS TERMINATED. ! BEGIN ROUTINE CONVERT= ! ! HANDLE QUESTION MARKS DURING STRING SCANNING. ! IF .CHAR NEQ "??" THEN .CHAR ELSE (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 "??" THEN "??" ELSE (WARNEM(.NCBUFF,ERSYIQC); .CHAR)); ROUTINE GETCH= ! ! HANDLE QUOTATION MARKS DURING STRING SCANNING. ! BEGIN MACRO DUMMYBIT=1^35$; IF .CHAR NEQ .QUOTETYPE THEN TRUE ELSE (SCANNER(); IF .CHAR EQL .QUOTETYPE THEN (CHAR_.CHAR OR DUMMYBIT; ! SO TWO CONSECUTIVE CALLS ! WILL RETURN THE SAME VALUE TRUE) ELSE FALSE) END; STRING_0; IF NOT GETCH() THEN RETURN FALSE; STRING_CONVERT(); SCANNER(); IF NOT GETCH() THEN RETURN FALSE; STRING_.STRING OR CONVERT()^8; SCANNER(); GETCH() END; ! OF PRWORD ! MAIN BODY OF SKAN CHAR_.SCHAR; TYPE_.STYPE; IF .FLAG NEQ 0 % IF CALLED BY SKAN1 % THEN SCANNER() ELSE INDEX_ MAINLOOP: WHILE 1 DO ! LOOP TO CATCH BLANKS AND !'S BEGIN MACRO CONTINUE=EXITBLOCK$; WHILE .CHAR LEQ BLANK DO SCANNER(); WHILE 1 DO ! LOOP TO CATCH %'S AND NON-OCTAL DIGITS BEGIN NATOM_.NCBUFF; CASE .TYPE OF SET ! 0 - DIGITS 0-7 BEGIN VAL_0; WHILE .TYPE LEQ NUMERIC DO BEGIN VAL_.VAL*10 + .CHAR-"0"; SCANNER() END; RESULT 2 END; ! 1 - DIGITS 8-9 TYPE_0; ! AND RE-ENTER CASE ! 2 - LETTERS BEGIN PACCUM_(ACCUM-1)<1,7>; ACCUM[0]_ACCUM[1]_-2; WHILE .TYPE LEQ ALPHNUM DO BEGIN IF .TYPE EQL ALPHNUM THEN CHAR_UPPERCASE(.CHAR); REPLACEI(PACCUM,.CHAR); SCANNER() END; RESULT 1 END; ! 3 - SINGLE OR DOUBLE QUOTE BEGIN LOCAL SAVSCT,SAVSCC; LOCAL SPEC,STVEC FSTRHED:CELL; EXTERNAL QUIT; SAVSCT_.SCANTYPE; SCANTYPE_"S"; SAVSCC_.SCANCHANGE; SCANCHANGE_.NCBUFF; QUOTETYPE_.CHAR; FSTRHED_0; SCANNER(); IF (SPEC_PRWORD()) THEN BEGIN ACCUMLENGTH_0; FSTRHED_GETCELL(CHTLONGS,1); DO BEGIN CELL_NEWBOT(.FSTRHED,CHTLEX,1); CELL[LEXEMEF]_LITLEXEME(.STRING) END WHILE (IF .SPEC THEN (SPEC_PRWORD(); 1)) AND (ACCUMLENGTH_.ACCUMLENGTH+1) LSS LONGESTPLIT; IF (FSTRHED[LSLENGTH]_.ACCUMLENGTH) GEQ LONGESTPLIT THEN (FERROR(.NATOM,.NCBUFF,ERSYMRQ); QUIT(0)); STRING_0 END; SCANTYPE_.SAVSCT; SCANCHANGE_.SAVSCC; IF .FSTRHED NEQ 0 THEN (STRING_.FSTRHED; RESULT 3) ELSE (VAL_.STRING; RESULT 5) END; ! 4 - # (OCTAL NUMBER) BEGIN VAL_0; SCANNER(); WHILE .TYPE EQL OCTAL DO BEGIN VAL_.VAL^3 + .CHAR-"0"; SCANNER() END; RESULT 2 END; ! 5 - ! (COMMENT TERMINATED BY EOL) BEGIN CHAR_EOL; CONTINUE END; ! 6 - % (COMMENT TERMINATED BY ANOTHER %) BEGIN LOCAL SAVSCT,SAVSCC; SAVSCT_.SCANTYPE; SCANTYPE_"C"; SAVSCC_.SCANCHANGE; SCANCHANGE_.NCBUFF; DO SCANNER() UNTIL .CHAR EQL "%"; SCANTYPE_.SAVSCT; SCANCHANGE_.SAVSCC; SCANNER() END; ! 7 - DELIMITER CHARACTER BEGIN VAL_.CHAR; SCANNER(); RESULT 4 END; ! 8 - QUESTION MARK (SPECIAL ESCAPE) BEGIN SCANNER(); VAL_.CHAR+#40; SCANNER(); RESULT 4 END; ! 9 - DOLLAR SIGN; MAY BEGIN SPECIAL FUNCTION NAME. BEGIN SCANNER(); IF .TYPE GTR ALPHNUM THEN (VAL_"$"; RESULT 4) ELSE BEGIN PACCUM_(ACCUM-1)<1,7>; ACCUM[0]_ACCUM[1]_-2; REPLACEI(PACCUM,"$"); DO BEGIN IF .TYPE EQL ALPHNUM THEN CHAR_UPPERCASE(.CHAR); REPLACEI(PACCUM,.CHAR) END UNTIL (SCANNER(); .TYPE GTR ALPHNUM); RESULT 1 END END; ! 10-14 - INVALID TYPE CODES 0; 0; 0; 0; 0; ! 15 - IGNORE CHARACTER BEGIN SCANNER(); CONTINUE END TES END ! OF INNER LOOP END; ! OF MAINLOOP SCHAR_.CHAR; STYPE_.TYPE; .INDEX END; MACRO EMPTYLSYMP(BUF)=(MAP STREAMTOP BUF; .ST[.BUF[0,36],STKLEN] EQL 0)$, EMPTYBUFP(ADD)=(MAP FVEC ADD; .ADD[STKLEN] EQL 0)$; BIND ! NOTE: MACRCOMSEL ALSO APPEARS IN SYNTAX.BLI. MACRCOMSEL=#777777, LBRACE=PLIT ("{", "[", "<", "("), RBRACE=PLIT (0, "}", "]", ">", ")"); ROUTINE LBRACEL(X)= ! ! VALUE RETURNED: ! IF X IS A LEFT BRACE (IS IN "LBRACE"), THE ! CORRESPONDING RIGHT BRACE; OTHERWISE 0. ! .RBRACE[1+(DECR I FROM 3 TO 0 DO IF .X EQL .LBRACE[.I] THEN EXITLOOP .I)]; ROUTINE RBRACEL(X)= ! ! VALUE RETURNED: ! TRUE IF X IS A RIGHT BRACE (IS IN "RBRACE"); ! OTHERWISE FALSE. ! (1+(DECR I FROM 4 TO 1 DO IF .X EQL .RBRACE[.I] THEN EXITLOOP 0)); ! UTILITY ROUTINE TO DETERMINE BRACKETS IN ITERATED MACROS ROUTINE DETBRACKET(WANTSYM)= BEGIN BIND MACRPLIT =#126, MACRRPI =")", MACRLPI ="(", MACRSETI =#6, ! SEE "OF1.BLI" FOR VALUES MACRTESI =#23, MACRNSETI =#27, MACRTESNI =#30, MACROF =#17, MACRCOMMAI =",", MACRSEMI =";", MACRCOLONI =":"; BIND MACRCOMMAO=MACRCOMMAI, MACRSEMO =MACRSEMI, MACRCOLONO=MACRCOLONI, MACRPLISTO=MACRLPI^24 +MACRRPI^12 +MACRCOMMAI, MACRCOMPO =MACRLPI^24 +MACRRPI^12 +MACRSEMI, MACRSETO =MACRSETI^24 +MACRTESI^12 +MACRSEMI, MACRNSETO =MACRNSETI^24+MACRTESNI^12+MACRSEMI; MAP FVEC DT; IF (NOT .WANTSYM) AND (.SYM NEQ HEMPTY) THEN IF .SYM[LTYPF] EQL BNDVAR THEN IF .ST[.SYM[ADDRF],TYPEF] EQL STRUCTURET THEN MACRCOLONO ELSE MACRPLISTO ELSE MACRPLISTO ELSE SELECT .OLDDELI OF NSET 0: RETURN MACRPLISTO; MACRPLIT: RETURN MACRPLISTO; MACROF: RETURN MACRSETO; MACRSETI: RETURN MACRSEMO; MACRNSETI: RETURN MACRSEMO; ! PROVIDE YOUR OWN COLONS! MACRCOMSEL: RETURN MACRNSETO; MACRCOMMAI: RETURN .OLDDELI; MACRSEMI: RETURN .OLDDELI; ALWAYS: SELECT .DT[.OLDDELI,HCLASS] OF NSET DCLRTR: RETURN MACRCOMMAO; OP: RETURN .OLDDELI; CLOBRAC: RETURN MACRPLISTO; ALWAYS: IF LBRACEL(.OLDDELI) NEQ 0 THEN RETURN MACRCOMMAO; OPENBRAC: RETURN MACRSEMO TESN; ALWAYS: RETURN MACRCOMPO TESN END; ! STREAM MANAGEMENT ROUTINES ROUTINE STRMCONC(FIRST,SECOND)= BEGIN MAP STVEC FIRST:SECOND; LOCAL STVEC POINT; IF .FIRST EQL 0 THEN RETURN .SECOND; POINT_.FIRST; UNTIL .POINT[STKNEXT] EQL 0 DO POINT_.POINT[STKNEXT]; POINT[STKNEXT]_.SECOND; .FIRST END; ROUTINE STRMPUSH(STKADD)= BEGIN LOCAL STVEC SPACE, LEN; MAP INDFVEC STKADD; LEN_.STKADD[STKLEN]+1; SPACE_GETSPACE(ST,.LEN); MOVECORE(.STKADD,.SPACE,.LEN); STKADD[STKNEXT]_.SPACE % NOTE: LENGTH NOT CHANGED % END; GLOBAL ROUTINE STRMPOP(STKADD)= BEGIN LOCAL STVEC SPACE, LEN; MAP INDFVEC STKADD; SPACE_.STKADD[STKNEXT]; LEN_.SPACE[STKLEN]+1; MOVECORE(.SPACE,.STKADD,.LEN); RELEASESPACE(ST,.SPACE,.LEN) END; ROUTINE STRMZTOP(STKADD)= BEGIN MAP INDFVEC STKADD; CLEARCORE(STKADD[1],.STKADD[STKLEN]); END; GLOBAL ROUTINE STRMQUIT(STKADD)= ! ! DETACH A STREAM FROM ITS BASE ! AND RESET THE BASE TO EMPTINESS; ! REVERSE POINTERS IN THE STREAM ! AND RETURN THE NEW BASE AS VALUE. ! BEGIN MAP INDFVEC STKADD; LOCAL STVEC CURRENT:NEXT:TEMP; CURRENT_0; NEXT_STRMPUSH(.STKADD); DO (TEMP_.NEXT[STKNEXT]; NEXT[STKNEXT]_.CURRENT; CURRENT_.NEXT) WHILE (NEXT_.TEMP) NEQ 0; STKADD[STKNEXT]_STKADD[STKLEN]_0; .CURRENT END; GLOBAL ROUTINE STRMAPPEND(STKADD,MAX)= BEGIN MAP INDFVEC STKADD; STKADD[ IF .STKADD[STKLEN] EQL .MAX THEN (STRMPUSH(.STKADD); STKADD[STKLEN]_1) ELSE STKADD[STKLEN]_.STKADD[STKLEN]+1] END; ROUTINE STRMNEXT= BEGIN STRMPOS_.STRMPOS+1; IF .STRMPOS GTR WSTMAX-1 THEN (STRMPOS_1; STRMTOP_.STRMTOP[STKNEXT]); STRMTOP[.STRMPOS] END; ROUTINE STRMTEOF= IF .STRMPOS EQL .STRMTOP[STKLEN] THEN (.STRMTOP[STKNEXT] EQL 0); ROUTINE REMNEXT= BEGIN REMPOS_.REMPOS+1; IF .REMPOS GTR APLMAX-1 THEN (REMPOS_1; REMTOP_.REMTOP[STKNEXT]); REMTOP[.REMPOS] END; ROUTINE REMTEOF= IF .REMPOS EQL .REMTOP[STKLEN] THEN (.REMTOP[STKNEXT] EQL 0); GLOBAL ROUTINE STRMRELEASE(CURRENT)= BEGIN LOCAL STVEC NEXT; MAP STVEC CURRENT; IF .CURRENT EQL 0 THEN RETURN; DO (NEXT_.CURRENT[STKNEXT]; RELEASESPACE(ST,.CURRENT,.CURRENT[STKLEN]+1)) WHILE (CURRENT_.NEXT) NEQ 0 END; ! MAIN LEXICAL ANALYZER ! --------------------- BIND STVEC STSYM=SYM[ADDRF]; MACRO NOTETRACE= ! ! CALLED WHEN THE TRACE BIT IS ABOUT TO BE SAVED AND RESET ! (CALLED FROM MACRSWAP,DETREMAIN,SFSTRING,SFNAME) ! ! MAKES SURE THE TRACE OUTPUT STREAM IS IN GOOD SHAPE FOR ! THIS CHANGE. ! IF .TRACEBIT THEN IF ITERATED THEN MACRTAPNDP(ITMS,FALSE) ELSE MACRTAPNDP(TMS,FALSE) $; MACRO TRYSTREAMPOP(DUMMY)= WHILE .STRMEOF DO IF POPORIT() THEN EXITLOOP $; MACRO MACRTRUND(S,D)= STRMAPPEND(MTBUF,MTMAX-1)_FORMWINDOW(S,D) $; GLOBAL ROUTINE RUND(QUOTELEVEL)= BEGIN BIND SYMBOL=TRUE, DELIMITER=FALSE; IF .PEEKBIT THEN RETURN (PEEKBIT_FALSE; NOVALUE); QUOTESYM_QUOTEDEL_FALSE; OLDDEL_.DEL; SCANFOR(SYMBOL,.QUOTELEVEL); IF .TRACEBIT THEN MACRTRUND(.SYM,0); IF .EXPANDERR THEN (EXPANDERR_0; OLDDELI_.DEL; DEL_.DT[.DEL]; HRUND(); RETURN NOVALUE); SCANFOR(DELIMITER,.QUOTELEVEL); IF .TRACEBIT THEN IF .MTBUF[STKLEN] EQL 0 THEN MACRTRUND(HEMPTY,.DEL) ELSE MTBUF[.MTBUF[STKLEN],DELIND]_.DEL; IF .MACRCP THEN RETURN NOVALUE; IF .STRUCP THEN STRUCOPY(); RESWD_.DEL[DLRESWD]; DEL[DLRESWD]_0; OLDDELI_.DEL; DEL_.DT[.DEL]; HRUND(); NOVALUE END; GLOBAL ROUTINE SCANFOR(SYMORDEL, QUOTELEVEL)= BEGIN LOCAL TATCL,STVEC TSYM; MACRO SYMASIS=(.QUOTELEVEL GEQ .ATOMCLASS)$, CINQ(CL)=EXITSELECT (IF .QUOTELEVEL LSS CL THEN CL ELSE (-1))$, SETIFMACRO=IF (SELECT .ATOMCLASS OF NSET UNBNDVAR: (TSYM_.NT[.FUTWINDOW[ADDRF],SYMLINK]; EXITSELECT 0); BNDVAR: (TSYM_.FUTWINDOW[ADDRF]; EXITSELECT 0) TESN) EQL 0 THEN IF (TATCL_ (SELECT .TSYM[TYPEF] OF NSET MACROT: CINQ(CLMACR); SFCONVT: CINQ(CLSFCONV); SFEXPNDT: CINQ(CLSFEXPND) TESN) ) GTR 0 THEN (FUTWINDOW[ADDRF]_.TSYM; ATOMCLASS_.TATCL)$, FILLSYM=(IF .QUOTED THEN (QUOTED_FALSE; QUOTESYM_TRUE); SYM_SYMPART(.FUTWINDOW); TAKE)$, FILLDEL=(IF .QUOTED THEN (QUOTED_FALSE; QUOTEDEL_TRUE); DEL_.FUTWINDOW[DELIND]; TAKE)$, TAKE=IF .STREAMIN THEN STRMTAKE() ELSE FILETAKE()$, RETSORD(S,D)=RETURN IF .SYMORDEL THEN S ELSE D$, CONVERSION=((TATCL_.ATOMCLASS) LEQ QLSFCONV)$, CONVERT=SELECT .TATCL OF NSET CLSTRUF: EXITSELECT STRUFTOLEX(); CLLSLEX: EXITSELECT LSERROR(); CLSSLEX: EXITSELECT SYM[LTYPF]_LITTYP; CLSFCONV: EXITSELECT SFCONVERT(.QUOTELEVEL); OTHERWISE: QNATOLEX() TESN$, EXPAND=(LOCAL LEXEME SYM; FILLSYM; SELECT .SYM[LTYPF] OF NSET CLMACR: EXITSELECT EMACR(.SYM,.SYMORDEL); CLMACRF: EXITSELECT EMACRF(.SYM); CLSFEXPND: EXITSELECT SFEXPAND(.SYM); TESN)$; WHILE 1 DO BEGIN TRYSTREAMPOP(); IF NOT .ATOMISSYM THEN RETSORD(SYM_HEMPTY,(FILLDEL)); IF NOT .QUOTED THEN SETIFMACRO; IF SYMASIS THEN RETSORD((FILLSYM),DEL_0); IF .ATOMCLASS EQL CLSFEXPND THEN IF .ST[.FUTWINDOW[ADDRF],WHICHF] EQL 3 THEN RETSORD((FILLSYM; SFCONVERT(.QUOTELEVEL)),DEL_0); ! SPECIAL FUNCTION UNQUOTE GLITCH IF CONVERSION THEN RETSORD((FILLSYM; CONVERT),DEL_0); EXPAND END END; ! B. TAKES ROUTINE FILETAKE= BEGIN IF .ATOMISSYM THEN NSYM_.NATOM ELSE NDEL_.NATOM; CASE SKAN(0) OF SET 0; % IDENTIFIER OR RESERVED WORD % BEGIN REGISTER STVEC LEX, NTVEC NAME; NAME_SEARCH(UNDECTYPE); LEX_.NAME[SYMLINK]; IF .LEX[TYPEF] EQL DELMT THEN (ATOMISSYM_FALSE; FUTWINDOW[DELIND]_.LEX[WHICHF]; FUTRESWD_TRUE; RETURN NOVALUE) ELSE (ATOMISSYM_TRUE; FUTWINDOW_FASTLEXOUT(UNBNDVAR,.NAME); RETURN NOVALUE) END; % LITERALS % BEGIN FUTWINDOW_LITLEXEME(.VAL); ATOMISSYM_TRUE END; % LONG STRING % BEGIN FUTWINDOW_LEXOUT(LSLEXTYP,.STRING); ATOMISSYM_TRUE END; % OPERATOR OR BRACKET CHARACTER % BEGIN ATOMISSYM_FALSE; FUTWINDOW[DELIND]_.VAL END; % SHORT STRING % BEGIN FUTWINDOW_LEXOUT(SSLEXTYP,.VAL); ATOMISSYM_TRUE END TES; NOVALUE END; ROUTINE STRMTAKE= BEGIN IF .ATOMISSYM THEN IF .FUTWINDOW[DELIND] NEQ 0 THEN (ATOMISSYM_FALSE; RETURN NOVALUE); IF STRMEOF_STRMTEOF() THEN ( RETURN NOVALUE); FUTWINDOW_@(STRMNEXT()); IF .ATOMCLASS EQL CLWANTSYM THEN (FUTWINDOW[ADDRF]_.NT[.FUTWINDOW,SYMLINK]; ATOMCLASS_BNDVAR); ATOMISSYM_.ATOMCLASS NEQ 0; NOVALUE END; ! C. CONVERSIONS ROUTINE HRUND= BEGIN BIND STVEC STSYM=SYM; EXTERNAL SAVTOP; MACRO SEPRECEDES(DUMMY)=(.OLDDEL LEQ HSQBCLOSE)$; ! TRUE IF .OLDDEL IS ")","]",">",OR "END" ! DUMMY ARGUMENT IS SO IT'LL LOOK LIKE "SEFOLLOWS" IN SYNTAX IF .SYM NEQ HEMPTY THEN BEGIN IF .SYM[LTYPF] EQL BNDVAR THEN IF .STSYM[BLF] LSS .RBLOCKLEVEL THEN IF ISEXP(SYM) THEN IF .STSYM[NOUPLEVEL] THEN (WARNEM(.NSYM,ERUPLVL); SYM_ZERO) END ELSE IF NOT SEPRECEDES() THEN BEGIN SELECT .DEL OF NSET HPARAOPEN: EXITSELECT (DEL_HCOMPOPEN; OLDDELI_IF .INAPLIT THEN "," ELSE ";"); HMINUS: EXITSELECT DEL_HNEG; HADD: EXITSELECT DEL_HPLUS TESN; RETURN NOVALUE END; SELECT .DEL OF NSET HWHILE: EXITSELECT DEL_HWHILECLOS; HUNTIL: EXITSELECT DEL_HUNTILCLOS; HDO: EXITSELECT DEL_HDOCLOSE TESN; NOVALUE END; ROUTINE STRUFTOLEX= ! ! CHANGE THE STRUCTURE FORMAL IN SYM ! TO A "REAL" LEXEME. ! BEGIN LOCAL GTVEC PAR; SYM_.ST[.STRUACT,.SYM[ADDRF],LEXW]; IF .SYM[LTYPF] EQL GTTYP THEN SYM_FAKECSE(.SYM); UNDCLTOLEX() END; ROUTINE UNDCLTOLEX= ! ! CHANGE THE UNDECLARED SYMBOL IN SYM ! TO A "DECLARED" EXTERNAL SYMBOL, ! AND COMPLAIN TO THE PROGRAMMER. ! IF .SYM[LTYPF] EQL BNDVAR THEN IF .STSYM[TYPEF] EQL UNDECTYPE THEN BEGIN BIND STVEC SYMST=SYM; SYM_STINSERT(.SYMST[NAMEPTR],EXTERNALT,0); SYM[LTYPF]_BNDVAR; DEFEXT(.SYM); SYMST[UNLIMACTS]_TRUE; IF NOT .ERRLEVEL THEN WARNEM(.NSYM,IDERR) END; GLOBAL ROUTINE QNATOLEX= ! ! CHANGE THE QUOTED NAME IN SYM ! TO A "REAL" LEXEME. ! (IF .SYM[LTYPF] EQL UNBNDVAR THEN (SYM[LTYPF]_BNDVAR; SYM[ADDRF]_.NT[.SYM[ADDRF],SYMLINK]); UNDCLTOLEX()); ROUTINE SFCONVERT(QUOTELEVEL)= BEGIN MACRO ODDCHAR(X)=((X)^(-8))$, EVENCHAR(X)=((X) AND #377)$; BIND SYMBOL=1,DELIMITER=0; MAP LEXEME SYM; REGISTER QL; ROUTINE SFASCII(LEX)=.LEX; ROUTINE SFASCIZ(LEX)= BEGIN MAP LEXEME LEX; LOCAL STVEC SHEAD:CELL; IF .LEX[LTYPF] EQL LITTYP THEN IF ODDCHAR(LITVALUE(.LEX)) EQL 0 THEN RETURN .LEX ELSE (SHEAD_GETCELL(CHTLONGS,1); SHEAD[LSLENGTH]_1; CELL_NEWBOT(.SHEAD,CHTLEX,1); CELL[LEXEMEF]_.LEX) ELSE (SHEAD_.LEX[ADDRF]; IF .ST[.SHEAD[BOTF],LBYTE] EQL 0 THEN RETURN .LEX); CELL_NEWBOT(.SHEAD,CHTLEX,1); CELL[LEXEMEF]_LITLEXEME(0); SHEAD[LSLENGTH]_.SHEAD[LSLENGTH]+1; RETURN LEXOUT(LSLEXTYP,.SHEAD) END; ROUTINE SFRADIX50(LEX)= BEGIN MAP LEXEME LEX; LOCAL STVEC SHEAD:NHEAD:CURRENT:CELL, ATLEFT,T; MACRO NOTEOF=(.CURRENT NEQ .SHEAD)$, NEXTIN=(IF NOTEOF THEN IF .ATLEFT THEN (V_.CURRENT[LBYTE]; ATLEFT_FALSE; CURRENT_.CURRENT[NEXTF]; .V) ELSE (ATLEFT_TRUE; V_.CURRENT[RBYTE]; IF .CURRENT[LBYTE] EQL 0 THEN IF .CURRENT[NEXTF] EQL .SHEAD THEN CURRENT_.SHEAD; .V) ELSE 0)$, R50IN=R50CHAR(NEXTIN)$; ROUTINE R50CHAR(CHAR)= IF INRANGE("0","9") THEN #36+.CHAR-"0" ELSE IF INRANGE("A","Z") THEN #1+.CHAR-"A" ELSE IF .CHAR EQL "$" THEN #33 ELSE IF .CHAR EQL "." THEN #34 ELSE IF .CHAR EQL " " THEN 0 ELSE IF .CHAR EQL 0 THEN 0 ELSE (WARNEM(.NSYM,WABADRAD50); 0); FUNCTION R50WORD= BEGIN LOCAL ACCUM, V; ACCUM_0; INCR I FROM 0 TO 2 DO ACCUM_#50*.ACCUM+R50IN; LITLEXEME(.ACCUM) END; IF .LEX[LTYPF] EQL LITTYP THEN BEGIN T_LITVALUE(.LEX); RETURN LITLEXEME( (R50CHAR(EVENCHAR(.T))*#50+R50CHAR(ODDCHAR(.T)))*#50) END; SHEAD _ .LEX[ADDRF]; CURRENT_.SHEAD[TOPF]; ATLEFT_FALSE; IF .SHEAD[LSLENGTH] EQL 2 THEN IF .ST[.SHEAD[BOTF],LBYTE] EQL 0 THEN RETURN R50WORD(); NHEAD_GETCELL(CHTLONGS,1); NHEAD[LSLENGTH]_0; DO (CELL_NEWBOT(.NHEAD,CHTLEX,1); CELL[LEXEMEF]_R50WORD(); NHEAD[LSLENGTH]_.NHEAD[LSLENGTH]+1) WHILE NOTEOF; RETURN LEXOUT(LSLEXTYP,.NHEAD) END; ROUTINE SFUNQUOTE= BEGIN SCANFOR(SYMBOL,.QL); IF .SYM[LTYPF] NEQ UNBNDVAR THEN RETURN; SYM[LTYPF]_BNDVAR; SYM[ADDRF]_.ST[.SYM[ADDRF],SYMLINK] END; FORWARD GETNSCHARS, GETNSARG; EXTERNAL STVEC NSPTR; MACRO INITNS= LOCAL SAVT,SAVOD,SAVSTCP,SAVMACP; BIND SUBTYPE=MACRSUBTYPE; SAVT_.TRACEBIT; SAVOD_.OLDDEL; SAVSTCP_.STRUCP; SAVMACP_.MACRCP; NOTETRACE; TRACEBIT_STRUCP_MACRCP_FALSE; SCANFOR(DELIMITER,QLLEXEME); IF .DEL NEQ "(" THEN % ERROR %; OLDDELI_"," $; MACRO WINDUPNS= TRACEBIT_.SAVT; OLDDEL_.SAVOD; STRUCP_.SAVSTCP; MACRCP_.SAVMACP; RETURN NOVALUE $; ROUTINE SFNAME= BEGIN LOCAL NTVEC NAMEND, NAME[2], PNAME, LIMIT, CHAR; INITNS; NAME[0]_NAME[1]_-2; PNAME_(NAME-1)<1,7>; LIMIT_10; NSPTR_0; DO BEGIN NAMEND_GETNSCHARS(CHAR,1); IF .NAMEND EQL 2 THEN EXITLOOP; ! ERROR HAS OCCURRED IF (LIMIT_.LIMIT-1) GEQ 0 THEN REPLACEI(PNAME,.CHAR) ELSE (UNTIL .DEL EQL HPARACLOSE DO RUND(QLSSLEX); EXITLOOP) END UNTIL .NAMEND; IF .NAMEND NEQ 2 THEN BEGIN ACCUM[0]_.NAME[0]; ACCUM[1]_.NAME[1]; SYM_SEARCH(UNDECTYPE); SYM_FASTLEXOUT(UNBNDVAR,.SYM); IF .QL LSS QLQNAME THEN QNATOLEX(); END; WINDUPNS END; ROUTINE SFSTRING= BEGIN LOCAL TWOCHARS, STVEC FSTRHED:CELL, LIMIT, STRNGEND; INITNS; FSTRHED_0; LIMIT_LONGESTPLIT; NSPTR_0; DO BEGIN STRNGEND_GETNSCHARS(TWOCHARS,2); IF .STRNGEND EQL 2 THEN EXITLOOP; ! ERROR HAS OCCURRED IF .FSTRHED EQL 0 THEN IF .STRNGEND THEN (SYM_LEXOUT(IF .QL LSS QLSSLEX THEN LITTYP ELSE SSLEXTYP, .TWOCHARS); WINDUPNS) ELSE FSTRHED_GETCELL(CHTLONGS,1); IF (LIMIT_.LIMIT-1) GEQ 0 THEN (CELL_NEWBOT(.FSTRHED,CHTLEX,1); CELL[LEXEMEF]_LITLEXEME(.TWOCHARS)) ELSE (FERROR(.NATOM,.NCBUFF,ERSYMRQ); PUNT(0)) END UNTIL .STRNGEND; IF .STRNGEND NEQ 2 THEN BEGIN FSTRHED[LSLENGTH]_LONGESTPLIT-.LIMIT; SYM_FASTLEXOUT(LSLEXTYP,.FSTRHED); END; WINDUPNS END; EXTERNAL LEXEME NSSYM, NSDIGITS[5]; BIND NSCOUNT=NSPTR, NSLEFT=NSDIGITS; ROUTINE GETNSCHARS(DEST,COUNT)= BEGIN .DEST_0; INCR I TO (.COUNT-1) DO BEGIN BIND DESTBYTE=(.DEST)<8*.I,8>; IF .NSPTR EQL 0 THEN IF .DEL EQL HPARACLOSE THEN RETURN TRUE ELSE IF GETNSARG() THEN RETURN 2; CASE .NSSYM[LTYPF] OF SET % 0 % 0; % LITTYP % BEGIN DESTBYTE_.NSDIGITS[.NSCOUNT-1]; IF (NSCOUNT_.NSCOUNT+1) EQL 6 THEN NSCOUNT_0 END; % BNDVAR, GTTYP, ERRTYP % 0; 0; 0; % LSLEXTYP % BEGIN IF NOT .NSLEFT THEN (DESTBYTE_.NSPTR[RBYTE]; IF .NSPTR[LBYTE] EQL 0 THEN NSPTR_0) ELSE (DESTBYTE_.NSPTR[LBYTE]; IF (NSPTR_.NSPTR[NEXTF]) EQL .NSSYM[ADDRF] THEN NSPTR_0); NSLEFT_NOT .NSLEFT END; % SSLEXTYP % BEGIN IF NOT .NSLEFT THEN (DESTBYTE_EVENCHAR(.NSPTR); NSPTR_ODDCHAR(.NSPTR)) ELSE (DESTBYTE_.NSPTR; NSPTR_0); NSLEFT_NOT .NSLEFT END TES END; ! OF LOOP RETURN (.NSPTR EQL 0) AND (.DEL EQL HPARACLOSE) END; ! OF GETNSCHARS ROUTINE GETNSARG= ! ! SCAN FOR ANOTHER ARGUMENT FOR $NAME OR $STRING; ! PUT INFORMATION ABOUT IT IN NSSYM, NSPTR(NSCOUNT), ! AND NSLEFT(NSDIGITS). RETURN TRUE IF ! SCAN WAS UNSUCCESSFUL (DUE TO ERRORS). ! WHILE 1 DO BEGIN EXTERNAL LASTEND; MACRO TRYAGAIN=EXITBLOCK$; RUND(QLSSLEX); IF .DEL NEQ HCOMMA AND .DEL NEQ HPARACLOSE THEN (ERRORR(PARAERR,PSPAR,.NDEL,.NDEL); RETURN TRUE); SYM_BINDBIND(.SYM); IF NOT ONEOF(.SYM[LTYPF],BIT3(LITTYP,LSLEXTYP,SSLEXTYP)) THEN (WARNEM(.NSYM,WILLNSARG); IF .DEL EQL HPARACLOSE THEN RETURN TRUE ELSE TRYAGAIN); NSSYM_.SYM; CASE .SYM[LTYPF] OF SET % 0 % 0; % LITTYP % BEGIN IF (SYM_LITVALUE(.SYM)) EQL 0 THEN (NSDIGITS[4]_"0"; NSCOUNT_5; RETURN FALSE); NSCOUNT_(DECR I FROM 5 TO 1 DO BEGIN NSDIGITS[.I-1]_(.SYM MOD 10)+"0"; IF (SYM_.SYM/10) EQL 0 THEN EXITLOOP .I END) END; % BNDVAR, GTTYP, ERRTYP % 0; 0; 0; % LSLEXTYP % (NSPTR_.ST[.NSSYM,TOPF]; NSLEFT_FALSE); % SSLEXTYP % (NSPTR_LITVALUE(.NSSYM); NSLEFT_FALSE) TES; RETURN FALSE END; ROUTINE SFCOUNT= BEGIN BIND SUBTYPE=MACRSUBTYPE; SYM_ IF RECURSIVE THEN .MACRNAME[RECCOUNTF] ELSE .MACRITCOUNT; SYM_LITLEXEME(.SYM-1) END; ROUTINE SFLENGTH=SYM_LITLEXEME(.MACRLENGTH); ! ACTUAL BODY OF SFCONVERT BIND STVEC SYMST=SYM; LOCAL SFIND; BIND SPECF=.PLIT(SFASCII,SFASCIZ,SFRADIX50,SFUNQUOTE, SFNAME,SFSTRING,SFCOUNT,SFLENGTH) [SFIND_.SYMST[WHICHF]]; QL_.QUOTELEVEL; IF .SFIND LEQ 2 THEN % LONG STRING CONVERSIONS % (SCANFOR(SYMBOL,QLLSLEX); IF NOT ONEOF(.SYM[LTYPF],BIT2(LITTYP,LSLEXTYP)) THEN (WARNEM(.NSYM,ERNEEDLS); RETURN); SYM_SPECF(.SYM)) ELSE % OTHER CONVERSIONS % SPECF(); IF .QL LSS .SYM[LTYPF] THEN LSERROR() END; ROUTINE SFEXPAND(SYM)= % MAKE MACRO AFTER DEBUGGED--HEH % BEGIN MAP STVEC SYM; ROUTINE SFQUOTE=QUOTED_TRUE; ROUTINE SFREMAINING=%FERROR(.NSYM,.NSYM,NOTIMPL)%; (.PLIT(SFQUOTE,SFREMAINING)[.SYM[WHICHF]])() END; ROUTINE LSERROR=(WARNEM(.NATOM,ERILSUSE); SYM_ZERO); ! D. EXPANDERS ! D.1: ACTUAL PARAMETER ROUTINES ROUTINE MACRPICKOFF(ACTBEG,NUMBER)= ! ! TAKES AS MANY ACTUALS AS CAN BE BOUND AT ! ONCE IN THE CURRENT MACRO EXPANSION, AND ! BINDS THEM TO FORMALS. ACTBEG IS THE LIST ! OF BOUND PARAMETERS. ! BEGIN MAP STVEC ACTBEG; INCR I FROM 0 TO .NUMBER-1 DO BEGIN IF REMTEOF() THEN RETURN; ACTBEG[.I,0,36]_@(REMNEXT()) END END; MACRO APPENDSYM=(IF .SYM NEQ 0 THEN STRMAPPEND(WSTBUF,WSTMAX-1)_.SYM)$, APPENDWIND=STRMAPPEND(WSTBUF,WSTMAX-1)_FORMWINDOW(.SYM,.DEL)$; ROUTINE SCANTO(RBRACK,ERP,COMMAP)= INCR I DO BEGIN LOCAL MATCHRB; RUND(QLQNAME); IF .COMMAP THEN UNLESSQUOTED(DEL) IF .DEL EQL "," OR .DEL EQL .RBRACK THEN IF .SYM EQL 0 THEN RETURN .I ELSE (APPENDSYM; RETURN 1); APPENDWIND; IF .DEL EQL .RBRACK THEN RETURN 1; IF (MATCHRB_LBRACEL(.DEL)) NEQ 0 THEN (IF SCANTO(.MATCHRB,.NDEL,0) LSS 0 THEN RETURN -1) ELSE IF RBRACEL(.DEL) NEQ 0 THEN (FERROR(.ERP,.NDEL,ERMFPL); RETURN -1) END; MACRO NEXTAP=STRMAPPEND(APLBUF,APLMAX-1)$, NEWNULL=(LOCAL STVEC T; T_GETSPACE(ST,1); .T)$; MACRO DETRFI= BEGIN LOCAL NUMNULL, MATCHRB; PLISTLEN_NUMNULL_0; RUND(QLQNAME); IF (MATCHRB_LBRACEL(.DEL)) EQL 0 THEN (ERRINFO[0]_.MACSTE; FERROR(.NDEL,.NDEL,ERMPL); EXITBLOCK 1); OLDDELI_","; ! SIGNAL TO DETBRACKET DO CASE 1+SIGN(SCANTO(.MATCHRB,.NDEL,TRUE)) OF SET EXITBLOCK 1; ! ERROR IN SCANTO NUMNULL_.NUMNULL+1; ! NULL STREAM BEGIN INCR I FROM 1 TO .NUMNULL DO NEXTAP_NEWNULL; NEXTAP_STRMQUIT(WSTBUF); PARMSEEN_TRUE; PLISTLEN_.PLISTLEN+.NUMNULL+1; NUMNULL_0 END TES UNTIL .DEL EQL .MATCHRB; PLISTTOP_PLISTBEG_STRMQUIT(APLBUF); 0 END$; MACRO DETREMAIN= BEGIN LOCAL SSYM, SCOPY, SOLDDEL, SOLDDELI, RETVAL, STRACE; MAP FVEC APMBUF:APLBUF:WSTBUF; IF .MACSTE EQL .DLREMAIN THEN (IF .MACRNACTS LSS .REMLEN THEN (PLISTTOP_.REMTOP; PLISTBEG_.REMBEG; SAVPOS_.REMPOS; PLISTLEN_.REMLEN-.MACRNACTS; EXITBLOCK 0) ELSE (SUBTYPE_MACRPASSED; PARMSEEN_FALSE; EXITBLOCK 0)); TRACEE(MACRTPB); APMBUF[STKLEN]_IF EMPTYBUFP(WSTBUF) THEN .APLBUF[STKLEN]+1 ELSE 1 + APLMAX+.WSTBUF[STKLEN]; STRMPUSH(APMBUF); APLBUF[STKLEN]_APLBUF[STKNEXT]_WSTBUF[STKLEN]_WSTBUF[STKNEXT]_0; SCOPY_.MACRCP; MACRCP_TRUE; PARMSEEN_FALSE; NOTETRACE; STRACE_.TRACEBIT; TRACEBIT_FALSE; SSYM_.SYM; SOLDDEL_.OLDDEL; SOLDDELI_.OLDDELI; OLDDELI_0; RETVAL_DETRFI; TRYSTREAMPOP(); MACRCP_.SCOPY; SYM_.SSYM; OLDDEL_.SOLDDEL; OLDDELI_.SOLDDELI; TRACEBIT_.STRACE; STRMPOP(APMBUF); .RETVAL END$; ! D.2: EXPANSION PER SE BIND INPMACRLS=PLIT(STRULEN-1, ! SIMPLE MACRPALEN-1, ! PASS MACRLEN-1, ! ITERATED 0, ! ? (PASS + ITERATED?!) MACRRFLEN-1, ! FIXED MACRRFLEN-1, ! RECURSIVE MACRLEN-1); ! FIXED ITERATED ROUTINE MACRSWAP(STACKLENGTH,TYPE,STREAMPOS)= ! ! SAVE THE OLD LEXICAL ANALYSIS CONTEXT, AND PUSH ! IN A NEW ONE, WITH APPROPRIATE INITIALIZATION. JUST ! HOW MUCH CONTEXT IS SAVED IS DETERMINED BY STACKLENGTH. ! BEGIN BIND SUBTYPE=MACRSUBTYPE; ! FOR "ITERATED" MACRO INPBUF[STKLEN]_.STACKLENGTH; IF NOT STRUCTURED THEN NOTETRACE; STRMPUSH(INPBUF); STRMZTOP(INPBUF); STREAMIN_TRUE; MACRSUBTYPE_.TYPE; STRMTOP_STRMBEG_.STREAMPOS; TRACEBIT_.EMFLG; % ATOMISSYM_STRMPOS_MACRITCOUNT_TMS_ITMS_0 % END; MACRO TRACEIT(ROUT,PAR)=IF .EMFLG THEN ROUT(PAR)$; ROUTINE EMACR(MACSTE,SYMORDEL)= BEGIN MACRO TRACEE(X)=TRACEIT(X,.MACSTE)$; MAP STVEC MACSTE; LOCAL STVEC SUBTYPE, PLISTLEN, PLISTTOP, PLISTBEG, SAVPOS, BRIND, PARMSEEN; SUBTYPE_.MACSTE[SUBTYPEM]; IF .EMFLG THEN (EXTERNAL FORCELINE; FORCELINE(); MACRNUMBL_.MACRNUMBL+4); IF ITERATED THEN BRIND_DETBRACKET(.SYMORDEL); IF REMREQ THEN IF DETREMAIN THEN (EXPANDERR_1; RETURN); ! TRACE EMPTY STREAM HERE SOMETIME IF MUSTSEEPARMS THEN IF NOT .PARMSEEN THEN (TRACEE(MACRTE); TRACEE(MACRTNULLV); RETURN); MACRSWAP(.INPMACRLS[.SUBTYPE],.SUBTYPE,.MACSTE[STREAMF]); MACRNAME_.MACSTE; IF SIMPLE THEN (TRACEE(MACRTE); RETURN STRMTAKE()); REMTOP_.PLISTTOP; REMBEG_.PLISTBEG; MACRLENGTH_REMLEN_.PLISTLEN; IF .MACRNAME EQL .DLREMAIN THEN REMPOS_.SAVPOS %ELSE REMPOS_0%; MACRNACTS_.MACSTE[NUMFIXED]+.MACSTE[NUMITED]; IF PASSED THEN (TRACEE(MACRTE); RETURN STRMTAKE()); IF (NOT FIXED) AND (.REMLEN LSS .MACRNACTS) THEN BEGIN STRMEOF_TRUE; MACRSUBTYPE_MACRPASSED; TRACEE(MACRTE); RETURN END; MACRACT_GETSPACE(ST,.MACRNACTS+1); MACRACT[STKLEN]_.MACRNACTS; MACRPICKOFF(.MACRACT+1,.MACRNACTS); TRACEE(MACRTFPO); TRACEE(MACRTE); IF FIXED THEN (MACRNACTS_.REMLEN; RETURN STRMTAKE()); IF RECURSIVE THEN (MACSTE[RECCOUNTF]_.MACSTE[RECCOUNTF]+1; RETURN STRMTAKE()); MACRITCOUNT_1; IF .MACRNAME NEQ .DLREMAIN THEN (TRACEE(MACRTPBE); TRACEE(MACRTLPO)); MACRBSIND_.BRIND; MACRNF_.MACSTE[NUMFIXED]; MACRNI_.MACSTE[NUMITED]; IF .MACRLBR EQL 0 THEN STRMTAKE() ELSE (FUTWINDOW[DELIND]_.MACRLBR; %ATOMISSYM_FALSE;% TRACEE(MACRTS)) END; ROUTINE EMACRF(OFFST)= BEGIN BIND SUBTYPE=MACRSUBTYPE; LOCAL OLDTRACE; MAP LEXEME OFFST; OLDTRACE_.TRACEBIT; IF FIXED THEN IF .OFFST[ADDRF] GTR .MACRNACTS THEN RETURN; MACRSWAP(MACRFLEN-1,MACRSIMPLE,.MACRACT[.OFFST[ADDRF],0,36]); TRACEBIT_.OLDTRACE; ACTUALEXP_TRUE; STRMTAKE() END; GLOBAL ROUTINE ESTRU(STREAM,ACTUALS,STRUCT,FAKE)= BEGIN LOCAL VALUE,SAVEL; EXTERNAL LASTEND; ! WINDOW SHOULD CONTAIN RIGHT BRACKET IF .STRUCP OR .NOTREE THEN (IF NOT .FAKE THEN RUNDE(); SYM_ZERO; RETURN); DEL_HSEMICOLON; NEWLASTEND(PSPOI); MACRSWAP(STRULEN-1,MACRSIND,.STREAM); TRACEBIT_FALSE; STRUEXPAND_TRUE; STRUACT_.ACTUALS; STRUNAME_.STRUCT; STRMTAKE(); RUND(QLLEXEME); EXPRESSION(); ! SIZE MUST WORRY ABOUT LITERAL RESLASTEND; ! WINDOW SHOULD CONTAIN RIGHT POINTER CLOSE VALUE_.SYM; IF NOT .FAKE THEN RUNDE(); SYM_.VALUE END; ! E. POP CONTEXTS ROUTINE POPORIT= ! ! POP OR ITERATE ! CALLED WHEN THE "STREAM END-OF-FILE" CONDITION ! IS DISCOVERED BY SCANFOR. FOR ITERATED MACROS, ! STARTS ANOTHER ITERATION (IF WARRANTED); FOR ! OTHER MACROS (& STRUCTURES), POPS THE CONTEXT ! THAT WAS PUSHED BY MACRSWAP. ! BEGIN MACRO TRACEE(ROUT)=TRACEIT(ROUT,.MACRNAME)$; BIND SUBTYPE=MACRSUBTYPE; LOCAL OLDTMS; IF ITERATED THEN BEGIN IF (REMLEN_.REMLEN-.MACRNACTS) LSS .MACRNI THEN BEGIN ! CLOSING DELIMITER TRACEE(MACRTIV); IF .MACRRBR NEQ 0 THEN BEGIN SUBTYPE_MACRRECUR; !SO AS NOT TO GO THROUGH AGAIN FUTWINDOW[DELIND]_.MACRRBR; MACRITCOUNT_0; TRACEE(MACRTS); STRMEOF_FALSE; ATOMISSYM_FALSE; RETURN TRUE ! CAUSE SCANFOR LOOP EXIT END END ELSE BEGIN TRACEE(MACRTIV); MACRITCOUNT_.MACRITCOUNT+1; MACRNACTS_.MACRNI; MACRPICKOFF(.MACRACT+.MACRNF+1,.MACRNI); STRMTOP_.STRMBEG; STRMPOS_0; ATOMISSYM_FALSE; STRMEOF_FALSE; IF .MACRSEP NEQ 0 THEN BEGIN FUTWINDOW[DELIND]_.MACRSEP; TRACEE(MACRTS); IF .MACRNAME NEQ .DLREMAIN THEN (TRACEE(MACRTPBE); TRACEE(MACRTLPO)); RETURN TRUE END ELSE (STRMTAKE(); IF .MACRNAME NEQ .DLREMAIN THEN (TRACEE(MACRTPBE); TRACEE(MACRTLPO)); RETURN FALSE) END END; IF RECURSIVE THEN MACRNAME[RECCOUNTF]_.MACRNAME[RECCOUNTF]-1; IF NOT STRUCTURED AND NOT .ACTUALEXP THEN TRACEE(MACRTV); IF REMREQ THEN IF .MACRNAME NEQ .DLREMAIN THEN BEGIN REMTOP_.REMBEG; REMPOS_0; WHILE NOT REMTEOF() DO (REMNEXT();STRMRELEASE(.REMTOP[.REMPOS,0,36])); STRMRELEASE(.REMBEG); IF NOT PASSED THEN RELEASESPACE(ST,.MACRACT,.MACRACT[STKLEN]+1) END; IF .TRACEBIT THEN (OLDTMS_.TMS; STRMPOP(INPBUF); IF .TRACEBIT THEN IF ITERATED THEN ITMS_STRMCONC(.ITMS,.OLDTMS) ELSE TMS_STRMCONC(.TMS,.OLDTMS) ELSE STRMRELEASE(.OLDTMS)) ELSE STRMPOP(INPBUF); FALSE END; ! F. STRUCTURE COPY ROUTINE STRUCOPY= BEGIN LOCAL STVEC NAME; IF .SYM[LTYPF] NEQ BNDVAR THEN RETURN APPEND(); NAME_.SYM[ADDRF]; IF .NAME[TYPEF] NEQ STRUFT THEN IF .NAME[TYPEF] EQL STRUCTURET THEN IF .NAME EQL .STRUDEF THEN (IF .DEL EQL "[" THEN (WARNEM(.NSYM,WASTRUCTREC); SYM_.STRUDEFV; RETURN APPEND()); IF .OLDDEL NEQ HDOT THEN (WARNEM(.NSYM,ERSNMBDOT); SYM_FASTLEXOUT(CLSTRUF,1); RETURN APPEND()); SYM[ADDRF]_1-.NINP) ELSE RETURN APPEND() ELSE RETURN APPEND() ELSE SYM[ADDRF]_.NAME[WHICHF]; SYM[LTYPF]_CLSTRUF; IF .OLDDEL NEQ HDOT THEN (APPEND(); SYM_ZERO; RETURN); IF .SIZEEXP THEN RETURN (WARNEM(.NSYM,ERNODOTS); SYM[ADDRF]_.SYM[ADDRF]-.NINP); SYM[ADDRF]_.SYM[ADDRF]+.NINP; IF .WSTBUF[LTYPF] EQL DELMT THEN (WSTBUF[]_.SYM; WSTBUF[DELIND]_.DEL; SYM_ZERO; RETURN) ELSE WSTBUF[DELIND]_0; APPEND() END; ROUTINE APPEND=(LOCAL LSYM; IF (IF .SYM[LTYPF] EQL BNDVAR THEN .STSYM[BLF] GTR .STRUCLEVEL) THEN LSYM_LEXOUT(CLWANTSYM,.STSYM[NAMEPTR]) ELSE LSYM_.SYM; STRMAPPEND(WSTBUF,WSTMAX-1)_FORMWINDOW(.LSYM,.DEL)); GLOBAL ROUTINE STRUSC(SIZEPRED)= BEGIN LOCAL SAVEDEL; BIND RIGHTPOINT=">"; NOCODE; STRUCP_TRUE; SIZEEXP_.SIZEPRED; SAVEDEL_.DEL; DEL_IF .DEL EQL HCOMPOPEN THEN "(" ELSE .OLDDELI; STRUCOPY(); DEL_.SAVEDEL; EXPRESSION(); WSTBUF[DELIND]_RIGHTPOINT; ! OVERWRITE CLOSING DELIMITER STRUCP_FALSE; RESNOTREE; STRMQUIT(WSTBUF) END; ! G. MACRO TRACE ROUTINES BIND NONE=0, COLON=":", EQUAL="="; BIND LBRACKET="[", RBRACKET="]", SLASH="/", SINGLEQ="'"; MACRO INNR=(.NOIN AND .MACRNUMBL NEQ 4)$, PREDE=NOT(.NOCON OR INNR)$, PREDFPO=NOT(.NOIT OR .NOPAR OR INNR)$, PREDIV=NOT(.NOIT OR .NOIN)$, PREDLPO=NOT(.NOIT OR .NOPAR OR .NOIN)$, PREDPB=NOT(.NOCON OR INNR)$, PREDPBE=NOT(.NOCON OR .NOIT OR .NOIN)$, PREDS=PREDPBE$, PREDV=NOT INNR$; MACRO NTEPR(NTIND)=OUTXSTRING(NT[NTIND,ACCUM1]<29,7>,10,1)$, STEPR(STIND)=NTEPR(.ST[STIND,NAMEPTR])$; GLOBAL ROUTINE OUTDEL(DTIND)= BEGIN BIND SELECTOFI=#777777, OFINDEX=#17; ! SEE DETREMAIN AND OF1 MAP LEXEME DTIND; IF .DTIND EQL SELECTOFI THEN DTIND_OFINDEX; DTIND[DLRESWD]_0; IF .DTPF[.DTIND] EQL 0 THEN OUTPUT(.DTIND) ELSE STEPR(.DTPF[.DTIND]) END; GLOBAL ROUTINE OUTSYM(SYM)= BEGIN MAP LEXEME SYM; CASE .SYM[LTYPF] OF SET % DELIMITER LEXEME % ; % LITERAL--PRINT AS OCTAL % (OUTPUT("#"); OUTOCT(LITVALUE(.SYM),1)); % BOUND VARIABLE--PRINT NAME % STEPR(.SYM[ADDRF]); % GT TYPE--PRINT ADDRESS IN BRACKETS % (OUTPUT(LBRACKET); OUTOCT(.SYM[ADDRF],1); OUTPUT(RBRACKET)); % ERROR LEXEME % OUTS('ERR-LEX'); % LONG STRING % (OUTPUT(SINGLEQ); OUT11STRING(.SYM); OUTPUT(SINGLEQ)); % SHORT STRING % (OUTPUT(SINGLEQ); OUTWRD(.SYM); OUTPUT(SINGLEQ)); % STRUCTURE ACTUAL % (OUTS('STRACT-'); OUTDEC(.SYM[ADDRF],1)); % UNBOUND VARIABLE % (OUTPUT(SINGLEQ); NTEPR(.SYM[ADDRF])); % SPECIAL FUNCTION LEXEME--STE IN ADDF % STEPR(.SYM[ADDRF]); % MACRO LEXEME--UNBOUND VARIABLE IN ADDF % (OUTS('MACRO-'); STEPR(.SYM[ADDRF])); % SPECIAL FUNCTION LEXEME (EXPANSION) % STEPR(.SYM[ADDRF]); % MACRO ACTUAL % (OUTS('MACRACT-'); OUTDEC(.SYM[ADDRF],1)) TES END; GLOBAL ROUTINE OUTSTR(TOPOFSTREAM)= BEGIN LOCAL ATOMDEL; MAP INDFVEC TOPOFSTREAM; IF .TOPOFSTREAM EQL 0 THEN (OUTMSG(NULL); RETURN CRLF); DO ( INCR I FROM 1 TO .TOPOFSTREAM[STKLEN] DO (ATOMDEL_(.DTPF[.TOPOFSTREAM[.I,DELIND]] NEQ 0); OUTSYM(.TOPOFSTREAM[.I,0,36]); IF .ATOMDEL THEN OUTPUT(" "); OUTDEL(.TOPOFSTREAM[.I,DELIND]); IF .ATOMDEL OR (.TOPOFSTREAM[.I,DELIND] EQL 0) THEN OUTPUT(" "))) WHILE (TOPOFSTREAM_.TOPOFSTREAM[STKNEXT]) NEQ 0; CRLF; END; ROUTINE OUTWRD(LEX)= BEGIN MAP LEXEME LEX; OUTPUT(LITVALUE(.LEX[ADDRF]) AND #177); OUTPUT(LITVALUE(.LEX[ADDRF])^(-8)); END; GLOBAL ROUTINE OUT11STR(LEX)= ! ! ROUTINE TO OUTPUT BLIS11 STRING. ! ! LEXEME ASSUMED OF TYPE LSLEXTYP OR LITTYP. ! NOTE: BLIS11 CHARACTER SEQUENCE IS LOW-ORDER 8 BITS ! FOLLOWED BY HIGH-ORDER 8 BITS. ! BEGIN MAP LEXEME LEX; LOCAL STVEC HEAD:CUR; IF .LEX[LTYPF] EQL LITTYP THEN RETURN OUTWRD(.LEX); HEAD_.LEX[ADDRF]; CUR_.HEAD[TOPF]; INCR I FROM 1 TO .HEAD[LSLENGTH] DO (OUTWRD(.CUR[LEXEMEF]); CUR_.CUR[NEXTF]); END; ROUTINE MACRTAPNDP(ADTMS,PRINTBOOL)= BEGIN .ADTMS_STRMCONC(..ADTMS, STRMQUIT(MTBUF)); IF .PRINTBOOL THEN OUTSTR(..ADTMS) END; ROUTINE MACRTE(MACSTE)=IF PREDE THEN (OUTMHD(.MACSTE,NONE,NONE,COLON); OUTMSG(EXPANSION); CRLF); ROUTINE MACRTFPO(MACSTE)=IF PREDFPO THEN (MAP STVEC MACSTE; INCR I FROM 1 TO .MACSTE[NUMFIXED] DO (OUTMHD(.MACSTE,NONE, .I, EQUAL); OUTSTR(.MACRACT[.I,0,36]))); ROUTINE MACRTIV(MACSTE)= BEGIN LOCAL DOPRINT; IF DOPRINT_PREDIV THEN OUTMHD(.MACSTE,.MACRITCOUNT,NONE,EQUAL); MACRTAPNDP(ITMS, .DOPRINT); TMS_STRMCONC(.TMS,.ITMS); ITMS_0 END; ROUTINE MACRTLPO(MACSTE)=IF PREDLPO THEN (MAP STVEC MACSTE; INCR I FROM 1 TO .MACSTE[NUMITED] DO (OUTMHD(.MACSTE,.MACRITCOUNT,.I+.MACSTE[NUMFIXED],EQUAL); OUTSTR(.MACRACT[.I+.MACSTE[NUMFIXED],0,36]))); ROUTINE MACRTPB(MACSTE)= (IF PREDPB THEN ( OUTMHD(.MACSTE,NONE,NONE,COLON); OUTMSG(PARAMETER BINDING); CRLF)); ROUTINE MACRTPBE(MACSTE)=IF PREDPBE THEN (OUTMHD(.MACSTE,.MACRITCOUNT,NONE,COLON); OUTMSG(PARAMETER BINDING / EXPANSION); CRLF); ROUTINE MACRTS(MACSTE)=IF PREDS THEN (OUTMHD(.MACSTE,NONE,NONE,COLON); OUTMSG(SEPARATOR = ); OUTDEL(.FUTWINDOW[DELIND]); CRLF); ROUTINE MACRTV(MACSTE)= BEGIN LOCAL DOPRINT; IF DOPRINT_PREDV THEN OUTMHD(.MACSTE,NONE,NONE,EQUAL); MACRTAPNDP(TMS,.DOPRINT); IF .DOPRINT THEN CRLF; MACRNUMBL_.MACRNUMBL-4 END; ROUTINE MACRTNULLV(MACSTE)= BEGIN IF PREDV THEN (OUTMHD(.MACSTE,NONE,NONE,EQUAL); OUTSTR(0); CRLF); MACRNUMBL_.MACRNUMBL-4 END; ROUTINE OUTMHD(MNAME,ITLEVEL,PARAMNO,EQORCOLON)= BEGIN MAP STVEC MNAME; OUTPUT(";"); OUTPUT(";"); OUTBLANK(.MACRNUMBL); OUTPUT("["); OUTSTE(.MNAME); OUTPUT("]"); IF .ITLEVEL GTR NONE THEN (OUTPUT("["); OUTNUM(.ITLEVEL-1,10,1); OUTPUT("]")); IF .PARAMNO GTR NONE THEN (OUTPUT("("); OUTNUM(.PARAMNO,10,1); OUTPUT(")")); OUTPUT(.EQORCOLON); OUTPUT(" "); END; ! END OF LEXAN MODULE END END ELUDOM