#include <stdio.h>
#include <string.h>
#include <stdlib.h>
int echo = (0==0);
static void
readsymbol (int *i)
{
int c;
*i = c = getchar ();
if (c == EOF) {fprintf(stderr, "EM CHAR IN STMNT - DISASTER\n");exit(0);}
if (echo) putchar(*i);
}
static int
nextsymbol (void)
{
int c = getchar ();
ungetc (c, stdin);
return c;
}
static void
printsymbol (int i)
{
putchar (i);
}
static void
read (int *i)
{
scanf ("%d", i);
if (echo) printf("%d", *i);
}
static void
write (int i, int j)
{
char fmt[16];
sprintf(fmt, "%%%0dd", j);
printf (fmt, i);
}
static void
space (void)
{
putchar (' ');
}
static void
spaces (int i)
{
while (--i > 0)
space ();
}
static void
newline (void)
{
putchar ('\n');
}
static void
newlines (int i)
{
while (--i > 0)
newline ();
}
int
main (int argc, char **argv)
{
auto void readps (void);
auto void readline (void);
auto int compare (void);
auto void ss (void);
auto void fault (int a, int b, int c, int d);
auto int chnext (void);
auto int newcell (void);
auto int returncell (int i);
auto void printname (int i);
int ap;
int app;
int tp;
int psp;
int asl;
int btn;
int ctn;
int chp;
int faults;
int level;
int ca;
int comp;
int scf;
int ps[(-(600)) - (-(1000)) + 1];
#define ps(n) ps[(n)+1000]
// REDUCED PHRASE STRUCTURE
int tag[1023 + 1], link[1023 + 1];
#define tag(n) tag[n]
#define link(n) link[n]
// TAGS LISTS
int a[200];
#define a(n) a[(n)-1]
// ANALYSIS RECORD
int t[300];
#define t(n) t[(n)-1]
// SOURCE TEXT
int bat[1023 + 1], cot[1023 + 1];
#define bat(n) bat[n]
#define cot(n) cot[n]
// BRANCH, CONST TABLES
int ch[512];
#define ch(n) ch[(n)-1]
// NAME CHAR TABLE
int jump[15 + 1],
star[15 + 1],
brt[15 + 1],
name[15 + 1],
rtp[15 + 1], br[15 + 1], chpp[15 + 1], start[15 + 1], rad[15 + 1];
#define jump(n) jump[n]
#define star(n) star[n]
#define brt(n) brt[n]
#define name(n) name[n]
#define rtp(n) rtp[n]
#define br(n) br[n]
#define chpp(n) chpp[n]
#define start(n) start[n]
#define rad(n) rad[n]
// LEVEL INFORMATION
int true[6], false[6];
#define true(n) true[(n)-1]
#define false(n) false[(n)-1]
// CONDITIONAL BRANCH INSTRUCTIONS
int prec[12], ucn[12];
#define prec(n) prec[(n)-1]
#define ucn(n) ucn[(n)-1]
// OPERATOR PRECEDENCES, TYPES
int opr[12 + 1];
#define opr(n) opr[n]
// MACHINE OPERATIONS
int pt[15], pn[15], ptc[15];
#define pt(n) pt[(n)-1]
#define pn(n) pn[(n)-1]
#define ptc(n) ptc[(n)-1]
// FOR RT SPECS, HEADINGS
readps ();
// READ IN AND REDUCE PHRASE STRUCTURE
asl = 0;
// CLEAR HASHING AREA &
L_10:
tag (asl) = 0;
// CREATE AVAILABLE SPACE LIST
link (asl) = 0;
// IN REMAINDER
if ((asl >= 256 && asl < 1023))
link (asl) = asl + 1;
asl += 1;
if (asl <= 1023)
goto L_10;
asl = 256;
// AVAILABLE SPACE LIST POINTER
br (0) = 'BR0';
// BASE REGISTER MNEMONICS
br (1) = 'BR1';
br (2) = 'BR2';
br (3) = 'BR3';
br (4) = 'BR4';
br (5) = 'BR5';
br (6) = 'BR6';
br (7) = 'BR7';
br (8) = 'BR8';
br (9) = 'BR9';
br (10) = 'BR10';
br (11) = 'BR11';
br (12) = 'BR12';
br (13) = 'BR13';
br (14) = 'BR14';
br (15) = 'BR15';
true (1) = 'BZ';
// CONDITIONAL BRANCH MNEMONICS
false (1) = 'BNZ';
true (2) = 'BNZ';
false (2) = 'BZ';
true (3) = 'BNG';
false (3) = 'BG';
true (4) = 'BL';
false (4) = 'BNL';
true (5) = 'BNL';
false (5) = 'BL';
true (6) = 'BG';
false (6) = 'BNG';
prec (1) = 3;
// OPERATOR PRECEDENCES
prec (2) = 3;
// 4 : HIGHEST
prec (3) = 2;
// 1 : LOWEST
prec (4) = 1;
prec (5) = 1;
prec (6) = 3;
prec (7) = 2;
prec (8) = 2;
prec (9) = 1;
prec (10) = 1;
prec (11) = 1;
prec (12) = 4;
opr (0) = 'LOAD';
// MACHINE INSTRUCTION MNEMONICS
opr (1) = 'SHL';
opr (2) = 'SHR';
opr (3) = 'AND';
opr (4) = 'XOR';
opr (5) = 'OR';
opr (6) = 'EXP';
opr (7) = 'DIV';
opr (8) = 'MLT';
opr (9) = 'ADD';
opr (10) = 'SUB';
opr (11) = 'NEG';
opr (12) = 'NOT';
ucn (1) = 3;
// OPERATOR TYPES
ucn (2) = 3;
// 1 : UNARY
ucn (3) = 2;
// 2 : BINARY COMMUTATIVE
ucn (3) = 2;
// 3 : BINARY NON-COMMUTATIVE
ucn (4) = 2;
ucn (5) = 2;
ucn (6) = 3;
ucn (7) = 3;
ucn (8) = 2;
ucn (9) = 2;
ucn (10) = 3;
ucn (11) = 1;
ucn (12) = 1;
btn = 0;
// BRANCH TABLE POINTER
ctn = 0;
// CONSTANT TABLE POINTER
chp = 1;
// NAME CHARACTER TABLE POINTER
faults = 0;
// FAULT COUNT
level = 0;
// TEXTUAL LEVEL
scf = 0;
// CONDITION FLAG
jump (0) = 0;
// JUMP LIST POINTER
star (0) = 0;
// STORAGE ALLOCATION POSITION IN COT
name (0) = 0;
// NAME LIST POINTER
rtp (0) = (-(1));
// ROUTINE TYPE
chpp (0) = 0;
// NAME CHARACTER TABLE POSITION
start (0) = 0;
// START/FINISH LIST
rad (0) = 10;
// NEXT RELATIVE ADDRESS TO BE ALLOCATED
ca = 0;
echo = (0!=0);
// CURRENT CODE DUMPING ADDRESS
printsymbol ('P');
printsymbol ('R');
printsymbol ('G');
printsymbol (':');
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
L_1:
readline ();
tp = 1;
// TEXT POINTER
L_2:
if (t (tp) == '!')
goto L_3;
// COMMENT - SKIP TO END
psp = (-(1000));
// START OF <SS> IN PHRASE STRUCTURE TABLES
ap = 1;
if (compare () == 1)
{
// SUCCESSFUL ANALYSIS
ap = 1;
// ANALYSIS RECORD POINTER
ss ();
// PROCESS SOURCE STATEMENT
if (t (tp - 1) == ';')
goto L_2;
// FURTHER STATEMENT ON THIS LINE
goto L_1;
}
// GO TO READ NEXT LINE
fault ('SYNT', 'AX ?', ' ', ' ');
// UNSUCCESSFUL ANALYSIS
L_5:
if (t (tp) == 10)
goto L_1;
// NEWLINE - READ NEXT LINE
if (t (tp) == ';')
{
// END OF STATEMENT
tp += 1;
// TP TO START OF NEXT STATEMENT
goto L_2;
}
// GO TO EXAMINE NEXT STATEMENT
L_3:
tp += 1;
// SKIP TO NEXT CHARACTER OF STATEMENT
goto L_5;
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void readps (void)
{
// READ IN AND REDUCE PHRASE STRUCTURE
int pnp;
int alt;
int p;
int i;
int j;
int k;
int pn[300 - 256 + 1], psp[300 - 256 + 1];
#undef pn
#define pn(n) pn[(n)-256]
#define psp(n) psp[(n)-256]
// PHRASE NAME CHARS & POINTERS TO START OF PHRASES IN PS
auto void insertlit (void);
auto int getpn (void);
pnp = 256;
// PN POINTER
p = (-(1000));
// PS POINTER
L_1:
readsymbol (&i);
if (i == 'B')
{
// BUILT-IN PHRASE
L_2:
readsymbol (&i);
// SKIP TO <
if (i != '<')
goto L_2;
j = getpn ();
// READ PHRASE NAME & GET POSITION IN PSP
L_3:
readsymbol (&i);
// SKIP TO =
if (i != '=')
goto L_3;
read (&k);
// READ PHRASE NUMBER
psp (j) = k;
// FILL IN PHRASE NUMBER
goto L_1;
}
// GO TO DEAL WITH NEXT PHRASE
if (i == 'P')
{
// PHRASE
L_4:
readsymbol (&i);
// SKIP TO <
if (i != '<')
goto L_4;
psp (getpn ()) = p;
// READ PHRASE NAME & FILL IN PS POSITION
L_7:
alt = p;
// REMEMBER START POSITION IN PS OF THIS ALTERNATIVE
L_6:
p += 1;
// NEXT PS POSITION
L_5:
readsymbol (&i);
// START OF NEXT ITEM IN THIS ALTERNATIVE
if (i == '\'')
{
// LITERAL TEXT
insertlit ();
// READ LITERAL & INSERT IN PS
goto L_5;
}
// GO FOR NEXT ITEM
if (i == '<')
{
// ITEM IS A PHRASE NAME
ps (p) = getpn ();
// READ PHRASE NAME & FILL IN PS WITH PSP POSITION
goto L_6;
}
// GO FOR NEXT ITEM
if (i == ',')
{
// END OF THIS ALTERNATIVE
ps (alt) = p;
// FILL IN POINTER TO END OF ALTERNATIVE
goto L_7;
}
// GO FOR START OF NEXT ALTERNATIVE
if (i == ';')
{
// END OF PHRASE DEFINITION
ps (alt) = p;
// FILL IN POINTER TO END OF ALTERNATIVE
ps (p) = 0;
// FILL IN END OF PHRASE MARKER
p += 1;
// NEXT PS POSITION FOR START OF NEXT PHRASE DEFINITION
goto L_1;
}
// GO FOR NEXT PHRASE
goto L_5;
}
// SKIP TO SOMETHING SIGNIFICANT
if (i == 'E')
{
// END OF PHRASE STRUCTURE DEFINITIONS
i = (-(1000));
// REPLACE ALL POINTERS TO PSP WITH CORRECT PS POINTERS
L_8:
if (ps (i) >= 256)
ps (i) = psp (ps (i));
i += 1;
if (i != p)
goto L_8;
return;
}
goto L_1;
// SKIP TO SOMETHING SIGNIFICANT
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void insertlit (void)
{
// INSERT LITERAL TEXT INTO 'PS'
int sh;
int i;
sh = 0;
// % SHIFT VALUE TO 0
L_1:
readsymbol (&i);
if (i == '\'')
{
if (nextsymbol () != '\'')
return; // END OF LITERAL
readsymbol (&i);
// QUOTE INSIDE LITERAL - IGNORE ONE
}
if (i == '%')
sh = 128;
else
{ // SHIFT VALUE TO 128 FOR %
if ((i < 'A' || i > 'Z'))
sh = 0;
// END OF KEYWORD - SHIFT VALUE TO 0
ps (p) = i + sh;
// STORE SHIFTED (POSSIBLY) CHAR IN PS
p += 1;
// MOVE TO NEXT POSITION IN PS
}
goto L_1;
}
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto int getpn (void)
{
// READ IN PHRASE NAME AND GET INDEX IN 'PSP'
int np;
int s;
int i;
np = 0;
// TO ACCUMULATE PHRASE NAME CHARS
s = 24;
// INITIAL SHIFT VALUE TO PACK CHARS
L_1:
readsymbol (&i);
if (i != '>')
{
// NOT END OF NAME YET
np = np | i << s;
// PACK NEXT CHAR OF PHRASE NAME
s -= 8;
// REDUCE SHIFT VALUE FOR NEXT CHAR
goto L_1;
}
if (pnp != 256)
{
// NOT FIRST PHRASE NAME
i = 256;
// SCAN NAMES TO FIND IF ALREADY IN
L_2:
if (np == pn (i))
return (i);
i += 1;
if (i != pnp)
goto L_2;
}
pn (pnp) = np;
// INSERT NEW NAME IN DICTIONARY
psp (pnp) = 99999;
// UNDEFINED PHRASE MARKER
pnp += 1;
// MOVE TO NEXT DICTIONARY POSITION
return (pnp - 1);
}
}
#undef pn
#define pn(n) pn[(n)-1]
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void readline (void)
{
// LEXICAL PHASE - READ & CLEAN UP NEXT LINE OF TEXT
auto void store (int i);
int sh;
int i;
newlines (2);
printsymbol (';');
sh = 0;
// % & LITERAL SHIFT VALUE TO 0
tp = 1;
// POINTER TO TEXT ARRAY T
L_1:
readsymbol (&i);
if ((i == 10 && tp == 1))
goto L_1;
printsymbol (i);
if (i == '\'')
{
sh = 128;
// SHIFT VALUE FOR LITERAL
L_2:
store (i);
// STORE SHIFTED CHAR IN TEXT ARRAY
readsymbol (&i);
printsymbol (i);
if (i == 10)
printsymbol (';');
if (i != '\'')
goto L_2;
// NOT END OF LITERAL YET
readsymbol (&i);
printsymbol (i);
if (i == '\'')
goto L_2;
// QUOTE IN LITERAL - IGNORE ONE
sh = 0;
// SHIFT VALUE TO 0 FOR END OF LITERAL
store ('\'');
// STORE UNSHIFTED VALUE TO MARK END
}
if (i == '%')
sh = 128;
else
{ // SHIFT VALUE TO 128 FOR KEYWORD
if ((i < 'A' || i > 'Z'))
sh = 0;
// SHIFT VALUE TO 0 FOR END OF KEYWORD
if (i != ' ')
{
// IGNORE SPACES
store (i);
if (i == 10)
{
// NEWLINE CHAR
if (t (tp - 2) == 'C' + 128)
{
tp -= 2;
printsymbol (';');
}
else
return;
}
}
}
goto L_1;
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void store (int i)
{
// STORE (POSSIBLY) SHIFTED CHARACTER IN TEXT ARRAY & CHECK LINE NOT TOO LONG
if (tp > 300)
{
fault ('STAT', 'MNT ', 'TOO ', 'LONG');
tp = 1;
}
t (tp) = i + sh;
// STORE CHAR IN TEXT ARRAY
tp += 1;
// MOVE TO NEXT POSITION
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto int compare (void)
{
// ANALYSE PHRASE
#undef name
auto int name (void); // BUILT-IN PHRASE NAME
auto int cnst (void); // BUILT-IN PHRASE <CNST>
int app;
int tpp;
int pspp;
int ae;
int n;
tpp = tp;
// PRESERVE INITIAL TEXT POINTER
app = ap;
// PRESERVE INITIAL ANALYSIS RECORD
a (ap) = 1;
// ALTERNATIVE 1 FIRST
L_11:
ae = ps (psp);
// POINTER TO END OF ALTERNATIVE
psp += 1;
// FIRST ITEM OF ALTERNATIVE DEFN
L_12:
if (psp == ae)
return (1); // END OF ALT REACHED - SUCCESS
n = ps (psp);
// NEXT ITEM OF ALT DEFN
psp += 1;
// FOR FOLLOWING ITEM
if (n < 0)
{
// SUB-PHRASE
pspp = psp;
// PRESERVE PS POINTER
psp = n;
// POINTER TO DEFN OF SUB-PHRASE
ap += 1;
// NEXT ANALYSIS RECORD POSITION
n = compare ();
// RECURSIVE COMPARISON FOR SUB-PHRASE
psp = pspp;
// RESTORE PS POINTER
if (n == 1)
goto L_12;
// SUCCESSFUL COMPARISON - GO FOR NEXT ITEM
goto L_13;
}
// UNSUCCESSFUL - GO FOR NEXT ALTERNATIVE
if (n == 1)
{
// BUILT-IN PHRASE <NAME>
if (name () == 1)
goto L_12;
// SUCCESS
goto L_13;
}
// FAILURE
if (n == 2)
{
// BUILT-IN PHRASE CNST
if (cnst () == 1)
goto L_12;
// SUCCESS
goto L_13;
}
// FAILURE
if (n == t (tp))
{
// LITERAL - MATCHES SOURCE CHAR
tp += 1;
// MOVE TO NEXT SOURCE CHAR
goto L_12;
}
// GO FOR NEXT ITEM
L_13:
if (ps (ae) == 0)
return (0); // END OF PHRASE
psp = ae;
// START OF DEFN OF NEXT ALTERNATIVE
tp = tpp;
// BACKTRACK SOURCE TEXT
ap = app;
// AND ANALYSIS RECORD POINTERS
a (ap) = a (ap) + 1;
// COUNT ALTERNATIVE NUMBER ON ONE
goto L_11;
// GO TO ANALYSE NEW ALTERNATIVE
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto int name (void)
{
// RECOGNISE AND INSERT NAME IN HASHING AREA OF TAG/LINK ARRAYS
int i;
int j;
int k;
int l;
int m;
int n;
i = t (tp);
// FIRST SOURCE CHAR
if ((i < 'A' || (i > 'Z' || (i == 'M' && t (tp + 1) == '\'' + 128))))
return (0); // FAILURE-NOTALETTERORANM-TYPECONSTANT
j = chp;
// NEXT POSITION IN CHARACTER ARRAY
k = i << 16;
// LEAVE HOLE FOR LENGTH & PACK FIRST CHAR
l = 1;
// NO OF CHARS
m = 8;
// NEXT SHIFT VALUE FOR PACKING
n = i;
// SUM VALUE OF CHARS FOR HASHING
L_1:
tp += 1;
i = t (tp);
// NEXT CHAR FROM TEXT ARRAY
if ((('0' <= i && i <= '9') || ('A' <= i && i <= 'Z')))
{
// ADIGITORALETTER
k = k | i << m;
// PACK NEXT LETTER
l += 1;
// CHARACTER COUNT
m -= 8;
// NEXT SHIFT
n += i;
// SUM OF LETTERS
if (m < 0)
{
// PACKED WORD OF CHARS FULL
ch (chnext ()) = k;
// STORE WORD IN CHAR ARRAY
k = 0;
// PACKING WORD TO ZERO
m = 24;
// NEW SHIFT VALUE
}
goto L_1;
}
// GO FOR NEXT CHAR
if (k != 0)
ch (chnext ()) = k;
// STORE ANY REMAINING CHARS IN CHAR ARRAY
ch (j) = ch (j) | l << 24;
// FILL IN LENGTH IN HOLE LEFT IN FIRST WORD
i = ((n & 15) << 4) | ((n >> 4) & 15);
// HASH VALUE
k = i;
// SCAN DICTIONARY FOR NAME
L_2:
if (tag (k) != 0)
{
// A NAME IN THIS POSITION
l = tag (k);
// CHAR ARRAY POSITION
m = j;
// CHAR ARRAY POSITION OF NEW NAME
L_4:
if (ch (l) == ch (m))
{
// PACKED WORDS MATCH
m += 1;
// NEXT WORD OF NEW NAME
if (m == chp)
{
// NAMES MATCH
chp = j;
// MOVE CHP BACK SINCE NAME ALREADY IN
goto L_3;
}
l += 1;
// NEXT WORD OF OLD NAME
goto L_4;
}
// GO FOR NEXT WORD
k = (k + 1) & 255;
// NO MATCH SO TRY NEXT DICTIONARY POSITION
if (k == i)
{
// STARTING POSITION REACHED AGAIN
fault ('DICT', 'IONA', 'RY F', 'ULL ');
exit (0);
}
goto L_2;
}
tag (k) = j;
// STORE CHAR ARRAY POSITION OF NAME
L_3:
ap += 1;
// NEXT ANALYSIS RECORD POSITION
a (ap) = k;
// STORE IDENTIFICATION NO OF NAME
return (1); // SUCCESS
}
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto int cnst (void)
{
// RECOGNISE INTEGER AND LITERAL TEXT CONSTANTS
int i;
int j;
int k;
i = t (tp);
// FIRST CHAR
if ((i == 'M' && t (tp + 1) == '\'' + 128))
{
// M-TYPE CONSTANT
tp += 1;
// IGNORE THE M
i = t (tp);
}
if (i == '\'' + 128)
{
// START OF A LITERAL
j = 0;
// TO ACCUMULATE LITERAL VALUE
k = 0;
// CHARACTER COUNT
L_1:
tp += 1;
i = t (tp);
// NEXT CHAR
if (i != '\'')
{
// NOT END OF LITERAL
j = (j << 8) | (i & 127);
// PACK CHAR
k += 1;
// COUNT CHAR
goto L_1;
}
tp += 1;
// POINTER AFTER QUOTE
if (k > 4)
fault ('STRI', 'NG T', 'OO L', 'ONG ');
goto L_2;
}
if ((i < '0' || i > '9'))
return (0); // NOT A CONSTANT
j = 0;
L_3:
j = 10 * j + i - '0';
// ACCUMULATE DECIMAL VALUE
tp += 1;
i = t (tp);
// NEXT CHAR
if (('0' <= i && i <= '9'))
goto L_3;
// A DIGIT - STILL PART OF CONSTANT
L_2:
ap += 1;
// NEXT ANALYSIS RECORD POSITION
a (ap) = j;
// FILL IN VALUE OF CONSTANT
return (1); // SUCCESS
}
}
#define name(n) name[n]
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void ss (void)
{
// COMPILE SOURCE STATEMENT
auto void ui (void);
auto void sccond (int *label);
auto void sexpr (void);
auto int findlabel (void);
auto void check (void);
auto void unset (void);
auto void pushstart (int flag, int label);
auto int btnext (void);
auto int ctnext (void);
auto int wsnext (void);
auto void storetag (int name, int form, int type, int dim, int lev,
int ad);
auto void dump (int op, int reg, int base, int disp);
auto void skipsexpr (void);
auto void skipapp (void);
auto void rt (void);
auto void arrad (void);
auto void enter (int type, int alloc);
auto void return_ (void);
int i;
int j;
int k;
int l;
int m;
int n;
int p;
int q;
int r;
int ws;
int label;
i = a (ap);
// ANALYSIS RECORD ENTRY
ap += 1;
// FOR FOLLOWING ENTRY
ws = 2;
// SET WORKSPACE POINTER
if (i == 1)
goto L_10;
// UNCONDITIONAL INSTRUCTION
if (i == 2)
goto L_20;
// CONDITIONAL STATEMENT
if (i == 3)
goto L_30;
// LABEL
if (i == 4)
goto L_40;
// %FINISH
if (i == 5)
goto L_50;
// DECLARATIONS
if (i == 6)
goto L_60;
// ROUTINE/FN SPEC
if (i == 7)
goto L_70;
// %END
if (i == 8)
goto L_80;
// %BEGIN
if (i == 9)
goto L_90;
// %ENDOFPROGRAM
return; // <SEP>
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// UI
L_10:
ui ();
// COMPILE UNCONDITIONAL INSTRUCTION
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// %IF . . . %THEN . . . %ELSE
L_20:
sccond (&i);
// COMPILE CONDITION
if (a (ap) == 2)
{
// AP ON <UI> - JUMP INSTRUCTION
ap += 2;
// AP ON <ELSE>
j = (-(1));
// MARKER FOR 'JUMP'
}
else
{
// NOT A JUMP
if (a (ap) == 3)
{
// %START
if (a (ap + 1) == 1)
fault ('%STA', 'RT %', 'ELSE', ' ? ');
pushstart (0, i);
return;
}
ui ();
// COMPILE REMAINING UNCOND. INSTNS.
j = 0;
// 'NOT JUMP' MARKER
}
if (a (ap) == 1)
{
// <ELSE>-CLAUSE PRESENT
if (j == 0)
{
// <UI> WAS NOT A JUMP
j = btnext ();
// JUMP ROUND <ELSE>-CLAUSE <UI>
dump ('B', 0, 'BT', j);
}
if (i >= 0)
bat (i) = ca;
// FILL IN LABEL ON <ELSE>-CLAUSE <UI>
ap += 1;
// AP ON <UI>
if (a (ap) == 3)
{
// %START
pushstart (1, j);
return;
}
ui ();
// COMPILE REMAINING <UI>S
i = j;
// JUMP AROUND LABEL
}
if (i >= 0)
bat (i) = ca;
// TO BRANCH ROUND THE UI
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// CONST: . . .
L_30:
i = findlabel ();
// LOCATE/INSERT LABEL IN JUMP LIST
if (i >= 0)
{
// VALID LABEL
if (bat (i) >= 0)
{
write (label, 1);
spaces (2);
fault ('LABE', 'L SE', 'T TW', 'ICE ');
}
bat (i) = ca;
// FILL IN LABEL ADDRESS
}
ss ();
// COMPILE STATEMENT AFTER LABEL
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// %FINISH . . .
L_40:
i = start (level);
// LINK TO FIRST CELL IN START LIST
if (i == 0)
{
// NO CELLS IN LIST
fault ('SPUR', 'IOUS', ' %FI', 'NISH');
return;
}
j = tag (i) & 65535;
// JUMP AROUND LABEL
k = tag (i) >> 16;
// BEFORE OR AFTER %ELSE MARKER
start (level) = returncell (i);
// POP UP CELL
if (a (ap) == 1)
{
// %ELSE PRESENT
if (k == 1)
fault ('TWO ', '%ELS', 'ES !', ' ');
k = btnext ();
// JUMP AROUND <UI>
dump ('B', 0, 'BT', k);
if (j != 65535)
bat (j) = ca;
// FILL IN LABEL ON <UI> IF NECESSARY
ap += 1;
// AP ON <UI>
if (a (ap) == 3)
{
// %START
pushstart (1, k);
return;
}
ui ();
// COMPILE REMAINING <UI>S
j = k;
// JUMP AROUND LABEL
}
if (j != 65535)
bat (j) = ca;
// FILL IN JUMP AROUND LABEL IF NECESSARY
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// DECLARATIONS
L_50:
if (a (ap) == 1)
{
// <ARR> = %ARRAY
app = ap;
// SAVE AP
L_51:
ap += 2;
// AP ON <NAMS>
if (a (ap) == 1)
goto L_51;
// SKIP DOWN TO END OF LIST OF NAMES
ap += 1;
// AP ON <+-\>
sexpr ();
// COMPILE EXPRESSION - LOWER BOUND
dump ('STR', 'ACC', br (level), wsnext ());
// STORE VALUE IN WORKSPACE
sexpr ();
// COMPILE EXPRESSION - UPPER BOUND
dump ('LDA', 'ACC', 'ACC', 1);
// INCREMENT VALUE BY 1
if (a (ap) == 1)
{
// 2-DIM ARRAYS
dump ('SUB', 'ACC', br (level), ws - 1);
// PERFORM 2-DIM ARRAY DECLARATION CALCULATIONS
dump ('STR', 'ACC', br (level), wsnext ());
ap += 1;
sexpr ();
// LOWER BOUND EXPR FOR 2ND DIM
dump ('MLT', 'ACC', br (level), ws - 1);
dump ('STR', 'ACC', br (level), wsnext ());
sexpr ();
// UPPER BOUND EXPR FOR 2ND DIM
dump ('LDA', 'ACC', 'ACC', 1);
dump ('MLT', 'ACC', br (level), ws - 2);
dump ('STR', 'ACC', br (level), wsnext ());
ws -= 4;
// RESTORE WORKSPACE POINTER
i = 2;
// NO OF DIMS
}
else
{
// 1-DIM ARRAYS
dump ('STR', 'ACC', br (level), wsnext ());
ws -= 2;
// RESTORE WORKSPACE POINTER
i = 1;
// NO OF DIMS
}
j = 2;
// TAG FOR 'ARRAY'
ap = app;
// RESTORE AP TO BEFORE LIST OF NAMES
}
else
{
// SCALAR DECLARATIONS
i = 0;
// DIMS=0 FOR SCALARS
j = 0;
// TAG FOR SCALAR
}
L_52:
storetag (a (ap + 1), j, 1, i, level, rad (level));
// PUSHDOWN TAG FOR THIS NAME
if (i == 0)
rad (level) = rad (level) + 1;
else
{ // ONE RELATIVE LOCATION FOR SCALARS
if (i == 1)
{
// 1-DIM ARRAYS
dump ('SUB', 'STP', br (level), ws);
dump ('STR', 'STP', br (level), rad (level));
dump ('ADD', 'STP', br (level), ws + 1);
}
else
{
// 2-DIM ARRAYS
dump ('LOAD', 'ACC', br (level), ws + 1);
dump ('STR', 'ACC', br (level), rad (level));
dump ('SUB', 'STP', br (level), ws + 2);
dump ('LDA', 'ACC', 'STP', 0);
dump ('SUB', 'ACC', br (level), ws);
dump ('STR', 'ACC', br (level), rad (level) + 1);
dump ('ADD', 'STP', br (level), ws + 3);
}
rad (level) = rad (level) + 2;
// 2 RELATIVE LOCATIONS FOR ARRAYS
}
ap += 2;
// AP ON <NAMS>
if (a (ap) == 1)
goto L_52;
// MORE NAMES IN LIST OF NAMES
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// RT SPEC? . . .
L_60:
i = a (ap) - 1;
// ROUTINE/FN
j = a (ap + 1);
// SPEC ?
k = a (ap + 2);
// NAME OF ROUTIINE OR FN
ap += 3;
// AP ON <FPP>
l = 0;
// PARAMETER COUNT
m = 10;
// FIRST RELATIVE ADDRESS TO BE ALLOCATED
L_63:
if (a (ap) == 1)
{
// PARAMETERS PRESENT
ap += 1;
// AP ON <ARRN>
if (a (ap) == 1)
n = 3;
else
n = 3 - a (ap);
// SET TAG FOR PARAMETER FORM
p = n << 28 | 1 << 24 | (level + 1) << 16;
// SET UP PATTERN FOR WHOLE TAG
L_62:
l += 1;
// PARAMETER COUNT
if (l > 15)
{
fault ('TOO ', 'MANY', ' PAR', 'AMS ');
goto L_61;
}
// IGNORE SUPERFLUOUS PARAMS
pt (l) = p | m;
// STORE TAG FOR THIS PARAM
pn (l) = a (ap + 1);
// STORE THE NAMES IDENT. NO
if (n == 3)
m += 2;
else
m += 1;
// NEXT RELATIVE ADDRESS
ap += 2;
// AP ON <NAMS>
if (a (ap) == 1)
goto L_62;
// MORE NAMES IN LIST
ap += 1;
// AP ON <FPS>
goto L_63;
}
L_61:
n = link (k);
// LINK TO TAG FOR NAME OF ROUTINE OR FN
if ((n == 0 || ((tag (n) >> 16) & 15) < level))
{
// NAME NOT SET OR SET AT LOWER LEVEL
if (l > 0)
{
// PARAMETERS PRESENT
p = 1;
// PARAMETER COUNT
q = k;
// 'INSERT AFTER' POINTER
L_64:
r = newcell ();
// PUSHDOWN TAG FOR PARAMETER
tag (r) = pt (p);
link (r) = link (q);
ptc (p) = r;
// SAVE POINTER TO TAG CELL
link (q) = r;
q = r;
// NEW VALUE FOR 'INSERT AFTER' POINTER
p += 1;
// PARAMETER COUNT
if (p <= l)
goto L_64;
// MORE PARAMETERS YET
}
storetag (k, 4, i, l, level, btnext ());
// PUSHDOWN TAG FOR NAME OF ROUTINE OR FN
if (level == 0)
bat (btn - 1) = k + 65536;
// FLAG FOR EXTERNAL SPECS
}
else
{
// NAME ALREADY SET AT THIS LEVEL
if ((j == 2 && tag (n) >> 28 == 4))
{
// STATEMENT NOT A SPEC & FORM OF NAME IS RT
if (((tag (n) >> 24) & 15) != i)
{
printname (k);
fault ('RT N', 'OT A', 'S SP', 'EC ');
}
if (bat (tag (n) & 65535) >= 0)
{
printname (k);
fault ('RT A', 'PPEA', 'RS T', 'WICE');
}
p = tag (n) >> 20 & 15;
// NO OF PARAMS IN SPEC
if (l != p)
{
fault ('PARS', ' NOT', ' AS ', 'SPEC');
if (l > p)
l = p;
// IGNORE SUPERFLUOUS PARAMS
}
if (l > 0)
{
// PARAMS PRESENT
p = 1;
// PARAM COUNT
q = link (n);
// LINK TO TAG OF FIRST PARAM
L_67:
if ((pt (p) | ((tag (q) & 15) << 20)) != tag (q))
{
printname (pn (p));
fault ('PAR ', 'NOT ', 'AS S', 'PEC ');
}
ptc (p) = q;
// SAVE POINTER TO TAG CELL
p += 1;
// PARAM COUNT
q = link (q);
// NEXT TAG CELL
if (p <= l)
goto L_67;
// MORE PARAMS
}
}
else
{
printname (k);
fault ('NAME', ' SET', ' TWI', 'CE ');
}
}
L_68:
if (j == 2)
{
// STATEMENT NOT A SPEC
brt (level) = btnext ();
// BRANCH ROUND ROUTINE OR FN
dump ('B', 0, 'BT', brt (level));
bat (tag (link (k)) & 65535) = ca;
// FILL IN ADDRESS OF THIS ROUTINE OR FN
if (level == 15)
fault ('TOO ', 'MANY', ' LEV', 'ELS ');
else
level += 1;
// NEXT TEXTUAL LEVEL
enter (i, m);
if (l > 0)
{
// PARAMS PRESENT
p = 1;
// PARAM COUNT
L_69:
i = pt (p);
// PUSHDOWN TAGS FOR PARAMS
if (i >> 28 == 3)
storetag (pn (p), 3, 1, 0, level, ptc (p));
else
storetag (pn (p), i >> 28, 1, 0, level, i & 65535);
// TREAT ARRAYNAMES SPECIALLY
p += 1;
if (p <= l)
goto L_69;
// MORE PARAMS YET
}
}
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// %END
L_70:
check ();
// CHECK LABELS & START/FINISH BLOCKS
cot (star (level)) = rad (level);
// STORE STATIC ALLOCATION FOR THIS LEVEL
unset ();
// UNSET NAMES DECLARED AT THIS LEVEL
chp = chpp (level);
if (rtp (level) != 0)
dump ('STOP', 0, 0, 0);
// %STOP FOR FNS
return_ ();
// DUMP %RETURN CODE
level -= 1;
// DECREMENT TEXTUAL LEVEL COUNT
if (level < 1)
{
// NOT BACK AT OUTER LEVEL YET
fault ('EXCE', 'SS %', 'END ', ' ');
goto L_71;
}
// TREAT AS %ENDOFPROGRAM
bat (brt (level)) = ca;
// FILL ADDR FOR BRANCH ROUND ROUTINE/FN
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// %BEGIN
L_80:
if (level != 0)
{
fault ('%BEG', 'IN E', 'XTRA', ' ');
// NO INTERNAL BLOCKS ALLOWED
return;
}
if ((ca != 0 || rad (0) != 10))
{
fault ('%BEG', 'IN N', 'OT F', 'IRST');
return;
}
level = 1;
// TEXTUAL LEVEL COUNT TO 1
enter ((-(1)), 10);
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// %ENDOFPROGRAM
L_90:
check ();
// CHECK LABELS & START/FINISHES
cot (star (level)) = rad (level);
// FILL IN STATIC ALLOCATION FOR OUTER BLOCK
unset ();
// UNSET NAMES DECLARED AT THIS LEVEL
if (level != 1)
fault ('TOO ', 'FEW ', '%END', 'S ');
L_71:
dump ('STOP', 0, 0, 0);
// %STOP
printsymbol ('B');
// PRINT OUT BRANCH TABLE
printsymbol ('T');
printsymbol (':');
newline ();
ca = 0;
L_93:
if (ca != btn)
{
dump ('B', 0, 'PRG', bat (ca));
// BRANCH RELATIVE TO START OF PROGRAM
goto L_93;
}
printsymbol ('C');
// PRINT OUT CONSTANT TABLE
printsymbol ('T');
printsymbol (':');
newline ();
i = 0;
L_91:
if (i != ctn)
{
write (cot (i), 10);
newline ();
i += 1;
goto L_91;
}
printsymbol (';');
write (faults, 1);
// NUMBER OF PROGRAM FAULTS
fault (' FAU', 'LTS ', 'IN P', 'ROGM');
exit (0); // !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void ui (void)
{
// COMPILE UNCONDITIONAL INSTRUCTION
int i;
int j;
int k;
int l;
i = a (ap);
// NEXT ANALYSIS RECORD ENTRY
ap += 1;
if (i == 1)
goto L_10;
// ROUTINE CALL OR ASSIGNMENT STATEMENT
if (i == 2)
goto L_20;
// JUMP INSTRUCTION
if (i == 3)
goto L_30;
// %START
if (i == 4)
goto L_40;
// %RETURN
if (i == 5)
goto L_50;
// %RESULT=
dump ('STOP', 0, 0, 0);
// %STOP
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// NAME APP ASS
L_10:
i = link (a (ap));
// POINTER TO NAME TAGS
if (i == 0)
{
printname (a (ap));
fault ('NAME', ' NOT', ' SET', 0);
}
else
i = tag (i);
// NAME TAGS OR ZERO TO AVOID DIAGNOSTICS
j = ap;
// PRESERVE ANALYSIS RECORD POINTER
ap += 1;
// AP ON <APP>
skipapp ();
// SKIP TO <ASS>
if (a (ap) == 2)
{
// ROUTINE CALL
if (i >> 24 == 64)
{
// 'FORM/TYPE' IS ROUTINE
ap = j;
// RESTORE AP TO <NAME>
rt ();
// CALL ROUTINE
}
else
{
if (i != 0)
{
printname (a (j));
fault ('NOT ', 'ROUT', 'INE ', 'NAME');
}
}
ap += 1;
// AP AFTER <UI>
return;
}
k = i >> 28;
// 'FORM' OF NAME
if (k == 4)
{
printname (a (j));
fault ('NAME', ' NOT', ' A D', 'ESTN');
// ROUTINE/FN FORM
i = 0;
// CLEAR TAGS TO AVOID FURTHER DIAGNOSTIC
}
ap += 1;
// AP ON <+-\>
sexpr ();
if (i == 0)
return; // LHS NAME NOT SET
if (k >= 2)
{
// LHS AN ARRAY TYPE
dump ('STR', 'ACC', br (level), wsnext ());
// PRESERVE ACCUMMULATOR
k = ap;
// PRESERVE AP
ap = j;
// RESTORE INITIALANAL REC POINTER
arrad ();
// CALCULATE ARRAY ELEMENT ADDRESS
ws -= 1;
// RESTORE WORKSPACE POINTER
dump ('LOAD', 'WK', br (level), ws);
// RESTORE ACCUMMULATOR
dump ('STR', 'WK', 'ACC', 0);
// DUMP ASSIGNMENT
ap = k;
// RESTORE AP TO AFTER <UI>
return;
}
if (k == 1)
{
dump ('LOAD', 'WK', br (i >> 16 & 15), i & 65535);
// INDIRECT ASSIGMENT
dump ('STR', 'ACC', 'WK', 0);
}
else
dump ('STR', 'ACC', br (i >> 16 & 15), i & 65535);
if (a (j + 1) == 1)
{
printname (a (j));
fault ('SCAL', 'AR H', 'AS P', 'ARAM');
}
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// -> CONST
L_20:
dump ('B', 0, 'BT', findlabel ());
// SCAN/INSERT JUMP LIST AND DUMP JUMP
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// %START
L_30:
fault ('%STA', 'RT ?', ' ', ' ');
// %START ALONE SHOULD NOT BE A SOURCE STATEMENT
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// %RETURN
L_40:
if (rtp (level) != 0)
fault ('%RET', 'URN ', 'CONT', 'EXT ');
return_ ();
// DUMP %RETURN CODE - INCORRECT FOR FN
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
// %RESULT=
L_50:
i = rtp (level);
// ROUTINE/FN TYPE
if (i <= 0)
fault ('%RES', 'ULT ', 'CONT', 'EXT ');
// %BEGIN/%ROUTINE
sexpr ();
// COMPILE RESULT EXPRESSION
return_ ();
// LEAVE RESULT IN ACC & DUMP RETURN CODE
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void sexpr (void)
{
// COMPILE ARITHMETIC EXPRESSION
auto void torp (void);
auto void pseval (void);
auto void eval (int p);
int rpp;
int app;
int rp[32], pt[32];
#define rp(n) rp[(n)-1]
#define pt(n) pt[(n)-1]
// REVERSE POLISH, POINTER/TYPE ARRAYS
rpp = 1;
// RP POINTER
torp ();
// EXPR TO REV POLISH
if (scf == 1)
{
// PART OF A SIMPLE CONDITION
scf = 0;
// RESET FLAG
comp = a (ap);
// COMPARATOR NUMBER
if ((a (ap + 3) == 0 && a (ap + 4) == 2))
ap += 5;
else
{
ap += 1;
// 2ND EXPR NON-ZERO
torp ();
// 2ND EXPRESSION TO REVERSE POLISH
rp (rpp) = 10;
// CODE FOR '-' I.E. (1ST-2ND)
pt (rpp) = 1;
// FLAG=OPERATOR
rpp += 1;
// INCREMENT RP POINTER
}
}
app = ap;
// SAVE FINAL ANAL REC POINTER
pseval ();
// PSEUDO-EVALUATE EXPRESSION
eval (rpp - 1);
// DUMP CODE FOR EXPR EVALUATION
ap = app;
// RESTORE FINAL ANAL REC POINTER
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void torp (void)
{
// TRANSFORM EXPRESSION TO REVERSE POLISH
auto void store (int i, int j);
int op[4];
#define op(n) op[(n)-1]
int opp;
int i;
opp = 0;
// OPERATOR STACK POINTER
i = a (ap);
// <+-\>
ap += 1;
if ((i == 1 || i == 4))
goto L_1;
// + OR NULL
i += 9;
// CODES FOR - & \ ...
L_3:
opp += 1;
// STACK OPERATOR
op (opp) = i;
L_1:
i = a (ap);
// <OPD>
if (i == 3)
{
// SUB-EXPRESSION
ap += 1;
// AP TO <+-\>
torp ();
// TRANSFORM SUB-EXPR TO REV POL
}
else
{
store (ap, 0);
// STORE ANAL REC POSITION OF OPERAND
ap += 2;
// AP ON <APP> OR AFTER <CNST>
if (i == 1)
skipapp ();
// OPERAND A NAME
}
if (a (ap) == 2)
{
// END OF <EXPR>
ap += 1;
// AP AFTER EXPRESSION
L_2:
if (opp == 0)
return; // OPERATOR STACK EMPTIED
store (op (opp), 1);
// UNSTACK REMAINING OPERATORS
opp -= 1;
goto L_2;
}
i = a (ap + 1);
// <OP>
ap += 2;
// AP ON <EXPR>
L_4:
if ((opp == 0 || prec (i) > prec (op (opp))))
goto L_3;
// OP STACK EMPTY OR NEW OP HIGHER PREC
store (op (opp), 1);
// UNSTACK TOP OPERATOR
opp -= 1;
goto L_4;
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void store (int i, int j)
{
// STORE IN RP & PT ARRAYS, I=ANAL REC PTR , J= OP/OPD FLAG
if (rpp > 32)
{
// REV POL ARRAY FULL
fault ('EXPR', ' TOO', ' LON', 'G ');
rpp = 1;
// IN ORDER TO CONTINUE
}
rp (rpp) = i;
// STORE OP/OPD
pt (rpp) = j;
// STORE FLAG
rpp += 1;
// NEXT POSITION
}
}
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void pseval (void)
{
// PSEUDO-EVALUATION, CHECKING OPERANDS
int pst[32];
#define pst(n) pst[(n)-1]
// OPERAND POINTER STACK
int pstp;
int i;
int j;
int k;
pstp = 0;
// PST POINTER
i = 1;
// REV POL ARRAY POINTER
L_3:
ap = rp (i);
// ANAL REC POSITION OF OPERAND
if (a (ap) == 1)
{
// OPERAND A NAME
j = link (a (ap + 1));
// LINK TO TAG OF NAME
if (j == 0)
{
printname (a (ap + 1));
fault ('NAME', ' NOT', ' SET', 0);
k = 0;
// DUMMY TAG VALUE
goto L_1;
}
k = tag (j);
// TAG OF NAME
j = k >> 28;
// 'FORM' OF NAME
if (j > 1)
{
// ARRAY OR ROUTINE/FN TYPE
rp (i) = ap + 1;
// STORE ANAL REC POSITION OF <NAME>
if (j == 4)
{
// NAME IS ROUTINE/FN TYPE
if (((k >> 24) & 15) == 0)
{
printname (a (ap + 1));
fault ('RT N', 'AME ', 'IN E', 'XPR ');
k = 0;
// DUMMY TAG VALUE
goto L_1;
}
pt (i) = (-(1));
// FLAG FOR FUNCTION
}
else
pt (i) = (-(2));
// FLAG FOR ARRAY
goto L_2;
}
// GO TO STACK POINTER
if (a (ap + 2) == 1)
{
printname (a (ap + 1));
fault ('SCAL', 'AR H', 'AS P', 'ARAM');
}
L_1:
rp (i) = k;
// STORE TAG OF NAME FOR SCALARS
pt (i) = (-(3));
// FLAG FOR SCALARS
}
else
{
// OPERAND IS A <CNST>
rp (i) = a (ap + 1);
// STORE VALUE OF CONSTANT
pt (i) = (-(4));
// FLAG FOR CONSTANTS
}
L_2:
pstp += 1;
// STACK OPERAND POINTER
L_4:
pst (pstp) = i;
i += 1;
// REV POL ARRAY POINTER
if (i < rpp)
{
// NOT END OF REV POL YET
if (pt (i) == 0)
goto L_3;
// AN OPERAND IS NEXT
if (rp (i) <= 10)
{
// BINARY OPERATORS
pstp -= 1;
// PSEUDO-EVALUATE POINTERS
pt (i) = pst (pstp);
// STACK POINTER TO RESULT
}
goto L_4;
}
}
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void eval (int p)
{
// DUMP CODE FOR EVALUATION OF EXPRESSION
auto void opn (int op, int l);
int i;
int j;
int k;
i = pt (p);
// POINTER/TYPE OF LAST REV POL ENTRY
if (i < 0)
{
// OPERAND
opn (0, p);
// LOAD OPERAND
return;
}
j = rp (p);
// OPERATOR
k = p - 1;
// START OF 2ND OPERAND
if (ucn (j) == 1)
{
// UNARY OPERATOR
if (pt (k) >= (-(2)))
eval (k);
else
opn (0, k);
// EVAL IF NODE OTHERWISE LOAD OPERAND
dump (opr (j), 'ACC', 0, 0);
// DUMP UNARY OPERATION
return;
}
if (pt (i) >= (-(2)))
{
// FIRST OPERAND A NODE
if (pt (k) >= (-(2)))
{
// SECOND OPERAND A NODE
eval (k);
// EVALUATE 2ND OPERAND
dump ('STR', 'ACC', br (level), wsnext ());
// & STORE IT IN WORKSPACE
eval (i);
// EVALUATE 1ST OPERAND
ws -= 1;
// RESTORE WORKSPACE POINTER
dump (opr (j), 'ACC', br (level), ws);
// DUMP OPERATION
}
else
{
// 2ND OPERAND NOT A NODE
eval (i);
// EVALUATE 1ST OPERAND
opn (j, k);
// OPERATION WITH 2ND OPERAND
}
}
else
{
// 1ST OPERAND NOT A NODE
if (pt (k) >= (-(2)))
{
// 2ND OPERAND A NODE
eval (k);
// EVALUATE 2ND OPERAND
if (ucn (j) == 2)
{
// OPERATOR IS COMMUTATIVE
opn (j, i);
// OPERATION WITH 1ST OPERAND
return;
}
dump ('STR', 'ACC', br (level), wsnext ());
// STORE VALUE OF 2ND OPERAND IN WORKSPACE
opn (0, i);
// LOAD 1ST OPERAND
ws -= 1;
// RESTORE WORKSPACE POINTER
dump (opr (j), 'ACC', br (level), ws);
// DUMP OPERATION WITH 2ND OPERAND
}
else
{
// 2ND OPERAND NOT A NODE
opn (0, i);
// LOAD 1ST OPERAND
opn (j, k);
// OPERATION WITH 2ND OPERAND
}
}
return; // ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void opn (int op, int l)
{
// DUMP SIMPLE OPERATION, OP=OPERATOR, L=RP POSITION OF OPERAND
int i;
int j;
i = pt (l);
// KIND OF OPERAND
ap = rp (l);
// ANAL REC POINTER OR NAME TAGS
if (i == (-(1)))
{
// ROUTINE/FN TYPE
rt ();
// DUMP CALL ON FUNCTION
return;
}
if (i == (-(2)))
{
// ARRAY ACCESS
arrad ();
// CALCULATE ARRAY ELEMENT ADDRESS
dump ('LOAD', 'ACC', 'ACC', 0);
// LOAD VALUE
return;
}
if (i == (-(3)))
{
// SCALAR TYPE
if (ap >> 28 == 1)
{
// %NAME TYPE
dump ('LOAD', 'WK', br (ap >> 16 & 15), ap & 65535);
// LOAD INDIRECT
dump (opr (op), 'ACC', 'WK', 0);
}
else
dump (opr (op), 'ACC', br (ap >> 16 & 15), ap & 65535);
return;
}
if ((op != 0 || ap > 65535))
{
// CONSTANT NOT 'LDA'-ABLE
j = ctnext ();
// NEXT HOLE IN CONSTANT TABLE
cot (j) = ap;
// STORE VALUE
dump (opr (op), 'ACC', 'CT', j);
}
else
dump ('LDA', 'ACC', 0, ap);
}
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void skipsexpr (void)
{
// SKIP PAST <+-\><OPD><EXPR> IN ANALYSIS RECORD, AP INITIALLY ON <+-\>
L_1:
ap += 2;
// AP ON <OPD>+1
if (a (ap - 1) == 3)
skipsexpr ();
else
{ // SKIP SUB-EXPR ELSE <NAME> OR <CNST>
ap += 1;
// AP ON <APP> OR AFTER <CNST>
if (a (ap - 2) == 1)
skipapp ();
// OPERAND IS A NAME
}
ap += 1;
// AP AFTER <EXPR>
if (a (ap - 1) == 1)
goto L_1;
// MORE OPERANDS
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void skipapp (void)
{
// SKIP PAST <APP> IN ANALYSIS RECORD
L_1:
ap += 1;
// POINTER TO <APP>+1 OR <EXPS>+1
if (a (ap - 1) == 1)
{
// EXPRESSIONS TO SKIP
skipsexpr ();
goto L_1;
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void sccond (int *label)
{
// COMPILE CONDITION I.E. <SC><COND>, LABEL SET FOR POSITION AFTER UI
auto void sc (void);
auto void cond (void);
auto void store (int ft);
int i;
int j;
int k;
int l;
int app;
int cap[16], lvl[16], tf[16], jmp[16], lbl[16];
#define cap(n) cap[(n)-1]
#define lvl(n) lvl[(n)-1]
#define tf(n) tf[(n)-1]
#define jmp(n) jmp[(n)-1]
#define lbl(n) lbl[(n)-1]
// ANAL REC POINTERS, NESTING LEVEL,
// TRUE/FALSE,JUMP&LABELARRAYS
i = 1;
// INDEX TO ARRAYS
l = 0;
// NESTING LEVEL
sc ();
// PROCESS <SC>
cond ();
// PROCESS <COND>
app = ap;
// PRESERVE FINAL ANAL REC POINTER
l = (-(1));
store (1);
// PSEUDO-FALSE AT LEVEL -1
l = (-(2));
store (2);
// PSEUDO-TRUE AT LEVEL -2
k = i - 1;
// LAST POSITION FILLED IN IN ARRAYS
i = 1;
L_2:
j = i;
// FIND POSITIONS TO JUMP TO
L_1:
j += 1;
// AFTER COMPARISONS
if ((lvl (j) >= lvl (i) || tf (j) == tf (i)))
goto L_1;
// SKIP HIGHER LEVELS ETC
jmp (i) = j;
// JUMP TO COMPARISON POSITION J
i += 1;
if (i < k)
goto L_2;
// MORE JUMPS TO FILL IN YET
if (a (ap) != 2)
goto L_3;
// UI NOT A JUMP INSTRUCTION
ap += 1;
// TO <CONST>
j = k - 1;
// LAST POSITION FILLED IN
tf (j) = 2;
// SET AS 'TRUE'
jmp (j) = j;
// SET JUMP AS THE UI JUMP
lbl (j) = findlabel ();
// FILL IN BRANCH TABLE POSITION
L_3:
i = 1;
// FILL IN PSEUDO-LABELS FOR INNER JUMPS
L_4:
if (lbl (jmp (i)) < 0)
lbl (jmp (i)) = btnext ();
// NEXT BAT POSITION
i += 1;
if (i < k)
goto L_4;
// MORE TO FILL IN
i = 1;
L_7:
ap = cap (i);
// ANAL REC POINTER FOR 1ST EXPR OF COMP
scf = 1;
// SET FLAG FOR SEXPR
sexpr ();
// TO EVALUATE (1ST - 2ND)
if (tf (i) == 1)
l = false (comp);
else
l = true (comp);
dump (l, 'ACC', 'BT', lbl (jmp (i)));
// BRANCH TO REQUIRED POSITION
if ((lbl (i) >= 0 && (i != k - 1 || tf (i) == 1)))
bat (lbl (i)) = ca;
i += 1;
// FILL IN LABEL ADDRESS
if (i < k)
goto L_7;
// MORE COMPARISONS YET
*label = lbl (k);
// FINAL LABEL
ap = app;
// FINAL ANALYSIS RECORD POINTER
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void store (int ft)
{
// STORE LEVEL & TRUE/FALSE FLAG
if (i > 16)
{
// ARRAYS FULL
fault ('COND', 'N TO', 'O LO', 'NG ');
i = 1;
// TO CONTINUE
}
lvl (i) = l;
// SAVE NESTING LEVEL
tf (i) = ft;
// SAVE TRUE/FALSE FLAG
lbl (i) = (-(1));
// SET 'LABEL NOT FILLED IN YET' FLAG
i += 1;
// NEXT ARRAY POSITION
}
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void sc (void)
{
ap += 1;
if (a (ap - 1) == 2)
{
l += 1;
// NESTING LEVEL UP 1 FOR SUB-CONDITION
sc ();
// PROCESS SUB-<SC>
cond ();
// PROCESS SUB-<COND>
l -= 1;
// NESTING LEVEL DOWN AFTER SUB-CONDITION
}
else
{
cap (i) = ap;
// ANAL REC POINTER FOR SIMPLE COMPARISON
skipsexpr ();
// SKIP 1ST EXPR OF COMPARISON
ap += 1;
// SKIP COMPARATOR
skipsexpr ();
// SKIP 2ND EXPR
}
}
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void cond (void)
{
// PROCESS <COND> FOR SIMPLE COMPARISONS
int i;
i = a (ap);
// <COND>
ap += 1;
// AP ON <SC>
if (i != 3)
{
// NOT NULL ALTERNATIVE OF <COND>
L_1:
store (i);
// SAVE %AND OR %OR TYPE OF CONDITION
sc ();
// PROCESS <SC>
ap += 1;
// POINTER ON <ANDC>+1 OR <ORC>+1
if (a (ap - 1) == 1)
goto L_1;
// MORE %ANDS OR %ORS
}
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void check (void)
{
// CHECK LABELS ALL SET & STARTS MATCH FINISHES
int i;
int j;
i = jump (level);
// POINTER TO JUMP LIST FOR THIS LEVEL
L_1:
if (i != 0)
{
// NO LABELS OR JUMPS USED AT THIS LEVEL
if (bat (tag (i) & 65535) < 0)
{
// LABEL SET INCORRECTLY
write (tag (i) >> 16, 1);
// PRINT OUT LABEL NO OF LABEL NOT SET
fault (' LAB', 'EL N', 'OT S', 'ET ');
}
i = returncell (i);
// RETURN JUMP LIST CELL TO ASL
goto L_1;
}
i = start (level);
// LINK TO START LIST
L_2:
if (i != 0)
{
// A CELL STILL IN LIST
fault ('%FIN', 'ISH ', 'MISS', 'ING ');
i = returncell (i);
// POP UP CELL
goto L_2;
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void unset (void)
{
// UNSET NAMES AND CHECK FOR MISSING ROUTINES
int i;
int j;
int k;
i = name (level);
// NAME LIST POINTER
L_1:
if (i != 0)
{
// UNSET NAMES DECLARED AT THIS LEVEL
j = tag (i);
// NAME IDENT NO
k = tag (link (j));
// TAG WORD AT TOP OF LIST
link (j) = returncell (link (j));
// POP UP CELL
if (k >> 28 == 4)
{
// ROUTINE/FN TYPE
if (bat (k & 65535) < 0)
{
printname (j);
fault ('ROUT', 'INE ', 'MISS', 'ING ');
}
k = k >> 20 & 15;
// NO OF PARAMS
L_2:
if (k != 0)
{
// PARAMS PRESENT
link (j) = returncell (link (j));
// POP UP CELLS
k -= 1;
// PARAM COUNT
goto L_2;
}
}
if (link (j) == 0)
tag (j) = 0;
// A PREVIOUS DECLARATION OF SAME NAME
i = returncell (i);
// RETURN NAME LIST CELL
goto L_1;
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void pushstart (int flag, int label)
{
// PUSHDOWN START/FINISH BLOCK INFORMATION
int i;
i = newcell ();
tag (i) = (flag << 16) | (label & 65535);
// PACK FLAG & LABEL
link (i) = start (level);
// PUSH CELL DOWN
start (level) = i;
// ONTO START LIST
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void enter (int type, int alloc)
{
// DUMP CODE FOR NEW LEVEL & INITIALISE LEVEL ARRAYS
int i;
dump ('STR', br (level), 'STP', 0);
// ENTRY SEQUENCE
dump ('LDA', br (level), 'STP', 0);
dump ('STR', 'WK', 'STP', 1);
i = ctnext ();
// STATIC ALLOCATION HOLE IN CONST TABLE
dump ('ADD', 'STP', 'CT', i);
star (level) = i;
// REMEMBER POSITION OF HOLE
jump (level) = 0;
// NO JUMPS AT NEW LEVEL YET
name (level) = 0;
// NO NAMES AT NEW LEVEL YET
rtp (level) = type;
// BLOCK/ROUTINE/FN TYPE
chpp (level) = chp;
// SAVE CHARACTER ARRAY POINTER
start (level) = 0;
// NO START/FINISH BLOCKS YET
rad (level) = alloc;
// NEXT RELATIVE ADDRESS TO BE ASSIGNED
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void return_ (void)
{
// DUMP CODE FOR %RETURN
dump ('LDA', 'STP', br (level), 0);
// RESTORE DIJKSTRA DISPLAY
dump ('LOAD', br (level), 'STP', 0);
dump ('LOAD', 'WK', 'STP', 1);
dump ('B', 0, 'WK', 0);
// BRANCH TO RETURN ADDRESS
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void rt (void)
{
// DUMP CODE FOR A ROUTINE OR FUNCTION CALL
int i;
int j;
int k;
int l;
int m;
int n;
int p;
i = link (a (ap));
// LINK TO TAG FOR NAME
ap += 1;
// AP ON <APP>
j = tag (i);
// TAG OF NAME
k = ((j >> 20) & 15) + 1;
// NO OF PARAMS +1
L_1:
k -= 1;
// COUNT PARAMS
ap += 1;
// AP ON <APP>+1
if (a (ap - 1) == 2)
{
// PARAMS ABSENT OR NO MORE TO PROCESS
dump ('BAL', 'WK', 'BT', j & 65535);
// DUMP BRANCH TO ROUTINE/FN
if (k > 0)
fault ('TOO ', 'FEW ', 'PARA', 'MS ');
return;
}
if (k <= 0)
{
// MORE PARAMS THAN SPEC
if (k == 0)
fault ('TOO ', 'MANY', ' PAR', 'AMS ');
// ONLY MONITOR ONCE
goto L_2;
}
i = link (i);
// LINK TO NEXT PARAM CELL
l = tag (i);
// TAG OF PARAM
if (l >> 28 == 0)
{
// SCALAR VALUE
sexpr ();
// COMPILE EXPRESSION
goto L_3;
}
if ((a (ap) == 4 && a (ap + 1) == 1))
goto L_4;
// <+-\> IS NULL & <OPD> IS A NAME
L_5:
fault ('NOT ', 'A NA', 'ME P', 'ARAM');
L_2:
skipsexpr ();
// SKIP INVALID PARAM TO CONTINUE
goto L_1;
L_4:
m = link (a (ap + 2));
// LINK TO TAG FOR PARAM NAME
if (m == 0)
{
printname (a (ap + 2));
fault ('NAME', ' NOT', ' SET', ' ');
goto L_2;
}
n = tag (m);
// TAG OF PARAM NAME
if (l >> 28 == 1)
{
// PARAM IS SCALAR NAME TYPE
if (n >> 28 == 4)
{
// ACTUAL NAME IS ROUTINE/FN TYPE
printname (a (ap + 2));
goto L_5;
}
if (n >> 28 >= 2)
{
// ACTUAL NAME IS AN ARRAY
ap += 2;
// AP ON <NAME>
arrad ();
// CALCULATE ARRAY ELEMENT ADDRESS
ap += 1;
// AP ON <EXPR>+1 - SHOULD BE <EXPS>
if (a (ap - 1) == 1)
goto L_5;
// FURTHER OPERAND - INVALID
goto L_3;
}
if (a (ap + 3) == 1)
{
// <APP> NOT NULL
printname (a (ap + 2));
fault ('SCAL', 'AR H', 'AS P', 'ARAM');
goto L_2;
}
if (a (ap + 4) == 1)
goto L_5;
// FURTHER OPERANDS - INVALID
if (n >> 28 == 1)
p = 'LOAD';
else
p = 'LDA';
// LOAD FOR NAME TYPE & LDA FOR VALUE TYPE
dump (p, 'ACC', br (n >> 16 & 15), n & 65535);
}
else
{
// PARAM IS ARRAY NAME
if ((a (ap + 3) != 2 || a (ap + 4) != 2))
goto L_5;
// <APP> NOT NULL OR MORE OPERANDS
if (((n >> 28) & 2) == 0)
{
// 'FORM' OF ACTUAL IS NOT ARRAY
printname (a (ap + 2));
fault ('NOT ', 'AN A', 'RRAY', ' NME');
goto L_2;
}
if (n >> 28 == 3)
{
// ACTUAL IS ARRAY NAME
m = n & 65535;
// POINTER TO TAG CELL OF PARAM LIST
n = tag (m);
// CORRECT TAG FOR PARAM
}
if (((n >> 20) & 15) != ((l >> 20) & 15))
{
// DIMENSIONS DIFFERENT
if (((l >> 20) & 15) == 0)
{
// FORMAL PARAM DIMENSION UNKNOWN
l = tag (i) | ((n & 15) << 20);
// FILL FORMAL TAG WITH DIMENSION
tag (i) = l;
// OF ACTUAL PARAM
}
else
{
// DIMENSION OF FORMAL KNOWN
if (((n >> 20) & 15) == 0)
tag (m) = tag (m) | ((l & 15) << 20);
else
{ // FILL IN DIMENSION OF ACTUAL IF UNKNOWN
printname (a (ap + 2));
fault ('ARRA', 'Y DI', 'MENS', 'ION?');
goto L_2;
}
}
}
dump ('LOAD', 'ACC', br (n >> 16 & 15), n & 65535);
if (((l >> 20) & 15) != 1)
{
// NOT 1-DIM ARRAY
dump ('STR', 'ACC', 'STP', l & 65535);
dump ('LOAD', 'ACC', br ((n >> 16) & 15), (n & 65535) + 1);
l += 1;
}
}
ap += 5;
// AP ON <EXPS>
L_3:
dump ('STR', 'ACC', 'STP', l & 65535);
goto L_1;
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void arrad (void)
{
// DUMP CODE TO CALCULATE ARRAY ELEMENT ADDRESS
int i;
int j;
int k;
int l;
l = a (ap);
i = link (l);
// LINK TO TAG FOR NAME OF ARRAY
j = tag (i);
if ((j >> 28) == 3)
{
// NAME IS AN ARRAY NAME
i = j & 65535;
// SUBSTITUTE CORRECT TAG VALUE
j = tag (i);
}
ap += 2;
// AP ON <APP>+1
if (a (ap - 1) == 1)
{
// INDEXES PRESENT
sexpr ();
// COMPILE EXPR FOR FIRST INDEX
ap += 1;
// AP ON <EXPS>+1
if (a (ap - 1) == 1)
{
// 2ND INDEX PRESENT
dump ('STR', 'ACC', br (level), wsnext ());
// STORE 1ST INDEX IN WORKSPACE
sexpr ();
// COMPILE EXPR FOR 2ND INDEX
if (a (ap) == 1)
{
// 3RD INDEX PRESENT
printname (l);
fault ('TOO ', 'MANY', ' IND', 'EXES');
skipapp ();
// SKIP EXCESS INDEXES
}
else
ap += 1;
// AP AFTER EXPRESSION
dump ('MLT', 'ACC', br ((j >> 16) & 15), j & 65535);
ws -= 1;
// RESTORE WORKSPACE POINTER
dump ('ADD', 'ACC', br (level), ws);
dump ('ADD', 'ACC', br ((j >> 16) & 15), (j & 65535) + 1);
k = 2;
// DIMENSION MARKER
}
else
{
// ONLY ONE INDEX PRESENT
dump ('ADD', 'ACC', br (j >> 16 & 15), j & 65535);
k = 1;
// DIMENSION MARKER
}
if (k != ((j >> 20) & 15))
{
// DIMS FOUND DO NOT AGREE WITH TAG
if (((j >> 20) & 15) == 0)
tag (i) = tag (i) | k << 20;
else
printname (l);
fault ('ARRA', 'Y DI', 'MENS', 'ION?');
// FILL IN DIMS IF UNKNOWN
}
}
else
{
printname (l);
fault ('NO A', 'RRAY', ' IND', 'EXES');
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto int btnext (void)
{
// ALLOCATE NEXT POSITION IN BRANCH TABLE
if (btn > 1023)
{
// FULL
fault ('TOO ', 'MANY', 'LABE', 'LS ');
btn = 0;
// TRY TO CONTINUE
}
bat (btn) = (-(1));
// MARKER FOR ADDRESS NOT FILLED IN YET
btn += 1;
// NEXT POSITION
return (btn - 1); // THIS POSITION
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto int ctnext (void)
{
// ALLOCATE NEXT POSITION IN CONSTANT TABLE
if (ctn > 1023)
{
// FULL
fault ('TOO ', 'MANY', ' CON', 'STS ');
ctn = 0;
// TRY TO CONTINUE
}
ctn += 1;
// NEXT POSITION
return (ctn - 1); // THIS POSITION
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto int wsnext (void)
{
// ALLOCATE NEXT WORK SPACE POSITION
ws += 1;
if (ws == 11)
fault ('COMP', 'ILER', ' WKS', 'PACE');
return (ws - 1);
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto int findlabel (void)
{
// CHECK & LOCATE OR INSERT LABEL IN JUMP LIST FOR THIS LEVEL
int i;
int j;
label = a (ap);
// VALUE OF CONST
ap += 1;
// AFTER <CONST>
if (label >> 16 != 0)
{
// INVALID LABEL NUMBER
write (label, 1);
spaces (2);
fault ('INVA', 'LID ', 'LABE', 'L ');
return ((-(1))); // 'FAULTY' RESULT
}
i = jump (level);
// JUMP LIST POINTER
L_1:
if (i != 0)
{
// SOMETHING IN LIST
if (label == tag (i) >> 16)
return (tag (i) & 65535); // LABEL ALREADY IN
i = link (i);
// NEXT CELL IN LIST
goto L_1;
}
i = newcell ();
// LABEL NOT IN LIST SO GET NEW CELL
j = btnext ();
// GET NEXT BRANCH TABLE POSITION
tag (i) = label << 16 | j;
// FILL IN LIST ENTRY
link (i) = jump (level);
// PUSHDOWN ONTO JUMP LIST
jump (level) = i;
// NEW JUMP LIST POINTER
return (j); // NEW BRANCH TABLE POSITION
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void storetag (int nam, int form, int type, int dim, int lev, int ad)
{
// STORE TAGS I.E. SET NAME & CHECK NOT SET ALREADY
int m;
int n;
m = link (nam);
// POINTER TO EXISTING TAGS WORD FOR THIS
if ((m != 0 && (lev == ((tag (m) >> 16) & 15) && form != 4)))
{
printname (nam);
fault ('NAME', ' SET', ' TWI', 'CE ');
return;
}
n = newcell ();
// NEW CELL FOR TAGS
tag (n) = form << 28 | type << 24 | dim << 20 | lev << 16 | ad;
// FILL IN TAGS
link (n) = link (nam);
// PUSHDOWN ONTO TAGS LIST FOR THIS NAME
link (nam) = n;
n = newcell ();
tag (n) = nam;
// PUSHDOWN NEW CELL ONTO NAME LIST
link (n) = name (level);
// FOR NAMES DECLARED AT THIS LEVEL
name (level) = n;
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void dump (int op, int reg, int base, int disp)
{
// PRINT OUT CURRENT ADDRESS, OPERATION MNEMONIC & OPERANDS
auto void pmn (int i);
int com;
spaces (10);
com = ' ';
pmn (op);
// OPERATOR MNEMONIC
com = ',';
pmn (reg);
// REGISTER MNEMONIC
if (disp >= 65536)
{
printsymbol (',');
spaces (7);
printname (disp - 65536);
}
else
{
if ((base == 'BT' || (base == 'CT' || base == 'PRG')))
{
printsymbol (',');
spaces (7);
}
pmn (base);
// BASE MNEMONIC
write (disp, 1);
// DISPLACEMENT
}
newline ();
ca += 1;
// INCREMENT CURRENT ADDRESS COUNT
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void pmn (int i)
{
// PRINT MNEMONIC - CHARS INTO ONE WORD
int j;
int k;
int l;
j = 2;
// AT LEAST TWO SPACES
k = 24;
// FIRST SHIFT VALUE
L_1:
l = i >> k & 255;
// UNPACK NEXT CHARACTER
if (l == 0)
j += 1;
else
printsymbol (l);
k -= 8;
// NEXT SHIFT VALUE
if (k >= 0)
goto L_1;
// MORE CHARS POSSIBLY YET
if ((i == 'BT' || (i == 'CT' || i == 'PRG')))
printsymbol ('+');
else
{
printsymbol (com);
spaces (j);
// TO ALLIGN FIELDS CORRECTLY
}
}
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void fault (int a, int b, int c, int d)
{
// MONITOR FAULT - A 'PRINT STRING' ROUTINE
auto void out (int i);
out (a);
out (b);
out (c);
out (d);
newline ();
faults += 1;
// INCREMENT FAULT COUNT
// ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! ! !
auto void out (int i)
{
// PRINT OUT PACKED CHARS
printsymbol (i >> 24);
printsymbol (i >> 16 & 255);
printsymbol (i >> 8 & 255);
printsymbol (i & 255);
}
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto int chnext (void)
{
// ALLOCATE NEXT POSITION IN 'CH' ARRAY
if (chp > 512)
{
// CHARACTER ARRAY FULL
fault ('NAME', 'S TO', 'O LO', 'NG ');
exit (0);
}
chp += 1;
return (chp - 1);
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto int newcell (void)
{
// ALLOCATE NEW CELL FOR LIST PROCESSING
int i;
if (asl == 0)
{
// END OF AVAILABLE SPACE LIST
fault ('ASL ', 'EMPT', 'Y ', ' ');
exit (0);
}
i = asl;
// POINTER TO TOP CELL OF ASL
asl = link (asl);
// ASL POINTER TO NEXT CELL DOWN
tag (i) = 0;
// CLEAR NEW CELL OUT
link (i) = 0;
return (i); // INDEX TO NEW CELL
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto int returncell (int i)
{
// DEALLOCATE CELL AND RETURN IT TO ASL
int j;
j = link (i);
// PRESENT LINK VALUE OF CELL
link (i) = asl;
// LINK TO TOP OF ASL
asl = i;
// ASL POINTER TO RETURNED CELL
return (j); // RETURN VALUE OF LINK
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
auto void printname (int i)
{
// PRINT NAME FROM HASH POSITION
int j;
int k;
int l;
int m;
j = tag (i);
// POINTER TO CH ARRAY
k = ch (j);
// LENGTH & FIRST 3 CHARS
l = k >> 24;
// NUMBER OF CHARS IN NAME
m = 16;
// FIRST SHIFT VALUE
L_1:
printsymbol (k >> m & 255);
l -= 1;
if (l == 0)
{
spaces (2);
return;
}
m -= 8;
// NEXT SHIFT VALUE
if (m < 0)
{
j += 1;
k = ch (j);
// NEXT WORD OF CHARS
m = 24;
}
goto L_1;
}
// !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
}