;
;
;COPYRIGHT (C) 1975,1981,1982 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;
;
;
;SUBTTL DECLARATION MODULE

; WRITTEN BY T. TEITELBAUM, L. SNYDER, C.M.U.
; EDITED BY R. M. DE MORGAN.

	HISEG

	SEARCH ALGPRM,ALGMAC	; SEARCH PARAMETER FILES
MODULE MDEC;
BEGIN
$PLEVEL=0;
EXTERN STABLE,ETABLE,LTABLE,FTABLE,DCBYTE,PRIOBYTE,DESCBYTE;
EXPROC RUND,RUND2,RUND3,RUND5,FATRUND,FAIL,ERREAD,ERR;
EXPROC BENTRY,BEXIT,SONOFF,MABS,SBEGIN,PCALL,PRSYM;
EXPROC MREL,MREL0,ABSFIX,GCOND,REOPEN,UNSTACK,CLOSE;
EXPROC IPLUNK,RAFIX,SEMERR,XTNDLB,SCOL;
EXPROC GSTAT,EVAL,CGINT,TOSTACK,MOB,MPS,MJRST0,PMBPLT;
EXPROC SNBLK,MRK.0,MRK.8,MRK.9;
SUBTTL FRONT END OF DECLARATION OF PROCEDURE SPRODEC.
PROCEDURE SPRODEC;
;WARNING!! DONT DECLARE ANY REGISTERS WITHOUT CHANGING ALL MODULE INITIALIZATIONS.
BEGIN
REGISTER FORMCHAIN;
LOCAL FORMCT,PNAME,FSDISP,MXDISP,ST11,RELBLOCK,PARAM1,PARAM2;
;..JUMP AROUND ALL OTHER PROCEDURES BEING DECLARED WITHIN THIS ONE;
GOTO SPRO1;


;..PUT THE FOLLOWING ROUTINES AT THE INNERMOST PROCEDURE LEVEL.
;..	THIS WAY, THEY WILL NOT USE THE DISPLAY REGISTER FOR THEIR LOCALS.
$PLEVEL=$PLEVEL+1;
SUBTTL ROUTINE COMPOSEDEC TO GATHER MULTIPLE WORD DECLARATIONS.

PROCEDURE COMPOSEDEC;
BEGIN
 REGISTER STATE,KTS,XDEL;
 FORMAL REQUEST;
 IF SYM NE PHI
				JUMPE	SYM,FALSE;$
   THEN
     FAIL(8,SOFT,SYM,ILLEGAL SYMBOL);
 FI;

 ;STATE_KTS_0;
				SETZB	STATE,KTS;$
NXTDEL:
 ;XDEL_DEL<DISCRIM>;
				LDB	XDEL,DESCBYTE;$
 ;KTS_KTS OR COMBTABLE[XDEL];
				IOR	KTS,COMBTABLE(XDEL);$
 ;XDEL_DEL<TRANSCLASS>;
				LDB	XDEL,[POINT 4,DEL,22];$
 ;STATE_TRANSMATRIX[STATE,XDEL];
				LDB	STATE,TRANSITION(XDEL);$
 IF NDEL = DECSPEC AND NDEL NE KWSTST
				MOVE	T,NDEL;$
				TEST(E,T,DECSPEC);$
				TEST(E,T,KWSTST);$
				GOTO	FALSE;$
   THEN
     BEGIN
       IF NSYM NE PHI
				SKIPN	NSYM;$
				GOTO	FALSE;$
	 THEN
	   BEGIN
	     IF STATE ELEMENT FINAL
				CAIGE	STATE,10;$
				GOTO	FALSE;$
	       THEN
		 GOTO L;
	       ELSE
		 FAIL(8,SOFT,NSYM,ILLEGAL SYMBOL);
	     FI;
	   ENDD;
       FI;

       RUND;
       GOTO NXTDEL;
     ENDD;
 FI;
 IF STATE ELEMENT FINAL
				CAIGE	STATE,10;$
				GOTO	FALSE;$
   THEN
L:   BEGIN
	IF KTS<TYPE> = COMPLEX
				TLNE	KTS,$TYPE;$
				T.C(KTS);$
	  THEN
	    BEGIN
	      FAIL(21,FRIED,DEL,COMPLEX NOT IMPLEMENTED);
	      ;KTS<TYPE>_'REAL';
				TLZ	KTS,$TYPE;$
				TLO	KTS,$R;$
	    ENDD;
	FI;
	IF KTS<LONG BIT>
				TLZN	KTS,$LONGBIT;$
				GOTO	FALSE;$
	  THEN
	    BEGIN
	      ;KTS<LONG BIT>_FALSE;
	      IF KTS<TYPE> = REAL
				TLNE	KTS,$TYPE;$
				T.R(KTS);$
		THEN
		ELSE
		  FAIL(22,SOFT,DEL,LONG MUST BE FOLLOWED BY REAL);
	      FI;
	      ;KTS<TYPE>_'LONG REAL';
				TLZ	KTS,$TYPE;$
				TLO	KTS,$LR;$
	    ENDD;
	FI;
	;T_REQUEST;
				MOVE	T,REQUEST;$
	;SELECT[STATE-10];
				PUSHJ	SP,@XANAL-10(STATE);$
     ENDD;
   ELSE
     BEGIN
	FAIL(25,HARD,DEL,ILLEGAL DECLARATION-SPECIFICATION);
	IF KTS<KIND> = PROC
				T.PRO(KTS);$
	  THEN
		;DEL_PROCEDURE;
				MOVE	DEL,ZPROCEDURE;$
		SFALSE(ERRL);
		;KTS_.SPRODEC;
				MOVEI	KTS,.SPRODEC;$
	FI;
     ENDD;
 FI;
 ;SYM_KTS;
				MOVE	SYM,KTS;$
 ;RETURN LEXEME AND PROCESSING ROUTINE ADDR. IN SYM
ENDD
PROCEDURE SPCHECK;
BEGIN
 IF SPECIFICATION AND KTS<STATUS> ELEMENT [OWN EXTERNAL FORWARD]
				TRNN	T,.SPSEL;$
				GOTO	FALSE;$
				HLRZ	T,KTS;$
				ANDI	T,$STATUS;$
				CAIL	T,$OWN;$
				CAILE	T,$FOW;$
				GOTO	FALSE;$
 THEN
  BEGIN
    FAIL(24,FRIED,DEL,ILLEGAL SPECIFICATION);
    ;KTS<STATUS>_'SIMPLE';
				TLZ	KTS,$STATUS;$
  ENDD;
 FI;
ENDD;


;..FORWARD;
PROCEDURE XANL0;
  BEGIN
    SPCHECK;
    ;KTS<DECL>_FALSE;
				TLZ	KTS,$DECL;$
    ;KTS<TYPE>_'LABEL';
				TLO	KTS,$L;$
  ENDD;

;..OWN VARIABLES (NOT INCLUDING ARRAYS).
PROCEDURE XANL1;
  BEGIN
  SPCHECK;
  ;KTS<ROUTINE>_@SIMP;
				HRRI	KTS,.SIMP;$
  ENDD;

;..SIMPLE VARIABLES.
PROCEDURE XANL2;
  BEGIN
  ;KTS<ROUTINE>_@SIMP;
				HRRI	KTS,.SIMP;$
  ENDD;
;..VALUE AND LABEL.
PROCEDURE XANL3;
  BEGIN
  IF DECLARATION
				TRNN	T,.DECSEL;$
				GOTO	FALSE;$
    THEN
      FAIL(23,HARD,DEL,LABEL-VALUE NOT DECLARATION);
  FI;
  ENDD;

