/* EPC Imp to C Translation Release 4 Version Apr 95 */
#include "imptoc.h"
int main (int argc, char **argv)
{ /* IMP15 COMPILER 30/10/78 */
/*OUTPUT STREAMS */
static const int err = 0;
static const int obj = 1;
static const int map = 2;
/*PRIMITIVE ROUTINE TAGS */
static const int moni = 4; /* MONITOR */
static const int nst = 5; /* NEST */
static const int le = 6; /* TEST LESS-THAN OR EQUAL */
static const int ge = 7; /* TEST GREATER-THAN OR EQUAL */
static const int ar = 8; /* ARRAY REFERENCE */
static const int adec = 9; /* ARRAY DECLARATION */
static const int sh = 10; /* SHIFT */
static const int ent = 16; /* PROCEDURE ENTRY/EXIT */
static const int flt = 17; /* FAULT TRAP */
static const int bar = 20; /* BYTE ARRAY-REF */
static const int bget = 21; /* BYTE FETCH */
static const int bput = 22; /* BYTE STORE */
static const int adr = 28; /* ADDR */
static const int Int = 29; /* INTEGER */
static const int ptxt = 38; /* PRINT TEXT */
/*DECLARATION CODES */
static const int beg = 108; /* BEGIN */
static const int ext = 128;
static const int own = 64;
static const int body = 64;
static const int ref = 32;
static const int array = 8;
static const int proc = 4;
static int line = 1; /* LINE NUMBER */
static int lines = 0; /* LINE COUNT */
static int icount = 0; /* INSTRUCTION COUNT */
static int sym = 0; /* CURRENT INPUT SYMBOL */
static int symtype = 0;
/*-2:LET, -1:DIG, 0:TERM*/
/* 1:OTHER, 2:KEYLET */
static int decl = 0; /* DECLARATOR TYPE */
static int sstype = 1; /* STATEMENT TYPE */
static int section = 0; /* 0:INSTR, 1:DATA */
static int ownc = 0; /* OWN COUNT */
static int faulty = 0; /* FAULT INDICATOR */
/*CURRENT INPUT LINE */
static int pos1 = 0; /* START-OF-ATOM POSITION */
static int pos = 0; /* CURRENT CHAR POSITION */
int Char[73 + 1];
/*NAME DICTIONARY */
static int dmax = 0; /* NAME DICT MAX */
static const int dbound = 500; /* UPPER BOUND (CHANGED FROM 350) */
int dict[dbound + 1];
/*TAG INFO */
static int global = 0; /* ZERO OR ENDOFPRIM TAG */
static int tmax = 0; /* TAG MAX */
int x; /* CURRENT TAG (WHEN RELEVANT) */
static int lmin = 253; /* COMP LAB MIN */
int *tt0, *ttx;
/*==TAGTYPE(0),TAGTYPE(X)*/
int tagtype[223 + 1];
int index[223 + 1];
/* SIGNIFICANCE OF TAGTYPE VALUES: */
/* VAL256+ VAL128 VAL64 VAL32 VAL0:15 */
/* 0 0 SET 0 0 0 0 0 LABEL */
/* 0 EXT OWN REF 0 0 0 1 INTEGER (EXT+OWN=CONST) */
/* 0 0 OWN REF 0 0 1 0 BYTE */
/* GRAM AD SAFE/EXT BODY REF 0 1 0 0 PRED */
/* GRAM AD SAFE/EXT BODY REF 0 1 T T FN */
/* 0 0 0 0 0 1 1 1 STRING */
/* BOUNDS AD 0 1 0 1 0 0 0 SWITCH */
/* 0 0 OWN REF 1 0 T T ARRAY */
/* GRAM AD SAFE/EXT BODY REF 1 1 0 0 ROUTINE */
/* GRAM AD SAFE/EXT BODY REF 1 1 T T MAP */
/* 0 0 1 1 1 1 0 0 BEGIN */
/* NEVER STORED IN TAGTYPE */
/* 0 0 0 1 0 1 0 0 SPEC */
/*ANALYSIS RECORD */
int ss; /* START OF SS */
static const int nodebound = 70;
int refco[nodebound + 1];
int sub[nodebound + 1];
/** GRAMMAR AND KEYDICT GENERATED BY TAKEON PROGRAM*/
static int gmax1 = 196;
static int gmax = 196;
static int phrase[127 - 111] = { 194, 69, 72, 77, 81, 115,
125, 147,
153, 156, 159, 168, 173, 176, 188, 0
};
static int atomic[111 - 79] = { 64, 70, 72, 77, 68, 69, 73,
67,
73, 73, 74, 77, 76, 77, 78, 78,
65, 65, 66, 66, 74, 78, 74, 12,
18, 15, 15, 65, 10, 15, 9, 42
};
static int initial[79] = { 36225, 35842, 33923, 3332,
68741, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
-118767, 0, 0, 3604, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, -131041, 0,
0, -117854, -117981, 3876, -117595, -117722, 0, 2088,
4009, 0, 0, 0, 0, 33838, 33071, 0,
0, 1842, 1075, 1460, 3765, 0, 66615, 99384,
33849, 33850, 98363, 0, 0, 0, 0, 35664,
-118944, -118429, 0, 0, 0, 0, 0, 35794,
-118058, -118044, 0, -118196, -118061, -118043, 0
};
static int gram[255 + 1] = { 0, 756, -129612, -129999,
1140, -94156, -94155, -129132,
9, -126846, 4996, 1653, -128746, 1073, -131063, 33918,
-129978, 1095, -129999, 2676, -130640, 9, 10, 5134,
1137, 5329, 5745, 6129, 6526, 6517, 39367, 33913,
33909, 4465, -126452, 110, 37625, -126739, 110, 6726,
40441, 5376, -123378, 9, 38642, -127729, 9, 39027,
-127601, 9, 1074, 7825, 39667, -124020, 110, -123127,
7417, -123923, 110, 2832, 8070, 1088, 7040, 8262,
-122481, -123002, 1040, -122810, 8070, 9030, -122225, 0,
9358, 9594, 9610, 9850, 16, 9998, 10233, 10348,
9849, -118944, -118767, -118196, -118058, -118061, -131041,
-117981,
-117854, -118429, -118044, -118043, -117722, 13477, -117492,
46494,
-131008, 46664, -117492, 46750, 46960, 47216, 32890, 32887,
46915, 32839, 46970, 79735, 65648, 79736, -116497, 0,
80231, 116, 112506, -115978, 15482, -82774, -82645, 0,
32768, 15862, 15222, -82774, 0, -114546, -114004, -113852,
16890, -121227, 17402, -112979, 32768, 118, 32880, 17424,
-112870, -112741, -112612, -112979, 32768, 51450, 50301,
50428,
50555, -117971, 0, -111775, -113832, 17243, -78819, 0,
65658, -111774, -113818, 17247, -117608, -117607, 32839,
-110439,
-109800, 53629, -110438, -109669, -109796, 0, 53883, 53756,
54525, -109542, -109029, 0, 54652, 55165, -108902, 0,
-131007, -131001, -131006, -113847, -113851, -113843, -113846,
-113842,
-121458, 23826, 24061, 104, 24299, 24332, 57338, 24681,
57594, 13162, 24974, 25210, 16, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0
};
static int kdict[425 - 31] = { 0, 387, 131, 403, 131, 131,
407, 131,
411, 415, 419, 431, 447, 451, 131, 475,
129, 129, 129, 129, 129, 129, 129, 129,
129, 129, 487, 490, 495, 523, 539, 131,
131, 556, 628, 656, 708, 752, 904, 128,
128, 972, 1152, 128, 1188, 1232, 1248, 1256,
1284, 128, 1348, 1440, 1552, 1604, 128, 1636,
1648, 128, 128, 131, 1695, 131, 131, 131,
-118367, -64814, 66268, 66204, 106541, 65947, 65550, 65552,
-117462, 66331, 66522, -116949, -65448, 65628, 66013, 65551,
-116051, -116162, -65384, 65692, 65553, 66077, -115665,
66459,
66395, 65546, 65545, -114500, -114627, -114754, 69677, 65818,
77869, 65818, -113987, -57332, 73773, 66142, -113347, -113474,
110637, 65882, 102445, -112188, 8782, -112349, -112470,
-60760,
65578, 71336, 68265, -111039, -111676, 82, 70696, -111197,
-111318, 70056, 71080, 68009, 71592, -110395, 10841, 69,
65728, 9415, 78, 65591, -108534, -109361, 8665, 8908,
65586, -108851, 10702, 84, 77827, 8909, 10830, 65547,
65536, -107711, 9946, -107862, 69864, 70888, -107325, 68,
71528, -107094, 69736, 70760, -102452, -105010, 88, -105271,
84, -105659, 9426, 10702, 8649, 73731, 10066, 9793,
73728, 84, 66847, 68, -104625, 65592, 70, -102842,
80, -103099, 82, -103351, 9167, 8402, 77, 65595,
77, 65593, 9938, 65594, 9801, 69, 65595, 8915,
-65489, 65584, -100671, -101559, 10575, 65556, 9422, 9299,
-101051, 65582, 10700, 69, 65583, -100148, 9813, 84,
65572, 8915, 66719, -94266, -98738, -98993, 11603, -99158,
70248, 71272, 84, 70568, 8916, 8903, 82, -95295,
-96186, -97075, -97586, -65470, 65606, 9921, 69, -63422,
67654, 10305, -96557, -60603, 70470, 8912, 67, 66373,
78, -95661, -61115, 69958, 8912, 67, 65861, 10578,
11457, -94770, 66116, 9921, 69, -62910, 68166, 66356,
77, -93360, 83, -93526, 69800, 70824, -93142, 70440,
71464, -92607, 10825, 67817, -92221, 68, 71656, -91741,
-91862, 69928, 70952, 67881, 10063, 10825, 10575, 65573,
10831, 65580, -90160, -90286, 10071, 69635, 65579, 82,
70632, 82, -89019, 10057, 10836, 11333, 84, 65574,
9412, 8387, 8916, -88237, -61179, 69894, 8912, 67,
65797, -86587, 10959, 9428, 8910, -86957, -60667, 70406,
8912, 67, 66309, -85296, -85933, 10964, 10066, 66591,
9813, 7892, -85443, 65571, 65570, 8389, 84, 65587,
-82111, -82488, -82736, -83884, 9431, 8660, 72, 70145,
-83007, -83249, 9426, 9166, 65990, 80, 66783, 10834,
65585, 8645, 67845, 10575, 84, 65536, 68, -81501,
-81622, 70376, 71400, 68329, -80447, -80696, 10962, 69,
66655, 10053, 65558, 68, -79837, -79958, 70120, 71144,
68073, 78, -79028, 9428, 76, 67061, 10693, 83,
66484, 9416, 8908, 66869, -77373, 10575, -77533, -77654,
69992, 71016, 67945, 84, -77014, 70184, 71208, -76611,
65753, 106541
};
/*!END OF GENERATED SECTION */
int *app;
/*== PHRASE(112)*/
int bapp; /* BASIC APP IE LB EXP RB */
int *mref;
/*== MAP RESULT REF*/
void compileblock (int level, int btag, int *btype, int *gd)
{
/*
void printss (int s);
int gapp (void);
void fault (int n);
void analyse (void);
void compile (void);
*/
static int ac = ~255;
static int aclit = 0;
int tbase, dbase, lstack, estack, pmax, atag, danger, access, extind,
ibase;
void printss (int s)
{
int k, p;
assert (0 <= (s & 7));
assert ((s & 7) <= 2);
selectoutput (s & 7);
fprintf (out_file, "%4d", line);
fprintf (out_file, "%s", " ");
fprintf (out_file, "%s", " ");
if (s != err) {
{
for (_imptempint = 1; _imptempint <= level; _imptempint++)
fprintf (out_file, " ");
};
pos1 = 0;
}
p = 1;
for (;;) {
if (p == pos1)
fprintf (out_file, "%c", '^');
if (p == pos)
break;
k = Char[p];
p++;
if (k == nl || (k == '%' && p == pos))
break;
fprintf (out_file, "%c", k);
}
if (s == map)
fprintf (out_file, "%6d", icount - ibase);
fprintf (out_file, "%s", "\n");
selectoutput (obj);
}
void printident ()
{
int i, j, k, l;
i = index[x];
j = (unsigned) i >> 9;
fprintf (out_file, "%c", ((unsigned) j >> 3) + 32);
i &= 511;
j &= 7;
while (j != 0) {
j--;
for (l = 12; l >= 0; l += -6) {
k = ((unsigned) dict[i - j] >> l) & 63;
if (k != 0)
fprintf (out_file, "%c", k + 32);
}
}
}
int gapp (void)
{ /* GRAMMAR FOR APP */
static const int comma = 15;
static const int lb = 14;
int i, l;
int class (int k)
{
if ((k & (array + proc)) != 0)
return (k & 15) + 80; /* PROC AND ARRAY PARAMS */
if ((k & ref) == 0)
return 122; /* INTEGER->EXP(122) */
if ((k & 2) == 0)
return 119; /* INTEGERNAME->REF(119) */
return 120; /* BYTEINTEGERNAME->BREF(120) */
}
void setgcell (int c)
{
c += l << 7; /* LINK + CLASS */
while (l != gmax) {
l++;
if (gram[l] == c)
return;
}
gmax++;
l = gmax;
gram[l] = c;
}
i = tmax;
if (i == tbase)
return 255; /* NULL APP (FOR NOW) */
l = gmax1; /* ')' CELL */
for (;;) {
setgcell (class (tagtype[i]));
i--;
if (i == tbase)
break;
setgcell (comma); /* ',' CELL */
}
setgcell (lb); /* '(' CELL */
return l;
}
void fault (int n)
{
int s_value;
int s_line;
char *s_file;
if (n > 2)
pos1 = 0;
if (pos != 0)
printss (err);
selectoutput (err);
fprintf (out_file, "%c", '*');
{
s_value = n;
s_line = __LINE__;
s_file = __FILE__;
goto s_despatch;
}
s_0:
fprintf (out_file, "%s", "FORM");
goto f;
s_1:
fprintf (out_file, "%s", "ATOM");
goto f;
s_2:
fprintf (out_file, "%s", "NAME");
goto f;
s_3:
fprintf (out_file, "%s", "SIZE");
goto f;
s_4:
fprintf (out_file, "%s", "DUPLICATE");
goto f;
s_5:
fprintf (out_file, "%s", "%BEGIN");
goto m;
s_6:
fprintf (out_file, "%s", "%CYCLE");
goto m;
s_7:
fprintf (out_file, "%s", "%START");
goto m;
s_8:
fprintf (out_file, "%s", "%END");
goto m;
s_9:
fprintf (out_file, "%s", "%REPEAT");
goto m;
s_10:
fprintf (out_file, "%s", "%FINISH");
goto m;
s_11:
fprintf (out_file, "%s", "%RESULT");
goto m;
s_12:
fprintf (out_file, "%c", '\'');
printident ();
fprintf (out_file, "%c", '\'');
m:
fprintf (out_file, "%s", " MISSING");
goto f;
s_13:
fprintf (out_file, "%s", "BOUNDS");
goto f;
s_14:
fprintf (out_file, "%s", "INDEX");
goto f;
s_15:
fprintf (out_file, "%s", "CONTEXT");
goto e;
s_16:
fprintf (out_file, "%s", "ACCESS");
goto a;
s_17:
fprintf (out_file, "%s", "ORDER");
goto f;
s_18:
fprintf (out_file, "%s", "MATCH");
f:
faulty = 1;
a:
access = -1;
e:
fprintf (out_file, "%s", "\n");
selectoutput (obj);
if (symtype == 0)
pos = 0;
goto s_skip;
s_despatch:
switch (s_value) {
case 0:
goto s_0;
case 1:
goto s_1;
case 2:
goto s_2;
case 3:
goto s_3;
case 4:
goto s_4;
case 5:
goto s_5;
case 6:
goto s_6;
case 7:
goto s_7;
case 8:
goto s_8;
case 9:
goto s_9;
case 10:
goto s_10;
case 11:
goto s_11;
case 12:
goto s_12;
case 13:
goto s_13;
case 14:
goto s_14;
case 15:
goto s_15;
case 16:
goto s_16;
case 17:
goto s_17;
case 18:
goto s_18;
default:
BADSWITCH (s_value, s_line, s_file);
}
s_skip:;
}
void analyse (void)
{
static const int comma = 15;
int atom1, atom2, subatom, last, head, max, dup, text, lim, index0;
int k, n, s, g, class, nmin, nmax;
int *z;
static int quote = 0;
static int key = 0;
static int gg = 0;
void readsym ()
{
if (sym != nl)
goto z2;
pos = 0;
pos1 = 0;
z1:
symtype = 1;
z2:
sym = fgetc (in_file);
if (pos != 73)
pos++;
Char[pos] = sym;
if (sym != nl) {
if (quote != 0)
return;
if (sym == ' ')
goto z1;
if (sym == '%') {
symtype = 2;
goto z2;
}
/*KDICT(33:95) := LINK<9>:CODE<2> */
if (sym >= 96)
sym -= 32;
key = kdict[sym - 32];
if ((key & 3) != 0 || symtype != 2)
symtype = (key & 3) - 2;
} else {
lines++;
symtype = quote; /* 0,>0 */
}
} /* READ SYM */
void codeatom (int target)
{
/*TARGET (IF SPECIFIED) IS FIRST ATOM CLASS FROM GRAMMAR */
int i, j, k;
void lookup (int d)
{
static int i; /* OWN FOR OPTIMISATION */
int j, k, l, m;
i = (index0 + tmax) + 1;
l = index0 + lim;
rep:
i--;
if (i == l)
goto new;
if ((index[i] & (~511)) != head)
goto rep;
j = index[i] & 511;
k = max;
while (k != dmax) {
m = dict[k];
if (dict[j] != m)
goto rep;
j--;
k--;
}
subatom = i - index0;
ttx = &tagtype[subatom];
atom1 = (*ttx & 15) + 64;
/*SET UP GRAM FOR PARAMETERS */
if ((*ttx & proc) != 0)
*app = (unsigned) *ttx >> 8;
else
*app = bapp;
/*NON-DECLARATIVE CONTEXT */
if ((d & 255) == 0)
return;
/*SPEC FOR PROC PARAMETER */
if (d == 36 && *app == 0)
return;
/*LABEL AFTER JUMP, PROC AFTER SPEC */
if (((*ttx & 255) + body) == d) {
*ttx += body;
return;
}
dup = 1;
new:
if (d == 0)
return;
tmax++;
subatom = tmax;
ttx = &tagtype[subatom];
*ttx = d;
atom1 = (*ttx & 15) + 64;
index[tmax] = head + max;
dmax = max;
} /* LOOKUP */
z1:
pos1 = pos;
atom1 = 9;
atom2 = 0;
subatom = 0;
if (symtype == 0)
return; /* NL OR SEMI-COLON */
if (symtype == -2)
goto name; /* LETTER -> */
if (symtype < 0)
goto number; /* DIGIT -> */
if (quote != 0)
goto quoted; /* QUOTED SYMBOL -> */
if (sym == '\'')
goto quotemark;
if (sym == '"')
goto string;
/*LOCATE ATOM IN FIXED DICT */
/*KDICT(96:KMAX) := MORE<1>:0<1>:LINK<9>:SYM<7> */
/* OR MORE<1>:1<1>:SUBCLASS<10>:CLASS<6> */
i = (unsigned) key >> 2;
readsym ();
for (;;) {
j = kdict[i - 32];
if ((j & 65536) != 0)
break;
if ((j & 127) != sym || symtype < 0) {
if (j >= 0)
goto err;
i++;
} else {
k = ((unsigned) j >> 7) & 511;
readsym ();
if (j > 0) {
if (k != 0) {
if (k != sym || symtype < 0)
goto err;
readsym ();
}
k = i + 1;
}
i = k;
}
}
atom1 = j & 63; /* ATOM CLASS */
subatom = ((unsigned) j >> 6) & 1023;
if (atom1 == 0 && subatom == 0)
goto z1; /* C NL, (SHORT) */
if (j < 0)
atom2 = kdict[i + 1 - 32] & 63; /* VARIANT ATOM CLASS */
if (atom1 >= 8)
return; /* DECLARATOR */
if (last >= 8)
decl = 0;
/*CUMULATE SUBATOM INFO IN DECL (FOR MULTI-WORD KEYWORDS) */
decl ^= subatom;
/*ADJUST PROCEDURE-TYPE PARAMETERS */
if (last != 0 && (decl & proc) != 0)
decl = (decl - body) + ref; /* PROC PAR */
if (atom1 != 0)
return;
/*EXTERNAL, BYTE */
if (symtype > 0)
goto z1;
err:
atom1 = -1;
return;
quoted:
if (last != comma) {
atom1 = comma;
return;
} /* INFILTRATE COMMA */
quotemark:
if (last == 38)
goto string; /* PRINTTEXT */
quote = sym;
readsym ();
atom1 = 71;
subatom = sym; /* SCONST */
if (sym == quote && ungetc (fgetc (in_file), in_file) == quote)
readsym ();
if (ungetc (fgetc (in_file), in_file) != quote)
return;
readsym ();
goto endquote;
string:
quote = sym;
readsym ();
atom1 = 67;
subatom = text; /* STRING */
j = 0;
while (sym != quote || ungetc (fgetc (in_file), in_file) == quote) {
if (sym == quote)
readsym ();
if ((j & (~127)) != 0) {
dict[text] = j;
text--;
if (text == dmax) {
/*TOO LONG */
atom1 = -3;
text++;
}
j = 0;
}
j = (j << 7) + sym;
readsym ();
}
dict[text] = j - 131072;
text--;
endquote:
quote = 0;
readsym ();
return;
number:
if (last == 17 || (last == 0 && section == 0))
goto name; /* JUMP OR LAB */
atom1 = 71; /* SCONST */
i = 10; /* DECIMAL */
for (;;) {
subatom = 0;
for (;;) {
if (symtype == -1)
k = sym - '0';
else
k = (sym - 'A') + 10;
if (k >= i)
goto err;
subatom += k;
readsym ();
if (symtype >= 0)
break;
j = i;
k = subatom;
subatom = 0; /* MULTIPLY BY RADIX */
while (j != 0) {
if ((j & 1) != 0)
subatom += k;
k = k << 1;
j = (unsigned) j >> 1;
}
}
if (sym != '_')
return;
i = subatom;
readsym ();
if (symtype >= 0)
goto err;
}
name:
head = (sym - 32) << 12;
max = dmax;
for (;;) {
readsym ();
if (symtype >= 0)
goto z25;
head += 512;
max++;
j = sym - 32;
readsym ();
if (symtype >= 0)
break;
j = ((j << 6) + sym) - 32;
readsym ();
if (symtype >= 0)
break;
j = ((j << 6) + sym) - 32;
dict[max] = j;
}
dict[max] = j;
z25:
atom1 = -2;
atom2 = 70; /* IDENT */
lim = tbase; /* LOCAL */
if (last == 0 && sym == ':') {
lookup (64);
return;
} /* LABEL */
if (last == 17) {
lookup (256);
return;
} /* JUMP */
if (target == 70 && decl != 0) {
lookup (decl);
return;
} /* IDENT */
lim = global;
if (last == 40)
lookup (256);
else
lookup (0); /* MCODE,NORMAL */
if (atom1 != 65 || (*ttx & (~255)) == 0)
return;
atom1 = 71;
subatom = dict[(unsigned) *ttx >> 8]; /* CONSTINTEGER */
} /* CODE ATOM */
/* GRAM LAYOUT: MORE<1> ORDER<2> LINK<8> CLASS<7> */
ss = 0;
sstype = 1;
decl = 0;
atom1 = 0;
last = 0;
dup = 0;
text = dbound;
index0 = 0;
*mref = (*mref & (~127)) + 119;
if ((*btype & 2) != 0)
*mref += 1;
nmax = 0;
nmin = nodebound + 1;
n = 0;
if (gg == 0 || section != 0) {
if (symtype == 0)
readsym ();
if (symtype == 0 || sym == '!')
goto skp;
codeatom (0);
if (atom1 == 11)
goto skp; /* COMMENT */
}
if (gg != 0)
goto l4;
if (atom1 <= 0)
goto z91;
gg = initial[atom1 - 1];
if (gg == 0)
goto z91;
sstype = (gg << 1) & 0x30000;
if (gg < 0) {
/*INIT ATOM FOR IMP */
nmax = 1;
refco[nmax] = 0;
sub[nmax] = 1;
}
l1:
last = atom1;
atom1 = 0;
s = subatom;
l2:
class = gg & 127;
if (class >= 24) {
/*NOT TRANSPARENT */
nmin--;
if (nmin == nmax)
goto z90;
sub[nmin] = s;
l3:
z = &n;
for (;;) {
/*INSERT CELL IN ORDER */
k = *z & 127;
if (k == 0 || (gg & 98304) == 0)
break;
gg -= 32768;
z = &refco[k];
}
refco[nmin] = (class << 7) + k;
*z = (*z ^ k) + nmin;
}
l4:
g = ((unsigned) gg >> 7) & 255;
for (;;) {
gg = gram[g];
class = gg & 127;
if (class == 0)
break;
if (class < 112) {
if (class >= 80)
class = atomic[class - 80];
if (atom1 == 0)
codeatom (class);
if (class == atom1 || class == atom2)
goto l1;
if (gg >= 0)
goto z91;
g++;
} else {
nmax++;
if (nmax == nmin)
goto z90;
refco[nmax] = n;
sub[nmax] = g;
n = 0;
g = phrase[class - 112];
}
}
s = 0;
while (n != 0) {
/*REVERSE LINKS */
z = &refco[n];
k = *z & 127;
*z = (*z ^ k) + s;
s = n;
n = k;
}
if (nmax == 0)
goto l5;
n = refco[nmax];
g = sub[nmax];
nmax--;
k = gg; /* EXIT-POINT CODE */
for (;;) {
gg = gram[g];
if (k == 0)
break;
if (gg >= 0)
goto z91;
k -= 32768;
g++;
}
if (s == 0 || (*z & 127) != 0)
goto l2; /* SINGLETON */
class = (unsigned) *z >> 7; /* DON'T BOTHER WITH NEW NODE */
goto l3;
l5:
ss = s;
if (dup != 0)
fault (4);
return;
/*ERROR */
z90:
atom1 = -3;
z91:
while (sym != nl)
readsym ();
if (atom1 < 0)
fault (-atom1);
else
fault (0);
quote = 0;
symtype = 0;
decl = 0;
section = 0;
gg = 0;
return;
skp:
while (symtype != 0)
readsym ();
} /* ANALYSE */
void compile (void)
{
static const int lac = 68;
static const int lad = 95;
static const int tad = 71;
static const int ada = 94;
static const int dac = 65;
static const int dad = 93;
int i, j, k, next, link, class, refdest, bown = 0;
int pend, pend1, pendopr, labcode, Else, main, ltag, lnest, final;
int control, inc, end, ilit, elit;
static int lit = 0;
static int lit1 = 0;
int c_value;
int c_line;
char *c_file;
void pr (int x)
{
int i;
i = abs (x);
while (i != 0) {
fprintf (out_file, "%c", (i & 15) + '0'); /* 'HEX'
DIGIT */
i = (unsigned) i >> 4;
}
if (x < 0)
fprintf (out_file, "%c", '-');
}
void plantname (int x)
{ /* PROCEDURES, EXT SPECS */
int i, j;
void next ()
{
fprintf (out_file, "%s", " ");
if (j != 0) {
j--;
pr (dict[i - j]);
}
}
i = index[x];
j = ((unsigned) i >> 9) & 7;
pr ((i & (~511)) + (tagtype[x] & 15)); /* SYM1+LENGTH+TYPE */
i &= 511;
next ();
next ();
fprintf (out_file, "%s", " ");
}
void swop ()
{ /* SWITCH SECTIONS */
static int t;
if (level < 0) {
if (section == 0) {
fprintf (out_file, "%c", '(');
t = x;
} else {
pr (t);
fprintf (out_file, "%c", ')');
if (global !=0) {
/*EXTERNAL NOT PERM */
plantname (t);
pr (t);
fprintf (out_file, "%c", '!');
}
}
} else
fprintf (out_file, "%c", '/');
section ^= 1;
}
void def (int t)
{ /* DEFINE TAG */
pr (t);
fprintf (out_file, "%c", '.');
if (section != 0)
return;
access = 1;
ac = ~255;
}
void op (int opc)
{ /* OUTPUT OP-CODE */
fprintf (out_file, "%c", opc);
icount++;
}
void plant (int v)
{ /* PLANT VALUE */
pr (v);
op ('#');
}
void print (int x)
{
if (pendopr >= 0) {
if (next != link)
final = 0;
pendopr ^= final; /* INVERT SKIP IF FINAL */
if (pendopr != 0) {
pr (pendopr);
op (79); /* OPR */
}
if (final == 0) {
labcode = main;
pr (lmin);
op (76); /* JMP */
}
if ((lnest & 1) != 0)
def (ltag - 1);
pendopr = -1;
access = 1;
}
pr (x);
}
void nest ()
{
print (nst);
op (66);
ac = ~ac; /* JMS NST (PRESERVES AC) */
}
void pop ()
{
op (84);
ac = 255; /* LAC* T0 */
}
void expend ()
{ /* DISCHARGE PENDING LAC */
int c;
if (pend < 0)
return;
if (ac >= 0)
nest ();
if (~ac != pend) {
if (pend == 0) {
/*CONSTANT */
print (lit);
op (36); /* LAC #LIT (PSEUDO-OP) */
} else {
c = lac;
if ((pend & 256) != 0)
c = lad;
if (lit != 0) {
print (lit);
op (36);
c = tad;
if ((pend & 256) != 0)
c = ada;
}
print (pend & 255);
op (c);
}
} else {
if (aclit != lit) {
if (pend == 0) {
print (lit);
op (36);
} else {
print (lit - aclit);
op (39); /* TAD # */
}
}
}
ac = pend;
aclit = lit;
pend = -1;
}
void load (int t)
{ /* LOAD AC */
expend ();
pend = t;
lit = 0;
}
void Do (int c)
{ /* (ADD),TAD,AND,XOR,SAD */
if (pend >= 0) {
if (pend == 0) {
/*CONSTANT */
print (lit);
op (c - 32); /* PSEUDO-OP */
} else {
if (lit != 0) {
if (c == tad) {
print (lit);
op (39); /* TAD #LIT (PSEUDO-OP) */
} else {
expend ();
goto z1;
}
}
print (pend);
op (c);
}
} else {
z1:
op (c + 16); /* <OP>* T0 */
}
pend = -1;
if (c != 75)
ac = 255; /* SAD */
}
void store (int t)
{ /* DEPOSIT AC */
static const int dzm = 67;
static const int isz = 73;
if (pend == 0 && lit == 0) {
pend = -1;
if (~ac == t)
ac = ~255;
final = 512;
print (t);
op (dzm);
} else {
if (pend == t && lit == 1 && ~ac != t) {
pend = -1;
final = 512;
print (t);
op (isz);
op (79); /* NOP */
} else {
expend ();
if (pendopr < 0) {
ac = t;
aclit = 0;
}
ac = ~ac; /* ?? */
final = 512;
print (t);
op (dac);
}
}
}
void opr (int x)
{ /* OPERATE-GROUP */
expend ();
print (x);
op (79);
if ((x & 4125) != 0)
ac = 255;
}
void not ()
{ /* COMPLEMENT AC */
if (pend != 0)
opr (1);
else
lit = ~lit;
}
void neg ()
{ /* NEGATE */
if (pend < 0) {
print (-1);
op (39);
} else
lit--;
not ();
}
void call (int t)
{ /* SUBROUTINE JUMP */
expend ();
print (t);
op (66);
ac = 255; /* JMS T */
}
void jmsx (int t)
{ /* SPECIAL JMS */
if (pend >= 0) {
/*SECOND PARAM SIMPLE */
print (2);
op (dac);
ac = ~ac;
} else {
store (1);
pop ();
store (2);
load (1);
}
call (t);
}
void jump (int t)
{ /* JUMP */
print (t);
op (76);
}
void mon (int n)
{ /* MONITOR */
print (moni);
op (82);
plant ((n & 255) + 256); /* JMS* MONI: FLTNUM */
ac = ~255;
access = 0;
}
void aref ()
{ /* ARRAY REF */
call (ar);
print (x);
op (lad);
}
void baref ()
{
call (bar);
print (x);
op (lad);
}
void plantown ()
{
ownc--;
if ((ownc & bown) == 0) {
if (bown != 0)
lit = (lit << 9) + lit1;
plant (lit);
} else
lit1 = lit;
}
void compileend ()
{
int i, j, k;
while (lstack != 3) {
fault ((lstack & 1) + 9);
lmin += 2;
lstack = (unsigned) lstack >> 2;
}
x = tmax;
swop (); /* SELECT DATA SECTION */
if (danger != 0)
plant (0);
i = -1;
while (x != tbase) {
ttx = &tagtype[x];
k = *ttx & 255;
if (k == (own + array)) {
/*SWITCH */
j = (unsigned) *ttx >> 8;
if (j != 0) {
swop ();
def (x);
plant (dict[j - 1]);
j = dict[j];
plant (j);
while (j > 0) {
op (79);
j--;
} /* NOP (JMP SET BY LOAD) */
swop ();
}
}
if ((k & (ext + own)) == 0) {
if (k == 0 || (k & (proc + ref)) == proc)
fault (12);
else {
if ((k & ((ref + array) + proc)) == 0 && danger == 0) {
def (x); /* DEFINE TAG DIRECT */
} else {
def (-x); /* DEFINE TAG INDIRECT */
}
if ((k & ((ref + array) + proc)) == 0 && danger != 0) {
plant (-1); /* POINTER SLOT */
} else {
plant (0);
}
i--;
}
}
x--;
}
if (btag != 0) {
def (btag);
plant (0); /* ENTRY POINT */
if (danger == 0) {
if (pmax != tbase) {
for (;;) {
print (pmax);
op (dad);
pmax--;
if (pmax == tbase)
break;
pop ();
}
}
} else {
j = pmax - tbase;
if (j != 0)
j--;
call (ent); /* JMS ENTRY/EXIT */
plant (i);
plant ((i + j) - 1);
/*-SLOTS:-NEST*/
}
if ((btag != danger) && (danger > 0))
*gd = btag;
else
*btype += ext;
}
swop (); /* REVERT TO INSTR SECTION */
}
/*PROCESS ANALYSIS RECORD */
void save (int v)
{
dmax++;
dict[dmax] = v;
}
int size (void)
{
int i;
i = (lit - lit1) + 1;
if (i <= 0 || i > 4095) {
fault (13);
i = 200;
}
return i;
}
void poplabel (int ind)
{
if (lstack == 3 || (lstack & 1) != ind) {
fault (ind + 6);
return;
}
labcode = lstack & 3;
Else = estack & 1;
lstack = (unsigned) lstack >> 2;
estack = (unsigned) estack >> 1;
lmin += 2;
}
void set (int *w)
{
if (pend != 0) {
tmax++;
*w = tmax;
tagtype[*w] = 1;
index[*w] = 0; /* DECLARE WL (INTEGER=1) */
store (*w);
lit = 0;
} else {
*w = 0;
pend = -1;
}
}
void push (int andor)
{
if ((lnest & 2) != andor) {
andor += 4;
lnest |= 1;
}
if ((lnest & 1) != 0)
ltag--;
lnest = (lnest << 3) + andor;
}
void pcall ()
{
/*PROCEDURE CALL */
call (x);
if (danger != 0 && danger != btag)
return;
if ((*ttx & ext) == 0 && x <= pmax)
danger = x; /* NOT SAFE */
}
void mcall ()
{
/*MAP CALL */
if (x == Int && pend > 0 && lit == 0
&& (tagtype[pend] & (own + ref)) == own) {
i = pend;
pend = -1;
} else {
pcall ();
i = 3;
}
}
void restore ()
{
if (pend1 >= 0) {
pend = pend1;
lit = lit1;
ac = ~255;
expend ();
} else {
pop ();
}
} /* end of restore */
void getnext ()
{
int i;
/*COMPILE DECLARATIONS */
if (next == 0) {
next = refco[link] & 127;
link = sub[link];
}
for (;;) {
x = sub[next];
ttx = &tagtype[x];
i = refco[next];
class = (unsigned) i >> 7;
if (class < 112 || x == 0)
break; /* ATOM OR NULL PHRASE */
if ((i & 127) != 0) {
sub[next] = link;
link = next;
}
next = x;
}
next = i & 127;
}
pend = -1;
lit = 0;
labcode = 0;
Else = 0;
pendopr = -1;
if (ac >= 0)
exit (0);
next = ss;
link = 0;
if (sstype == 0 && access == 0)
fault (16);
z1:
getnext ();
z2:
if (class <= 31) {
c_value = x;
c_line = __LINE__;
c_file = __FILE__;
goto c_despatch;
} /* OPERATORS,SIMP */
{
c_value = class;
c_line = __LINE__;
c_file = __FILE__;
goto c_despatch;
}
z9:
if (next != link)
goto z1;
z10:
if (labcode == 0)
return;
z11:
if ((labcode & 1) == 0) {
jump (-(lmin + 1));
access = 0;
} /* JUMP BACK FOR LOOPS */
if (labcode == 0)
return;
if (labcode != 3)
def (lmin);
if (Else != 0)
def (lmin + 1); /* PICKUP POINT FOR ELSE */
return;
c_70:
/* IDENT */
if ((*ttx & own) == 0) {
if ((*ttx & ext) != 0)
goto z811;
if ((*ttx & (ref + array)) != array)
goto z9; /* SCALAR */
if ((*ttx & 2) != 0) {
/*BYTE */
print (3);
op (67); /* DZM T3 (AS INDIC) */
}
if (ac >= 0) {
/*FIRST IN GROUP */
if (lstack != 3)
fault (17);
jmsx (adec); /* JMS ADEC */
} else {
/*BOUNDS ALREADY SET */
load (1);
call (adec); /* LAC T1:JMS ADEC */
}
atag = x;
print (atag);
op (dad);
ac = ~255;
goto z9;
}
ownc = 0;
pend = -1;
if ((*ttx & 3) == 0) {
/*SWITCH */
save (-lit);
save (size ());
z701:
*ttx += dmax << 8;
goto z9;
}
if ((*ttx & ext) != 0) {
/*CONST */
save (lit);
goto z701;
}
if (section == 0)
swop ();
if ((*ttx & ref) != 0)
x = -x;
def (x);
if ((*ttx & (ref + array)) != array) {
plant (lit);
if (level < 0)
swop ();
goto z9;
}
plant (-lit);
ownc = size ();
plant (ownc);
lit = 0;
bown = 0;
if ((*ttx & 2) == 0)
goto z9;
bown = 1;
ownc += ownc & 1;
goto z9;
c_108:
/* CONST BOUND SEP (COLON) */
lit1 = lit;
pend = -1;
goto z9;
c_109:
/* OWNSEP (COMMA) */
if (ownc > 0)
plantown ();
lit = 0;
pend = -1;
goto z9;
c_110:
/* OWNT (T) */
while (ownc > 0) {
plantown ();
lit = 0;
}
if (section != 0)
swop (); /* REVERT TO INSTR SECTION */
return;
c_81:
/* PROCEDURE IDENT */
if ((*ttx & (ext + body)) == 0) {
/*INTERNAL SPEC */
if (global == 0)
*ttx += ext; /* PERM */
return;
}
z811:
fprintf (out_file, "%c", '('); /* BODY OR EXT SPEC */
if ((*ttx & body) != 0)
goto z9; /* BODY */
plantname (x);
print (x);
fprintf (out_file, "%c", ',');
fprintf (out_file, "%c", ')');
goto z9;
/*COMPILE BEGIN,END */
c_57:
/* ENDOFPRIM */
tbase = tmax;
return;
c_58:
/* ENDOFPERM */
global = tbase;
tbase = tmax;
line = 1;
lines = 0;
icount = 0;
closeoutput ();
return;
c_55:
/* BEGIN */
if (level < 0) {
/*MAIN BEGIN */
if (global == 0) {
if (tmax == 0)
tmax = 1;
tbase = tmax;
global = tbase;
}
sstype = 0;
access = 1;
level = 0;
fprintf (out_file, "%c", '!'); /* ENTRY-POINT */
} else {
tmax++;
x = tmax; /* TREAT AS ROUTINE */
tagtype[x] = beg;
index[x] = 0;
call (x);
ac = ~255;
fprintf (out_file, "%c", '(');
}
return;
c_56:
/* END */
if (btag == 0) {
/*MAIN PROGRAM */
fault (5);
sstype = 0;
return;
}
if (access != 0) {
if (access > 0 && (*btype & 15) != 12 && global !=0)
fault (11);
print (btag);
op (92); /* JMP* BTAG */
}
if (danger == 0)
danger = -atag;
compileend ();
if (global !=0)
plantname (tbase); /* NAME UNLESS PERM */
print (tbase);
fprintf (out_file, "%c", ')');
if (extind == 0)
return;
if (level != 0)
fault (15);
plantname (tbase);
pr (tbase);
fprintf (out_file, "%c", '!');
return;
c_59:
/* ENDOFPROGRAM, ENDOFFILE */
if (access != 0)
mon (0);
danger = 0;
if (level >= 0)
compileend ();
fprintf (out_file, "%c", ')'); /* END OF BLOCK */
if (btag == 0)
return;
fault (8); /* MISSING END */
assert (_IMP_MONITOR_);
exit (0);
/*COMPILE LOOPS AND CONDITIONS */
/*LSTACK, ESTACK AND LNEST ARE SINGLE-WORD NESTS */
/*LSTACK (2 BITS) KEEPS TRACK OF STATEMENT BRACKETS */
/*ESTACK (1 BIT) KEEPS TRACK OF ELSE JUMPS */
/*LNEST (3 BITS) DEALS WITH INTERNAL STRUCTURE OF COND STATEMENTS */
/*SIGNIFICANCE OF LSTACK VALUES: */
/* 00 CYCLE */
/* 01 IF,UNLESS */
/* 10 FOR,WHILE,UNTIL */
/* 11 ELSE */
/*SIGNIFICANCE OF LNEST VALUES: */
/* 000 AND AFTER AND,IF */
/* 001 AS ABOVE + DISCONTINUITY */
/* 010 OR AFTER OR,UNLESS */
/* 011 AS ABOVE + DISCONTINUITY */
/* 100 IF / WHILE / AND AFTER OR,UNLESS */
/* 101 AS ABOVE + DISCONTINUITY */
/* 110 UNLESS / OR AFTER AND,IF */
/* 111 UNTIL / AS ABOVE + DISCONTINUITY */
/*COMPILE FOR LOOP */
/* ORDER = (START) CONTROL (INC) CSEP1 (END) CSEP2 (CYCLE,IMP) */
c_107:
/* CONTROL VARIABLE */
control = x;
pend1 = pend;
lit1 = lit; /* START VALUE */
pend = -1;
goto z9;
c_105:
/* CSEP1 */
set (&inc);
ilit = lit;
goto z9;
c_106:
/* CSEP2 */
set (&end);
elit = lit; /* END VALUE */
load (inc);
lit = ilit; /* LAC INC */
neg ();
if (pend1 < 0) {
if (ac < 0)
pop ();
Do (tad);
} else {
if (pend != 0) {
load (pend1);
lit = lit1;
Do (tad);
} else {
pend = pend1;
lit += lit1;
}
}
store (control);
/*= START-INC*/
def (lmin + 1); /* LAB FOR JUMP BACK */
load (control); /* LAC CONTROL */
load (end);
lit = elit;
Do (75); /* SAD END */
jump (lmin); /* JMP (NEXT INSTR) */
load (inc);
lit = ilit;
Do (tad); /* TAD INC */
store (control); /* DAC CONTROL */
labcode = 2;
goto z9;
c_51:
/* REPEAT */
poplabel (0);
goto z11;
/*COMPILE CONDITIONS */
/*STAT ORDER = CWORD COND IMP, CWORD COND START' */
/* CWORD COND IMP ELSE IMP, CWORD COND IMP ELSE START */
/*COND ORDER = AND C1 C2, OR C1 C2, NOT C1 */
/*SCOND ORDER = EXP1 EXP2 COP, EXP1 EXP2 COP EXP3 COP */
c_53:
/* LWORD: WHILE(20), UNTIL(23) */
if ((x & 1) != 0)
jump (lmin - 1); /* UNTIL - JUMP OVER TEST */
def (lmin + 1); /* LABEL FOR LOOPING */
c_52:
/* CWORD: IF(12), UNLESS(14) */
labcode = 0;
main = (unsigned) x >> 3;
lnest = x & 7;
ltag = lmin;
goto z9;
c_42:
/* AND */
push (0);
goto z9;
c_43:
/* OR */
push (2);
goto z9;
c_44:
/* NOT */
lnest ^= 2;
goto z9;
c_45:
/* COP: <(64), =(128), <=(192), >=(576), #(640), >(704) */
if (next != 0)
push (0); /* DOUBLE-SIDED */
if (pend == 0 && lit == 0) {
/*COMPARISON WITH ZERO */
pend = -1;
if (next != 0)
x += 4096; /* +CLA IF DOUBLE */
} else {
k = pend;
if ((x & 64) != 0) {
/*<,<=,>=,> */
if (pend == 0 && lit > 0 && next == 0) {
print (64);
op (79); /* SMA */
neg ();
Do (tad);
} else {
if ((x & 128) != 0) {
/*<=,> */
jmsx (le);
x ^= 448; /* SZL,SNL */
} else {
jmsx (ge);
x ^= 832; /* SZL,SNL */
}
if (k >= 0)
ac = k; /* ACLIT STILL SET */
}
} else {
/*=,#*/
Do (75); /* SAD */
if (x == 640) {
/*# */
if (k >= 0 && next != 0) {
pend = k;
ac = ~255;
}
x = 0;
} else
x = 512; /* SKP */
}
}
condskip:
if ((lnest & 2) != 0)
x ^= 512; /* INVERT */
if ((lnest & (~7)) != 0 || main == 2) {
if (x != 0)
opr (x);
if (next == 0)
ac = ~ac;
i = ltag;
j = lnest;
while ((j & 4) == 0) {
j = (unsigned) j >> 3;
i += j & 1;
}
jump (i);
if (i == lmin)
labcode = main;
if ((lnest & 1) != 0)
def (ltag - 1);
lnest = (unsigned) lnest >> 3;
ltag += lnest & 1;
} else {
pendopr = x;
final = 0;
ac = ~ac;
if ((lnest & 1) != 0)
ac = ~255;
}
goto z9;
/*COMPILE START, FINISH, ELSE, EXIT */
c_49:
c_50:
/* START, CYCLE */
if (pendopr >= 0)
print (0); /* DISCHARGE PENDING SKIP */
if (labcode == 0)
def (lmin + 1); /* INDEFINITE CYCLE */
if (lstack < 0) {
assert (_IMP_MONITOR_);
exit (0);
}
lstack = (lstack << 2) + labcode;
estack = (estack << 1) + Else;
lmin -= 2;
return;
c_46:
/* FINISH */
poplabel (1);
goto z9;
c_47:
/* FINISH ELSE */
poplabel (1);
if (labcode == 3)
fault (15);
c_48:
/* ELSE */
if (access != 0) {
jump (lmin + 1);
Else = 1;
}
labcode = 3;
def (lmin);
goto z9;
c_20:
/* EXIT */
j = lmin + 2;
k = 1;
while ((k & lstack) != 0) {
j += 2;
k = k << 2;
}
if ((((-k) & lstack)) == 0) {
fault (15);
k = 0;
}
access = 0;
final = 512;
jump (j);
lstack |= k << 1;
goto z9;
/*COMPILE LABELS AND JUMPS */
c_80:
/* LAB */
if (x < atag)
fault (17);
def (x);
return;
c_64:
/* L */
access = 0;
final = 512;
jump (x);
goto z9;
c_82:
/* SLAB */
i = (unsigned) *ttx >> 8;
if (i == 0)
return; /* POINTER TO BOUNDS */
lit += dict[i - 1]; /* INDEX - UPPER */
if (lit <= 0) {
lit += dict[i]; /* + NUMBER */
if (lit > 0) {
print (lit + 1);
fprintf (out_file, "%s", " ");
def (x);
return;
}
}
fault (14);
return;
c_72:
/* SNAME */
aref ();
print (3);
op (88);
mon (135); /* XCT* T3:MON 7+128 */
goto z10;
/*COMPILE PROCEDURE EXITS */
c_16:
/* RETURN */
i = 12; /* SHOULD BE ROUTINE */
pex:
if ((*btype & 15) != i)
fault (15);
access = 0;
final = 512;
print (btag);
op (92); /* JMP* BTAG */
goto z9;
c_17:
/* TRUE */
opr (2050); /* STL */
z171:
i = 4; /* SHOULD BE PRED */
goto pex;
c_18:
/* FALSE */
opr (2048); /* CLL */
goto z171;
c_35:
/* FRESULT */
i = (*btype & 3) + 4; /* SHOULD BE FN */
j = ac;
k = aclit;
expend ();
ac = j;
if (ac >= 0)
ac = ~255;
aclit = k;
goto pex;
c_34:
/* MRESULT */
i = (*btype & 3) + 12; /* SHOULD BE MAP */
store (3);
goto pex;
/*COMPILE STOP, FAULT, MONITOR, ETC */
c_19:
/* STOP */
mon (64);
goto z9;
c_36:
/* FAULT */
if (btag != 0)
fault (15); /* SHOULD BE MAIN PROG */
call (flt);
plant (1); /* JMS FLT: SLOT FOR NP */
ac = ~255;
getnext ();
jump (x);
goto z9;
c_37:
/* MONITOR */
pend = -1;
mon (lit);
goto z9;
c_40:
/* MCODE (OPERAND AFTER) */
lit = sub[next];
c_41:
/* LMCODE (CONST BEFORE) */
print (lit);
op (x);
ac = ~255;
return;
c_67:
c_87:
/* STRING (PRINTTEXT) */
call (ptxt); /* PTEXT SR (TEXT FOLLOWS) */
do {
i = dict[x];
plant (i);
x--;
}
while (i >= 0);
ac = ~255;
getnext (); /* IGNORE CALL */
goto z9;
/*COMPILE OPERANDS */
c_71:
/* SCONST */
i = x;
getnext ();
if (pend >= 0 && class == 28 && x <= 2) {
/*EXP +- LIST */
if (x != 1)
i = -i;
lit += i;
goto z9;
}
load (0);
lit = i;
goto z2;
c_103:
/* ASSA: = (EXP = APP (A,M)) */
pend1 = pend;
lit1 = lit;
pend = -1;
goto z9;
c_65:
/* V */
load (x);
goto z9;
c_73:
/* ARRAY ELEMENT (VAL) */
aref ();
i = 3;
vg:
print (i);
op (84); /* LAC* */
goto z9;
c_77:
/* MAP ELEMENT (VAL) */
mcall ();
if (i == 3)
goto vg;
if (ac >= 0)
nest ();
ac = 255;
goto vg;
c_66:
/* BV */
load (256 + x);
bg:
call (bget);
goto z9;
c_74:
/* BYTE ARRAY ELEMENT (VAL) */
baref ();
goto bg;
c_78:
/* BYTE MAP ELEMENT (VAL) */
pcall ();
goto bg;
c_96:
/* VDEST: V */
store (x);
goto z9;
c_86:
/* ARRAY ELEMENT (DEST) */
aref ();
i = 3;
vp:
restore ();
vp1:
print (i);
op (81); /* DAC* */
ac = ~ac;
goto z9;
c_83:
/* MAP ELEMENT (DEST) */
mcall ();
if (i == 3 || ac < 0)
goto vp;
goto vp1;
c_99:
/* BVDEST: BV */
call (bput);
print (x);
op (lad);
ac = ~255;
goto z9;
c_100:
/* BADEST: BA */
baref ();
bp:
restore ();
call (bput);
print (3);
op (lac);
ac = ~255;
goto z9;
c_101:
/* BMDEST: BM */
pcall ();
goto bp;
c_112:
/* APP (NULL) */
expend ();
if (ac >= 0)
nest ();
goto z9;
c_84:
c_85:
c_89:
c_90:
c_92:
/* PPAR,FPAR,APAR,BAPAR,RPAR */
c_93:
c_94:
c_97:
c_98:
/* MPAR,BMPAR,VREF,BVREF */
load (256 + x); /* LAD X */
goto z9;
c_88:
/* ARRAY ELEMENT (REF) */
aref ();
goto z9;
c_102:
/* BYTE AREF */
baref ();
goto z9;
c_91:
c_95:
/* MAP ELEMENT (REF,BREF) */
if (x != Int)
pcall ();
goto z9;
c_69:
/* F (CALL) */
if (x != adr)
pcall ();
goto z9;
c_68:
/* P (CALL) */
pcall ();
x = 256; /* FOR SNL */
goto condskip;
c_76:
/* R (CALL) */
expend ();
final = 512;
pcall ();
ac = ~255;
goto z9;
c_111:
goto z9; /* SEP */
/*COMPILE OPERATORS */
c_104:
/* MOD */
opr (65);
opr (513); /* SMA!CMA:SKP!CMA */
print (1);
op (39); /* TAD #1 */
goto z9;
c_1:
/* PLUS-SIGN */
if (class != 24)
Do (tad); /* TAD (UNLESS UNARY) */
goto z9;
c_2:
/* MINUS-SIGN */
if (class != 24) {
if (pend > 0) {
print (1);
op (79); /* INFILTRATE CMA */
Do (tad);
not (); /* TAD: CMA */
} else {
neg ();
Do (tad);
}
} else {
neg ();
}
goto z9;
c_3:
/* UOP: \
NOT */
not ();
goto z9;
c_4:
c_5:
/* LEFT-SHIFT, RIGHT-SHIFT */
if (pend == 0 && (lit & (~7)) == 0) {
pend = -1;
while (lit != 0) {
if (x != 5)
opr (2056);
else
opr (2064); /* RCL,RCR */
lit--;
}
} else {
if (x == 5)
neg ();
jmsx (sh);
}
goto z9;
c_6:
/* AND */
Do (74);
goto z9;
c_10:
/* XOR */
Do (69);
goto z9;
c_11:
c_12:
c_13:
c_14:
c_15:
/* OR,MULT,IDIV,DIV,EXP */
jmsx (x);
goto z9;
c_8:
/* REFOP -- (DISP -- REF) */
neg ();
c_7:
/* REFOP ++ (DISP ++ REF) */
getnext ();
if (pend == 0) {
pend = 256 + x; /* AD OF X PLUS LIT */
} else {
expend ();
print (x);
op (ada);
ac = 255;
}
goto z9;
c_9:
/* REFASS: == */
getnext ();
if ((*ttx & ref) == 0)
fault (15);
if ((pend - 256) == x && lit == 1) {
print (x);
op (89); /* ISZ* (FOR ISZ) */
if (((~ac) & 255) == x)
ac = ~255;
} else {
if (pend > 0) {
ttx = &tagtype[pend & 255];
expend ();
if ((*ttx & (own + ref)) == 0) {
print (-65537);
op (42); /* AND #-65537 */
}
}
print (x);
op (dad);
ac = ~(x + 256);
aclit = 0;
}
goto z9;
goto c_skip;
c_despatch:
switch (c_value) {
case 70:
goto c_70;
case 108:
goto c_108;
case 109:
goto c_109;
case 110:
goto c_110;
case 81:
goto c_81;
case 57:
goto c_57;
case 58:
goto c_58;
case 55:
goto c_55;
case 56:
goto c_56;
case 59:
goto c_59;
case 107:
goto c_107;
case 105:
goto c_105;
case 106:
goto c_106;
case 51:
goto c_51;
case 53:
goto c_53;
case 52:
goto c_52;
case 42:
goto c_42;
case 43:
goto c_43;
case 44:
goto c_44;
case 45:
goto c_45;
case 49:
goto c_49;
case 50:
goto c_50;
case 46:
goto c_46;
case 47:
goto c_47;
case 48:
goto c_48;
case 20:
goto c_20;
case 80:
goto c_80;
case 64:
goto c_64;
case 82:
goto c_82;
case 72:
goto c_72;
case 16:
goto c_16;
case 17:
goto c_17;
case 18:
goto c_18;
case 35:
goto c_35;
case 34:
goto c_34;
case 19:
goto c_19;
case 36:
goto c_36;
case 37:
goto c_37;
case 40:
goto c_40;
case 41:
goto c_41;
case 67:
goto c_67;
case 87:
goto c_87;
case 71:
goto c_71;
case 103:
goto c_103;
case 65:
goto c_65;
case 73:
goto c_73;
case 77:
goto c_77;
case 66:
goto c_66;
case 74:
goto c_74;
case 78:
goto c_78;
case 96:
goto c_96;
case 86:
goto c_86;
case 83:
goto c_83;
case 99:
goto c_99;
case 100:
goto c_100;
case 101:
goto c_101;
case 112:
goto c_112;
case 84:
goto c_84;
case 85:
goto c_85;
case 89:
goto c_89;
case 90:
goto c_90;
case 92:
goto c_92;
case 93:
goto c_93;
case 94:
goto c_94;
case 97:
goto c_97;
case 98:
goto c_98;
case 88:
goto c_88;
case 102:
goto c_102;
case 91:
goto c_91;
case 95:
goto c_95;
case 69:
goto c_69;
case 68:
goto c_68;
case 76:
goto c_76;
case 111:
goto c_111;
case 104:
goto c_104;
case 1:
goto c_1;
case 2:
goto c_2;
case 3:
goto c_3;
case 4:
goto c_4;
case 5:
goto c_5;
case 6:
goto c_6;
case 10:
goto c_10;
case 11:
goto c_11;
case 12:
goto c_12;
case 13:
goto c_13;
case 14:
goto c_14;
case 15:
goto c_15;
case 8:
goto c_8;
case 7:
goto c_7;
case 9:
goto c_9;
default:
BADSWITCH (c_value, c_line, c_file);
}
c_skip:;
} /* COMPILE SS */
tbase = tmax;
dbase = dmax;
lstack = 3;
estack = 0;
if (*btype != beg) {
/*PROCEDURE (NOT BEGIN) */
analyse (); /* FORMAL PARAMETERS */
x = gapp () << 8;
if ((*btype & (~255)) != 0) {
if ((*btype & (~255)) != x && global !=0)
fault (18);
} else {
*btype += x;
}
if ((*btype & body) == 0)
goto fin; /* SPEC -> */
}
if (btag != 0)
printss (map + 8);
access = btag; /* NON-ZERO EXCEPT AT OUTSET */
extind = *btype & ext;
*btype ^= extind;
atag = 0;
ibase = icount;
danger = 0;
pmax = tmax;
if ((pmax - 1) == tbase && (tagtype[pmax] & 62) == 0) {
ac = ~pmax;
aclit = 0;
}
for (;;) {
line += lines;
{
for (_imptempint = 1; _imptempint <= lines; _imptempint++)
fprintf (out_file, "\n");
} /* LINE-END CODE */
lines = 0;
analyse ();
if (ss != 0)
compile ();
if ((sstype & 0x20000) != 0) {
/*START OR END OF BLOCK */
ac = ~255;
if ((sstype & 0x10000) != 0)
break; /* END */
compileblock (level + 3, x, &tagtype[x], &danger);
}
}
printss (map);
fin:
tmax = tbase;
dmax = dbase;
return;
} /* COMPILE BLOCK */
selectinput (1);
openoutput (obj, "temp.obj");
openoutput (map, "temp.map");
selectoutput (obj);
app = &phrase[112 - 112];
bapp = *app;
tt0 = &tagtype[0];
*tt0 = beg;
mref = &gram[((unsigned) initial[34 - 1] >> 7) & 255];
compileblock (-3, 0, tt0, tt0);
fprintf (out_file, "%s", "\n");
assert (faulty == 0);
exit (0);
}
/* end of automatic translation */