Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50325/declar.bli
There are no other files named declar.bli in the archive.
! File: DECLAR.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 DECLAR(TIMER=EXTERNAL(SIX12))=
BEGIN
! DECLAR MODULE
! -------------
!
! D. WILE
! MODIFIED BY:
! R. JOHNSSON
! P. KNUEVEN
!
!
! THIS MODULE PROCESSES DECLARATIONS.
!
!
REQUIRE COMMON.BEG;
REQUIRE GTST.BEG;
REQUIRE ST.BEG;
REQUIRE GTX.BEG;
REQUIRE LDSFT.BEG;
REQUIRE LDSF.BEG;
REQUIRE ERROR.BEG;
REQUIRE STRUCT.BEG;
REQUIRE TN.BEG;
REQUIRE IO.BEG;
BEGIN
!NEXT FIELD DEFINITIONS FOR THE FIELDS OF THE 2 WORD
!LIST WE MAKE UP FOR SIZE PROCESSING IN THE DECLARATIONS.
MACRO
STELNEXTF=0,0,18$,
STELSTEF=0,18,18$,
STELCPF=1,0,36$;
!-------------------------------------------------------
! THE FOLLOWING ARE MISC. EXTERNALS FOR DECLAR ONLY
EXTERNAL
CSCNAME,
CSDNAME,
CSGNAME,
CSONAME,
CSPNAME,
DECLSIZE, ! 1 DURING "BYTE" DECLARATION, OTHERWISE 2
IDENTFLG,
IDENTLEX,
INAPLIT, ! SIGNAL FROM PLIT PARSER TO DETBRACKET (VIA HRUND)
% THE FOLLOWING FOUR VARIABLES ARE SET BY GROMLIST %
OEQL, ! POINTS TO ROUTINE TO PROCESS "="
OFUN, ! POINTS TO ROUTINE TO DO RANDOM BITS OF
! PROCESSING ON EACH VARIABLE (E.G. PLABEL, PLOCAL)
OPAR, ! NOT USED AS FAR AS I KNOW.
OTYPE, ! VARIABLE TYPE BEING DECLARED
PLHEAD, ! CHARACTER STRING - NAME OF CURRENT PLIT
PLLBRAC, ! LOCATION OF LAST PLIT LEFT PAREN
STELAST, ! LAST ENTRY IN LIST OF SYMBOLS BEING DECLARED
STELIST, ! LIST OF SYMBOLS BEING DECLARED
UNAMNO;
EXTERNAL
GETTN, ! FROM LOW SEGMENT
STRMAPPEND, ! FROM LEXAN
STRMQUIT,
STRUSC,
BINDBIND, ! FROM SYNTAX
PDETACH,
DYNBIND,
EXPRESSION,
GETNCSE,
RNAMEFOLLOWS,
SENABLE,
STRUPICKOFF;
! MACROS AND BINDS FOR SWITCHES:
!
BIND SWSWL=19; !HIGHEST SWITCH INDEX VALID IN SWITCHES DECL.
MACRO ALLSW=.SWTBL[-1]$; ! " " " " " MODULE HEAD
! THESE MACROS HELP IN SPECIFYING THE VALID SWITCHES.
MACRO
BS(NUM,STR)=('STR' OR ((-1)^(-7*NUM))) AND (-2)$,
BL(STR)='STR' AND (-2)$;
! THE FOLLOWING IS A LIST OF SWITCHES FOR THE BLISS COMPILER.
! IT IS A PLIT WHICH IS SEARCHED AS A VECTOR.
!
! THIS DECLARATION IS SET UP AS FOLLOWS:
!
! FOR EACH ALLOWABLE SWITCH NAME, ONE OF THE ABOVE
! MACROS IS INVOKED WITH THE FIRST FIVE (5) CHARACTERS
! OF THAT SWITCH NAME AS ITS ARGUMENT. THE REMAINING
! CHARACTERS OF THE SWITCH NAME, IF ANY, FOLLOW AS A COMMENT.
BIND SWTBL=PLIT (
BL(EXPAN) %D%,
BL(NOEXP) %AND%,
BS(4,LIST),
BL(NOLIS) %T%,
BS(4,ERRS),
BL(NOERR) %S%,
BL(MLIST),
BL(NOMLI) %ST%,
BL(OPTIM) %IZE%,
BL(NOOPT) %IMIZE%,
BL(UNAME) %S%,
BL(NOUNA) %MES%,
BL(FINAL),
BL(NOFIN) %AL%,
BS(4,SAFE),
BL(UNSAF) %E%,
BS(3,ZIP),
BL(UNZIP),
BL(DEBUG),
BL(NODEB) %UG%,
BS(3,PIC),
BL(NOPIC),
% END OF SWITCHES VALID IN BOTH MODULE HEAD AND SWITCHES DECLARATION.
MODIFY SWSWL IF THE NUMBER OF SWITCHES ABOVE THIS CHANGES.
THE FOLLOWING SWITCHES ARE VALID ONLY IN THE MODULE HEAD. %
BL(SEGME) %NT%,
BL(NOSEG) %MENT%,
BL(START),
BL(STACK),
BS(4,MAIN),
BL(RESER) %VE%,
BL(IDENT),
BL(SYNTA) %X%);
! KEYWORD TABLE FOR CSECT/PSECT PROCESSING
BIND KWTBL=PLIT(
BS(4,CODE),
BL(DEBUG),
BL(GLOBA) %L%,
BS(3,OWN),
BS(4,PLIT));
FORWARD
ERRDECL,
DCLARE,
DECLARESYM,
DEFOG,
DEFGLO,
DEFASYM,
DEFMAP,
INITEQ,
OWNEQ,
GLOBALEQ,
MAPPURGE,
SYMPURGE,
GETLNKG,
SFORWARD,
SUNDECLARE,
STARTLNKG,
STARTNAME,
MAYBEDECLARE,
STARTCOL,
CONTIDLIST,
MAPONE,
ENDIDBATCH,
WHICHBIND,
BINDEQ,
GLBINDEQ,
REGEQ,
DOEQL,
DOSIZE,
GROMLIST,
PGLOBAL,
POWN,
PSTACKLOCAL,
PLOCAL,
PEXTERNAL,
PLABEL,
PREGISTER,
PBIND,
PGLOBBIND,
PROCPARMS,
GLOBROUT,
SLOCAL,
SSTACKLOCAL,
SOWN,
SGLOBAL,
SEXTERNAL,
SDCLLABEL,
SREGISTER,
SBIND,
SGLOBBIND,
SROUTINE,
SMAP,
SSETSIZE,
SBYTE,
SWORD,
INCRDECRREG,
SSWITCHES,
DOMODULE,
GETCONS,
GETSTRING,
SWITCHER,
SIDENT,
SSTACK,
SMAIN,
SSTART,
SRESERVE,
SRESERVE,
PPARAM,
SSTRUCTURE,
SMACRO,
GETSTRING2,
SCSECT,
SLNKGDECL,
SPLIT,
SPLITB,
PLITARG,
TUPLEITEM,
LSORLE,
LEXTOP,
SREQUIRE,
REQUINIT;
BIND DECLARATORS=PLIT(
0, !0
SBYTE, !1
SOWN, !2
SGLOBAL, !3
SEXTERNAL, !4
SROUTINE, !5
SSTRUCTURE, !6
SMAP, !7
SFORWARD, !8
SBIND, !9
SMACRO, !10
SUNDECLARE, !11
SDCLLABEL, !12
SWORD, !13
SSWITCHES, !14
SLOCAL, !15
SREGISTER, !16
SENABLE, !17
SREQUIRE, !18
SCSECT, !19
SSTACKLOCAL, !20
SLNKGDECL, !21
SCSECT !22 - PSECTS HANDLED BY CSECT ROUTINE
);
MACRO
ALLIGN(TABLE,NBYTE)=IF @TABLE AND NOT NBYTE
THEN TABLE_@TABLE+1$,
NEXTINTAB(TABLE,STE)=(STE[OFFSETF]_@TABLE;
TABLE_@TABLE+.STE[NCONTIGLOC])$,
BYTES(STE)=(.STE[SIZEF]/8)$;
MACRO ERROR(A,B,C,D)=ERRORR(D,C,B,A)$,
DELERR(COND,ERM)=IF .DEL COND THEN
RETURN ERROR(.LOBRAC,.NDEL,.LASTEND,ERM)$,
SXCTDECL=(LOBRAC_.NDEL;(@DECLARATORS[.DEL[HSYNTYP]])())$,
XCTDECL=(IF .SYM NEQ HEMPTY
THEN (SYM_HEMPTY;
ERROR(.LOBRAC,.NSYM,.LASTEND,DECLSYMERR))
ELSE (SXCTDECL;
IF .DEL NEQ HSEMICOLON
THEN ERROR(.LOBRAC,.NDEL,.LASTEND,DCLDELERR)
ELSE RUND(QLLEXEME)))$,
DECF(TP)=(IF NOT DECLARESYM(SENTRY,TP,1)
THEN RETURN
ELSE (SENTRY[POSF]_0; SENTRY[SIZEF]_16))$,
CKFORWD(RTYPE)=(IF (SENTRY_.NT[.SYM[ADDRF],SYMLINK]) NEQ 0
THEN IF .SENTRY[BLF] EQL .BLOCKLEVEL
AND .SENTRY[TYPEF] EQL FORWT
THEN (SENTRY[TYPEF]_RTYPE; SENTRY[DEBUGF]_.DEBFLG)
ELSE DECF(RTYPE)
ELSE DECF(RTYPE))$,
FBIT(BITNUM)=BITNUM,1$,
MUSTDECLARE =FBIT(0)$, !DECLARATION OTHER THAN MAP.
MUSTMAP =FBIT(1)$, !MUST BE MAPPED.
ISSBSLEX =FBIT(2)$, !HAS A SIZE LEXEME STREAM.
TEMPF =FBIT(3)$, !TEMPORARY BOOLEAN.
WASANEQUAL =FBIT(4)$, !EQUAL FOUND FOLLOWING THE
!INCARNATION ACTUALS.
LITRESULT=(.SYM[LTYPF] EQL LITTYP)$,
RULITEXP(LOCALSAV,LOCINFO)=(RUND(QLLEXEME);
LITEXP(LOCALSAV,LOCINFO))$,
LITEXP(LOCALSAV,LOCINFO)=(LOCALSAV_LOCINFO;
EXPRESSION();
SYM_BINDBIND(.SYM);
IF NOT LITRESULT
THEN (WARNEM(.LOCALSAV,ERMBADEXP); SYM_ONE))$;
EXTERNAL STVEC LNKGLX:INCACTS:STRSTE;
EXTERNAL INITSYMLSTS;
EXTERNAL LOBRAC;
GLOBAL ROUTINE ERRDECL=SXCTDECL; ! FOR ERROR HANDLING--SEE RUNC IN SYNTAX
GLOBAL ROUTINE DCLARE=
BEGIN
LOCAL SAVEL;
INDCL;
DECLSIZE_2;
NEWLASTEND(PSSEM);
BLOCKLEVEL_.BLOCKLEVEL+1;
WHILE .DEL[HCLASS] EQL DCLRTR DO
XCTDECL;
IF .NEXTLOCAL THEN NEXTLOCAL_.NEXTLOCAL+1;
RESINDECL;
RESLASTEND;
LCBRAC_.NDEL
END;
ROUTINE DECLARESYM(WHERE,TYPE,ERRHURTS)=
!I. GENERAL:
!
! 1. THIS ROUTINE DECLARES A SYMBOL IN "SYM".
!
! 2. PARAMETERS:
!
! A. WHERE - A POINTER TO A LOCATION WHERE THE
! SYMBOL TABLE INDEX OF THE SYMBOL
! DECLARED IN "SYM" SHOULD BE PUT.
!
! B. TYPE - THE TYPE OF THE SYMBOL TO BE DECLARED
!
! C. ERRHURTS - A BOOLEAN THAT DETERMINES THE TYPE
! OF ERROR RECOVERY TO BE ATTEMPTED.
!
!II. SPECIFIC:
!
! 1. *
!
! A. FIRST EXAMINE THE LEXEME IN SYM.
! 1. IF IT IS NOT A NAME TABLE ENTRY, GIVE
! EITHER AN ERROR OR A WARNING MESSAGE,
! DEPENDING ON THE SETTING OF "ERRHURTS".
!
! 2. PICK UP THE SYMBOL TABLE ENTRY MOST
! RECENTLY ATTACHED TO THIS NAME TABLE
! ENTRY.
!
! B. IF THE ENTRY IS UNDECLARED, OR FROM AN OUTER
! BLOCK, THEN:
! 1. DECLARE THE SYMBOL, AND ENTER ITS NEW
! TYPE IN A NEW SYMBOL TABLE ENTRY FOR
! THIS BLOCK.
!
!
! 2. PUT IT WHERE THE CALLER WANTS IT,
! AND CORRECT THE FUTURE SYMBOL LEXEME.
!
! C. OTHERWISE, WE HAVE ALREADY DECLARED IT IN
! THIS BLOCK, AND THAT IS AN ERROR.
BEGIN
BIND STVEC STSYM=SYM;
LOCAL STVEC STENTRY,MSGTYPE,ERRLOC;
MSGTYPE_ERNOSYM; ERRLOC_.NSYM;
IF .SYM EQL HEMPTY
THEN (ERRLOC_.NDEL;
IF .RESWD
THEN (RUNDE();
MSGTYPE_ERDCLRESWD));
IF .SYM[LTYPF] EQL BNDVAR
THEN (WARNEM(.LOBRAC,.NSYM,ERNOSYM);
SYM_.STSYM[NAMEPTR])
ELSE IF .SYM[LTYPF] NEQ UNBNDVAR
THEN (IF .ERRHURTS
THEN ERROR(.LOBRAC,.ERRLOC,.LASTEND,.MSGTYPE)
ELSE WARNEM(.LOBRAC,.ERRLOC,.MSGTYPE);
RETURN 0);
IF .STRUEXPAND
THEN STINSERT(.SYM[ADDRF],UNDECTYPE,0);
STENTRY_.STSYM[SYMLINK];
IF .STENTRY[TYPEF] NEQ UNDECTYPE
AND .STENTRY[BLF] GEQ .BLOCKLEVEL
THEN (ERRINFO[0]_.STENTRY; WARNEM(.NSYM,WASMPREV));
.WHERE_STINSERT(.SYM[ADDRF],.TYPE,0);
RETURN 1;
END;
MACRO BDEF=BEGIN MAP STVEC STE;$, EDEF=END$;
ROUTINE DEFOG(TABLE,STE,REQIN,RELIN,INIT)=
BDEF
ALLIGN(.TABLE,BYTES(STE));
IF .REQIN THEN
(STE[REQINIT]_TRUE;
STE[RELEASEINIT]_.RELIN;
STE[INITP]_.INIT);
STE[REGF]_PC;
IF .STE[ITSAPLIT] THEN
IF .STE[COUNTED] THEN (.TABLE)<0,36>_@.TABLE+2;
NEXTINTAB(.TABLE,STE);
INITSYMLSTS(.STE);
0
EDEF;
ROUTINE DEFGLO(STE,REQIN,RELIN,INIT)=
BDEF DEFOG(NEXTGLOBAL,.STE,.REQIN,.RELIN,.INIT);
STE[MODE]_ABSOLUTE; EDEF;
GLOBAL ROUTINE DEFASYM(STE,NOBYTES,POS,SIZ)=
BDEF
STE[NCONTIGLOC]_.NOBYTES;
STE[POSF]_.POS;
STE[SIZEF]_.SIZ;
STE[LNKGNMF]_.LNKGLX;
EDEF;
GLOBAL ROUTINE DEFMAP(STE)=
BDEF STE[HAVNOACTS]_TRUE;
STE[STRUORIACT]_.STRUDEFV; EDEF;
ROUTINE INITEQ=
BEGIN LOCAL PLITP,ERR, SIZ;
ERR_.NDEL;
OLDDELI_#126; ! "PLIT" SIGNAL TO DETBRACKET
IF (SIZ_2*SPLITB(PLITP %, T%)) GTR .SIZE
THEN (IF NOT .NOTREE THEN WARNEM(.ERR,ERISEDS); SIZE_.SIZ);
SYM_.PLITP;
0
END;
ROUTINE OWNEQ=INITEQ();
ROUTINE GLOBALEQ=INITEQ();
ROUTINE MAPPURGE(STE)=
% PRESUMES MAPPABLE SYMBOL %
BDEF
LOCAL STVEC STREAM;
IF (.STE[STRUORIACT] EQL 0) OR
.STE[HAVNOACTS] OR
NOT .STE[RELEASEACTS]
THEN RETURN;
STREAM_.STE[STRUORIACT];
STREAM[STRUCF]_0;
STRMRELEASE(.STREAM);
TRUE
EDEF;
GLOBAL ROUTINE SYMPURGE(STE)=
! SYMPURGE RETURNS TRUE IF THE SYMBOL MAY BE PURGED. IN
! ADDITION IT RELEASES ALL FIELDS (STREAMS AND
! TREES ASSOCIATED WITH THE FIELDS WITHIN THE SYMBOL.
BDEF
EXTERNAL FERASEDET;
MACRO
INIPURGE(STE)=
(IF .STE[REQINIT] AND .STE[RELEASEINIT]
THEN FERASEDET(.STE[INITP]); 2)$,
MACPURGE(STE)=
(STRMRELEASE(.STE[STREAMF]); 1)$,
STRPURGE(STE)=
(STRMRELEASE(.STE[BODYSTRM]);
IF .STE[SIZESTRM] NEQ 0 THEN STRMRELEASE(.STE[SIZESTRM]);
1)$;
SELECT .STE[TYPEF] OF
NSET
UNDECTYPE: RETURN 1;
MACROT: RETURN MACPURGE(STE);
STRUCTURET: RETURN STRPURGE(STE);
FORWT: (ERRINFO[0]_.STE; WARNEM(0,ERMRD); RETURN 1);
% MAPPABLE TYPES ONLY PAST HERE %
ALWAYS: IF NOT ISSTVAR(STE) THEN RETURN 1 ELSE MAPPURGE(.STE);
GLOBALT: RETURN INIPURGE(STE);
OWNT: RETURN INIPURGE(STE);
ALWAYS: RETURN 2;
TESN;
0
EDEF;
ROUTINE GETLNKG(LOC)=
!
! CALLED BY SFORWARD, GLOBROUT, AND SROUTINE
! PARSES THE LINKAGE NAME OF THE ROUTINE
!
BEGIN
BIND NTVEC NTSYM=SYM;
LOCAL STVEC LNKGNM;
LNKGNM _ .DFLTLNKGLX;
IF .DEL EQL ERRLEX THEN
BEGIN
LNKGNM _ .NTSYM[SYMLINK];
IF .LNKGNM[TYPEF] NEQ LNKGNMT THEN
(WARNEM(.NSYM,WAMSPLNKG);
LNKGNM _ .DFLTLNKGLX);
RUND(QLQNAME);
END;
.LOC _ .LNKGNM;
NOVALUE
END;
ROUTINE SFORWARD=
!
!SYNTAX: FORWARD <NAMESPEC1>,<NAMESPEC2>,...,<NAMESPECN>
!
! <NAMESPEC>::=<NAME>/<NAME>(<#PARAMETERS>)
!
!I. GENERAL:
!
! 1. THIS ROUTINE DECLARES AS FORWARD WITHIN THE BLOCK
! OPEN AT THE TIME OF DECLARATION.
!
! 2. THIS MEANS THAT THE ROUTINE WILL BE FOUND, AND
! DECLARED LATER WITHIN THIS SAME BLOCK;
!
!II. SPECIFIC:
!
! 1. *
!
! A. IT DOES EACH OF THE FOLLOWING THINGS TO
! DECLARE A FORWARD NAME UNTIL IT COMES TO
! A ";".
!
! 1. DECLARE THE NAME IN "SYM" AS OF
! TYPE FORWARD.
!
! 2. NEXT, IF WE SEE AN OPEN PARENTHESIS,
! ("("),THEN:
!
! A. PROCESS THE EXPRESSION WITHIN
! THE PARENTHESIS PAIR, AND
! MAKE SURE IT IS A LITERAL.
!
! B. IF WE DON'T NOW SEE A
! CLOSE PARENTHESIS
! AND AND EMPTY FUTURE SYMBOL,
! IE, THE WINDOW SHOULD BE:
!
! (XXX,")",<EMPTY>,",")
!
! THEN THERE IS AN ERROR.
!
! C. SAVE THE RESULTING LITERAL,
! AND MOVE THE WINDOW.
!
! 3. FINALLY, ADD THE NUMBER OF PARAMETERS
! FOR THE ROUTINE TO ITS SYMBOL TABLE
! ENTRY.
!
! 4. GENERATE INFORMATION FOR THE ROUTINE.
!
! 5. WE SHOULD HAVE A COMMA NEXT, OR A ";"
BEGIN
LOCAL SFSYMCHK,SAVSYM,STVEC SFSTE:LNKGNM;
DO
BEGIN
RUND(QLQNAME);
GETLNKG(LNKGNM);
IF DECLARESYM(SFSTE,FORWT,0)
THEN IF .DEL EQL HPARAOPEN
THEN BEGIN
RULITEXP(SFSYMCHK,.NSYM);
IF .DEL NEQ HPARACLOSE
THEN RETURN ERROR(.LOBRAC,.NDEL,.LASTEND,ERSYMNPRD);
SAVSYM_.SYM;
RUND(QLLEXEME);
IF .SYM NEQ HEMPTY THEN RETURN
ERROR(.LOBRAC,.NDEL,.LASTEND,ERSYMNPRD);
END
ELSE SAVSYM_0
ELSE EXITCOMPOUND;
DEFMAP(.SFSTE);
SFSTE[LNKGNMF]_.LNKGNM;
SFSTE[POSF]_0;
SFSTE[SIZEF]_16;
SFSTE[REGF]_PC;
SFSTE[MODE]_IF .PICSW THEN RELATIVE ELSE ABSOLUTE;
END
WHILE .DEL EQL HCOMMA;
END;
ROUTINE SUNDECLARE=
DO
BEGIN
MAP STVEC SYM;
RUND(QLQNAME);
STINSERT(.SYM,UNDECTYPE,0)
END
WHILE .DEL EQL HCOMMA;
ROUTINE STARTLNKG=
BEGIN
LOCAL STVEC STE;
LNKGLX_.DFLTLNKGLX;
IF .DEL EQL ERRLEX
THEN BEGIN
MACRO FORGET(WARNTYPE) =
(WARNEM(.NSYM,WARNTYPE);
EXITBLOCK RUND(QLQNAME)) $;
IF .SYM[LTYPF] EQL UNBNDVAR
THEN SYM_FASTLEXOUT(BNDVAR,.NT[.SYM,SYMLINK])
ELSE IF .SYM[LTYPF] NEQ BNDVAR
THEN FORGET(WAINVSTRUC);
IF (STE_.SYM[ADDRF]) EQL .TRAPLNKGLX[ADDRF]
THEN FORGET(WATRAPLNKG);
IF .STE[TYPEF] NEQ LNKGNMT
THEN RETURN 0;
LNKGLX_.STE;
RUND(QLQNAME)
END;
RETURN 0;
END;
ROUTINE STARTNAME=
!I. GENERAL:
!
! 1.THIS ROUTINE SETS UP A STRUCTURE SYMBOL TABLE ENTRY
! FOR THE SYMBOLS FOLLOWING IT, IF THE STRUCTURE IS
! SPECIFIED.
!
! 2. WE THEN SET FIELDS RELEVANT TO THE STRUCTURE, ONLY
! IF THE SYMBOLS FOLLOWING IN THIS DECLARATION ARE
! TO BE MAPPED.
!
!II. SPECIFIC:
!
! 1. *
!
! A. IF ".DEL" IS AN ERROR LEXEME THEN WE
! HAVE: <NAME1> <NAME2>
! WITH NO INTERVENING DELIMITER, AND THUS
! SPECIFIES A STRUCTURE MAPPING.
!
! B. WE HAVE ERRORS NOW, IF:
!
! 1. THE SYMBOL TABLE ENTRY FOR THE
! STRUCTURE IS OF AN UNDECLARED TYPE.
!
! 2. THE SYMBOL IS NOT OF TYPE STRUCTURE.
!
! C. IF EVERYTHING ELSE IS OK, THEN WE HAVE A
! STRUCTURE, SO WE SET THE "MUSTMAP" FIELD
! OF THE FLAGS "OFLAGS", SINCE WE MUST THEN
! MAP THIS STRUCTURE ONTO ALL FOLLOWING
! IDENTIFIERS IN THIS FIELD.
!
! D. OTHERWISE,, IF WE DON'T EXPLICITLY HAVE A STRUCTURE,
! THEN THE STRUCTURE SYMBOL TABLE INDEX IS SET
! TO THE VECTOR DEFAULT INDEX, AND WE NEED NOT
! MAP AT THIS POINT. THE REASON THAT WE DO
! SET THE INDEX THOUGH IS THAT WE MAY FIND
! LATER THAT WE INDEED DO NEED TO MAP, AND WE
! WILL THEN HAVE EVERYTHING SET UP.
! E. NEXT WE SEE IF THE FOLLOWING ID'S NEED TO BE
! MAPPED WHETHER OR NOT WE SAW A STRUCTURE.
! THEY NEED TO BE MAPPED IN THE FOLLOWING
! CASES:
!
! 1. A STRUCTURE WAS SPECIFIED.
!
! 2. WE SEE "<NAME>[".
!
! 3. WE SEE "<NAME>:".
!
! 4. THE IDENTIFIERS FOLLOWING ARE
! NOT TO BE DECLARED.
!
! 2. *
!
! A. THEN, IF WE DO NEED TO MAP, THEN WE DO THE
! FOLLOWING:
!
! 1. SET THE FLAG FOR THE LEXEME STREAM
! TYPE.
!
! 2. SET THE LEXEME STREAM STRUCTURE INDEX.
! 3. SET THE INCARNATION ACTUALS CELL BLOCK
! SIZE, AND THE NUMBER OF EXPECTED
! INCARNATION ACTUALS. NOTE THAT THE
! NUMBER OF EXPECTED INCARNATION
! ACTUALS IS OBTAINED FROM THE
! STRUCTURE SYMBOL TABLE ENTRY.
BEGIN
INCACTS_0; STRSTE_.STRUDEFV;
IF .DEL EQL ERRLEX
THEN BEGIN
LOCAL STVEC STE;
MACRO FORGET(WARNTYPE) =
(WARNEM(.NSYM,WARNTYPE);
EXITBLOCK RUND(QLQNAME)) $;
IF .SYM[LTYPF] EQL UNBNDVAR
THEN SYM_.NT[.SYM,SYMLINK]
ELSE IF .SYM[LTYPF] NEQ BNDVAR
THEN FORGET(WAINVSTRUC);
STE_.SYM[ADDRF];
IF .STE[TYPEF] NEQ STRUCTURET
THEN FORGET(WASMNOTSTR)
ELSE RUND(QLQNAME);
STRSTE_.STE
END;
RETURN 0;
END;
ROUTINE MAYBEDECLARE(ERRHURTS)=
!I. GENERAL:
!
! 1. THIS ROUTINE DECLARES THE SYMBOL IN "SYM" IF IT
! SHOULD BE, (IE IF OFLAGS[MUSTDECLARE] IS ON).
!
! 2. RETURNS:
!
! A. THIS ROUTINE RETURNS A 1 IF THERE WERE
! ANY ERRORS FOUND DURING DECLARATION.
(IF .OFLAGS[MUSTDECLARE]
THEN NOT DECLARESYM(STE,.OTYPE,.ERRHURTS)
ELSE (STE_.NT[.SYM[ADDRF],SYMLINK];0));
ROUTINE STARTCOL=
!I. GENERAL:
!
! 1. THIS ROUTINE TAKES THE SYMBOL IN "SYM", DECLARES
! IT IF NECESSARY, AND PUTS IT AS THE FIRST ELEMENT
! ON THE SYMBOL TABLE LIST.
!
! 2. THIS SYMBOL TABLE LIST IS MADE SINCE WE CAN HAVE
! THINGS OF THE FORM:
!
! <NAME1>:...:<NAMEN>[<VAL1>,...,<VALM>]:...
BEGIN
IF MAYBEDECLARE(1)
THEN RETURN 1;
ST[STELAST_STELIST_GETSPACE(ST,2),STELSTEF]_.STE;
ST[.STELIST,STELCPF]_.NSYM;
RETURN 0;
END;
ROUTINE CONTIDLIST=
!I. GENERAL:
!
! 1. THIS ROUTINE SIMPLY CONTINUES DECLARING SYMBOLS
! IN "SYM".
!
! 2. WINDOW IN:
!
! A. (<NAME1> , ":" )
!
! 3. WINDOW OUT:
!
! A. (<NAME2> , ":"/"["/","/";" )
BEGIN
REGISTER SAVSTE;
RUND(QLQNAME);
IF MAYBEDECLARE(0)
THEN RETURN 1;
SAVSTE_.STELAST;
ST[.SAVSTE,STELNEXTF]_STELAST_GETSPACE(ST,2);
ST[.STELAST,STELSTEF]_.STE;
ST[.STELAST,STELCPF]_.NSYM;
RETURN 0;
END;
ROUTINE MAPONE(POS,FIRST)=
BEGIN
MAP STVEC STE;
LOCAL STEE;
IF .OTYPE EQL 0 THEN
BEGIN
IF NOT ISEXP(STE)
THEN (WARNEM(.POS,WACANTMAP);
RETURN 0);
IF .STE[BLF] EQL .BLOCKLEVEL
THEN MAPPURGE(.STE)
ELSE (SYM_LEXOUT(UNBNDVAR,.ST[STEE_.STE,NAMEPTR]);
DECLARESYM(STE,MBINDT,0);
DEFASYM(.STE,0,0,8*.DECLSIZE);
STE[BINDLEXF]_BINDBIND(LEXOUT(BNDVAR,.STEE)));
END;
STE[STRUORIACT]_
IF .INCACTS NEQ 0
THEN (IF STE[RELEASEACTS]_.FIRST
THEN INCACTS[STRUCF]_.STRSTE; .INCACTS)
ELSE (STE[HAVNOACTS]_TRUE; .STRSTE);
0
END;
ROUTINE ENDIDBATCH=
BEGIN
REGISTER TEMP;
MAP STVEC STELIST:TEMP:STE;
LOCAL FIRSTACT;
FIRSTACT_TRUE;
DO
BEGIN
STE_.STELIST[STELSTEF];
IF MAPONE(.ST[.STELIST,STELCPF],.FIRSTACT) THEN RETURN 1;
IF .OFLAGS[MUSTDECLARE]
THEN BEGIN
DEFASYM(.STE,.SIZE,0,8*.DECLSIZE);
IF (.OFUN)(.FIRSTACT,.SIZE,.STE)
THEN RETURN 1;
END;
FIRSTACT_FALSE;
END
WHILE
BEGIN
TEMP_.STELIST;
STELIST_.TEMP[STELNEXTF];
RELEASESPACE(ST,.TEMP,2);
.TEMP NEQ .STELAST
END;
RETURN 0;
END;
ROUTINE WHICHBIND=
!I. GENERAL:
!
! 1. THIS ROUTINE DETERMINES WHAT TYPE OF BIND WE MUST
! DO, AND PASSES ITS FINDINGS TO ITS CALLER AS A
! RETURN VALUE.
!
! 2. RETURNS:
!
! A. 0 - CODE MUST BE GENERATED FOR THIS
! BIND.
!
! B. 1 - THE BIND IS TO A LITERAL.
!
! C. 2 - GENERAL ADDRESS BIND, BUT NO CODE.
BEGIN
MAP LEXEME SYM;
EXPRESSION();
SYM_BINDBIND(.SYM);
IF .SYM[LTYPF] EQL GTTYP
THEN IF NOT
BEGIN ! GET RID OF <0,0> AND <0,8> BEFORE CHECKONELOCAL DOES SO
BIND STVEC STSYM=SYM;
IF .STSYM[NODEX] EQL SYNPOI
THEN IF .STSYM[OPR2] EQL ZERO
THEN IF LITVALUE(.STSYM[OPR3]) MOD 8 EQL 0
THEN BEGIN
BIND TEMP=.SYM[ADDRF];
STSYM_.STSYM[OPR1];
PDETACH(TEMP);
RELEASESPACE(GT,TEMP,BASEGTNODESIZE+3);
.SYM[LTYPF] NEQ GTTYP
END
END
THEN (DYNBIND(); RETURN 0);
IF LITRESULT THEN 1 ELSE 2
END;
ROUTINE BINDEQ=(RUND(QLLEXEME); WHICHBIND(); 0);
ROUTINE GLBINDEQ=
BEGIN
RUND(QLLEXEME);
CASE WHICHBIND() OF
SET
%0% (WARNEM(.NSYM,ERSMPLNLO); SYM_ZERO);
%1% ;
%2% (IF .SYM[LTYPF] EQL BNDVAR
THEN IF LOADCONST(SYM)
THEN EXITCASE;
WARNEM(.NSYM,ERSMPLNLO); SYM_ZERO)
TES;
0
END;
ROUTINE REGEQ=
!I. GENERAL:
!
! 1. THIS ROUTINE PROCESSES AN "=" IN A REGISTER
! DECLARATION.
!
!II. SPECIFIC:
!
! 1. *
!
! A. EVALUATE AN EXPRESSION WHOSE RESULT SHOULD
! BE A LITERAL.
!
! B. IF THE RESULT IS A LITERAL, THEN CHECK THAT
! IT IS WITHIN LIMITS FOR A REGISTER
! DECLARATION.
!
! C. IF EVERYTHING ELSE SO FAR IS OK, THEN SEE IF
! THE REGISTER IS IN USE FOR ANYTHING ELSE AT
! THIS TIME, AND IF IT IS, THEN GIVE A WARNING.
BEGIN
LOCAL SAVSYMPOS; REGISTER LTRES;
BIND LOWREG=0,
HIGHREG=5;
RUND(QLLEXEME);
LITEXP(SAVSYMPOS,.NSYM);
LTRES_LITVALUE(.SYM[ADDRF]);
IF (.LTRES GTR HIGHREG) OR (.LTRES LSS LOWREG)
THEN (WARNEM(.SAVSYMPOS,ERSMNDEC); SYM_ONE);
RETURN 0;
END;
ROUTINE DOEQL=
!I. GENERAL:
!
! 1. THIS ROUTINE HANDLES THE GENERAL CASE OF AN EQUAL
! SIGN ("=") AFTER AN IDENTIFIER IN A DECLARATION.
!
! 2. RETURNS:
!
! A. 1 - IF ANY ERRORS WERE FOUND. AN ERROR OCCURS
! IF:
!
! 1. NO EQUAL SIGN IS FOUND, AND WE
! REQUIRE ONE.
!
! 2. THE SPECIFIC ROUTINE WHICH PROCESSES
! EQUAL SIGNS FOR THE TYPE OF
! DECLARATION WE ARE NOW PROCESSING
! FINDS ANY ERRORS.
!
!II. SPECIFIC:
!
! 1. *
!
! A. IF A PROCESSING ROUTINE WAS SPECIFIED, AND
! AN EQUAL SIGN WAS FOUND (IN "SYM"), THEN
! MOVE THE WINDOW SO IT IS AT THE
! BEGILNING OF THE EXPRESSION FOLLOWING THE
! EQUAL SIGN.
!
! B. THERE ARE FOUR (4) RETURN CASES.
!
! 1. NO EQUAL SEEN, NONE REQUIRED, ALL OK.
! 2. NO EQUAL, BUT ONE IS REQUIRED,
! ERROR.
!
! 3. EQUAL SEEN, AND NOT REQUIRED. PROCESS
! IT, AND RETURN IN THE SAME STATE AS
! THE PROCESSING ROUTINE EXITED.
!
! 4. EQUAL SEEN, AND IT WAS REQUIRED.
! AGAIN PROCESS IT AND RETURN IN THE
! SAME STATE AS THE PROCESSING ROUTINE
! EXITED.
BEGIN
IF .DEL EQL HEQUAL
THEN BEGIN
OFLAGS[WASANEQUAL]_TRUE;
IF .OEQL EQL 0
THEN (WARNEM(.NDEL,WANOEQL);
RETURN INITEQ())
END
ELSE OFLAGS[WASANEQUAL]_FALSE;
RETURN CASE .OFLAGS[WASANEQUAL]*2+(.OEQL LSS 0) OF
SET
0;
BEGIN
ERROR(.LOBRAC,.NDEL,.LASTEND,ERSYMEQ);
1
END;
(.OEQL)(.SIZE);
(-.OEQL)(.SIZE)
TES;
END;
ROUTINE DOSIZE=
BEGIN
LOCAL NOBRAC, NSTART;
SIZE_.DECLSIZE;
IF .DEL EQL HCOLON THEN RETURN 0;
NSTART_.NDEL;
INCACTS_GETSPACE(ST,.STRSTE[NUMPARM]+3);
INCACTS[STKLEN]_.STRSTE[NUMPARM]+2;
IF .DEL EQL HSQBOPEN
THEN (LOCAL SAVMNACTS;
IF .OTYPE EQL LABELT
THEN WARNEM(.NDEL,LSIZERR);
SAVMNACTS_.MANYACTS; MANYACTS_0;
STRUPICKOFF(HSQBCLOSE,.INCACTS+2,.INCACTS[STKLEN]-1,ONE,TRUE);
MANYACTS_.SAVMNACTS;
NOBRAC_FALSE)
ELSE (SETCORE(INCACTS[2],.INCACTS[STKLEN]-1,ONE);
NOBRAC_TRUE);
INCACTS[1,0,36]_LITLEXEME(.DECLSIZE);
IF .STRSTE[SIZESTRM] NEQ 0
THEN BEGIN
LOCAL SAVDEL;
IF .NOBRAC THEN SAVDEL_.DEL;
ESTRU(.STRSTE[SIZESTRM],.INCACTS-1,.STRSTE,.NOBRAC);
IF .NOBRAC THEN DEL_.SAVDEL;
SYM_BINDBIND(.SYM);
IF NOT LITRESULT
THEN (WARNEM(.NSTART,ERMBADEXP); SYM_ONE);
SIZE_LITVALUE(.SYM)
END
ELSE IF NOT .NOBRAC THEN RUNDE();
RETURN 0;
END;
ROUTINE GROMLIST(GRLTYPE,GRLPARAM,GRLFUN,GRLEQL,GRLASS)=
!
!SYNTAX: <DELTYPE> <NAMESPEC1>,...,<NAMESPECN>
!
! <NAMESPEC> ::=<STRUCSPEC> <NAMSZ1>...:<NAMSZK>
! <STRUCSPEC>::=/<STRUCTURE NAME>
! <NAMSZ> ::=<NAME1>:...:<NAMEM><SIZE><EQSPEC>
! <SIZE> ::=/[<SIZE1>,...,<SIZEL>]
! <EQSPEC> ::=/ = <EXPRESSION>
!
!I. GENERAL:
!
! 1. THIS ROUTINE HANDLES THE GENERAL PROCESSING OF
! DECLARATIONS.
!
! 2. MACROS:
!
! A. CHECK(ROUTNAME) - "ROUTNAME" MUST BE THE
! NAME OF A ROUTINE WHICH RETURNS A 1
! IF ANY ERRORS WERE FOUND. THIS MACRO
! SIMPLY SERVES TO CALL THIS ROUTINE, AND
! RETURN IF ANY ERRORS WERE FOUND.
!
! B. OTHERCHECKS - THIS MACRO STARTS THE PROCESSING
! OF A FIELD FOLLOWING THE
! OPTIONAL STRUCTURE, UP TO THE
! FIRST COMMA. IT WORKS AS
! FOLLOWS. IT FIRST PROCESSES
! THE FIRST NAME IN A POSSIBLE
! STRING OF AN ARBITRARY
! NUMBER, LIKE - X:Y:Z:...
! THEN IT PROCESSES ALL OTHERS
! WHILE THE DELIMITER FOLLOWING
! EACH IS A COLON (":"), IE
! UNTIL IT COMES TO "[" OR "="
! AS IN X:Y:Z[10] OR X:Y:Z=20
! IT THEN TRIES TO PROCESS AN
! OPTIONAL SIZE FIELD, AND THEN
! AN "=" (BIND). FINALLY, IT
! CALLS "ENDIDBATCH" TO ANY
! LAST NECESSARY THINGS IN THE
! DECLARATION OF IDENTIFIERS SO
! FAR FOUND.
!
!II. SPECIFIC:
!
! 1. *
!
! A. FIRST PUT ALL PARAMETERS INTO GLOBALS FOR
! OTHER PROCESSING ROUTINES TO USE.
!
! B. TO PROCESS A FIELD OF DECLARATIONS,(IE
! BETWEEN COMMAS), WE MUST DO THE FOLLOWING
! THINGS:
!
! 1. FIRST CHECK IF THERE IS A STRUCTURE
! NAME, AND IF THERE IS, THEN DO THE
! APPROPRIATE THINGS TO SET IT UP.
!
! 2. THEN WE MUST SEE IF THERE ARE BINDS,
! ETC FOR A LIST OF IDENTIFIERS WHICH
! WE PROCESS NOW.SINCE THE FOLLOWING
! IS LEGAL, WE MUST DO THESE
! INSIDE STEPS AN ARBITRARY NUMBER OF
! TIMES:
!
! X:Z:T[100]:P:R[29,4]:D:C
!
! HERE WE SEE THAT THERE ARE 3
! DECOMPOSABLE UNITS WHICH SHOULD
! BE TREATED THE SAME, THEY ARE:
!
! X:Z:T[100]
! P:R[29,4]
! D:C
!
! C. KEEP DOING PART [1.B] UNTIL
! THERE ARE NO MORE COMMAS.
!
! D. THE LAST DELIMITER SHOULD BE ";", AND THERE
! IS AN ERROR IF IT IS NOT.
BEGIN
MACRO CHECK(ROUTNAME)=(IF ROUTNAME() THEN RETURN)$,
OTHERCHECKS=(CHECK(STARTCOL);
WHILE .DEL EQL HCOLON
DO CHECK(CONTIDLIST);
CHECK(DOSIZE);
CHECK(DOEQL);
CHECK(ENDIDBATCH))$,
NAMEPROC=(CHECK(STARTLNKG);CHECK(STARTNAME);
DO OTHERCHECKS
WHILE IF .DEL EQL HCOLON THEN (RUND(QLQNAME);1))$;
LOCAL SAVTYPE,SAVPARM,SAVFUN,SAVEQL,SAVFLAGS;
LOBRAC_.NDEL;
SAVTYPE_.OTYPE;
SAVPARM_.OPAR;
SAVFUN_.OFUN;
SAVEQL_.OEQL;
SAVFLAGS_.OFLAGS;
OTYPE_.GRLTYPE;
OPAR_.GRLPARAM;
OFUN_.GRLFUN;
OEQL_.GRLEQL;
OFLAGS[MUSTDECLARE]_.GRLTYPE NEQ 0;
DO (RUND(QLQNAME); NAMEPROC) WHILE .DEL EQL HCOMMA;
OTYPE_.SAVTYPE;
OPAR_.SAVPARM;
OFUN_.SAVFUN;
OEQL_.SAVEQL;
OFLAGS_.SAVFLAGS;
END;
ROUTINE PGLOBAL(FIRST,SIZE,STE)=DEFGLO(.STE,.OFLAGS[WASANEQUAL],.FIRST,.SYM);
ROUTINE POWN(FIRST,SIZE,STE)=
BEGIN MAP STVEC STE;
DEFOG(NEXTOWN,.STE,.OFLAGS[WASANEQUAL],.FIRST,.SYM);
STE[MODE]_ABSOLUTE;
END;
ROUTINE PSTACKLOCAL(IGP,PGSIZE,PGSTE)=
BEGIN MAP STVEC PGSTE;
ALLIGN(NEXTLOCAL,BYTES(PGSTE));
NEXTLOCAL_.NEXTLOCAL+.STE[NCONTIGLOC];
STE[OFFSETF]_-.NEXTLOCAL;
PGSTE[REGF]_SP;
PGSTE[MODE]_INDEXED;
PGSTE[NOUPLEVEL]_TRUE;
INITSYMLSTS(.PGSTE);
0
END;
ROUTINE PLOCAL(IGP,PGSIZE,PGSTE)=
BEGIN MAP STVEC PGSTE;
IF .PGSIZE EQL 2
THEN BEGIN
LOCAL GTVEC TN;
TN_PGSTE[REGF]_GETTN();
TNDECREQD(.TN);
TN[LDF]_.LOOPDEPTH;
PGSTE[MODE]_GENREG;
PGSTE[NOUPLEVEL]_TRUE;
INITSYMLSTS(.PGSTE);
END
ELSE PSTACKLOCAL(.IGP,.PGSIZE,.PGSTE);
0
END;
GLOBAL ROUTINE PEXTERNAL(IGPARAM,IGSIZE,PESTE)=
!I. GENERAL:
!
! 1. THIS ROUTINE HANDLES THE SPECIFIC PROCESSING FOR
! THE EXTERNAL DECLARATION.
!
!II. SPECIFIC:
!
! 1. *
!
! A. SIMPLY SET THE ADDITIONAL INFORMATION WORD
! TO A UNIQUE NUMBER REPRESENTING THE EXTERNAL
! TYPE FOR LATER PROCESSING BY THE LOADER
! INTERFACE.
BEGIN
MAP STVEC PESTE;
% BIND EXTERNALADDR=#777777; %
PESTE[REGF]_PC;
PESTE[OFFSETF]_0;
PESTE[MODE]_ABSOLUTE;
% PESTE[ADDRESSF]_EXTERNALADDR; %
INITSYMLSTS(.PESTE);
RETURN 0;
END;
ROUTINE PLABEL(PARAM,PLSIZE,PLSTE)= NOVALUE;
ROUTINE PREGISTER(IGPARAM,PRSIZE,PRSTE)=
!I. GENERAL:
!
! 1. THIS ROUTINE PERFORMS THE FUNCTIONS UNIQUE TO
! REGISTER DECLARATIONS.
!
!II. SPECIFIC:
!
! 1. *
!
! A. IF THERE WAS AN EQUAL SIGN, THEN THE
! REGISTER IS DECLARED AS AN ABSOLUTE
! TYPE.
!
! B. OTHERWISE, WE ACQUIRE THE REGISTER, INSERT
! IT INTO THE LITERAL TABLE, AND SET THE
! ADDITIONAL INFORMATION FIELD TO THIS
! LITERAL TABLE INDEX.
BEGIN
MAP STVEC PRSTE;
LOCAL GTVEC TN;
TN_PRSTE[REGF]_GETTN();
PRSTE[MODE]_GENREG;
PRSTE[NOUPLEVEL]_TRUE;
IF .OFLAGS[WASANEQUAL]
THEN (BIND NUM=LITVALUE(.SYM);
TNSRREQD(.TN,NUM);
IF .RESERVED[NUM,1]
THEN PRSTE[NOUPLEVEL]_FALSE)
ELSE TNARREQD(.TN);
TN[LDF]_.LOOPDEPTH;
INITSYMLSTS(.PRSTE);
RETURN 0;
END;
ROUTINE PBIND(PARM,SIZE,STENTRY)=
BEGIN
MAP STVEC STENTRY;
STENTRY[BINDLEXF]_.SYM;
STENTRY[NOUPLEVEL]_
CASE .SYM[LTYPF] OF
SET
% 0 % ;
% LITTYP % FALSE;
% BNDVAR % .ST[.SYM,NOUPLEVEL];
% GTTYP % TRUE
TES;
END;
ROUTINE PGLOBBIND(PARM,SIZE,STENTRY)=
BEGIN
MAP STVEC STENTRY;
STENTRY[BINDLEXF]_.SYM;
STENTRY[GLBIND]_TRUE;
END;
GLOBAL ROUTINE PROCPARMS(RNAME)=
BEGIN
MAP STVEC RNAME;
MACRO ISTRAPTYPE=
ONEOF(.LNKT,BIT4(EMTLNKGT,INTRRPTLNKGT,TRAPLNKGT,IOTLNKGT))$;
MACRO OLDPCPS=
IF ISTRAPTYPE THEN
BEGIN
BIND PCPS=PLIT ('OLDPC','OLDPS');
LOCAL SACC[2],SSYM;
SACC_.ACCUM;
SACC[1]_.ACCUM[1];
SSYM_.SYM;
DECR I FROM 1 TO 0 DO
BEGIN
ACCUM_.PCPS[.I]; ACCUM[1]_-2;
SYM_FASTLEXOUT(UNBNDVAR,SEARCH(UNDECTYPE));
DECLARESYM(FORMAL,FORMALT,0);
NP_.NP+1;
DEFASYM(.FORMAL,2,0,16);
FORMAL[STRUORIACT]_.STRUDEFV;
FORMAL[HAVNOACTS]_1;
FORMAL[OFFSETF]_.LSF;
LSF_.FORMAL;
FORMAL[REGF]_SP;
FORMAL[MODE]_INDEXED;
END;
SYM_.SSYM;
ACCUM[1]_.SACC[1]; ACCUM_.SACC;
-2
END ELSE 0$;
MACRO NEXTFORMDESC=
IF (FNO_.FNO+1) GTR .LNKG[LNKGSIZEF]
THEN FT_STACKPARM
ELSE (FT_.LNKG[PARMTYPE(.FNO)];
FL_.LNKG[PARMLOC(.FNO)])$;
REGISTER STVEC T:LNKG:FORMAL,LNKT;
LOCAL FT,FL,FNO,LSF,NP;
EXTERNAL LIFOENTER; ! FROM LSTPKG
NP_LSF_FNO_0;
LNKG_.RNAME[LNKGNMF];
LNKT_.LNKG[LNKGTF];
LNKG_.LNKG[LNKGDESCF];
RNAME[REGFORMLST]_MAKHDR(0,LIFOENTER);
IF .DEL EQL HPARAOPEN
THEN BEGIN
WHILE .DEL NEQ HPARACLOSE DO
BEGIN
RUND(QLQNAME);
IF NOT DECLARESYM(FORMAL,FORMALT,0)
THEN EXITCOMPOUND;
NP_.NP+1;
DEFASYM(.FORMAL,2,0,16);
FORMAL[STRUORIACT]_.STRUDEFV;
FORMAL[HAVNOACTS]_1;
NEXTFORMDESC;
CASE .FT OF
SET
! 0: STACK
BEGIN
FORMAL[OFFSETF]_.LSF;
LSF_.FORMAL;
FORMAL[REGF]_SP;
FORMAL[MODE]_INDEXED
END;
! 1: REGISTER
BEGIN
FORMAL[MODE]_GENREG;
FORMAL[SREGF]_.FL;
T_FORMAL[REGF]_GETTN();
T[LDF]_.LOOPDEPTH;
T[LONFU]_T[LONLU]_T[FONFU]_T[FONLU]_1; ! SPAN MUST START AT 1
ENLST(.RNAME[REGFORMLST],MAKITEM(.FL^18+.FORMAL<ADDRF>,1))
END;
! 2: (LITERAL) MEMORY
BEGIN
FORMAL[TYPEF]_MBINDT;
FORMAL[BINDLEXF]_LITLEXEME(.FL)
END;
! 3: (NAMED) MEMORY
BEGIN
FORMAL[TYPEF]_MBINDT;
FORMAL[BINDLEXF]_LEXOUT(BNDVAR,.FL)
END
TES;
FORMAL[NOUPLEVEL]_TRUE;
IF .DEL NEQ HPARACLOSE AND .DEL NEQ HCOMMA
THEN (ERROR(.LOBRAC,.NDEL,.LASTEND,DCLDELERR); RETURN 0);
INITSYMLSTS(.FORMAL);
END;
END;
FNO_OLDPCPS;
WHILE .LSF NEQ 0 DO
BEGIN
FORMAL_.LSF;
LSF_.FORMAL[OFFSETF];
FORMAL[OFFSETF]_FNO_.FNO+2;
IF ONEOF(.LNKT,BIT2(HBLISLNKGT,IHBLISLNKGT))
THEN FORMAL[OFFSETF]_.FORMAL[OFFSETF]+8;
END;
RNAME[RNPARMSF]_.NP;
IF .DEL EQL HPARACLOSE THEN RUNDE();
RETURN 1
END;
ROUTINE GLOBROUT=
DO
BEGIN
LOCAL STVEC SENTRY:LNKGNM;
RUND(QLQNAME);
GETLNKG(LNKGNM);
CKFORWD(GROUTINET);
DEFMAP(.SENTRY);
SENTRY[LNKGNMF]_.LNKGNM;
SENTRY[REGF]_PC;
SENTRY[MODE]_ABSOLUTE;
RNAMEFOLLOWS(.SENTRY);
END
WHILE .DEL EQL HCOMMA;
! GENERAL DECLARATION ROUTINES
! ----------------------------
!
!SYNTAX: <DELTYPE> <NAMESPEC1>,...,<NAMESPECN>
!
! <NAMESPEC> ::=<STRUCSPEC> <NAMSZ1>...:<NAMSZK>
! <STRUCSPEC>::=/<STRUCTURE NAME>
! <NAMSZ> ::=<NAME1>:...:<NAMEM><SIZE><EQSPEC>
! <SIZE> ::=/[<SIZE1>,...,<SIZEL>]
! <EQSPEC> ::=/ = <EXPRESSION>
!
!I. GENERAL:
!
! 1. THE FOLLOWING SEVEN(7) ROUTINES, (SLOCAL,
! SOWN,SGLOBAL,SEXTERNAL,SREGISTER,SBIND,SMAP), ARE ALL
! ROUTINES WHICH DECLARE THE LIST OF IDENTIFIERS
! AS THE TYPE WHICH THEIR NAME IMPLIES.
!
! 2. THEY ARE ALL OF THE SAME FORM, IE THEY ALL CALL
! "GROMLIST" WITH THE FOLLOWING PARAMETERS:
!
! A. #1 - TYPE WHICH SYMBOLS SHOULD BE DECLARED
! AS. NOTE THAT "MAP" HAS NO TYPE
! ASSOCIATED WITH IT.
!
! B. #2 - A POINTER TO A VARIABLE WHICH CONTAINS
! THE TOTAL NUMBER OF VARIABLES OF THAT
! TYPE DECLARED SO FAR. FOR LOCALS, ONLY
! THE DIFFERENCE BETWEEN THAT NUMBER ON
! ENTRANCE AND EXIT OF A BLOCK IS OF
! INTEREST, BU FOR OWNS AND GLOBALS,
! THE TOTAL NUMBER IS NECESSARY, SINCE
! THATS HOW MUCH SPACE SHOULD BE ALLOCATED.
!
! C. #3 - NAME OF A ROUTINE TO HANDLE THE
! PECULIARITIES DUE TO A SPECIFIC
! TYPE OF DECLARATION.
!
! D. #4 - ROUTINE TO HANDLE AN EQUAL SIGN ("=")
! FOLLOWING A NAME (TO BE BOUND).
!
! E. #5 - ROUTINE TO HANDLE "_" AFTER A NAME.
ROUTINE SLOCAL=GROMLIST(LOCALT,0,PLOCAL,0,0);
ROUTINE SSTACKLOCAL=GROMLIST(LOCALT,0,PSTACKLOCAL,0,0);
ROUTINE SOWN=GROMLIST(OWNT,0,POWN,OWNEQ,0);
ROUTINE SGLOBAL=(RUND(QLQNAME);
IF .SYM EQL HEMPTY
THEN SELECT .DEL[HSYNTYP] OF
NSET
DCLROU: RETURN GLOBROUT();
DCLBIN: RETURN SGLOBBIND();
TESN;
PEEKBIT_TRUE;
GROMLIST(GLOBALT,0,PGLOBAL,GLOBALEQ,0));
ROUTINE SEXTERNAL=GROMLIST(EXTERNALT,0,PEXTERNAL,0,0);
ROUTINE SDCLLABEL=GROMLIST(LABELT,0,PLABEL,0,0);
ROUTINE SREGISTER= GROMLIST(REGT,0,PREGISTER,REGEQ,0) ;
ROUTINE SGLOBBIND=GROMLIST(MBINDT,0,PGLOBBIND,-GLBINDEQ<0,0>,0);
ROUTINE SBIND=GROMLIST(MBINDT,0,PBIND,-BINDEQ<0,0>,0);
ROUTINE SROUTINE=
DO
BEGIN
LOCAL STVEC SENTRY:LNKGNM;
RUND(QLQNAME);
GETLNKG(LNKGNM);
CKFORWD(ROUTINET);
DEFMAP(.SENTRY);
SENTRY[LNKGNMF] _ .LNKGNM;
SENTRY[REGF]_PC;
SENTRY[MODE]_IF .PICSW THEN RELATIVE ELSE ABSOLUTE;
RNAMEFOLLOWS(.SENTRY);
END
WHILE .DEL EQL HCOMMA;
ROUTINE SMAP=GROMLIST(0,0,0,0,0);
ROUTINE SSETSIZE(N)=
BEGIN
DECLSIZE_.N; RUND(QLLEXEME);
IF .SYM NEQ HEMPTY THEN RETURN ERROR(.LOBRAC,.NSYM,.LASTEND,DECLSYMERR);
IF .DEL[HCLASS] NEQ DCLRTR
THEN RETURN ERROR(.LOBRAC,.NDEL,.LASTEND,ERRBYTEFOL);
SXCTDECL;
DECLSIZE_2;
END;
ROUTINE SBYTE=SSETSIZE(1);
ROUTINE SWORD=SSETSIZE(2);
GLOBAL ROUTINE INCRDECRREG=
!I. GENERAL:
!
! 1. THIS ROUTINE IS USED TO DECLARE A REGISTER FOR THE
! INDEX OF AN "INCR" OR "DECR" LOOP EXPRESSION.
!
!II. SPECIFIC:
!
! 1. *
!
! A. OPEN A NEW BLOCK.
!
! B. SET DECLARATION FLAGS.
!
! C. DECLARE THE REGISTER, AND RETURN IF
! THERE ARE ANY ERRORS.
!
! D. DO THINGS UNIQUE TO REGISTER DECLARATION.
BEGIN
LOCAL STVEC REGSTE;
BLOCKLEVEL_.BLOCKLEVEL+1;
OFLAGS_0;
OFLAGS[MUSTDECLARE]_1;
RUND(QLQNAME);
IF NOT DECLARESYM(REGSTE,LOCALT,1)
THEN RETURN 0;
PLOCAL(0,2,.REGSTE);
REGSTE[POSF]_0;
REGSTE[SIZEF]_16;
RETURN 1;
END;
ROUTINE SSWITCHES=
BEGIN
LOCAL LOBRAC;
LOBRAC_.NDEL;
SWITCHER(SWSWL);
DELERR(NEQ HSEMICOLON,DCLDELERR);
END;
GLOBAL ROUTINE DOMODULE=
BEGIN
MAP NTVEC SYM;
EXTERNAL FLOWINIT;
ROUTINE DCLMODNAME =
!
! DECLARE MODULE NAME AS A GLOBAL ROUTINE.
! A CALL ON THIS MUST BE PAIRED, OF COURSE, WITH
! A LATER CALL ON BLOCKPURGE.
!
BEGIN
LOCAL NTVEC NAME;
BLOCKLEVEL_.BLOCKLEVEL+1;
ACCUM[0]_.MODNAME[0]; ACCUM[1]_.MODNAME[1];
NAME_SEARCH(UNDECTYPE);
STE_STINSERT(.NAME,GROUTINET,0);
LNKGLX_.DFLTLNKGLX;
DEFASYM(.STE,2,0,16);
DEFGLO(.STE,FALSE,0,0);
NOVALUE
END;
FLOWINIT();
IF .DEL EQL HMODULE
THEN
BEGIN
IF .SYM NEQ HEMPTY THEN %%%%%%;
RUND(QLQNAME);
IF .SYM NEQ HEMPTY THEN (MODNAME[0]_.SYM[ACCUM1];
MODNAME[1]_.SYM[ACCUM2];
CSNAME_.MODNAME; CSFLAG_-1;
SYM_HEMPTY);
IF .DEL EQL HPARAOPEN THEN
BEGIN
SWITCHER(ALLSW);
IF .DEL NEQ HPARACLOSE THEN EXITCOMPOUND;
RUND(QLLEXEME);
END;
IF .DEL NEQ HEQUAL OR .SYM NEQ HEMPTY
THEN BEGIN
UNTIL .DEL EQL HBEGIN DO RUND(QLLEXEME);
WARNEM(.NDEL,WABADMOD);
END
ELSE RUND(QLLEXEME);
DCLMODNAME();
EXPRESSION();
IF .DEL NEQ HELUDOM THEN WARNEM(0,WAMODDOM);
BLOCKPURGE();
END
ELSE
(EXPRESSION();
IF .DEL EQL HELUDOM THEN WARNEM(.NDEL,WAMODDOM));
GETNCSE();
NOVALUE
END;
ROUTINE GETCONS=
BEGIN
IF .DEL EQL HPARACLOSE
THEN SYM_ZERO
ELSE (RUND(QLLEXEME);
IF .SYM EQL HEMPTY THEN SYM_ZERO);
.SYM[LTYPF] EQL LITTYP
AND (.DEL EQL HCOMMA OR .DEL EQL HPARACLOSE)
END;
ROUTINE GETSTRING=
BEGIN
RUND(QLLSLEX);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
(.SYM[LTYPF] EQL LSLEXTYP OR .SYM[LTYPF] EQL LITTYP)
AND (.DEL EQL HCOMMA OR .DEL EQL HPARACLOSE)
END;
ROUTINE SWITCHER(HIGH)=
!I. GENERAL
!
! 1. THIS ROUTINE IS USED TO PROCESS A LIST OF SWITCHES
! SEPARATED BY COMMAS.
!
! 2. THE PARAMETER IS THE INDEX INTO THE PLIT SWTBL
! OF THE LAST SWITCH WHICH IS CONSIDERED VALID IN
! THE CURRENT CONTEXT.
BEGIN
MACRO SYCHK(X)=IF X THEN WARNEM(.LOBRAC,WASWSYN)$;
MAP NTVEC SYM;
LOCAL LOBRAC;
REGISTER X;
LOBRAC_.NDEL;
DO
BEGIN
RUND(QLQNAME); !SWITCH NAME NOW IN SYM
X_.SYM[ACCUM1];
X_INCR I FROM 0 TO .HIGH DO IF .X EQL .SWTBL[.I] THEN EXITLOOP .I;
CASE 1+.X OF
SET
WARNEM(.LOBRAC,WASWNONX); !WARNING, NOT FOUND
EMFLG_1; ! EXPAND MACRO
EMFLG_0; ! DON'T EXPAND MACRO
LSTFLG_0; ! LIST
LSTFLG_1; ! NO LIST
ERRBIT_0; ! ERR MSGS TO TTY
ERRBIT_1; ! NO ERR MSGS TO TTY
MLFLG_1; ! MACH LIST
MLFLG_0; ! NO MACH LIST
NPTFLG_0; ! OPTIMIZE
NPTFLG_1; ! NO-OPTIMIZE
UNAMESW_1; ! GENERATE UNIQUE NAMES
UNAMESW_0; ! DO NOT GENERATE UNIQUE NAMES
FINALSW_1; ! DO FINAL PEEPHOLE OPTIMIZATION
FINALSW_0; ! DO NOT DO FINAL PEEPHOLE OPTIMIZATION
MRKFLG_0; ! TURN ON UNCERTAIN OPTIMIZATIONS
MRKFLG_1; ! TURN OFF " "
ZIPSW_1; ! CHOOSE SPEED OVER TIME
ZIPSW_0; ! CHOOSE TIME OVER SPEED
DEBFLG_1; ! GENERATE SIX12 SYMBOL & NAME TABLES
DEBFLG_0; ! DO NOT DO ABOVE
PICSW_1; ! POSITION INDEPENDENT CODE
PICSW_0; ! NO POSITION INDEPENDENT CODE
SEGSW_1; ! NO DATA ALLOWED IN CODE CSECT
SEGSW_0; ! DATA (CASE STMT. TABLES, OFFSET
! FOR $ENABL) ALLOWED IN CODE CSECT
SYCHK(SSTART()); ! STARTING ADDRESS DECLARATION
SSTACK(DEFAULTSSTK); ! STACK DECLARATION
SYCHK(SMAIN()); ! MAIN DECLARATION
SYCHK(SRESERVE()); ! RESERVE SPECIFIC REGS.
SYCHK(SIDENT()); ! IDENT
NOTREE_-1 ! SYNTAX CHECK ONLY
TES;
END
UNTIL .DEL NEQ HCOMMA;
0 END;
ROUTINE SIDENT=
BEGIN
IF .DEL NEQ HEQUAL THEN RETURN 1;
IF GETSTRING() THEN (IDENTLEX_.SYM;IDENTFLG_1;RETURN 0);
RETURN 1
END;
ROUTINE SSTACK(X)=
BEGIN
MODMAIN[0]_.MODNAME[0];
MODMAIN[1]_.MODNAME[1];
SSTKLEN_.X;
MAINDECL_TRUE;
END;
ROUTINE SMAIN=
BEGIN
SSTACK(0);
IF .DEL EQL HCOMMA OR .DEL EQL HPARACLOSE THEN RETURN 0;
IF .DEL NEQ HPARAOPEN THEN RETURN 1;
IF NOT GETCONS() THEN RETURN 1;
SSTKLEN_LITVALUE(.SYM[ADDRF]);
IF .DEL NEQ HPARACLOSE THEN RETURN 1;
RUND(QLLEXEME);
IF .SYM NEQ HEMPTY THEN RETURN 1;
RETURN 0;
END;
ROUTINE SSTART=
BEGIN
BIND STVEC STSYM=SYM;
IF .DEL NEQ HEQUAL THEN RETURN 1;
RUND(QLQNAME);
IF .SYM[LTYPF] NEQ UNBNDVAR
OR (.DEL NEQ HCOMMA AND .DEL NEQ HPARACLOSE)
THEN RETURN 1;
MODMAIN[0]_.STSYM[ACCUM1];
MODMAIN[1]_.STSYM[ACCUM2];
RETURN 0;
END;
ROUTINE SRESERVE=
BEGIN
LABEL NEXT;
IF .DEL NEQ HPARAOPEN THEN RETURN 1;
DO NEXT:BEGIN
IF NOT GETCONS() THEN RETURN 1;
SYM_EXTEND(LITVALUE(.SYM));
IF .SYM LSS 1 OR .SYM GTR 5
THEN (WARNEM(.NSYM,WACANTRES); LEAVE NEXT);
RESERVED[.SYM,1]_TRUE
END
UNTIL .DEL NEQ HCOMMA;
RUND(QLLEXEME);
IF .SYM NEQ HEMPTY THEN RETURN 1;
RETURN 0
END;
ROUTINE PPARAM(TYP,INITOFF,RBRACK)=
BEGIN
LOCAL STVEC PARAM, OFFST;
OFFST_.INITOFF;
RUND(QLQNAME);
IF .SYM EQL HEMPTY AND .DEL EQL .RBRACK THEN (RUNDE(); RETURN 0);
DO (IF DECLARESYM(PARAM,.TYP,0)
THEN (PARAM[WHICHF]_.OFFST; OFFST_.OFFST+1))
WHILE (IF .DEL EQL HCOMMA THEN (RUND(QLQNAME); 1));
DELERR(NEQ .RBRACK,ERSMSQBCLOSE);
RUNDE();
.OFFST-.INITOFF
END;
ROUTINE SSTRUCTURE=
DO
BEGIN
LOCAL SAVENME;
RUND(QLQNAME);
SAVENME_.SYM[ADDRF];
IF NOT DECLARESYM(STRUDEF,STRUCTURET,1) THEN RETURN;
IF .SAVENME EQL .STRUDVNME THEN STRUDEFV_.STRUDEF;
BLOCKLEVEL_.BLOCKLEVEL+1;
IF NOT .STRUCP THEN STRUCLEVEL_.BLOCKLEVEL;
NINP_STRUDEF[NUMPARM]_IF .DEL EQL HSQBOPEN THEN
PPARAM(STRUFT,3,HSQBCLOSE);
DELERR(NEQ HEQUAL, ERMEQ);
RUND(QLLEXEME);
STRUDEF[SIZESTRM]_
IF .SYM EQL HEMPTY AND .DEL EQL HSQBOPEN
THEN
BEGIN
LOCAL STREAM;
RUND(QLLEXEME);
STREAM_STRUSC(1);
DELERR(NEQ HSQBCLOSE, ERSMSQBCLOSE);
DEL_HEQUAL; !HIDE THE SPECIAL USE OF [] FROM LEXAN
RUND(QLLEXEME);
.STREAM
END;
STRUDEF[BODYSTRM]_STRUSC(0);
IF NOT .STRUCP THEN STRUCLEVEL_#777777;
IF .DEL EQL HCOMMA THEN FSYMPROTECT();
BLOCKPURGE()
END
WHILE .DEL EQL HCOMMA;
ROUTINE SMACRO=
DO
BEGIN
LOCAL SUBTYP, QUIT, SAVCOPY;
MACRO CHKPL(LB,RB,DEF,INITOFF,ZER,NONZER)=
IF .DEL EQL LB THEN SUBTYP_.SUBTYP+
(IF (DEF_PPARAM(MACRFT,INITOFF,RB)) EQL 0 THEN ZER ELSE NONZER)$;
RUND(QLQNAME);
IF NOT DECLARESYM(MACRDEF,MACROT,1) THEN RETURN;
BLOCKLEVEL_.BLOCKLEVEL+1;
MACRDEF[NUMFIXED]_MACRDEF[NUMITED]_SUBTYP_0;
CHKPL(HPARAOPEN,HPARACLOSE,MACRDEF[NUMFIXED],1,0,MACRFIND);
CHKPL(HSQBOPEN,HSQBCLOSE,MACRDEF[NUMITED],.MACRDEF[NUMFIXED]+1,MACRRIND,MACRIIND);
BLOCKLEVEL_.BLOCKLEVEL-1;
MACRDEF[SUBTYPEM]_.SUBTYP;
DELERR(NEQ HEQUAL, ERMEQ);
% SEE ALSO STRUSC AND STRUCOPY %
SAVCOPY_.MACRCP;
MACRCP_TRUE;
SCANTYPE_"M";
SCANCHANGE_.NDEL;
QUIT_FALSE;
UNTIL .QUIT DO
BEGIN
RUND(QLMACR);
UNLESSQUOTED(SYM)
IF .SYM[LTYPF] EQL UNBNDVAR
THEN IF .ST[.NT[.SYM[ADDRF],SYMLINK],TYPEF] EQL MACRFT
THEN (SYM[LTYPF]_CLMACRF;
SYM[ADDRF]_.ST[.NT[.SYM[ADDRF],SYMLINK],WHICHF]);
UNLESSQUOTED(DEL)
IF .DEL EQL "$" THEN
IF .SYM EQL HEMPTY THEN EXITLOOP ELSE (DEL_0; QUIT_TRUE);
STRMAPPEND(WSTBUF,WSTMAX-1)_FORMWINDOW(.SYM,.DEL)
END;
MACRDEF[STREAMF]_STRMQUIT(WSTBUF);
BLOCKLEVEL_.BLOCKLEVEL+1;
BLOCKPURGE();
SCANTYPE_" ";
MACRCP_.SAVCOPY;
IF RUNDE() THEN RETURN;
END
WHILE .DEL EQL HCOMMA;
MACRO RUNSC=UNTIL .DEL EQL HSEMICOLON DO RUND(QLLEXEME)$,
KWCHK=IF NOT GETSTRING2() THEN(WARNEM(.LOBRAC,WBADCSECT);RUNSC;RETURN)$;
ROUTINE GETSTRING2=
BEGIN
RUND(QLLSLEX);
IF .SYM EQL HEMPTY THEN SYM_ZERO;
(.SYM[LTYPF] EQL LSLEXTYP OR .SYM[LTYPF] EQL LITTYP) AND
(.DEL EQL HCOMMA OR .DEL EQL HSEMICOLON)
END;
ROUTINE SCSECT=
BEGIN
MAP STVEC SYM;
LOCAL X,Y,Z,FLG,LOBRAC;
LOBRAC_.NDEL;
Y_0;
IF .DEL EQL HCSECT THEN FLG_1 ELSE FLG_2;
DO
BEGIN
RUND(QLQNAME);
Y_.Y+1;
IF .SYM EQL HEMPTY
THEN (Z_SELECT .DEL OF
NSET
HOWN : BS(3,OWN);
HGLOBAL : BL(GLOBA);
HPLIT : BS(4,PLIT);
OTHERWISE : 0
TESN;
RUND(QLLEXEME);
IF .DEL NEQ HEQUAL THEN (WARNEM(.LOBRAC,WBADCSECT);RUNSC;RETURN))
ELSE Z_.SYM[ACCUM1];
X_INCR I FROM 0 TO .KWTBL[-1]-1 DO
IF .Z EQL .KWTBL[.I] THEN EXITLOOP .I;
IF .X LSS 0 THEN
BEGIN
IF (.DEL EQL HSEMICOLON) AND (.Y EQL 1)
THEN (CSNAME_.Z;
CSFLG_.FLG;
CSFLAG_-1)
ELSE (WARNEM(.LOBRAC,WBADCSECT);
RUNSC; RETURN)
END
ELSE
BEGIN
BIND FLGPLIT=PLIT(CSCFLG,CSDFLG,CSGFLG,CSOFLG,CSPFLG),
NAMEPLIT=PLIT(CSCNAME,CSDNAME,CSGNAME,CSONAME,CSPNAME);
KWCHK;
.FLGPLIT[.X]_.FLG;
.NAMEPLIT[.X]_.SYM
END;
END
UNTIL .DEL NEQ HCOMMA;
0
END;
ROUTINE SLNKGDECL=
BEGIN
BIND NP=30;
STRUCTURE V1[I]=(.V1+.I-1)<0,36>;
LOCAL STVEC S:LP, V1 P[NP], N,LT;
MACRO RERR(EN)=RETURN ERROR(.LOBRAC,.NSYM,.LASTEND,(EN))$;
MACRO RERRD(EN)=EXITLOOP ERROR(.LOBRAC,.NSYM,PSPAR,(EN))$;
BIND STVEC SYMST=SYM;
DO BEGIN
LOCAL SAVENME;
N_0; RUND(QLQNAME);
SAVENME_.SYM[ADDRF];
IF NOT DECLARESYM(S,LNKGNMT,1) THEN RETURN;
IF .DEL NEQ HEQUAL THEN RERR(LNKGNOEQUAL);
RUND(QLLEXEME);
IF .SYM[LTYPF] NEQ BNDVAR THEN RERR(LNKGNOTYP) ELSE
IF .SYMST[TYPEF] NEQ LNKGNMT THEN RERR(LNKGNOTYP) ELSE
LT_.SYMST[LNKGTF];
IF .SAVENME EQL .ST[.DFLTLNKGLX,NAMEPTR]
THEN DFLTLNKGLX_LEXOUT(BNDVAR,.S);
IF .DEL EQL HPARAOPEN THEN
WHILE 1 DO
BEGIN
IF (N_.N+1) GTR NP THEN RERRD(LNKGTOOMANYP);
RUND(QLQNAME);
IF .SYM EQL HEMPTY THEN
BEGIN
IF .DEL NEQ HREGISTER THEN RERRD(LNKGINVPARM) ELSE
BEGIN
RUND(QLLEXEME);
IF .DEL NEQ HEQUAL THEN RERRD(LNKGNOEQUAL) ELSE
BEGIN
RUND(QLLEXEME); SYM_BINDBIND(.SYM);
IF (IF .SYM[LTYPF] NEQ LITTYP THEN 1 ELSE
IF (P[.N]_LITVALUE(.SYM)) LSS 0 THEN 1 ELSE
IF .P[.N] GTR 6 THEN 1 ELSE 0)
THEN (WARNEM(.NSYM,LNKGNOTREG); P[.N]_1);
END;
END
END ELSE
IF .SYMST[ACCUM1] EQL 'STACK' THEN P[.N]_-1 ELSE
IF .SYMST[ACCUM1] EQL 'MEMOR' %Y% THEN
BEGIN
LABEL LAB;
IF .DEL NEQ HEQUAL THEN RERRD(LNKGNOEQUAL);
RUND(QLLEXEME); EXPRESSION(); SYM_BINDBIND(.SYM);
LAB: SELECT .SYM[LTYPF] OF
NSET
LITTYP: (P[.N]_.SYM; LEAVE LAB);
BNDVAR: IF LOADCONST(SYM)
THEN (P[.N]_.SYM; LEAVE LAB);
ALWAYS: (WARNEM(.NSYM,LNKGINVPARM); P[.N]_-1)
TESN
END ELSE
RERRD(LNKGINVPARM);
IF .DEL EQL HPARACLOSE THEN EXITLOOP RUND(QLLEXEME) ELSE
IF .DEL NEQ HCOMMA THEN RERRD(LNKGINVSYNTAX);
END;
LP_GETSPACE(ST,.N+1);
LP[LNKGSIZEF]_.N;
WHILE .N GTR 0 DO
BEGIN
LP[PARMTYPE(.N)]_.P[.N]<LEFTPART>+1;
! THE ABOVE RELIES ON LITTYP BEING 1,BNDVAR BEING 2.
LP[PARMLOC(.N)]_.P[.N];
N_.N-1;
END;
S[LNKGTF]_.LT; S[LNKGDESCF]_.LP;
END
UNTIL .DEL NEQ HCOMMA;
END;
%%
% PLIT SYNTAX PROCESSING ROUTINES. THE SYNTAX FOR PLITS IS AS
FOLLOWS:
<PLIT> ::= PLIT <PLITARG>
<PLITARG> ::= <LOAD TIME EXPRESSION> !
<LONG STRING> !
<TUPLE>
<TUPLE> ::= (<TUPLE ITEM LIST>)
<TUPLE ITEM LIST> ::= <TUPLE ITEM> !
<TUPLE ITEM>,<TUPLE ITEM LIST>
<TUPLE ITEM> ::= <LOAD TIME EXPRESSION> !
<LONG STRING> !
<DUPLICATION FACTOR>:<PLITARG>
<DUPLICATION FACTOR> ::= <COMPILE TIME EXPRESSION>
[NOTE: <LOAD TIME EXPRESSION> ::= <PLIT> ! ...]
%
%%
BIND PLNEXT=NEXTGLOBAL;
GLOBAL ROUTINE SPLIT=
BEGIN
MACRO MAKENEWNAME=
(PLHEAD_.PLHEAD+2;
IF .PLHEAD<1,7> EQL "[" THEN (PLHEAD<1,7>_"A";
IF (PLHEAD<8,7>_.PLHEAD<8,7>+1) EQL "[" THEN
(PLHEAD<8,7>_"A"; PLHEAD<15,7>_.PLHEAD<15,7>+1));
ACCUM[0]_.PLHEAD; ACCUM[1]_-2)$;
LOCAL PLITLEN, STVEC STE, PLITP, ISCOUNTED;
ISCOUNTED_(.DEL EQL HPLIT);
MAKENEWNAME;
STE_.NT[SEARCH(GLOBALT),SYMLINK];
PLITLEN_SPLITB(PLITP);
DEFASYM(.STE,2*.PLITLEN,0,16);
DEFMAP(.STE);
STE[ITSAPLIT]_TRUE;
STE[COUNTED]_.ISCOUNTED;
DEFGLO(.STE,TRUE,TRUE,.PLITP);
SYM_LEXOUT(BNDVAR,.STE)
END;
GLOBAL ROUTINE SPLITB(GLOSTE) =
BEGIN
MAP STVEC GLOSTE;
LOCAL STVEC TEMPHEAD:NEXTCELL:FIRSTCELL, OFFST, SLBRAC;
SLBRAC_.PLLBRAC; PLLBRAC_.NDEL;
TEMPHEAD_GETCELL(CHTPLIT,1);
INAPLIT_TRUE;
OFFST_PLITARG(.TEMPHEAD);
INAPLIT_FALSE;
TEMPHEAD[LSLENGTH]_.OFFST;
.GLOSTE_.TEMPHEAD;
PLLBRAC_.SLBRAC;
.OFFST
END;
ROUTINE PLITARG(HEAD) =
BEGIN
RUND(QLLSLEX);
IF .SYM NEQ HEMPTY OR
(.DEL NEQ HPARAOPEN AND .DEL NEQ HCOMPOPEN)
THEN RETURN LSORLE(.HEAD);
BEGIN
LOCAL LENTH, SLBRAC, SAVEL;
NEWLASTEND(PSPARCOM);
SLBRAC_.PLLBRAC; PLLBRAC_.NDEL;
LENTH_0;
DO (RUND(QLLSLEX); LENTH_.LENTH+TUPLEITEM(.HEAD))
WHILE .DEL EQL HCOMMA;
RESLASTEND;
IF .DEL NEQ HPARACLOSE
THEN RETURN ERROR(.PLLBRAC,.NDEL,.LASTEND,ERSYPLMRP);
RUNDE();
PLLBRAC_.SLBRAC;
.LENTH
END
END;
ROUTINE TUPLEITEM(HEAD) =
BEGIN
EXPRESSION();
IF .DEL EQL HCOLON
THEN
BEGIN
LOCAL LEN, STVEC NEWHEAD;
SYM_BINDBIND(.SYM);
IF NOT LITRESULT THEN (ERROR(.PLLBRAC,.NSYM,0,ERSMPLNLI);
SYM_LITLEXEME(1));
NEWHEAD_GETCELL(CHTDUP,1);
NEWHEAD[DUPLENGTH]_LEN_LITVALUE(.SYM[ADDRF]);
PUSHBOT(.HEAD,.NEWHEAD);
.LEN*PLITARG(.NEWHEAD)
END
ELSE LSORLE(.HEAD)
END;
ROUTINE LSORLE(HEAD)=
BEGIN
IF .SYM[LTYPF] EQL LSLEXTYP
THEN
BEGIN
MAP STVEC SYM;
LEXTOP(.HEAD,.SYM);
RETURN .SYM[LSLENGTH]
END
ELSE
BEGIN
CASE WHICHBIND() OF
SET
(WARNEM(.NSYM,ERSMPLNLO); SYM_ZERO);
;
(IF .SYM[LTYPF] EQL BNDVAR
THEN IF LOADCONST(SYM)
THEN EXITCASE;
WARNEM(.NSYM,ERSMPLNLO);
SYM_ZERO)
TES;
RETURN LEXTOP(.HEAD,.SYM)
END
END;
ROUTINE LEXTOP(HEAD,LEX) =
BEGIN
LOCAL STVEC CELL;
CELL_GETCELL(CHTLEX,1);
CELL[LEXEMEF]_.SYM;
PUSHBOT(.HEAD,.CELL);
1
END;
! THESE ROUTINES HANDLE THE "REQUIRE" DECLARATION
! VERY MACHINE DEPENDENT.
ROUTINE SREQUIRE=
BEGIN
LOCAL DEVICE;
REGISTER N;
EXTERNAL SCANFOR,FILESELECT,RLS;
MACRO
FILE=BUFDATA[.CURCHN+1,FILENAMEF]$,
EXT=BUFDATA[.CURCHN+1,EXTF]$,
PPN=BUFDATA[.CURCHN+1,PPNF]$,
THISPPN=BUFDATA[.CURCHN,PPNF]$;
BIND CMUDEC=-2;
MACRO
FUTSYM=SYMPART(.FUTWINDOW)<0,36>$,
FUTDEL=DT[.FUTWINDOW[DELIND]]$,
SCANSYM=SCANFOR(1,QLQNAME)$,
SCANDEL=(SCANFOR(0,QLQNAME); DEL_.DT[.DEL])$,
LITP(X)=X[LTYPF] EQL LITTYP$,
LITV(X)=LITVALUE(X)$,
ABORT(NUM)=RETURN (RLS(.CURCHN+1); ERROR(.LOBRAC,.NDEL,PSSEM,NUM))$;
ROUTINE JRUND=(SCANDEL; SCANSYM);
ROUTINE CVSIX=
BEGIN LOCAL SYMPTR,SIXPTR,SIXSYM; REGISTER R; MACHOP ILDB=#134,IDPB=#136;
SIXSYM_0;
SYMPTR_NT[.SYM,0,36,7];
SIXPTR_SIXSYM<36,6>;
DECR I FROM 5 TO 0 DO
(ILDB(R,SYMPTR);
IF .R EQL #177 THEN EXITLOOP;
IF .R LEQ #132 THEN R_.R-#40;
IDPB(R,SIXPTR) );
.SIXSYM
END;
EXTERNAL SKAN1;
FILE_EXT_PPN_0;
SCANSYM;
DEVICE_IF .FUTDEL EQL HCOLON THEN (N_CVSIX(); JRUND(); .N) ELSE SIXBIT 'DSK ';
IF NOT (N_REQUINIT(.DEVICE)) THEN RETURN
ERROR(.LOBRAC,.NDEL,PSSEM,(IF .N EQL 0
THEN ERREQDEV
ELSE ERREQNEST));
FILE_CVSIX();
IF .FUTDEL EQL HDOT THEN (JRUND(); EXT_(CVSIX())^(-18));
IF .FUTDEL EQL HSQBOPEN
THEN
BEGIN
JRUND();
IF .FUTDEL EQL HSQBCLOSE
THEN (IF .SYM EQL HEMPTY THEN (PPN_.THISPPN; SYM_ZERO))
ELSE
IF .FUTDEL EQL HCOMMA THEN
(IF NOT LITP(.SYM) THEN ABORT(ERREQDPPN);
PPN<18,18>_LITV(.SYM);
JRUND());
IF .FUTDEL NEQ HSQBCLOSE THEN ABORT(ERREQDPPN);
IF LITP(.SYM) THEN (IF (PPN_.PPN OR LITV(.SYM)) EQL 0 THEN PPN_.THISPPN)
ELSE
BEGIN
N<RIGHTPART>_NT[.SYM,0,0,0];
N<LEFTPART>_PPN<0,0>;
IF NOT SKIP(CALLI(N,CMUDEC)) THEN ABORT(ERREQCPPN);
END;
JRUND()
END;
IF NOT LKUP(.CURCHN+1) THEN ABORT(ERREQFIND);
CURCHN_.CURCHN+1;
SKAN1(); !FORCE EOL AND GET NEW LINE FROM REQUIRED FILE
SEQNUM_' '; ! BLANK OUT SEQNUM FIELD FOR NEW FILE
SCANDEL
END; !OF SREQUIRE
ROUTINE REQUINIT(DEVICE)=
BEGIN
REGISTER N;
EXTERNAL OPN;
MACRO
DEVCHR=4$,
INPUTF=19,1$,
ASCIIMF=0,1$,
STATUS=OPENBLOCK[0]$,
ODEV=OPENBLOCK[1]$,
BUFW=OPENBLOCK[2]$;
N_.DEVICE;
CALLI(N,DEVCHR);
IF .N EQL 0 THEN RETURN 0;
IF NOT .N<INPUTF> THEN RETURN 0;
IF NOT .N<ASCIIMF> THEN RETURN 0;
IF (.CURCHN+1) GTR #17 THEN RETURN 2;
OPN(.CURCHN+1,.DEVICE,1,2)
END; !OF REQUINIT
END;
END ELUDOM