! File:   DECLAR.BLI
!
Module DECLAR=
Begin
!				DECLAR MODULE
!				-------------
!
!	THIS MODULE PROCESSES DECLARATIONS.
!
Require 'Bliss';

External Routine
	decl_routine	: Novalue,
	decl_gbl_routine: Novalue,
	decl_require	: Novalue,
	decl_psect	: Novalue,
	decl_macro	: Novalue,
	decl_linkage	: Novalue,
	SWITCHER	: Novalue,
	struct_get_size;

Own
	STE		: Ref ST,
	DECLSIZE	: Integer,
	STELIST		: Ref ST,
	STELAST		: Ref ST,
	STRSTE		: Ref ST,
	OTYPE		: Integer,
	idx_reg		: Integer,
	MUSTDECLARE	: Boolean,
	WASANEQUAL	: Boolean;

Forward Routine
	ERRDECL		: Novalue,
	DCLARE		: Novalue,
	DEFOG,
	DEFASYM		: Novalue,
	eql_initializer,
	decl_forward	: Novalue,
	decl_undeclare	: Novalue,
	STARTLNKG,
	STARTNAME,
	MAYBEDECLARE,
	STARTCOL,
	CONTIDLIST,
	MAPONE,
	ENDIDBATCH,
	eql_bind,
	eql_gbl_bind,
	eql_register,
	DOEQL,
	GROMLIST	: Novalue,
	post_global,
	post_own,
	post_stacklocal,
	post_local,
	post_external,
	post_label,
	post_register,
	post_bind,
	post_gbl_bind,
	decl_local	: Novalue,
	decl_stacklocal	: Novalue,
	decl_own	: Novalue,
	decl_global	: Novalue,
	decl_external	: Novalue,
	decl_label	: Novalue,
	decl_register	: Novalue,
	decl_bind	: Novalue,
	decl_gbl_bind	: Novalue,
	decl_map	: Novalue,
	SSETSIZE	: Novalue,
	decl_byte	: Novalue,
	decl_word	: Novalue,
	decl_switches	: Novalue,
	decl_module	: Novalue;

Own
    DECLARATORS		: Vector[22,Long] Preset(
			[DCLBYTE]	= decl_byte,
			[DCLOWN]	= decl_own,
			[DCLGLO]	= decl_global,
			[DCLEXT]	= decl_external,
			[DCLROU]	= decl_routine,
			[DCLSTR]	= decl_structure,
			[DCLMAP]	= decl_map,
			[DCLFOR]	= decl_forward,
			[DCLBIN]	= decl_bind,
			[DCLMAC]	= decl_macro,
			[DCLUND]	= decl_undeclare,
			[DCLLAB]	= decl_label,
			[DCLWORD]	= decl_word,
			[DCLSWI]	= decl_switches,
			[DCLLOC]	= decl_local,
			[DCLREG]	= decl_register,
			[DCLENABLE]	= decl_enable,
			[DCLREQU]	= decl_require,
			[DCLSLOCAL]	= decl_stacklocal,
			[DCLLNKG]	= decl_linkage,
			[DCLPSECT]	= decl_psect);


Macro
	ALLIGN(TABLE,NBYTE)=If .TABLE And Not NBYTE
			      Then TABLE = .TABLE+1 %,
	NEXTINTAB(TABLE,S)=(S[gt_disp] = .TABLE;
			      TABLE = .TABLE+.S[st_var_size]) %,
	BYTES(S)=(.S[gt_len]/8) %;

Macro
	SXCTDECL	= bliss(.DECLARATORS[.DEL<lex_index>]) %;

Global Routine ERRDECL : Novalue =
Begin
    pos_open = .pos_del;
    SXCTDECL	! FOR ERROR HANDLING--SEE RUNC IN SYNTAX
End;

Global Routine DCLARE : Novalue =
Begin
    Local
	SAVEL		: Integer;

! note that we are inside a declaration and set the default allocation
! unit to a word. also set up for error recovery

    INDCL;
    DECLSIZE = 2;
    savel = .lastend;
    lastend[PS_SEMICOLON] = TRUE;