;..SIMPLE AND OWN ARRAYS.
PROCEDURE XANL4;
  BEGIN
  SPCHECK;
  IF KTS<TYPE> = 0
				T.PHI(KTS);$
    THEN
      ;KTS<TYPE>_'REAL';
				TLO	KTS,$R;$
  FI;
  ENDD;
;..SIMPLE,FORWARD, AND EXTERNAL PROCEDURES.
PROCEDURE XANL5;
  BEGIN
  SPCHECK;
  IF KTS<TYPE> = 0
				T.PHI(KTS);$
    THEN
      ;KTS<TYPE>_'NON TYPE';
				TLO	KTS,$N;$
  FI;
  IF KTS<STATUS> = SIMPLE
				T.SIM(KTS);$
    THEN
      ;KTS<ROUTINE>_@SPRODEC;
				HRRI	KTS,.SPRODEC;$
  FI;
  ENDD;

;..SIMPLE AND FORWARD SWITCHES.
PROCEDURE XANL6;
  BEGIN
   SPCHECK;
   IF KTS<STATUS> = SIMPLE
				T.SIM(KTS);$
     THEN
       ;KTS<ROUTINE>_@SWDEC;
				HRRI	KTS,.SSWDEC;$
  FI;
  ENDD;
;..FORWARD LABEL;
PROCEDURE XANL7;
BEGIN
 SPCHECK;
 IF DEL EQ 'LABEL'
				CAME	DEL,ZLABEL;$
				GOTO	FALSE;$
 THEN
  ;KTS<DECL>_FALSE;
				TLZ	KTS,$DECL;$
 ELSE
  ;..ERROR IS "FORWARD VALUE";
  FAIL(25,DEL,HARD,ILLEGAL DECLARATION-SPECIFICATION);
 FI;
ENDD;
TRANSMATRIX:

;          0  1  2  3  4  5  6  7 10

;		    V
;		    A
;		    L     P
;	   E        U     R
;	   X     F  E     O
;	   T     O  '     C  S
;	   E     R  L  A  E  W
;	   R     W  A  R  D  I  L  T
;	   N  O  A  B  R  U  T  O  Y
;	   A  W  R  E  A  R  C  N  P
;	   L  N  D  L  Y  E  H  G  E 
;					WHERE TYPE ::=
;						 <INTEGER REAL BOOLEAN STRING COMPLEX>.

  BYTE(4) 01,05,10,13,14,15,16,07,12;  0
  BYTE(4) 06,06,06,06,06,15,06,02,04;  1
  BYTE(4) 06,06,06,06,06,15,06,06,04;  2
  BYTE(4) 06,06,06,06,14,06,06,06,11;  3
  BYTE(4) 06,06,06,06,06,15,06,06,06;  4
  BYTE(4) 06,06,06,06,14,06,06,03,11;  5
  BYTE(4) 06,06,06,06,06,06,06,06,06;  6
  BYTE(4) 06,06,06,06,14,15,06,06,12;  7
  BYTE(4) 06,06,06,17,06,15,16,02,04;  10  FINAL
  BYTE(4) 06,06,06,06,14,06,06,06,06;  11  FINAL
  BYTE(4) 06,06,06,06,14,15,06,06,06;  12  FINAL
  BYTE(4) 06,06,06,06,06,06,06,06,06;  13  FINAL
  BYTE(4) 06,06,06,06,06,06,06,06,06;  14  FINAL
  BYTE(4) 06,06,06,06,06,06,06,06,06;  15  FINAL
  BYTE(4) 06,06,06,06,06,06,06,06,06;  16  FINAL
  BYTE(4) 06,06,06,06,06,06,06,06,06;  17  FINAL


COMBTABLE:
  XWD	$DECL!$EXT,.SIMP;
  XWD	$DECL!$OWN,0;
  XWD	$DECL!$FOW,.SIMP;
  XWD	$DECL!$L,.SIMP;
  XWD	$DECL!$FOV,.SIMP;
  XWD	$DECL!$ARR,.SARYDEC;
  XWD	$DECL!$PRO,0;
  XWD	$DECL!$PRO!$L,0;
  XWD	$DECL!$LONGBIT,0;
  XWD	$DECL!$R,0;
  XWD	$DECL!$I,0;
  XWD	$DECL!$B,0;
  XWD	$DECL!$S,0;
  XWD	$DECL!$C,0;
TRANSITION:
REPEAT 11,<POINT	4,TRANSMATRIX(STATE),<.-TRANSITION>*4+3>;

XANAL:
XANL0;
XANL1;
XANL2;
XANL3;
XANL4;
XANL5;
XANL6;
XANL7;
SUBTTL ROUTINE TO SELECT DECLARATIONS
PROCEDURE DSEL;
BEGIN
SFALSE(ERRL);
IF DEL EQ PSEUDO-STATEMENT
				DELEL(KWSTST);$
 THEN
  SONOFF
 ELSE
  BEGIN
   ;COMPOSE MULTIPLE KEYWORD DECLARATION 
   ;CALL COMPOSEDEC;
				COMPOSEDEC;
				NOOP	.DECSEL;
   ;THE COMPOSED DELIMITER IS RETURNED IN SYM: (LEXEME,ROUTINE)
   WHILE DEL NOT AN ELEMENT OF STOPPERS
				NOTSTOP;$
    DO
    IF ERRL
				TGB(ERRL);$
      THEN
	RUND5
      ELSE
       BEGIN
       STRUE(DECLAR);
       ;CALL @SYM;
				PUSHJ	SP,(SYM);$
				NOOP	.DECSEL;$
       SFALSE(DECLAR);
      IF DEL#SC
				CAMN	DEL,ZSC;$
				GOTO	FALSE;$
	THEN
	FAIL(16,HARD,DEL,DECLARATION MUST BE FOLLOWED BY SC)
      FI;
      ENDD;
    FI;
  OD;
ENDD;
FI;
ENDD;
SUBTTL ROUTINE TO SELECT SPECIFIERS
DEFINE SPSEL
<
BEGIN
IF DEL EQ PSEUDO-STATEMENT
				DELEL(KWSTST);$
 THEN
  SONOFF
 ELSE
  BEGIN
   ;CALL COMPOSEDEC;
				COMPOSEDEC;$
				NOOP	.SPSEL;$
   WHILE DEL NOT ELEMENT OF STOPS
				NOTSTOPS;$
   DO
   IF ERRL
				TGB(ERRL);$
     THEN
	RUND5
     ELSE
	    BEGIN
	     ;CALL SIMP;
				SIMP;$
				NOOP	.SPSEL;$
	    ENDD;
   FI;
  OD;
  ENDD;
FI;
ENDD;
>
SUBTTL ROUTINE DUBDEC ... FOR DOUBLE DECLARATION OF VARIABLES.
PROCEDURE DUBDEC;
BEGIN
 SEMERR(106,0,UNDECLARED (UNSPECIFIED) IDENTIFIER);
 IF SYM NE PHI
				JUMPE	SYM,FALSE;$
  THEN
   BEGIN
