;
;
;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 STATEMENT MODULE

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

	HISEG

	SEARCH ALGPRM,ALGMAC	; SEARCH PARAMETER FILES
MODULE MSTM;
$PLEVEL=2;
BEGIN
EXTERN STABLE,ETABLE,LTABLE,FTABLE,DCBYTE,PRIOBYTE,DESCBYTE;
EXPROC BLK1,BLK2,RUND,RUND2,RUND3,RUND5,FAIL,ERREAD,ERR,DSEL,SDOT,SBRACK,BENTRY,BEXIT,PSEUDO;
EXPROC MOB,PCALL,MABS,MREL,SEMERR,RAFIX,EVAL,MJRST0,UNSTACK,REOPEN,CLOSE,PLUNK,IPLUNK,LABREF,GBOOL,GSTAT;
EXPROC MPS,XTNDLB,STADD,SCINS; [E030]
EXPROC DUBDEC,PMBPLT,PMBLNT;
EXPROC	MRK.1,MRK.2,MRK.3,MRK.4,MRK.5,MRK.6,MRK.7,MRK.8,MRK.9;

;..SIMULATE THE ENVIRONMENT OF PROCEDURE DECLARATION ROUTINE(SPRODEC).;
FAKE FORMCT,PNAME,FSDISP,MXDISP,ST11,RELBLOCK,PARAM1;
SUBTTL ROUTINE FOR <WHILE STATEMENT>.
;
;PARSE:		<WHILE STATEMENT>::= WHILE <BOOLEAN EXPRESSION> DO <STATEMENT>
;
;SYNTAX ERRORS:
;		WHILE NOT IMMEDIATELY PRECEDED BY A DELIMITER
;			BEGIN X WHILE B DO S END
;			      ^
;
;		PENDING STOPPER ENCOUNTERED BEFORE DO
;			BEGIN WHILE A = END DO S END
;					  ^
;
;		WHILE STATEMENT OCCURS WHERE ONLY <UNCONDITIONAL STATEMENT> IS ALLOWED
;			IF B THEN WHILE B DO S ELSE S;
;						  ^
;
;SEMANTIC ERRORS:
;		NOT <BOOLEAN EXPRESSION>
;			WHILE A + B DO S
;				  ^
;
;		NOT <STATEMENT>
;			WHILE B DO A[I];
;				      ^
;
;CODE 	GENERATED:
;		L: <BOOLEAN EXPRESSION>
;		   [TRANSFER TO L2 IF <BOOLEAN EXPRESSION> IS FALSE]
;		   <STATEMENT>
;		   JRST L
;		L2:
;
PROCEDURE SWHILE;
BEGIN
 LOCAL ST6,WHINIT,WHJUMP;
 FORMAL OLDEL;
 MRK.1; PLACE 'FOR' MARKER;
 IF SYM NE PHI
				JUMPE	SYM,FALSE;$
   THEN
     FAIL(8,SOFT,SYM,SYMBOL NOT PERMITTED HERE);
   FI;
 CODE GWHL1;
;----
 ;WHINIT_RA;
				MOVE	T,RA;$
				MOVEM	T,WHINIT;$
 KILLAX;
;-------
 ENDCODE;
 ;ST6_STOPS;
 ;STOPS_STOPS OR 'DO';
				SETSTOPS(ST6,.DO);$
 RUND;
 ESEL;
 ;STOPS_ST6;
				RESTOP(ST6);$
 IF DEL = 'DO'
				DELEL(.DO);$
   THEN
    BEGIN
	CODE GWHL2;
;	----
	GBOOL;
	MOB;
	;WHJUMP<RHS>_(RA-1);
	;WHJUMP<LHS>_CAX;
				MOVE	T,RA;$
				SUBI	T,1;$
				HRL	T,CAX;$
				MOVEM	T,WHJUMP;$
;	-------
	ENDCODE;
	SFALSE(ERRL);
	RUND2;
	MRK.2;	PLACE 'DO' MARKER;
	SSEL;
	CODE GWHL3;
