;
;
;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 MODULE WITH GENERAL UTILITY ROUTINES

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

	HISEG

	SEARCH ALGPRM,ALGMAC	; SEARCH PARAMETER FILES
MODULE MUTL;
$PLEVEL=2;
BEGIN
EXPROC FAILED,EVAL,REOPEN,PLUNK,IPLUNK,CLOSE,UNSTACK,MOB,TOCT1,BEXIT;
EXPROC XTNDLB,STADD,MABS,MREL,RAFIX,CGBINARY,SBHDR;
EXPROC MABS,ADDFIX,PROGDEF,PROCDEF,ZZEND,SONOFF,COMPOSDEC;
EXPROC SPRODEC,SBEGIN,SBRACK,SFPARN,EXPARN,DSEL,RUND,SCRUND,SEARCH,MABS,GETSPC;
EXTERN .RINIT,.PINIT,COREB,CHKSUM,CCLSW;
SUBTTL INITIALIZATION FOR COMPILER AND TEST
INTERN TEST
OWN REALLOCATE;
TEST:
;..PRIMARY INTERPRETATION LOOP;
;..SET SEQUENCE FOR NORMAL AND CCL ENTRY.
				TDZA	A1,A1	;NORMAL
				MOVEI	A1,1	;CCL
				MOVEM	A1,CCLSW
ZERO(COREB);
ZERO(CHKSUM);
WHILE TRUE
				NOOP	FALSE;$
DO
BEGIN
 ;CALL RINIT;
				JSP	A1,.RINIT;$
 SETF(REALLOCATE);
 ;..PROCESS ANY PSEUDO INSTRUCTIONS (LISTON,CHECKON,...)
 PSEUDO;
 IF NDEL = 'BEGIN' OR 'COLON'
				MOVE	T,NDEL;$
				CAMN	T,ZBEGIN;$
				GOTO	TRUE;$
				TEL(.COLON);$
   THEN
     BEGIN
	;..BLOCK OR LABELLED BLOCK;
	SETT(REALLOCATE);
	;..WRITE LOADER BLOCK FOR PROGRAM;
	PROGDEF;
	;..COMPILE PROGRAM;
	SPRODEC;
	;..WRITE LOADER FIXUPS FOR ALL GLOBAL SYMBOLS AND CONSTANTS;
	ZZEND;
     ENDD;
   ELSE
     IF NDEL = 'EOF'
				TEL(.EOF);$
       THEN
	 FAIL(89,HARD,DEL,EMPTY SOURCE FILE);
     FI;
 FI;

 ;..PROCESS INTERNAL PROCEDURES, ALLOW EXTRA SEMI-COLON BEFORE EOF;
 WHILE DEL NE 'EOF' AND (DEL NE SEMICOLON OR NDEL NE 'EOF')
				DELNEL(.EOF);$
				TEST(N,DEL,.SC);$
				GOTO	TRUE;$
				NDELNEL(.EOF);$
  DO
  BEGIN
   ;..REALLOCATE FRESH TABLES AND STACK IF NECESSARY;
   IF REALLOCATE
				SKIPN	REALLOCATE;$
				GOTO	FALSE;$
    THEN
     ;CALL PINIT;
				JSP	A1,.PINIT;$
   FI;
   SETT(REALLOCATE);
   PSEUDO;
   IF ERRL
				TGB(ERRL);$
     THEN
        IF NDEL EQ 'BEGIN'
				MOVE	T,NDEL;$
				CAME	T,ZBEGIN;$
				GOTO	FALSE;$
         THEN
          SPRODEC;
          STRUE(ERRL);
         ELSE
          RUND
        FI
     ELSE
       IF NDEL ELEM DECSPEC
				MOVE	T,NDEL;$
				TEL(DECSPEC);$
	 THEN
	   BEGIN
	     RUND;
	     COMPOSEDEC;
	     NOOP	.DECSEL;
	     ;..COMPOSITE DELIMITER RETURN IN SYM;
	     IF SYM<RHS> = @PRODEC AND NOT ERRL
				HRRZI	T,.SPRODEC;$
				CAIN	T,(SYM);$
				TNGB(ERRL);$
	       THEN
		 BEGIN
		   ;..INTERNAL PROCEDURE;

		   ;..WRITE LOADER BLOCK FOR INTERNAL PROCEDURE;
		   PROCDEF;
		   ;..TURN ON DECLARATION MODE;
		   STRUE(DECLAR);
		   ;FNLEVEL_1;
				AOS	FNLEVEL;$
		   BENTRY;
		   ;..COMPILE PROCEDURE;
		   SPRODEC;
		   BEXIT;
		   SFALSE(DECLAR);
		   ;..WRITE LOADER FIXUPS FOR GLOBAL SYMBOLS AND CONSTANTS;
		   ZZEND;
		   IF DEL NOT ELEM [SC EOF]
				DELNEL(.SC!.EOF);$
		     THEN
		       FAIL(87,DEL,HARD,ILLEGAL TERM. OF PROC);
		   FI;
		 ENDD;
	       ELSE
		 IF NOT ERRL
				TNGB(ERRL);$
		   THEN
		     FAIL(88,DEL,HARD,ILLEGAL FILE STRUCTURE);
		 FI;
	     FI;
	   ENDD;
	 ELSE
	   IF DEL = 'END'
				DELEL(.END);$
	     THEN
	       FAIL(86,DEL,HARD,EXTRA END - INCORRECT BLOCK STRUCTURE);
	     ELSE
	       FAIL(85,DEL,HARD,INCORRECT BLOCK OR FILE STRUCTURE);
	   FI;
     FI;
   FI;
  ENDD;
  OD;
 ;..FATAL COMPILER ERRORS REENTER HERE;
 INTERN HELL
 HELL:
 ENDD;
OD;

SUBTTL ROUTINE LOOK.
;..ROUTINE FOR SYMBOL LOOK-AHEAD ON NSYM;
;..  USED WHEN RECOVERY FROM SYNTAX ERROR IS BEING ATTEMPTED;
PROCEDURE LOOK;
BEGIN
 OWN SYMSYM;
 ;..CALL SEARCH MAKING SURE THAT 1) NO ENTRY IS MADE
 ;.. AND 2)SEARCH IS NOT CALLED IF SYM IS PHI OR CONSTANT
 ;.. AND 3) SYM IS NOT DESTROYED.;
 

	MOVEM	SYM,SYMSYM;$
	STRUE(NOENTRY);$
	SKIPN	T,NSYM;$
	JRST	.+3;$
	TLNN	T,$KIND;$
	PUSHJ	SP,.SEARCH;$
	SFALSE(NOENTRY);$
	MOVE	SYM,SYMSYM;$