EDIT(137)	; Don't try to mark constants as undeclared.
    IF SYM EQ CONSTANT					; [E137]
				T.CONST(SYM)		; [E137]
      THEN						; [E137]
	BEGIN						; [E137]
				TLZ	SYM,$SERRL	; [E137]
				TLO	SYM,$DECL	; [E137]
	ENDD						; [E137]
      ELSE						; [E137]
	BEGIN						; [E137]
	;ST[SYM]<SERRL>_TRUE;
	;ST[SYM]<DECL>_FALSE;
				TLO	SYM,$SERRL;$
				TLZ	SYM,$DECL;$
				HLLZM	SYM,STW1;$
	ENDD						; [E137]
    FI							; [E137]
   ENDD;
 FI;
ENDD;
SUBTTL ROUTINE TO DECLARE/SPECIFY LIST OF VARIABLES.
PROCEDURE SIMP;
BEGIN
REGISTER LEXVAL,SIMPSIZE,ST12;
FORMAL OLDEL;
 CODE GSMP1;
;----
 ;LEXVAL<LEX>_SYM<LEX>;
 ;LEXVAL<RHS>_0;
				HLLZM	SYM,LEXVAL;$
 ;..GIVE WARNING IF THIS DECLARATION IS FOLLOWING A PROCEDURE
 ;..OR SWITCH DECLARATION;
 IF NOT SPECIFICATION AND  PROSKIP NE 0
				MOVE	T,OLDEL;$
				TEST(N,T,.SPSEL);$
				SKIPN	T,PROSKIP;$
				GOTO	FALSE;$
 THEN
  BEGIN
   JOIN;..(PROSKIP);
   FAIL(26,DEL,SOFT,WARNING: VARIABLES DECLARED AFTER PROCEDURES OR SWITCHES);
   ZERO(PROSKIP);
  ENDD;
 FI;

 ;SIMPSIZE_1;
				MOVEI	SIMPSIZE,1;$
 IF LEXVAL<TYPE> ELEM [LONGREAL STRING COMPLEX]
				T.TWO(LEXVAL);$
   THEN
     ;SIMPSIZE_SIMPSIZE+1;
				ADDI	SIMPSIZE,1;$
 FI;
;-------
 ENDCODE;
;ST12_STOPS;
;STOPS_STOPS OR COMMA;
				SETSTOPS(ST12,.COM);$
LOOP
  BEGIN
  RUND5;
  WHILE DEL NOT ELEMENT OF STOPS
				NOTSTOP;$
    DO
      IF ERRL
				TGB(ERRL);$
        THEN
	  ERREAD
	ELSE
	  IF DEL = LBRA
				CAME	DEL,ZLBRA;$
				GOTO	FALSE;$
	    THEN
	      FAIL(27,HARD,DEL,IMPROPER ARRAY DECLARATION -SPECIFICATION);
	    ELSE
	      IF SYM=PHIS AND NSYM=PHIS
				SKIPN	NSYM;$
				JUMPE	SYM,TRUE;$
				GOTO	FALSE;$
		THEN
		  FAIL(28,HARD,DEL,CANNOT DECLARE OR SPECIFY A DELIMITER);
		ELSE
		  FAIL(30,HARD,DEL,IMPROPER DECLARATION);
	      FI;
	  FI;
	FI;
     OD;
IF SYM EQ PHI
				JUMPN	SYM,FALSE;$
 THEN
  FAIL(29,SOFT,SYM,MISSING LIST ELEMENT);
 ELSE
  IF NOT ERRL
				TNGB(ERRL);$
  THEN
  IF OLDEL ELEMENT SPEC.SEL
				MOVE	T,OLDEL;$
				TEL(.SPSEL);$
    THEN
      CODE GSPEC1;
;     ----
	IF SYM<STATUS> ELEM [FOV FON] AND FNLEVEL EQ ST[SYM]<PL>
				T.FORM;$
				HLRZ	T,STW0;$
				XOR	T,FNLEVEL;$
				TRNE	T,$PL;$
				GOTO	FALSE;$
	THEN
	 BEGIN
	   ;SYM<AM>_0;
				TLZ	SYM,$AM;$
	   IF LEXVAL<STATUS> = FOV
				T.FOV(LEXVAL);$
	    THEN
	    BEGIN
	      ;..VALUE SPECIFICATION;
	      IF SYM<STATUS> = FON
				T.FON;$
		THEN
		 ;SYM<STATUS>_ST[SYM]<STATUS>_FORMAL-BY-VALUE;
				TLZ	SYM,$STATUS;$
				TLO	SYM,$FOV;$
				HLLM	SYM,STW1;$
		ELSE
		  FAIL(31,SOFT,SYM,ALREADY SPECIFIED VALUE);
	      FI;
	    ENDD;
	  ELSE

	   ;..TYPE SPECIFICATION;
	   IF SYM<KIND!TYPE> EQ 0
				TLNE	SYM,$KIND!$TYPE;$
				GOTO	FALSE;$
	    THEN
	    ;SYM<KIND!TYPE>_ST[SYM]<KIND!TYPE>_LEXVAL<KIND!TYPE>;
				HLLZ	T,LEXVAL;$
				TLZ	T,400777;$
				IORM	T,STW1;$
				IOR	SYM,T;$
	    ELSE
		DUBDEC;
	  FI;
      FI;
      IF SYM EQ VALUE PROCEDURE OR SWITCH
				HLRZ	T,SYM;$
				ANDI	T,$KIND!$STATUS;$
				XORI	T,$PRO!$FOV;$
				JUMPN	T,FALSE;$
	THEN
	 BEGIN
	  FAIL(32,SYM,SOFT,PROCEDURES AND SWITCHES CANNOT BE VALUE);
	  ;ST[SYM]<STATUS>_FORMAL-BY-NAME;
				TLZ	SYM,$STATUS;$
				TLO	SYM,$FON;$
				HLLM	SYM,STW1;$
	 ENDD;
      FI;
     ENDD
   ELSE
     BEGIN
     IF FORMCT NE -1
				SKIPGE	FORMCT;$
				GOTO	FALSE;$
	THEN
	  BEGIN
	    FAIL(33,FRIED,SYM,ATTEMPT TO SPECIFY NON-FORMAL(S));
	    ;FORMCT_-1;
				SETOM	FORMCT;$
	  ENDD;
	FI;
	IF LEXVAL<KIND>!<TYPE> NE 0
				TLNN	LEXVAL,$KIND!$TYPE;$
				GOTO	FALSE;$
	  THEN
	    ;ST[SYM]<LEX>_LEXVAL<KIND>!<TYPE>!<DECL>;
				HLLZ	T,LEXVAL;$
				TLZ	T,-1-$KIND-$TYPE-$DECL;$
				IORM	T,STW1;$
	FI;
     ENDD;
    FI;
;     -------
      ENDCODE;
    ELSE
      CODE GSMP2;