;	----
	GSTAT;
	;T_'JRST'.WHINIT;
				HRLZI	T,<JRST 0>_-22;$
				HRR	T,WHINIT;$
	MREL;
	JOIN(WHJUMP);
	MRK.3;	PLACE 'OD' MARKER;
;	-------
	ENDCODE;
	SFALSE(ERRL);
     ENDD
   ELSE
     FAIL(12,HARD,DEL,ILLEGAL DELIMITER FOUND BEFORE 'DO');
 FI
 IF DEL = 'ELSE' AND OLDEL = 'STHEN'
				DELEL(.ELSE);$
				MOVE	T,OLDEL;$
				TEL(OTHEN);$
   THEN
     FAIL(13,SOFT,DEL,WHILE STATEMENT IS NOT UNCONDITIONAL STATEMENT);
 FI
 CODE GWHL4;
;----
 STATEMENT;
;-------
 ENDCODE;
ENDD;


SUBTTL ROUTINE FOR <UNLABELLED CONDITIONAL STATEMENT>.
;
;PARSE:		<UNLABELLED CONDITIONAL STATEMENT>::=
;			<IF STATEMENT>/
;			<IF STATEMENT> ELSE <STATEMENT>/
;			<IF CLAUSE> <FOR STATEMENT>/
;			<IF CLAUSE> <WHILE STATEMENT>
;		WHERE <IF CLAUSE>::=IF <BOOLEAN EXPRESSION> THEN
;		AND   <IF STATEMENT>::= <IF CLAUSE><UNCONDITIONAL STATEMENT>
;
;SYNTAX ERRORS:
;		IF NOT PRECEDED BY A DELIMITER
;			BEGIN X IF B THEN S;S END
;			      ^
;
;		THIS STATEMENT OCCURS WHERE ONLY <UNCONDITIONAL STATEMENT> IS ALLOWED
;			IF B THEN IF B THEN S;
;				   ^
;
;		PENDING STOPPER ENCOUNTERED BEFORE THEN
;			IF B = END THEN S ELSE S
;				 ^
;
;		SPURIOUS SEMICOLON BEFORE ELSE
;			IF B THEN S; ELSE S
;				   ^
;
;
PROCEDURE SSIF;
BEGIN
 REGISTER REGIF;
 LOCAL ST7,IFJUMP;
 FORMAL OLDEL;
 MRK.4;	PLACE 'IF' MARKER
 IF SYM NE PHI
				JUMPE	SYM,FALSE;$
    THEN
      FAIL(8,SOFT,SYM,SYMBOL NOT PERMITTED HERE);
    FI;
 IF OLDEL ='STHEN'
				MOVE	T,OLDEL;$
				TEL(OTHEN);$
  THEN
    FAIL(14,HARD,DEL,'THEN IF' ILLEGAL);
 FI;
 ;ST7_STOPS;
 ;STOPS_STOPS OR 'THEN';
				SETSTOPS(ST7,.THEN);$
 RUND;
 ESEL;
 IF DEL = 'THEN'
				DELEL(.THEN);$
   THEN
     BEGIN
;	----
	CODE GSIF1;
	 GBOOL;
	 MOB;
	 ;IFJUMP<RHS>_(RA-1);
				HRRZ	T,RA;$
				SUBI	T,1;$
	 ;IFJUMP<LHS>_CAX;
				HRL	T,CAX;$
				MOVEM	T,IFJUMP;$
;	-------
	ENDCODE;
	SFALSE(ERRL);
	;STOPS_ST7 OR 'SELSE';
				MOVE	STOPS,ST7;$
				ADDSTOPS(.ELSE);$
	RUND2;
	MRK.5;	PLACE 'THEN' MARKER;
	SSEL(OTHEN);
	;STOPS_ST7;
				RESTOPS(ST7);$
	CODE GSIF2;