ENDD;
SUBTTL ROUTINE TO RECOVER WINDOW AFTER MISSING SEMICOLON
PROCEDURE SCINSERT;
BEGIN
 FAIL(0,SOFT,NSYM,MISSING SEMICOLON);
;..FIXUP WINDOW;
 ;DEL_SEMICOLON;
				MOVE	DEL,ZSC;$
 ;SYM_SEARCH;
				SKIPN	SYM,NSYM;$
				JRST	.+3;$
				TLNN	SYM,$KIND;$
				PUSHJ	SP,.SEARCH;$
 ;..COMPUTE LEXEX AND COMPNAME;
 ;..LINE POINTER(SYM)_LINE POINTER(DEL)_LINE POINTER(NSYM);
 SCRUND;
 ZERO(NSYM);
ENDD;
SUBTTL RUND2 ROUTINE.
;..ROUTINE TO RUND WINDOW WHEN A "BEGIN" OR ";" IS IN DEL;
;..RUND2 CHECKS FOR MISSING SEMICOLON AFTER PARAMETERLESS PROCEDURE;
;..FOR EXAMPLE:
;..	BEGIN P BEGIN END; P X_Y  END;
;..	       ^	    ^
PROCEDURE RUND2;
BEGIN
IF NSYM NE PHI AND NDEL ELEMENT [KWSTST DECSPEC PHID]
				SKIPN	NSYM;$
				GOTO	FALSE;$
				MOVE	T,NDEL;$
				JUMPE	T,TRUE;$
				TEL(KWSTST!DECSPEC);$
  THEN
    BEGIN
      ;..KILL POSSIBLE SEMERR LEXEME;
      ;SYM_0;
				SETZ	SYM,0;$
      ;T_LOOK;
				LOOK;$
      IF T<KIND> EQ PROCEDURE AND #PARAMETERS EQ 0
				T.PRO(T);$
				MOVE	T1,1(T);$
				TLNE	T1,$AM-1;$
				GOTO	FALSE;$
	THEN
	BEGIN
	 ;..MISSING SEMI-COLON;
	 IF NDEL = PHID
				SKIPE	NDEL;$
				GOTO	FALSE;$
	  THEN
	   BEGIN
	    FAIL(0,SOFT,NDEL,MISSING SEMICOLON);
	    RUND;
	    ;DEL_SEMICOLON;
				MOVE	DEL,ZSC;$
	   ENDD
	  ELSE
	   SCINSERT;
	 FI
	ENDD
	ELSE
	  RUND;
    FI;
    ENDD
  ELSE
    RUND;