;     ----
;..SIMPLE VARIABLES (INTEGER, REAL, BOOLEAN, STRING, LONG REAL,
;..COMPLEX, LONG COMPLEX) ARE DEFINED AND STORAGE IS ALLOCATTD.
 IF SYM NOT A VIRGIN ENTRY 
				TN.VIRGIN;$
   THEN
    DUBDEC;
   ELSE
     BEGIN
     IF LEXVAL<KIND> = VARIABLE AND LEXVAL<TYPE> NE LABEL
				T.VAR(LEXVAL);$
				TN.L(LEXVAL);$
	THEN
	BEGIN
	IF LEXVAL<STATUS> = SIMPLE AND FNLEVEL GT 1
				MOVE	T,FNLEVEL;$
				CAILE	T,1;$
				T.SIM(LEXVAL);$
	  THEN
	    BEGIN

		;..VARIABLE ALLOCATED IN FIXED STACK;

		;LEXVAL<VALUE>_FSDISP;
				HRR	LEXVAL,FSDISP;$
		;FSDISP_FSDISP+SIMPSIZE;
				ADDM	SIMPSIZE,FSDISP;$
		IF LEXVAL<TYPE> = STRING
				T.S (LEXVAL);$
		  THEN
		  BEGIN;..PLANT CALL TO OTS ROUTINE
		    ;..PLANT MOVEI 1,<LEXVAL>(15);
				HRLZI	T,<MOVEI 1,0(15)>_-22;$
				HRR	T,LEXVAL;$
				MABS;
		    MCALL(STRDEC);
		    SETT(ARDEC);
		  ENDD;
		FI;
	    ENDD;
	  ELSE
	    BEGIN

		;..VARIABLE ALLOCATED IN OWN AREA;

		;LEXVAL<VALUE>_0;
				HRRI	LEXVAL,0;$
		IF LEXVAL ELEM [LONGREAL COMPLEX STRING]
				T.TWO(LEXVAL);$
		  THEN
		    XTNDLB
		FI;
	    ENDD;
	FI;
	ENDD;
    ELSE
    BEGIN
    ;..EXTERNAL OR FORWARD DECLARATION;
     ;LEXVAL<VALUE>_0;
				HRRI	LEXVAL,0;$
      XTNDLB;
    IF LEXVAL<TYPE> EQ PROC		;
				T.PRO(LEXVAL);$
      THEN
	BEGIN
	;..WRITE.INHIBIT _ 1;
				MOVE	T,2(SYM);$
				ANDI	T,77;$
				ADDI	T,1;$
				IDIVI	T,6;$
				ADDI	T,3(SYM);$
				MOVE	T1,(T);$  FIRST EXTENSION WORD
				TLO	T1,400000;$
				MOVEM	T1,(T);$
	ENDD;				;
    FI;
    ENDD;
    FI;
    ;..STORE LEXEME AND VALUE FIELD IN SYMBOL TABLE ENTRY;
    ;ST[SYM]<1>_LEXVAL;
				MOVEM	LEXVAL,STW1;$
     ENDD;
 FI;
;     -------
      ENDCODE;
  FI;
 FI;
 FI;
 SFALSE(ERRL);
 ENDD;
AS DEL = COMMA
				DELEL(.COM);$
SA;
;STOPS_ST12;
				RESTOPS(ST12);$
ENDD;
SUBTTL ROUTINE TO DECLARE ARRAY VARIABLES.
PROCEDURE SARYDEC;
BEGIN
REGISTER ARYCHAIN,LEXVAL;
LOCAL ST13,ARYCT,BPCT,LOWER,ST10,ERRL3;
;ST13_STOPS;
;STOPS_STOPS OR COMMA;
				SETSTOPS(ST13,.COM);$
 CODE GARY1;
;----
 
 ;COMPOSED DECLARATOR LEXEME PASSED BY COMPOSEDEC IN SYM.

 ;LEXVAL<LEX>_SYM<LEX>;
 ;LEXVAL<RHS>_0;
				HLLZM	SYM,LEXVAL;$
 ;..GIVE WARNING IF THIS DECLARATION IS FOLLOWING A PROCEDURE
 ;..OR SWITCH DECLARATION;
 IF PROSKIP NE 0
				SKIPN	T,PROSKIP;$
				GOTO	FALSE;$
 THEN
  BEGIN
   JOIN;..(PROSKIP);
   FAIL(26,DEL,SOFT,WARNING: VARIABLES DECLARED AFTER PROCEDURES OR SWITCHES);
   ZERO(PROSKIP);
  ENDD;
 FI;
;..NOOP BLOCK EXIT OPTIMIZATION DUE TO ARRAY DECLARATION;
 SETT(ARDEC);

;-------
 ENDCODE;
LOOP
 BEGIN
  SFALSE(ERRL);
  CODE GARY2;
; ----
  ZERO(ARYCT);
  ;ARYCHAIN<FIRST>_0;
  ;ARYCHAIN<OLD>_@ARYCHAIN-1;
				HRLZI	ARYCHAIN,-1+ARYCHAIN;$
; -------
  ENDCODE;
  LOOP
   BEGIN
    RUND5;
    CODE GARY3;
;   ----
 IF SYM NE VIRGIN
				TN.VIRGIN;$
   THEN
    DUBDEC;
   ELSE
     BEGIN
	;ST[SYM]<LEX>_LEXVAL<LEX>;
				HLLM	LEXVAL,STW1;$
	;ST[ARYCHAIN<OLD>]<VALUE>_SYM<ASTE>;
				HLRZ	T,ARYCHAIN;$
				HRRM	SYM,1(T);$
	;ARYCHAIN<OLD>_SYM<ASTE>;
				HRLM	SYM,ARYCHAIN;$
	INCR(ARYCT);
     ENDD;
 FI;
;   -------
    ENDCODE;
   ENDD
  AS DEL EQ COMMA
				DELEL(.COM);$
  SA;
  IF DEL NE LEFT BRACKET
				CAMN	DEL,ZLBRA;$
				GOTO	FALSE;$
   THEN
    BEGIN
     FAIL(34,HARD,DEL,BOUND PAIR NOT FOUND);
     WHILE DEL NOT ELEMENT STOPS
				NOTSTOP;$
      DO
	ERREAD;
      OD;
     ENDD
    ELSE
     BEGIN

	;..THIS COMPOUND STATEMENT PROCESSES THE BOUND PAIR;
	;ST10_STOP;
	;STOPS_STOPS OR [RIGHT-BRACKET , : ];
				SETSTOPS(ST10,.RBRA!.COM!.COLON);$
	SETT(LOWER);
	STRUE(BPAIR);
	ZERO(BPCT);
	SFALSE(DECLAR);
	SETF(ERRL3);
	LOOP
	  BEGIN
	   SFALSE(ERRL);
	   RUND;
	   ESEL;
	   IF DEL EQ COLON XOR LOWER
				MOVE	T,LOWER;$
				XOR	T,DEL;$
				TEST(N,T,.COLON);$
				GOTO	FALSE;$
	     THEN
	    BEGIN
		IF NOT ERRL
				TNGB(ERRL);$
		THEN
		FAIL(35,HARD,DEL,BAD PUNCTUATION IN BOUND PAIR)
		FI;
	      ENDD
	     ELSE
		BEGIN
		 ;LOWER_ NOT LOWER;
				SETCMM	LOWER;$
		 INCR(BPCT);
		 CODE GBP1;
;		 ----
 EVAL;
 IF SYM ELEM [ARITH EXP]
				T.AE;$
   THEN
     BEGIN
	;..FORCE TO INTEGER;
	CGINT;
	TOSTACK;
	MOB;
     ENDD;
   ELSE
     SEMERR(107,$VAR!$I!$SIM!$DECL,ARITH EXPRESSION);
 FI;
;		 -------
		 ENDCODE;
		ENDD;
	   FI;
	   ;ERRL3_ERRL OR ERRL3;
				IORM	FL,ERRL3;$
	 ENDD
	AS DEL IS AN ELEMENT OF [COMMA :]
				DELEL(.COM!.COLON);$
	SA;
	;STOPS_ST10;
				RESTOPS(ST10);$
	IF DEL EQ RIGHT BRACKET
				DELEL(.RBRA);$
	 THEN
	  BEGIN
	    SFALSE(ERRL);
	    RUND3;
	  ENDD
	 ELSE
	  IF NOT ERRL
				TNGB(ERRL);$
	    THEN
	      FAIL(36,HARD,DEL,MISSING RIGHT BRACKET);
	  FI;
	FI;
	SFALSE(BPAIR);
	STRUE(DECLAR);
      CODE GARY4;