;       ----
        GSTAT;
;       -------
	ENDCODE;
	SFALSE(ERRL);
     ENDD
   ELSE
     BEGIN
	;STOPS_ST7;
				RESTOPS(ST7);$
	FAIL(15,HARD,DEL,THEN STATEMENT NOT FOUND);
	IF DEL NE 'ELSE'
				DELNEL(.ELSE)
	  THEN
	    ;..SORRY TO HAVE TO DO THIS;
	    GOTO RETURN;
	FI;
     ENDD
 FI;
 IF DEL = SC AND NDEL = 'ELSE' AND NSYM = PHI
				DELEL(.SC);$
				NDELEL(.ELSE);$
				SKIPE	NSYM;$
				GOTO	FALSE;$
   THEN
      BEGIN
	FAIL(10,SOFT,DEL,SPURIOUS SEMICOLON);
	;REGIF_SYM;
				MOVE	REGIF,SYM;$
	RUND;
	;SYM_REGIF;
				MOVE	SYM,REGIF;$
      ENDD
 FI;
 IF DEL = 'ELSE'
				DELEL(.ELSE);$
   THEN
      BEGIN
	CODE GSIF3;
;	----
 IF SYM<TYPE> NE LABEL
				TLNN	SYM,$TYPE;$
				GOTO	TRUE;$
				TN.L;$
   THEN
     BEGIN
	MJRST0;
	FIXREL(IFJUMP);
	;IFJUMP<RHS>_RA-1;
				HRRZ	T,RA;$
				SUBI	T,1;$
				HRRM	T,IFJUMP;$
     ENDD
   ELSE
    BEGIN
	FIXREL(IFJUMP);
	;CAX_IFJUMP<LHS>;
	;IFJUMP<RHS>_0;
				HLLZS	T,IFJUMP;$
				HLRZM	T,CAX;$
     ENDD
 FI;
 ;EXCHANGE(CAX,IFJUMP<LHS>);
				HLRZ	T,IFJUMP;$
				EXCH	T,CAX;$
				HRLM	T,IFJUMP;$
;	-------
	ENDCODE;
	RUND2;
	MRK.6;	PLACE 'ELSE' MARKER;
	SSEL;
	CODE GSIF4;
;	----
	GSTAT;
;	-------
	ENDCODE;
	SFALSE(ERRL);
      ENDD
 FI;
;----
 CODE GSIF5;
 FIXREL(IFJUMP);
 MRK.7;	PLACE 'FI' MARKER
 IF CAX NE IFJUMP<LHS>
				HLRZ	T,IFJUMP;$
				CAMN	T,CAX;$
				GOTO	FALSE;$
  THEN
    KILLAX
 FI;
 STATEMENT
;-------
 ENDCODE;
RETURN: ENDD;
SUBTTL ROUTINE FOR <UNLABELLED BLOCK> / <UNLABELLED COMPOUND>.
;
;PARSE:		<UNLABELLED BLOCK>::= <BLOCK HEAD> ; <COMPOUND TAIL>
;		<UNLABELLED COMPOUND>::= BEGIN <COMPOUND TAIL>
;			WHERE <COMPOUND TAIL>::=<STATEMENT> END/
;						<STATEMENT>;<COMPOUND	TAIL>
;
;SYNTAX ERRORS:
;		BEGIN NOT IMMEDIATELY PRECEDED BY A DELIMITER
;			IF B THEN L BEGIN S; S END;
;				  ^
;
;		<BLOCK HEAD> NOT FOLLOWED BY SEMICOLON
;			BEGIN REAL X, Y, Z END
;					     ^
;
;		MISSING SEMICOLON
;			BEGIN S END WHILE B DO S;
;				   ^
;
;		NO DELIMITERS ALLOWED IN COMMENT AFTER END
;			BEGIN S END OF THIS OR THAT 
;					      ^
;		MISSING END
;			IF B THEN BEGIN S; S; S ELSE S
;						   ^
;
;SEMANTIC ERRORS:
;		NOT <STATEMENT>
;			BEGIN S; A[I]; S END
;				    ^
;
PROCEDURE SBEGIN;
BEGIN
 LOCAL BLOCK,OLDPS,SAVCLB,OLDAD,FSDSAVE,FLSAVE;
 FORMAL OLDEL;
 IF SYM NE PHI
				JUMPE	SYM,FALSE;$
   THEN
     FAIL(8,SOFT,SYM,SYMBOL NOT PERMITTED HERE);
  FI;
 PSEUDO;
 CODE GBEG0;
