.CONDITIONAL .PROCEDURE DIGIT;
.BEGIN
.WHEN BS -
ZEROSYMBOL .GEZ .THEN
.WHEN @ - 10
.LZ .THEN .EXITTRUE;
.END;
.PROCEDURE ENTER;
.INTEGER BACKPOINTER;
.BEGIN %
LDA,*-1;
BACKPOINTER := @ - 2;
STACK(*
BACKPOINTER);
.END;
.PROCEDURE WORKAREA;
.BEGIN
.IF WORKING <
MAXWORK .THEN
.BEGIN
MAXWORK :=
WORKING;
VADD := '1777;
WORKSPACE[
WORKING] :=
LA;
.END .ELSE
.BEGIN
VADD :=
WORKSPACE[
WORKING] + '1000;
WORKSPACE[#] :=
LA;
.END;
.END;
.PROCEDURE EXPRESSION;
.ARRAY SYMMETRIC[-5]('14000,'34000,'6000,'12000,'22000);
.BEGIN ENTER;
TERM;
MOREBINORSHIFT:
.IF BSIS(
BINARY)
.THEN
.BEGIN
NBS;
.WHEN LETTER .THEN
.BEGIN IDENTIFIER;
ID := -1;
.WHEN TYPE .AND '177770 = '10
.THEN
.BEGIN STACK(
ADDBS);
.GOTO NASTY;
.END;
EASY:
CELL;
GENMACRO;
.GOTO MOREBINORSHIFT;
.END;
STACK(
ADDBS);
.FOR # :=
WAYS OF BEGINNING .DO
.WHEN BASIC(
TERMTYPES[#])
.THEN .GOTO NASTY;
.WHEN BSIS(
UNARY)
.THEN .GOTO NASTY;
UNSTACK;
.GOTO EASY;
NASTY:
WORKFLAG,
WORKING :=
WORKING - 1;
GENVADDINST(
STA);
TERM;
ADDBS :=
UNSTACK;
# :=
ADDBS; %
IRS,0;
@ :=
OPTABLE[#];
.FOR # := -5
.DO
.WHEN @ =
SYMMETRIC[#]
.THEN .GOTO NOSWOP;
WORKFLAG := -1;
GENVADDINST(
IMA);
NOSWOP:
WORKFLAG := -1;
GENMACRO;
%
IRS,
WORKING; %
NOP;
.GOTO MOREBINORSHIFT;
.END
.ELSE .WHEN BSIS(
SHIFT)
.THEN
.BEGIN NBS;
CONSTANT;
VALUE :=
.NEG VALUE .AND '77;
INDEX :=
.INC ADDBS;
GENERATE (
OPTABLE[#] +
VALUE );
.GOTO MOREBINORSHIFT;
.END;
LEAVE;
.END;
@
.PROCEDURE FAIL;
.ARRAY FAILS[-3](
"ERROR ");
.INTEGER I;
.BEGIN
I := @;
NEWLINE;
.FOR # := -3
.DO
OUT2(
FAILS[#]);
OCTAL3(
I);
.WHEN I .LZ .THEN
.BEGIN
OUT1(
SPACE);
PRINTIDENT;
.END;
%
IRS,
ERRORS;
NEWLINE;
# :=
CYCLE;
.FOR I :=
CYCLESIZE .DO
.BEGIN
.WHEN TRACE[#]
.NZ .THEN OUT1(@);
.WHEN @ =
CRSYMBOL .THEN OUT1('212);
TRACE[#] :=
.Z;
%
IRS,0; %
SKP; %
LDX,
CYCLESIZE;
.END;
.WHEN INDEVICE .Z .THEN .GOTO ESCAPE;
.END;
@
.PROCEDURE FAILIFNOT;
.BEGIN .WHEN @
.NE BS .THEN FAIL(@);
NBS;
.END;
@
.PROCEDURE GENERATE;
.BEGIN
INST := @;
.IF LA > '777
.THEN FAIL(
OVERSECTOR)
.ELSE GENWORD(
INST);
.END;
@
.PROCEDURE GENWORD;
.BEGIN INST := @;
INDEX :=
LOCAL;
CODE[#] :=
INST;
.WHEN .SENSE2 .THEN
.BEGIN
NEWLINE;
OUTSIX(
LOCAL);
OUTSIX(
INST);
DAPPRINT(
INST);
.END;
%
IRS,
LA;
.END;
.PROCEDURE GENMACRO;
.INTEGER OPCOUNT,
TWORK,
TEMPCONST,
NOI;
.BEGIN
TEMPCONST :=
EXPLICITCONST;
TWORK :=
WORKFLAG;
.FOR NOI :=
.NEG .ICLEFT OPTABLE[
ADDBS]
.DO
.BEGIN
%
IRS,
ADDBS;
I :=
OPTABLE[
ADDBS];
ADD := @
.AND '777;
.IF @
.Z .THEN
.BEGIN
.WHEN I .SHSRL 10
.AND '17
.Z .THEN .GOTO SPECIAL;
.IF @
.NE '14
.THEN
.BEGIN WORKFLAG :=
TWORK;
GENVADDINST(
I);
EXPLICITCONST :=
TEMPCONST;
.END
.ELSE
SPECIAL:
GENERATE(
I);
.END
.ELSE GENERATE(
I);
.END;
EXPLICITCONST :=
.Z;
.END;
.PROCEDURE GETADD;
.BEGIN INDEX :=
.INC POS;
ADD :=
NAMELIST[#];
.END;
@
.PROCEDURE GETCODE;
.BEGIN
INDEX :=
.IF @
.GE '1000
.THEN
@
.AND '777 +
LSTART .ELSEACC;
@ :=
CODE[#];
.END;
@
.PROCEDURE GENVADDINST;
.INTEGER INST;
.BEGIN INST := @;
.IF WORKFLAG .LZ .THEN
.BEGIN
WORKFLAG :=
.Z;
WORKAREA;
GENERATE(
INST +
VADD);
.END .ELSE
.IF EXPLICITCONST .LZ .THEN
.BEGIN EXPLICITCONST :=
.Z;
MAKECONST;
GENERATE(
INST+
ADD);
.END
.ELSE GENERATE(
INST+
VADD)
.END;
.PROCEDURE GLOBCOLLAPSE;
.INTEGER I;
.BEGIN
.FOR I :=
DECPOINTER .DO
.BEGIN
LOCDP :=
I;
.WHEN .SENSE3 .THEN PRINTNAMELISTENTRY;
.WHEN NAMELIST[
I]
.LZ .THEN %
IRS,
I;
%
IRS,
I;
TYPE :=
NAMELIST[
I];
%
IRS,
I;
ADD :=
NAMELIST[
I];
.IF TYPE =
LABEL .THEN
.WHEN ADD .LZ .THEN FAIL (
GLNOTMET)
.ELSE .IF @ =
ARRAY .THEN
.WHEN GETCODE(
ADD)
.LZ .THEN FAIL(
FORDARRNOTMET)
.ELSE .WHEN @
.AND '10 = '10
.THEN
.WHEN GETCODE(
ADD)
.Z .THEN FAIL(
FORWPROCNOTMET);
.END;
LOCDP :=
DECPOINTER;
DECPOINTER :=
PERMANENTDECLARATIONS;
.END;
.PROCEDURE IDENTIFIER;
.BEGIN
ENTER;
.IF LETTER .THEN
.BEGIN
ALLOWSPACE := -1;
IDNBS;
LEVEL :=
CLEVEL;
TYPE :=
.Z;
.FOR # :=
DECPOINTER .DO
.BEGIN
CHAR1 :=
INDEX;
.IF NAMELIST[#] =
IDENT1 .THEN
.IF @
.GEZ .THEN .GOTO FOUND
.ELSE
.BEGIN %
IRS,0;
.WHEN NAMELIST[#] =
IDENT2 .THEN .GOTO FOUND;
.END
.ELSE .WHEN @
.LZ .THEN %
IRS,0;
%
IRS,0;
.WHEN @
.Z .THEN LEVEL :=
NAMELIST[#];
%
IRS,0;
.END;
.GOTO EXIT;
FOUND: %
IRS,0; %
STX,
POS;
TYPE :=
NAMELIST[#];
%
IRS,0;
ADD :=
NAMELIST[#];
.END .ELSE FAIL(
NOTALETTER);
EXIT:
LEAVE;
.END;
.PROCEDURE IFSTATEMENT;
.BEGIN
ENTER;
INVERT :=
.Z;
NBS;
STACK(
STMARK);
CONDITION;
STMARK :=
UNSTACK;
STACK(
FJADD);
FAILIFNOT(
THENSYMBOL);
STACK(
STMARK);
.IF STMARK .LZ .THEN STATEMENT
.ELSE EXPRESSION;
STMARK :=
UNSTACK;
.WHEN BASIC(
ELSEACCSYMBOL)
.AND STMARK .Z .THEN
.BEGIN
PLUGJUMP(
LA);
NBS;
.GOTO OUTIF;
.END;
%
IRS,
LA;
PLUGJUMP(
LA);
FAILIFNOT(
ELSESYMBOL);
STACK(
LA - 1);
.IF STMARK .LZ .THEN STATEMENT
.ELSE EXPRESSION;
PLUGJUMP(
LA);
OUTIF:
LEAVE;
.END;
.NEXTSECTOR;
&*********************************************************
.PROCEDURE COMPSTATEMENT;
.BEGIN
ENTER;
FAILIFNOT(
BEGINSYMBOL);
AGAIN :
STATEMENT;
.WHEN BASIC(
SEMICOLONSYMBOL)
.THEN
.BEGIN
NBS;
.GOTO AGAIN;
.END;
FAILIFNOT(
ENDSYMBOL);
LEAVE;
.END;
.PROCEDURE ADEBUG;
.INTEGER A,
B,
C,
XX;
.BEGIN
A := @;
%
IAB;
B := @;
C :=
.ADDC .Z;
%
STX,
XX;
NEWLINE;
OUTSIX(
A);
@ :=
B; %
IAB;
@ :=
C .SHSRL 1;
# :=
XX;
@ :=
A;
.END;