;     ----
 ;..ALLOCATE LOCAL USE OF TEMPORARY REGISTERS;
 DIM=T2;

 ;..INITIALIZE SYM FOR PASSING THRU LINKED SYMBOL TABLE ENTRIES;
 ;SYM<LHS>_0;
 ;SYM<ASTE>_ARYCHAIN<FIRST>;
				HRRZ	SYM,ARYCHAIN;$

 ;..TREAT NUMBER OF DIMENSIONS ;
 ;BPCT_BPCT/2;
 ;DIM<LHS>_(BPCT+1) MOD 2^5;
				MOVE	DIM,BPCT;$
				LSH	DIM,-1;$
				MOVEM	DIM,BPCT;$
				ADDI	DIM,1;$
				ANDI	DIM,$AM;$
				HRLZI	DIM,(DIM);$
 ;..TREAT GLOBALS AND OWNS DIFFERENTLY FROM VARIABLES IN THE STACK;
 IF LEXVAL<STATUS> EQ SIMPLE AND FNLEVEL NE 1
				MOVE	T,FNLEVEL;$
				CAILE	T,1;$
				T.SIM(LEXVAL);$
   THEN
    ;..VARIABLE IN STACK;
    WHILE SYM<ASTE> NE 0
				TRNN	SYM,777777;$
				GOTO	FALSE;$
     DO
     BEGIN
	;T_ST[SYM]<VALUE>;
				HRR	T,STW1;$
	;ST[SYM]<VALUE>_FSDISP;
				MOVE	T1,FSDISP;$
				HRRM	T1,STW1;$
	;FSDISP_FSDISP+2;
				ADDI	T1,2;$
				MOVEM	T1,FSDISP;$
	;ST[SYM]<AM>_DIM;
				IORM	DIM,STW1;$
	;SYM<ASTE>_T;
				HRR	SYM,T;$
     ENDD;
   OD;
  ELSE
    ;..VARIABLE IN STORAGE;
    WHILE SYM<ASTE> NE 0
				TRNN	SYM,777777;$
				GOTO	FALSE;$
     DO
     BEGIN
	;T_ST[SYM];
				MOVE	T,STW1;$
	;ST[SYM]<AM>_DIM;
				IOR	T,DIM;$
	;ST[SYM]<VALUE>_0;
				HLLZM	T,STW1;$
	;SYM<ASTE>_T;
				HRR	SYM,T;$
     ENDD;
   OD;
  FI;
 ;..CODE CALL SEQUENCE FOR ARRAY ALLOCATION;
 ;..REG A1: LEXEME OF ARRAY;

 ;T_'MOVEI A1,'.LEXVAL<LEXEME>;
 ;BUT MAKE IT OWN IFI FXED ARRAY;
				HLRZ	T,LEXVAL;$
				ANDI	T,$KIND!$TYPE!$STATUS;$
				MOVE	T1,FNLEVEL;$
				CAIG	T1,1;$
				IORI	T,$OWN;$
				HRLI	T,<MOVEI A1,0>_-22;$
 MABS;

 ;..REG A2: ADDRESS OF FIRST ARRAY VARIABLE IN LIST;

 ;T_'MOVEI A2,'.$ST.ARYCHAIN<FIRST>;
				HRRZ	T,ARYCHAIN;$
				HRLI	T,<MOVEI A2,>_-22!$ST;$
 MPS;

 ;..REG A3: -# OF ARRAYS;

 ;T_'MOVNI A3'.ARYCT;
				MOVE	T,ARYCT;$
				HRLI	T,<MOVNI A3,>_-22;$
 MABS;
 ;..REG A4: -# OF DIMENSIONS;

 ;T_'MOVNI A4,'.BPCT;
				HRLZI	T,<MOVNI A4,0>_-22;$
				HRR	T,BPCT;$
 MABS;

 ;..CALL ALLOCATOR IN ALGOTS;
 IF LEXVAL<STATUS> = OWN
				T.OWN(LEXVAL);$
   THEN
     MCALL(OARRAY);
   ELSE
     MCALL(ARRAY);
 FI;
;     -------
      ENDCODE;
     ENDD;
  FI;
 ENDD
AS DEL EQ COMMA
				DELEL(.COM);$
SA;
;STOPS_ST13;
				RESTOPS(ST13);$
ENDD;
SUBTTL ROUTINE FOR <SWITCH DECLARATION>.
PROCEDURE SSWDEC;
BEGIN
NEWLOP;
REGISTER LOP;
LOCAL ST9,LISTCT,SWFIX;
;ST9_STOPS;
;STOPS_STOPS OR COMMA;
				SETSTOPS(ST9,.COM);$
RUND5;
 CODE GSW1DEC;
;----
 ;..PLACE JRST AROUND SWITCH BODY IF THIS IS FIRST PROCEDURE IN THIS BLOCK;
IF PROSKIP EQ 0
				SKIPE	PROSKIP;$
				GOTO	FALSE;$
  THEN
   SPLIT(PROSKIP);
FI;

IF SYM<STATUS> EQ 'FORWARD'
				T.FOW;$
  THEN
   BEGIN
    IF SYM NE SWITCH
				SETCM	T,SYM;$
				TLNN	T,$PRO!$L;$
				GOTO	FALSE;$
     THEN
      FAIL(37,FRIED,SYM,TYPE DISAGREES WITH FORWARD DECLARATION);
      ;..SYM<STATUS>_SIMPLE
				TLZ	SYM,$STATUS
    FI;
    ;..RESOLVE BACKCHAIN OF REFERENCES;
    FIXREL(STW1);

    ;..FORCE SYM TO LOOK LIKE A VIRGIN IDENTIFIER;
    ;SYM<LHS>_0;
				HRRZI	SYM,(SYM);$

   ENDD;
FI;

IF SYM NE VIRGIN IDENTIFIER
				TN.VIRGIN;$
 THEN
  DUBDEC;
 ELSE
  BEGIN
   ;ST[SYM]<LEXEME>_[PRO LABEL SIMPLE DECL];
   ;ST[SYM]<VALUE> _RA;
				MOVE	T,RA;$
				HRLI	T,$PRO!$L!$SIM!$DECL;$
				MOVEM	T,STW1;$
  ENDD;
FI;
ZERO(LISTCT);
MABSI(<CAILE A2,0>);

;SWFIX_RA;
				MOVE	T,RA;$
				MOVEM	T,SWFIX;$
MABSI(<CAILE A2,.-.>);
MABSI(<SETZ A2,0>);
MABSI(<XCT .-.(A2)>);
MABSI(<POPJ SP,0>);
;T_'POPJ SP,0';
				HRLZI	T,<POPJ SP,0>_-22;$
PLUNKI;
REVER;
CLOSE(LOP);

BENTRY;

;-------
 ENDCODE;
SFALSE(DECLAR);
IF DEL NE _ 
				CAMN	DEL,ZASS;$
				GOTO	FALSE;$
  THEN
    FAIL(38,HARD,DEL,COLON-EQUAL MISSING IN SWITCH DECL.);
FI;
LOOP
  BEGIN
    SFALSE(ERRL);
    RUND5;
    LSEL;
    CODE GSW2DEC;