;----
 ;OLDPS_PROSKIP;
				MOVE	T,PROSKIP;$
				MOVEM	T,OLDPS;$
 ZERO(PROSKIP);
 ;OLDAD_ARDEC;
				MOVE	T,ARDEC;$
				MOVEM	T,OLDAD;$
 SETF(ARDEC);
 ;FLSAVE_NOENTRY
				MOVEI	T,NOENTRY
				AND	T,FL
				MOVEM	T,FLSAVE
;-------
 ENDCODE;
 IF NDEL NOT ELEMENT OF DECSPEC
				MOVE	T,NDEL;$
				TNEL(DECSPEC);$
   THEN
      CODE GBEG1;
;      ----
	SETF(BLOCK);
;      -------
      ENDCODE;
   ELSE
     BEGIN
	CODE GBEG2;
;	----
	;FSDSAVE_FSDISP;
				MOVE	T,FSDISP;$
				MOVEM	T,FSDSAVE;$
	SETT(BLOCK);
	BENTRY;
	INCR(LEXBLOCK);
	;SAVCLB_CURBLOCK;
				MOVE	T,CURBLOCK;$
				MOVEM	T,SAVCLB;$
	;CURBLOCK_LEXBLOCK;
				MOVE	T,LEXBLOCK;$
				MOVEM	T,CURBLOCK;$
	;PRINT BLOCK ENTRY MESSAGE;
	BLK1;
	INCR(RELBLOCK);
	MCALL(BLKBEG);
;	-------
	ENDCODE;
	LOOP
	  BEGIN
	    RUND2;
	    DSEL;
	    SFALSE(ERRL);
	  ENDD
	AS DEL = SC AND NDEL IS DECSPEC
				TEST(N,DEL,.SC);$
				GOTO	FALSE;$
				NDELEL(DECSPEC);$
	SA;
	CODE GBEG3;
;	----
	IF PROSKIP NE 0
				SKIPN	T,PROSKIP;$
				GOTO	FALSE;$
	  THEN
	   JOIN;..(PROSKIP);
	FI;
;	-------
	ENDCODE;
	IF DEL NE SC
				DELNEL(.SC);$
	  THEN
	    FAIL(16,SOFT,SYM,DECLARATIONS MUST BE FOLLOWED BY SEMICOLON);
	    IF DEL ELEMENT STOPS
				TDNN	DEL,STOPS;$
				GOTO	FALSE;$
	      THEN
		GOTO SBEG1;
	    FI;
	FI;
     ENDD;
 FI;


	LOOP
	  BEGIN
	    RUND2;
	    SSEL;
	    CODE GBEG4;
;	    ----
	    GSTAT;
;	    -------
	    ENDCODE;
	    ;IF FLSAVE EQ ZERO
				SKIPN	FLSAVE
	      ;THEN
	      SFALSE(NOENTRY);
	    ;FI
	    SFALSE(ERRL);
	  ENDD;
	AS DEL = SC;
				DELEL(.SC);$
	SA;

	SBEG1:
	IF DEL = END
				DELEL(.END);$
	  THEN
	    BEGIN
	      ;..PRINT BLOCK END;
	      IF BLOCK
				SKIPN	BLOCK;$
				GOTO	FALSE;$
		THEN
		  BEGIN
		  ;T_SAVCLB;
				MOVE	T,SAVCLB;$
		  BLK2;
		  ENDD;
	      FI;