! loop for all declarations

    While .DEL<lex_class> Eql CL_DECL Do
	Begin
	If .SYM Neq NIL Then
	    Begin
	    SYM = NIL;
	    ERROR(.pos_open,.pos_sym,0,B11$_SUPERFLUOUS)
	    End
	Else
	    Begin
	    pos_open = .pos_del;
	    SXCTDECL;
	    If .DEL Neq TK_SEMICOLON Then
		ERROR(.pos_open,.pos_del,0,B11$_MISSING_SEMICOLON)
	    Else
		RUND(QL_LEXEME)
	    End
	End;

! round up the next stack address

    If .NEXTLOCAL Then
	NEXTLOCAL = .NEXTLOCAL+1;

! restore the previous state and note the last good position

    RESINDECL;
    lastend = .savel;
    pos_good = .pos_del
End;

!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.

Global Routine DECLARESYM(WHERE,TYPE : Integer,ERRHURTS : Boolean) =
Begin
    Local
	S		: Ref ST,
	MSGTYPE,
	ERRLOC;

! assume an error of a missing name

    MSGTYPE = B11$_MISSING_SYMBOL;
    ERRLOC = .pos_sym;

! if no symbol then check to see if there was an attempt to declare a
! reserved word

    If .SYM Eql NIL Then
	Begin
	ERRLOC = .pos_del;
	If .flg_reserved_word Then
	    Begin
	    RUNDE();
	    MSGTYPE = B11$_DECLARE_RESERVED
	    End
	End;

! the quote level to get this symbol was Q_NAME.  if it was bound then
! that probably means the user used %UNQUOTE wrongly.

    If .SYM[gt_type] Eql T_SYMBOL Then
	Begin
	WARNEM(.ERRLOC,B11$_MISSING_SYMBOL);
	SYM = .SYM[st_name]
	End

! make sure there is a symbol to declare

    Else If .SYM[gt_type] Neq T_NAME Then
	Begin
	If .ERRHURTS Then
	    ERROR(.pos_open,.ERRLOC,0,.MSGTYPE)
	Else
	    WARNEM(.ERRLOC,.MSGTYPE);
	Return FALSE
	End;

! if inside a structure expansion then hide any previous symbol.
! symbols declared within structure expansions never conflict.
!
! Q: why not just add it to the test below?  am I missing something?

    If .mac_type Eql SRC_STRUCTURE And .SYM[nt_symb] Neqa 0 Then
	STINSERT(.SYM,S_UNDECLARE,0);

! check for a previous symbol at the same block level.

    S = .SYM[nt_symb];
    If .S Neqa 0 And .S[st_code] Neq S_UNDECLARE And
		.S[st_scope] Geq .level_block Then
	WARNEM(.pos_sym,B11$_SYMBOL_REDECLARED,.S);

! enter the new symbol into the symbol table

    .WHERE = STINSERT(.SYM,.TYPE,0);
    Return TRUE
End;

! define OWN/GLOBAL symbols

Routine DEFOG(TABLE,S : Ref ST,REQIN : Boolean,RELIN : Boolean,INIT : Ref CELL) =
Begin

! make sure the table is aligned properly for this symbol's allocation unit

    ALLIGN(.TABLE,BYTES(S));

! if initialized then note it and save the initialization info.  also note
! whether this is the first instance of this info.  symbols grouped together
! share the same initialization info.

    If .REQIN Then
	Begin
	S[st_v_init]         = TRUE;
	S[st_v_release_init] = .RELIN;
	S[st_var_init]       = .INIT
	End;
    S[gt_reg] = PC;

! if a plit, allocate a word for the count

    If .S[st_v_plit] And .S[st_v_counted] Then
	.TABLE = ..TABLE + WRDSZ/8;

! allocate an address in the psect

    NEXTINTAB(.TABLE,S);

! allocate use/change lists

    INITSYMLSTS(.S);
    S[gt_mode] = ABSOLUTE;
    Return FALSE
End;

! define a global symbol

Global Routine DEFGLO(S : Ref ST,REQIN : Boolean,RELIN : Boolean,INIT : Ref CELL) =
Begin
    Return DEFOG(NEXTGLOBAL,.S,.REQIN,.RELIN,.INIT)
End;

! define a symbol's allocation

Global Routine DEFASYM(S : Ref ST,NOBYTES : Integer,POS : Integer,SIZ : Integer) : Novalue =
Begin
    S[st_var_size]    = .NOBYTES;
    S[gt_pos]         = .POS;
    S[gt_len]         = .SIZ;
    S[st_var_linkage] = .sym_linkage