;   ----
REVER;
IF SYM<AM> EQ CODE GENERATED
				T.COGE;$
 THEN
  BEGIN
   UNSTACK;
   REOPEN;
   ;T_'POPJ SP,0';
				HRLZI	T,<POPJ SP,0>_-22;$
   PLUNKI;
   CLOSE;
   ;SWFIX<LHS>_RA;
				MOVE	T,RA;$
				HRLM	T,SWFIX;$
   MOB;
   REOPEN(LOP);
   ;T_'JRST'.SWFIX<LHS>;
				HRLZI	T,<JRST 0>_-22!$REL;$
				HLR	T,SWFIX;$
   PLUNKI;
   CLOSE(LOP);
  ENDD;
 ELSE
  BEGIN
   REOPEN(LOP);
   ;LEXEX_LLEXEX;
				MOVE	T,LLEXEX;$
				MOVEM	T,LEXEX;$
   ;T_'.LSEL';
				MOVEI	T,.LSEL;$
   GCOND;
   ;LLEXEX_LEXEX;
				MOVE	T,LEXEX;$
				MOVEM	T,LLEXEX;$
  ENDD;
FI;
INCR(LISTCT);

;   -------
    ENDCODE;
  ENDD
AS DEL EQ COMMA
				DELEL(.COM);$
SA;
;STOPS_ST9;
				RESTOPS(ST9);$
 CODE GSW3DEC;
;----
 FIXABS(SWFIX,LISTCT);
 ;T_SWFIX+2;
				HRRZ	T,SWFIX;$
				ADDI	T,2;$
 FIXREL;
 ;SYM_LEFTOP;
 ;SYM<LEXEME>_[EXP LABEL SIMPLE DECL SP];
				MOVE	T,LLEXEX;$
				MOVEM	T,LEXEX;$
				HRLZI	SYM,$EXP!$L!$SIM!$DECL!$SP;$
 MOB;
 BEXIT;
;-------
 ENDCODE;
SFALSE(ERRL);
ENDD;



;..RETURN TO THE PROCEDURE LEVEL OF THE BODY OF SPRODEC.
$PLEVEL=$PLEVEL-1;
SUBTTL BODY OF PROCEDURE SPRODEC.

SPRO1:
IF FNLEVEL = 0
				SKIPE	FNLEVEL;$
				GOTO	FALSE;$
  THEN
    BEGIN
    ;..THE PROGRAM BLOCK;
      MCALL(PARAM);
				MOVEI	T,0;$
				MABS;$
      ;PARAM1_RA;
				MOVE	T,RA;$
				MOVEM	T,PARAM1;$
      ;T_0,.-.;
				SETZ	T,0;$
      MABS;
      MABSI(<XWD $PRO!$N,1>);
      ;FSDISP_MXDISP_2;
				MOVEI	T,2;$
				MOVEM	T,FSDISP;$
				MOVEM	T,MXDISP;$
      INCR(FNLEVEL);
      ZERO(PNAME);
      ZERO(RELBLOCK);
      BENTRY;
      RUND;
				PUSH	SP,RA
				MOVE	T,PARAM1
				SUBI	T,2
				MOVEM	T,RA
				TRNN	FL,TRPOFF
				PUSHJ	SP,.ESBLK##
				POP	SP,RA
      IF DEL EQ 'COLON'
				DELEL(.COLON);$
	THEN
	 SCOL
      FI;
      IF DEL EQ 'BEGIN'
				CAME	DEL,ZBEGIN;$
				GOTO	FALSE;$
	THEN
	  SBEGIN
	ELSE
	  FAIL(88,HARD,DEL,PROGRAM NOT FOUND AFTER LABEL)
      FI;
				TRNN	FL,TRPOFF
				PUSHJ	SP,.ESBLK##
      MABSI(<JRST 1(DL)>);
      FIXABS(PARAM1,MXDISP);
      BEXIT;
    ENDD;
  ELSE
BEGIN
 CODE GPRO1;
;----
 ; THIS ROUTINE SAVES THE TYPE OF THE PROCEDURE IN THE LEFT HALF OF
 ; PNAME.  THE TYPE COMES FROM SYM, WHERE IS WAS LEFT BY COMPOSEDEC.

 ;PNAME<LEX>_SYM<LEX>;
				HLLZM	SYM,PNAME;$
 ;..IF THIS IS THE FIRST PROCEDURE DECLARATION THIS BLOCK
 ;..THEN PLACE A JRST INSTRUCTION AROUND PROCEDURE CODE;
 IF PROSKIP EQ 0
				SKIPE	PROSKIP;$
				GOTO	FALSE;$
  THEN
   SNBLK;
   MRK.8;
   MRK.9;
   SPLIT(PROSKIP);
 FI;

;-------
 ENDCODE;

RUND5;

	; Edit (1004)	Fix compiler looping on bad procedure name.

	IF SYM = PHI OR SYM = CONST;			[E1004] 
				JUMPE SYM,TRUE;		[E1004]
				T.CONST(SYM);		[E1004]
	THEN;						[E1004]
	BEGIN;						[E1004]
	SEMERR (106,0, UNDECLARED(UNSPECIFIED) IDENTIFIER );[E1004]	
		; [E1004] ENTER AN ERROR SYMBOL TABLE ENTRY
				PUSH 	SP,NSYM;	[E1004]
				PUSH 	SP,FL;		[E1004]
	;
	Edit(170); Turn off CREF switch correctly.
	;
				TRZ	FL,CREF;	[E1004][E170]
				MOVEI	T,[
				EXP	0
				XWD	1,0];		[E1004]
				AOJ	T,;		[E1004]
				MOVEM	T,NSYM;		[E1004]
				PUSHJ	SP,.SEARCH##;	[E1004]
				POP	SP,FL;		[E1004]
				POP	SP,NSYM;	[E1004]
		; [E1004] MAKE IT A VIRGIN IDENTIFIER
		; [E1004] SYM<LHS>_0
				TLZ	SYM,777777;	[E1004]
	ENDD;						[E1004]
	ELSE;						[E1004]
	IF TRACING
				TRNE	FL,TRLOFF;$
				GOTO	FALSE;$
	  THEN
	  BEGIN ; PLANT TRACE INFORMATION BLOCK BEFORE PROC HEADING
	; PARAM1_RA;
				HRR	T,RA;$
				MOVEM	T,PARAM1;$
	PMBPLT;
	ENDD;
	  ELSE
	  ; NO TRACING;
	  ; PARAM1_0;
				SETZM	PARAM1;$
	FI;
	FI;						[E1004]
 CODE GPRO2;
;----
 ;..THE PROCEDURE IDENTIFIER IS DECLARED, THE JUMP AROUND PROCEDURE