EDIT(030) ;DONT ALLOW BEGIN IN COMMENT (NOT STRICTLY ALGOL, BUT..)
		WHILE NDEL NOT ELEM SC END ELSE EOF BGIN; [E030]
				MOVE	T,NDEL	; [E030]
				CAMN	T,ZBEGIN; [E030]
				GOTO	FALSE	; [E030]
				NDELNEL(.SC!.END!.ELSE!.EOF);$
		  DO;
		    ZERO(NSYM);$
		    RUND;
		  OD;
		ZERO(NSYM); [E030]
		IF NDEL EQ BGIN ; [E030]
				MOVE	T,NDEL	; [E030]
				CAME	T,ZBEGIN; [E030]
				GOTO	FALSE	; [E030]
		  THEN; [E030]
		  SCINS; [E030]
		  ELSE ; [E030]
		  RUND ; [E030]
		FI; [E030]
	    ENDD
	  ELSE
		FAIL(20,SOFT,SYM,MISSING END);
	FI;
	IF BLOCK
				SKIPN	BLOCK;$
				GOTO	FALSE;$
	  THEN
	    BEGIN
		CODE GBEG5;
;		----
		;ALLOW PAUSE ON THE "END"
				TRNN	FL,TRPOFF	;IF TRACING
				PUSHJ	SP,.ESBLK##	; CALL SPECIAL ROUTINE
		IF ARDEC
				SKIPN	ARDEC;$
				GOTO	FALSE;$
		  THEN
		    MCALL(BLKEND)
		  ELSE
		    MABSI(<SOS	PLBLKL(DL)>);
		    MABSI(<POP	SP,BLKPTR(DL)>)
		    MABSI(<SOS %TRLV(DB)>);
		FI;
		;MXDISP_MAX(MXDISP,FSDISP);
				MOVE	T,FSDISP;$
				CAMLE	T,MXDISP;$
				MOVEM	T,MXDISP;$
		BEXIT;
		;CURBLOCK_SAVCLB;
				MOVE	T,SAVCLB;$
				MOVEM	T,CURBLOCK;$
		DECR(RELBLOCK);
		;FSDISP_FSDSAVE;
				MOVE	T,FSDSAVE;$
				MOVEM	T,FSDISP;$
;		-------
		ENDCODE;
	    ENDD;
	FI;
	CODE GBEG6;
;	----
	;PROSKIP_OLDPS;
				MOVE	T,OLDPS;$
				MOVEM	T,PROSKIP;$
	;ARDEC_OLDAD;
				MOVE	T,OLDAD;$
				MOVEM	T,ARDEC;$
	STATEMENT;
;	-------
	ENDCODE;
ENDD;
SUBTTL ROUTINE FOR <UNLABELLED GOTO STATEMENT>
;PARSE:	<GOTO STATEMENT>::= GOTO <DESIGNATIONAL EXPRESSION>
;
;SYNTAX ERRORS:
;		GOTO NOT FOLLOWED BY DESIGNATIONAL EXPRESSION
;			GOTO L+1;
;			      ^
;
;SEMANTICS ERRORS:
;		GOTO NOT FOLLOWED BY LABEL VALUED EXPRESSION
;			BEGIN INTEGER L; GOTO L END
;					      ^
;
;CODE GENERATED:
;	1) GOTO L(THIS BLOCK)
;		JRST L+2
;	2) GOTO L; (OUTER BLOCK)
;		JRST L
;	3) GOTO <OTHER DESIGNATIONAL EXPRESSION>
;		JUMPN A2,(A2)
;		[DESIGNATIONAL EXPRESSION PUTS VALUE IN REGISTER AL OR
;		ZERO IF SWITCH IS OUT OF BOUNDS]
PROCEDURE SGOTO;
BEGIN
 RUND5;
 MRK.8;	PLACE 'GOTO' MARKER
 LSEL;
 CODE GGO;