End;

! called when a '=' is seen to parse an initializer for OWN and GLOBAL
! variables

Routine eql_initializer =
Begin
    Local
	PLITP		: Ref ST,
	ERR		: Integer,
	SIZ		: Integer;

    ERR = .pos_del;
    OLDDELI = %o'126';			! 'PLIT' SIGNAL TO DETBRACKET
    SIZ = SPLITB(PLITP) * WRDSZ/8;
    If .SIZ Gtr .unit_size Then
	Begin
	If Not .NOTREE Then
	    WARNEM(.ERR,B11$_INITIAL_SIZE);
	unit_size = .SIZ
	End;
    SYM = .PLITP;
    Return FALSE
End;

!
! CALLED BY SFORWARD, GLOBROUT, AND SROUTINE
! PARSES THE LINKAGE NAME OF THE ROUTINE
!
Global Routine GETLNKG =
Begin
    Local
	LNKGNM		: Ref ST;

    LNKGNM = .sym_bliss;
    If .DEL Eql TK_ERROR Then
	Begin
	LNKGNM = .SYM[nt_symb];
	If .LNKGNM Eqla 0 Or .LNKGNM[st_code] Neq S_LINKAGE Then
	    Begin
	    WARNEM(.pos_sym,B11$_INVALID_LINKAGE);
	    LNKGNM = .sym_bliss
	    End;
	RUND(QL_NAME)
	End;
    Return .LNKGNM
End;

!
!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.
!
!			4. GENERATE INFORMATION FOR THE ROUTINE.
!
!			5. WE SHOULD HAVE A COMMA NEXT, OR A ';'

Routine decl_forward : Novalue =
Begin
    Local
	S		: Ref ST,
	LNKGNM		: Ref ST;

    Do
	Begin
	RUND(QL_NAME);
	LNKGNM = GETLNKG();
	If DECLARESYM(S,S_FORWARD,FALSE) Then
	    Begin
	    S[st_v_no_acts]   = TRUE;
	    S[st_var_actuals] = .sym_vector;
	    S[st_var_linkage] = .LNKGNM;
	    S[gt_pos]         = 0;
	    S[gt_len]         = 16;
	    S[gt_reg]         = PC;
	    S[gt_mode]        = (If .swit_pic Then RELATIVE Else ABSOLUTE);
	    End
	End
    While .DEL Eql TK_COMMA
End;

Routine decl_undeclare : Novalue =
Begin
    Do
	Begin
	RUND(QL_NAME);
	STINSERT(.SYM,S_UNDECLARE,0)
	End
    While .DEL Eql TK_COMMA
End;

Routine STARTLNKG =
Begin
    Local
	S		: Ref ST;
    Label
	aaa;

    sym_linkage = .sym_bliss;
    If .DEL Eql TK_ERROR Then
	aaa: Begin
	Macro FORGET(WARNTYPE) =
		Begin
		WARNEM(.pos_sym,WARNTYPE);
		RUND(QL_NAME);
		Leave aaa
		End  %;

	If .SYM[gt_type] Neq T_NAME Then
	    FORGET(B11$_NOT_A_STRUCTURE);
	s = .SYM[nt_symb];
	If .S Eql .sym_trap Then
	    FORGET(B11$_TRAP_LINKAGE);
	If .S[st_code] Neq S_LINKAGE Then
	    Return 0;
	sym_linkage = .S;
	RUND(QL_NAME)
	End;
    Return 0
End;

!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.

Routine STARTNAME =
Begin
    Local
	S		: Ref ST;

    If .DEL Eql TK_ERROR Then
	Begin
	Macro FORGET(WARNTYPE) =
		Begin
		WARNEM(.pos_sym,WARNTYPE);
		RUND(QL_NAME);
		Return 0
		End  %;

	If .SYM[gt_type] Neq T_NAME Then
	    FORGET(B11$_NOT_A_STRUCTURE);
	S = .SYM[nt_symb];
	If .S[st_code] Neq S_STRUCTURE Then
	    FORGET(B11$_NOT_A_STRUCTURE);
	RUND(QL_NAME);
	STRSTE = .S
	End;
    Return 0
End;

!I. GENERAL:
!
!	1. THIS ROUTINE DECLARES THE SYMBOL IN 'SYM' IF IT 
!	   SHOULD BE
!
!	2. RETURNS:
!
!		A. THIS ROUTINE RETURNS A 1 IF THERE WERE
!		   ANY ERRORS FOUND DURING DECLARATION.