;..DECLARATIONS IS PLACED, THE FICTIOUS BLOCK IS SETUP AND THE
 ;..FORMAL CHAIN IS INITIALIZED (SEE GPRO3, GPRO5).

 IF SYM<STATUS> = FORWARD
				T.FOW;$
   THEN
     BEGIN
	IF SYM<TYPE> NE PNAME<TYPE>
				HLL	T,SYM;$
				XOR	T,PNAME;$
				TLNN	T,$TYPE;$
				GOTO	FALSE;$
	  THEN
	    FAIL(37,FRIED,SYM,TYPE DISAGREES WITH FORWARD DECLARATION);
	FI;

	;..RESOLVE BACKCHAIN OF REFERENCES TO THIS PROCEDURE;

	FIXREL(STW1);
	;..MAKE SYM LOOK LIKE A VIRGIN IDENTIFIER;
	;SYM<LHS>_0;
				TLZ	SYM,777777;$
	;.. WRITE.INHIBIT _ 0;		;
				MOVE	T,2(SYM);$
				ANDI	T,77;$
				ADDI	T,1;$
				IDIVI	T,6;$
				ADDI	T,3(SYM);$
				SETZM	(T);$ W.INH IS SIGN BIT;
     ENDD;
     ELSE;
	IF SYM<STATUS> NE EXTERNAL
				TLNN	SYM,700;$
				GOTO	TRUE;$
				TLC	SYM,300;$
				TLCN	SYM,300;$
				GOTO	FALSE;$
	  THEN;
	  XTNDLB;
	FI;				;
 FI;
 IF NOT VIRGIN IDENTIFIER
				TN.VIRGIN;$
   THEN
	BEGIN;						[E1004]
		DUBDEC;					[E1004]
		; [E1004] PNAME<SERRL>_TRUE
				MOVE	T,PNAME;	[E1004]
				TLO	T,$SERRL;	[E1004]
				MOVEM	T,PNAME;	[E1004]
	ENDD;						[E1004]
   ELSE
     BEGIN
	; SYM<LEX>_ST[SYM]<LEXEME>_PNAME<LEX>;
				HLL	T,PNAME;$
				HLL	SYM,T;$
	; ST[SYM]<VALUE>_RA
				HRR	T,RA;$
				MOVEM	T,STW1;$
	;PNAME<AM>_ST;
	;PNAME<ASTE>_SYM<ASTE>;
				TLO	SYM,$ST;$
				MOVEM	SYM,PNAME;$
     ENDD;
 FI;
 ;T_FNLEVEL_FNLEVEL+1;
				AOS	T,FNLEVEL;$
 IF FNLEVEL GT 63
				CAIGE	T,100;$
				GOTO	FALSE;$
   THEN
     FAIL(39,FATAL,DEL,TOO MANY PROCEDURE LEVELS);
 FI;
 ;..SET FSDISP TO POINT TO FIRST FORMAL LOCATION;

 IF SYM<TYPE> ELEM [LONGREAL STRING COMPLEX]
				T.TWO;$
   THEN
     ;FSDISP_3;
				MOVEI	T,3;$
   ELSE
     IF SYM<TYPE> = NONTYPE
				T.N;$
	THEN
	BEGIN;				;
	  ;..ASSIGNMENT.DONE _ 1; TO AVOID WARNING AT END;
				MOVE	T,2(SYM);$
				ANDI	T,77;$
				ADDI	T,1;$
				IDIVI	T,6;$
				ADDI	T,3(SYM);$
				MOVE	T1,(T);$
				TLO	T1,200000;$
				MOVEM	T1,(T);$
	  ;FSDISP_1;
				MOVEI	T,1;$
	ENDD;				;
	ELSE
	  ;FSDISP_2;
				MOVEI	T,2;$
     FI;
 FI;
 ;MXDISP_FSDISP_FSDISP+FNLEVEL;
				ADD	T,FNLEVEL;$
				MOVEM	T,FSDISP;$
				MOVEM	T,MXDISP;$
 BENTRY;
 ZERO(RELBLOCK);
 ;FORMCT_1;
				MOVEI	T,1;$
				MOVEM	T,FORMCT;$

 ;..INITIALIZE THE FORMCHAIN WORD ::= <OLD,FIRST> APPROPRIATELY TO SAVE
 ;..THE FIRST FORMAL SYMBOL TABLE  ADDRESS.

 ;FORMCHAIN<OLD>_@FORMCHAIN-1;
 ;FORMCHAIN<FIRST>_0;
				HRLZI	FORMCHAIN,-1+FORMCHAIN;$
;-------
 ENDCODE;
IF DEL = LPAR
				CAME	DEL,ZLPAR;$
				GOTO	FALSE;$
  THEN
    BEGIN
      ;ST11_STOPS;
      ;STOPS_STOPS OR RPAR COM;
				SETSTOPS(ST11,.RPAR!.COM);$
      LOOP
	BEGIN
	 RUND;
	 WHILE DEL NOT ELEMENT OF STOPS
				NOTSTOP;$
	   DO
	    IF ERRL
				TGB(ERRL);$
	      THEN
		RUND5
	      ELSE
		FAIL(40,DEL,HARD,NOT SIMPLE ID IN FORMAL LIST);
	    FI;
	   OD;

	 CODE GPRO3;
;	 ----
;..THIS ROUTINE PROCESSES A FORMAL PARAMETER AND CHAINS THE SYMBOL TABLE
;..ENTRIES FOR THESE PARAMETERS IN THE VALUE FIELD OF THE ST ENTRY
;..FOR CONVENIENT REFERENCE IN GPRO5.

 IF SYM NE VIRGIN
				TN.VIRGIN;$
   THEN
     SEMERR(108,0,VIRGIN IDENTIFIER);
   ELSE
     BEGIN
	;ST[SYM]<LEX>_[0,0,FON,DECL];
				MOVEI	T,$FON!$DECL;$
				HRLM	T,STW1;$
	;ST[FORMCHAIN<0LD>]<VALUE>_SYM<ASTE>;
				HLRZ	T,FORMCHAIN;$
				HRRM	SYM,1(T);$
	;FORMCHAIN<OLD>_SYM<ASTE>;
				HRLM	SYM,FORMCHAIN;$
	INCR(FORMCT);
     ENDD;
 FI;
;	 -------
	 ENDCODE;
	 SFALSE(ERRL);
	ENDD
      AS DEL = COMMA OR FATCOMMA
				DELEL(.COM);$
				SKIPE	NSYM;$
				FATRUND;$
      SA;
      ;STOPS_ST11;
				RESTOPS(ST11);$
      IF DEL NE RPAR
				DELNEL(.RPAR);$
	THEN
	  FAIL(41,DEL,SOFT,FORMAL LIST NOT CLOSED);
	ELSE
	  RUND5
      FI;
    ENDD
  ELSE
    IF DEL = PHID
				JUMPN	DEL,FALSE;$
      THEN
        BEGIN
  	  FAIL(42,DEL,SOFT,MISSING SEMI IN PROC HEAD);
	  ;DEL_SEMI;
				MOVE	DEL,ZSC;$
	ENDD
    FI;
;POSSIBLE FIXUP FOR:  P A,B);;
FI;
WHILE DEL NOTELEMENT STOPS
				NOTSTOP;$
  DO
    IF ERRL
				TGB(ERRL);$
      THEN
	RUND5
      ELSE
	FAIL(44,DEL,HARD,ILLEGAL PUNCTUATION IN FORMAL LIST);
    FI
  OD;
IF DEL NE SEMI
				DELNEL(.SC);$
  THEN
    FAIL(0,DEL,HARD,MISSING SEMICOLON);
  ELSE
    BEGIN
      CODE GPRO4;
;     ----
;..THE ROUTINE GENERATES THE CALL TO PARAM FOR PROCEDURE 
;..INITIALIZATION.

				TRNN	FL,TRPOFF
				PUSHJ	SP,.ESBLK##
 MCALL(PARAM);
; PLANT POINTER TO POST-MORTEM BLOCK
				HRRZ	T,PARAM1;$
IF NOT TRACING
				TRNN	FL,TRLOFF
				GOTO	FALSE
  THEN;
    MABS;
  ELSE;
    MREL0;