;----
 LABREF;
 EVAL;
UNSTACK; [267]
 IF SYM<ADDRESS MODE> = SINGLE
				T.SINGLE;$
   THEN
     BEGIN
	;..NOTE THAT SYM IS BEING CLOBBERED!;
	MRK.9;	PLACE 'TO' MARKER
	;T_'JRST'.SYM;
				HRLZI	T,<JRST	0>_-22;$
				TLZ	SYM,777777-$AM;$
				IOR	T,SYM;$
	MPS;
	STATEMENT($L);
     ENDD;
   ELSE
     BEGIN
	MOB;
	MRK.9;	PLACE 'TO' MARKER
	;..GENERATE 'JUMPN	A2,(A2)';
	;T_'JUMPN	A2,.-.'!$SELF;
				HRLZI	T,<JUMPN A2,0>_-22!$SELF;$
	MPS;
	STATEMENT;
     ENDD;
 FI;
;-------
 ENDCODE;
 SFALSE(ERRL);
ENDD;
SUBTTL ROUTINE FOR LABEL DECLARATION
PROCEDURE SCOL;
BEGIN
KILLAX;
LOOP
 BEGIN
 CODE GCOL1;
;----
 IF SYM EQ PHI OR SYM<ADDRESS MODE> NE SIMPLE VARIABLE IN SYMBOL TABLE
EDIT(027) ; CHECK TYPE OF APPARENT LABELS MORE CAREFULLY
				JUMPE	SYM,TRUE;$
				HLRZ	T,SYM	; [E027]
				ANDI	T,$AM	; [E027]
				CAIN	T,$ST	; [E027]
				GOTO	FALSE	; [E027]
  THEN
   SEMERR(105,0,LABEL IDENTIFIER)
  ELSE
   BEGIN
    IF SYM EQ VIRGIN IDENTIFIER AND NOT EXTENDED
				T.VIRGIN;$
				SKIPGE	STW0;$
				JRST	FALSE;$
     THEN
      XTNDLB
     ELSE
      IF ST[SYM]<BLOCKLEVEL> LT BLOCKLEVEL
				HLRZ	T,STW0;$
				ANDI	T,$BL;$
				LSH	T,-6;$
				CAML	T,BLOCKLEVEL;$
				GOTO	FALSE;$
	THEN
	 STADD
	ELSE
	 IF SYM<DECL>
				T.DECL;$
	 THEN
	  BEGIN
	   DUBDEC;
	   GOTO COLEND;
	  ENDD;
	 FI;
      FI;
    FI;
    ;ST[SYM]<WORD1>_[VAR,LABEL,SIMPLE,DECLARED] . RA+1+PMBLNT;
    ;T1_PMBLNT;
				TLO	SYM,$VAR!$L!$SIM!$DECL	;
    PMBLNT;
				MOVE	T1,T;$
				ADDI	T,1;$
				ADD	T,RA;$
				HRLI	T,$VAR!$L!$SIM!$DECL;$
				MOVEM	T,STW1;$
;-------
 ENDCODE;
IF LABEL TRACE REQUIRED
				TNGB(TRLOFF);$
    THEN
      GCOL2;	PLANT PMBLOCK AND LABEL CODE (ONE FOR EACH NAME HERE)
FI;
   ENDD;
  FI;
COLEND:

  RUND2;
ENDD;
AS DEL EQ COLON
				DELEL(.COLON);
SA;
IF NOT TRACING LABELS;
				TGB(TRLOFF);$
    THEN;  NEED TO PLANT JUST ONE BLOCK OF LABEL CODE;
        BEGIN
        ; T1_0; MARK LENGTH OF PMB ZERO;
				SETZ	T1,;$
	GCOL2;
        ENDD;
    FI;
SFALSE(ERRL);
ENDD;

PROCEDURE GCOL2;

