/* 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 */