Routine MAYBEDECLARE(ERRHURTS : Boolean) =
Begin
    If .MUSTDECLARE Then
	Return Not DECLARESYM(STE,.OTYPE,.ERRHURTS);
    STE = .SYM[nt_symb];
    Return FALSE
End;

!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>]:...

Routine STARTCOL =
Begin
    If MAYBEDECLARE(TRUE) Then
	Return TRUE;
    STELAST = STELIST = GETSPACE(SZ_STELIST);
    STELIST[ste_symb] = .STE;
    STELIST[ste_pos]  = .pos_sym;
    Return FALSE
End;

!I. GENERAL:
!
!	1. THIS ROUTINE SIMPLY CONTINUES DECLARING SYMBOLS
!	   IN 'SYM'.
!
!	2. WINDOW IN:
!
!		A. (<NAME1> , ':' )
!
!	3. WINDOW OUT:
!
!		A. (<NAME2> , ':'/'['/','/';' )

Routine CONTIDLIST =
Begin
    Local
	SAVSTE		: Ref ST;

    RUND(QL_NAME);
    If MAYBEDECLARE(FALSE) Then
	Return TRUE;
    SAVSTE = .STELAST;
    SAVSTE[ste_next]  = STELAST = GETSPACE(SZ_STELIST);
    STELAST[ste_symb] = .STE;
    STELAST[ste_pos]  = .pos_sym;
    Return FALSE
End;

Routine MAPONE(POS : Integer,FIRST : Boolean) =
Begin
    Local
	STEE		: Ref ST,
	S		: Ref ST,
	p		: Ref Vector;

    S = .STE;
    If .OTYPE Geq 0 Then
	Begin
	If Not ISEXP(S) Then
	    Begin
	    WARNEM(.POS,B11$_CANT_MAP,.S);
	    Return FALSE
	    End;
	If .S[st_scope] Eql .level_block Then
	    Begin
	    If .S[st_var_actuals] Neqa 0 And Not .S[st_v_no_acts] And
			.S[st_v_release_acts] Then
		Begin
		p = .S[st_var_actuals];
		RELEASESPACE(.p,SZ_STREAM(.p[act_size]))
		End
	    End
	Else
	    Begin
	    STEE = .S;
	    SYM = .S[st_name];
	    DECLARESYM(S,S_BIND,FALSE);
	    DEFASYM(.S,0,0,8*.DECLSIZE);
	    S[st_bind_data] = BINDBIND(.STEE)
	    End
	End;
    If .ptr_actuals Neqa 0 Then
	Begin
	If S[st_v_release_acts] = .FIRST Then
	    ptr_actuals[act_symb] = .STRSTE;
	S[st_var_actuals] = .ptr_actuals
	End
    Else
	Begin
	S[st_v_no_acts] = TRUE;
	S[st_var_actuals] = .STRSTE
	End;
    Return FALSE
End;

Routine ENDIDBATCH(OFUN) =
Begin
    Local
	TEMP		: Ref ST,
	FIRSTACT	: Boolean;

    FIRSTACT = TRUE;
    Do
	Begin
	STE = .STELIST[ste_symb];
	If MAPONE(.STELIST[ste_pos],.FIRSTACT) Then
	    Return TRUE;
	If .MUSTDECLARE Then
	    Begin
	    DEFASYM(.STE,.unit_size,0,8*.DECLSIZE);
	    If Bliss(.OFUN,.FIRSTACT,.unit_size,.STE) Then
		Return TRUE
	    End;
	FIRSTACT = FALSE;
	TEMP     = .STELIST;
	STELIST  = .TEMP[ste_next];
	RELEASESPACE(.TEMP,SZ_STELIST)
	End
    While .TEMP Neq .STELAST;
    Return FALSE
End;

!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.

Global Routine WHICHBIND =
Begin
    Local
	TEMP,
	L		: Ref GT;

    EXPRESSION();
    SYM = BINDBIND(.SYM);