BEGIN
	LOCAL PMBSAV;
    ;..PUT OUT THE 3 INSTRUCTION SEQUENCE.
    ;T_'JRST .+3+PMBLNT';
				HRLZI	T,<JRST 0>_-22;$
				ADD	T,RA;$
				ADDI	T,3(T1);$
    MREL;

IF TRACING LABELS;
				TNGB(TRLOFF);$
    THEN;
    BEGIN;
    ; SAVE POINTER TO PMBLOCK
				MOVE	T,RA;$
				MOVEM	T,PMBSAV;$
    PMBPLT;		PLANT PMB HERE
    ENDD;
FI;
    MCALL(GOLAB);
    ;T_'RELBLOCK,FNLEVEL-1(DL)';
				HRLZ	T,RELBLOCK;$
				LSH	T,+5;$
				TLO	T,DL;$
				HRR	T,FNLEVEL;$
				SUBI	T,1;$
    MABS;

IF TRACING LABELS;
				TNGB(TRLOFF);$
    THEN; PLANT CALL TO LABEL TRACE ROUTINE;
        BEGIN;
        MCALL(TRLAB);
	; MREL(PMBPTR);
				MOVE	T,PMBSAV;$
				MREL;
        ENDD;
FI;
ENDD;
SUBTTL PROCEDURE FOR CHECKON,CHECKOFF,LISTON,LISTOFF,LINE
PROCEDURE SONOFF;
BEGIN
 REGISTER SUBCLASS;
 ;SUBCLASS_DEL<DESC>;
				LDB	SUBCLASS,DESCBYTE;$
 RUND5;
 WHILE DEL ELEMENT STOPS
				NOTSTOPS;$
   DO
     IF ERRL
				TGB(ERRL);$
	THEN
	  ERREAD
	ELSE
	  FAIL(18,HARD,DEL,ILLEGAL ARGUMENT);
     FI;
   OD;
 IF NOT ERRL
				TNGB(ERRL);$
   THEN
     BEGIN
       IF SYM = IMMEDIATE INTEGER CONSTANT
				T.IMM;$
				T.I;$
	 THEN
	   BEGIN
	     IF SUBCLASS = LINE
				CAIE	SUBCLASS,DESC<LINE>;$
				GOTO	FALSE;$
	       THEN
		 ;LINENO_SYM<RHS>;
				HRRM	SYM,LINENO;$
	       ELSE
		 IF SYM GE 3
				TLZ	SYM,777777;$
				CAIGE	SYM,3;$
				GOTO	FALSE;$
		   THEN
		     SONERR: FAIL(19,SOFT,SYM,ARGUMENT TOO LARGE);
		   ELSE
		     ;SUBCLASS_SUBCLASS;
		     ;EVALUATE(OOTABLE[SUBCLASS]);
				XCT	OOTABLE(SUBCLASS);$
		   IF ACON
				TGB(ACON);
		     THEN
		     ; FORCE ACOO _ 1;
				STRUE(ACOO);
		   FI;
		   IF ACOFF
				TGB(ACOFF);
		     THEN
		     ; FORCE ACOO _ 0;
				SFALSE(ACOO);
		   FI;
		 FI;
	     FI;
	   ENDD;
	 ELSE
	   FAIL(18,SOFT,SYM,ILLEGAL ARGUMENT);
	FI;
     ENDD;
 FI;
 CODE GSONOFF;
;----
 STATEMENT;
;-------
 ENDCODE;
ENDD;
 ;EXECUTE TABLE TO SET ON/OFF SWITCHES

 OOTABLE:	STRUE(LISTOO);
		STRUE(OBOO);
		GOTO	SONERR;
		SFALSE(LISTOO);
		SFALSE(OBOO);
		GOTO	SONERR;
		STRUE(LNOO);
		STRUE(ACOO);
		GOTO	SONERR;
		SFALSE(LNOO);
		SFALSE(ACOO);
		GOTO	SONERR;
ENDD; OF MODULE MSTM

LIT
END