Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50325/lexan.bli
There are no other files named lexan.bli in the archive.
! 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: <IDENTIFIER> FOUND
(THE 10 CHARACTERS ARE IN ACCUM[0:1])
2: <LITERAL> 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<ADDRF> 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