!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