! GET RID OF <0,0> AND <0,8> BEFORE CHECKONELOCAL DOES SO

    If .SYM[gt_type] Eql T_NODE Then
	Begin
	L = .SYM[gt_arg2];
	If .SYM[gt_code] Neq OP_POINTER Or .L[gt_type] Neq T_LITERAL
			Or .L[gt_disp] Neq 0 Then
	    Begin
	    DYNBIND();
	    Return 0
	    End;
	L = .SYM[gt_arg3];
	If .L[gt_disp] Mod 8 Neq 0 Then
	    Begin
	    DYNBIND();
	    Return 0
	    End;
	SYM = RaiseChild(.SYM,0);
	If .SYM[gt_type] Eql T_NODE Then
	    Begin
	    DYNBIND();
	    Return 0
	    End
	End;
    If .SYM[gt_type] Eql T_LITERAL Then
	Return 1
    Else
	Return 2
End;

! called after a '=' is seen in a BIND declaration

Routine eql_bind =
Begin
    RUND(QL_LEXEME);
    WHICHBIND();
    Return FALSE
End;

! called after a '=' is seen in a GLOBAL BIND declaration

Routine eql_gbl_bind =
Begin
    RUND(QL_LEXEME);
    Case WHICHBIND() From 0 To 2 Of Set
	[0]:
	    Begin
	    WARNEM(.pos_sym,B11$_WANT_LTCE);
	    FreeSym();
	    SYM = MakeLit(0)
	    End;
	[1]:
	    0;
	[2]:
	    Begin
	    If .SYM[gt_type] Neq T_VARIABLE Or Not LOADCONST(SYM) Then
		Begin
		WARNEM(.pos_sym,B11$_WANT_LTCE);
		FreeSym();
		SYM = MakeLit(0)
		End
	    End
    Tes;
    Return FALSE
End;

!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.

Routine eql_register =
Begin
    Local
	pos		: Integer;

    pos = .pos_del;
    RUND(QL_LEXEME);
    idx_reg = Ctce();
    If .idx_reg Gtru 5 Then
	Begin
	WARNEM(.POS,B11$_INVALID_REGISTER,.idx_reg);
	idx_reg = 0
	End;
    Return FALSE
End;

!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.

Routine DOEQL(OEQL) =
Begin
    If .DEL Eql TK_EQUAL Then
	Begin
	WASANEQUAL = TRUE;
	If .OEQL Eql 0 Then
	    Begin
	    WARNEM(.pos_del,B11$_NO_EQUAL_WANTED);
	    Return eql_initializer()
	    End;
	Return Bliss(.OEQL,.unit_size)
	End;
    WASANEQUAL = FALSE;
    If .OTYPE Eql S_BIND Then
	Begin
	ERROR(.pos_open,.pos_del,0,B11$_MISSING_EQUAL);
	Return TRUE
	End
    Else
	Return FALSE
End;

!
!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.
!
!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.

Routine GROMLIST(GRLTYPE,GRLFUN,GRLEQL) : Novalue =
Begin
    Local
	SAVTYPE,
	SAVE_EQUAL,SAVE_MUST;

    pos_open    = .pos_del;
    SAVTYPE     = .OTYPE;
    SAVE_EQUAL  = .WASANEQUAL;
    SAVE_MUST   = .MUSTDECLARE;
    OTYPE       = .GRLTYPE;
    MUSTDECLARE = .GRLTYPE Geq 0;
    Do
	Begin
	RUND(QL_NAME);
	If STARTLNKG() Then
	    Return;
	ptr_actuals = 0;
	STRSTE = .sym_vector;
	If STARTNAME() Then
	    Return;
	While TRUE Do
	    Begin
	    If STARTCOL() Then
		Return;
	    While .DEL Eql TK_COLON Do
		If CONTIDLIST() Then
		    Return;
	    unit_size = .DECLSIZE;
	    If .DEL Neq TK_COLON Then
		struct_get_size(.STRSTE,.OTYPE,.DECLSIZE);
	    If DOEQL(.GRLEQL) Then
		Return;
	    If ENDIDBATCH(.GRLFUN) Then
		Return;
	    If .DEL Neq TK_COLON Then
		Exitloop;
	    RUND(QL_NAME)
	    End
	End
    While .DEL Eql TK_COMMA;
    OTYPE       = .SAVTYPE;
    WASANEQUAL  = .SAVE_EQUAL;
    MUSTDECLARE = .SAVE_MUST
End;

! post-processor for a GLOBAL declaration