FI;
 ;..GENERATE ARGUMENT WORD 1, [FUNCTION LEVEL OF PROCEDURE NAME, MAX FIXED STACK SIZE];

 ;PARAM1_RA;
				MOVE	T,RA;$
				MOVEM	T,PARAM1;$
 ;T<LHS>_FNLEVEL-1;
 ;T<RHS>_.-.;
				HRLZ	T,FNLEVEL;$
				SUB	T,[XWD 1,0];$
 MABS;

 ;..GENERATE ARGUMENT WORD 2, [PROCEDURE LEXEME,# OF FORMALS +1];

 ;T<LHS>_PNAME<LEX>;
				HLL	T,PNAME;$
				TLZ	T,000077;$
 ;T<RHS>_FORMCT;
				HRR	T,FORMCT;$
 MABS;

 ;ST[PNAME]<ADRESS MODE FIELD>_FORMCT MOD 2^5;
				MOVE	T1,PNAME;$
				MOVE	T,FORMCT;$
				DPB	T,[POINT 5,1(T1),17];$
;     -------
      ENDCODE;
      SFALSE(ERRL);
      IF NDEL ELEMENT DECSPEC
				NDELEL(DECSPEC);$
	THEN
	  BEGIN
	   LOOP
	     BEGIN
		RUND2;
		SPSEL;
		SFALSE(ERRL);
	     ENDD;
	   AS DEL = SEMI AND NDEL ELEMENT DECSPEC
				TEST(N,DEL,.SC);$
				GOTO	FALSE;$
				NDELEL(DECSPEC);$
	   SA;
	  ENDD;
      FI;
      IF DEL NE SEMI
				DELNEL(.SC);$
        THEN
	  FAIL(0,DEL,HARD,MISSING SEMICOLON);
      FI;
      CODE GPRO5;
;     ----
;..THIS ROUTINE PASSES THRU THE LIST OF FORMALS
;    1) VERIFY THAT EACH HAS BEEN SPECIFIED
;    2) OUTPUT FORMAL DESCRIPTOR WORD FOR PARAM CALL

 ;SYM<LHS>_0;
 ;SYM<ASTE>_FORMCHAIN<FIRST>;
				HRRZ	SYM,FORMCHAIN;$
 ZERO(FORMCT);
 ;   WARNING !!!!!!!
 ;   TERMINATION OF THE FOLLOWING LOOP RELIES ON THE FACTS
 ;     1) FORMCHAIN<OLD> IS INITIALLY ZERO
 ;     2) THE LAST FORMAL ON THE CHAIN HAS <VALUE> = 0
 WHILE SYM<ASTE> NE 0
				TRNN	SYM,777777;$
				GOTO	FALSE;$
   DO
     BEGIN
	;T1_FSDISP;
				MOVE	T1,FSDISP;$
	;T_ST[SYM]<WORD1>;
				MOVE	T,STW1;$
	IF T<TYPE> = 0
				T.PHI(T);$
	  THEN
	    BEGIN
	    ;ST[SYM]<LEX>_VIRGIN;
				HRRZS	STW1;$
	    ;ST[SYM]<MSGIVEN>_TRUE;
				HRLZI	T2,$MSG;$
				IORM	T2,STW0;$
	    INCR(FORMCT)
	    ENDD;
	FI;
	;ST[SYM]<VALUE>_T1;
				HRRM	T1,STW1;$
	;SYM<ASTE>_T<RHS>;
				HRR	SYM,T;$
	;T<RHS>_T1;
				HRR	T,T1;$
	IF T<KIND> = ARRAY
				HLRZ	T2,T;$
				ANDI	T2,$KIND;$
				CAIE	T2,$ARR;$
				GOTO	FALSE;$
	THEN
	  ;T1_T1+2;
				ADDI	T1,2;$
	ELSE
	  IF T<STATUS> = FORMAL BY NAME OR T<TYPE> = LABEL
				HLRZ	T2,T;$
				ANDI	T2,$TYPE;$
				CAIN	T2,$L;$
				GOTO	TRUE;$
				T.FON(T);$
	      THEN
		;T1_T1+3;
				ADDI	T1,3;$
	      ELSE
		IF T<TYPE> ELEM [LONGREAL STRING COMPLEX]
				T.TWO(T);$
		  THEN
		    ;T1_T1+2;
				ADDI	T1,2;$
		  ELSE
		    ;T1_T1+1;
				ADDI	T1,1;$
		FI;
	  FI;
	FI;
	;FSDISP_T1;
				MOVEM	T1,FSDISP;$
	MABS;
     ENDD;
   OD;
 IF FORMCT NE 0
				SKIPN	FORMCT;$
				GOTO	FALSE;$
   THEN
     FAIL(43,FRIED,DEL,N UNSPECIFIED FORMALS);
 FI;
;..FICTITIOUS BLOCK AROUND BODY;
BENTRY;
;     -------
      ENDCODE;
      SFALSE(DECLAR)
      RUND2;
      SFALSE(ERRL);
      SSEL;
      CODE GPRO6;
;     ----
     ;..GENERATOR FOR PROCEDURE EXIT.

     ;..COMPLETE THE PROCEDURE BODY;
     GSTAT;

     ;T1_MAX(MXDISP,FSDISP);
				MOVE	T1,FSDISP;$
				CAMGE	T1,MXDISP;$
				MOVE	T1,MXDISP;$
     ;..RESOLVE THE MAXIMUM FIXED STACK SIZE
     ;.. PARAMETER IN THE CALL TO PARAM.
     FIXABS(PARAM1);

     ;..LABEL THE FINAL END WITH A STATEMENT NUMBER
				TRNN	FL,TRPOFF
				PUSHJ	SP,.ESBLK##
     ;..PROCEDURE EXIT THROUGH INSTRUCTION LOADED
     ;.. BY PARAM IN THE RESULT SPECIFIER LOCATION.
     ;T_'JRST FNLEVEL(DL)';
     MRK.0;	;PLACE MARKER
				HRLZI	T,<JRST 0(DL)>_-22;$
				ADD	T,FNLEVEL;$
     MABS;
     BEXIT;
     BEXIT;
	IF TRACING AND TYPED PROCEDURE
				MOVE	T,PNAME;
	;
	Edit(167); Test for /PRODUCTION switch correctly.
	;
				TLNE	T,$TYPE-$N
				TRNE	FL,TRPOFF;	[E167]
				GOTO	FALSE;
	THEN; Place Symbol Table Entry for Procedure Result
	PRSYM;
	FI;
      DECR(FNLEVEL);
    IF NOT PNAME<SERRL>;				[E1004] 
				MOVE	T,PNAME;	[E1004]
				TLNE	T,$SERRL;	[E1004]
				GOTO	FALSE;		[E1004]
	THEN;						[E1004]
    ;..WRITE.INHIBIT _ 1;		;
				HRRZ	T,PNAME;$
				MOVE	T1,2(T);$
				ANDI	T1,77;$
				ADDI	T1,1;$
				IDIVI	T1,6;$
				ADDI	T,3(T1)	; POINT TO EXTN
				MOVE	T1,(T); 1ST EXTENSION WORD
    IF NO.ASSIGNMENT.MADE;
				TLOE	T1,600000; ALSO SET W.INH
				GOTO	FALSE;
      THEN
	BEGIN
				MOVEM	T1,(T);$
				FAIL(126,SOFT,DEL,NO ASSIGN TO TYPED PROCEDURE IN ITS BODY);
	ENDD;
    ELSE
				MOVEM	T1,(T);$
    FI;	
    FI;							[E1004]
;     -------
      ENDCODE;
      SFALSE(ERRL);
    ENDD;

FI;
ENDD;
FI;
ENDD;  OF PROCEDURE SPRODEC.

ENDD; OF MODULE MDEC

LIT
END