FI;
ENDD;
SUBTTL RUND3 ROUTINE.
;..ROUTINE TO RUND WINDOW WHEN A ")" OR "]" IS IN DEL;
;..RUND3 CHECKS FOR MISSING SEMICOLON BEFORE STATEMENTS AND DECLARATIONS;
;..  AND VERIFIES THAT ")" OR "]" IS NOT IMMEDIATELY FOLLOWED BY
;..  A SYMBOL.
;..FOR EXAMPLE:
;..	BEGIN P(X,Y) BEGIN END; X_A[I] Y+Z+A[I] Y_0 END;
;..		    ^		      ^	       ^
PROCEDURE RUND3;
BEGIN
IF NSYM = PHIS AND NDEL NOTELEM [KWSTST DECSPEC]
				SKIPE	NSYM;$
				GOTO	FALSE;$
				MOVE	T,NDEL;$
				TNEL(KWSTST!DECSPEC);$
  THEN
    RUND
  ELSE
    ;..KILL POSSIBLE SEMERR LEXEME
    ;SYM_0;
				SETZ	SYM,0;$
    IF NOT TOPLEVEL
				TN.TOPLEV;$
      THEN
	BEGIN
	  IF NSYM NE PHIS OR NDEL EQ 'IF'
				SKIPE	NSYM;$
				GOTO	TRUE;$
				MOVE	T,NDEL;$
				CAME	T,ZIF;$
				GOTO	FALSE;$
	    THEN
	      FAIL(4,HARD,NSYM,MISSING  OPERATOR);
	      ;IN ALL OTHER CASES ERROR MUST BE GIVEN ON SELECTION;
	  FI;
	  RUND;
	ENDD
      ELSE
	IF NDEL ELEMENT [KWSTST DECSPEC]
				MOVE	T,NDEL;$
				TEL(KWSTST!DECSPEC);$
	  THEN
	    BEGIN
	    IF NSYM NE PHIS
				SKIPN	NSYM;$
				GOTO	FALSE;$
	      THEN
		BEGIN
		FAIL(4,HARD,DEL,MISSING OPERATOR)
		;SYM_NSYM_PHIS;
				SETZB	SYM,NSYM;$
		ENDD
	    FI;
		  FAIL(0,SOFT,NSYM,MISSING SEMI);$
		  ;DEL_SEMI;
				MOVE	DEL,ZSC;$
	    ENDD
	  ELSE
	    IF <NDEL ELEMENT [:_] OR (NDEL ELEMENT [;(] AND LOOK ELEMENT [NT PROC])>
				TEST(E,T,.COLON);$
				GOTO	TRUE;$
				CAMN	T,ZASS;$
				GOTO	TRUE;$
				TEST(E,T,.SC);$
				GOTO	.+3;$
				CAME	T,ZLPAR;$
				GOTO	FALSE;$
				LOOK;$
				T.PRO(T);$
				T.N(T);$
	      THEN
		BEGIN
		FAIL(0,SOFT,DEL,MISSING SEMI);
		;DEL_SEMI;
				MOVE	DEL,ZSC;$
		ENDD
	      ELSE
		BEGIN
		  FAIL(4,HARD,NSYM,MISSING OPERATOR);
		  RUND
		ENDD
	    FI;
	FI;
    FI;
FI;
ENDD;
SUBTTL RUND5 ROUTINE.
;..ROUTINE TO RUND WINDOW WHEN EXPRESSION "ELSE" OR DECLARATION "," IN DEL;
;..  ALSO CERTAIN CASES  IN PROCEDURE DECLARATION;
;..RUND5 CHECKS FOR MISSING SEMICOLON BEFORE A STATEMENT OR DECLARATION;
;..FOR EXAMPLE:
;..	BEGIN REAL X,Y BEGIN END; X_IF B THEN Y ELSE Z BEGIN END END;
;..		      ^				      ^
PROCEDURE RUND5;
BEGIN
IF NDEL NOT ELEMENT [KWSTST DECSPEC PHID]
				MOVE	T,NDEL;$
				JUMPE	T,FALSE;$
				TNEL(KWSTST!DECSPEC);$
  THEN
    RUND
  ELSE
    ;..KILL POSSIBLE SEMERR LEXEME;
    ;SYM_0;
				SETZ	SYM,0;$
    IF NSYM EQ PHIS AND NDEL EQ 'IF'
				SKIPE	NSYM;$
				GOTO	FALSE;$
				CAME	T,ZIF;$
				GOTO	FALSE;$
      THEN
	RUND
      ELSE
	IF NDEL ELEMENT [KWSTST DECSPEC]
				TEL(KWSTST!DECSPEC);$
	  THEN
	   ;..MISSING SEMICOLON;
	   SCINSERT;
	  ELSE
	    BEGIN
	      RUND;
	      IF <NOT ERRL AND (NDEL ELEMENT [: _] OR (NDEL ELEMENT [;(] AND LOOK EQ NONTYPE PROCEDURE))>
				TNGB(ERRL);$
				MOVE	T,NDEL;$
				TEST(E,T,.COLON);$
				GOTO	TRUE;$
				CAMN	T,ZASS;$
				GOTO	TRUE;$
				TEST(E,T,.SC);$
				GOTO	.+3;$
				CAME	T,ZLPAR;$
				GOTO	FALSE;$
				LOOK;$
				T.PRO(T);$
				T.N(T);$
		THEN
		 BEGIN
		  FAIL(0,SOFT,DEL,MISSING SEMICOLON);
		  ;DEL_SEMICOLON;
				MOVE	DEL,ZSC;$
		 ENDD;
	      FI;
	  ENDD;
	FI;
    FI;
FI;
ENDD;
SUBTTL ROUTINE PSEUDO.
;..ROUTINE PROCESSES PSEUDO-OPS IN ALL CASES EXCEPT WHERE SSEL SELECTS AUTOMATICALLY.
;..FOR EXAMPLE: BEFORE THE PROGRAM, BEFORE AND WITHIN DECLARATIONS, 
;..  BUT NOT BETWEEN STATEMENTS.
PROCEDURE PSEUDO;
BEGIN
 WHILE NDEL = PSEUDO OP
				MOVE	T,NDEL;$
				TEST(E,T,KWSTST);$
				TEST(N,T,DECSPEC);$
				GOTO	FALSE;$
  DO
   BEGIN
     RUND2;
     SONOFF;
   ENDD;
  OD;
ENDD;
SUBTTL ERREAD ROUTINE.

;..ENTRY TO ERREAD VIA .ERR WILL CAUSE A RETURN TO CALL SITE MINUS 3.
;..THIS ENTRY POINT IS USED IN ORDER TO OPTIMIZE THE SEL LOOPS.
INTERN .ERR;
.ERR:	;RETURN ADDRESS IN STACK_RETURN ADDRESS - 4;
				MOVNI	T,4;$
				ADDM	T,(SP);$

;..ROUTINE TO RUND WINDOW WHILE IN A SYNTAX ERROR LEVEL.;
;..ERREAD WILL EITHER DESCEND ON A SUITABLE OPEN BRACKET OR RUND.;
PROCEDURE ERREAD;
BEGIN
 IF <DEL ELEMENT [BEGIN DO ( [ PROCEDURE]>
				DELEL(ERRST);$	[534]
   THEN
     DESCEND
   ELSE
     RUND
 FI;
 ERRLEX;
ENDD;



SUBTTL GOBBLE ROUTINE.
;..ERROR READ ROUTINE FOR BRACKETS AND PARENS DURING DECLARATIONS.
PROCEDURE GOBBLE;
BEGIN 
 ;..ARGUMENT IN T INDICATES PROPER STOPPER: ) OR ] BIT;
 LOCAL ST21;
 ;ST21_STOPS;
				SAVESTOPS(ST21);$
 ;STOPS_[; END EOF ] UNION T;
				MOVE	STOPS,T;$
				ADDSTOPS(.SC!.END!.EOF);$
 RUND;
 SFALSE(DECLAR);
 WHILE DEL NOT ELEMENT STOPS
				NOTSTOPS;$
  DO
   ERREAD;
  OD;
 STRUE(DECLAR);
 ;STOPS_ST21;
				RESTOPS(ST21);$
ENDD;
SUBTTL DESCEND ROUTINE.
;..ROUTINE TO DESCEND DURING ERROR READING.
;..THE DELIMITERS ( [ BEGIN DO PROCEDURE
;..WILL CAUSE THE SYNTAX CHECKING TO RESUME DURING ERROR READING.
PROCEDURE DESCEND;
BEGIN
 LOCAL SVSTOPS,SVGB;
 ;SVSTOPS_STOPS;
				SAVESTOPS(SVSTOPS);$
 ;SVGB_FL;
				MOVEM	FL,SVGB;$
 SFALSE(ERRL!DECLAR);
 SFALSE(NOENTRY); LET SEARCH MAKE ENTRIES.
 ;SYM<SERRL>_0;
				TLZ	SYM,$SERRL;$
 IF DEL = LBRA
				CAME	DEL,ZLBRA;$
				GOTO	FALSE;$
   THEN
     BEGIN
       ZERO(SYM);
       ;SYM<SERRL>_1;
				TLO	SYM,$SERRL;$
     IF SVGB<DECLAR>
				MOVE	T,SVGB;$
				TEL(DECLAR);$
      THEN
	BEGIN
	;T_ ]-STOPPER;
				HRLZI	T,.RBRA_-22;$
	GOBBLE;
	ENDD;
      ELSE
       SBRACK;
       NOOP	.ERSEL;
     FI;
     ENDD
   ELSE
     IF DEL = LPAR
				CAME	DEL,ZLPAR;$
				GOTO	FALSE;$
	THEN
	  BEGIN
	   IF SVGB<DECLAR>
				MOVE	T,SVGB;$
				TEL(DECLAR);$
	    THEN
		BEGIN
		;T_ )-STOPPER;
				HRLZI	T,.RPAR_-22;$
		GOBBLE;
		ENDD;
	    ELSE
	    IF SYM<KIND> ELEMENT [ARRAY PROC] OR SYM NEW ENTRY
				TLNE	SYM,$ARR;$
				GOTO	TRUE;$
				T.VIRGIN;$
	      THEN
		BEGIN
		ZERO(SYM);
		;SYM<SERRL>_1;
				TLO	SYM,$SERRL;$
		SFPARN;
		NOOP	.ERSEL
		ENDD
	      ELSE
		BEGIN
		EXPARN;
		NOOP	.ERSEL
		ENDD
	    FI;
	  FI;
	  ENDD
	ELSE
	 BEGIN
	  ;STOPS_[SC END EOF ELSE];
				HRLZI	STOPS,<.SC!.END!.EOF!.ELSE>_-22;$
	  ;SYM_PHIS;
				SETZ	SYM,;$
	  IF DEL = BEGIN
				CAME	DEL,ZBEGIN;$
				GOTO	FALSE;$
	    THEN
	      BEGIN
	      SBEGIN;
	      NOOP	.ERSEL
	      ENDD
	    ELSE
	    IF DEL EQ PROCEDURE
				CAME	DEL,ZPROCEDURE;$
				GOTO	FALSE;$
	     THEN
	      BEGIN
		IF <NDEL ELEMENT [ SEMICOLON (  ]>
				MOVE	T,NDEL;$
				CAMN	T,ZLPAR;$
				GOTO	TRUE;$
				TEL(.SC);$
		THEN
		 DSEL
		ELSE
		 RUND
		FI;
	      ENDD
	     ELSE
	      ;DEL IS NECESSARILY A DO;
	      IF NDEL = KWSTST AND NSYM = PHIS
				NDELEL(KWSTST);$
				SKIPE	NSYM;$
				GOTO	FALSE;$
		THEN
		  BEGIN
		  RUND;
		  SSELECT(.ERSEL)
		  ENDD
		ELSE
		  RUND;
	      FI;
	    FI;
	  FI;
	ENDD;
     FI;
 FI;
 ;STOPS_SVSTOPS;
				RESTOPS(SVSTOPS);$
 ;FL_SVGB;
				SFALSE(ERRL!DECLAR!NOENTRY);$
				MOVE	T,SVGB;$
				ANDI	T,ERRL!DECLAR!NOENTRY;$
				IOR	FL,T;$
ENDD;
SUBTTL FAIL ROUTINE
;..ROUTINE TO EMIT FAIL MESSAGE.
;..FAIL MAY DECIDE TO SUPPRESS THE FAIL MESSAGE.
PROCEDURE FAIL;
BEGIN
 FORMAL FAILCODE;
 ;..FAILCODE ::= [XWD  CODE, MSG]
 ;..  WHERE MSG IS THE MESSAGE NUMBER
 ;..		CODE IS A BIT ENCODING OF 
 ;..		WINDOW POSITION (SYM,DEL,NSYM,NDEL)
 ;..		STRENGTH (HARD,SOFT,FRIED,FATAL,IUO).;
 ;T_FAILCODE;
				MOVE	T,FAILCODE;
				TLNE	T,..FVARY;$
				HRR	T,(T);$
 ;T1_GLOBAL BOOLEAN REGISTER;
				MOVE T1,FL;$
 ;IF FAILCODE<SUSPEND SYNTAX SCAN>
  ;THEN STRUE(ERRL);
				TLNE	T,SUSPSYN;$
				STRUE(ERRL);$
  ;IF FAILCODE<SUSPEND OBJECT FILE>
  ;THEN STRUE(ERRF);
				TLNE	T,SUSPCOD;$
				STRUE(ERRF);$
 ;TTY_FAIL MESSAGE;
 IF NOT T<FATAL> AND SYM<SERRL> AND (HARD IMPL ERRL)
				TLNE	SYM,400000;$
				TLNE	T,..FATAL;$
				GOTO	FALSE;$
				TLNN	T,SUSPSYN;$
				GOTO	TRUE;$
				TEST(N,T1,ERRL);$
				GOTO	FALSE;$
  THEN
   ;..SUPRESS FAIL MSG;
				GOTO	FOUT;$
  FI;
  FAILED;
 IF FAILCODE<SUSPEND CODE GENERATION>
				TLNN	T,SUSPCOD;$
				GOTO	FALSE;$
   THEN
     ERRLEX;
 FI;

FOUT:
 ;SKIP RETURN;
				AOS	(SP);$
ENDD;

SUBTTL ERRLEX ROUTINE
PROCEDURE ERRLEX;
BEGIN
 ;..FORCE THE LEXEME OF SYM TO BE ALWAYS WRONG AND THEREBY
 ;..AUTOMATICALLY SKIP ALL EXPRESSION CODE GENERATION.  THIS 
 ;..LEXEME WILL BE PRESERVED BY ALL EXPRESSION ROUTINES.
 ;..THE LEXEME WILL EVENTUALLY DISAPPEAR WHEN A CORRECT LEXEME
 ;..NORMALLY WOULD.
 ;SYM<SERRL>_1;
 ;SYM<DECLAR>_0;
				TLO	SYM,$SERRL;$
				TLZ	SYM,$DECL;$
ENDD;
SUBTTL SEMANTICS ERROR RECOVERY

;..ROUTINE SEMERR DISTINGUISHES BETWEEN THREE CASES:
;..	1/ SYM IS NULL,  EG. ;IF THEN...
;..	2/ SYM IS UNDECLARED VARIABLE,
;..	3/ SYM IS WRONG IN THIS CONTEXT, EG. WRONG TYPE.
;..IN THE CASE OF AN UNDECLARED VARIABLE, THE MESSAGE GIVEN BIT IN
;..	THE SYMBOL TABLE IS TURNED ON AND IS USED TO SUPRESS DOUBLE MESSAGES.
;..IF THE CALL SITE HAS SPECIFIED A LIKELY LEXEME FOR THE UNDECLARED IDENTIFIER
;..   THEN IT IS GIVEN THAT DECLARATION.
PROCEDURE SEMERR;
BEGIN
 FORMAL SEMERLEX;
 
 ;..SEMERLEX ::= [XWD LEXEME,MSG]  WHERE THE LEXEME IS
 ;..USED IN FIXING UP UNDECLARED IDENTIFIERS, IF ANY.  
 ;..MSG INDICATES WHAT CONSTRUCT WAS BEING SOUGHT WHEN THE ERROR 
 ;..WAS ENCOUNTERED FOR USE IN THE IUO FORM OF FAIL

 IF NOT ERRL
				TNGB(ERRL);$
   THEN
 BEGIN
 IF SYM = PHIS
				JUMPN	SYM,FALSE;$
   THEN
     BEGIN
     ;SYM<SERRL>_0;
				TLZ	SYM,$SERRL;$
     FAIL(5,FRIED,SYM,MISSING INDENTIFIER);
     ENDD;
   ELSE
     IF SYM = VIRGIN ENTRY
				T.VIRGIN;$
	THEN
	  BEGIN
	    IF NOT ST[SYM]<MESSAGE GIVEN>
				HLL	T,STW0;$
				TLNE	T,$MSG;$
				GOTO	FALSE;$
	      THEN
		BEGIN
		  ;..ALWAYS PRINT MESSAGE(EVEN IF SEMANTIC ERROR LEVEL);
		  ;SYM<SERRL>_0;
				TLZ	SYM,$SERRL;$
		  FAIL(1,FRIED,SYM,UNDECLARED VARIABLE);
		  ;ST[SYM]<MSG>_TRUE;
				HRLZI	T,$MSG;$
				IORM	T,STW0;$
		; TROUBLE LATER IF ITS REALLY A LABEL SO
		XTNDLB;
		ENDD;
	    FI;
	    ;ST[SYM]<LEX>_SEMERLEX;
				HLL	T,SEMERLEX;$
				HLLM	T,STW1;$
	    ;SYM<LEX>_SEMERLEX<LEX>;
				HLL	SYM,T;$
	    ERRLEX;
	  ENDD;
	ELSE
	  ;FAIL(#,IUO,SYM,SEMERLEX[EXPECT]);
				MOVE	T2,SEMERLEX;$
				PUSHJ	SP,.FAIL;$
				XWD	..SYM!..IUO!..FVARY,T2;$
     FI;
 FI;
 ENDD;
 FI;
 ;SKIP RETURN PAST ARG WORD;
				AOS	(SP);$
ENDD;
SUBTTL ROUTINES FOR SELECTION ON BAD SYNTAX
PROCEDURE F1;
BEGIN
 STRUE(NOENTRY);
 FAIL(2,HARD,DEL,ILLEGAL STMT);
ENDD;

PROCEDURE F2;
BEGIN
 FAIL(96,HARD,DEL,DECLARATION FOLLOWS STATEMENT);
 ;..KILL "PROCEDURES DECLARED" FLAG;
 ZERO(PROSKIP);
 DSEL;
 WHILE DEL=SC AND NDEL IS DECSPEC
				TEST(N,DEL,.SC);$
				GOTO	FALSE;$
				NDELEL(DECSPEC);$
  DO
   BEGIN
    RUND2;
    DSEL;
    SFALSE(ERRL);
   ENDD;
 OD;
 STATEMENT;
ENDD;

PROCEDURE F3;
BEGIN
 FAIL(3,HARD,DEL,ILLEGAL EXPRESSION);
 ;STOPS_STOPS-[,: STEP UNTIL WHILE];
				TLZ	STOPS,EXPUNGE_-^D18;$
ENDD;

PROCEDURE F4;
BEGIN
 FAIL(6,HARD,DEL,ILLEGAL DESIGNATION EXPRESSION);
 ;STOPS_STOPS-[,: STEP UNTIL WHILE];
				TLZ	STOPS,EXPUNGE_-^D18;$
ENDD;

PROCEDURE F5;
BEGIN
 FAIL(7,HARD,DEL,ILLEGAL ASSINGMENT);
STRUE(ERRL);
ENDD;
SUBTTL BLOCK ENTRY ROUTINE.
PROCEDURE BENTRY;
BEGIN
 INCR(BLOCKLEVEL);
 ;GETSPC(1);
				MOVEI	T4,1;$
				GETSPC;$
 ;SAVE STATE OF SYMBOL TABLE;
				MOVEI	T4,1(T);$
				EXCH	T4,STBB;$
				MOVEM	T4,(T);$
 IF NOT PRODUCTION SWITCH SET;
				TNGB(TRPOFF);
    THEN;..OUTPUT BLOCK-START ITEM FOR DEBUGGER
				SBHDR;
  FI;
ENDD;

SUBTTL POST-MORTEM BLOCK GENERATION ROUTINES - PMBLNT
PROCEDURE PMBLNT;
BEGIN
IF TRACING LABELS
				TNGB(TRLOFF);$
    THEN  ; LENGTH OF PMB _ SIXBITZ LENGTH OF NAME + 2 WORDS;
        BEGIN;
				MOVE	T,2(SYM);$
				ANDI	T,77;$
				TLNN	SYM,$TYPE-$L	;
				TLNN	SYM,$TYPE	;
				AOSA	T		;
				ADDI	T,2		;
				IDIVI	T,6;$
				ADDI	T,3;$
        ENDD;$
    ELSE;
    ; LENGTH _ 0
				SETZ	T,;$
FI;
ENDD;
SUBTTL POST-MORTEM BLOCK GENERATION ROUTINES - PMBPLT
PROCEDURE PMBPLT;
BEGIN
  LOCAL OUTPTR;
				MOVEI	T,0;$
				MABS;$
				MOVE	T1,2(SYM);$
				ANDI	T1,77;$
				AOS	T1;$
				HRRZI	T,(T1);$
				HRRZI	T4,(T1);$
				TLNN	SYM,$TYPE-$L;$
				TLNN	SYM,$TYPE;$
				JRST	.+2;$
				AOS	T,T1	;
				IDIVI	T1,6;$
				SKIPE	T2;$
				AOS	T1;$
				HRL	T,T1;$
				MOVEI	T1,2(SYM);$
				MOVE	T2,2(SYM);$
				LSH	T2,-6;$
				SETZB	T3,T5;$

PMB2:				JUMPN	T2,PMB3;$
				ADDI	T1,1;$
				MOVE	T2,(T1);$

PMB3:				SETZ	T3,;$
				LSHC	T2,-6;$
				JUMPE	T3,PMB3;$
				ROT	T3,6;$
				ADDI	T3,40;$

PMB7:				SOJG	T5,PMB5;$
				PUSH	SP,T2;$
				PUSH	SP,T3;$
				PUSH	SP,T4;$
				MABS;
				POP	SP,T4;$
				POP	SP,T3;$
				POP	SP,T2;$
				SETZ	T,;$
				SKIPA	T5,.+1;$
				POINT	6,T;$
				MOVEM	T5,OUTPTR;$
				MOVEI	T5,6;$

PMB5:				IDPB	T3,OUTPTR;$
				SOJG	T4,PMB2;$
				MOVEI	T3,':';$
				TLNN	SYM,$TYPE-$L;$
				TLNN	SYM,$TYPE;$
				JRST	.+2;$
				JUMPE	T4,PMB7;$
				MABS;
				TRNN	T,77;$
				JRST	PMB6;$
				MOVEI	T,0;$
				MABS;$
PMB6:
ENDD;
SUBTTL CODE GENERATION UTILITIES... PCALL, MJRST0.
;..ROUTINE TO EMIT CALL ON SYSTEM ROUTINE THROUGH %ALGDR TABLE.
PROCEDURE PCALL;
BEGIN
 FORMAL OFFSET;
 ;..THE ALGDR OFFSET IS PASSED AS A FORMAL.

 ;T<RHS>_OFFSET;
				HRR	T,OFFSET;$
 ;T<LHS>_'JSP	AX,';[303]
				HRLI	T,<JSP	AX,.-.>_-22 ;[303]
 MABS;
 ;T_RA-1;
				MOVE	T,RA;$
				SUBI	T,1;
 FIXADD;
 KILLAX;
ENDD;


;..ROUTINE TO EMIT INSTRUCTION "JRST 0" .
PROCEDURE MJRST0;
BEGIN
 ;T_'JRST	.-.';
				HRLZI	T,<JRST	.-.>_-22;$
 MABS;
ENDD
SUBTTL ROUTINE TOSTACK.
PROCEDURE TOSTACK;
  BEGIN
	;..THIS PROCEDURE GENERATES CODE TO PUSH SYM ONTO THE STACK;
	IF SYM<AM> = IMM
				T.IMM;$
	  THEN
	    ;.. ADD TO CONSTANTS TABLE;
	    ;T3_SYM<RHS>;
				HRRZ	T3,SYM;$
	    TOCT(1,SYM);
	FI;
	UNSTACK;
	REOPEN;
	;T_'PUSH SP,.-.';
				HRLZI	T,<PUSH SP,0>_-22;$
	PLUNKI(SYM);
	;SYM<AM>_SP;
				TLZ	SYM,$AM;$
				TLO	SYM,$SP;$
	CLOSE;
  ENDD;
SUBTTL ROUTINE LABREF.
;..ROUTINE PROCESSES DESIGNATIONAL EXPRESSION.
PROCEDURE LABREF;
BEGIN
 IF SYM<AM> = ST
				SETCM	T,SYM;$
				TLNN	SYM,30;$
				TLNE	T,7;$
				GOTO	FALSE;$
   THEN
     BEGIN
       ;..SYM IS AN IDENTIFIER.;
       IF SYM = VIRGIN ID
				T.VIRGIN;$
	 THEN
	   BEGIN
	     XTNDLB;
	     ;SYM_VAR,LABEL,SIM,UNDECL;
	     ;ST[SYM]<LEXEME>_VAR,LABEL,SIM,UNDECL;
				HRLI	SYM,$VAR!$L!$SIM;$
				HLLM	SYM,STW1;$
				TLO	SYM,$ST;$
	   ENDD;
	 ELSE
	   IF ST[SYM]<BL> LT BLOCKLEVEL
				HLRZ	T,STW0;$
				ANDI	T,$BL;$
				LSH	T,-6;$
				CAML	T,BLOCKLEVEL;$
				GOTO	FALSE;$
	     THEN
		BEGIN
		  ;..IDENTIFIER IS DECLARED IN SOME OUTER BLOCK.;
		  IF SYM NOT A FORMAL LABEL
				HLRZ	T,SYM;$
				ANDI	T,$TYPE!$STATUS;$
				CAIE	T,$L!$FON;$
				CAIN	T,$L!$FOV;$
				GOTO	FALSE;$
		    THEN
		      ;..MAKE NEW SYMBOL TABLE ENTRY FOR THIS IDENTIFIER
		      ;..  AT CURRENT BLOCKLEVEL IN CASE
		      ;..  IDENTIFIER IS REDECLARED IN THIS BLOCK.

		      ;..(THE CASE OF THE FORMAL LABEL IS EXCLUDED BECAUSE 
		      ;..  WE REQUIRE A FORWARD DECLARATION IF A FORMAL
		      ;..  LABEL IS TO BE REDECLARED. THIS IS NECESSARY
		      ;..  BECAUSE THE DIFFERENCE BETWEEN THE CODE
		      ;..  FOR GOTO LOCAL L  AND GOTO FORMAL L  COULD
		      ;..  NOT BE RESOLVED BY THE LOADER).;
		      STADD;
		      ;SYM_VAR,LABEL,SIM,UNDECL;
		      ;ST[SYM]<LEXEME>_VAR,LABEL,SIM,UNDECL;
				HRLI	SYM,$VAR!$L!$SIM;$
				HLLM	SYM,STW1;$
				TLO	SYM,$ST;$
		  FI;
		ENDD;
	     ELSE
		;..IDENTIFIER IS ALREADY AT CURRENT BLOCKLEVEL AND SO
		;..  IT MUST BE A LABEL OR BE IN ERROR.;
		IF SYM NE (VAR LABEL)
				TLNN	SYM,$TYPE;$
				GOTO	TRUE;$
				TLNN	SYM,<$KIND-$VAR>!<$TYPE-$L>;$
				GOTO	FALSE;$
		  THEN
		    SEMERR(104,0,LABEL IDENTIFIER);
		FI;
	   FI;
       FI;
     ENDD;
   ELSE
    ;..SYM IS NOT AN IDENTIFIER AND SO MUST BE A DESIGNATIONAL
    ;..  EXPRESSION OR BE IN ERROR.;
     IF SYM NE (EXP LABEL SIM)
				HLRZ	T,SYM;$
				ANDI	T,$KIND!$TYPE!$STATUS;$
				XORI	T,$EXP!$L!$SIM;$
				JUMPE	T,FALSE;$
       THEN
	 SEMERR(103,0,DESIGNATIONAL EXPRESSION);
     FI;
 FI;
ENDD;
SUBTTL ROUTINE FATRUND.
;..ROUTINE TO CHECK FOR USE OF FAT COMMA.
;..FATRUND IS USED IN SPRODEC AND SFPARN AS FOLLOWS:
;..	LOOP
;..	   ...
;..	AS DEL EQ COMMA OR FATCOMMA
;..		DELEL(.COM)
;..		SKIPE NSYM
;..		FATRUND
;..	SA;

;..IF NO FAT COMMA , RETURN FALLS THROUGH.
;..IF FAT COMMA, RETURN IS TO TRUE (MADE VIA THE GOTO TRUE IN DELEL(.COM)).
PROCEDURE FATRUND;
BEGIN
 REGISTER NUMERIC;
 IF DEL= RPAR AND NDEL = COL
				DELEL(.RPAR);$
				NDELEL(.COLON);
   THEN
     BEGIN
	;T1_NSYM;
				MOVE	T1,NSYM;$
	IF NSYM=CONSTANT
				TLNN	T1,$EXP;$
				GOTO	FALSE;$
	  THEN
	    ;NUMERIC_40;
				MOVEI	NUMERIC,40;
	  ELSE
	    BEGIN
		;..AN EXPLANATION OF WHAT THIS COMPOUND STATEMENT DOES
		;..IS LEFT AS AN EXERCISE TO THE READER;
		;T5_LENGTH IN WORDS OF ID;
				MOVE	T5,-1(T1);$
		;NUMERIC_FIRST FIVE CHARACTERS;
				MOVE	NUMERIC,(T1);$
		;NUMERIC<30-35>_0;
				TRZ	NUMERIC,77;$
		WHILE T5 NE 0
				JUMPE	T5,FALSE;$
		  DO
		   BEGIN
		     ;NUMERIC_NUMERIC OR @NSYM;
				IOR	NUMERIC,@NSYM;$
		     DECR(T5);
		   ENDD;
		  OD;
	    ENDD;
	FI;
	ZERO(NSYM);
	RUND;
	IF NSYM = PHI AND NDEL = LPAR
				MOVE	T,NDEL;$
				CAMN	T,ZLPAR;$
				SKIPE	NSYM;$
				GOTO	FALSE;$
	  THEN
	    BEGIN
		;..FAT COMMA;
		IF NUMERIC AND 404040404040 NE 0
				TDNN	NUMERIC,[404040404040];$
				GOTO	FALSE;$
		  THEN
		    FAIL(11,SOFT,SYM,ONLY LETTER STRING ALLOWED);
		FI;
		RUND;
		;RETURN TO TRUE;
				MOVE	T,-1(SP);$
				SUBI	T,3;$
				MOVEM	T,-1(SP);$
	    ENDD;
	  ELSE
	    FAIL(9,HARD,DEL,AMBIGUOUS USE OF COLON);
	FI;
     ENDD;
 FI;
ENDD;
SUBTTL ROUTINE GCOND.
;..ROUTINE TO PROCESS EXPRESSION THAT MAY BE 
;..BOOLEAN, ARITHMETIC OR DESIGNATIONAL.  IT IS CALLED FROM
;..BOTH CLAUSES OF CONDITIONAL EXPRESSION , EXPRESSION PARENTHESIS,
;.. AND SWITCH DECLARATION.;
PROCEDURE GCOND;
BEGIN
 ;..THE FORMAL FROM THE CALLING ROUTINE IS PASSED IN T;
 IF OLDEL = DESIGNATIONALS
				TEL(.LSEL);$
   THEN
     LABREF;
 FI;
 EVAL;
 IF SYM<TYPE> = LABEL
				TLNE	SYM,$TYPE;$
				T.L;$
   THEN
     BEGIN
	IF SYM<AM> = ST
				TLNE	SYM,$AM-$ST;$
				GOTO	FALSE;$
	  THEN
	    BEGIN
	      ;T_'MOVEI A2,.-.';
				HRLZI	T,<MOVEI	A2,0>_-22;$
	      PLUNKI(SYM);
	      ;SYM<STATUS>_SIMPLE;
	      ;SYM<AM>_PTR;
				TLZ	SYM,$AM!$STATUS;$
				TLO	SYM,$PTR;$
	      ;SYM<RESULT>_A2;
				HRRI	SYM,A2;$
	      CLOSE;
	    ENDD;
	FI;
     ENDD;
   ELSE
     IF SYM<KIND>=ARRAY OR SYM<TYPE> = N.T. OR NOT SYM<DECL>
				TLNE	SYM,$ARR;$
				GOTO	TRUE;$
				TLNN	SYM,$DECL;$
				GOTO	TRUE;$
				T.N;$
       THEN
	 SEMERR(100,0,EXPRESSION);
     FI;
 FI;
ENDD;
SUBTTL ROUTINE GDOUBLE.
;..ROUTINE TO DOUBLE A CONSTANT AT COMPILE TIME;
;..USED FOR LAST DIMENSION OF LONG REAL AND STRING ARRAY SUBSCRIPTING.;
PROCEDURE GDOUBLE;
BEGIN
 NEWLOP;
 REGISTER LOP;
 ;LEFTOP_SYM;
				SYMSAVE;$
 ;OP_'PLUS LEXEME';
				MOVE	T,ZPLUS;$
				MOVEM	T,OP;$
 CGBINARY;
ENDD;
SUBTTL ROUTINE GSTAT.
;..ROUTINE TO COMPLETE THE CODE FOR A STATEMENT AND OUTPUT TO REL FILE.
PROCEDURE GSTAT;
BEGIN
 IF NOT SYM<STMT>
				SETCM	T,SYM;$
				TLNN	T,$STMT;$
				GOTO	FALSE;$
   THEN
     BEGIN
       IF SYM<KIND> = PROC AND SYM<TYPE> NE LABEL
				T.PRO;$
				TN.L;$
	 THEN
				TRNN	FL,TRPOFF
				PUSHJ	SP,.SNBLK##
	   EVAL
	 ELSE
	   BEGIN
	     IF SYM NE PHIS AND NOT ERRL
				JUMPE	SYM,FALSE;$
				TNGB(ERRL);$
		THEN
		    SEMERR(101,$PRO!$I!$DECL,STATEMENT);$
	     FI;
	     STATEMENT;

	     ;* WARNING, ERRL IS BEING TURNED OFF!!;
	     SFALSE(ERRL);
	   ENDD;
       FI;
     ENDD;
 FI;
 IF CODE GENERATED
				T.COGE;$
   THEN
     MOB;
 FI;
 ;..RESTORE TEMPCODE BUFFER TO EMPTY;
 ;INDEX_TCBASE;
 ;HANDLE_770000,TCBASE;
				MOVE	T,TCBASE;$
				MOVEM	T,INDEX;$
				HRLI	T,770000;$
				MOVEM	T,HANDLE;$
ENDD;
SUBTTL ROUTINE GBOOL.
;..ROUTINE TO PROCESS BOOLEAN EXPRESSION USED IN CONDITIONAL TEST.
;..GBOOL IS CALL FOR CONDITIONAL STATEMENT,CONDITIONAL EXPRESS,
;..	WHILE STATEMENT, AND WHILE-FOR-LIST-ELEMENT.
PROCEDURE GBOOL;
BEGIN
 EVAL;
 UNSTACK;
 REOPEN;
 IF SYM<KIND> EQ ARRAY OR SYM<TYPE> NE BOOLEAN OR NOT SYM<DECL>
				TLNN	SYM,$DECL;$
				GOTO	TRUE;$
				TLNN	SYM,$TYPE;$
				GOTO	TRUE;$
				TLNN	SYM,$ARR!<$TYPE-$B>;$
				GOTO	FALSE;				
  THEN
   SEMERR(102,$VAR!$B!$SIM!$DECL,BOOLEAN EXPRESSION)
  ELSE
    IF SYM<ADDRESS MODE> EQ ACCUMULATOR
				TLNE	SYM,$AM-$ACC;$
				GOTO	FALSE;$
     THEN
     BEGIN
      ;..BOOLEAN VALUE IS IN A REGISTER.;
      IF LAST OPERATION WAS RELATION
				MOVE	T,INDEX;$
				HLRZ	T1,-2(T);$
				ANDI	T1,777000;$
				CAIE	T1,<TDZA 0,0>_-22;$
				GOTO	FALSE;$
				HLRZ	T1,-1(T);$
				ANDI	T1,777000;$
				CAIE	T1,<SETO 0>_-22;$
				GOTO	FALSE;$
       THEN
	BEGIN
	 ;..STRIP OFF CODE TO CREATE TRUE OR FALSE;
	 ;TC[INDEX-2]_'JRST 0';
				HRLZI	T1,<JRST 0>_-22;$
				MOVEM	T1,-2(T);$
	 DECR(INDEX);
	ENDD;
       ELSE
        BEGIN
	;T_'JUMPE .-.';
				HRLZI	T,<JUMPE .-.>_-22;$
	;T1_SYM<RESULT>;
				HRRZ	T1,SYM;$
	PLUNK;
        ENDD
      FI;
     ENDD;
     ELSE
      ;..BOOLEAN VALUE IS NOT IN A REGISTER.;
      IF SYM<ADDRESS MODE> ELEMENT OF [CT IMM]
				T.CONST;$
       THEN
	BEGIN
	 ;..BOOLEAN VALUE IS A CONSTANT.;
	 IF SYM<ADDRESS MODE> EQ IMM AND SYM<RHS>EQ FALSE
				TRNN	SYM,777777;$
				T.IMM;$
	  THEN
	   ;..CONSTANT IS FALSE SO ALWAYS JUMP TO ELSE-PART.;
	   ;T_'JRST .-.';
				HRLZI	T,<JRST .-.>_-22;$
	  ELSE
	   ;..CONSTANT IS NOT FALSE (NE 0) SO NEVER JUMP.
	   ;..  IE. ALWAYS FALL THROUGH TO THEN -PART.;
	   ;T_'NOOP .-.';
				HRLZI	T,<NOOP .-.>_-22;$
	 FI;
	 PLUNKI;
	ENDD
       ELSE
	BEGIN
	 ;..BOOLEAN VALUE IS IN STORAGE AND IS NOT A CONSTANT.;
	 ;T_'SKIPN 0';
				HRLZI	T,<SKIPN 0>_-22;$
	 PLUNKI(SYM);
	 ;T_'JRST .-.';
				HRLZI	T,<JRST .-.>_-22;$
	 PLUNKI;
	ENDD;
      FI;
    FI;
 FI;
 CLOSE;
 ;SYM<KIND>_EXP;
				TLZ	SYM,$KIND;$
				TLO	SYM,$EXP;$
ENDD;
SUBTTL  DISPATCH TABLES FOR SYNTAX ROUTINES
INTERNAL STABLE;		;STATEMENTS
INTERNAL ETABLE;		;EXPRESSIONS(ARITHMETIC & BOOLEAN)
INTERNAL LTABLE;		;EXPRESSIONS(DESIGNATIONAL)
INTERNAL FTABLE;		;FOR LIST ELEMENTS

;MACRO TO DEFINE DISPATCH TABLES
DEFINE DT(LIST)
<IRP LIST,<IFNDEF .'LIST,<EXTERN .'LIST>
XWD 0,.'LIST
>>

STABLE: DT(<F1,SARY,SSPAREN,SSIF,F1,F1,F1,SWHILE,SASS,SDOT,SBEGIN,SFOR,SGOTO,SCOL,SONOFF,F2>);

ETABLE: DT(<F3,SBRACK,SEPAREN,SEIF,SOP,F3,F3,F3,F5,SDOT,F3,F3,F3,F3,F3,F3>);

LTABLE: DT(<F4,SSW,SLPAREN,SEIF,F4,F4,F4,F4,F4,F4,F4,F4,F4,F4,F4,F4>);

FTABLE=.-5
DT(<SSTEP,SUNTIL,SFWHILE>);



SUBTTL GLOBAL CONSTANTS
INTERN DCBYTE,PRIOBYTE,DESCBYTE
DCBYTE:		POINT	4,DEL,35
PRIOBYTE:	POINT	4,DEL,31
DESCBYTE:	POINT	5,DEL,27
 
ENDD; OF MODULE ALGUTL

LIT
END TEST