Routine post_global(FIRST : Boolean,SIZE : Integer,S : Ref ST) =
Begin
    Return DEFGLO(.S,.WASANEQUAL,.FIRST,.SYM)
End;

! post-processor for an OWN declaration

Routine post_own(FIRST : Boolean,SIZE : Integer,S : Ref ST) =
Begin
    Return DEFOG(NEXTOWN,.S,.WASANEQUAL,.FIRST,.SYM)
End;

! post-processor for a STACKLOCAL declaration

Routine post_stacklocal(FIRST : Boolean,SIZE : Integer,S : Ref ST) =
Begin
    ALLIGN(NEXTLOCAL,BYTES(S));
    NEXTLOCAL         = .NEXTLOCAL+.STE[st_var_size];
    STE[gt_disp]      = -.NEXTLOCAL;
    S[gt_reg]         = SP;
    S[gt_mode]        = INDEXED;
    S[st_v_nouplevel] = TRUE;
    INITSYMLSTS(.S);
    Return FALSE
End;

! post-processor for a LOCAL declaration

Routine post_local(FIRST : Boolean,SIZE : Integer,S : Ref ST) =
Begin
    Local
	TN		: Ref GT;

    If .SIZE Neq 2 Then
	Return post_stacklocal(.FIRST,.SIZE,.S);
    TN = S[gt_reg]    = GETTN();
    TN[tn_request]    = BIND_DECLARE;
    TN[tn_depth]      = .LOOPDEPTH;
    S[gt_mode]        = GENREG;
    S[st_v_nouplevel] = TRUE;
    INITSYMLSTS(.S);
    Return FALSE
End;

!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.

Global Routine post_external(FIRST : Boolean,SIZE : Integer,S : Ref ST)=
Begin
    S[gt_reg]  = PC;
    S[gt_disp] = 0;
    S[gt_mode] = ABSOLUTE;
    INITSYMLSTS(.S);
    Return FALSE
End;

Routine post_label(FIRST : Boolean,SIZE : Integer,S : Ref ST) =
Begin
    Return FALSE
End;

!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.

Routine post_register(FIRST : Boolean,SIZE : Integer,S : Ref ST)=
Begin
    Local
	TN		: Ref GT;

    TN = S[gt_reg] = GETTN();
    S[gt_mode]        = GENREG;
    S[st_v_nouplevel] = TRUE;

! if there was an '=', get the register index and allow up-level
! references to it unless it was a reserved register.

    If .WASANEQUAL Then
	Begin
	TN[tn_request] = BIND_REGISTER;
	TN[gt_reg]     = .idx_reg;
	If .RESERVED<.idx_reg,1,0> Then
	    S[st_v_nouplevel] = FALSE
	End
    Else
	TN[tn_request] = BIND_ANY_REGISTER;
    TN[tn_depth] = .LOOPDEPTH;
    INITSYMLSTS(.S);
    Return FALSE
End;

Routine post_bind(FIRST : Boolean,SIZE : Integer,S : Ref ST)=
Begin
    S[st_bind_data] = .SYM;
    S[st_v_nouplevel] = 
	    (Case .SYM[gt_type] From T_LITERAL To T_NODE Of Set
		[ Inrange, Outrange ]:
		    Begin
		    Punt(666);
		    FALSE
		    End;
		[ T_LITERAL ]:
		    FALSE;
		[ T_VARIABLE ]:
		    .Block[.SYM[gt_disp],st_v_nouplevel];
		[ T_NODE ]:
		    TRUE
	    Tes);
    Return TRUE
End;

Routine post_gbl_bind(FIRST : Boolean,SIZE : Integer,S : Ref ST) =
Begin
    S[st_bind_data]  = .SYM;
    S[st_v_gbl_bind] = TRUE;
    Return TRUE
End;

! 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 decl_local : Novalue =
Begin
    GROMLIST(S_LOCAL,post_local,0)
End;

Routine decl_stacklocal : Novalue =
Begin
    GROMLIST(S_LOCAL,post_stacklocal,0)
End;

Routine decl_own : Novalue =
Begin
    GROMLIST(S_OWN,post_own,eql_initializer)
End;

Routine decl_global : Novalue =
Begin
    RUND(QL_NAME);
    If .SYM Eql NIL Then
	Selectone .DEL Of Set
	    [TK_ROUTINE]:
		Begin
		decl_gbl_routine();
		Return
		End;
	    [TK_BIND]:
		Begin
		decl_gbl_bind();
		Return
		End
	Tes;
    mac_v_peek = TRUE;
    GROMLIST(S_GLOBAL,post_global,eql_initializer)
