Trailing-Edge
-
PDP-10 Archives
-
ALGOL-20_1-29-82
-
algol-sources/algstm.mac
There are 8 other files named algstm.mac in the archive. Click here to see a list.
;
;
;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