.PROCEDURE ASSIGNMENTSTATEMENT;
.INTEGER LHSCOUNT,
MARKER,
I,
K,
INSTRUCTION;
& THIS DOES BOTH ASSIGNMENTS AND EXCHANGES, THE LOCAL
& PROCEDURES 'GENCHECK' AND 'DOLHS' GENERATE CODE WHICH MAY
& BE MODIFIED BY THE SETTING OF THE MARKER THUS:
& -1 GENERATE LDA FOR STA.
& 0 SUPPRESS ALL LDX AND STX
& >0 NORMAL CODE GENERATION
& LHSCOUNT MUST BE 0 OR 1 FOR AN EXCHANGE TO BE VALID
@
.PROCEDURE GENCHECK;
.BEGIN
INSTRUCTION := @;
.IF @
.AND '36000 =
STA .THEN
.WHEN MARKER .LZ .THEN INSTRUCTION :=
INSTRUCTION - '4000
.ELSE .WHEN @ = '32000
.AND MARKER .Z .THEN .EXIT;
GENERATE(
INSTRUCTION);
.END;
@
.PROCEDURE DOLHS;
.BEGIN
MARKER := @;
LHSCOUNT :=
LHSPT - 1;
.FOR I :=
LHSINDEX .TO LHSCOUNT .DO
.BEGIN
.IF LHSINST[
I]
.Z .THEN
.BEGIN
%
IRS,
I;
K :=
LHSINST[
I];
%
IRS,
I;
VALUE :=
LHSINST[
I];
.WHEN MARKER .NZ .THEN
.BEGIN
MAKECONST;
GENERATE(
K +
ADD);
.END;
.END .ELSE GENCHECK(@);
.END;
.END;
.BEGIN
STATELHS := -1;
LHSCOUNT :=
.Z;
LHSPT :=
LHSINDEX;
MORELHS:
LHS;
.WHEN BSCOMMA .THEN
.BEGIN
%
IRS,
LHSCOUNT;
NBS;
.GOTO MORELHS;
.END;
FAILIFNOT(
BECOMES SYMBOL);
STATELHS :=
.Z;
.IF BASIC(
COLON SYMBOL)
.THEN & THE EXCHANGE :=:
.BEGIN
.WHEN LHSCOUNT .NZ .THEN FAIL(
BADEXCHANGE);
DOLHS(-1);
NBS;
LHSCOUNT :=
.INC LA;
CELL;
GENVADDINST(
IMA);
DOLHS(
LA -
LHSCOUNT);
.END .ELSE
.BEGIN
EXPRESSION;
DOLHS(1);
.END;
.END;
.PROCEDURE CELL;
.SWITCH STYPE =
LNOTDEC,
LCONST,
LCONST,
LARRAY,
LCOMPCONST,
LARRAY,
LLABEL,
LTABLE;
.BEGIN
ENTER;
.WHEN ID .LZ .THEN .GOTO OK;
.IF LETTER .THEN
.BEGIN IDENTIFIER;
OK:
INDEX :=
TYPE - 8;
.WHEN @
.LZ .THEN .GOTO STYPE[#];
FAIL(
CELLTYPE);
.GOTO FIN;
LNOTDEC:
FAIL(
IDNOTDEC);
.GOTO FIN;
LCONST:
VADD :=
ADD;
.GOTO FIN;
LARRAY: @ :=
ADD;
.GOTO ARRTAB;
LTABLE: @ :=
.INC ADD;
ARRTAB:
STACK(
.SSM @);
SUBSCRIPT;
VADD :=
UNSTACK;
.GOTO FIN;
LCOMPCONST:
VALUE :=
ADD;
EXPLICITCONST := -1;
.GOTO FIN;
LLABEL:
FAIL(
RHSLABEL);
FIN:
ID :=
.Z;
.END
.ELSE .IF BASIC(
STARSYMBOL)
.THEN
.BEGIN NBS;
IDENTIFIER;
.WHEN TYPE .NE INT .THEN FAIL (
PTRNOTINT);
VADD :=
ADD + '100000;
.END
.ELSE .IF BASIC(
CODEWORDSYMBOL)
.THEN
.BEGIN
NBS;
TYPEIDENT;
VADD :=
ADD;
.END
.ELSE
.BEGIN CONSTANT;
EXPLICITCONST := -1;
.END;
LEAVE;
.END;
.PROCEDURE CODESTATEMENT;
.BEGIN NBS;
.IF LETTER .THEN
.BEGIN IDNBS;
.WHEN IDENT2 .Z .THEN
.FOR # :=
MCODESIZE .DO
.IF MCODE[#] =
IDENT1 .THEN .GOTO FOUND
.ELSE %
IRS,0;
FAIL(
INVMCODE);
FOUND: %
IRS,0;
INST :=
MCODE[#];
J := @
.SHDRL 14;
.IF .Z .SHDLL 4
.Z .THEN
.IF J .NE 1
.THEN GENERATE(
INST)
.ELSE
.BEGIN FAILIFNOT(
COMMASYMBOL);
CONSTANT;
GENERATE(
.NEG VALUE .AND '77 +
INST);
.END
.ELSE .IF @ - '14
.Z .THEN
.BEGIN FAILIFNOT(
COMMASYMBOL);
CONSTANT;
GENERATE(
INST +
VALUE);
.END
.ELSE
.BEGIN
.IF BASIC(
STARSYMBOL)
.THEN
.BEGIN NBS;
I := '100000;
.END .ELSE I :=
.Z;
.WHEN BASIC(
COLONSYMBOL)
.THEN
.BEGIN I :=
I + '40000;
NBS;
.END;
.WHEN I .Z .THEN FAILIFNOT(
COMMASYMBOL);
INST :=
INST +
I;
.IF BASIC(
STARSYMBOL)
.THEN
.BEGIN NBS;
.WHEN BASIC(
PLUSSYMBOL)
.THEN NBS;
NUMBER;
GENERATE(
INST +
LA + '1000 +
VALUE);
.END .ELSE
.IF NUMERICAL .THEN
.BEGIN NUMBER;
GENERATE(
INST+
VALUE);
.END .ELSE
.BEGIN TYPEIDENT;
GENERATE(
INST +
ADD);
.END;
.END
.END
.ELSE .IF NUMERICAL .THEN
.BEGIN
NUMBER;
GENERATE(
VALUE);
.END
.ELSE FAIL(
INVMCODE);
.END;
.PROCEDURE CLEARWORKSPACE;
.BEGIN
.WHEN MAXWORK .LZ .THEN
.FOR WORKING := @
.DO
.BEGIN BACKPLUG(
WORKSPACE[
WORKING]);
GENERATE(
.Z);
.END;
MAXWORK :=
.Z;
.END;
.PROCEDURE PRINTIDENT;
.BEGIN TAB := -7;
IDFLAG :=
.Z;
OUT3X(
NAMELIST[
LOCDP]);
.WHEN NAMELIST[
LOCDP]
.LZ .THEN
.BEGIN %
IRS,0;
OUT3X(
NAMELIST[#]);
.END;
LL:
OUT1(
SPACE); %
IRS,
TAB;
.GOTO LL;
.END;
.NEXTSECTOR;
&*********************************************************
.PROCEDURE SETKWITHPROCTYPE;
.BEGIN
K := 8;
.WHEN BASIC(
ACSYMBOL)
.THEN
.BEGIN %
IRS,
K;
NBS;
.END;
.WHEN BASIC(
CONDSYMBOL)
.THEN
.BEGIN %
IRS,
K; %
IRS,
K;
NBS;
.END;
FAILIFNOT(
PROCSYMBOL);
.END;
.PROCEDURE CONDITION;
.PROCEDURE CONSIMPLE;
.SWITCH REL =
LE,
LT,
GE,
GT,
NE,
EQ,
GT,
GE,
LT,
LE,
EQ,
NE;
.INTEGER TLA,
RELOPCASE;
.BEGIN
ENTER;
.IF BSIS(
COND)
.THEN
.BEGIN NBS;
INDEX :=
.INC ADDBS;
GENERATE(
OPTABLE[#]
.NEV INVERT);
SETFJADD;
.END
.ELSE .IF LETTER .THEN
.BEGIN IDENTIFIER;
.IF TYPE .AND '177776 = '12
.THEN
.BEGIN
PROCCALL;
.WHEN INVERT .NZ .THEN GENERATE(
SKP);
SETFJADD;
.END .ELSE
.BEGIN ID := -1;
.GOTO EXPR;
.END;
.END .ELSE
.BEGIN
EXPR:
STACK(
INVERT);
EXPRESSION;
INVERT :=
UNSTACK;
.IF BSIS(
ACCOND)
.THEN
.BEGIN NBS;
INDEX :=
.INC ADDBS;
GENERATE(
OPTABLE[#]
.NEV INVERT);
SETFJADD;
.END .ELSE
.IF BSIS(
RELOP)
.THEN
.BEGIN INDEX :=
.INC ADDBS;
RELOPCASE :=
OPTABLE[#];
NBS;
CELL;
GENVADDINST(
CAS);
.WHEN INVERT .NZ .THEN
RELOPCASE :=
RELOPCASE - 6;
.GOTO REL[
RELOPCASE];
GT:
GENERATE(
JMPSO +
LA + 3);
LT:
GENERATE(
NOP);
.GOTO SETF;
GE:
GENERATE(
NOP);
NE:
GENERATE(
SKP);
SETF:
SETFJADD;
.GOTO EXIT;
EQ:
GENERATE(
SKP);
.GOTO NE;
LE:
SETFJADD;
GENERATE(
NOP);
EXIT:
.END .ELSE .IF BASIC(
RANGESYMBOL)
.THEN
.BEGIN
NBS;
CELL;
GENVADDINST(
CAS);
GENERATE(
NOP);
TLA :=
LA;
FAILIFNOT(
TOSYMBOL);
CELL;
.WHEN TLA -
LA .NZ .THEN FAIL(
BADRANGE);
GENVADDINST(
CAS);
SETFJADD;
GENERATE(
NOP);
.WHEN INVERT .NZ .THEN
.BEGIN
STACK(
FJADD);
PLUGJUMP(
.INC LA);
SETFJADD;
.END
.END
.ELSE FAIL(
FCONDITION);
.END;
LEAVE;
.END;
.BEGIN
ENTER;
CONSIMPLE;
ANOTHER:
.WHEN BASIC(
ANDSYMBOL)
.THEN
.BEGIN
.WHEN INVERT .NZ .THEN .GOTO ORDEMORGAN;
ANDDEMORGAN:
STACK(
FJADD);
NBS;
CONSIMPLE;
PLUGJUMP(
FJADD);
.GOTO ANOTHER;
.END;
.WHEN BASIC(
ORSYMBOL)
.THEN
.BEGIN
.WHEN INVERT .NZ .THEN .GOTO ANDDEMORGAN;
ORDEMORGAN:
STACK(
LA);
%
IRS,
LA;
INDEX :=
FJADD +
LSTART;
CODE[#] :=
JMPSO +
LA;
NBS;
CONSIMPLE;
PLUGJUMP(
LA);
.GOTO ANOTHER;
.END;
LEAVE;
.END;