End;

Routine decl_external : Novalue =
Begin
    GROMLIST(S_EXTERNAL,post_external,0)
End;

Routine decl_label : Novalue =
Begin
    GROMLIST(S_LABEL,post_label,0)
End;

Routine decl_register : Novalue =
Begin
    GROMLIST(S_REGISTER,post_register,eql_register)
End;

Routine decl_gbl_bind : Novalue =
Begin
    GROMLIST(S_BIND,post_gbl_bind,eql_gbl_bind)
End;

Routine decl_bind : Novalue =
Begin
    GROMLIST(S_BIND,post_bind,eql_bind)
End;

Routine decl_map : Novalue =
Begin
    GROMLIST(-1,0,0)
End;

Routine SSETSIZE(N : Integer) : Novalue =
Begin
    DECLSIZE = .N;
    RUND(QL_LEXEME);
    If .SYM Neq NIL Then
	ERROR(.pos_open,.pos_sym,0,B11$_SUPERFLUOUS)
    Else If .DEL<lex_class> Neq CL_DECL Then
	ERROR(.pos_open,.pos_del,0,B11$_MISSING_DECLARATION)
    Else
	Begin
	pos_open = .pos_del;
	SXCTDECL;
	DECLSIZE = 2
	End
End;

Routine decl_byte : Novalue =
Begin
    SSETSIZE(1)
End;

Routine decl_word : Novalue =
Begin
    SSETSIZE(2)
End;

!I. GENERAL:
!
!	1. THIS ROUTINE IS USED TO DECLARE A REGISTER FOR THE
!	   INDEX OF AN 'INCR' OR 'DECR' LOOP EXPRESSION.
!
!II. SPECIFIC:
!
!	1. *
!
!		B. SET DECLARATION FLAGS.
!
!		C. DECLARE THE REGISTER, AND RETURN IF
!		   THERE ARE ANY ERRORS.
!
!		D. DO THINGS UNIQUE TO REGISTER DECLARATION.

Global Routine decl_incr_variable =
Begin
    Local
	S		: Ref ST;

    If Not DECLARESYM(S,S_LOCAL,TRUE) Then
	Return 0;
    post_local(FALSE,2,.S);
    S[gt_pos] = 0;
    S[gt_len] = 16;
    Return .S
End;

Routine decl_switches : Novalue =
Begin
    Local
	pos_open;

    pos_open = .pos_del;
    SWITCHER(FALSE);
    If .DEL Neq TK_SEMICOLON Then
	Begin
	ERROR(.pos_open,.pos_del,0,B11$_MISSING_SEMICOLON);
	Return
	End
End;

! called from main

Global Routine decl_module : Novalue =
Begin
    Local
	NAME		: Ref GT;

    FLOWINIT();

! skip over 'MODULE'

    RUND(QL_NAME);

! if a module name was given then save it

    If .SYM Neq NIL Then
	Begin
	MODNAME = SYM[nt_data];
	CSNAME  = .MODNAME;
	SYM     = NIL
	End;

! check for module switches

    If .DEL Eql TK_CALL Then
	Begin
	SWITCHER(TRUE);
	If .DEL Eql TK_RPAREN Then
	    RUND(QL_LEXEME)
	End;

! checl for '='

    If .DEL Neq TK_EQUAL Or .SYM Neq NIL Then
	WARNEM(.pos_del,B11$_MISSING_EQUAL)
    Else
	RUND(QL_LEXEME);

! was at scope level 0.  this is the first user level

    RaiseScope();

! enter the module name as a routine name

    NAME = SEARCH(.MODNAME);
    STE = STINSERT(.NAME,S_GBL_ROUTINE,0);

! set the default linkage and declare the module

    sym_linkage = .sym_bliss;
    DEFASYM(.STE,WRDSZ/8,0,16);
    DEFGLO(.STE,FALSE,0,0);

! parse the module body

    EXPRESSION();

! check for 'ELUDOM'

    If .DEL Neq TK_ELUDOM Then
	WARNEM(0,B11$_MISSING_ELUDOM);
    LowerScope();

! find all potential named-CSE's

    GETNCSE()
End;

End
Eludom