Trailing-Edge
-
PDP-10 Archives
-
BB-H138B-BM
-
language-sources/de1n.bli
There are 18 other files named de1n.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
! OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
!
!COPYRIGHT (C) 1972,1973,1974,1977,1978 DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 01754
!FILENAME: H1DECL.BLI
!DATE: 14 JANUARY 74 MGM/FLD/KR
%3.43% GLOBAL BIND H1DEV=7; !MODULE VERSION NUMBER
%%
% THE GENERAL STRUCTURE OF THE ROUTINE/FUNCTION/STRUCTURE
DECLARATION PROCESSORS IS AS FOLLOWS+
1. THERE ARE 4 SYNTAX ROUTINES:SGLOROU,SROUTINE,
SFUNCTION, AND SSTRUCTURE; EACH IS A GLOBAL ROUTINE
OF NO PARAMETERS CALLED WHEN THE WINDOW IS IN THE
FORM:
(XXX,"SROUTINE",<ROUTINE NAME>,"(").
2. THE FIRST 3 OF THESE DIFFER SIGNIFICANTLY ONLY
IN THAT THEIR STE TYPES ARE DIFFERENT AND THEY SET
THE GPV "FCNSTATE" DIFFERENTLY. HENCE, THEY SIMPLY
CALL THE ROUTINE "DECSIMPLE" WITH THEIR TYPE, VALUE
THAT FCNSTATE IS TO BE SET TO, AND ERROR INCREMENT:
NOTE: A FUNCTION MAY NOT BE DECLARED WITHIN A ROUTINE.
%
%%
!
! REVISION HISTORY:
! 9-27-77 ROUTINE DECSIMPLE IS MODIFIED TO FIX BUG#48.EXTRA
! ARGUMENT IS PASSED TO ROUTINE RFS.
! 7-15-77 ROUTINES SOWN,SGLOBAL,SBIND ARE MODIFIED IN ORDER
! TO FIX BUG#18,BIND TO A REGISTER. NOW OWN,GLOBAL,
! BIND VARIABLES CAN BE BOUND TO A REGISTER.
!
! 5-9-77: INITIALIZATION OF OWN,GLOBAL VARIABLES IS ADDED.
! ROUTINES OWNEQL,GLOEQL ARE ADDED.ROUTINES SOWN,SGLOBAL,
! WHICHBIND,STARTNAME,STARTCOL,DOEQL ARE MODIFIED.
! A OWN VARIABLE COLONFLAG IS ADDED TO GIVE WARNINGS IN
! OWNEQL OR GLOEQL ROUTINES.COLONFLAG IS SET IN STARTCOL
! AND RESET TO ZERO IN STARTNAME.
! "_" IS AN ALPHACHARACTER UNDER BLS36C SWITCH.NECESSARY
! CHANGES ARE MADE TO ROUTINE SWITCHER.
!
! 1/26/77: ADDED B10NL SWITCH (OPERATES ONLY WITH BLS36C SWITCH).
! CHANGED SWITCH BLS20(C) TO BLS36(C).
! ABOVE SWITCHES ARE MODULE HEAD SWITCHES.
EXTERNAL REGASSN; ! 7-8-77
FORWARD DECSIMPLE;
! GLOBAL ROUTINE SGLOROU = DECSIMPLE(GLOBALT,1,0);
OWN COLONFLAG; !5-9-77,COLON IN OWNEQL OR GLOEQL GIVE WARNING
%2.25% GLOBAL ROUTINE SROUTINE =
%5.200.26% (LOCAL LTYPE;
%5.200.26% IF .REALFS EQL 0 THEN (RECOVER(.NFUTSYM,ERSYNAME);RETURN);
%5.200.26% IF .FUTDEL EQL HERRLEX
%5.200.26% THEN (IF .ST[.REALFS,0]<TYPEF> NEQ LINKAGET
%5.200.26% THEN (RECOVER(.NFUTSYM,#433);RETURN);
%5.200.26% LTYPE_.FUTSYM<STEF>;
%5.200.26% HRUND())
%5.200.26% ELSE LTYPE_0;
%2.25% IF .GRFLG !ALL ROUTINES MUST BE MADE GLOBAL
%2.25% THEN
%2.25% IF GLOBALCHECK(.REALFS) EQL 0
%5.200.26% %2.25% THEN DECSIMPLE(GROUTINET,3,.LTYPE)
%2.25% ELSE
%2.25% BEGIN
%2.25% WARNEM(.NFUTSYM,ERGLRTOROUT);
%5.200.26% %2.25% DECSIMPLE(RTNT,1,.LTYPE)
%2.25% END
%5.200.26% %2.25% ELSE DECSIMPLE(RTNT,1,.LTYPE);
%5.200.26% );
%5.200.26% GLOBAL ROUTINE SFUNCTION = DECSIMPLE(FUNCT, 2,0);
%%
% 3. IT WILL BE SEEN THAT "DECSIMPLE" ACTUALLY CORRESPONDS
(ON THE SAME LEVEL) TO SSTRUCTURE, AND HENCE WILL BE
EXPLAINED FIRST. DECSIMPLE DOES EVERYTHING IT CAN
WITHIN THE CURRENT BLOCKLEVEL/FUNCTIONLEVEL CONTEXT, WHICH IS
A. SAVE THE GPV "FCNSTATE" AND SET THE NEW VALUE TO ITS
SECOND PARAMETER VALUE;
B. CREATE A SYMBOL TABLE ENTRY AT THE CURRENT BLOCK/FUNCTION
LEVEL FOR THE ROUTINE/FUNCTION NAME, IF IT IS NOT ALREADY
DECLARED TO BE FORWARD;
C. CALL "RFS" TO PROCESS THE ROUTINE/FUNCTION IN A NEW
BLOCK/FUNCTION LEVEL CONTEXT, WITH PARAMETERS
WHICH INDICATE:
I. THE STE FOR THE CURRENT R/F/S NAME;
II. THE FORMAL PARAMETER TYPE NAME: FORMALT;
III. THE LEFT-DELIMITER FOR THE PARAMETER LIST: "(";
IV. THE RIGHT-DELIMITER FOR THE SAME: ")";
V. THE FACT THAT WE ARE NOT PROCESSING A STRUCTURE: 0;
%
%%
ROUTINE DECSIMPLE(DSTYPE,DSFUNST
%5.200.26% ,LINKAGTYP) =
BEGIN
LOCAL LOCGPV[1];
PUSHGPV(0,FCNSTATE)_.DSFUNST;
BEGIN
LOCAL DSSTE,DSSTTP,DSSTWD1;
EXTERNAL XUNFORWT,XREFTY;
% COMPARE DECSYM AND DECSYN%
IF .REALFS EQL 0
THEN (RECOVER(.NFUTSYM,ERSYNAME); EXITBLOCK)
ELSE IF (DSSTWD1_.ST[DSSTE_.REALFS,0]; .DSSTWD1<BLF>)
EQL .BLOCKLEVEL
THEN IF (DSSTTP_.DSSTWD1<TYPEF>) EQL
UNDEDT
THEN (ST[.DSSTE,0]<TYPEF>_.DSTYPE;
%5.200.41% IF .XREFLG THEN (XREFTY(.DSTYPE);XUNFORWT());
ST[.DSSTE,1]_0)
ELSE IF .DSSTTP EQL FORWT
THEN (ST[.DSSTE,0]<TYPEF>_.DSTYPE;
IF .XREFLG THEN XUNFORWT())
ELSE (RECOVER(.NFUTSYM,ERSMPREV);
EXITBLOCK)
ELSE ( DSSTE_DECSYQ(.DSSTE,.DSTYPE,0);IF .XREFLG THEN XUNFORWT());
%5.200.26% IF .LINKAGTYP<NEXTF> NEQ 0 THEN
%5.200.26% (IF .ST[.DSSTE,1]<LINKAGESTF> NEQ 0
%5.200.26% THEN ERROR(.NSYM,#436);ST[.DSSTE,1]<LINKAGESTF>_.LINKAGTYP<NEXTF>);
%5.200.26% ST[.DSSTE,1]<PORTALSWF>_.LINKAGTYP<PORTALSWF>;
RFS(.DSSTE,0,.DSTYPE EQL #12,.DSTYPE EQL RTNT); %9-27-77%
END;
POPGPV(0,FCNSTATE);
END;
%%
% 4. "SSTRUCTURE" BEHAVES DIFFERENTLY FROM "DECSIMPLE"
IN THAT:
A. ALTHOUGH "FCNSTATE" IS SAVED, IT IS SET TO THE SAME
VALUE AS THE LAST STATE (IF IN FUNCTION OR ROUTINE)
OR TO A ROUTINE AT FUNCTIONLEVEL 0.
B. THE ADDITIONAL GPVS: CURST, CURSTI, AND STRDEF
ARE SAVED AND INITIALIZED TO THE STE INDEX ,
THE STE INDEX, AND 3, RESPECTIVELY.
C. FORWARD STRUCTURE DEFINITIONS CANNOT OCCUR; HENCE, THE
DECLARE SIMPLE VARIABLE ROUTINE DECSYN IS USED.
D. CALLS RFS WITH PARAMETERS:
I. THE STRUCTURE NAME STE INDEX;
II. THE FACT THAT WE ARE PROCESSING A STRUCTURE: 1;
%
%%
GLOBAL ROUTINE SSTRUCTURE =
BEGIN
LOCAL LOCGPV[4];
%5.200.9% LOCAL PARSEOK;
%5.200.9% DO ( !! UNTIL FOLLOWED BY NON-COMMA !!
%5.200.9% PARSEOK_1;
PUSHGPV(0,STRDEF)_0;
PUSHGPV(1,CURST);
PUSHGPV(2,CURSTI);
PUSHGPV(3,FCNSTATE)_1;
BEGIN
LOCAL STVEC STRSTE;
IF DECSYN(STRSTE,STRT)
THEN
BEGIN
IF (.STRSTE[2] EQL .WDVECTOR) AND
.WDVECTOR[1] EQL .STRSTE[3]
THEN PTOVECTOR_.STRSTE; ! CURRENT "VECTOR"
RFS(CURST_.STRSTE,1,0,0);
IF (.SERRPOS NEQ 0) AND NOT .STRSTE[1]<SIMBITAF>
THEN
(ERROR(.SERRPOS,#40); SERRPOS_0);
END
%5.200.9% ELSE PARSEOK_0; !TO AVOID LOOP WHEN COMMA PRECEDES BAD NAME
END;
POPGPV(3,FCNSTATE);
POPGPV(2,CURSTI);
POPGPV(1,CURST);
POPGPV(0,STRDEF);
%5.200.9% )
%5.200.9% WHILE (.PARSEOK AND .DEL<LEFTHALF> EQL HCOMMA );
END;
GLOBAL ROUTINE SUNDECLARE =
BEGIN
DO
IF .REALFS NEQ 0
THEN DECSYQ(.REALFS, UNDEDT, 0)
ELSE RECOVER(.NFUTSYM,ERSYNAME)
WHILE (HRUND(); .DEL<LEFTHALF> EQL HCOMMA);
END;
%%
%
"SFORWARD" DECLARES EACH OF THE NAMEPARS TO BE FORWARD FUNCTION
DECLARATIONS. FOR EACH NAMEPAR WE MUST:
1. DECLARE IT;
2. DETERMINE HOW MANY PARAMETERS IT USES (DEFAULT 0) AND PUT IT IN
THE STE NPARMSF FIELD;
3. CREATE A PLACE IN FCNLIST FOR IT USING GENFCN.
WINDOW IN: (XXX, "SFORWARD", FORWARD:1, ("("/","/";"))
WINDOW OUT: (XXX, ";", XXX, XXX)
%
%%
GLOBAL ROUTINE SFORWARD =
BEGIN
LOCAL SFSTE, SFSYNCHK,
%5.200.24% LINKTYP;
%5.200.24% LINKTYP_0; !NO LINKAGENAME YET
DO (
%5.200.24% IF .REALFS EQL 0 THEN (RECOVER(.NFUTSYM,ERSYNAME);RETURN);
%5.200.24% IF .FUTDEL EQL HERRLEX THEN
%5.200.24% IF .ST[.REALFS,0]<TYPEF> NEQ LINKAGET
%5.200.24% THEN (RECOVER(.NFUTSYM,#433);RETURN)
%5.200.24% ELSE (LINKTYP_.REALFS;HRUND());
IF DECSYM(SFSTE, FORWT)
THEN
SYM_(IF .DEL<LEFTHALF> EQL HPAROPEN
THEN
(HRUND();
SFSYNCHK_.NSYM;
EXPRESSION(1);
IF NOT LITP(.SYM) THEN (RECOVER(.SFSYNCHK,ERSMBADFEXP); RETURN);
IF (.DEL<LEFTHALF> NEQ HROCLO) OR
(.FUTSYM NEQ HEMPTY)
THEN (RECOVER(.NDEL,ERSYMNPRD); RETURN);
SFSYNCHK_.SYM;
HRUND();
.SFSYNCHK)
ELSE 0)
ELSE RETURN;
ST[.SFSTE,1]<NPARMF>_.SYM;
%5.200.24% ST[.SFSTE,1]<LINKAGESTF>_.LINKTYP;
GENFCN(.SFSTE);)
WHILE (SFSYNCHK_.DEL<LEFTHALF>) EQL HCOMMA;
IF .SFSYNCHK NEQ HSEMCOL THEN RECOVER(.NDEL,ERSYMDEL);
END;
%%
%
SLINKAGE PROCESSES AN EXPRESSION OF THE FORM:
LINKAGE <NAME1>= ENTXIT ( <NAME2>,<NAME3> ) [,...] ;
PRODUCING FOR EACH <NAME1> A SYMBOL OF TYPE LINKAGET
AND ATTACHING TO THIS STE A 4-WORD ITEM CONTAINING THE
<NAME2> AND <NAME3> ITEMS, AS CHARACTER STRINGS.
%
%%
GLOBAL ROUTINE SLINKAGE=
BEGIN
LOCAL SLSTE,SLSYNCHK;
! ( ---- , LINKAGE ,, <NAME1> , = )
DO
BEGIN !UNTIL NOT FOLLOWED BY COMMA . . . . .
IF DECSYM(SLSTE,LINKAGET)
THEN BEGIN
! ( <NAME1>, = ,, ----- , ENTXIT )
SLSTE_ST[.SLSTE,1]_GETSPACE(2);
IF .DEL<LEFTHALF> NEQ HEQL THEN (RECOVER(.NDEL,ERRRDLINK);RETURN);
HRUND(); IF .DEL<LEFTHALF> NEQ HENTXIT THEN (RECOVER(.NDEL,ERRRDLINK);RETURN);
HRUND(); IF .DEL<LEFTHALF> NEQ HROPEN THEN (RECOVER(.NDEL,ERRRDLINK);RETURN);
HRUND(); IF .DEL<LEFTHALF> NEQ HCOMMA THEN (RECOVER(.NDEL,ERRRDLINK);RETURN);
ST[.SLSTE,0]_.ST[.SYM<STEF>,2]; ST[.SLSTE,1]_.ST[.SYM<STEF>,3];
HRUND(); IF .DEL<LEFTHALF> NEQ HROCLO THEN (RECOVER(.NDEL,ERRRDLINK);RETURN);
ST[.SLSTE,2]_.ST[.SYM<STEF>,2]; ST[.SLSTE,3]_.ST[.SYM<STEF>,3];
END
ELSE (RECOVER(.NSYM,ERSYNAME);RETURN);
HRUND()
END
WHILE ( SLSYNCHK_.DEL<LEFTHALF>) EQL HCOMMA;
IF .SLSYNCHK NEQ HSEMCOL THEN RECOVER(.NDEL,ERSYMDEL);
END;
%%
% THE GLOBAL ROUTINES FOR MAPPING DECLARATIONS:
(S) BIND, EXTERNAL, GLOBAL, LOCAL, MAP, OWN, AND REGISTER. THE
LOCAL ROUTINES "GROMLIST", "COPYINCA", AND THOSE PRECEDED BY "P" ARE
SIMPLY USEFUL AND NEED NOT BE DECLARED GLOBAL. GENERALLY, EACH OF THE
MAPPING DECLARATION ROUTINES CALLS "GROMLIST" WITH A SET OF ROUTINES
AS PARAMETERS. GROMLIST THEN HANDLES THE COMMON SYNTAX, CALLING THE
PASSED ROUTINES TO PROCESS THE DECLARATION SPECIFIC INFORMATION.
%
%%
FORWARD GROMLIST, PBIND, BINDEQ;
!EXTERNAL STRSTE, !STRUCTURE SYMBOL TABLE INDEX
! SIZE, ! ALLOCATION SIZE FOR DECLARED VARIABLE
! INCA, ! INDEX OF INCARNATION ACTUALS
! NUMPARS, ! NUMBER OF EXPECTED ACTUALS
! INCASIZE, ! NUMBER OF INCARNATION ACTUAL CELLS
! STE, ! SYMBOL TABLE INDEX OF SYMBOL BEING DECLARED
! STELIST, ! INDEX OF LIST OF SYMBOL TABLE INDICES
! STELAST, ! INDEX OF LAST STELIST ELEMENT
! STRLXS, ! LEXEME STREAM FOR SIZE (INDEX)
! OFLAGS; ! SEE MACROS FOR BIT MEANINGS
% BIT ASSIGNMENTS FOR OFLAGS %
MACRO FBIT(A)=A,1$;
MACRO 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
WASANEQL=FBIT(4)$, ! EQUAL FOUND FOLLOWING INCACTS
EQLPAR=18,18$; ! PARAM FOR EQUALS FOUND
FORWARD OWNEQL,GLOEQL;
GLOBAL ROUTINE PGLO(PGTABLE, PGSIZE, PGSTE)=
BEGIN
GLOBAL ROUTINE SLOCAL=GROMLIST(LOCALT,NEXTLOCAL,PGLO,0,0);
GLOBAL ROUTINE SOWN =(REGASSN_1;GROMLIST(OWNT ,NEXTOWN,PGLO ,OWNEQL,0);
REGASSN_0);
GLOBAL ROUTINE SGLOBAL=
BEGIN
%5.200.26% LOCAL LTYPE,PORTALSW;
%5.200.26% ROUTINE PORTALCHK=
%5.200.26% (IF .FUTSYM NEQ HEMPTY THEN RETURN #435;
%5.200.26% IF .FUTDEL<ADDRESSF> NEQ (#777777 AND NSROUTINE<0,0>) THEN RETURN #435;
%5.200.26% 1);
REGASSN_1; ! 7-8-77
%5.200.26% IF .DEL<LEFTHALF> EQL HPORTAL
%5.200.26% THEN (IF (PORTALSW_PORTALCHK()) NEQ 1
%5.200.26% THEN (ERROR(.NFUTDEL,.PORTALSW);PORTALSW_0))
! THE ERROR OF USING PORTAL FOR GLOBAL WILL BE HANDLED BY LETTING
! COMPILATION PROCEED, AFTER ERROR IS CALLED, AS IF GLOBAL HAD APPEARED
%5.200.26% ELSE PORTALSW_0;
IF .FUTSYM EQL HEMPTY AND
.FUTDEL<ADDRESSF> EQL (#777777 AND NSROUTINE<0,0>)
%2.31% THEN
%2.31% BEGIN
%2.31% HRUND(); !TO GET ROUTINE NAME INTO SYM
%5.200.26% IF .REALFS EQL 0 THEN (RECOVER(.NFUTSYM,ERSYNAME);RETURN);
%5.200.26% IF .FUTDEL EQL HERRLEX
%5.200.26% THEN ( IF .ST[.REALFS,0]<TYPEF> NEQ LINKAGET THEN (RECOVER(.NFUTSYM,#433);RETURN);
%5.200.26% LTYPE_.FUTSYM<STEF>;
%5.200.26% HRUND())
%5.200.26% ELSE LTYPE_0;
%5.200.26% LTYPE<PORTALSWF>_.PORTALSW;
%2.34% IF GSTINSERT(.REALFS) EQL 0
%5.200.26%%2.31% THEN DECSIMPLE(GROUTINET,3,.LTYPE)
%2.31% ELSE !NAME IS ALREADY DECLARED GLOBAL
%2.31% BEGIN !SO DECLARE IT OWN HERE
%2.31% WARNEM(.NFUTSYM,ERGLRTOROUT);
%5.200.26% %2.31% DECSIMPLE(RTNT,1,.LTYPE)
%2.31% END
%2.31% END
ELSE IF .FUTDEL<ADDRESSF> EQL NSBIND<0,0>
THEN (HRUND(); GROMLIST(BINDT,1,PBIND,-BINDEQ<0,0>,0))
ELSE GROMLIST(GLOBALT,NEXTGLOBAL,PGLO,GLOEQL,0);
REGASSN_0
END;
%%
% STORE THE CURRENT TABLE INDEX IN THE ADDITIONAL INFORMATION
WORD OF THE SYMBOL BEING DECLARED AND UPDATE THE TABLE INDEX BY THE
LENGTH OF THE SYMBOL.
%
%%
%2.31% IF .OTYPE EQL GLOBALT
%2.31% THEN !MAKE SURE GLOBAL IS NOT PREVIOUSLY DECLARED
%2.34% IF GSTINSERT(.PGSTE) NEQ 0
%2.31% THEN !IT'S BEEN DECLARED GLOBAL, SO LET'S MAKE THIS ONE OWN
%2.31% BEGIN
%2.31% WARNEM(.NFUTSYM,ERGLTOOWN);
%2.31% PGTABLE_NEXTOWN;
%2.31% ST[.PGSTE,0]<TYPEF>_OWNT
%2.31% END;
ST[.PGSTE,1]<ADDRESSF>_..PGTABLE;
.PGTABLE_..PGTABLE+.PGSIZE;
IF .PGTABLE NEQ NEXTLOCAL THEN DEFLOW(.PGSTE);
0
END;
GLOBAL ROUTINE PEXTERNAL(IGPARAM,IGSIZE,PESTE)=
BEGIN
GLOBAL ROUTINE SEXTERNAL=GROMLIST(EXTRNT,0,PEXTERNAL,0,0);
%%
% SIMPLY SET THE ADDITIONAL INFORMATION WORD TO #777777 FOR THE
LOADER INTERFACE.
%
%%
ST[.PESTE,1]<ADDRESSF>_#777777;
0
END;
ROUTINE PREGISTER(IGPARAM,PRSIZE,PRSTE)=
BEGIN
ROUTINE REGEQ=
BEGIN
LOCAL L,M;
L_.NSYM; %KEEP THIS IN CASE OF SEMANTIC ERRORS%
EXPRESSION(1);
IF .SYM EQL HEMPTY THEN SYM_LITLEXEME(0);
IF NOT LITP(.SYM) THEN (RECOVER(.L,ERSMNOTL); RETURN 1);
M_LITV(.SYM);
IF (.M GEQ 16) OR (.M LSS 0)
THEN (RECOVER(.L,ERSMINREG); RETURN 1);
IF NOT .MODREGM<.M,1> THEN WARNEM(.L,ERSMNDEC);
0
END;
GLOBAL ROUTINE SREGISTER=GROMLIST(REGT,0,PREGISTER,REGEQ,0);
%%
% ACQUIRE THE REGISTER, INSERT IT IN THE LITERAL TABLE, AND SET
THE ADDITIONAL INFORMATION FIELD TO THIS LITERAL TABLE INDEX.
%
%%
IF .OFLAGS<WASANEQL>
THEN %DECLARE AS ABSOLUTE TYPE%
(ST[.PRSTE,0]<TYPEF>_ABSOLUTET;
%2.17% SYM_ST[.PRSTE,1]<ADDRESSF>_LTINSERT(0<0,36>+LITV(.SYM))+VEM)
ELSE
(ST[.PRSTE,1]<ADDRESSF>_LTINSERT(0<0,36>+ACQUIRE(.PRSTE+16,.PRSIZE));
ST[.PRSTE,1]<NRF>_.PRSIZE;);
0
END;
GLOBAL ROUTINE WHICHBIND =
% THIS ROUTINE CALLS EXPRESSION AND DETERMINES
WHICH TYPE OF EXPRESSION IT IS:
0--CODE MUST BE GENERATED TO PRODUCE THIS RESULT;
1--LITERAL LEXEME;
(5.200.18) 2--LOADTIME ADDRESS
(5.200.18) 3--RUNTIME ADDRESS %
BEGIN
LOCAL LOCGPV,RVAL;
%5.200.18% LOCAL XTYPE,XSTE;
% WHICHBIND GETS CALLED RECURSIVELY FOR BIND A=(BIND B=3;B);
SAVE STE,STELIST,STELAST AND RESTORE THEM AT END 4-28-77 %
LOCAL SAVSTE,SAVSTELIST,SAVSTELAST;
SAVSTE_.STE;SAVSTELIST_.STELIST;SAVSTELAST_.STELAST;
PUSHGPV(0,CODEPROP)_0;
RVAL_
BEGIN
EXPRESSION(1);
IF .SYM EQL HEMPTY THEN (SYM_ZERO; 1) ELSE
IF .CODEPROP OR ((.SYM AND (COPM+RTEM)) NEQ 0)
THEN 0
ELSE 2-LITP(.SYM)
END;
%5.200.18% IF .RVAL EQL 2 THEN
%5.200.18% (IF NOT ( LOADTIMEAD^(-(XTYPE_.ST[XSTE_.SYM<STEF>,0]<TYPEF>)))
%5.200.18% THEN IF ( NOT (.XTYPE EQL LEXEMT ))
%5.200.18% THEN IF (NOT(.XTYPE EQL PTRT))
%5.200.18% THEN RVAL_3
%5.200.18% ELSE (IF NOT .ST[.XSTE,1]<15,1>
%5.200.18% THEN RVAL_3
%5.200.18% ELSE IF NOT(LOADTIMEAD^(-(.ST[.ST[.XSTE,1]<STEF>,0]<TYPEF>))) THEN RVAL_3)
%5.200.18% ELSE IF NOT (LOADTIMEAD^(-(.ST[.ST[.ST[.XSTE,1]<STEF>,0]<STEF>,0]<TYPEF>)))
%5.200.18% THEN RVAL_3);
%5.200.18 -----------------> IF NEITHER THE SYMBOL NOR THE LEXEME IS OF LOADTIMEADDRESS TYPE, THEN WE HAVE A RUNTIME ADDRESS%
POPGPV(0,CODEPROP);
STE_.SAVSTE;STELIST_.SAVSTELIST;STELAST_.SAVSTELAST;
.RVAL
END;
GLOBAL ROUTINE MKDUMINCA(VEC)=
BEGIN
LOCAL SIZE, NPARS, STVEC NEWACTS;
MAP STVEC VEC;
NEWACTS_GETSPACE(SIZE_((NPARS_.VEC[1]<NPARMF>)^(-1)+1));
NEWACTS[0]<STRXF>_.VEC;
NEWACTS[0]<PSZF>_.SIZE;
INCR I FROM 1 TO .NPARS DO NEWACTS[.I]_1; %DEFAULT ACTUAL VALUES%
.NEWACTS
END;
ROUTINE PBIND(PARM,SIZE,STE)=
BEGIN
LOCAL TYPE;
ST[.STE,0]<TYPEF>_
TYPE_CASE .OFLAGS<EQLPAR> OF SET BINDT; ABSOLUTET; LEXEMT TES;
ST[.STE,1]<ADDRESSF>_.SYM;
IF NOT .OPAR THEN
! WE ARE FINISHED UNLESS THIS IS A GLOBAL BIND
RETURN 0;
IF GSTINSERT(.STE) NEQ 0 THEN
BEGIN
! THIS IS ALREADY A GLOBAL DECLARATION MAKE THIS ONE
! LOCAL ONLY
WARNEM(.NSYM,ERALDECGL);
RETURN 0;
END;
IF .TYPE EQL ABSOLUTET THEN
BEGIN
! GLOBAL BIND TO A LITERAL
ST[.STE,0]<TYPEF>=GABSOLUTET;
IF .ST[.STE,1]<VEF>
THEN ! LONG LITERAL
DEFGBC(.STE,GETLITVAL(.ST[.STE,1]<LTEF>))
ELSE ! SHORT LITERAL
DEFGBC(.STE,.ST[.STE,1]<LTEF>);
RETURN 0;
END;
IF .TYPE EQL LEXEMT THEN
! WE HAVE (HOPEFULLY) A LINK TIME CONSTANT
BEGIN
LOCAL PTR,SYMIND;
PTR=.ST[.ST[.STE,1]<RIGHTHALF>,0];
IF .PTR<LSF> NEQ 1 OR
(.PTR AND (NEGM OR NOTM OR DOTM OR RTEM)) NEQ 0 THEN
! THIS IS NOT A POINTER LEXEME
BEGIN
WARNEM(.NSYM,ERGBMBCTC);
RETURN 0;
END;
SYMIND=.PTR<STEF>;
! NOW WE HAVE A SYMBOL TABLE ENTRY TO MAKE THE BIND TO.
SELECT .ST[.SYMIND,0]<TYPEF> OF
NSET
OWNT:
DEFGBG(.STE,
(.PTR<POSNSIZEF>^24) OR (.ST[.SYMIND,1]<RIGHTHALF>),
.GNAMES[0]);
GLOBALT:
DEFGBG(.STE,
(.PTR<POSNSIZEF>^24) OR (.ST[.SYMIND,1]<RIGHTHALF>),
.GNAMES[1]);
PLITT:
DEFGBG(.STE,
(.PTR<POSNSIZEF>^24) OR (.ST[.SYMIND,1]<RIGHTHALF>),
.GNAMES[6]);
GPLITT:
DEFGBG(.STE,
(.PTR<POSNSIZEF>^24) OR (.ST[.SYMIND,1]<RIGHTHALF>),
.GNAMES[6]);
EXTRNT:
DEFGBG(.STE,
.PTR<POSNSIZEF>^24,
GETNAM(ST[.SYMIND,2],6));
GROUTINET:
DEFGBG(.STE,
.PTR<POSNSIZEF>^24,
GETNAM(ST[.SYMIND,2],6));
EXPRT:
BEGIN
LOCAL OFFST,REALSYM;
OFFST=.ST[.SYMIND,1]<RIGHTHALF>;
REALSYM=.ST[.SYMIND,1]<LEFTHALF>;
IF .ST[.REALSYM,0]<TYPEF> NEQ EXTRNT
THEN
BEGIN
WARNEM(.NSYM,ERGBMBCTC);
RETURN 0;
END;
DEFGBG(.STE,
(.PTR<POSNSIZEF>^24) OR .OFFST,
GETNAM(ST[.REALSYM,2],6));
END;
ROUTINET:
DEFGBR(.STE,.SYMIND,.PTR<POSNSIZEF>^24);
FUNCT:
DEFGBR(.STE,.SYMIND,.PTR<POSNSIZEF>^24);
FORWT:
PUTGBP(.STE,.SYMIND,.PTR<POSNSIZEF>^24);
OTHERWISE:
BEGIN
WARNEM(.NSYM,ERGBMBCTC);
RETURN 0;
END
TESN;
ST[.STE,0]<TYPEF>=GLEXEMT;
RETURN 0;
END;
WARNEM(.NSYM,ERGBMBCTC);
RETURN 0;
END; %OF PBIND%
ROUTINE BINDEQ=
BEGIN
OFLAGS<EQLPAR>_WHICHBIND();
%5.200.18% IF .OFLAGS<EQLPAR> EQL 3 THEN OFLAGS<EQLPAR>_2;
%5.200.18% ! WHICHBIND IS CHANGED TO DISTINGUISH
%5.200.18% ! LOADTIME ADDRESSES FROM OTHERS, SOMETHING
%5.200.18% ! NOT OF INTEREST HERE.
CASE .OFLAGS<EQLPAR> OF
SET
% CODE GENERATED %
BEGIN
LOCAL LEFTOP;
LEFTOP_LEXRA(.FREG);
LEFTOP<STEF>_.NEXTLOCAL;
LEFTOP<POSNSIZEF>_36;
IF .CODETOG THEN (DULEX(GSTO(.LEFTOP,.SYM)); CT[.CT[.CODEPTR,1]<PREVF>,0]<RELOCF>_LOCRELOC);
SYM_.NEXTLOCAL; % PASS PARAM TO PBIND %
NEXTLOCAL_.NEXTLOCAL+1
END;
% LITERAL %;
% POINTER %
BEGIN
LOCAL LEXSTE;
ST[LEXSTE_GETSPACE(1),0]_.SYM;
ST[.LEXSTE,1]_.MAPTB;
SYM_MAPTB_.LEXSTE
END
TES;
0
END; %OF BINDEQ %
GLOBAL ROUTINE SBIND=(REGASSN_1;GROMLIST(BINDT,0,PBIND,-BINDEQ<0,0>,0);
REGASSN_0);
%%
% MAP FUNCTION NOT CALLED--MAPONE CALLED FOR EVERYONE.
%
%%
%V2H% GLOBAL ROUTINE SDECLABEL=
%V2H% !WE HAVE SEEN A LABEL DECLARATION SO DECLARE THE FOLLOWING LIST
%V2H% !AS LABELS.
%V2H% GROMLIST(LABELT,0,0,0,0);
GLOBAL ROUTINE SMAP=GROMLIST(0,0,0,0,0);
%%
% MAPONE(MPSTE:<ST INDEX OF VARIABLE BEING MAPPED>,
MPCP: <INPUT STRING POINTER IF ERRORS>,
MPINCA:<STE INDEX OF INCARNATION ACTUALS>,
MPTYPE:<IF TYPE KNOWN, THEN MAP IS ALLOWED>)
THIS ROUTINE IS CALLED TO MAP A SINGLE VARIABLE. IF THE TYPE IS NOT SPECIFIED
(AND THUS, THE VARIABLE IS NOT SIMULTANEOUSLY BEING DECLARED, WE MUST INSURE:
1. THAT THE VARIABLE MAY BE USED IN THE CURRENT CONTEXT;
2. THAT THE TYPE OF THE VARIABLE ALLOWS IT TO BE MAPPED.
A SYMBOL FROM AN OUTER BLOCK IS REDEFINED (VIA THE ABSOLUTET)
IN THE CURRENT CONTEXT BEFORE IT IS MAPPED.
MAPPING ITSELF IS TRIVIAL. WE SIMPLY SET THE STRF FIELD OF THE STE ADDITIONAL
INFORMATION WORD TO THE INDEX OF THE INCARNATION ACTUALS.
WINDOW: UNCHANGED.
%
%%
ROUTINE MAPONE(MPSTE,MPCP,MPINCA,MPTYPE)=
BEGIN
MAP STVEC MPSTE;
IF .MPTYPE EQL 0
THEN
BEGIN
IF NOT CHKULA(.MPSTE) OR NOT MAPPABLE((.MPSTE[0]<TYPEF>))
THEN (RECOVER(.MPCP,ERSMNOMAP); RETURN 1);
IF .BLOCKLEVEL NEQ .MPSTE[0]<BLF>
THEN MPSTE_DECSYQ(.MPSTE,ABSOLUTET,LSM+.MPSTE)
END; % NO ELSE PART %
MPSTE[1]<STRF>_.MPINCA;
0
END;
%%
% UNMAP SIMPLY RELEASES ALL THE LEXEME TYPE ENTRIES FOR
SYMBOLS AT THE CURRENT BLOCKLEVEL.
%
%%
GLOBAL ROUTINE UNMAP=
BEGIN
REGISTER TEMP;
WHILE .MAPTB NEQ 0 DO
(TEMP_.ST[.MAPTB,1];
RELEASESPACE(.MAPTB,1);
MAPTB_.TEMP);
END;
%%
% GROMLIST(GRLTYPE:<TYPE OF SYMBOL TO BE DECLARED>,
GRLPARAM:<PARAMETER PASSED TO GRLFUN>,
GRLFUN:<ROUTINE TO PROCESS DECLARATION SPECIFIC INF.>,
GRLEQL:<ROUTINE TO PROCESS "=">,
GRLASS:<ROUTINE TO PROCESS "_">)
THIS ROUTINE:
1. DECLARES EACH VARIABLE WITH NON-ZERO TYPE (GRLTYPE);
2. MAPS EACH VARIABLE WHICH MUST BE MAPPED;
3. PASSES EACH VARIABLE TO THE PARAMETER ROUTINE (GRLFUN).
%
%%
FORWARD STARTNAME, STARTCOL, CONTIDLIST, DOSIZE, ENDIDBATCH, DOEQL;
ROUTINE GROMLIST(GRLTYPE,GRLPARAM,GRLFUN,GRLEQL,GRLASS)=
BEGIN
%5.200.11% MACRO QUITIF(A)=IF A() THEN LEAVE COMMALOOP$;
%5.200.11% LOCAL LOCGPV[6];
%5.200.11% LABEL COMMALOOP;
%5.200.11% PUSHGPV(0,OTYPE)_.GRLTYPE;
%5.200.11% PUSHGPV(1,OPAR)_.GRLPARAM;
%5.200.11% PUSHGPV(2,OFUN)_.GRLFUN;
%5.200.11% PUSHGPV(3,OEQL)_.GRLEQL;
%5.200.11% PUSHGPV(4,OASS)_.GRLASS;
%5.200.11% PUSHGPV(5,OFLAGS);OFLAGS<MUSTDECLARE>_.GRLTYPE NEQ 0;
COMMALOOP:
DO % UNTIL NO COMMA %
(QUITIF(STARTNAME);
DO % UNTIL NO OUTER COLON %
(QUITIF(STARTCOL);
WHILE .FUTDEL<LEFTHALF> EQL HCOLON DO (QUITIF(CONTIDLIST));
QUITIF(DOSIZE);
QUITIF(DOEQL);
QUITIF(ENDIDBATCH);)
WHILE .DEL<LEFTHALF> EQL HCOLON;)
WHILE .DEL<LEFTHALF> EQL HCOMMA;
! LEAVE COMMALOOP COMES HERE
%5.200.11% POPGPV(5,OFLAGS);
%5.200.11% POPGPV(4,OASS);
%5.200.11% POPGPV(3,OEQL);
%5.200.11% POPGPV(2,OFUN);
%5.200.11% POPGPV(1,OPAR);
%5.200.11% POPGPV(0,OTYPE);
IF .DEL<LEFTHALF> NEQ HSEMCOL THEN RETURN RECOVER(.NDEL,ERSYMGRLD);
END;
%%
% STARTNAME: WE FIRST SET UP THE STRUCTURE STE IF THE STRUCTURE
IS SPECIFIED--THERE IS AN ERROR LEXEME IN FUTDEL, USING THE ASSUMED
"VECTOR" STRUCTURE IF NOT. WE KNOW AT THISP POINT WHETHER WE MUST MAP THIS
STRING OF IDS; IF:
1. A STRUCTURE WAS SPECIFIED EXPLICITLY;
2. FUTURE DELIMITER IS A COLON OR OPEN BRACKET;
3. THE DECLARATION IS A MAP DECLARATION--IN PARTICULAR,
"MAP A;" = "MAP VECTOR A;".
WE THEN SET THE OWNS RELEVANT TO THE STRUCTURE ONLY (IF THE SYMBOLS ARE
TO BE MAPPED), NAMELY:
1. THE FLAG FOR THE LEXEME STREAM TYPE (SIMBITS);
2. THE STRUCTURE LEXEME STREAM INDEX;
3. THE INCARNATION ACTUALS CELL BLOCK-SIZE;
4. THE NUMBER OF EXPECTED INCARNATION ACTUALS.
%
%%
ROUTINE STARTNAME=
BEGIN
REGISTER TEMP;
%5.200.27% GLOBAL LNKSTE;
% WINDOW: (XXX,"SLOCAL",STRUCTURE-NAME,HERRLEX) OR
(XXX,"SLOCAL",FIRST-ID,(";"/":"/"["/",")) %
COLONFLAG_0; !RESET TO ZERO.IT IS SET IN STARTCOL ROUTINE
IF .REALFS EQL 0 THEN (RECOVER(.NFUTSYM,ERSYNAME); RETURN 1);
%5.200.27% LNKSTE_0; !NO LINKAGENAME UNLESS ONE IS SPECIFIED
%5.200.27% IF .FUTDEL EQL HERRLEX
%5.200.27% THEN IF .ST[LNKSTE_.REALFS,0]<TYPEF> EQL LINKAGET
%5.200.27% THEN (HRUND();IF .REALFS EQL 0 THEN (RECOVER(.NFUTSYM,ERSYNAME);RETURN 1))
%5.200.27% ELSE LNKSTE_0;
IF .FUTDEL EQL HERRLEX
THEN IF .ST[STRSTE_.REALFS,0]<TYPEF> NEQ STRT
THEN (RECOVER(.NFUTSYM,ERSMNOTSTR); RETURN 1)
ELSE (OFLAGS<MUSTMAP>_1; HRUND();)
ELSE (STRSTE_.PTOVECTOR; OFLAGS<MUSTMAP>_0;);
%5.200.27% IF .LNKSTE NEQ 0 THEN OFLAGS<MUSTMAP>_1;
IF OFLAGS<MUSTMAP>_
.OFLAGS<MUSTMAP> OR
(TEMP_.FUTDEL<LEFTHALF>; .TEMP) EQL HCOLON
OR .TEMP EQL HSQOPEN OR
NOT .OFLAGS<MUSTDECLARE>
THEN
(TEMP_.ST[.STRSTE,1];
OFLAGS<ISSBSLEX>_.TEMP<SIMBITSF>;
STRLXS_.TEMP<LXTESF>;
INCASIZE_(NUMPARS_.TEMP<NPARMF>)^(-1)+1;); % NO ELSE %
0
END;
%%
% MAYBEDECLARE DECLARS THE SYMBOL IN FUTSYM IF IT SHOULD BE
(.GRLTYPE IS NON-ZERO), AND RETURNS THE VALUE 1 IF THERE WERE
ERRORS.
%
%%
ROUTINE MAYBEDECLARE=(IF .OFLAGS<MUSTDECLARE>
THEN NOT DECSYN(STE,.OTYPE)
ELSE (STE_.REALFS; 0));
%%
% STARTCOL TAKES THE ID IN FUTSYM, DECLARES IT IF
NECESSARY AND PUTS IT AS THE FIRST ELEMENT ON THE STELIST.
%
%%
ROUTINE STARTCOL=
BEGIN
REGISTER TEMP;
IF .DEL<LEFTHALF> EQL HCOLON THEN
COLONFLAG_1; !RESET IN STARTNAME ROUTINE USED IN OWNEQL OR GLOEQL
IF MAYBEDECLARE() THEN RETURN 1;
(TEMP_ST[STELAST_STELIST_GETSPACE(1),0])<STELSTEF>_.STE;
(.TEMP+1)<STELCPF>_.NFUTSYM;
0
END;
%%
% CONTIDLIST SIMPLY DOES A RUND AND DECLARES THE SYMBOL IN FUTSYM
(IF NECESSARY). IT THEN PUTS THE DECLARED SYMBOL ON THE STE LIST.
WINDOW: (XXX,XXX,ID,":");
WINDOW OUT: (ID,":",NEXTID,(":"/"["/","/";")).
%
%%
ROUTINE CONTIDLIST=
BEGIN REGISTER TEMP;
HRUND();
IF MAYBEDECLARE() THEN RETURN 1;
ST[.STELAST,0]<STELNEXTF>_TEMP_GETSPACE(1);
(TEMP_ST[STELAST_.TEMP,0])<STELSTEF>_.STE;
(.TEMP+1)<STELCPF>_.NFUTSYM;
0
END;
%%
% DOSIZE: WINDOW (XXX,XXX,LAST-ID,("["/","/";"))
SET ASSUMED SIZE TO 1. IF WE MUST MAP THE SYMBOL, THEN WE MUST
CREATE A SET OF INCARNATION ACTUALS. HENCE, WE SET UP A PROTOTYPE
INCARNATION ACTUALS AREA (WHOSE INDEX IS "INCA") AND DEFAULT ALL OF THEM
TO 1. WE THEN CHECK TO SEE IF A SIZE-LIST WAS SPECIFIED. IF SO, WE
FILL THE INCARNATION ACTUALS SUCCESSIVELY, UNTIL WE RUN OUT OF EXPRESSIONS,
OR ATTEMPT TO GIVE TOO MANY ACTUALS. WE THEN GET THE SIZE FROM THE SIZE EXPRESSION ON THE
STRUCTURE DECLARATION (IF SPECIFIED). OTHERWISE, WE USE THE PRODUCT OF THE SPECIFIED INCARNATION
INCARNATION ACTUALS.
WINDOW OUT: (LASTSIZE,"]",EMPTY(CHECKED),(":"/";"/",")) OR WINDOW IN.
%
%%
FORWARD GSSA;
ROUTINE DOSIZE=
BEGIN
LOCAL KEEPSTSIZE;
REGISTER TEMP;
SIZE_1;
IF NOT .OFLAGS<MUSTMAP> THEN RETURN 0;
% SET UP EMPTY INCARNATION ACTUALS AREA %
(TEMP_ST[INCA_GETSPACE(.INCASIZE),0])<PSZF>_.INCASIZE;
(.TEMP)<STRXPF>_.STRSTE;
%5.200.27% (.TEMP)<LINKAGESTF>_.LNKSTE; !STORE THE LT FOUND IN STARTTNAME
% PUT THE ACTUALS IN WHILE THE SIZE IS SPECIFIED, PUT DEFAULT OF
1 IN WHEN NOT. %
IF OFLAGS<TEMPF>_(.FUTDEL<LEFTHALF> EQL HSQOPEN) THEN HRUND();
INCR I FROM 1 TO .NUMPARS DO
IF .OFLAGS<TEMPF>
THEN
(HRUND();
KEEPSTSIZE_.NSYM;
EXPRESSION(1);
IF NOT LITP(.SYM) THEN (RECOVER(.KEEPSTSIZE,ERSMSIZE); RETURN 1);
SIZE_.SIZE*LITV(.SYM);
(.TEMP+.I)_.SYM;
IF .DEL<LEFTHALF> EQL HSQCLO
THEN (OFLAGS<TEMPF>_0;
IF .FUTSYM NEQ HEMPTY THEN (RECOVER(.NFUTSYM,ERSYMGRLD); RETURN 1);)
ELSE IF .DEL<LEFTHALF> NEQ HCOMMA
THEN (RECOVER(.NDEL,ERSYMRBRAC); RETURN 1);)
ELSE (.TEMP+.I)_1; % END OF DO %
% PULSE PAST REMAINING (EXTRA) ACTUALS %
IF .OFLAGS<TEMPF>
THEN
(WARNEM(.NFUTSYM,ERSMEXPAR);
DO
(HRUND();
KEEPSTSIZE_.NSYM;
EXPRESSION(1);
IF NOT LITP(.SYM) THEN (RECOVER(.KEEPSTSIZE,ERSMSIZE); RETURN 1);)
WHILE (TEMP_.DEL<LEFTHALF>) EQL HCOMMA;
IF .TEMP NEQ HSQCLO THEN (RECOVER(.NDEL,ERSYMRBRAC); RETURN 1);
IF .FUTSYM NEQ HEMPTY THEN (RECOVER(.NFUTSYM,ERSYMRBRAC); RETURN 1););
% WINDOW: (SIZE, "]", EMPTY, (":"/","/";"))
WE MUST NOW DETERMINE THE SIZE FROM THE LEXEME STREAM, IF
NECESSARY. %
IF NOT .OFLAGS<ISSBSLEX> OR .STRLXS EQL 0 THEN RETURN 0;
% NOTE--SIZE DECLARATION MAY HAVE TO FUDGE ";" ON END %
GSSA(0,.INCA,.STRSTE,0,.NFUTSYM);SYM_GENCODE(.SYM,2);
IF NOT LITP(.SYM) THEN (RECOVER(.KEEPSTSIZE,ERSMSIZE); RETURN 1);
SIZE_LITV(.SYM);
0
END;
%%
% ENDIDBATCH: PROCESS THE LIST OF STES BY:
1. MAPPING EACH VARIABLE THAT MUST BE MAPPED;
2. CALLING THE PASSED FUNCTION TO PROCESS THE DECLARATION
SPECIFIC INFORMATION. CALL FORMAT:
(@OFUN)(<USER PARAMETER>, <DECLARATION SIZE>, <STE INDEX OF SYMBOL>)
%
%%
FORWARD COPYINCA;
ROUTINE ENDIDBATCH=
BEGIN REGISTER TEMP;
DO
(IF .OFLAGS<MUSTMAP>
THEN
(IF MAPONE(STE_.ST[.STELIST,0]<STELSTEF>,
.ST[.STELIST,1]<STELCPF>, .INCA, .OTYPE) THEN RETURN 1;);
%V2H% !IF WE HAVE A LABEL TYPE ID, NO FURTHER DECLARATION IS NECESSARY
%V2H% IF .OFLAGS<MUSTDECLARE> THEN IF .OTYPE NEQ LABELT THEN (IF (@OFUN)(.OPAR,.SIZE,.STE) THEN RETURN 1;);)
WHILE
(TEMP_.STELIST;
STELIST_.ST[.TEMP,0]<STELNEXTF>;
RELEASESPACE(.TEMP,1);
IF .TEMP NEQ .STELAST
THEN (COPYINCA(); 1)
ELSE 0);
IF NOT .OFLAGS<WASANEQL> THEN HRUND();
% WINDOW: (XXX,":",ID,("["/":"/","/";")) OR
(XXX,",",ID,(HERRLEX/":"/","/"["/";")) OR
(XXX,";",XXX,XXX) %
0
END;
%%
% THE EQUAL SIGN IS HANDLED BY THE "OEQL" PARAMETER.
IF IT IS NON-ZERO, AN EQUAL SIGN IS PERMISSABLE. IF IT IS NEGATIVE,
AN EQUAL SIGN IS NECESSARY (E.G. IN BIND). THE PROCESSING ROUTINE
MUST RETURN AN ERROR BOOLEAN--1 IF ERRORS. THE ROUTINE IS PASSED
THE SINGLE PARAMETER "OPAR". THE DECLARATION PROCESSING ROUTINE
MAY COUNT ON THE VALUE OF SYM NOT CHANGING BETWEEN THE EQUAL
PROCESSING AND THE DECLARATION ROUTINE ITSELF. THE ROUTINES MAY
LATER TEST "OFLAGS<WASANEQL>" TO SEE IF THERE WAS ONE (I.E. IT
DOES NOT HAVE TO SAVE THE INFORMATION ITSELF.
%
%%
ROUTINE DOEQL=
BEGIN
REGISTER R;
IF R_OFLAGS<WASANEQL>_(.OEQL NEQ 0) AND
(.FUTDEL<LEFTHALF> EQL HEQL)
THEN (HRUND();IF .OTYPE NEQ OWNT AND .OTYPE NEQ GLOBALT
THEN HRUND(););
CASE (.R^1)+(.OEQL LSS 0) OF
SET
0; !NO EQUALS AND DID NOT NEED ONE
(RECOVER(.NFUTDEL,ERSYMEQ); 1); !NO EQUALS AND NEEDED ONE
(@OEQL)(.OPAR); !OPTIONAL EQUAL
(-.OEQL)(.OPAR) !REQUIRED EQUAL
TES
END;
ROUTINE OWNEQL=
BEGIN
LOCAL STVEC FIRSTCELL,TEMP,L;
L_.NSYM;
FIRSTCELL_SPLIT1(2);
TEMP_.FIRSTCELL[1];
IF .SIZE LSS .TEMP THEN WARNEM(.L,#765); !SIZE LSS ITEMS
IF (.STELIST NEQ .STELAST) OR .COLONFLAG THEN
WARNEM(.L,#766); !COLON IS A WARNING IN ASSIGNMENT
FIRSTCELL[1]<RIGHTHALF>_.NEXTOWN-.OWNBLK;
FIRSTCELL[0]<PRIORITYF>_OWNT;
OWNBLK_.NEXTOWN+.TEMP;
FIRSTCELL[1]<LEFTHALF>_#377777;
0
END;
ROUTINE GLOEQL=
BEGIN
LOCAL STVEC FIRSTCELL,TEMP,L;
L_.NSYM;
FIRSTCELL_SPLIT1(1);
TEMP_.FIRSTCELL[1];
IF .SIZE LSS .TEMP THEN WARNEM(.L,#765); !SIZE LSS ITEMS
IF (.STELIST NEQ .STELAST) OR .COLONFLAG THEN
WARNEM(.L,#766); !COLON IS A WARNING IN ASSIGNMENT
FIRSTCELL[1]<RIGHTHALF>_.NEXTGLOBAL-.GLOBLK;
FIRSTCELL[0]<PRIORITYF>_GLOBALT;
GLOBLK_.NEXTGLOBAL+.TEMP;
FIRSTCELL[1]<LEFTHALF>_#377777;
0
END;
%%
% CHKULA(STEINDEX: <INDEX OF SYMBOL WHOSE ADDRESSING IS TO BE CHECKED>)
=1 IF THE SYMBOL IS A FORMAL, STRUCTURE FORMAL, LOCAL, OR FUNCTION AND
IS ADDRESSABLE;
=0 IF ONE OF THE ABOVE TYPES AND NOT ADDRESSABLE (EVEN THROUGH THE DISPLAY).
WE SIMPLY TEST THOSE SYMBOLS WITH THE ABOVE TYPES TO INSURE THAT THEIR BLOCKLEVEL
IS GREATER THAN OR EQUAL TO TRBLEVEL--THE BLOCKLEVEL OF THE MOST RECENT ROUTINE
DECLARATION.
%
%%
GLOBAL ROUTINE CHKULA(STEINDEX)=
BEGIN
MAP STVEC STEINDEX;
MACRO RET(PRED)=IF PRED THEN RETURN 1$;
RET( NOT (1^LOCALT+1^FORMALT+1^FUNCT+1^STRFPT+1^BINDT)^(-.STEINDEX[0]<TYPEF>));
RET(.TRBLEVEL LSS .STEINDEX[0]<BLF>);
IF .STRDEF THEN
(SERRPOS_.NSYM;
SERRSTE_.STEINDEX;
RETURN 1);
0
END;
%%
% THE FOLLOWING ROUTINES ARE USED FOR SETTING UP FOR A LEXEME COPY
(EITHER SIZE OR ACCESS) AND FOR STOPPING SUCH A COPY--STRSCOPY AND
STRECOPY RESPECTIVELY. THE FIRST MERELY STICKS IN AN EXTRA LEFT PARENTHESIS
AS THE FIRST WORD OF THE EXPRESSION. THE SECOND INSERTS AN EXTRA RIGHT PAREN.
RELSTRLIST(LXTI:<INDEX OF FIRST CELL ON THE LIST>) RELEASES A LEXEME STREAM
FROM LXT.
THE FORMER SETS CSTI AND RETURNS THE NEW CELL INDEX AS ITS VALUE.
%
%%
%3.1% GLOBAL ROUTINE STRSCOPY(NPS)=
BEGIN
CSTIL_CSTI_GETSPACE(2);
LXT[.CSTI,0]_-1;
LXT[.CSTI,1]_0;
LXT[.CSTI,2]_0;
LXT[.CSTI,3]_0;
IF .STRDEF<TACCESS>
THEN
(STRDEF<LEFTHALF>_GETSPACE((.NPS^(-1))+1);
STRDEF<NPF>_.NPS);
WRUND2();
IF .CSTI NEQ .CSTIL THEN (RELEASESPACE(.CSTIL,2); CSTIL_.CSTI);
.CSTI
END;
%3.1% GLOBAL ROUTINE STRECOPY=
BEGIN
RELEASESPACE(.CSTI,2);
LXT[.CSTIL,1]_0;
LXT[.CSTIL,3]_.LXCLOA;
END;
GLOBAL ROUTINE RELSTRLIST(LXTI)=
BEGIN
REGISTER TOGO, NEXTTOGO;
NEXTTOGO_.LXTI;
WHILE (TOGO_.NEXTTOGO) NEQ 0 DO
(NEXTTOGO_.LXT[.NEXTTOGO,1]; RELEASESPACE(.TOGO,2););
END;
%%
% GSSA(ACTUALS:<STE INDEX OF ACTUALS BLOCK>,
INCACTS:<STE INDEX OF INCARNATION ACTUALS BLOCK>,
STRUCT:<STE INDEX OF STRUCTURE BEING EXPANDED>,
ACCESS:<0--SIZE EXPANSION, 1--ACCESS EXPANSION>,
CHARPT:<POINTER TO INPUT STRING ERROR POSITION THROUGHOUT GENERATION>)
SAVE THE STRUCTURE ACCESSING LEXEME GENERATION VARIABLES, NAMELY:
SSTREX, STREXP, CURSTE, CURSTAP, CURSTIP, CURSTNP ALONG WITH FUTSYM, FUTDEL,
NFUTSYM, AND NFUTDEL WHICH WILL HAVE CHANGED THROUGH THE EXPANSION. WE
THEN INITIALIZE THE SAME VARIABLES TO THE DEFAULTS MENTIONED BELOW;
NOTE: THE NEXT HRUND WILL PRETEND THE LXT LEXEME STREAM WAS IN FUTSYM
AND FUTDEL.
%
%%
GLOBAL ROUTINE GSSA(ACTUALS, INCACTS, STRUCT, ACCESS, CHARPT)=
BEGIN
REGISTER L;
ST[L_GETSPACE(6),0]_.SSTREX;
ST[.L,1]_.STREXP;
ST[.L,2]_.CURSTE;
ST[.L,3]_.CURSTAP;
ST[.L,4]_.CURSTIP;
ST[.L,5]_.CURSTNP;
ST[.L,8]_IF .REALFS NEQ 0 THEN .REALFS+LSM ELSE .FUTSYM;
ST[.L,9]_.FUTDEL;
ST[.L,10]_.NFUTSYM;
ST[.L,11]_.NFUTDEL;
% DEFAULTS %
SSTREX_.L;
STREXP_1+(1-.ACCESS)^1;
CURSTE_(IF .ACCESS THEN .ST[.STRUCT,1]<LXTEAF> ELSE .ST[.STRUCT,1]<LXTESF>);
CURSTAP_.ACTUALS;
CURSTIP_.INCACTS;
CURSTNP_.ST[.STRUCT,1]<NPARMF>;
NFUTSYM_NFUTDEL_.CHARPT;
SYM_DEL_FUTSYM_FUTDEL_0; %NO SIDE EFFECTS FROM HRUND %
HRUND(); HRUND(); EXPRESSION(0);
END;
%%
% COPYINCA()--GET MORE SPACE, PUT ADDRESS INTO INCA AND COPY THE
OLD LIST OVER.
%
%%
ROUTINE COPYINCA=
BEGIN
REGISTER R;
LOCAL MAX;
INCA_GETSPACE(MAX_.ST[R_.INCA,0]<PSZF>);
INCR I FROM 0 TO 2*.MAX-1 DO
ST[.INCA,.I]_.ST[.R,.I];
END;
! THE FOLLOWING ROUTINES PROCESS SWITCHES AND MODULE HEAD DECLARATIONS.
MACRO BS(NUM,STR)=('STR' OR ((-1)^(-7*NUM))) AND (-2)$,
BL(STR)='STR' AND (-2)$;
BIND SWTBL=PLIT (
%3.28% 23, !THIS IS THE NUMBER OF COMMON SWITCHES
BL(EXPAN) %D%,
BL(NOEXP) %AND%,
BS(4,LIST),
BL(NOLIS) %T%,
BS(4,ERRS),
BL(NOERR) %S%,
BL(MLIST),
BL(NOMLI) %ST%,
BL(INSPE) %CT%,
BL(NOINS) %PECT%,
BL(OPTIM) %IZE%,
BL(NOOPT) %IMIZE%,
BL(GLORO) %UTINES%,
BL(NOGLO) %ROUTINES%,
BL(TIMIN) %G%,
BL(NOTIM) %ING%,
BL(FSAVE),
BL(NOFSA) %VE%,
BS(4,XREF),
BL(NOXRE) %F%,
BL(ENGLI) %SH%,
BL(NOENG) %LISH%,
BL(START),
BS(4,NULL),
% END OF COMMON SWITCHES, UPDATE THE FIRST VALUE WHEN ADDING COMMON SWITCHES
BEGIN MODULE SWITCHES ONLY %
BL(TIMER),
BL(RESER) %VE%,
BS(3,CCL),
BL(DREGS),
BS(4,SREG),
BS(4,FREG),
BS(4,VREG),
BL(STACK),
BL(SYNTA) %X%,
BL(HISEG),
BL(LOWSE) %G%,
BL(RSAVE),
BL(NORSA) %VE%,
BL(ENTRI) %ES%,
BL(PROLO) %G%,
BL(HEADF) %ILE%,
BL(DEBUG),
BL(NODEB) %UG%,
BL(VERSI) %ON%,
BL(BLS36) %C%,
BL(IDELE) %TE%,
BL(B10NL)
% END OF SWITCHES % );
GLOBAL ROUTINE SWITCHER(HIGH)=
BEGIN
MACRO SYCHK(X)=IF X THEN RETURN 1$;
REGISTER X;
DO % UNTIL DEL IS NOT A COMMA %
BEGIN
IF .REALFS EQL 0
THEN (RETURN 1)
ELSE X_.ST[.REALFS,2];
HRUND(); !SWITCH NAME NOW IN SYM
%3.28% X_ DECR I FROM .SWTBL[.HIGH] TO 1 DO IF .X EQL .SWTBL[.I] THEN BREAK .I;
%3.33% CASE .X OF
SET
%ERROR% RETURN 3; ! ERROR, NOT FOUND
%EXPAND% EMFLG_1; ! EXPAND MACRO
%NOEXPAND% EMFLG_0; ! DON'T EXPAND MACRO
%2.14% %LIST% LSTFLG_.CANLST; !LIST
%NOLIST% LSTFLG_1; ! NO LIST
%ERRS% ERRBIT_0; ! ERR MSGS TO TTY
%NOERRS% ERRBIT_1; ! NO ERR MSGS TO TTY
%MLIST% MLFLG_1; ! MACH LIST
%NOMLIST% MLFLG_0; ! NO MACH LIST
%INSPECT% LUNDEFLG_1; ! INSPECT
%NOINSPECT% LUNDEFLG_0; ! NO INSPECT
%OPTIMIZE% NPTFLG_0; ! OPTIMIZE
%NOOPTIMIZE% NPTFLG_1; ! NO-OPTIMIZE
%GLOROUTINES% GRFLG_1; ! LOCAL ROUTINES DECLARED GLOBAL
%NOGLOROUTINES% GRFLG_0; ! LOCAL ROUTINES STAY LOCAL
%TIMING% TTFLAG_.MHTIME; ! SET TIMING FLAG ON
%NOTIMING% TTFLAG_0; ! SET TIMING FLAG OFF
%FSAVE% FSAVFLG_1; ! ALWAYS SAVE FREG
%NOFSAVE% FSAVFLG_0; ! DON'T ALWAYS SAVE FREG
%XREF% XREFLG_1; ! TURN ON XREF
%NOXREF% XREFLG_0; ! TURN OFF XREF
%ENGLISH% NOENGLISH_0; ! USE ENGLISH LANGUAGE DIAGNOSTICS
%NOENGLISH% NOENGLISH_1; ! USE ONLY MNEMONIC ERROR CODES
%START% STARTBLOCK_1; ! PUT A START BLOCK IN THIS MODULE
%NULL% .VREG; ! DO NOTHING
! END OF COMMON SWITCHES
%TIMER% SYCHK((PSWTIM())); ! PROCESS TIMER DECL
%RESERVE% SYCHK((PSWRES())); ! RESERVE SPECIFIC REGS.
%CCL% CCLFLAG_1; ! GENERATE CCL LINK CODE
%DREGS% SYCHK((PSWSAV())); ! NO DECLARABLE REGS.
%SREG=% SYCHK((PSWSPC(0))); ! DEFINE SREG
%FREG=% SYCHK((PSWSPC(1))); ! DEFINE FREG
%VREG=% SYCHK((PSWSPC(2))); ! DEFINE VREG
%STACK% (STARTBLOCK_ 1; SYCHK((PSWSTK()))); ! DEFINE STACK
%SYNTAX% CODETOG_0; ! SYNTAX CHECK ONLY
%HISEG% (HGHFLG_1; TWOSEGFLG_0); ! HIGH SEGMENT
%LOWSEG% (HGHFLG_0; TWOSEGFLG_0); ! LOW SEGMENT
%RSAVE% SVERGFLG_1; ! SAVE/RESTORE REGISTERS AT EXCHJ
%NORSAVE% SVERGFLG_0; ! NO SAVE/RESTORE AT EXCHJ
%ENTRIES% SYCHK((PSWENT())); ! ENTRY LIST
%PROLOG% PROFLG_1; ! PROLOG FLAG ON
%HEADFILE% SREQUIRE(); ! PROCESS REQUIRE DECL IN MODULE HEAD
%DEBUG% DEBFLG_FSAVFLG_-1; ! GENERATE DEBUG LINKAGE
%NODEBUG% DEBFLG_0; ! NO DEBUG LINKAGE
%VERSION=% SYCHK(PSWVER()); ! PROCESS VERSION DECLARATION
%BLS36C% (TYPEDOPE[19]=#104235673440; B20FLG<0,1>_1); ! THIS IS BEING USED BY BLISS-36C
%IDELETE% B20FLG<1,1>_1; ! DELETE THE INPUT FILE (ONLY IF ABOVE SWITCH SET)
%B10NL% B20FLG<2,1>_1; ! SUPPRESS LISTING OF NON-COMMENTS (ONLY IF BLS36C SWITCH SET)
TES;
END UNTIL .DEL<LEFTHALF> NEQ HCOMMA;
END;
%3.1% GLOBAL ROUTINE SSWITCHES=
BEGIN LOCAL X;
X_SWITCHER(SWSWL);
IF .X THEN RECOVER(.NFUTSYM,#600+.X) ELSE
IF .DEL<LEFTHALF> NEQ HSEMCOL THEN RECOVER(.NDEL,#602)
END;
GLOBAL ROUTINE SMODHEAD=
BEGIN
REGISTER R;
R_.NDEL;
HRUND();
RECOVER(.R,ERSYINVMDEC);
END;
%3.1% GLOBAL ROUTINE H1RFS(RFSTE,L2,RFSTRB) =
BEGIN
IF .CODETOG THEN
(ACPR1(); ! [SEE E]
PUSHCODE(););
% COMPILE THE BODY AND CONVEY THE VALUE/NO VALUE TO
THE CODE GENERATORS. WINDOW HERE: (<EMPTY>,"=",...)%
HRUND(); ! WINDOW: (<BODY SYM 1>,<BODY DEL 1>,...)
EXPRESSION(1); ! WINDOW: (<BODY LEXEME>,";",XXX,XXX)
IF .CODETOG THEN CONVEY(.SYM);
% NOTE: STRUCTURES ARE PROCESSED BY COPYING THE LEXEME STREAM
FOR THE STRUCTURE AND AT THE SAME TIME GENERATING CODE
FOR THE BODY. THE CODE IS KEPT IF ANY DECLARATIONS ARE NECESSARY,
THE CONDITION FOR A BLOCK. THE LEXEME SCAN IS TURNED OFF IF
A BLOCK IS DECLARED. HENCE, AT THIS POINT WE MUST FIX UP MACRO
TYPE STRUCTURES, BY:
1. ERASING THE CODE GENERATED FOR THE STRUCTURE;
2. RELEASING THE FUNCTION HEADER FROM FCNLIST;
3. SETTING THE STE TO INDICATE A MACRO-TYPE STRUCTURE. %
% CHECK FOR STRUCTURE OF MACRO-TYPE: %
IF .RFSTRB THEN
(IF .STRDEF
THEN (IF .CODETOG THEN (ERASE(.L2); CLEARRTGT());
ST[.RFSTE,1]<SIMBITAF>_1;
ST[.RFSTE,1]<LXTEAF>_.CURST;
STRECOPY();
RETURN 1;)
ELSE RELSTRLIST(.CURST));
0
END;
!END OF H1DECL.BLI