begin;
comment ALGOL 60 - version of the ALGOL 60 - translator
for the EL - X8, F.E.J. Kruseman Aretz
;
comment basic symbols
;
integer PLUS, MINUS, MUL, DIV, IDI, TTP, EQU, UQU, LES, MST, MOR, LST, NON, QVL, IMP, OR, AND, GOTO, FOR, STEP, UNTIL, WHILE, DO, COMMA, PERIOD, TEN, COLON, SEMICOLON, COLONEQUAL, SPACE SBL, IF, THEN, ELSE, COMMENT, OPEN, CLOSE, SUB, BUS, QUOTE, UNQUOTE, BEGIN, END, OWN, REA, INTEG, BOOLE, STRI, ARRAY, PROCED, SWITCH, LABEL, VALUE, TRUE, FALSE, NEW LINE, UNDERLINING, BAR;
comment other global integers
;
integer CASE, LOWER CASE, STOCK, STOCKL, LAST SYMBOL, LINE COUNTER, LAST IDENTIFIER, LAST IDENTIFIERL, QUOTE COUNTER, RUN NUMBER, SHIFT, TYPE, CHARA, CHARACTER, VALUE CHARACTER, ARR DECLS MACRO, VALUE OF CONSTANT, DECIMAL EXPONENT, DECIMAL COUNT, WORD COUNT, NLP, LAST NLP, N, INTEGER LABEL, BLOCK CELL POINTER, NEXT BLOCK CELL POINTER, DIMENSION, FORCOUNT, INSTRUCT COUNTER, DP0, FUNCTION LETTER, FUNCTION DIGIT, C VARIANT, NL BASE, PROG BASE, TEXT BASE, TEXT POINTER, END OF TEXT, END OF MEMORY, START, END OF LIST, D0, D1, D2, D3, D4, D5, D6, D7, D8, D9, D10, D11, D12, D13, D14, D15, D16, D17, D18, D19, D20, D21, D22, D23, D24, D25, RE, IN, BO, ST, AR, NONDES, DES, UN, ARBO, INTLAB;
comment macro identifiers
;
integer STACK, NEG, ADD, SUB, MUL, DIV, IDI, TTP, EQU, UQU, LES, MST, MOR, LST, STAB, NON, QVL, IMP, OR, AND, STAA, TSR, TSI, TSB, TSST, TFSU, TSL, TFSL, TCST, STSR, STSI, SSTSI, STSB, STSST, STFSU, ENTRIS, TFD, SAS, DECS, FAD, TASR, TASI, TASB, TASST, TASU, EXITIS, FADCV, TRSCV, TISCV, TSCVU, EXIT, TEST1, TEST2, CRV, CIV, CBV, CSTV, CLV, CEN, CLPN, TAV, TIAV, RAD, IAD, BAD, STAD, ORAD, OIAD, OBAD, OSTAD, LOS, EXITP, EXITPC, REJST, JUA, EMPTY, ABS, SIGN, ENTIER, SQRT, EXP, LN, END;
comment macro2 identifiers
;
integer TRV, TIV, TRC, TIC, TSIC, TBV, TBC, TSTV, TLV, TAK, TSWE, STR, STI, SSTI, STB, STST, DOS, DOS2, DDS3, JU, JU1, LJU, LJU1, COJU, YCOJU, SUBJ, ISUBJ, DECB, DO, TBL, ENTRB, DPTR, INCRB, TDL, ENTRPB, NIL, LAST, LAD, TDA, TNA, TAA, SWP, EXITB, EXITC, EXITSV, CODE, SLNC, RLNC, LNC;
comment global Booleans
;
Boolean LETTER LAST SYMBOL, DIGIT LAST SYMBOL, ARR DECLARATOR LAST SYMBOL, TYPE DECLARATOR LAST SYMBOL, IN ARRAY DECLARATION, IN FORMAL LIST, TEXT IN MEMORY, OWN TYPE, INT LABELS, REAL NUMBER, SMALL, ERRONEOUS, DERRONEOUS, WANTED;
comment global arrays
;
integer array INTERNAL REPRESENTATION[0 : 127], WORD DELIMITER[0 : 23], MACRO LIST[0 : 511], TABEL[5 : 59], INSTRUCT LIST[0 : 203], MASK[0 : 9];
comment start of initialization
;
PLUS := READ;
MINUS := READ;
MUL := READ;
DIV := READ;
IDI := READ;
TTP := READ;
EQU := READ;
UQU := READ;
LES := READ;
MST := READ;
MOR := READ;
LST := READ;
NON := READ;
QVL := READ;
IMP := READ;
OR := READ;
AND := READ;
GOTO := READ;
FOR := READ;
STEP := READ;
UNTIL := READ;
WHILE := READ;
DO := READ;
COMMA := READ;
PERIOD := READ;
TEN := READ;
COLON := READ;
SEMICOLON := READ;
COLONEQUAL := READ;
SPACE SBL := READ;
IF := READ;
THEN := READ;
ELSE := READ;
COMMENT := READ;
OPEN := READ;
CLOSE := READ;
SUB := READ;
BUS := READ;
QUOTE := READ;
UNQUOTE := READ;
BEGIN := READ;
END := READ;
OWN := READ;
REA := READ;
INTEG := READ;
BOOLE := READ;
STRI := READ;
ARRAY := READ;
PROCED := READ;
SWITCH := READ;
LABEL := READ;
VALUE := READ;
TRUE := READ;
FALSE := READ;
NEW LINE := READ;
UNDERLINING := READ;
BAR := READ;
LOWER CASE := READ;
STACK := READ;
NEG := READ;
ADD := READ;
SUB := READ;
MUL := READ;
DIV := READ;
IDI := READ;
TTP := READ;
EQU := READ;
UQU := READ;
LES := READ;
MST := READ;
MOR := READ;
LST := READ;
STAB := READ;
NON := READ;
QVL := READ;
IMP := READ;
OR := READ;
AND := READ;
STAA := READ;
TSR := READ;
TSI := READ;
TSB := READ;
TSST := READ;
TFSU := READ;
TSL := READ;
TFSL := READ;
TCST := READ;
STSR := READ;
STSI := READ;
SSTSI := READ;
STSB := READ;
STSST := READ;
STFSU := READ;
ENTRIS := READ;
TFD := READ;
SAS := READ;
DECS := READ;
FAD := READ;
TASR := READ;
TASI := READ;
TASB := READ;
TASST := READ;
TASU := READ;
EXITIS := READ;
FADCV := READ;
TRSCV := READ;
TISCV := READ;
TSCVU := READ;
EXIT := READ;
TEST1 := READ;
TEST2 := READ;
CRV := READ;
CIV := READ;
CBV := READ;
CSTV := READ;
CLV := READ;
CEN := READ;
CLPN := READ;
TAV := READ;
TIAV := READ;
RAD := READ;
IAD := READ;
BAD := READ;
STAD := READ;
ORAD := READ;
OIAD := READ;
OBAD := READ;
OSTAD := READ;
LOS := READ;
EXITP := READ;
EXITPC := READ;
REJST := READ;
JUA := READ;
EMPTY := READ;
ABS := READ;
SIGN := READ;
ENTIER := READ;
SQRT := READ;
EXP := READ;
LN := READ;
END := READ;
TRV := READ;
TIV := READ;
TRC := READ;
TIC := READ;
TSIC := READ;
TBV := READ;
TBC := READ;
TSTV := READ;
TLV := READ;
TAK := READ;
TSWE := READ;
STR := READ;
STI := READ;
SSTI := READ;
STB := READ;
STST := READ;
DOS := READ;
DOS2 := READ;
DOS3 := READ;
JU := READ;
JU1 := READ;
IJU := READ;
IJU1 := READ;
COJU := READ;
YCOJU := READ;
SUBJ := READ;
ISUBJ := READ;
DECB := READ;
DO := READ;
TBL := READ;
ENTRB := READ;
DPTR := READ;
INCRB := READ;
TDL := READ;
ENTRPB := READ;
NIL := READ;
LAST := READ;
LAD := READ;
TDA := READ;
TNA := READ;
TAA := READ;
SWP := READ;
EXITB := READ;
EXITC := READ;
EXITSV := READ;
CODE := READ;
SLNC := READ;
RLNC := READ;
LNC := READ;
D0 := 1;
D1 := 2;
D2 := 4;
D3 := 8;
D4 := 16;
D5 := 32;
D6 := 64;
D7 := 128;
D8 := 256;
D9 := 512;
D10 := 1024;
D11 := 2048;
D12 := 4096;
D13 := 8192;
D14 := 16384;
D15 := 32768;
D16 := 65536;
D17 := 131072;
D18 := 262144;
D19 := 524288;
D20 := 1048576;
D21 := 2097152;
D22 := 4194304;
D23 := 8388608;
D24 := 16777216;
D25 := 33554432;
RE := 0;
IN := 1;
BO := 2;
ST := 3;
AR := 4;
NONDES := 5;
DES := 6;
UN := 7;
ARBO := 8;
INTLAB := 9;
FUNCTION LETTER := READ;
FUNCTION DIGIT := READ;
C VARIANT := READ;
for N := 0 step 1 until 127 do
INTERNAL REPRESENTATION[N] := READ;
for N := 0 step 1 until 23 do
WORD DELIMITER[N] := READ;
for N := 0 step 1 until 511 do
MACRO LIST[N] := READ;
for N := 5 step 1 until 59 do
TABEL[N] := READ;
for N := 0 step 1 until 203 do
INSTRUCT LIST[N] := READ;
for N := 0 step 1 until 9 do
MASK[N] := D20 × READ;
END OF MEMORY := READ;
END OF LIST := INSTRUCT LIST[174];
TEXT IN MEMORY := TRUE;
ERRONEOUS := DERRONEOUS := FALSE;
WANTED := READ = 0;
begin;
integer array SPACE[0 : END OF MEMORY];
procedure ERRORMESSAGE(N);
integer N;
begin;
integer I;
ERRONEOUS := TRUE;
if N = 122 ∨ N = 123 ∨ N = 126 ∨ N = 127 ∨ N = 129 then DERRONEOUS := TRUE;
if N ≥ RUN NUMBER then begin;
NLCR;
PRINTTEXT(`er');
PRINT(N);
PRINT(LINE COUNTER);
PRINT(LAST SYMBOL);
for I := 0 step 1 until WORD COUNT do
PRINT(SPACE[NL BASE - LAST NLP - I]);
end;
end ERRORMESSAGE;
integer procedure NEXT SYMBOL;
begin;
integer SYMBOL;
NEXT0: SYMBOL := if STOCK1 ≥ 0 then STOCK1 else NEXT BASIC SYMBOL;
STOCK1 := -1;
if (LAST SYMBOL = SEMICOLON ∨ LAST SYMBOL = BEGIN) ∧ SYMBOL = COMMENT then begin;
SKIP0: SYMBOL := NEXT BASIC SYMBOL;
if SYMBOL ≠ SEMICOLON then goto SKIP0;
goto NEXT0;
;
end;
if LAST SYMBOL = END then begin;
SKIP1: if SYMBOL ≠ END ∧ SYMBOL ≠ SEMICOLON ∧ SYMBOL ≠ ELSE then begin;
SYMBOL := NEXT BASIC SYMBOL;
goto SKIP1;
end;
end else if SYMBOL = 125 then begin;
STOCK1 := NEXT BASIC SYMBOL;
if STOCK1 > 9 ∧ STOCK1 < 64 then begin;
SKIP2: STOCK1 := NEXT BASIC SYMBOL;
if STOCK1 > 9 ∧ STOCK1 < 64 then goto SKIP2;
if STOCK1 = COLON then STOCK1 := NEXT BASIC SYMBOL else ERRORMESSAGE(100);
if STOCK1 = OPEN then STOCK1 := -STOCK1 else ERRORMESSAGE(101);
SYMBOL := COMMA;
end else SYMBOL := CLOSE;
end;
DIGIT LAST SYMBOL := SYMBOL < 10 ∨ SYMBOL = PERIOD ∨ SYMBOL = TEN;
LETTER LAST SYMBOL := SYMBOL < 64 ∧ ¬DIGIT LAST SYMBOL;
NEXT SYMBOL := LAST SYMBOL := SYMBOL;
OUTSYMBOL(RUN NUMBER, SYMBOL);
TEST POINTERS;
end next symbol;
integer procedure NEXT BASIC SYMBOL;
begin;
integer SYMBOL;
NEXT0: INSYMBOL(RUN NUMBER, SYMBOL);
if SYMBOL = NEW LINE then begin;
LINE COUNTER := LINE COUNTER + 1;
if QUOTE COUNTER = 0 then begin;
OUTSYMBOL(RUN NUMBER, SYMBOL);
goto NEXT0;
end;
end;
NEXT BASIC SYMBOL := SYMBOL;
end next basic symbol;
procedure INSYMBOL(SOURCE, DESTINATION);
integer SOURCE, DESTINATION;
begin;
integer SYMBOL, I;
if (SOURCE = 200 ∨ SOURCE = 300) ∧ TEXT IN MEMORY then begin;
DESTINATION := BIT STRING(D8 × SHIFT, SHIFT, SPACE[TEXT BASE + TEXT POINTER]);
if SHIFT < 257 then SHIFT := D8 × SHIFT else begin;
SHIFT := 1;
TEXT POINTER := TEXT POINTER + 1;
end;
end else begin;
SYMBOL := if STOCK > 0 then STOCK else NEXT TAPE SYMBOL;
STOCK := -1;
if SYMBOL > BUS then begin;
if SYMBOL = 123 then SYMBOL := SPACE SBL;
if QUOTE COUNTER > 0 then begin;
if SYMBOL = BAR then begin;
NEXT0: STOCK := NEXT TAPE SYMBOL;
if STOCK = BAR then goto NEXT0;
if STOCK = LES then QUOTE COUNTER := QUOTE COUNTER + 1 else if STOCK = MOR then begin;
if QUOTE COUNTER = 1 then begin;
SYMBOL := UNQUOTE;
STOCK := -SYMBOL;
end else QUOTE COUNTER := QUOTE COUNTER - 1;
end;
end else if SYMBOL = 124 then SYMBOL := COLON else if SYMBOL = 125 then SYMBOL := CLOSE;
end else if SYMBOL ≥ NEWLINE then begin;
if SYMBOL = BAR then begin;
NEXT1: SYMBOL := NEXT TAPE SYMBOL;
if SYMBOL = BAR then goto NEXT1;
SYMBOL := if SYMBOL = AND then TTP else if SYMBOL = EQU then UQU else if SYMBOL = LES then QUOTE else if SYMBOL = MOR then UNQUOTE else 160;
end else if SYMBOL = UNDERLINING then begin;
SYMBOL := THE UNDERLINED SYMBOL;
if SYMBOL > 63 then SYMBOL := if SYMBOL = 124 then IDI else if SYMBOL = LES then MST else if SYMBOL = MOR then LST else if SYMBOL = NON then IMP else if SYMBOL = EQU then QVL else 161 else begin;
STOCK := NEXT TAPE SYMBOL;
if STOCK = UNDERLINING then begin;
SYMBOL := THE UNDERLINED SYMBOL + D7 × SYMBOL;
for I := 0 step 1 until 23 do
begin;
if WORD DELIMITER[I] ÷ D7 = SYMBOL then begin;
SYMBOL := WORD DELIMITER[I];
SYMBOL := SYMBOL - SYMBOL ÷ D7 × D7;
goto NEXT2;
end;
end;
SYMBOL := 162;
NEXT2: STOCK := NEXT TAPE SYMBOL;
if STOCK = UNDERLINING then begin;
THE UNDERLINED SYMBOL;
goto NEXT2;
end;
end else SYMBOL := 161;
end;
end else if SYMBOL = 124 then begin;
STOCK := NEXT TAPE SYMBOL;
if STOCK = EQU then begin;
SYMBOL := COLONEQUAL;
STOCK := -SYMBOL;
end else SYMBOL := COLON;
end;
end else INSYMBOL(RUNNUMBER, SYMBOL);
end;
DESTINATION := SYMBOL;
end;
end insymbol;
integer procedure THE UNDERLINED SYMBOL;
begin;
integer SYMBOL;
SYMBOL := NEXT TAPE SYMBOL;
THE UNDERLINED SYMBOL := if SYMBOL = UNDERLINING then THE UNDERLINED SYMBOL else SYMBOL;
end the underlined symbol;
integer procedure NEXT TAPE SYMBOL;
begin;
integer SYMBOL, HEAD;
SYMBOL := INTERNAL REPRESENTATION[REHEP];
if SYMBOL > 0 then begin;
HEAD := SYMBOL ÷ D8;
NEXT TAPE SYMBOL := ABS(if CASE = LOWER CASE then SYMBOL - D8 × HEAD else HEAD);
end else begin;
if SYMBOL < -2 then CASE := -SYMBOL else if SYMBOL = 0 then ERRORMESSAGE(102) else if SYMBOL = -1 then ERRORMESSAGE(103);
NEXT TAPE SYMBOL := NEXT TAPE SYMBOL;
end;
end next tape symbol;
procedure OUTSYMBOL(DESTINATION, SOURCE);
integer DESTINATION, SOURCE;
begin;
if DESTINATION = 100 ∧ TEXT IN MEMORY then begin;
SPACE[TEXT BASE + TEXT POINTER] := SPACE[TEXT BASE + TEXT POINTER] + SHIFT × SOURCE;
if SHIFT < 257 then SHIFT := D8 × SHIFT else begin;
SHIFT := 1;
TEXT POINTER := TEXT POINTER + 1;
SPACE[TEXT BASE + TEXT POINTER] := 0;
end;
end;
end outsymbol;
Boolean procedure ARITHOPERATOR LAST SYMBOL;
begin;
ARITHOPERATOR LAST SYMBOL := LAST SYMBOL = PLUS ∨ LAST SYMBOL = MINUS ∨ LAST SYMBOL = MUL ∨ LAST SYMBOL = DIV ∨ LAST SYMBOL = IDI ∨ LAST SYMBOL = TTP;
end arithoperator last symbol;
Boolean procedure RELATOPERATOR LAST SYMBOL;
begin;
RELATOPERATOR LAST SYMBOL := LAST SYMBOL = LES ∨ LAST SYMBOL = MST ∨ LAST SYMBOL = EQU ∨ LAST SYMBOL = LST ∨ LAST SYMBOL = MOR ∨ LAST SYMBOL = UQU;
end relatoperator last symbol;
Boolean procedure BOOLOPERATOR LAST SYMBOL;
begin;
BOOLOPERATOR LAST SYMBOL := LAST SYMBOL = QVL ∨ LAST SYMBOL = IMP ∨ LAST SYMBOL = OR ∨ LAST SYMBOL = AND;
end booloperator last symbol;
Boolean procedure DECLARATOR LAST SYMBOL;
begin;
OWN TYPE := LAST SYMBOL = OWN;
if OWN TYPE then NEXT SYMBOL;
TYPE := if LAST SYMBOL = REA then 0 else if LAST SYMBOL = INTEG then 1 else if LAST SYMBOL = BOOLE then 2 else if LAST SYMBOL = STRI then 3 else 1000;
if TYPE < 4 then NEXT SYMBOL else begin;
if OWN TYPE then ERRORMESSAGE(104);
if LAST SYMBOL = ARRAY then TYPE := 0;
end;
ARR DECLARATOR LAST SYMBOL := LAST SYMBOL = ARRAY;
if ARR DECLARATOR LAST SYMBOL ∧ RUN NUMBER = 300 then ARR DECLA MACRO := if OWN TYPE then (if TYPE = 0 then ORAD else if TYPE = 1 then OIAD else if TYPE = 2 then OBAD else 0 ≠ STAD) else (if TYPE = 0 then RAD else if TYPE = 1 then IAD else if TYPE = 2 then BAD else STAD);
CHARA := if ARR DECLARATOR LAST SYMBOL then 8 else if LAST SYMBOL = SWITCH then 14 else if LAST SYMBOL = PROCED then (if TYPE < 4 then 16 else 24) else TYPE;
TYPE DECLARATOR LAST SYMBOL := CHARA < 4;
if OWN TYPE ∧ CHARA > 8 then ERRORMESSAGE(105);
if TYPE < 4 ∧ LAST SYMBOL = SWITCH then ERRORMESSAGE(106);
if CHARA < 25 ∧ RUN NUMBER = 100 then CHARACTER := ((if TYPE DECLARATOR LAST SYMBOL then TYPE else if TYPE < 4 then TYPE + CHARA else CHARA) + (if OWN TYPE then 32 else 0)) × D19;
DECLARATOR LAST SYMBOL := CHARA < 25;
end declarator last symbol;
Boolean procedure SPECIFIER LAST SYMBOL;
begin;
TYPE := if LAST SYMBOL = REA then 0 else if LAST SYMBOL = INTEG then 1 else if LAST SYMBOL = BOOLE then 2 else if LAST SYMBOL = STRI then 3 else if LAST SYMBOL = ARRAY then 5 else 1000;
if TYPE < 4 then NEXT SYMBOL;
CHARA := if LAST SYMBOL = LABEL then 6 else if LAST SYMBOL = SWITCH then 14 else 1000;
if TYPE + CHARA < 1000 then ERRORMESSAGE(107);
CHARA := if LAST SYMBOL = ARRAY then 8 else if LAST SYMBOL = PROCED then (if TYPE < 4 then 16 else 24) else CHARA;
if CHARA < 25 then NEXT SYMBOL;
if CHARA + TYPE < 2000 ∧ RUN NUMBER = 100 then begin;
VALUE CHARACTER := (if CHARA > 8 then TYPE else if CHARA = 6 then 6 else if TYPE = 5 then 8 else TYPE + CHARA) + 64;
CHARACTER := ((if TYPE > 5 then CHARA else (if TYPE > 1 then TYPE else 4) + (if CHARA < 1000 then CHARA else 0)) + 96) × D19;
end;
SPECIFIER LAST SYMBOL := CHARA + TYPE < 2000;
end specifier last symbol;
Boolean procedure OPERATOR LAST SYMBOL;
begin;
OPERATOR LAST SYMBOL := ARITHOPERATOR LAST SYMBOL ∨ RELATOPERATOR LAST SYMBOL ∨ BOOLOPERATOR LAST SYMBOL;
end operator last symbol;
procedure UNSIGNED NUMBER;
begin;
integer SIGN OF EXPONENT;
if LAST SYMBOL < 10 then begin;
VALUE OF CONSTANT := UNSIGNED INTEGER(0);
REAL NUMBER := DIGIT LAST SYMBOL;
end else begin;
VALUE OF CONSTANT := if LAST SYMBOL = TEN then 1 else 0;
REAL NUMBER := TRUE;
end;
DECIMAL EXPONENT := 0;
if REAL NUMBER then begin;
NEXT0: if LAST SYMBOL < 10 then begin;
DECIMAL EXPONENT := DECIMAL EXPONENT + 1;
NEXT SYMBOL;
goto NEXT0;
end;
if LAST SYMBOL = PERIOD then begin;
NEXT SYMBOL;
VALUE OF CONSTANT := UNSIGNED INTEGER(VALUE OF CONSTANT);
DECIMAL EXPONENT := DECIMAL EXPONENT - DECIMAL COUNT;
NEXTL: if LAST SYMBOL < 10 then begin;
NEXT SYMBOL;
goto NEXT1;
end;
end;
if LAST SYMBOL = TEN then begin;
NEXT SYMBOL;
SIGN OF EXPONENT := 1;
if LAST SYMBOL = PLUS then NEXT SYMBOL else if LAST SYMBOL = MINUS then begin;
NEXT SYMBOL;
SIGN OF EXPONENT := -1;
end;
DECIMAL EXPONENT := DECIMAL EXPONENT + SIGN OF EXPONENT × UNSIGNED INTEGER(0);
if LAST SYMBOL < 10 then begin;
ERRORMESSAGE(108);
NEXT2: if NEXT SYMBOL < 9 then goto NEXT2;
end;
end;
end;
SMALL := VALUE OF CONSTANT < D15 ∧ ¬REAL NUMBER;
end unsigned number;
integer procedure UNSIGNED INTEGER(START);
integer START;
begin;
integer WORD;
WORD := START;
DECIMAL COUNT := 0;
if LAST SYMBOL > 9 then ERRORMESSAGE(109);
NEXT0: if LAST SYMBOL < 10 then begin;
if WORD < 6710886 ∨ (WORD = 6710886 ∧ LAST SYMBOL < 4) then begin;
WORD := 10 × WORD + LAST SYMBOL;
DECIMAL COUNT := DECIMAL COUNT + 1;
NEXT SYMBOL;
goto NEXT0;
end;
end;
UNSIGNED INTEGER := WORD;
end unsigned integer;
procedure READ IDENTIFIER;
begin;
integer WORD, COUNT;
WORD := COUNT := WORD COUNT := 0;
if LETTER LAST SYMBOL then begin;
NEXT0: if LAST SYMBOL < 64 then begin;
if COUNT = 4 then begin;
WORD COUNT := WORD COUNT + 1;
WORD := COUNT := 0;
end;
WORD := SPACE[NL BASE - NLP - WORD COUNT] := D6 × WORD - LAST SYMBOL - 1;
COUNT := COUNT + 1;
NEXT SYMBOL;
goto NEXT0;
end else begin;
LAST IDENTIFIER := SPACE[NL BASE - NLP];
LAST IDENTIFIER1 := if WORD COUNT = 0 then 0 else SPACE[NL BASE - NLP - 1];
end;
end else begin;
ERRORMESSAGE(110);
SPACE[NL BASE - NLP] := -1;
end;
SPACE[NL BASE - NLP - WORD COUNT - 1] := 127 × D19;
end read identifier;
integer procedure NEXT POINTER(N);
integer N;
begin;
integer WORD, POINTER;
POINTER := N;
NEXT0: WORD := -SPACE[NL BASE - POINTER];
if WORD ≤ 0 then begin;
POINTER := POINTER + 1;
goto NEXT0;
end;
if WORD ≥ D25 then begin;
POINTER := WORD - WORD ÷ D13 × D13;
goto NEXT0;
end;
NEXT POINTER := POINTER;
end next pointer;
integer procedure LOOK UP;
begin;
integer COUNT, POINTER;
POINTER := BLOCK CELL POINTER + (if IN FORMAL LIST ∨ IN ARRAY DECLARATION then 5 else 4);
NEXT0: POINTER := NEXT POINTER(POINTER);
for COUNT := 0 step 1 until WORD COUNT do
begin;
if SPACE[NL BASE - POINTER - COUNT] ≠ SPACE[NL BASE - LAST NLP - COUNT] then goto NEXT1;
end;
POINTER := POINTER + WORD COUNT + 1;
if SPACE[NL BASE - POINTER] < 0 then begin;
NEXT1: POINTER := POINTER + 1;
goto if SPACE[NL BASE - POINTER] < 0 then NEXT1 else NEXT0;
end;
LOOK UP := POINTER;
end look up;
Boolean procedure IN NAME LIST;
begin;
integer HEAD;
if REAL NUMBER ∨ ¬INT LABELS then IN NAME LIST := FALSE else begin;
HEAD := VALUE OF CONSTANT ÷ D18;
SPACE[NL BASE - NLP] := -D12 - HEAD;
SPACE[NL BASE - NLP - 1] := (HEAD - 1) × D18 - VALUE OF CONSTANT;
WORD COUNT := 1;
SPACE[NL BASE - NLP - 2] := 6 × D19;
LAST NLP := NLP;
INTEGER LABEL := LOOK UP;
IN NAME LIST := INTEGER LABEL < NLP;
end;
end in name list;
integer procedure NEXT IDENTIFIER(N);
integer N;
begin;
integer POINTER;
POINTER := NEXT POINTER(N) + 1;
NEXT0: if SPACE[NL BASE - POINTER] < 0 then begin;
POINTER := POINTER + 1;
goto NEXT0;
end;
NEXT IDENTIFIER := POINTER;
end next identifier;
procedure SKIP IDENTIFIER;
begin;
if LAST SYMBOL < 64 then begin;
NEXT SYMBOL;
SKIP IDENTIFIER;
end;
end skip identifier;
procedure SKIP TYPE DECLARATION;
begin;
if LETTER LAST SYMBOL then SKIP IDENTIFIER;
if LAST SYMBOL = COMMA then begin;
NEXT SYMBOL;
SKIP TYPE DECLARATION;
end;
end skip type declaration;
procedure SKIP VALUE LIST;
begin;
if LAST SYMBOL = VALUE then begin;
NEXT SYMBOL;
SKIP TYPE DECLARATION;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL;
end;
end skip value list;
procedure SKIP SPECIFICATION LIST;
begin;
if SPECIFIER LAST SYMBOL then begin;
SKIP TYPE DECLARATION;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL;
SKIP SPECIFICATION LIST;
end;
end skip specification list;
procedure SKIP STRING;
begin;
QUOTE COUNTER := 1;
NEXT0: if NEXT SYMBOL ≠ UNQUOTE then goto NEXT0;
QUOTE COUNTER := 0;
end skip string;
procedure SKIP REST OF STATEMENT(PR);
procedure PR;
begin;
if LAST SYMBOL = DO then begin;
NEXT SYMBOL;
PR;
end else if LAST SYMBOL = GOTO ∨ LAST SYMBOL = FOR ∨ LAST SYMBOL = BEGIN then PR;
if LAST SYMBOL = QUOTE then SKIP STRING;
if LAST SYMBOL ≠ SEMICOLON ∧ LAST SYMBOL ≠ END then begin;
NEXT SYMBOL;
SKIP REST OF STATEMENT(PR);
end;
end skip rest of statement;
integer procedure BIT STRING(KN, N, CODE WORD);
integer KN, N, CODE WORD;
begin;
integer K;
K := CODE WORD ÷ KN;
BIT STRING := (CODE WORD - K × KN) ÷ N;
end bit string;
integer procedure DISPLAY LEVEL;
begin;
DISPLAY LEVEL := BIT STRING(D6, D0, SPACE[NL BASE - BLOCK CELL POINTER - 1]);
end display level;
integer procedure TOP OF DISPLAY;
begin;
TOP OF DISPLAY := BIT STRING(D13, D6, SPACE[NL BASE - BLOCK CELL POINTER - 1]);
end top of display;
integer procedure LOCAL SPACE;
begin;
LOCAL SPACE := SPACE[NL BASE - BLOCK CELL POINTER - 1] ÷ D13;
end local space;
integer procedure PROC LEVEL;
begin;
PROC LEVEL := BIT STRING(D6, D0, SPACE[NL BASE - BLOCK CELL POINTER - 2]);
end proc level;
Boolean procedure USE OF COUNTER STACK;
begin;
USE OF COUNTER STACK := BIT STRING(D7, D6, SPACE[NL BASE - BLOCK CELL POINTER - 2]) = 1;
end use of counter stack;
integer procedure STATUS;
begin;
STATUS := SPACE[NL BASE - BLOCK CELL POINTER - 2] ÷ D13;
end status;
Boolean procedure IN CODE(N);
integer N;
begin;
IN CODE := BIT STRING(D25, D24, SPACE[NL BASE - N - 1]) = 1;
end in code;
integer procedure TYPE BITS(N);
integer N;
begin;
TYPE BITS := BIT STRING(D22, D19, SPACE[NL BASE - N]);
end type bits;
Boolean procedure LOCAL LABEL(N);
integer N;
begin;
LOCAL LABEL := NONFORMAL LABEL(N) ∧ BIT STRING(D6, D0, SPACE[NL BASE - CORRESPONDING BLOCK CELL POINTER(N) - 1]) = DISPLAY LEVEL;
end local label;
Boolean procedure NONFORMAL LABEL(N);
integer N;
begin;
NONFORMAL LABEL := SPACE[NL BASE - N] ÷ D19 = 6;
end nonformal label;
integer procedure CORRESPONDING BLOCK CELL POINTER(N);
integer N;
begin;
integer P;
P := BLOCK CELL POINTER;
NEXT0: if N < P ∨ (N > SPACE[NL BASE - P - 2] ÷ D13 ∧ P > 0) then begin;
P := SPACE[NL BASE - P] ÷ D13;
goto NEXT0;
end;
CORRESPONDING BLOCK CELL POINTER := P;
end corresponding block cell pointer;
procedure ENTRANCE BLOCK;
begin;
BLOCK CELL POINTER := NEXT BLOCK CELL POINTER;
NEXT BLOCK CELL POINTER := BIT STRING(D13, D0, SPACE[NL BASE - BLOCK CELL POINTER]);
end entrance block;
procedure EXIT BLOCK;
begin;
BLOCK CELL POINTER := SPACE[NL BASE - BLOCK CELL POINTER] ÷ D13;
end exit block;
procedure INIT;
begin;
STOCK := STOCK1 := LAST SYMBOL := WORD COUNT := -1;
SHIFT := 1;
LINE COUNTER := QUOTE COUNTER := FORCOUNT := 0;
IN FORMAL LIST := IN ARRAY DECLARATION := FALSE;
CASE := LOWER CASE;
TEXT POINTER := 0;
end init;
procedure TEST POINTERS;
begin;
integer FPROG, FNL, I, SHIFT;
if TEXT IN MEMORY then begin;
FPROG := TEXT BASE + (if RUNNUMBER = 300 then TEXT POINTER else 0) - INSTRUCT COUNTER;
FNL := N1 BASE - NLP - (TEXT BASE + (if RUNNUMBER = 100 then TEXT POINTER else END OF TEXT));
if FPROG + FNL < 40 then begin;
TEXT IN MEMORY := FALSE;
TEST POINTERS;
end else if FPROG < 20 then begin;
SHIFT := (FNL - FPROG) ÷ 2;
for I := TEXT BASE + TEXT POINTER step -1 until TEXT BASE do
SPACE[I + SHIFT] := SPACE[I];
TEXT BASE := TEXT BASE + SHIFT;
end else if FNL < 20 then begin;
SHIFT := (FPROG - FNL) ÷ 2;
for I := TEXT BASE step 1 until TEXT BASE + TEXT POINTER do
SPACE[I] := SPACE[I + SHIFT];
TEXT BASE := TEXT BASE - SHIFT;
end;
end else if NL BASE - NLP - INSTRUCT COUNTER < 20 then begin;
ERRORMESSAGE(492);
goto ENDRUN;
end;
end test pointers;
procedure PRESCAN0;
begin;
integer OLD BLOCK CELL POINTER, DISPL LEVEL, PRC LEVEL, GLOBAL COUNT, LOCAL COUNT, LABEL COUNT, LOCAL FOR COUNT, MAX FOR COUNT, INTERNAL BLOCK DEPTH, STRING OCCURRENCE, SUBCOUNT, ARRAY POINTER;
procedure PROGRAM;
begin;
integer N;
CHARACTER := 6 × D19;
if LETTER LAST SYMBOL then begin;
READ IDENTIFIER;
if LAST SYMBOL = COLON then begin;
N := PROCESS IDENTIFIER;
LABEL DECLARATION(N);
end else ERRORMESSAGE(111);
PROGRAM;
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if LAST SYMBOL = COLON then INT LAB DECLARATION else ERRORMESSAGE(112);
PROGRAM;
;
end else if LAST SYMBOL = BEGIN then BEGIN STATEMENT else begin;
ERRORMESSAGE(113);
NEXT SYMBOL;
PROGRAM;
end;
end Program;
integer procedure BLOCK(PROC IDENTIFIER);
integer PROC IDENTIFIER;
begin;
integer DUMP1, DUMP2, DUMP3, DUMP4, DUMP5, DUMP6, DUMP7, DUMP8, N, FORMAL COUNT;
DUMP1 := BLOCK CELL POINTER;
DUMP2 := LOCAL FOR COUNT;
DUMP3 := MAX FOR COUNT;
DUMP4 := LOCAL COUNT;
DUMP5 := LABEL COUNT;
DUMP6 := INTERNAL BLOCK DEPTH;
DUMP7 := STRING OCCURRENCE;
DUMP8 := PRC LEVEL;
LOCAL FOR COUNT := MAX FOR COUNT := LOCAL COUNT := LABEL COUNT := INTERNAL BLOCK DEPTH := STRING OCCURRENCE := 0;
BLOCK CELL POINTER := NLP + 1;
SPACE[NL BASE - OLD BLOCK CELL POINTER] := SPACE[NL BASE - OLD BLOCK CELL POINTER] + BLOCK CELL POINTER;
OLD BLOCK CELL POINTER := BLOCK CELL POINTER;
SPACE[NL BASE - BLOCK CELL POINTER] := DUMP1 × D13;
SPACE[NL BASE - BLOCK CELL POINTER - 1] := DISPL LEVEL := DISPL LEVEL + 1;
SPACE[NL BASE - BLOCK CELL POINTER - 3] := 0;
NLP := NLP + 6;
if PROC IDENTIFIER > 0 then begin;
PRC LEVEL := DISPL LEVEL;
FORMAL COUNT := 0;
SPACE[NL BASE - BLOCK CELL POINTER - 4] := -D25 - NLP;
if LAST SYMBOL = OPEN then begin;
CHARACTER := 127 × D19;
NEXT0: NEXT SYMBOL;
IDENTIFIER;
SPACE[NL BASE - NLP] := 0;
NLP := NLP + 1;
FORMAL COUNT := FORMAL COUNT + 1;
if LAST SYMBOL = COMMA then goto NEXT0;
if LAST SYMBOL = CLOSE then NEXT SYMBOL else ERRORMESSAGE(114);
end;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL else ERRORMESSAGE(115);
SPACE[NL BASE - PROC IDENTIFIER - 1] := D22 + FORMAL COUNT + 1;
if LAST SYMBOL = VALUE then begin;
NEXT1: NEXT SYMBOL;
N := IDENTIFIER;
if N > LAST NLP then ERRORMESSAGE(116) else SPACE[NL BASE - N] := 95 × D19;
NLP := LAST NLP;
if LAST SYMBOL = COMMA then goto NEXT1;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL else ERRORMESSAGE(117);
end;
NEXT2: if SPECIFIER LAST SYMBOL then begin;
NEXT3: N := IDENTIFIER;
if N > LAST NLP then ERRORMESSAGE(118) else if SPACE[NL BASE - N] = 127 × D19 then SPACE[NL BASE - N] := CHARACTER else if SPACE[NL BASE - N] ≠ 95 × D19 then ERRORMESSAGE(119) else if VALUE CHARACTER > 75 then ERRORMESSAGE(120) else begin;
SPACE[NL BASE - N] := VALUE CHARACTER × D19;
if TYPE = 3 then STRING OCCURRENCE := D6;
end;
NLP := LAST NLP;
if LAST SYMBOL = COMMA then begin;
NEXT SYMBOL;
goto NEXT3;
end;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL else ERRORMESSAGE(121);
goto NEXT2;
end;
SPACE[NL BASE - NLP] := -D25 - 4 - DUMP1;
NLP := NLP + 1;
SPACE[NL BASE - BLOCK CELL POINTER - 4] := -D25 - NLP;
if LAST SYMBOL = QUOTE then begin;
SPACE[NL BASE - PROC IDENTIFIER - 1] := SPACE[NL BASE - PROC IDENTIFIER - 1] + D24;
NEXT4: NEXT SYMBOL;
if LAST SYMBOL ≠ UNQUOTE then goto NEXT4;
NEXT SYMBOL;
end else if LAST SYMBOL = BEGIN then begin;
NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then DECLARATION LIST;
COMPOUND TAIL;
NEXT SYMBOL;
end else STATEMENT;
end else begin;
SPACE[NL BASE - NLP] := -D25 - 4 - DUMP1;
NLP := NLP + 1;
SPACE[NL BASE - BLOCK CELL POINTER - 4] := -D25 - NLP;
DECLARATION LIST;
COMPOUND TAIL;
end;
SPACE[NL BASE - BLOCK CELL POINTER - 2] := D13 × NLP + STRING OCCURRENCE + PRC LEVEL;
for N := 0 step 1 until MAX FOR COUNT - 1 do
SPACE[NL BASE - NLP - 1] := D19;
SPACE[NL BASE - BLOCK CELL POINTER - 1] := SPACE[NL BASE - BLOCK CELL POINTER - 1] + D6 × (INTERNAL BLOCK DEPTH + 1);
if PRC LEVEL > 1 then SPACE[NL BASE - BLOCK CELL POINTER - 1] := SPACE[NL BASE - BLOCK CELL POINTER - 1] + D13 × (MAX FOR COUNT + LOCAL COUNT) else GLOBAL COUNT := GLOBAL COUNT + MAX FOR COUNT + LOCAL COUNT + LABEL COUNT;
NLP := NLP + MAX FOR COUNT;
SPACE[NL BASE - NLP] := -D25 - 5 - BLOCK CELL POINTER;
NLP := NLP + 1;
SPACE[NL BASE - BLOCK CELL POINTER + 1] := -D25 - NLP;
DISPL LEVEL := SPACE[NL BASE - DUMP1 - 1];
BLOCK := INTERNAL BLOCK DEPTH + 1;
BLOCK CELL POINTER := DUMP1;
LOCAL FOR COUNT := DUMP2;
MAX FOR COUNT := DUMP3;
LOCAL COUNT := DUMP4;
LABEL COUNT := DUMP5;
INTERNAL BLOCK DEPTH := DUMP6;
STRING OCCURRENCE := DUMP7;
PRC LEVEL := DUMP8;
end Block;
procedure COMPOUND TAIL;
begin;
STATEMENT;
if LAST SYMBOL = SEMICOLON then begin;
NEXT SYMBOL;
COMPOUND TAIL;
end;
end Compound tail;
procedure DECLARATION LIST;
begin;
integer N, COUNT;
NEXT0: if TYPE DECLARATOR LAST SYMBOL then begin;
COUNT := 0;
NEXT1: COUNT := COUNT + 1;
N := IDENTIFIER;
if N < LAST NLP then ERRORMESSAGE(122);
if LAST SYMBOL = COMMA then begin;
NEXT SYMBOL;
goto NEXT1;
end;
if TYPE = 0 ∨ TYPE = 3 then COUNT := 2 × COUNT;
if OWN TYPE then GLOBAL COUNT := GLOBAL COUNT + COUNT else LOCAL COUNT := LOCAL COUNT + COUNT;
if TYPE = 3 then STRING OCCURRENCE := D6;
end else if ARR DECLARATOR LAST SYMBOL then begin;
COUNT := ARRAY POINTER := 0;
NEXT2: COUNT := COUNT + 1;
NEXT SYMBOL;
N := IDENTIFIER;
if N < LAST NLP then ERRORMESSAGE(123);
SPACE[NL BASE - NLP] := ARRAY POINTER;
ARRAY POINTER := NLP;
NLP := NLP + 1;
if LAST SYMBOL = COMMA then goto NEXT2;
DIMENSION := 0;
if LAST SYMBOL = SUB then begin;
SUBCOUNT := 1;
NEXT3: NEXT SYMBOL;
if LETTER LAST SYMBOL then SKIP IDENTIFIER else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
STORE NUMERICAL CONSTANT;
end;
if LAST SYMBOL = QUOTE then SKIP STRING;
if LAST SYMBOL = COLON then begin;
DIMENSION := DIMENSION + 1;
goto NEXT3;
end;
if LAST SYMBOL = SUB then begin;
SUBCOUNT := SUBCOUNT + 1;
goto NEXT3;
end;
if LAST SYMBOL ≠ BUS then goto NEXT3;
if SUBCOUNT > 1 then begin;
SUBCOUNT := SUBCOUNT - 1;
goto NEXT3;
end;
NEXT SYMBOL;
if DIMENSION = 0 then ERRORMESSAGE(124) else DIMENSION := DIMENSION + 1;
end else ERRORMESSAGE(125);
NEXT4: N := SPACE[NL BASE - ARRAY POINTER];
SPACE[NL BASE - ARRAY POINTER] := DIMENSION;
ARRAY POINTER := N;
if N ≠ 0 then goto NEXT4;
if OWN TYPE then GLOBAL COUNT := GLOBAL COUNT + (3 × DIMENSION + 3) × COUNT else LOCAL COUNT := LOCAL COUNT + COUNT;
if LAST SYMBOL = COMMA then begin;
COUNT := 0;
goto NEXT2;
end;
if TYPE = 3 then STRING OCCURRENCE := D6;
end else if LAST SYMBOL = SWITCH then begin;
NEXT SYMBOL;
N := IDENTIFIER;
if N < LAST NLP then ERRORMESSAGE(126);
SPACE[NL BASE - NLP] := 0;
NLP := NLP + 1;
NEXT5: NEXT SYMBOL;
if LETTER LAST SYMBOL then SKIP IDENTIFIER else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
STORE NUMERICAL CONSTANT;
end;
if LAST SYMBOL = QUOTE then SKIP STRING;
if LAST SYMBOL ≠ SEMICOLON then goto NEXT5;
end else begin;
NEXT SYMBOL;
N := IDENTIFIER;
if N < LAST NLP then ERRORMESSAGE(127);
NLP := NLP + 1;
if TYPE < 4 then begin;
SPACE[NL BASE - NLP] := TYPE × D19;
NLP := NLP + 1;
end;
BLOCK(N);
end;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL else ERRORMESSAGE(128);
if DECLARATOR LAST SYMBOL then goto NEXT0;
end Deciaration list;
procedure STATEMENT;
begin;
integer N, LFC;
LFC := LOCAL FOR COUNT;
NEXT0: CHARACTER := 6 × D19;
NEXT1: if LETTER LAST SYMBOL then begin;
READ IDENTIFIER;
if LAST SYMBOL = COLON then begin;
N := PROCESS IDENTIFIER;
LABEL DECLARATION(N);
goto NEXT1;
end;
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if LAST SYMBOL = COLON then begin;
INT LAB DECLARATION;
goto NEXT1;
end else STORE NUMERICAL CONSTANT;
end else if LAST SYMBOL = FOR then begin;
LOCAL FOR COUNT := LOCAL FOR COUNT + 1;
if LOCAL FOR COUNT > MAX FOR COUNT then MAX FOR COUNT := LOCAL FOR COUNT;
end else if LAST SYMBOL = BEGIN then begin;
BEGIN STATEMENT;
NEXT SYMBOL;
goto NEXT1;
end else if LAST SYMBOL = QUOTE then SKIP STRING;
if LAST SYMBOL ≠ SEMICOLON ∧ LAST SYMBOL ≠ END then begin;
NEXT SYMBOL;
goto NEXT1;
end;
LOCAL FOR COUNT := LFC;
end Statement;
procedure LABEL DECLARATION(N);
integer N;
begin;
if N < LAST NLP then ERRORMESSAGE(129);
if LABEL COUNT = 0 then SPACE[NL BASE - BLOCK CELL POINTER - 3] := D13 × (NLP - 1);
LABEL COUNT := LABEL COUNT + 2;
SPACE[NL BASE - NLP] := D18;
NLP := NLP + 1;
NEXT SYMBOL;
end Label declaration;
procedure INT LAB DECLARATION;
begin;
if REAL NUMBER then begin;
ERRORMESSAGE(130);
NEXT SYMBOL;
end else begin;
INT LABELS := TRUE;
IN NAME LIST;
NLP := NLP + 3;
LABEL DECLARATION(INTEGER LABEL);
end;
end Int lab declaration;
procedure BEGIN STATEMENT;
begin;
integer N;
NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then begin;
N := BLOCK(0);
if N > INTERNAL BLOCK DEPTH then INTERNAL BLOCK DEPTH := N;
end else COMPOUND TAIL;
end Begin statement;
procedure STORE NUMERICAL CONSTANT;
begin;
if ¬SMALL then begin;
SPACE[PROG BASE + INSTRUCT COUNTER] := VALUE OF CONSTANT;
SPACE[PROG BASE + INSTRUCT COUNTER + 1] := DECIMAL EXPONENT;
INSTRUCT COUNTER := INSTRUCT COUNTER + 2;
end;
end Store numerical constant;
integer procedure PROCESS IDENTIFIER;
begin;
LAST NLP := NLP;
NLP := NLP + WORD COUNT + 2;
SPACE[NL BASE - NLP + 1] := CHARACTER;
PROCESS IDENTIFIER := LOOK UP;
end Process identifier;
integer procedure IDENTIFIER;
begin;
READ IDENTIFIER;
IDENTIFIER := PROCESS IDENTIFIER;
end Identifier;
MAIN PROGRAM OF PRESCAN0: RUNNUMBER := 100;
INIT;
LOCAL FOR COUNT := MAX FOR COUNT := LOCAL COUNT := LABEL COUNT := GLOBAL COUNT := INTERNAL BLOCK DEPTH := STRING OCCURRENCE := DISPL LEVEL := PRC LEVEL := 0;
OLD BLOCK CELL POINTER := BLOCK CELL POINTER := NLP;
INT LABELS := FALSE;
SPACE[TEXT BASE] := SPACE[NL BASE - BLOCK CELL POINTER] := SPACE[NL BASE - BLOCK CELL POINTER - 1] := SPACE[NL BASE - BLOCK CELL POINTER - 3] := 0;
NLP := BLOCK CELL POINTER + 6;
SPACE[NL BASE - BLOCK CELL POINTER - 4] := -D25 - NLP;
NEXT SYMBOL;
PROGRAM;
SPACE[NL BASE - BLOCK CELL POINTER - 1] := (GLOBAL COUNT + MAX FOR COUNT + LABEL COUNT) × D13 + (INTERNAL BLOCK DEPTH + 1) × (D13 + D6);
SPACE[NL BASE - BLOCK CELL POINTER - 2] := NLP × D13;
for N := 0 step 1 until MAX FOR COUNT - 1 do
SPACE[NL BASE - NLP - N] := D19;
NLP := NLP + MAX FOR COUNT;
SPACE[NL BASE - BLOCK CELL POINTER - 5] := -D25 - NLP;
END OF TEXT := TEXT POINTER;
OUTPUT;
end prescan0;
procedure PRESCAN1;
begin;
procedure ARITHEXP;
begin;
if LAST SYMBOL = IF then IFCLAUSE(ARITHEXP) else SIMPLE ARITHEXP;
end Arithexp;
procedure SIMPLE ARITHEXP;
begin;
integer N;
if LAST SYMBOL = PLUS ∨ LAST SYMBOL = MINUS then NEXT0: NEXT SYMBOL;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
ARITHEXP;
if LAST SYMBOL = CLOSE then NEXT SYMBOL;
end else if DIGIT LAST SYMBOL then UNSIGNED NUMBER else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
ARITHMETIC(N);
SUBSCRIPTED VARIABLE(N);
FUNCTION DESIGNATOR(N);
end else if LAST SYMBOL = IF then ARITHEXP;
if ARITHOPERATOR LAST SYMBOL then goto NEXT0;
end Simple arithexp;
procedure SUBSCRIPTED VARIABLE(N);
integer N;
begin;
if LAST SYMBOL = SUB then begin;
SUBSCRVAR(N);
DIMENSION := SUBSCRLIST;
LIST LENGTH(N);
end;
end Subscripted variable;
integer procedure SUBSCRLIST;
begin;
NEXT SYMBOL;
ARITHEXP;
if LAST SYMBOL = COMMA then SUBSCRLIST := SUBSCRLIST + 1 else begin;
if LAST SYMBOL = BUS then NEXT SYMBOL;
SUBSCRLIST := 1;
end;
end Subscrlist;
procedure BOOLEXP;
begin;
if LAST SYMBOL = IF then IFCLAUSE(BOOLEXP) else SIMPLE BOOLEAN;
end Boolexp;
procedure SIMPLE BOOLEAN;
begin;
integer N, TYPE;
if LAST SYMBOL = NON then NEXT SYMBOL;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
EXP(TYPE);
if LAST SYMBOL = CLOSE then NEXT SYMBOL;
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
FUNCTION DESIGNATOR(N);
if ARITHOPERATOR LAST SYMBOL ∨ RELATOPERATOR LAST SYMBOL then ARITHMETIC(N) else BOOLEAN(N);
end else if DIGIT LAST SYMBOL ∨ LAST SYMBOL = PLUS ∨ LAST SYMBOL = MINUS then SIMPLE ARITHEXP else if LAST SYMBOL = TRUE ∨ LAST SYMBOL = FALSE then NEXT SYMBOL;
REST OF EXP(TYPE);
end Simple boolean;
procedure STRINGEXP;
begin;
if LAST SYMBOL = IF then IFCLAUSE(STRINGEXP) else SIMPLE STRINGEXP;
end Stringexp;
procedure SIMPLE STRINGEXP;
begin;
integer N;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
STRINGEXP;
if LAST SYMBOL = CLOSE then NEXT SYMBOL;
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
STRING(N);
SUBSCRIPTED VARIABLE(N);
FUNCTION DESIGNATOR(N);
end else if LAST SYMBOL = QUOTE then begin;
QUOTE COUNTER := 1;
NEXT0: NEXT SYMBOL;
if LAST SYMBOL = UNQUOTE then begin;
QUOTE COUNTER := 0;
NEXT SYMBOL;
end else goto NEXT0;
end;
end Simple stringexp;
procedure DESIGEXP;
begin;
if LAST SYMBOL = IF then IFCLAUSE(DESIGEXP) else SIMPLE DESIGEXP;
end Desigexp;
procedure SIMPLE DESIGEXP;
begin;
integer N;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
DESIGEXP;
if LAST SYMBOL = CLOSE then NEXT SYMBOL;
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
DESIGNATIONAL(N);
SUBSCRIPTED VARIABLE(N);
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if IN NAME LIST then DESIGNATIONAL(INTEGER LABEL);
end;
end Simple desigexp;
procedure EXP(TYPE);
integer TYPE;
begin;
if LAST SYMBOL = IF then begin;
NEXT SYMBOL;
BOOLEXP;
NEXT SYMBOL;
SIMPLEXP(TYPE);
if LAST SYMBOL = ELSE then begin;
NEXT SYMBOL;
TYPE EXP(TYPE);
end;
end else SIMPLEXP(TYPE);
end Exp;
procedure TYPE EXP(TYPE);
integer TYPE;
begin;
if TYPE = AR ∨ TYPE = RE ∨ TYPE = IN then ARITHEXP else if TYPE = BO then BOOLEXP else if TYPE = ST then STRINGEXP else if TYPE = DES then DESIGEXP else EXP(TYPE);
end Type exp;
procedure SIMPLEXP(TYPE);
integer TYPE;
begin;
integer N;
TYPE := UN;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
EXP(TYPE);
if LAST SYMBOL = CLOSE then NEXT SYMBOL;
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
FUNCTION DESIGNATOR(N);
if ARITHOPERATOR LAST SYMBOL ∨ RELATOPERATOR LAST SYMBOL then ARITHMETIC(N) else if BOOLOPERATOR LAST SYMBOL then BOOLEAN(N) else begin;
if NONFORMAL LABEL(N) then DESIGNATIONAL(N);
TYPE := TYPE BITS(N);
end;
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if IN NAME LIST then DESIGNATIONAL(INTEGER LABEL) else TYPE := AR;
end else if LAST SYMBOL = PLUS ∨ LAST SYMBOL = MINUS then begin;
SIMPLE ARITHEXP;
TYPE := AR;
end else if LAST SYMBOL = NON ∨ LAST SYMBOL = TRUE ∨ LAST SYMBOL = FALSE then begin;
SIMPLE BOOLEAN;
TYPE := BO;
end else if LAST SYMBOL = QUOTE then begin;
SIMPLE STRINGEXP;
TYPE := ST;
goto END;
end;
REST OF EXP(TYPE);
END: ;
end Simplexp;
procedure REST OF EXP(TYPE);
integer TYPE;
begin;
if ARITHOPERATOR LAST SYMBOL then begin;
NEXT SYMBOL;
SIMPLE ARITHEXP;
TYPE := AR;
end;
if RELATOPERATOR LAST SYMBOL then begin;
NEXT SYMBOL;
SIMPLE ARITHEXP;
TYPE := BO;
end;
if BOOLOPERATOR LAST SYMBOL then begin;
NEXT SYMBOL;
SIMPLE BOOLEAN;
TYPE := BO;
end;
end Rest of exp;
procedure ASSIGNSTAT(N);
integer N;
begin;
SUBSCRIPTED VARIABLE(N);
if LAST SYMBOL = COLONEQUAL then RIGHT HAND SIDE(N);
end Assignstat;
procedure RIGHT HAND SIDE(N);
integer N;
begin;
integer M, TYPE, TYPE N;
ASSIGNED TO(N);
TYPE N := TYPE BITS(N);
NEXT SYMBOL;
if LETTER LAST SYMBOL then begin;
M := IDENTIFIER;
SUBSCRIPTED VARIABLE(M);
if LAST SYMBOL = COLONEQUAL then begin;
INSERT(TYPE N, M);
RIGHT HAND SIDE(M);
TYPE := TYPE BITS(M);
end else begin;
FUNCTION DESIGNATOR(M);
if ARITHOPERATOR LAST SYMBOL ∨ RELATOPERATOR LAST SYMBOL then ARITHMETIC(M) else if BOOLOPERATOR LAST SYMBOL then BOOLEAN(M) else begin;
ARBOST(M);
TYPE := if TYPE N = RE ∨ TYPE N = IN then AR else TYPE N;
INSERT(TYPE, M);
TYPE := TYPE BITS(M);
if TYPE = RE ∨ TYPE = IN then TYPE := AR;
end;
REST OF EXP(TYPE);
end;
end else begin;
M := TYPE N;
TYPE EXP(TYPE N);
if M ≠ NONDES then TYPE N := M;
TYPE := if TYPE N = RE ∨ TYPE N = IN then AR else TYPE N;
end;
INSERT(TYPE, N);
end Right hand side;
procedure INSERT(TYPE, N);
integer TYPE, N;
begin;
if TYPE = RE then REAL(N) else if TYPE = IN then INTEGER(N) else if TYPE = BO then BOOLEAN(N) else if TYPE = AR then ARITHMETIC(N);
end Insert;
procedure FUNCTION DESIGNATOR(N);
integer N;
begin;
if LAST SYMBOL = OPEN then begin;
FUNCTION(N);
DIMENSION := PARLIST;
LIST LENGTH(N);
end;
end Function designator;
integer procedure PARLIST;
begin;
NEXT SYMBOL;
ACTUAL PARAMETER;
if LAST SYMBOL = COMMA then PARLIST := PARLIST + 1 else begin;
if LAST SYMBOL = CLOSE then NEXT SYMBOL;
PARLIST := 1;
end;
end Parlist;
procedure ACTUAL PARAMETER;
begin;
integer TYPE;
EXP(TYPE);
end Actual parameter;
procedure PROCSTAT(N);
integer N;
begin;
PROC(N);
DIMENSION := if LAST SYMBOL = OPEN then PARLIST else 0;
LIST LENGTH(N);
end Procstat;
procedure STATEMENT;
begin;
integer N;
if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
if LAST SYMBOL = COLON then LABELLED STATEMENT(N) else begin;
if LAST SYMBOL = SUB ∨ LAST SYMBOL = COLONEQUAL then ASSIGNSTAT(N) else PROCSTAT(N);
end;
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if LAST SYBMOL = COLON then INTLABELLED STATEMENT;
end else if LAST SYMBOL = GOTO then GOTOSTAT else if LAST SYMBOL = BEGIN then begin;
NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then BLOCK else COMPOUND TAIL;
NEXT SYMBOL;
end else if LAST SYMBOL = IF then IFCLAUSE(STATEMENT) else if LAST SYMBOL = FOR then FORSTAT;
end Statement;
procedure GOTOSTAT;
begin;
integer N;
NEXT SYMBOL;
if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
if ¬LOCAL LABEL(N) then begin;
DESIGNATIONAL(N);
SUBSCRIPTED VARIABLE(N);
end;
end else DESIGEXP;
end Gotostat;
procedure COMPOUND TAIL;
begin;
STATEMENT;
if LAST SYMBOL ≠ SEMICOLON ∧ LAST SYMBOL ≠ END then SKIP REST OF STATEMENT(STATEMENT);
if LAST SYMBOL = SEMICOLON then begin;
NEXT SYMBOL;
COMPOUND TAIL;
end;
end Compound tail;
procedure IFCLAUSE(PR);
procedure PR;
begin;
NEXT SYMBOL;
BOOLEXP;
if LAST SYMBOL = THEN then NEXT SYMBOL;
PR;
if LAST SYMBOL = ELSE then begin;
NEXT SYMBOL;
PR;
end;
end Ifclause;
procedure FORSTAT;
begin;
integer N;
NEXT SYMBOL;
if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
ARITHMETIC(N);
SUBSCRIPTED VARIABLE(N);
if LAST SYMBOL = COLONEQUAL then NEXT0: NEXT SYMBOL;
ARITHEXP;
if LAST SYMBOL = STEP then begin;
NEXT SYMBOL;
ARITHEXP;
if LAST SYMBOL = UNTIL then begin;
NEXT SYMBOL;
ARITHEXP;
end;
end else if LAST SYMBOL = WHILE then begin;
NEXT SYMBOL;
BOOLEXP;
end;
if LAST SYMBOL = COMMA then goto NEXT0;
if LAST SYMBOL = DO then NEXT SYMBOL;
FORCOUNT := FORCOUNT + 1;
STATEMENT;
FORCOUNT := FORCOUNT - 1;
end;
end Forstat;
procedure SWITCH DECLARATION;
begin;
integer N;
NEXT SYMBOL;
if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
if LAST SYMBOL = COLONEQUAL then begin;
DIMENSION := SWITCHLIST;
SWITCH LENGTH(N);
end;
end;
end Switch declaration;
integer procedure SWITCHLIST;
begin;
NEXT SYMBOL;
DESIGEXP;
if LAST SYMBOL = COMMA then SWITCHLIST := SWITCHLIST + 1 else SWITCHLIST := 1;
end Switchlist;
procedure ARRAY DECLARATION;
begin;
integer I, N, COUNT;
NEXT SYMBOL;
N := IDENTIFIER;
COUNT := 1;
NEXT0: if LAST SYMBOL = COMMA then begin;
NEXT SYMBOL;
if LETTER LAST SYMBOL then SKIP IDENTIFIER;
COUNT := COUNT + 1;
goto NEXT0;
end;
if LAST SYMBOL = SUB then begin;
IN ARRAY DECLARATION := TRUE;
DIMENSION := BOUND PAIR LIST;
IN ARRAY DECLARATION := FALSE;
end else DIMENSION := 0;
CHECK DIMENSION(N);
if OWN TYPE then for I := 1 step 1 until COUNT do
begin;
ADDRESS(N, INSTRUCT COUNTER);
INSTRUCT COUNTER := INSTRUCT COUNTER + 3 × DIMENSION + 6;
N := NEXT IDENTIFIER(N);
end;
if LAST SYMBOL = COMMA then ARRAY DECLARATION;
end Array declaration;
integer procedure BOUND PAIR LIST;
begin;
NEXT SYMBOL;
ARITHEXP;
if LAST SYMBOL = COLON then begin;
NEXT SYMBOL;
ARITHEXP;
end;
if LAST SYMBOL = COMMA then BOUND PAIR LIST := BOUND PAIR LIST + 1 else begin;
if LAST SYMBOL = BUS then NEXT SYMBOL;
BOUND PAIR LIST := 1;
end;
end Bound pair list;
procedure PROCEDURE DECLARATION;
begin;
integer N, M;
NEXT SYMBOL;
N := IDENTIFIER;
ENTRANCE BLOCK;
if LAST SYMBOL = OPEN then begin;
IN FORMAL LIST := TRUE;
NEXT0: NEXT SYMBOL;
M := IDENTIFIER;
if SPACE[NL BASE - M] = 95 × D19 then begin;
ERRORMESSAGE(201);
SPACE[NL BASE - M] := 127 × D19;
end;
if LAST SYMBOL = COMMA then goto NEXT0;
if LAST SYMBOL = CLOSE then NEXT SYMBOL;
N FORMAL LIST := FALSE;
end;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL;
SKIP VALUE LIST;
SKIP SPECIFICATION LIST;
if IN CODE(N) then SCAN CODE(N) else begin;
if SPACE[NL BASE - N] ÷ D19 = 19 ∧ ¬USE OF COUNTER STACK then SPACE[NL BASE - BLOCK CELL POINTER - 2] := SPACE[NL BASE - BLOCK CELL POINTER - 2] + 64;
if LAST SYMBOL = BEGIN then begin;
NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then DECLARATION LIST;
COMPOUND TAIL;
NEXT SYMBOL;
end else STATEMENT;
ADDRESSING OF BLOCK IDENTIFIERS(N);
end;
end Procedure declaration;
procedure BLOCK;
begin;
ENTRANCE BLOCK;
DECLARATION LIST;
COMPOUND TAIL;
ADDRESSING OF BLOCK IDENTIFIERS(0);
end Block;
procedure DECLARATION LIST;
begin;
if TYPEDECLARATOR LAST SYMBOL then SKIP TYPE DECLARATION else if ARR DECLARATOR LAST SYMBOL then ARRAY DECLARATION else if LAST SYMBOL = SWITCH then SWITCH DECLARATION else PROCEDURE DECLARATION;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then DECLARATION LIST;
end Declaration list;
procedure PROGRAM;
begin;
integer N;
if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
if LAST SYMBOL = COLON then LABEL DECLARATION(N);
PROGRAM;
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if IN NAME LIST then LABEL DECLARATION(INTEGER LABEL);
PROGRAM;
end else if LAST SYMBOL = BEGIN then begin;
NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then BLOCK else COMPOUND TAIL;
end else begin;
NEXT SYMBOL;
PROGRAM;
end;
end Program;
procedure LABELLED STATEMENT(N);
integer N;
begin;
if NONFORMAL LABEL(N) then LABEL DECLARATION(N);
STATEMENT;
end Labelled statement;
procedure INTLABELLED STATEMENT;
begin;
if IN NAME LIST then LABEL DECLARATION(INTEGER LABEL);
STATEMENT;
end Intlabelled statement;
procedure LABEL DECLARATION(N);
integer N;
begin;
if PROC LEVEL = 0 then begin;
DESIGNATIONAL(N);
ADDRESS(N, INSTRUCT COUNTER);
SPACE[NL BASE - N - 1] := SPACE[NL BASE - N - 1] + INSTRUCT COUNTER + D20 × FORCOUNT;
SPACE[PROG BASE + INSTRUCT COUNTER] := 0;
SPACE[PROG BASE + INSTRUCT COUNTER + 1] := D18 × DISPLAY LEVEL + DP0;
INSTRUCT COUNTER := INSTRUCT COUNTER + 2;
end else SPACE[NL BASE - N - 1] := SPACE[NL BASE - N - 1] + D20 × FORCOUNT;
NEXT SYMBOL;
end Label declaration;
procedure ADDRESSING OF BLOCK IDENTIFIERS(N);
integer N;
begin;
integer COUNTER, F, CODE, CODE1;
if N = 0 then SPACE[NL BASE - BLOCK CELL POINTER - 1] := SPACE[NL BASE - BLOCK CELL POINTER - 1] + D13;
if PROC LEVEL > 0 then begin;
COUNTER := D9 × DISPLAY LEVEL + D8;
if N = 0 then COUNTER := COUNTER + 1 + D18 else begin;
COUNTER := COUNTER + DISPLAY LEVEL + TOP OF DISPLAY;
F := BLOCK CELL POINTER + 5;
NEXT0: F := NEXT IDENTIFIER(F);
if F > BLOCK CELL POINTER then begin;
ADDRESS(F, COUNTER);
CODE1 := SPACE[NL BASE - F] ÷ D18;
CODE := CODE1 ÷ 2;
COUNTER := COUNTER + (if CODE = 64 ∨ CODE = 67 ∨ CODE = 70 then 2 else if CODE < 96 then 1 else if CODE1 = 2 × CODE then 2 else 4);
goto NEXT0;
end;
COUNTER := COUNTER + D18;
CODE := SPACE[NL BASE - N] ÷ D19;
if CODE ≠ 24 then begin;
F := if WANTED then 3 else if CODE = 16 ∨ CODE = 19 then 2 else 1;
ADDRESS(N + 2, COUNTER);
COUNTER := COUNTER + F;
SPACE[NL BASE - BLOCK CELL POINTER - 1] := SPACE[NL BASE - BLOCK CELL POINTER - 1] + D13 × F;
end;
end;
F := STATUS;
NEXT1: if SPACE[NL BASE - F] > 0 then begin;
ADDRESS(F, COUNTER);
COUNTER := COUNTER + 1;
F := F + 1;
goto NEXT1;
end;
F := BLOCK CELL POINTER + 4;
NEXT2: F := NEXT IDENTIFIER(F);
CODE := SPACE[NL BASE - F] ÷ D19;
if F > BLOCK CELL POINTER ∧ F < STATUS ∧ CODE < 64 then begin;
if CODE > 24 then begin;
if CODE < 36 then begin;
ADDRESS(F, INSTRUCT COUNTER);
INSTRUCT COUNTER := INSTRUCT COUNTER + (if CODE = 32 ∨ CODE = 35 then 2 else 1);
end;
end else if CODE < 14 then begin;
if CODE ≠ 6 ∨ (CODE = 6 ∧ BIT STRING(D19, D18, SPACE[NL BASE - F - 1]) = 0) then begin;
ADDRESS(F, COUNTER);
COUNTER := COUNTER + (if CODE = 0 ∨ CODE = 3 ∨ CODE = 6 then 2 else 1);
end;
end;
goto NEXT2;
end;
if COUNTER > D18 + D9 × (DISPLAY LEVEL + 1) then ERRORMESSAGE(202);
EXIT BLOCK;
end else STATIC ADDRESSING;
end Addressing of block identifiers;
procedure STATIC ADDRESSING;
begin;
integer F, CODE;
F := STATUS;
NEXT0: if SPACE[NL BASE - F] > 0 then begin;
ADDRESS(F, INSTRUCT COUNTER);
INSTRUCT COUNTER := INSTRUCT COUNTER + 1;
F := F + 1;
goto NEXT0;
end;
F := BLOCK CELL POINTER + 4;
NEXT1: F := NEXT IDENTIFIER(F);
CODE := SPACE[NL BASE - F] ÷ D19;
if F > BLOCK CELL POINTER ∧ F < STATUS then begin;
if CODE > 24 ∧ CODE < 36 ∨ CODE < 14 ∧ CODE ≠ 6 then begin;
ADDRESS(F, INSTRUCT COUNTER);
INSTRUCT COUNTER := INSTRUCT COUNTER + (if CODE = 0 ∨ CODE = 3 ∨ CODE = 32 ∨ CODE = 35 then 2 else 1);
end;
goto NEXT1;
end;
EXIT BLOCK;
end Static addressing;
procedure ADD TYPE(N, T);
integer N, T;
begin;
integer CODE, NEW CODE, TYPE;
NEW CODE := CODE := SPACE[NL BASE - N] ÷ D19;
if CODE > 95 then begin;
if CODE = 127 then NEW CODE := 96 + T else if CODE = 120 ∧ T < 6 then NEW CODE := 112 + T else begin;
TYPE := CODE - CODE ÷ 8 × 8;
if TYPE = UN ∨ (TYPE = NONDES ∧ T < 5) ∨ (TYPE = AR ∧ T < 2) then NEW CODE := CODE - TYPE + T;
end;
SPACE[NL BASE - N] := SPACE[NL BASE - N] - (CODE - NEW CODE) × D19;
end;
end Add type;
procedure REAL(N);
integer N;
begin;
ADD TYPE(N, RE);
end Real;
procedure INTEGER(N);
integer N;
begin;
ADD TYPE(N, IN);
end Integer;
procedure BOOLEAN(N);
integer N;
begin;
ADD TYPE(N, BO);
end Boolean;
procedure STRING(N);
integer N;
begin;
ADD TYPE(N, ST);
end String;
procedure ARITHMETIC(N);
integer N;
begin;
ADD TYPE(N, AR);
end Arithmetic;
procedure ARBOST(N);
integer N;
begin;
ADD TYPE(N, NONDES);
end Arbost;
procedure DESIGNATIONAL(N);
integer N;
begin;
integer P;
if NONFORMAL LABEL(N) then begin;
if BIT STRING(D19, D18, SPACE[NL BASE - N - 1]) = 1 then begin;
SPACE[NL BASE - N - 1] := ABS(SPACE[NL BASE - N - 1] - D18);
P := CORRESPONDING BLOCK CELL POINTER(N);
if BIT STRING(D6, D0, SPACE[NL BASE - P - 2]) > 0 then begin;
SPACE[NL BASE - P - 3] := SPACE[NL BASE - P - 3] + 1;
SPACE[NL BASE - P - 1] := SPACE[NL BASE - P - 1] + D14;
end;
end;
end else ADD TYPE(N, DES);
end Designational;
procedure ASSIGNED TO(N);
integer N;
begin;
integer CODE;
CODE := SPACE[NL BASE - N] ÷ D19;
if CODE > 95 then begin;
if CODE = 127 then CODE := 101;
if CODE < 102 then SPACE[NL BASE - N] := CODE × D19 + D18 else ADD TYPE(N, NONDES);
end;
end Assigned to;
procedure SUBSCRVAR(N);
integer N;
begin;
integer CODE, NEW CODE;
CODE := SPACE[NL BASE - N] ÷ D19;
if CODE > 95 then begin;
NEW CODE := if CODE = 127 then 111 else if CODE < 104 then CODE + 8 else CODE;
SPACE[NL BASE - N] := SPACE[NL BASE - N] + (NEW CODE - CODE) × D19;
end;
end Subscrvar;
procedure PROC(N);
integer N;
begin;
integer CODE, NEW CODE;
CODE := SPACE[NL BASE - N] ÷ D19;
if CODE > 95 then begin;
NEW CODE := if CODE = 127 then 120 else if CODE < 102 then CODE + 16 else CODE;
SPACE[NL BASE - N] := SPACE[NL BASE - N] + (NEW CODE - CODE) × D19;
end;
end Proc;
procedure FUNCTION(N);
integer N;
begin;
ARBOST(N);
PROC(N);
end Function;
procedure LIST LENGTH(N);
integer N;
begin;
integer WORD;
if SPACE[NL BASE - N] ÷ D19 > 95 then begin;
WORD := SPACE[NL BASE - N - 1];
if BIT STRING(D18, D0, WORD) = 0 then SPACE[NL BASE - N - 1] := WORD + DIMENSION + 1;
end;
end List length;
procedure SWITCH LENGTH(N);
integer N;
begin;
SPACE[NL BASE - N - 1] := DIMENSION + 1;
end Switch length;
procedure ADDRESS(N, M);
integer N, M;
begin;
integer WORD;
WORD := SPACE[NL BASE - N] ÷ D18;
SPACE[NL BASE - N] := WORD × D18 + M;
end Address;
procedure CHECK DIMENSION(N);
integer N;
begin;
if SPACE[NL BASE - N - 1] ≠ DIMENSION + 1 then begin;
ERRORMESSAGE(203);
SPACE[NL BASE - N - 1] := DIMENSION + 1;
end;
end Check dimension;
integer procedure IDENTIFIER;
begin;
integer N;
LAST NLP := NLP;
READ IDENTIFIER;
IDENTIFIER := N := LOOK UP;
if N > NLP then ASK LIBRARIAN;
if N > NLP then begin;
ERRORMESSAGE(204);
NLP := NLP + WORD COUNT + 3;
SPACE[NL BASE - NLP + 1] := 0;
end;
end Identifier;
procedure SCAN CODE(N);
integer N;
begin;
BLOCK CELL POINTER := SPACE[NL BASE - BLOCK CELL POINTER] ÷ D13;
NEXT0: NEXT SYMBOL;
if LAST SYMBOL = MINUS then NEXT SYMBOL;
if LETTER LAST SYMBOL then IDENTIFIER else UNSIGNED INTEGER(0);
if LAST SYMBOL = COMMA then goto NEXT0;
if LAST SYMBOL = UNQUOTE then NEXT SYMBOL;
end Scan code;
procedure ASK LIBRARIAN;
begin;
comment if the current identifier occurs in the library
then this procedure will add a new namecell to
the name list and increase nlp
;
;
end Ask librarian;
MAIN PROGRAM OF PRESCAN 1: if ¬TEXT IN MEMORY then begin;
NEWPAGE;
PRINTTEXT(`input tape for prescan1');
end;
RUNNUMBER := 200;
INIT;
BLOCK CELL POINTER := NEXT BLOCK CELL POINTER := 0;
DP0 := INSTRUCT COUNTER;
INSTRUCT COUNTER := INSTRUCT COUNTER + TOP OF DISPLAY;
SPACE[NL BASE - NLP] := -1;
NEXT SYMBOL;
ENTRANCE BLOCK;
PROGRAM;
STATIC ADDRESSING;
OUTPUT;
end prescan1;
procedure TRANSLATE;
begin;
integer LAST LNC, LNC, LAST LNCR, MACRO, PARAMETER, STATE, STACK0, STACK1, B, RET LEVEL, MAX DEPTH, RET MAX DEPTH, MAX DEPTH ISR, MAX DISPLAY LENGTH, MAX PROC LEVEL, ECOUNT, CONTROLLED VARIABLE, INCREMENT, L0, L1, L2, L3, L4, L5, NUMBER OF SWITCH ELEMENTS, SWITCH IDENTIFIER, SWITCH LIST COUNT, SWORD, ADDRESS OF CONSTANT, SUM OF MAXIMA;
Boolean IN SWITCH DECLARATION, IN CODE BODY, IF STATEMENT FORBIDDEN, COMPLICATED, COMPLEX STEP ELEMENT;
procedure ARITHEXP;
begin;
integer FUTURE1, FUTURE2;
if LAST SYMBOL = IF then begin;
FUTURE1 := FUTURE2 := 0;
NEXT SYMBOL;
BOOLEXP;
MACRO2(COJU, FUTURE1);
if LAST SYMBOL ≠ THEN then ERRORMESSAGE(300) else NEXT SYMBOL;
SIMPLE ARITHEXP;
if LAST SYMBOL = ELSE then begin;
MACRO2(JU, FUTURE2);
SUBSTITUTE(FUTURE1);
NEXT SYMBOL;
ARITHEXP;
SUBSTITUTE(FUTURE2);
end else ERRORMESSAGE(301);
end else SIMPLE ARITHEXP;
end Arithexp;
procedure SIMPLE ARITHEXP;
begin;
if LAST SYMBOL = MINUS then begin;
NEXT SYMBOL;
TERM;
MACRO(NEG);
end else begin;
if LAST SYMBOL = PLUS then NEXT SYMBOL;
TERM;
end;
NEXT TERM;
end Simple arithexp;
procedure NEXT TERM;
begin;
if LAST SYMBOL = PLUS then begin;
MACRO(STACK);
NEXT SYMBOL;
TERM;
MACRO(ADD);
NEXT TERM;
end else if LAST SYMBOL = MINUS then begin;
MACRO(STACK);
NEXT SYMBOL;
TERM;
MACRO(SUB);
NEXT TERM;
end;
end Next term;
procedure TERM;
begin;
FACTOR;
NEXT FACTOR;
end Term;
procedure NEXT FACTOR;
begin;
if LAST SYMBOL = MUL then begin;
MACRO(STACK);
NEXT SYMBOL;
FACTOR;
MACRO(MUL);
NEXT FACTOR;
end else if LAST SYMBOL = DIV then begin;
MACRO(STACK);
NEXT SYMBOL;
FACTOR;
MACRO(DIV);
NEXT FACTOR;
end else if LAST SYMBOL = IDI then begin;
MACRO(STACK);
NEXT SYMBOL;
FACTOR;
MACRO(IDI);
NEXT FACTOR;
end;
end Next factor;
procedure FACTOR;
begin;
PRIMARY;
NEXT PRIMARY;
end Factor;
procedure NEXT PRIMARY;
begin;
if LAST SYMBOL = TTP then begin;
MACRO(STACK);
NEXT SYMBOL;
PRIMARY;
MACRO(TTP);
NEXT PRIMARY;
end;
end Next primary;
procedure PRIMARY;
begin;
integer N;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
ARITHEXP;
if LAST SYMBOL = CLOSE then NEXT SYMBOL else ERRORMESSAGE(302);
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
ARITHCONSTANT;
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
FUNCTION DESIGNATOR(N);
ARITHNAME(N);
end else begin;
ERRORMESSAGE(303);
if LAST SYMBOL = IF ∨ LAST SYMBOL = PLUS ∨ LAST SYMBOL = MINUS then ARITHEXP;
end;
end Primary;
procedure ARITHNAME(N);
integer N;
begin;
if NONARITHMETIC(N) then ERRORMESSAGE(304);
COMPLICATED := FORMAL(N) ∨ FUNCTION(N);
if SIMPLE(N) then begin;
if FORMAL(N) then MACRO2(DOS, N) else if INTEGER(N) then MACRO2(TIV, N) else MACRO2(TRV, N);
end;
end Arithname;
procedure SUBSCRIPTED VARIABLE(N);
integer N;
begin;
if SUBSCRVAR(N) then begin;
ADDRESS DESCRIPTION(N);
if LAST SYMBOL = COLONEQUAL then begin;
MACRO(STACK);
MACRO(STAA);
end else EVALUATION OF(N);
end;
end Subscripted variable;
procedure ADDRESS DESCRIPTION(N);
integer N;
begin;
if LAST SYMBOL = SUB then begin;
NEXT SYMBOL;
DIMENSION := SUBSCRIPT LIST;
CHECK DIMENSION(N);
if FORMAL(N) then MACRO2(DOS, N) else if DESIGNATIONAL(N) then MACRO2(TSWE, N) else MACRO2(TAK, N);
end else ERRORMESSAGE(305);
end Address description;
procedure EVALUATION OF(N);
integer N;
begin;
if DESIGNATIONAL(N) then begin;
if FORMAL(N) then MACRO(TFSL) else MACRO(TSL);
end else if BOOLEAN(N) then MACRO(TSB) else if STRING(N) then MACRO(TSST) else if FORMAL(N) then MACRO(TFSU) else if INTEGER(N) then MACRO(TSI) else MACRO(TSR);
end Evaluation of;
integer procedure SUBSCRIPT LIST;
begin;
ARITHEXP;
if LAST SYMBOL = COMMA then begin;
MACRO(STACK);
NEXT SYMBOL;
SUBSCRIPT LIST := SUBSCRIPT LIST + 1;
end else begin;
if LAST SYMBOL = BUS then NEXT SYMBOL else ERRORMESSAGE(306);
SUBSCRIPT LIST := 1;
end;
end Subscript list;
procedure BOOLEXP;
begin;
integer FUTURE1, FUTURE2;
if LAST SYMBOL = IF then begin;
FUTURE1 := FUTURE2 := 0;
NEXT SYMBOL;
BOOLEXP;
MACRO2(COJU, FUTURE1);
if LAST SYMBOL ≠ THEN then ERRORMESSAGE(307) else NEXT SYMBOL;
SIMPLE BOOLEAN;
if LAST SYMBOL = ELSE then begin;
MACRO2(JU, FUTURE2);
SUBSTITUTE(FUTURE1);
NEXT SYMBOL;
BOOLEXP;
SUBSTITUTE(FUTURE2);
end else ERRORMESSAGE(308);
end else SIMPLE BOOLEAN;
end Boolexp;
procedure SIMPLE BOOLEAN;
begin;
IMPLICATION;
NEXT IMPLICATION;
end Simple boolean;
procedure NEXT IMPLICATION;
begin;
if LAST SYMBOL = QVL then begin;
MACRO(STAB);
NEXT SYMBOL;
IMPLICATION;
MACRO(QVL);
NEXT IMPLICATION;
end;
end Next implication;
procedure IMPLICATION;
begin;
BOOLTERM;
NEXT BOOLTERM;
end Implication;
procedure NEXT BOOLTERM;
begin;
if LAST SYMBOL = IMP then begin;
MACRO(STAB);
NEXT SYMBOL;
BOOLTERM;
MACRO(IMP);
NEXT BOOLTERM;
end;
end Next boolterm;
procedure BOOLTERM;
begin;
BOOLFAC;
NEXT BOOLFAC;
end Boolterm;
procedure NEXT BOOLFAC;
begin;
if LAST SYMBOL = OR then begin;
MACRO(STAB);
NEXT SYMBOL;
BOOLFAC;
MACRO(OR);
NEXT BOOLFAC;
end;
end Next boolfac;
procedure BOOLFAC;
begin;
BOOLSEC;
NEXT BOOLSEC;
end Boolfac;
procedure NEXT BOOLSEC;
begin;
if LAST SYMBOL = AND then begin;
MACRO(STAB);
NEXT SYMBOL;
BOOLSEC;
MACRO(AND);
NEXT BOOLSEC;
end;
end Next boolsec;
procedure BOOLSEC;
begin;
if LAST SYMBOL = NON then begin;
NEXT SYMBOL;
BOOLPRIM;
MACRO(NON);
end else BOOLPRIM;
end Boolsec;
procedure BOOLPRIM;
begin;
integer TYPE, N;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
ARBOOLEXP(TYPE);
if LAST SYMBOL = CLOSE then NEXT SYMBOL else ERRORMESSAGE(309);
if TYPE = AR then REST OF RELATION else if TYPE = ARBO then begin;
if ARITHOPERATOR LAST SYMBOL then REST OF RELATION else RELATION;
end;
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
BOOLPRIMREST(N);
end else if DIGIT LAST SYMBOL ∨ LAST SYMBOL = PLUS ∨ LAST SYMBOL = MINUS then begin;
SIMPLE ARITHEXP;
REST OF RELATION;
end else if LAST SYMBOL = TRUE ∨ LAST SYMBOL = FALSE then begin;
MACRO2(TBC, LAST SYMBOL);
NEXT SYMBOL;
end else ERRORMESSAGE(310);
end Boolprim;
Boolean procedure RELATION;
begin;
integer RELMACRO;
if RELATOPERATOR LAST SYMBOL then begin;
RELMACRO := RELATMACRO;
MACRO(STACK);
NEXT SYMBOL;
SIMPLE ARITHEXP;
MACRO(RELMACRO);
RELATION := TRUE;
end else RELATION := FALSE;
end Relation;
procedure REST OF RELATION;
begin;
REST OF ARITHEXP;
if ¬RELATION then ERRORMESSAGE(311);
end Rest of relation;
procedure BOOLPRIMREST(N);
integer N;
begin;
FUNCTION DESIGNATOR(N);
if ARITHMETIC(N) ∨ ARITHOPERATOR LAST SYMBOL ∨ RELATOPERATOR LAST SYMBOL then begin;
ARITHNAME(N);
REST OF RELATION;
end else BOOLNAME(N);
end Boolprimrest;
procedure BOOLNAME(N);
integer N;
begin;
if NONBOOLEAN(N) then ERRORMESSAGE(312);
if SIMPLE(N) then begin;
if FORMAL(N) then MACRO2(DOS, N) else MACRO2(TBV, N);
end;
end Boolname;
procedure ARBOOLEXP(TYPE);
integer TYPE;
begin;
integer FUTURE1, FUTURE2;
if LAST SYMBOL = IF then begin;
FUTURE1 := FUTURE2 := 0;
NEXT SYMBOL;
BOOLEXP;
MACRO2(COJU, FUTURE1);
if LAST SYMBOL ≠ THEN then ERRORMESSAGE(313) else NEXT SYMBOL;
SIMPLE ARBOOLEXP(TYPE);
if LAST SYMBOL = ELSE then begin;
MACRO2(JU, FUTURE2);
SUBSTITUTE(FUTURE1);
NEXT SYMBOL;
if TYPE = BO then BOOLEXP else if TYPE = AR then ARITHEXP else ARBOOLEXP(TYPE);
SUBSTITUTE(FUTURE2);
end else ERRORMESSAGE(314);
end else SIMPLE ARBOOLEXP(TYPE);
end Arboolexp;
procedure SIMPLE ARBOOLEXP(TYPE);
integer TYPE;
begin;
integer N;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
ARBOOLEXP(TYPE);
if LAST SYMBOL = CLOSE then NEXT SYMBOL else ERRORMESSAGE(315);
if TYPE = BO ∨ TYPE = ARBO ∧ BOOLOPERATOR LAST SYMBOL then begin;
REST OF BOOLEXP;
TYPE := BO;
end else if TYPE = AR ∨ ARITHOPERATOR LAST SYMBOL ∨ RELATOPERATOR LAST SYMBOL then REST OF ARBOOLEXP(TYPE);
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
ARBOOLREST(TYPE, N);
end else if DIGIT LAST SYMBOL ∨ LAST SYMBOL = PLUS ∨ LAST SYMBOL = MINUS then begin;
SIMPLE ARITHEXP;
REST OF ARBOOLEXP(TYPE);
end else if LAST SYMBOL = NON ∨ LAST SYMBOL = TRUE ∨ LAST SYMBOL = FALSE then begin;
SIMPLE BOOLEAN;
TYPE := BO;
end else begin;
ERRORMESSAGE(316);
TYPE := ARBO;
end;
end Simple arboolexp;
procedure REST OF ARITHEXP;
begin;
NEXT PRIMARY;
NEXT FACTOR;
NEXT TERM;
end Rest of arithexp;
procedure REST OF BOOLEXP;
begin;
NEXT BOOLSEC;
NEXT BOOLFAC;
NEXT BOOLTERM;
NEXT IMPLICATION;
end Rest of boolexp;
procedure REST OF ARBOOLEXP(TYPE);
integer TYPE;
begin;
REST OF ARITHEXP;
if RELATION then begin;
REST OF BOOLEXP;
TYPE := BO;
end else TYPE := AR;
end Rest of arboolexp;
procedure ARBOOLREST(TYPE, N);
integer TYPE, N;
begin;
FUNCTION DESIGNATOR(N);
if BOOLEAN(N) ∨ BOOLOPERATOR LAST SYMBOL then begin;
BOOLNAME(N);
REST OF BOOLEXP;
TYPE := BO;
end else if ARITHMETIC(N) ∨ ARITHOPERATOR LAST SYMBOL ∨ RELATOPERATOR LAST SYMBOL then begin;
ARITHNAME(N);
REST OF ARBOOLEXP(TYPE);
end else begin;
if STRING(N) ∨ DESIGNATIONAL(N) then ERRORMESSAGE(317);
MACRO2(DOS, N);
TYPE := ARBO;
end;
end Arboolrest;
procedure STRINGEXP;
begin;
integer FUTUREL, FUTURE2;
if LAST SYMBOL = IF then begin;
FUTUREL := FUTURE2 := 0;
NEXT SYMBOL;
BOOLEXP;
MACRO2(COJU, FUTUREL);
if LAST SYMBOL ≠ THEN then ERRORMESSAGE(318) else NEXT SYMBOL;
SIMPLE STRINGEXP;
if LAST SYMBOL = ELSE then begin;
MACRO2(JU, FUTURE2);
SUBSTITUTE(FUTUREL);
NEXT SYMBOL;
STRINGEXP;
SUBSTITUTE(FUTURE2);
end else ERRORMESSAGE(319);
end else SIMPLE STRINGEXP;
end Stringexp;
procedure SIMPLE STRINGEXP;
begin;
integer FUTURE, N;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
STRINGEXP;
if LAST SYMBOL = CLOSE then NEXT SYMBOL else ERRORMESSAGE(320);
end else if 1 ≠ ETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
STRINGNAME(N);
end else if LAST SYMBOL = QUOTE then begin;
MACRO(TCST);
FUTURE := 0;
MACRO2(JU, FUTURE);
CONSTANT STRING;
SUBSTITUTE(FUTURE);
end else ERRORMESSAGE(321);
end Simple stringexp;
procedure STRINGNAME(N);
integer N;
begin;
if NONSTRING(N) then ERRORMESSAGE(322);
FUNCTION DESIGNATOR(N);
if SIMPLE(N) then begin;
if FORMAL(N) then MACRO2(DOS, N) else MACRO2(TSTV, N);
end;
end Stringname;
procedure DESIGEXP;
begin;
integer FUTUREL, FUTURE2;
if LAST SYMBOL = IF then begin;
FUTUREL := FUTURE2 := 0;
NEXT SYMBOL;
BOOLEXP;
MACRO2(COJU, FUTUREL);
if LAST SYMBOL ≠ THEN then ERRORMESSAGE(323) else NEXT SYMBOL;
SIMPLE DESIGEXP;
if LAST SYMBOL = ELSE then begin;
MACRO2(JU, FUTURE2);
SUBSTITUTE(FUTUREL);
NEXT SYMBOL;
DESIGEXP;
SUBSTITUTE(FUTURE2);
end else ERRORMESSAGE(324);
end else SIMPLE DESIGEXP;
end Desigexp;
procedure SIMPLE DESIGEXP;
begin;
integer N;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
DESIGEXP;
if LAST SYMBOL = CLOSE then NEXT SYMBOL else ERRORMESSAGE(325);
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
DESIGNAME(N);
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if IN NAME LIST then MACRO2(TLV, INTEGER LABEL) else ERRORMESSAGE(326);
end else ERRORMESSAGE(327);
end Simple desigexp;
procedure DESIGNAME(N);
integer N;
begin;
if NONDESIGNATIONAL(N) then ERRORMESSAGE(328);
if SIMPLE(N) then begin;
if FORMAL(N) then MACRO2(DOS, N) else MACRO2(TLV, N);
end;
end Designame;
procedure ARDESEXP(TYPE);
integer TYPE;
begin;
EXP(TYPE);
if TYPE = BO ∨ TYPE = ST then ERRORMESSAGE(329);
if TYPE = UN then TYPE := INTLAB else if TYPE = NONDES then TYPE := AR;
end Ardesexp;
procedure NONDESEXP(TYPE);
integer TYPE;
begin;
EXP(TYPE);
if TYPE = DES then ERRORMESSAGE(330);
if TYPE = UN then TYPE := NONDES else if TYPE = INTLAB then TYPE := AR;
end Nondesexp;
procedure EXP(TYPE);
integer TYPE;
begin;
integer FUTURE1, FUTURE2;
if LAST SYMBOL = IF then begin;
FUTURE1 := FUTURE2 := 0;
NEXT SYMBOL;
BOOLEXP;
MACRO2(COJU, FUTURE1);
if LAST SYMBOL ≠ THEN then ERRORMESSAGE(331) else NEXT SYMBOL;
SIMPLEXP(TYPE);
if LAST SYMBOL = ELSE then begin;
MACRO2(JU, FUTURE2);
SUBSTITUTE(FUTURE1);
NEXT SYMBOL;
if TYPE = AR then ARITHEXP else if TYPE = BO then BOOLEXP else if TYPE = ST then STRINGEXP else if TYPE = DES then DESIGEXP else if TYPE = INTLAB then ARDESEXP(TYPE) else if TYPE = NONDES then NONDESEXP(TYPE) else EXP(TYPE);
SUBSTITUTE(FUTURE2);
end else ERRORMESSAGE(332);
end else SIMPLEXP(TYPE);
end Exp;
procedure SIMPLEXP(TYPE);
integer TYPE;
begin;
integer N;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
EXP(TYPE);
if LAST SYMBOL = CLOSE then NEXT SYMBOL else ERRORMESSAGE(333);
if TYPE = BO ∨ (TYPE = NONDES ∨ TYPE = UN) ∧ BOOLOPERATOR LAST SYMBOL then begin;
REST OF BOOLEXP;
TYPE := BO;
end else if TYPE ≠ ST ∧ TYPE ≠ DES ∧ OPERATOR LAST SYMBOL then REST OF ARBOOLEXP(TYPE);
end else if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
EXPREST(TYPE, N);
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
ARITHCONSTANT;
if IN NAME LIST ∧ (¬OPERATOR LAST SYMBOL) then begin;
MACRO2(TLV, INTEGER LABEL);
TYPE := INTLAB;
end else REST OF ARBOOLEXP(TYPE);
end else if LAST SYMBOL = PLUS ∨ LAST SYMBOL MINUS then SIMPLE ARBOOLEXP(TYPE) else if LAST SYMBOL = NON ∨ LAST SYMBOL = TRUE ∨ LAST SYMBOL = FALSE then begin;
SIMPLE BOOLEAN;
TYPE := BO;
end else if LAST SYMBOL = QUOTE then begin;
SIMPLE STRINGEXP;
TYPE := ST;
end else begin;
ERRORMESSAGE(334);
TYPE := UN;
end;
end Simplexp;
procedure EXPREST(TYPE, N);
integer TYPE, N;
begin;
if DESIGNATIONAL(N) then begin;
DESIGNAME(N);
TYPE := DES;
end else if STRING(N) then begin;
STRINGNAME(N);
TYPE := ST;
end else begin;
FUNCTION DESIGNATOR(N);
if BOOLEAN(N) ∨ BOOLOPERATOR LAST SYMBOL then begin;
BOOLNAME(N);
REST OF BOOLEXP;
TYPE := BO;
end else if ARITHMETIC(N) ∨ ARITHOPERATOR LAST SYMBOL ∨ RELATOPERATOR LAST SYMBOL then begin;
ARITHNAME(N);
REST OF ARBOOLEXP(TYPE);
end else begin;
if SIMPLE(N) then MACRO2(DOS, N);
TYPE := if UNKNOWN(N) then UN else NONDES;
end;
end;
end Exprest;
procedure ASSIGNSTAT(N);
integer N;
begin;
SUBSCRIPTED VARIABLE(N);
if LAST SYMBOL = COLONEQUAL then DISTRIBUTE ON TYPE(N) else ERRORMESSAGE(335);
end Assignstat;
integer procedure DISTRIBUTE ON TYPE(N);
integer N;
begin;
if INTEGER(N) then begin;
INTASSIGN(N);
DISTRIBUTE ON TYPE := IN;
end else if REAL(N) then begin;
REALASSIGN(N);
DISTRIBUTE ON TYPE := RE;
end else if BOOLEAN(N) then begin;
BOOLASSIGN(N);
DISTRIBUTE ON TYPE := BO;
end else if STRING(N) then begin;
STRINGASSIGN(N);
DISTRIBUTE ON TYPE := ST;
end else DISTRIBUTE ON TYPE := if ARITHMETIC(N) then ARASSIGN(N) else UNASSIGN(N);
end Distribute on type;
procedure PREPARE(N);
integer N;
begin;
if FUNCTION(N) then begin;
if FORMAL(N) then ERRORMESSAGE(336) else if OUTSIDE DECLARATION(N) then ERRORMESSAGE(337) else N := LOCAL POSITION(N);
end else if SIMPLE(N) ∧ FORMAL(N) then MACRO2(DOS2, N);
NEXT SYMBOL;
end Prepare;
Boolean procedure INTASSIGN(N);
integer N;
begin;
integer M;
Boolean ROUNDED;
if NONINTEGER(N) then ERRORMESSAGE(338);
PREPARE(N);
ROUNDED := FALSE;
if LETTER LAST SYMBOL then begin;
M := IDENTIFIER;
SUBSCRIPTED VARIABLE(M);
if LAST SYMBOL = COLONEQUAL then ROUNDED := INTASSIGN(M) else begin;
FUNCTION DESIGNATOR(M);
ARITHNAME(M);
REST OF ARITHEXP;
end;
end else ARITHEXP;
if SUBSCRVAR(N) then begin;
if FORMAL(N) then MACRO(STFSU) else if ROUNDED then MACRO(SSTSI) else MACRO(STSI);
end else if FORMAL(N) then MACRO2(DOS3, N) else if ROUNDED then MACRO2(SSTI, N) else MACRO2(STI, N);
INTASSIGN := FORMAL(N) ⊃ ROUNDED;
end Intassign;
procedure REALASSIGN(N);
integer N;
begin;
integer M;
if NONREAL(N) then ERRORMESSAGE(339);
PREPARE(N);
if LETTER LAST SYMBOL then begin;
M := IDENTIFIER;
SUBSCRIPTED VARIABLE(M);
if LAST SYMBOL = COLONEQUAL then REALASSIGN(M) else begin;
FUNCTION DESIGNATOR(M);
ARITHNAME(M);
REST OF ARITHEXP;
end;
end else ARITHEXP;
if SUBSCRVAR(N) then begin;
if FORMAL(N) then MACRO(STFSU) else MACRO(STSR);
end else if FORMAL(N) then MACRO2(DOS3, N) else MACRO2(STR, N);
end Realassign;
procedure BOOLASSIGN(N);
integer N;
begin;
integer M;
if NONBOOLEAN(N) then ERRORMESSAGE(340);
PREPARE(N);
if LETTER LAST SYMBOL then begin;
M := IDENTIFIER;
SUBSCRIPTED VARIABLE(M);
if LAST SYMBOL = COLONEQUAL then BOOLASSIGN(M) else begin;
BOOLPRIMREST(M);
REST OF BOOLEXP;
end;
end else BOOLEXP;
if SUBSCRVAR(N) then MACRO(STSB) else if FORMAL(N) then MACRO2(DOS3, N) else MACRO2(8 ≠ TB, N);
end Boolassign;
procedure STRINGASSIGN(N);
integer N;
begin;
integer M;
if NONSTRING(N) then ERRORMESSAGE(341);
PREPARE(N);
if LETTER LAST SYMBOL then begin;
M := IDENTIFIER;
SUBSCRIPTED VARIABLE(M);
if LAST SYMBOL = COLONEQUAL then STRINGASSIGN(M) else STRINGNAME(M);
end else STRINGEXP;
if SUBSCRVAR(N) then MACRO(STSST) else if FORMAL(N) then MACRO2(DOS3, N) else MACRO2(STST, N);
end Stringassign;
integer procedure ARASSIGN(N);
integer N;
begin;
integer TYPE, M;
if NONARITHMETIC(N) then ERRORMESSAGE(342);
PREPARE(N);
TYPE := AR;
if LETTER LAST SYMBOL then begin;
M := IDENTIFIER;
SUBSCRIPTED VARIABLE(M);
if LAST SYMBOL = COLONEQUAL then begin;
if NONARITHMETIC(M) then ERRORMESSAGE(343);
TYPE := DISTRIBUTE ON TYPE(M);
end else begin;
FUNCTION DESIGNATOR(M);
ARITHNAME(M);
REST OF ARITHEXP;
end;
end else ARITHEXP;
if SUBSCRVAR(N) then MACRO(STFSU) else MACRO2(DOS3, N);
ARASSIGN := TYPE;
end Arassign;
integer procedure UNASSIGN(N);
integer N;
begin;
integer TYPE, M;
if NONTYPE(N) then ERRORMESSAGE(344);
PREPARE(N);
if LETTER LAST SYMBOL then begin;
M := IDENTIFIER;
SUBSCRIPTED VARIABLE(M);
if NONTYPE(M) then ERRORMESSAGE(345);
if LAST SYMBOL = COLONEQUAL then TYPE := DISTRIBUTE ON TYPE(M) else EXPREST(TYPE, M);
end else NONDESEXP(TYPE);
if SUBSCRVAR(N) then begin;
if TYPE = BO then MACRO(STSB) else if TYPE = ST then MACRO(STSST) else MACRO(STFSU);
end else MACRO2(DOS3, N);
UNASSIGN := TYPE;
end Unassign;
procedure FUNCTION DESIGNATOR(N);
integer N;
begin;
if PROC(N) then begin;
if NONFUNCTION(N) then ERRORMESSAGE(346);
PROCEDURE CALL(N);
end;
end Function designator;
procedure PROCSTAT(N);
integer N;
begin;
if PROC(N) then begin;
PROCEDURE CALL(N);
if ¬(IN LIBRARY(N) ∨ FUNCTION(N)) then LAST LNC := -N;
if FORMAL(N) ∨ (FUNCTION(N) ∧ STRING(N)) then MACRO(REJST);
end else ERRORMESSAGE(347);
end Procstat;
procedure PROCEDURE CALL(N);
integer N;
begin;
integer NUMBER OF PARAMETERS;
if OPERATOR LIKE(N) then PROCESS OPERATOR(N) else begin;
NUMBER OF PARAMETERS := LIST LENGTH(N);
if NUMBER OF PARAMETERS ≠ 0 then PARAMETER LIST(N, NUMBER OF PARAMETERS) else if FORMAL(N) then MACRO2(DOS, N) else if IN LIBRARY(N) then MACRO2(ISUBJ, N) else MACRO2(SUBJ, N);
end;
end Procedurecall;
integer procedure ORDINAL NUMBER(N);
integer N;
begin;
ORDINAL NUMBER := if FORMAL(N) then 15 else if SUBSCRVAR(N) then (if ARITHMETIC(N) then (if REAL(N) then 8 else 9) else if BOOLEAN(N) then 10 else 11) else if FUNCTION(N) then (if ARITHMETIC(N) then (if REAL(N) then 24 else 25) else if BOOLEAN(N) then 26 else 27) else if PROC(N) then 30 else if ARITHMETIC(N) then (if REAL(N) then 0 else 1) else if BOOLEAN(N) then 2 else if STRING(N) then 3 else 14;
end Ordinal number;
procedure PARAMETER LIST(N, NUMBER OF PARAMETERS);
integer N, NUMBER OF PARAMETERS;
begin;
integer COUNT, M, F, APD, TYPE, FUTURE;
Boolean SIMPLE IDENTIFIER;
integer array DESCRIPTOR LIST[1 : NUMBER OF PARAMETERS];
COUNT := FUTURE := 0;
F := N;
if LAST SYMBOL = OPEN then begin;
NEXT: COUNT := COUNT + 1;
NEXT SYMBOL;
ACTUAL PARAMETER(APD, SIMPLE IDENTIFIER, TYPE, FUTURE);
if COUNT ≤ NUMBER OF PARAMETERS then begin;
DESCRIPTOR LIST[COUNT] := APD;
if ¬FORMAL(N) then begin;
F := NEXT FORMAL IDENTIFIER(F);
if SIMPLE IDENTIFIER then begin;
if SUBSCRVAR(F) then begin;
if NONSUBSCRVAR(TYPE) then ERRORMESSAGE(348);
CHECK TYPE(F, TYPE);
CHECK LIST LENGTH(F, TYPE);
end else if PROC(F) then begin;
if NONPROC(TYPE) then ERRORMESSAGE(349);
CHECK LIST LENGTH(F, TYPE);
if FUNCTION(F) then begin;
if NONFUNCTION(TYPE) then ERRORMESSAGE(350);
CHECK TYPE(F, TYPE);
end;
end else if SIMPLE(F) then begin;
if NONSIMPLE(TYPE) then ERRORMESSAGE(351);
CHECK TYPE(F, TYPE);
end;
end else begin;
if SUBSCRVAR(F) ∨ PROC(F) then ERRORMESSAGE(352);
if ASSIGNED TO(F) ∧ NONASSIGNABLE(APD) then ERRORMESSAGE(353);
if ARITHMETIC(F) ∧ (TYPE = BO ∨ TYPE = ST ∨ TYPE = DES) then ERRORMESSAGE(354) else if BOOLEAN(F) ∧ TYPE ≠ BO ∧ TYPE ≠ NONDES ∧ TYPE ≠ UN then ERRORMESSAGE(355) else if STRING(F) ∧ TYPE ≠ ST ∧ TYPE ≠ NONDES ∧ TYPE ≠ UN then ERRORMESSAGE(356) else if DESIGNATIONAL(F) ∧ TYPE ≠ DES ∧ TYPE ≠ UN then ERRORMESSAGE(357) else if ARBOST(F) ∧ TYPE = DES then ERRORMESSAGE(358);
end;
end;
end else ERRORMESSAGE(359);
if LAST SYMBOL = COMMA then goto NEXT;
if LAST SYMBOL = CLOSE then begin;
NEXT SYMBOL;
if COUNT < NUMBER OF PARAMETERS then ERRORMESSAGE(360);
end else ERRORMESSAGE(361);
end else ERRORMESSAGE(362);
if FUTURE ≠ 0 then SUBSTITUTE(FUTURE);
if FORMAL(N) then MACRO2(DOS, N) else if IN LIBRARY(N) then MACRO2(ISUBJ, N) else MACRO2(SUBJ, N);
M := 0;
NEXT APD: if M < COUNT ∧ M < NUMBER OF PARAMETERS then begin;
M := M + 1;
APD := DESCRIPTOR LIST[M];
MACRO2(CODE, APD);
goto NEXT APD;
end;
end Parameter list;
procedure ACTUAL PARAMETER(APD, SIMPLE IDENTIFIER, TYPE, FUTURE);
integer APD, TYPE, FUTURE;
Boolean SIMPLE IDENTIFIER;
begin;
integer N, BEGIN ADDRESS;
BEGIN ADDRESS := ORDER COUNTER + (if FUTURE = 0 then 1 else 0);
SIMPLE IDENTIFIER := FALSE;
if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
if LAST SYMBOL = COMMA ∨ LAST SYMBOL = CLOSE then begin;
TYPE := N;
SIMPLE IDENTIFIER := TRUE;
if PROC(N) ∧ ¬FORMAL(N) then begin;
if FUTURE = 0 then MACRO2(JU, FUTURE);
MACRO(TFD);
if IN LIBRARY(N) then MACRO2(IJU1, N) else MACRO2(JU1, N);
APD := D20 × ORDINAL NUMBER(N) + BEGIN ADDRESS;
end else if SUBSCRVAR(N) ∧ DESIGNATIONAL(N) ∧ ¬FORMAL(N) then begin;
if FUTURE = 0 then MACRO2(JU, FUTURE);
MACRO2(TSWE, N);
APD := 12 × D20 + BEGIN ADDRESS;
end else APD := D20 × ORDINAL NUMBER(N) + ADDRESS(N) + (if DYNAMIC(N) then DL8 else 0);
end else begin;
START IMPLICIT SUBROUTINE(FUTURE);
if SUBSCRVAR(N) then ADDRESS DESCRIPTION(N);
if (LAST SYMBOL = COMMA ∨ LAST SYMBOL = CLOSE) ∧ (¬DESIGNATIONAL(N)) then begin;
if UNKNOWN(N) then MACRO(SAS);
MACRO2(EXITSV, -2 × DIMENSION);
APD := D20 × (if BOOLEAN(N) then 18 else if STRING(N) then 19 else if FORMAL(N) then 32 else if REAL(N) then 16 else 17) + ORDERCOUNTER;
TYPE := if ARITHMETIC(N) then AR else if BOOLEAN(N) then BO else if STRING(N) then ST else if ARBOST(N) then NONDES else UN;
MACRO2(SUBJ, -BEGIN ADDRESS);
if BOOLEAN(N) then MACRO(TASB) else if STRING(N) then MACRO(TASST) else if FORMAL(N) then MACRO(TASU) else if INTEGER(N) then MACRO(TASI) else MACRO(TASR);
MACRO(DECS);
MACRO2(SUBJ, -BEGIN ADDRESS);
MACRO(FAD);
end else begin;
if SUBSCRVAR(N) then EVALUATION OF(N);
EXPREST(TYPE, N);
MACRO(EXITIS);
APD := MASK[TYPE] + BEGIN ADDRESS;
end;
end;
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if (LAST SYMBOL = COMMA ∨ LAST SYMBOL = CLOSE) ∧ (¬IN NAME LIST) then begin;
TYPE := AR;
APD := NUMBER DESCRIPTOR;
end else begin;
START IMPLICIT SUBROUTINE(FUTURE);
ARITHCONSTANT;
if IN NAME LIST ∧ (¬OPERATOR LAST SYMBOL) then begin;
MACRO2(TLV, INTEGER LABEL);
TYPE := INTLAB;
end else REST OF ARBOOLEXP(TYPE);
MACRO(EXITIS);
APD := MASK[TYPE] + BEGIN ADDRESS;
end;
end else if LAST SYMBOL = PLUS then begin;
NEXT SYMBOL;
if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if LAST SYMBOL = COMMA ∨ LAST SYMBOL = CLOSE then begin;
TYPE := AR;
APD := NUMBER DESCRIPTOR;
end else begin;
START IMPLICIT SUBROUTINE(FUTURE);
ARITHCONSTANT;
REST OF ARBOOLEXP(TYPE);
MACRO(EXITIS);
APD := MASK[TYPE] + BEGIN ADDRESS;
end;
end else begin;
START IMPLICIT SUBROUTINE(FUTURE);
ARBOOLEXP(TYPE);
MACRO(EXITIS);
APD := MASK[TYPE] + BEGIN ADDRESS;
end;
end else if LAST SYMBOL = MINUS then begin;
NEXT SYMBOL;
if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if (LAST SYMBOL = COMMA ∨ LAST SYMBOL = CLOSE) ∧ SMALL then begin;
TYPE := AR;
APD := D20 × 13 + VALUE OF CONSTANT;
end else begin;
START IMPLICIT SUBROUTINE(FUTURE);
ARITHCONSTANT;
NEXT PRIMARY;
NEXT FACTOR;
MACRO(NEG);
REST OF ARBOOLEXP(TYPE);
MACRO(EXITIS);
APD := MASK[TYPE] + BEGIN ADDRESS;
end;
end else begin;
START IMPLICIT SUBROUTINE(FUTURE);
TERM;
MACRO(NEG);
REST OF ARBOOLEXP(TYPE);
MACRO(EXITIS);
APD := MASK[TYPE] + BEGIN ADDRESS;
end;
end else if LAST SYMBOL = TRUE ∨ LAST SYMBOL = FALSE then begin;
TYPE := BO;
N := LAST SYMBOL;
NEXT SYMBOL;
if LAST SYMBOL = COMMA ∨ LAST SYMBOL = CLOSE then APD := D20 × 6 + (if N = TRUE then 0 else 1) else begin;
START IMPLICIT SUBROUTINE(FUTURE);
MACRO2(TBC, N);
REST OF BOOLEXP;
MACRO(EXITIS);
APD := MASK[TYPE] + BEGIN ADDRESS;
end;
end else begin;
START IMPLICIT SUBROUTINE(FUTURE);
EXP(TYPE);
MACRO(EXITIS);
APD := MASK[TYPE] + BEGIN ADDRESS;
end;
end Actual parameter;
procedure START IMPLICIT SUBROUTINE(FUTURE);
integer FUTURE;
begin;
if FUTURE = 0 then MACRO2(JU, FUTURE);
MACRO(ENTRIS);
end Start implicit subroutine;
integer procedure NUMBER DESCRIPTOR;
begin;
NUMBER DESCRIPTOR := if SMALL then D20 × 7 + VALUE OF CONSTANT else D20 × (if REAL NUMBER then 4 else 5) + ADDRESS OF CONSTANT;
end Number descriptor;
procedure PROCESS OPERATOR(N);
integer N;
begin;
integer COUNT;
COUNT := 0;
if LAST SYMBOL = OPEN then begin;
NEXT: NEXT SYMBOL;
ARITHEXP;
COUNT := COUNT + 1;
if LAST SYMBOL = COMMA then begin;
MACRO(STACK);
goto NEXT;
end;
if LAST SYMBOL = CLOSE then NEXT SYMBOL else ERRORMESSAGE(361);
end;
if COUNT ≠ LIST LENGTH(N) then ERRORMESSAGE(363);
MACRO(OPERATOR MACRO(N));
end Process operator;
Boolean procedure NONASSIGNABLE(APD);
integer APD;
begin;
integer RANK;
RANK := APD ÷ D20;
NONASSIGNABIE := (RANK ≠ 15) ∧ (RANK - RANK ÷ 16 × 16) > 3;
end Nonassignable;
procedure LINE;
begin;
if LNC ≠ LAST LNC then LINE1;
end Line;
procedure LINE1;
begin;
if WANTED then begin;
LAST LNC := LNC;
MACRO2(LNC, LNC);
end;
end Line1;
procedure STATEMENT;
begin;
IFSTATEMENT FORBIDDEN := FALSE;
STAT;
end Statement;
procedure UNCONDITIONAL STATEMENT;
begin;
IFSTATEMENT FORBIDDEN := TRUE;
STAT;
end Unconditional statement;
procedure STAT;
begin;
integer N, SAVE LNC;
if LETTER LAST SYMBOL then begin;
SAVE LNC := LINE COUNTER;
N := IDENTIFIER;
if DESIGNATIONAL(N) then begin;
LABEL DECLARATION(N);
STAT;
end else begin;
LNC := SAVE LNC;
LINE;
if SUBSCRVAR(N) ∨ LAST SYMBOL = COLONEQUAL then ASSIGNSTAT(N) else PROCSTAT(N);
end;
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if IN NAME LIST then begin;
LABEL DECLARATION(INTEGER LABEL);
STAT;
end else ERRORMESSAGE(364);
end else begin;
if LAST SYMBOL = GOTO then begin;
LNC := LINE COUNTER;
LINE;
GOTOSTAT;
end else if LAST SYMBOL = BEGIN then begin;
SAVE LNC := LINE COUNTER;
NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then begin;
LNC := SAVE LNC;
LINE;
BLOCK;
end else COMPOUND TAIL;
NEXT SYMBOL;
end else if LAST SYMBOL = IF then begin;
if IFSTATEMENT FORBIDDEN then ERRORMESSAGE(365);
INC := LINE COUNTER;
LINE;
IFSTAT;
end else if LAST SYMBOL = FOR then begin;
LNC := LINE COUNTER;
LINE;
FORSTAT;
if LAST SYMBOL = ELSE then ERRORMESSAGE(366);
end;
end;
end Stat;
procedure GOTOSTAT;
begin;
integer N;
NEXT SYMBOL;
if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
SUBSCRIPTED VARIABLE(N);
if LOCAL LABEL(N) then begin;
TEST FORCOUNT(N);
MACRO2(JU, N);
end else begin;
DESIGNAME(N);
MACRO(JUA);
end;
end else begin;
DESIGEXP;
MACRO(JUA);
end;
end Gotostat;
procedure COMPOUND TAIL;
begin;
STATEMENT;
if LAST SYMBOL ≠ SEMICOLON ∧ LAST SYMBOL ≠ END then begin;
ERRORMESSAGE(367);
SKIP REST OF STATEMENT(STATEMENT);
end;
if LAST SYMBOL = SEMI COLON then begin;
NEXT SYMBOL;
COMPOUND TAIL;
end;
end Compound tail;
procedure IFSTAT;
begin;
integer FUTURE1, FUTURE2, SAVE LNC, LAST LNC1;
FUTURE1 := FUTURE2 := 0;
SAVE LNC := LINE COUNTER;
NEXT SYMBOL;
BOOLEXP;
MACRO2(COJU, FUTURE1);
if LAST SYMBOL = THEN then NEXT SYMBOL else ERRORMESSAGE(368);
UNCONDITIONAL STATEMENT;
if LAST SYMBOL = ELSE then begin;
MACRO2(JU, FUTURE2);
SUBSTITUTE(FUTURE1);
LAST LNC1 := LAST LNC;
LAST LNC := SAVE LNC;
NEXT SYMBOL;
STATEMENT;
SUBSTITUTE(FUTURE2);
if LAST LNC > LAST LNC1 then LAST LNC := LAST LNC1;
end else begin;
SUBSTITUTE(FUTURE1);
if LAST LNC > SAVE LNC then LAST LNC := SAVE LNC;
end;
end Ifstat;
procedure FORSTAT;
begin;
integer FUTURE, SAVE LNC;
SAVE INC := LINE COUNTER;
L0 := 0;
NEXT SYMBOL;
FOR LIST;
FUTURE := 0;
MACRO2(JU, FUTURE);
if L0 ≠ 0 then SUBSTITUTE(L0);
if LAST SYMBOL = DO then NEXT SYMOOL else ERRORMESSAGE(369);
INCREASE STATUS(INCREMENT);
FORCOUNT := FORCOUNT + 1;
STATEMENT;
INCREASE STATUS(-INCREMENT);
FORCOUNT := FORCOUNT - 1;
if LAST LNC < 0 ∨ LNC ≠ SAVE LNC then begin;
LNC := SAVE LNC;
LINE1;
end;
MACRO2(IJU, STATUS);
SUBSTITUTE(FUTURE);
end Forstat;
procedure STORE PREPARATION;
begin;
if SUBSCRVAR(CONTROLLED VARIABLE) then MACRO2(SUBJ, -12) else if FORMAL(CONTROLLED VARIABLE) then MACRO2(DOS2, CONTROLLED VARIABLE);
end Store preparation;
procedure STORE MACRO;
begin;
if SUBSCRVAR(CONTROLLED VARIABLE) then begin;
if FORMAL(CONTROLLED VARIABLE) then MACRO(STFSU) else if INTEGER(CONTROLLED VARIABLE) then MACRO(STSI) else MACRO(STSR);
MACRO2(DECB, 2);
end else if FORMAL(CONTROLLED VARIABLE) then MACRO2(DOS3, CONTROLLED VARIABLE) else if INTEGER(CONTROLLED VARIABLE) then MACRO2(STI, CONTROLLED VARIABLE) else MACRO2(STR, CONTROLLED VARIABLE);
end Store macro;
procedure TAKE MACRO;
begin;
if SUBSCRVAR(CONTROLLED VARIABLE) then MACRO2(SUBJ, -L1) else ARITHNAME(CONTROLLED VARIABLE);
end Take macro;
procedure FOR LIST;
begin;
if LETTER LAST SYMBOL then begin;
CONTROLLED VARIABLE := IDENTIFIER;
if NONARITHMETIC(CONTROLLED VARIABLE) then ERRORMESSAGE(370);
if SUBSCRVAR(CONTROLLED VARIABLE) then begin;
L3 := 0;
MACRO2(JU, L3);
L4 := ORDER COUNTER;
ADDRESS DESCRIPTION(CONTROLLED VARIABLE);
MACRO2(EXITSV, 1 - 2 × DIMENSION);
L1 := ORDER COUNTER;
MACRO2(SUBJ, -L4);
if FORMAL(CONTROLLED VARIABLE) then MACRO(TSCVU) else if INTEGER(CONTROLLED VARIABLE) then MACRO(TISCV) else MACRO(TRSCV);
L2 := ORDER COUNTER;
MACRO2(SUBJ, -L4);
MACRO(FADCV);
SUBSTITUTE(L3);
end else if FUNCTION(CONTROLLED VARIABLE) then ERRORMESSAGE(371);
if LAST SYMBOL ≠ COLONEQUAL then ERRORMESSAGE(372);
LIST: L3 := ORDER COUNTER;
MACRO2(TSIC, 0);
MACRO2(SSTI, STATUS);
L4 := ORDER COUNTER;
STORE PREPARATION;
NEXT SYMBOL;
ARITHEXP;
if LAST SYMBOL = COMMA ∨ LAST SYMBOL = DO then begin;
STORE MACRO;
MACRO2(JU, L0);
SUBSTITUTE(L3);
end else if LAST SYMBOL = WHILE then begin;
STORE MACRO;
NEXT SYMBOL;
BOOLEXP;
MACRO2(YCOJU, L0);
SUBST2(L4, L3);
end else if LAST SYMBOL = STEP then begin;
L5 := 0;
MACRO2(JU, L5);
L4 := ORDER COUNTER;
NEXT SYMBOL;
COMPLICATED := FALSE;
ARITHEXP;
COMPLEX STEP ELEMENT := COMPLICATED ∨ ORDER COUNTER > L4 + 1;
if COMPLEX STEP ELEMENT then MACRO(EXIT);
SUBSTITUTE(L3);
STORE PREPARATION;
TAKE MACRO;
MACRO(STACK);
if COMPLEX STEP ELEMENT then MACRO2(SUBJ, -L4) else MACRO2(DO, L4);
MACRO(ADD);
SUBSTITUTE(15);
STORE MACRO;
if SUBSCRVAR(CONTROLLED VARIABLE) ∨ FORMAL(CONTROLLED VARIABLE) then TAKE MACRO;
MACRO(STACK);
if LAST SYMBOL = UNTIL then begin;
NEXT SYMBOL;
ARITHEXP;
end else ERRORMESSAGE(373);
MACRO(TEST1);
if COMPLEX STEP ELEMENT then MACRO2(SUBJ, -L4) else MACRO2(DO, L4);
MACRO(TEST2);
MACRO2(YCOJU, L0);
end else ERRORMESSAGE(374);
if LAST SYMBOL = COMMA then goto LIST;
end else ERRORMESSAGE(375);
end For list;
procedure SWITCH DECLARATION;
begin;
integer M;
NEXT SYMBOL;
if LETTER LAST SYMBOL then begin;
SWITCH IDENTIFIER := IDENTIFIER;
NUMBER OF SWITCH ELEMENTS := LIST LENGTH(SWITCH IDENTIFIER);
if LAST SYMBOL = COLONEQUAL then begin;
integer array SWORD LIST[1 : NUMBER OF SWITCH ELEMENTS];
SWITCH LIST COUNT := 0;
IN SWITCH DECLARATION := TRUE;
NEXT: SWITCH LIST COUNT := SWITCH LIST COUNT + 1;
NEXT SYMBOL;
if LETTER LAST SYMBOL then begin;
M := IDENTIFIER;
if NONDESIGNATIONAL(M) then ERRORMESSAGE(376);
if SUBSCRVAR(M) then begin;
SWORD := -45613055 + ORDER COUNTER;
SUBSCRIPTED VARIABLE(M);
MACRO(EXIT);
end else SWORD := (if FORMAL(M) then -33685503 else 4718592 + (if DYNAMIC(M) then FUNCTION DIGIT else 0)) + ADDRESS(M);
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if IN NAME LIST then SWORD := 4718592 + (if DYNAMIC(INTEGER LABEL) then FUNCTION DIGIT else 0) + ADDRESS(INTEGER LABEL) else ERRORMESSAGE(377);
end else begin;
SWORD := -45613055 + ORDER COUNTER;
DESIGEXP;
MACRO(EXIT);
end;
if SWITCH LIST COUNT > NUMBER OF SWITCH ELEMENTS then ERRORMESSAGE(378);
SWORD LIST[SWITCH LIST COUNT] := SWORD;
if LAST SYMBOL = COMMA then goto NEXT;
if SWITCH LIST COUNT < NUMBER OF SWITCH ELEMENTS then ERRORMESSAGE(379);
MARK POSITION IN NAME LIST(SWITCH IDENTIFIER);
IN SWITCH DECLARATION := FALSE;
MACRO2(CODE, NUMBER OF SWITCH ELEMENTS);
M := 0;
NEXT SWORD: if M < SWITCH LIST COUNT ∧ M < NUMBER OF SWITCH ELEMENTS then begin;
M := M + 1;
SWORD := SWORD LIST[M];
MACRO2(CODE, SWORD);
goto NEXT SWORD;
end;
end else ERRORMESSAGE(380);
end else ERRORMESSAGE(381);
end Switch declaration;
procedure ARRAY DECLARATION;
begin;
integer N, COUNT;
NEXT SYMBOL;
LNC := LINE COUNTER;
LINE;
N := IDENTIFIER;
DIMENSION := LIST LENGTH(N);
COUNT := 1;
NEXT: if LAST SYMBOL = COMMA then begin;
NEXT SYMBOL;
IDENTIFIER;
COUNT := COUNT + 1;
goto NEXT;
end;
if LAST SYMBOL = SUB then begin;
IN ARRAY DECLARATION := TRUE;
BOUND PAIR LIST;
IN ARRAY DECLARATION := FALSE;
end else ERRORMESSAGE(382);
MACRO2(TNA, COUNT);
MACRO2(TDA, DIMENSION);
MACRO2(TAA, N);
MACRO(ARR DECLA MACRO);
if LAST SYMBOL = COMMA then ARRAY DECLARATION;
end Array declaration;
procedure BOUND PAIR LIST;
begin;
NEXT SYMBOL;
ARITHEXP;
MACRO(STACK);
if LAST SYMBOL = COLON then begin;
NEXT SYMBOL;
ARITHEXP;
MACRO(STACK);
end else ERRORMESSAGE(383);
if LAST SYMBOL = COMMA then BOUND PAIR LIST else if LAST SYMBOL = BUS then NEXT SYMBOL else ERRORMESSAGE(384);
end Bound pair list;
procedure PROCEDURE DECLARATION;
begin;
integer N, F, COUNT, SAVE LNC;
NEXT SYMBOL;
F := N := IDENTIFIER;
SKIP PARAMETER LIST;
SKIP VALUE LIST;
SKIP SPECIFICATION LIST;
if ¬IN LIBRARY(N) then MARK POSITION IN NAME LIST(N);
if IN CODE(N) then TRANSLATE CODE else begin;
if FUNCTION(N) then SET INSIDE DECLARATION(N, TRUE);
ENTRANCE BLOCK;
MACRO2(DPTR, DISPLAY LEVEL);
MACRO2(INCRB, TOP OF DISPLAY);
for COUNT := LIST LENGTH(N) step -1 until 1 do
begin;
F := NEXT FORMAL IDENTIFIER(F);
if IN VALUE LIST(F) then begin;
if SUBSCRVAR(F) then MACRO(CEN) else begin;
if ARITHMETIC(F) then begin;
if INTEGER(F) then MACRO(CIV) else MACRO(CRV);
end else if BOOLEAN(F) then MACRO(CBV) else if STRING(F) then MACRO(CSTV) else MACRO(CLV);
end;
end else if ASSIGNED TO(F) then MACRO(CLPN) else MACRO(CEN);
end;
MACRO2(TDL, DISPLAY LEVEL);
MACRO2(ENTRPB, LOCAL SPACE);
LABEL LIST;
F := N;
for COUNT := LIST LENGTH(N) step -1 until 1 do
begin;
F := NEXT FORMAL IDENTIFIER(F);
if IN VALUE LIST(F) ∧ SUBSCRVAR(F) then begin;
MACRO2(TAA, F);
if INTEGER(F) then MACRO(TIAV) else MACRO(TAV);
end;
end;
SAVE LNC := LAST LNC;
LAST LNC := -LINE COUNTER;
SAVE AND RESTORE LNC(SLNC, N);
if LAST SYMBOL = BEGIN then begin;
NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then DECLARATION LIST;
COMPOUND TAIL;
NEXT SYMBOL;
end else STATEMENT;
LNC := LAST LNC := SAVE LNC;
if FUNCTION(N) then begin;
SET INSIDE DECLARATION(N, FALSE);
F := LOCAL POSITION(N);
if ARITHMETIC(F) then ARITHNAME(F) else if BOOLEAN(F) then BOOLNAME(F) else begin;
STRINGNAME(F);
MACRO(LOS);
end;
end;
SAVE AND RESTORE LNC(RLNC, N);
if USE OF COUNTER STACK then MACRO(EXITPC) else MACRO(EXITP);
EXIT BLOCK;
end;
end Procedure declaration;
procedure SAVE AND RESTORE LNC(MACRO, N);
integer MACRO, N;
begin;
if WANTED ∧ FUNCTION(N) then MACRO2(MACRO, LOCAL POSITION1(N));
end Save and restore lnc;
procedure BLOCK;
begin;
ENTRANCE BLOCK;
MACRO2(TBL, DISPLAY LEVEL);
MACRO2(ENTRB, LOCAL SPACE);
LABEL LIST;
DECLARATION LIST;
COMPOUND TAIL;
if USE OF COUNTER STACK then MACRO2(EXITC, DISPLAY LEVEL) else MACRO2(EXITB, DISPLAY LEVEL);
EXIT BLOCK;
end Block;
procedure DECLARATION LIST;
begin;
integer FUTURE, ARR DEC;
FUTURE := ARR DEC := 0;
NEXT: if TYPE DECLARATOR LAST SYMBOL then SKIP TYPE DECLARATION else if ARR DECLARATOR LAST SYMBOL then begin;
if FUTURE ≠ 0 then begin;
SUBSTITUTE(FUTURE);
FUTURE := 0;
end;
ARR DEC := 1;
ARRAY DECLARATION;
end else begin;
if FUTURE = 0 then MACRO2(JU, FUTURE);
if LAST SYMBOL = SWITCH then SWITCH DECLARATION else PROCEDURE DECLARATION;
end;
if LAST SYMBOL = SEMICOLON then NEXT SYMBOL else ERRORMESSAGE(385);
if DECLARATOR LAST SYMBOL then goto NEXT;
if FUTURE ≠ 0 then SUBSTITUTE(FUTURE);
if ARR DEC ≠ 0 then MACRO2(SWP, DISPLAY LEVEL);
end Declaration list;
procedure LABEL LIST;
begin;
integer N, COUNT;
COUNT := NUMBER OF LOCAL LABELS;
if COUNT > 0 then begin;
MACRO2(DECB, 2 × COUNT);
MACRO2(LAD, DISPLAY LEVEL);
N := 0;
for COUNT := COUNT step -1 until 1 do
begin;
NEXT: N := NEXT LOCAL LABEL(N);
if SUPER LOCAL(N) then goto NEXT;
if COUNT = 1 then MACRO2(LAST, N) else MACRO2(NIL, N);
end;
end;
end Label list;
procedure PROGRAM;
begin;
integer N;
if LETTER LAST SYMBOL then begin;
N := IDENTIFIER;
if LAST SYMBOL = COLON then LABEL DECLARATION(N);
PROGRAM;
end else if DIGIT LAST SYMBOL then begin;
UNSIGNED NUMBER;
if IN NAME LIST ∧ LAST SYMBOL = COLON then LABEL DECLARATION(INTEGER LABEL);
PROGRAM;
end else if LAST SYMBOL = BEGIN then begin;
NEXT SYMBOL;
if DECLARATOR LAST SYMBOL then BLOCK else COMPOUND TAIL;
MACRO(END);
end else begin;
NEXT SYMBOL;
PROGRAM;
end;
end Program;
procedure LABEL DECLARATION(N);
integer N;
begin;
LAST LNC := -LINE COUNTER;
if SUBSCRVAR(N) then begin;
ERRORMESSAGE(388);
SUBSCRIPTED VARIABLE(N);
end else MARK POSITION IN NAME LIST(N);
if LAST SYMBOL = COLON then NEXT SYMBOL else ERRORMESSAGE(389);
end Label declaration;
procedure SUBSTITUTE(ADDRESS);
integer ADDRESS;
begin;
SUBST2(ORDER COUNTER, ADDRESS);
end Substitute;
procedure SUBST2(ADDRESS1, ADDRESS2);
value ADDRESS1, ADDRESS2;
integer ADDRESS1, ADDRESS2;
begin;
integer INSTRUCTION, INSTRUCT PART, ADDRESS PART;
ADDRESS2 := ABS(ADDRESS2);
INSTRUCTION := SPACE[PROG BASE + ADDRESS2];
INSTRUCT PART := INSTRUCTION ÷ D15 × D15 - (if INSTRUCTION < 0 then 32767 else 0);
ADDRESS PART := INSTRUCTION - INSTRUCT PART;
SPACE[PROG BASE + ADDRESS2] := INSTRUCT PART + ADDRESS1;
if ADDRESS PART = 0 then begin;
if INSTRUCT PART = END OF LIST then SPACE[PROG BASE + ADDRESS2] := -SPACE[PROG BASE + ADDRESS2];
end else SUBST2(ADDRESS1, ADDRESS PART);
end Subst2;
integer procedure ORDER COUNTER;
begin;
MACRO(EMPTY);
ORDER COUNTER := INSTRUCT COUNTER;
end Order counter;
procedure MACRO(MACRO NUMBER);
integer MACRO NUMBER;
begin;
MACRO2(MACRO NUMBER, PARAMETER);
end Macro;
procedure MACRO2(MACRO NUMBER, METAPARAMETER);
integer MACRO NUMBER, METAPARAMETER;
begin;
MACRO := if MACRO NUMBER < 512 then MACRO LIST[MACRO NUMBER] else MACRO NUMBER;
PARAMETER := METAPARAMETER;
if STATE = 0 then begin;
if MACRO = STACK then STATE := 1 else if SIMPLE ARITHMETIC TAKE MACRO then LOAD(3) else PRODUCE(MACRO, PARAMETER);
end else if STATE = 1 then begin;
LOAD(2);
if ¬SIMPLE ARITHMETIC TAKE MACRO then begin;
PRODUCE(STACK, PARAMETER);
UNLOAD;
end;
end else if STATE = 2 then begin;
if OPTIMIZABLE OPERATOR then OPTIMIZE else begin;
PRODUCE(STACK, PARAMETER);
STATE := 3;
MACRO2(MACRO, PARAMETER);
end;
end else if STATE = 3 then begin;
if MACRO = NEG then OPTIMIZE else begin;
UNLOAD;
MACRO2(MACRO, PARAMETER);
end;
end;
if FORWARD JUMPING MACRO ∧ METAPARAMETER ≤ 0 then ASSIGN(METAPARAMETER);
end Macro2;
procedure LOAD(STATE I);
integer STATE I;
begin;
STACK0 := MACRO;
STACK1 := PARAMETER;
STATE := STATE I;
end Load;
procedure UNLOAD;
begin;
PRODUCE(STACK0, STACK1);
STATE := 0;
end Unload;
procedure OPTIMIZE;
begin;
STACK0 := TABEL[5 × OPT NUMBER(MACRO) + OPT NUMBER(STACK0)];
UNLOAD;
end Optimize;
procedure ASSIGN(METAPARAMETER);
integer METAPARAMETER;
begin;
METAPARAMETER := -(INSTRUCT COUNTER - 1);
end Assign;
procedure PRODUCE(MACRO, PARAMETER);
integer MACRO, PARAMETER;
begin;
integer NUMBER, PAR NUMBER, ENTRY, COUNT;
if MACRO = EMPTY then else if MACRO = CODE then begin;
SPACE[PROG BASE + INSTRUCT COUNTER] := PARAMETER;
INSTRUCT COUNTER := INSTRUCT COUNTER + 1;
TEST POINTERS;
end else begin;
NUMBER := INSTRUCT NUMBER(MACRO);
PAR NUMBER := PAR PART(MACRO);
ENTRY := INSTRUCT PART(MACRO) - 1;
if PAR NUMBER > 0 then PROCESS PARAMETER(MACRO, PARAMETER);
PROCESS STACK POINTER(MACRO);
for COUNT := 1 step 1 until NUMBER do
PRODUCE(CODE, INSTRUCT LIST[ENTRY + COUNT] + (if COUNT = PAR NUMBER then PARAMETER else 0));
end;
end Produce;
procedure PROCESS STACK POINTER(MACRO);
integer MACRO;
begin;
if ¬IN CODE BODY then begin;
integer REACTION;
REACTION := B REACTION(MACRO);
if REACTION < 9 then begin;
B := B + REACTION - 4;
if B > MAX DEPTH then MAX DEPTH := B;
end else if REACTION = 10 then B := 0 else if REACTION = 11 then B := B - 2 × (DIMENSION - 1) else if REACTION = 12 then begin;
if ECOUNT = 0 then begin;
RET LEVEL := B;
RET MAX DEPTH := MAX DEPTH;
B := 0;
MAX DEPTH := MAX DEPTH ISR;
end;
ECOUNT := ECOUNT + 1;
end else if REACTION = 13 then begin;
if MACRO = EXITSV then begin;
if B > MAX DEPTH ISR then MAX DEPTH ISR := B;
B := B - 2 × (DIMENSION - 1);
end;
if ECOUNT = 1 then begin;
if MAX DEPTH > MAX DEPTH ISR then MAX DEPTH ISR := MAX DEPTH;
B := RET LEVEL;
MAX DEPTH := RET MAX DEPTH;
end;
if ECOUNT > 0 then ECOUNT := ECOUNT - 1;
end else if REACTION = 14 then begin;
B := DISPLAY LEVEL + TOP OF DISPLAY;
if B > MAX DISPLAY LENGTH then MAX DISPLAY LENGTH := B;
RET MAX DEPTH := MAX DEPTH;
end else if REACTION = 15 then begin;
if B > MAX PROC LEVEL then MAX PROC LEVEL := B;
B := 0;
MAX DEPTH := RET MAX DEPTH;
end;
end;
end Process stack pointer;
procedure PROCESS PARAMETER(MACRO, PARAMETER);
integer MACRO, PARAMETER;
begin;
if VALUE LIKE(MACRO) then begin;
if MACRO = TBC then PARAMETER := if PARAMETER = TRUE then 0 else 1 else if MACRO = SWP then PARAMETER := D9 × PARAMETER else if MACRO ≠ EXITSV then PARAMETER := ABS(PARAMETER);
end else begin;
if MACRO = JU ∨ MACRO = SUBJ ∨ MACRO = NIL ∨ MACRO = LAST then begin;
if PARAMETER ≤ 0 then PARAMETER := -PARAMETER else PARAMETER := PROGRAM ADDRESS(PARAMETER);
end else PARAMETER := ADDRESS(PARAMETER) + (if DYNAMIC(PARAMETER) then (if MACRO = TLV ∨ MACRO = TAA then FUNCTION DIGIT else if MACRO = STST then FUNCTION LETTER else C VARIANT) else 0);
end;
end Process parameter;
Boolean procedure SIMPLE ARITHMETIC TAKE MACRO;
begin;
SIMPLE ARITHMETIC TAKE MACRO := BIT STRING(D1, D0, MACRO) = 1;
end Simple arithmetic take macro;
Boolean procedure OPTIMIZABLE OPERATOR;
begin;
OPTIMIZABLE OPERATOR := BIT STRING(D2, D1, MACRO) = 1;
end Optimizable operator;
Boolean procedure FORWARD JUMPING MACRO;
begin;
FORWARD JUMPING MACRO := BIT STRING(D3, D2, MACRO) = 1;
end Forward jumping macro;
Boolean procedure VALUE LIKE(MACRO);
integer MACRO;
begin;
VALUE LIKE := BIT STRING(D4, D3, MACRO) = 1;
end Value like;
integer procedure OPT NUMBER(MACRO);
integer MACRO;
begin;
OPT NUMBER := BIT STRING(D8, D4, MACRO);
end Opt number;
integer procedure INSTRUCT NUMBER(MACRO);
integer MACRO;
begin;
INSTRUCT NUMBER := BIT STRING(D10, D8, MACRO);
end Instruct number;
integer procedure PAR PART(MACRO);
integer MACRO;
begin;
PAR PART := BIT STRING(D12, D10, MACRO);
end Par part;
integer procedure INSTRUCT PART(MACRO);
integer MACRO;
begin;
INSTRUCT PART := BIT STRING(D21, D12, MACRO);
end Instruct part;
integer procedure B REACTION(MACRO);
integer MACRO;
begin;
B REACTION := MACRO ÷ D21;
end B reaction;
integer procedure CODE BITS(N);
integer N;
begin;
CODE BITS := SPACE[NL BASE - N] ÷ D19;
end Code bits;
integer procedure CHARACTER(N);
integer N;
begin;
CHARACTER := BIT STRING(D24, D19, SPACE[NL BASE - N]);
end Character;
Boolean procedure ARITHMETIC(N);
integer N;
begin;
integer I;
I := TYPE BITS(N);
ARITHMETIC := CHARACTER(N) ≠ 24 ∧ (I < 2 ∨ I = 4);
end Arithmetic;
Boolean procedure REAL(N);
integer N;
begin;
REAL := CHARACTER(N) ≠ 24 ∧ TYPE BITS(N) = 0;
end Real;
Boolean procedure INTEGER(N);
integer N;
begin;
INTEGER := TYPE BITS(N) = 1;
end Integer;
Boolean procedure BOOLEAN(N);
integer N;
begin;
BOOLEAN := TYPE BITS(N) = 2;
end Boolean;
Boolean procedure STRING(N);
integer N;
begin;
STRING := TYPE BITS(N) = 3;
end String;
Boolean procedure DESIGNATIONAL(N);
integer N;
begin;
DESIGNATIONAL := TYPE BITS(N) = 6;
end Designational;
Boolean procedure ARBOST(N);
integer N;
begin;
ARBOST := CHARACTER(N) ≠ 24 ∧ TYPE BITS(N) < 6;
end Arbost;
Boolean procedure UNKNOWN(N);
integer N;
begin;
UNKNOWN := TYPE BITS(N) = 7;
end Unknown;
Boolean procedure NONARITHMETIC(N);
integer N;
begin;
integer I;
I := TYPE BITS(N);
NONARITHMETIC := CHARACTER(N) = 24 ∨ I = 2 ∨ I = 3 ∨ I = 6;
end Nonarithmetic;
Boolean procedure NONREAL(N);
integer N;
begin;
NONREAL := NONARITHMETIC(N) ∨ TYPE BITS(N) = 1;
end Nonreal;
Boolean procedure NONINTEGER(N);
integer N;
begin;
NONINTEGER := NONARITHMETIC(N) ∨ TYPE BITS(N) = 0;
end Noninteger;
Boolean procedure NONBOOLEAN(N);
integer N;
begin;
integer I;
I := TYPE BITS(N);
NONBOOLEAN := I ≠ 2 ∧ I ≠ 5 ∧ I ≠ 7;
end Nonboolean;
Boolean procedure NONSTRING(N);
integer N;
begin;
integer I;
I := TYPE BITS(N);
NONSTRING := I ≠ 3 ∧ I ≠ 5 ∧ I ≠ 7;
end Nonstring;
Boolean procedure NONDESIGNATIONAL(N);
integer N;
begin;
NONDESIGNATIONAL := TYPE BITS(N) < 6;
end Nondesignational;
Boolean procedure NONTYPE(N);
integer N;
begin;
NONTYPE := TYPE BITS(N) = 6 ∨ (PROC(N) ∧ NONFUNCTION(N));
end Nontype;
Boolean procedure SIMPLE(N);
integer N;
begin;
SIMPLE := CODE BITS(N) = 127 ∨ SIMPLE1(N);
end Simple;
Boolean procedure SIMPLE1(N);
integer N;
begin;
SIMPLE1 := CHARACTER(N) ÷ D3 = 0;
end Simple1;
Boolean procedure SUBSCRVAR(N);
integer N;
begin;
SUBSCRVAR := CHARACTER(N) ÷ D3 = 1;
end Subscrvar;
Boolean procedure PROC(N);
integer N;
begin;
PROC := CHARACTER(N) ÷ D3 > 1 ∧ CODE BITS(N) ≠ 127;
end Proc;
Boolean procedure FUNCTION(N);
integer N;
begin;
FUNCTION := CHARACTER(N) ÷ D3 = 2;
end Function;
Boolean procedure NONSIMPLE(N);
integer N;
begin;
NONSIMPLE := ¬(SIMPLE(N) ∨ (if PROC(N) then (FORMAL(N) ∨ FUNCTION(N)) ∧ LIST LENGTH(N) < 1 else FALSE));
end Nonsirnple;
Boolean procedure NONSUBSCRVAR(N);
integer N;
begin;
NONSUBSCRVAR := SIMPLE1(N) ∨ PROC(N);
end Nonsubscrvar;
Boolean procedure NONPROC(N);
integer N;
begin;
NONPROC := ¬(CHARACTER(N) ÷ D3 ≥ 2 ∨ (FORMAL(N) ∧ SIMPLE1(N) ∧ ¬ASSIGNED TO(N)));
end Nonproc;
Boolean procedure NONFUNCTION(N);
integer N;
begin;
NONFUNCTION := ¬(FUNCTION(N) ∨ FORMAL(N));
end Nonfunction;
Boolean procedure FORMAL(N);
integer N;
begin;
FORMAL := CODE BITS(N) > 95;
end Formal;
Boolean procedure IN VALUE LIST(N);
integer N;
begin;
IN VALUE LIST := CODE BITS(N) > 63 ∧ ¬FORMAL(N);
end In value list;
Boolean procedure ASSIGNED TO(N);
integer N;
begin;
ASSIGNED TO := BIT STRING(D19, D18, SPACE[NL BASE - N]) = 1;
end Assigned to;
Boolean procedure DYNAMIC(N);
integer N;
begin;
DYNAMIC := CODE BITS(N) > 63 ∨ ASSIGNED TO(N);
end Dynamic;
Boolean procedure IN LIBRARY(N);
integer N;
begin;
IN LIBRARY := SPACE[NL BASE - N - 1] > D25;
end In library;
Boolean procedure ID1(K, N);
integer K, N;
begin;
ID1 := BIT STRING(2 × K, K, SPACE[NL BASE - N - 1]) = 1;
end Id1;
Boolean procedure OPERATOR LIKE(N);
integer N;
begin;
OPERATOR LIKE := ID1(D23, N);
end Operator like;
Boolean procedure OUTSIDE DECLARATION(N);
integer N;
begin;
OUTSIDE DECLARATION := ID1(D22, N);
end Outside declaration;
Boolean procedure ASS TO FUNCTION DESIGNATOR(N);
integer N;
begin;
ASS TO FUNCTION DESIGNATOR := ID1(D21, N);
end Ass to function designator;
Boolean procedure DECLARED(N);
integer N;
begin;
DECLARED := ID1(D19, N);
end Declared;
Boolean procedure SUPER LOCAL(N);
integer N;
begin;
SUPER LOCAL := ID1(D18, N);
end Super local;
procedure CHANGE(K, N);
integer K, N;
begin;
integer I, J;
I := SPACE[NL BASE - N - 1];
J := I - I ÷ (2 × K) × (2 × K);
SPACE[NL BASE - N - 1] := I + (if J < K then K else -K);
end Change;
integer procedure LOCAL POSITION(N);
integer N;
begin;
if ¬ASS TO FUNCTION DESIGNATOR(N) then CHANGE(D21, N);
LOCAL POSITION := LOCAL POSITION1(N);
end Local position;
integer procedure LOCAL POSITION1(N);
integer N;
begin;
LOCAL POSITION1 := N + 2;
end Local position1;
procedure SET INSIDE DECLARATION(N, BOOL);
integer N;
Boolean BOOL;
begin;
CHANGE(D22, N);
if ¬(BOOL ∨ ASS TO FUNCTION DESIGNATOR(N)) then ERRORMESSAGE(390);
end Set inside declaration;
procedure MARK POSITION IN NAME LIST(N);
integer N;
begin;
integer ADDRESS;
if DECLARED(N) then ERRORMESSAGE(391) else begin;
ADDRESS := PROGRAM ADDRESS(N);
if ADDRESS ≠ 0 then SUBSTITUTE(ADDRESS);
CHANGE(D19, N);
end;
end Mark position in name list;
integer procedure PROGRAM ADDRESS(N);
integer N;
begin;
integer WORD, HEAD, M;
M := if CODE BITS(N) = 6 then N + 1 else N;
WORD := SPACE[NL BASE - M];
HEAD := WORD ÷ D18 × D18;
if ¬DECLARED(N) then SPACE[NL BASE - M] := HEAD + ORDER COUNTER;
PROGRAM ADDRESS := WORD - HEAD;
end Program address;
integer procedure ADDRESS(N);
integer N;
begin;
integer WORD, TAIL, LEVEL;
WORD := CODE BITS(N);
if WORD > 13 ∧ WORD < 25 then TAIL := PROGRAM ADDRESS(N) else begin;
WORD := SPACE[NL BASE - N];
TAIL := WORD - WORD ÷ D18 × D18;
if DYNAMIC(N) then begin;
LEVEL := TAIL ÷ D9;
if LEVEL = PROC LEVEL ∧ ¬IN SWITCH DECLARATION then TAIL := TAIL + D9 × (63 - LEVEL);
end;
end;
ADDRESS := TAIL;
end Address;
integer procedure LIST LENGTH(N);
integer N;
begin;
LIST LENGTH := BIT STRING(D18, D0, SPACE[NL BASE - N - 1]) - 1;
end List length;
procedure TEST FORCOUNT(N);
integer N;
begin;
if SPACE[NL BASE - N - 1] ÷ D20 > FOR COUNT then ERRORMESSAGE(392);
end Test forcount;
procedure CHECK DIMENSION(N);
integer N;
begin;
integer I;
I := if CODE BITS(N) = 14 then 1 else LIST LENGTH(N);
if I ≥ 0 ∧ I ≠ DIMENSION then ERRORMESSAGE(393);
end Check dimension;
procedure CHECK LIST LENGTH(F, N);
integer F, N;
begin;
integer I, J;
I := LIST LENGTH(F);
J := if CODE BITS(N) = 14 then 1 else LIST LENGTH(N);
if I ≥ 0 ∧ J ≥ 0 ∧ I ≠ J then ERRORMESSAGE(394);
end Check list length;
procedure CHECK TYPE(F, N);
integer F, N;
begin;
if (DESIGNATIONAL(F) ∧ NONDESIGNATIONAL(N)) ∨ (ARBOST(F) ∧ NONTYPE(N)) ∨ (ARITHMETIC(F) ∧ NONARITHMETIC(N)) ∨ (BOOLEAN(F) ∧ NONBOOLEAN(N)) ∨ (STRING(F) ∧ NONSTRING(N)) then ERRORMESSAGE(395);
end Check type;
integer procedure NUMBER OF LOCAL LABELS;
begin;
NUMBER OF LOCAL LABELS := BIT STRING(D13, D0, SPACE[NL BASE - BLOCK CELL POINTER - 3]);
end Number of local labels;
integer procedure NEXT LOCAL LABEL(N);
integer N;
begin;
NEXT LOCAL LABEL := if N = 0 then SPACE[NL BASE - BLOCK CELL POINTER - 3] ÷ DL3 else NEXT IDENTIFIER(N);
end Next local label;
integer procedure NEXT FORMAL IDENTIFIER(N);
integer N;
begin;
NEXT FORMAL IDENTIFIER := NEXT IDENTIFIER(N + (if FORMAL(N) ∨ IN LIBRARY(N) ∨ IN VALUE LIST(N) then 2 else if FUNCTION(N) then 9 else 8));
end Next formal identifier;
procedure INCREASE STATUS(INCREMENT);
integer INCREMENT;
begin;
SPACE[NL BASE - BLOCK CELL POINTER - 2] := SPACE[NL BASE - BLOCK CELL POINTER - 2] + INCREMENT;
end Increase status;
integer procedure IDENTIFIER;
begin;
READ IDENTIFIER;
IDENTIFIER := LOOK UP;
end Identifier;
procedure SKIP PARAMETER LIST;
begin;
if LAST SYMBOL = OPEN then begin;
NEXT SYMBOL;
SKIP TYPE DECLARATION;
if LAST SYMBOL = CLOSE then NEXT SYMBOL;
end;
if LASTSYMBOL = SEMICOLON then NEXT SYMBOL;
end Skip parameter list;
procedure TRANSLATE CODE;
begin;
integer MACRO, PARAMETER;
if LAST SYMBOL = QUOTE then begin;
IN CODE BODY := TRUE;
NEXT: NEXT SYMBOL;
if DIGIT LAST SYMBOL then begin;
MACRO := UNSIGNED INTEGER(0);
if MACRO < 512 then MACRO := MACRO LIST[MACRO];
if PAR PART(MACRO) > 0 then begin;
if LAST SYMBOL = COMMA then NEXT SYMBOL else ERRORMESSAGE(396);
if LETTER LAST SYMBOL then PARAMETER := IDENTIFIER else if DIGIT LAST SYMBOL then PARAMETER := UNSIGNED INTEGER(0) else if LAST SYMBOL = MINUS then begin;
NEXT SYMBOL;
if DIGIT LAST SYMBOL then PARAMETER := -UNSIGNED INTEGER(0) else ERRORMESSAGE(397);
end else ERRORMESSAGE(398);
MACRO2(MACRO, PARAMETER);
end else MACRO(MACRO);
end else ERRORMESSAGE(399);
if LAST SYMBOL = COMMA then goto NEXT;
if LAST SYMBOL = UNQUOTE then NEXT SYMBOL else ERRORMESSAGE(400);
IN CODE BODY := FALSE;
end else ERRORMESSAGE(401);
ENTRANCE BLOCK;
EXIT BLOCK;
end Translate code;
procedure UNSIGNED NUMBER;
begin;
integer P;
UNSIGNED NUMBER;
if ¬SMALL then begin;
P := 0;
NEXT: if P = DP0 then goto FOUND;
if SPACE[PROG BASE + P] ≠ VALUE OF CONSTANT ∨ SPACE[PROG BASE + P + 1] ≠ DECIMAL EXPONENT then begin;
P := P + 2;
goto NEXT;
end;
FOUND: ADDRESS OF CONSTANT := P;
end;
end Unsigned number;
procedure ARITHCONSTANT;
begin;
if SMALL then MACRO2(TSIC, VALUE OF CONSTANT) else if REAL NUMBER then MACRO2(TRC, ADDRESS OF CONSTANT) else MACRO2(TIC, ADDRESS OF CONSTANT);
end Arithconstant;
integer procedure OPERATOR MACRO(N);
integer N;
begin;
OPERATOR MACRO := SPACE[NL BASE - N - 2];
end Operator macro;
procedure CONSTANT STRING;
begin;
integer WORD, COUNT;
QUOTE COUNTER := 1;
NEXT0: WORD := COUNT := 0;
NEXT1: NEXT SYMBOL;
if LAST SYMBOL ≠ UNQUOTE then begin;
WORD := D8 × WORD + LAST SYMBOL;
COUNT := COUNT + 1;
if COUNT = 3 then begin;
MACRO2(CODE, WORD);
goto NEXT0;
end;
goto NEXT1;
end;
NEXT2: WORD := D8 × WORD + 255;
COUNT := COUNT + 1;
if COUNT < 3 then goto NEXT2;
MACRO2(CODE, WORD);
QUOTE COUNTER := 0;
NEXT SYMBOL;
end Constant string;
integer procedure RELATMACRO;
begin;
RELATMACRO := if LAST SYMBOL = LES then LES else if LAST SYMBOL = MST then MST else if LAST SYMBOL = MOR then MOR else if LAST SYMBOL = LST then LST else if LAST SYMBOL = EQU then EQU else UQU;
end Relatmacro;
MAIN PROGRAM OF TRANSLATE SCAN: if ¬TEXT IN MEMORY then begin;
NEWPAGE;
PRINTEXT(`input tape for translate scan');
end;
START := INSTRUCT COUNTER;
LAST NLP := NLP;
RUNNUMBER := 300;
INIT;
INCREMENT := D13;
STATE := B := MAX DEPTH := MAX DEPTH ISR := MAX DISPLAY LENGTH := MAX PROC LEVEL := ECOUNT := 0;
IN SWITCH DECLARATION := IN CODE BODY := FALSE;
NEXT BLOCK CELL POINTER := 0;
ENTRANCE BLOCK;
NEXT SYMBOL;
PROGRAM;
SUM OF MAXIMA := MAX DEPTH + MAX DEPTH ISR + MAX DISPLAY LENGTH + MAX PROC LEVEL;
MACRO2(CODE, SUM OF MAXIMA);
OUTPUT;
end translate;
procedure OUTPUT;
begin;
integer I, K, APOSTROPHE, INSTRUCT NUMBER, PAR, ADDRESS;
procedure PUCAR(N);
integer N;
begin;
integer I;
for I := 1 step 1 until N do PUNLCR;
end pucar;
procedure TABSPACE(N);
integer N;
begin;
integer I, K;
K := N ÷ 8;
for I := 1 step 1 until K do PUSYM(118);
PUSPACE(N - K × 8);
end tabspace;
procedure ABSFIXP(K);
integer K;
begin;
ABSFIXP(4, 0, K);
PUCAR(2);
end absfixp;
procedure PUNCH(BOOL);
Boolean BOOL;
begin;
if BOOL then PUTEXT(` true') else PUTEXT(`false');
PUCAR(2);
end punch;
procedure PUNCH OCTAL(N);
value N;
integer N;
begin;
integer I, K;
Boolean MINUSSIGN;
MINUSSIGN := N < 0;
N := ABS(N);
PUSYM(if MINUSSIGN then MINUS else PLUS);
PUSYM(APOSTROPHE);
for I := D24,
D21,
D18,
D15,
D12,
D9,
D6,
D3,
D0 do
begin;
K := N ÷ I;
N := N - K × I;
PUSYM(K);
end;
PUSYM(APOSTROPHE);
end punch octal;
APOSTROPHE := 120;
PUNLCR;
if RUNNUMBER = 100 then begin;
TABSPACE(22);
PUTEXT(`prescan0');
PUCAR(2);
PUTEXT(`erroneous');
PUSPACE(14);
PUNCH(ERRONEOUS);
PUTEXT(`text length');
PUSPACE(12);
ABSFIXP(if TEXT IN MEMORY then TEXT POINTER + 1 else 0);
PUTEXT(`namelist');
PUCAR(2);
for I := 0 step 1 until NLP - 1 do
begin;
TABSPACE(7);
ABSFIXP(4, 0, I);
PUSPACE(5);
PUNCH OCTAL(SPACE[NL BASE - I]);
PUNLCR;
end;
STOPCODE;
PUNLCR;
PUTEXT(`dp0');
PUCAR(2);
PUTEXT(`start');
PUCAR(2);
PUTEXT(`program');
PUCAR(2);
for I := PROG BASE step 1 until INSTRUCT COUNTER - 1 do
begin;
TABSPACE(7);
ABSFIXP(4, 0, I);
FIXP(16, 0, SPACE[I]);
PUNLCR;
end;
RUNOUT;
STOPCODE;
end else if RUNNUMBER = 200 then begin;
TABSPACE(38);
PUTEXT(`prescan1');
PUCAR(2);
TABSPACE(39);
PUNCH(ERRONEOUS);
TABSPACE(39);
ABSFIXP(if TEXT IN MEMORY then TEXT POINTER + 1 else 0);
PUCAR(2);
for I := 0 step 1 until NLP - 1 do
begin;
TABSPACE(34);
PUNCH OCTAL(SPACE[NL BASE - I]);
PUNLCR;
end;
STOPCODE;
PUCAR(7);
for I := PROG BASE step 1 until INSTRUCT COUNTER - 1 do
begin;
TABSPACE(32);
FIXP(13, 0, SPACE[I]);
PUNLCR;
end;
RUNOUT;
STOPCODE;
end else begin;
TABSPACE(54);
PUTEXT(`translate');
PUCAR(2);
TABSPACE(55);
PUNCH(ERRONEOUS);
TABSPACE(55);
ABSFIXP(if TEXT IN MEMORY then TEXT POINTER + 1 else 0);
PUCAR(2);
for I := 0 step 1 until NLP - 1 do
begin;
TABSPACE(50);
PUNCH OCTAL(SPACE[NL BASE - I]);
PUSPACE(2);
ABSFIXP(4, 0, I);
PUNLCR;
end;
STOPCODE;
PUNLCR;
TABSPACE(55);
ABSFIXP(DP0);
TABSPACE(55);
ABSFIXP(START);
PUCAR(2);
for I := PROG BASE step 1 until START - 1 do
begin;
TABSPACE(48);
FIXP(13, 0, SPACE[I]);
PUSPACE(2);
ABSFIXP(4, 0, I);
PUNLCR;
end;
PUNLCR;
for I := START step 1 until INSTRUCT COUNTER - 1 do
begin;
K := SPACE[I];
PAR := K ÷ 32768;
ADDRESS := K - PAR × 32768;
INSTRUCT NUMBER := PAR ÷ 10;
PAR := PAR - INSTRUCT NUMBER × 10;
TABSPACE(48);
ABSFIXP(3, 0, INSTRUCT NUMBER);
ABSFIXP(1, 0, PAR);
ABSFIXP(5, 0, ADDRESS);
PUSPACE(2);
ABSFIXP(4, 0, I);
PUNLCR;
end;
end;
end output;
MAIN PROGRAM: for N := 0 step 1 until END OF MEMORY do
SPACE[N] := 0;
INSTRUCT COUNTER := PROG BASE := NLP := 0;
TEXT BASE := END OF MEMORY ÷ 3;
NL BASE := END OF MEMORY;
PRESCAN0;
if ¬DERRONEOUS then begin;
PRESCAN1;
TRANSLATE;
end;
ENDRUN: ;
end;
end;