#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 %external %routine %spec close output
extern void CLOSEOUTPUT(void);
// 2 %external %routine %spec close input
extern void CLOSEINPUT(void);
// 3 %external %routine %spec open output(%integer i, %string(255) s)
extern void OPENOUTPUT(int I, _imp_string255 S);
// 4 %external %routine %spec open input(%integer i, %string(255) s)
extern void OPENINPUT(int I, _imp_string255 S);
// 5 %recordformat impcomfm(%integer statements, flags, code, gla, diags, perm,
struct IMPCOMFM {
union {
struct {
int STATEMENTS;
int FLAGS;
int CODE;
int GLA;
int DIAGS;
int PERM;
_imp_string31 FILE;
_imp_string63 OPTION;
};
};
};
// 6+ %string(31) file,
// 7+ %string(63) Option)
// 8 %externalrecord(impcomfm) IMPCOM
struct IMPCOMFM IMPCOM;
// 9
// 10 !
// 11 ! On EMAS all shorts should be changed to integers.
// 12 ! Also, the INCLUDE facility will need to be modified.
// 13 !
// 14 !
// 15 !###################################################
// 16 ! Copyright: 1 January 1980 #
// 17 ! Interactive Datasystems (Edinburgh) Ltd. #
// 18 ! 32 Upper Gilmore Place #
// 19 ! Edinburgh EH3 9NJ #
// 20 ! All Rights Reserved #
// 21 !###################################################
// 22
// 23 %BEGIN
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
// 24 %CONSTSTRING(4) version = "8.4"
const _imp_string4 VERSION = _imp_str_init("8.4");
// 25
// 26 !configuration parameters
// 27
// 28 %CONSTINTEGER max int = ((-1)>>1)//10
// 29 %CONSTINTEGER max dig = (-1)>>1-maxint*10
// 30 %CONSTINTEGER byte size = 8; !bits per byte
// 31 %CONSTINTEGER max tag = 800; !max no. of tags
// 32 %CONSTINTEGER max dict = 6000; !max extent of dictionary
// 33 %CONSTINTEGER name bits = 11
// 34 %CONSTINTEGER max names = 1<<namebits-1
// 35 %OWNINTEGER spare names = max names
static int SPARENAMES = 2047;
// 36 %CONSTINTEGER max grammar = 1720
// 37 %CONSTINTEGER lit max = 50; !max no. of constants/stat.
// 38 %CONSTINTEGER rec size = 520; !size of analysis record
// 39 %CONSTINTEGER dim limit = 6; !maximum array dimension
// 40
// 41 !symbols
// 42
// 43 %CONSTINTEGER ff = 12; !form feed
// 44 %CONSTINTEGER marker = '^'; !marker for faults
// 45 %CONSTINTEGER squote = '"'; !string quote
// 46 %CONSTINTEGER cquote = ''''; !character quote
// 47
// 48 !streams
// 49
// 50 %CONSTINTEGER source = 1; ! input streams
// 51 ! 2 is for prims
// 52 ! 3 is for include files
// 53 %CONSTINTEGER report = 0, object = 1, listing = 2;! output streams
// 54
// 55
// 56 !types
// 57
// 58 %CONSTINTEGER integer = 1
// 59 %CONSTINTEGER real = 2
// 60 %CONSTINTEGER stringv = 3
// 61 %CONSTINTEGER record = 4
// 62
// 63 !forms
// 64
// 65 %CONSTINTEGER iform = integer<<4+1
// 66
// 67 %CONSTINTEGER var = 91
// 68 %CONSTINTEGER const = 93
// 69 %CONSTINTEGER swit = 105
// 70 %CONSTINTEGER comment = 22
// 71 %CONSTINTEGER termin = 20
// 72 %CONSTINTEGER lab = 3
// 73 %CONSTINTEGER jump = 54
// 74
// 75 %CONSTINTEGER recfm = 4
// 76 %CONSTINTEGER proc = 7; !class for proc
// 77
// 78 !phrase entries
// 79
// 80 %CONSTINTEGER escdec = 252
// 81 %CONSTINTEGER escproc = 253
// 82 %CONSTINTEGER escarray = 254
// 83 %CONSTINTEGER escrec = 255
// 84
// 85 %RECORDFORMAT arfm(%SHORTINTEGER class,sub,link,ptype,papp,pformat,x,pos);!imp77:
struct ARFM {
union {
struct {
short int CLASS;
short int SUB;
short int LINK;
short int PTYPE;
short int PAPP;
short int PFORMAT;
short int X;
short int POS;
};
};
};
// 86 !emas:%RECORDFORMAT arfm(%INTEGER class,sub,link,ptype,papp,pformat,x,pos)
// 87
// 88 %RECORDFORMAT tagfm(%INTEGER app, format, %C
struct TAGFM {
union {
struct {
int APP;
int FORMAT;
short int FLAGS;
short int INDEX;
short int TEXT;
short int LINK;
};
};
};
// 89+ %SHORTINTEGER flags, index, text, link)
// 90
// 91 !flags
// 92
// 93 ! *===.===.===.===.===.====.====.====.===.======.======*
// 94 ! ! u ! c ! c ! p ! s ! a ! o ! pr ! s ! type ! form !
// 95 ! ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 3 ! 4 !
// 96 ! *===^===^===^===^===^====^====^====^===^======^======*
// 97 ! u c c p s a o p s t f
// 98 ! s l o a u n w r p y o
// 99 ! e o n r b a n o e p r
// 100 ! d s s a n m t c e m
// 101 ! e t m a e
// 102 ! d s m
// 103 ! e
// 104 !
// 105 !
// 106
// 107 %CONSTINTEGER used bit = b'1000000000000000',
// 108+ closed = b'0100000000000000',
// 109+ const bit = b'0010000000000000',
// 110+ parameters = b'0001000000000000',
// 111+ subname = b'0000100000000000',
// 112+ aname = b'0000010000000000',
// 113+ own bit = b'0000001000000000',
// 114+ prot = b'0000000100000000',
// 115+ spec = b'0000000010000000'
// 116
// 117 %CONSTINTEGER trans bit = x'4000'
// 118 %CONSTINTEGER error = x'8000'
// 119
// 120 %CONSTINTEGER manifest = 120, figurative = 130
// 121 %CONSTINTEGER actions = 180, phrasal = 200
// 122
// 123 %CONSTBYTEINTEGERARRAY amap(0:15) = %C
const unsigned char AMAP[16] = {89, 91, 92, 104, 94, 93, 105, 100, 101, 102, 103, 106, 107, 108, 109, 89};
// 124+ 89, 91, 92, 104, 94, const, swit, 100, 101, 102, 103, 106, 107, 108, 109, 89
// 125 !? v n l fm const swit rp fp mp pp a an na nan ?
// 126
// 127 %CONSTBYTEINTEGERARRAY atoms(0:15) = 89, 1, 1, 10, 9, 1, 10, 7,
const unsigned char ATOMS[16] = {89, 1, 1, 10, 9, 1, 10, 7, 7, 7, 7, 4, 1, 4, 1, 89};
// 128+ 7, 7, 7, 4, 1, 4, 1, 89
// 129
// 130 %RECORD(arfm)%ARRAY ar(1:rec size)
struct ARFM AR[520];
// 131
// 132 %OWNINTEGER class = 0; !class of atom wanted
static int CLASS = 0;
// 133 %OWNINTEGER x = 0; !usually last tag
static int X = 0;
// 134 %OWNINTEGER atom1 = 0; !atom class (major)
static int ATOM1 = 0;
// 135 %OWNINTEGER atom2 = 0; !atom class (minor)
static int ATOM2 = 0;
// 136 %OWNINTEGER subatom = 0; !extra info about atom
static int SUBATOM = 0;
// 137 %OWNINTEGER type = 0,
static int TYPE = 0;
static int APP = 0;
static int FORMAT = 0;
// 138+ app = 0,
// 139+ format = 0; !atom info
// 140 %INTEGER hash value
int HASHVALUE;
// 141 %OWNINTEGER faulty = 0; !fault indicator
static int FAULTY = 0;
// 142 %OWNINTEGER fault rate = 0; !fault rate count
static int FAULTRATE = 0;
// 143 %OWNINTEGER lines = 0; !current line number
static int LINES = 0;
// 144 %OWNINTEGER text line = 0; !starting line for string const
static int TEXTLINE = 0;
// 145 %OWNINTEGER margin = 0; !statement start margin
static int MARGIN = 0;
// 146 %OWNINTEGER error margin = 0,
static int ERRORMARGIN = 0;
static int ERRORSYM = 0;
static int COLUMN = 0;
// 147+ error sym = 0,
// 148+ column = 0
// 149 %OWNINTEGER stats = 0; !statements compiled
static int STATS = 0;
// 150 %OWNINTEGER mon pos = 0; !flag for diagnose
static int MONPOS = 0;
// 151 %OWNINTEGER sym = nl; !current input symbol
static int SYM = 10;
// 152 %OWNINTEGER symtype = 0; !type of current symbol
static int SYMTYPE = 0;
// 153 %OWNINTEGER quote = 0; !>0 strings, <0 chars
static int QUOTE = 0;
// 154 %owninteger end mark = 0; !%end flag
static int ENDMARK = 0;
// 155 %OWNINTEGER cont = ' ',
static int CONT = 32;
static int CSYM = 32;
// 156+ csym = ' '; !listing continuation marker
// 157 %OWNINTEGER decl = 0; !current declarator flags
static int DECL = 0;
// 158 %OWNINTEGER dim = 0; !arrayname dimension
static int DIM = 0;
// 159 %OWNINTEGER spec given = 0
static int SPECGIVEN = 0;
// 160
// 161 %OWNINTEGER escape class = 0; !when and where to escape
static int ESCAPECLASS = 0;
// 162 %OWNINTEGER protection = 0,
static int PROTECTION = 0;
static int ATOMFLAGS = 0;
// 163+ atom flags = 0
// 164 %OWNINTEGER otype = 0; !current 'own' type
static int OTYPE = 0;
// 165 %OWNINTEGER reals ln = 1; ! =4 for %REALSLONG
static int REALSLN = 1;
// 166 %OWNINTEGER last1 = 0; !previous atom class
static int LAST1 = 0;
// 167 %OWNINTEGER gen type = 0
static int GENTYPE = 0;
// 168 %OWNINTEGER ptype = 0; !current phrase type
static int PTYPE = 0;
// 169 %OWNINTEGER papp = 0; !current phrase parameters
static int PAPP = 0;
// 170 %OWNINTEGER pformat = 0; !current phrase format
static int PFORMAT = 0;
// 171 %OWNINTEGER force = 0; !force next ptype
static int FORCE = 0;
// 172 %OWNINTEGER g = 0,
static int G = 0;
static int GG = 0;
static int MAPGG = 0;
// 173+ gg = 0,
// 174+ map gg = 0; !grammar entries
// 175 %OWNINTEGER fdef = 0; !current format definition
static int FDEF = 0;
// 176 %OWNINTEGER this = -1; !current recordformat tag
static int THIS = -1;
// 177 %OWNINTEGER nmin = 0; !analysis record atom pointer
static int NMIN = 0;
// 178 %OWNINTEGER nmax = 0; !analysis record phrase pointer
static int NMAX = 0;
// 179 %OWNINTEGER rbase = 0; !record format definition base
static int RBASE = 0;
// 180 %OWNINTEGER stbase = 0; !constant work area base
static int STBASE = 0;
// 181 %OWNINTEGER gmin = max grammar; !upper bound on grammar
static int GMIN = 1720;
// 182 %OWNINTEGER dmax = 1
static int DMAX = 1;
// 183 %OWNINTEGER tmin = max tag; !upper bound on tags
static int TMIN = 800;
// 184 %OWNINTEGER ss = 0; !source statement entry
static int SS = 0;
// 185 %STRING(63) include file
_imp_string63 INCLUDEFILE;
// 186 %OWNINTEGER include list = 0,
static int INCLUDELIST = 0;
static int INCLUDELEVEL = 0;
// 187+ include level= 0
// 188 %OWNINTEGER include = 0; !=0 unused, #0 being used
static int INCLUDE = 0;
// 189 %OWNINTEGER perm = 1; !1 = compiling perm, 0 = program
static int PERM = 1;
// 190 %OWNINTEGER progmode = 0; !-1 = file, 1 = begin/eop
static int PROGMODE = 0;
// 191 %OWNINTEGER sstype = 0; !-1:exec stat
static int SSTYPE = 0;
// 192 ! 0: declaration
// 193 ! 1: block in
// 194 ! 2: block out
// 195 %OWNINTEGER spec mode = 0; !>=0: definition
static int SPECMODE = 0;
// 196 ! -1: proc spec
// 197 ! -2: recordformat
// 198 %OWNINTEGER ocount = -1; !own constants wanted
static int OCOUNT = -1;
// 199 %OWNINTEGER limit = 0; !lookup limit
static int LIMIT = 0;
// 200 %OWNINTEGER copy = 0; !duplicate name flag
static int COPY = 0;
// 201 %OWNINTEGER order = 0; !out of sequence flag
static int ORDER = 0;
// 202 %OWNINTEGER for warn = 0; !non-local flag
static int FORWARN = 0;
// 203 %OWNINTEGER dubious = 0; !flag for dubious statements
static int DUBIOUS = 0;
// 204 %OWNINTEGER dp = 1
static int DP = 1;
// 205 %OWNINTEGER pos1 = 0,
static int POS1 = 0;
static int POS2 = 0;
// 206+ pos2 = 0; !error position
// 207 %OWNINTEGER pos = 0; !input line index
static int POS = 0;
// 208 %OWNINTEGER dimension = 0; !current array dimension
static int DIMENSION = 0;
// 209 %OWNINTEGER local = 0; !search limit for locals
static int LOCAL = 0;
// 210 %OWNINTEGER fm base = 0; !entry for format decls
static int FMBASE = 0;
// 211 %OWNINTEGER search base = 0; !entry for record_names
static int SEARCHBASE = 0;
// 212 %OWNINTEGER format list = 0; !size of current format list
static int FORMATLIST = 0;
// 213 %INTEGER recid
int RECID;
// 214 %OWNBYTEINTEGERARRAY char(0:133) = nl(134); !input line
static unsigned char CHAR[134] = {[0 ... 133] = 10};
// 215 %INTEGERARRAY lit pool(0:lit max)
int LITPOOL[51];
// 216 %OWNINTEGER lit = 0; !current literal (integer)
static int LIT = 0;
// 217 %OWNINTEGER lp = 0; !literals pointer
static int LP = 0;
// 218 %OWNINTEGER block x = 0; !block tag
static int BLOCKX = 0;
// 219 %OWNINTEGER list = 1; !<= to enable
static int LIST = 1;
// 220 %OWNINTEGER control = 0
static int CONTROL = 0;
// 221 %OWNINTEGER diag = 0; !diagnose flags
static int DIAG = 0;
// 222 %SHORTINTEGERARRAY hash(0:max names)
short int HASH[2048];
// 223 %RECORD(tagfm)%ARRAY tag(0:max tag)
struct TAGFM TAG[801];
// 224 %SHORTINTEGERARRAY dict(1:max dict)
short int DICT[6000];
// 225 %BYTEINTEGERARRAY buff(1:512)
unsigned char BUFF[512];
// 226 %OWNINTEGER bp = 0
static int BP = 0;
// 227
// 228 !*** start of generated tables ***
// 229 %endoflist
// 575 !*** end of generated tables ***
const _imp_string8 TEXT[256] = {
_imp_str_init("Z"), _imp_str_init("VDEC"), _imp_str_init("OWNVDEC"), _imp_str_init("EXTVSPEC"),
_imp_str_init("ADEC"), _imp_str_init("OWNADEC"), _imp_str_init("EXTASPEC"), _imp_str_init("PROC"),
_imp_str_init("PROCSPEC"), _imp_str_init("FORMDEC"), _imp_str_init("SWDEC"), _imp_str_init("LDEC"),
_imp_str_init("FORMSPEC"), _imp_str_init(""), _imp_str_init(""), _imp_str_init(""),
_imp_str_init(""), _imp_str_init(""), _imp_str_init("OPTION"), _imp_str_init("COMMA"),
_imp_str_init("T"), _imp_str_init("COLON"), _imp_str_init("COMMENT"), _imp_str_init("LB"),
_imp_str_init("ALIAS"), _imp_str_init("RB"), _imp_str_init("SUB"), _imp_str_init("ARRAYD"),
_imp_str_init("STYPE"), _imp_str_init("ARRAY"), _imp_str_init("NAME"), _imp_str_init("PROCD"),
_imp_str_init("FNMAP"), _imp_str_init("SWITCH"), _imp_str_init("OWN"), _imp_str_init("EXTERNAL"),
_imp_str_init("STRING"), _imp_str_init("RECORD"), _imp_str_init("FORMAT"), _imp_str_init("SPEC"),
_imp_str_init("MCODE"), _imp_str_init("LABEL"), _imp_str_init("OP1"), _imp_str_init("OP2"),
_imp_str_init("OP3"), _imp_str_init("SIGN"), _imp_str_init("UOP"), _imp_str_init("MOD"),
_imp_str_init("DOT"), _imp_str_init("COMP"), _imp_str_init("ACOMP"), _imp_str_init("EQ"),
_imp_str_init("EQEQ"), _imp_str_init("JAM"), _imp_str_init("JUMP"), _imp_str_init("RESOP"),
_imp_str_init("AND"), _imp_str_init("OR"), _imp_str_init("NOT"), _imp_str_init("WHILE"),
_imp_str_init("UNTIL"), _imp_str_init("FOR"), _imp_str_init("CWORD"), _imp_str_init("EXIT"),
_imp_str_init("ON"), _imp_str_init("SIGNAL"), _imp_str_init("THEN"), _imp_str_init("START"),
_imp_str_init("ELSE"), _imp_str_init("FINISH"), _imp_str_init("FELSE"), _imp_str_init("CYCLE"),
_imp_str_init("REPEAT"), _imp_str_init("PROGRAM"), _imp_str_init("BEGIN"), _imp_str_init("END"),
_imp_str_init("ENDPROG"), _imp_str_init("ENDPERM"), _imp_str_init("FRESULT"), _imp_str_init("MRESULT"),
_imp_str_init("BACK"), _imp_str_init("MONITOR"), _imp_str_init("STOP"), _imp_str_init("LIST"),
_imp_str_init("REALSLN"), _imp_str_init("CONTROL"), _imp_str_init("INCLUDE"), _imp_str_init("MASS"),
_imp_str_init("RTYPE"), _imp_str_init("ADDOP"), _imp_str_init("IDENT"), _imp_str_init("V"),
_imp_str_init("N"), _imp_str_init("CONST"), _imp_str_init("FM"), _imp_str_init(""),
_imp_str_init("R"), _imp_str_init("F"), _imp_str_init("M"), _imp_str_init("P"),
_imp_str_init("RP"), _imp_str_init("FP"), _imp_str_init("MP"), _imp_str_init("PP"),
_imp_str_init("L"), _imp_str_init("S"), _imp_str_init("A"), _imp_str_init("AN"),
_imp_str_init("NA"), _imp_str_init("NAN"), _imp_str_init(""), _imp_str_init(""),
_imp_str_init(""), _imp_str_init(""), _imp_str_init(""), _imp_str_init(""),
_imp_str_init(""), _imp_str_init(""), _imp_str_init(""), _imp_str_init(""),
_imp_str_init("%MSTART"), _imp_str_init("%CLEAR"), _imp_str_init("%PRED"), _imp_str_init(""),
_imp_str_init("%DUBIOUS"), _imp_str_init("%DUP"), _imp_str_init("%PIN"), _imp_str_init("%POUT"),
_imp_str_init("%EDUP"), _imp_str_init(""), _imp_str_init("PIDENT"), _imp_str_init("CIDENT"),
_imp_str_init("OIDENT"), _imp_str_init("FNAME"), _imp_str_init("SWID"), _imp_str_init("DOTL"),
_imp_str_init("DOTR"), _imp_str_init("ASEP"), _imp_str_init("CSEP"), _imp_str_init("OSEP"),
_imp_str_init("PSEP"), _imp_str_init("ARB"), _imp_str_init("BPLRB"), _imp_str_init("ORB"),
_imp_str_init("PRB"), _imp_str_init("CRB"), _imp_str_init("RCRB"), _imp_str_init("RECRB"),
_imp_str_init("RECLB"), _imp_str_init("LAB"), _imp_str_init("MLAB"), _imp_str_init("SLAB"),
_imp_str_init("XNAME"), _imp_str_init("OWNT"), _imp_str_init("DBSEP"), _imp_str_init("PCONST"),
_imp_str_init("CMOD"), _imp_str_init("CSIGN"), _imp_str_init("CUOP"), _imp_str_init("COP1"),
_imp_str_init("COP2"), _imp_str_init("COP3"), _imp_str_init("INDEF"), _imp_str_init("XELSE"),
_imp_str_init("CRESOP"), _imp_str_init("NLAB"), _imp_str_init("RUNTIL"), _imp_str_init("ACONST"),
_imp_str_init("ORRB"), _imp_str_init("FMANY"), _imp_str_init("OSTRING"), _imp_str_init("FMLB"),
_imp_str_init("FMRB"), _imp_str_init("FMOR"), _imp_str_init("RANGERB"), _imp_str_init("FSID"),
_imp_str_init(""), _imp_str_init(""), _imp_str_init(""), _imp_str_init(""),
_imp_str_init(""), _imp_str_init("%DUMMY"), _imp_str_init("%DECL"), _imp_str_init("%TYPE"),
_imp_str_init("%ZERO"), _imp_str_init("%APPLY"), _imp_str_init("%PROT"), _imp_str_init("%SETPROT"),
_imp_str_init("%PTYPE"), _imp_str_init("%GAPP"), _imp_str_init("%LOCAL"), _imp_str_init("%GUARD"),
_imp_str_init("%MCODE"), _imp_str_init("%CDUMMY"), _imp_str_init("%SETTYPE"), _imp_str_init("%OPER"),
_imp_str_init("%PARAM"), _imp_str_init("%BLOCK"), _imp_str_init("%OTHER"), _imp_str_init("%COMPILE"),
_imp_str_init("APP"), _imp_str_init("BASEAPP"), _imp_str_init("APP2"), _imp_str_init("APP3"),
_imp_str_init("APP4"), _imp_str_init("APP5"), _imp_str_init("APP6"), _imp_str_init("ADEFN"),
_imp_str_init("NPARM"), _imp_str_init("SWDEF"), _imp_str_init("SWIDS"), _imp_str_init("CIEXP"),
_imp_str_init("RCONST"), _imp_str_init("SCONST"), _imp_str_init("ARRAYP"), _imp_str_init("XIMP"),
_imp_str_init("IMP"), _imp_str_init("COND"), _imp_str_init("SCOND"), _imp_str_init("EXP1"),
_imp_str_init("EXP2"), _imp_str_init("SEXP"), _imp_str_init("IEXP"), _imp_str_init("IEXP1"),
_imp_str_init("IEXP2"), _imp_str_init("ISEXP"), _imp_str_init("SEQ"), _imp_str_init("FDEF"),
_imp_str_init("EXP"), _imp_str_init("NARRAYP"), _imp_str_init("STRUCT"), _imp_str_init("RESEXP"),
_imp_str_init("BPL"), _imp_str_init("CONSTB"), _imp_str_init("FITEM"), _imp_str_init("MOREA"),
_imp_str_init("CLIST"), _imp_str_init("FPP"), _imp_str_init("FPP0"), _imp_str_init("FPP1"),
_imp_str_init("FPP2"), _imp_str_init("INITVAR"), _imp_str_init("RECEXP"), _imp_str_init("EIMP"),
_imp_str_init("IDENTS"), _imp_str_init("RANGE"), _imp_str_init("RCONSTB"), _imp_str_init("VARP"),
_imp_str_init("INITDEC"), _imp_str_init(""), _imp_str_init(""), _imp_str_init(""),
_imp_str_init("ESCDEC"), _imp_str_init("ESCPROC"), _imp_str_init("ESCARRAY"), _imp_str_init("ESCREC")};
// 576
static int GMAX = 719;
// 577 %ROUTINE flush buffer
static short int PHRASE[56] = {0, 564, 565, 567, 569, 571, 573, 562, 614, 203, 200, 602, 478, 480,
624, 298, 206, 308, 318, 433, 426, 437, 444, 458, 453, 461, 467, 482,
402, 627, 629, 603, 521, 511, 486, 502, 575, 527, 528, 543, 550, 578,
397, 287, 197, 636, 516, 621, 167, 0, 0, 0, 640, 693, 701, 709};
// 578 %INTEGER j
const unsigned char ATOMIC[50] = {90, 90, 90, 90, 90, 48, 48, 19, 19, 19, 19, 25, 25, 25, 25, 25, 25,
25, 23, 104, 104, 105, 30, 20, 21, 93, 47, 45, 46, 42, 43, 44, 40, 68,
55, 104, 60, 93, 25, 40, 93, 23, 25, 57, 25, 90, 176, 177, 178, 179};
// 579 %IF faulty = 0 %START
const short int INITIAL[120] = {
24, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
23, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 20, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
-32551, 0, 0, 0, 0, 13, 0, 14, 4, -32557, 16, -32550, 0, 0, 5, 6, 3, 12,
15, 8, 7, 9, 10, 11, -32558, -32554, -32559, -32552, -32553, 18, 22, 17, 21, 19, 0, 0,
0, -32562, -32560, 0, 0, 0, -32561, 0, 0, 0, 0, 0, 0, 0, 1, 2, 0, -32556,
0, -32555, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
// 580 select output(object)
static short int GRAM[1721] = {0, -28523, -28521, -28602, -32706, -28509, -28603,
-24502, -24503, -20405, -20404, -28595, -32697, -32709,
-16323, -28600, -32704, -28587, -28589, -32681, -16344,
-28586, -28588, -12270, -32586, 216, -12287, -16380,
-8185, -8184, -12285, -12286, -12283, -12282, -12279,
-12276, -16373, 20490, -32706, -32701, 216, -16364,
-28610, -28613, -28612, 16445, 217, -16364, 62,
-32701, 16450, -16364, 5346, -16364, 166, -16344,
4332, 130, -16360, -16361, 126, 217, -32701,
216, -16364, 16450, -32700, 16404, -32701, -32706,
216, 16405, 16407, -16222, 8414, 130, 217,
-32697, 16450, 1250, 4307, 4318, 192, 93,
170, 90, 207, -16365, 16404, 90, -16360,
-16365, 16404, 241, -16365, 16404, 132, 132,
-16360, 4329, -16365, 16404, 133, 175, 90,
-16365, 16404, 209, -16365, 16404, 4313, 217,
16451, 4263, 16384, 16384, 120, 216, -32700,
16404, -32706, 16404, 243, 16409, 454, -32685,
16404, 454, 248, -16365, 16404, 4263, 194,
-16360, 4329, -32717, 16404, 4263, 16407, 454,
237, 127, 215, 454, 4263, 16384, -16364,
1502, -32629, -16361, 153, -32606, 222, 143,
-32629, 153, 454, 126, 16409, 454, 16384,
234, -16365, -32595, 147, -32678, 234, 193,
-32677, -32676, -32661, 109, -32717, 53, 52,
52, 52, 194, 194, 194, -28581, 4188,
194, -28566, 4203, 194, -28564, 4205, 4580,
16429, 183, 183, 186, 186, -28583, 0,
9437, 90, -16365, 0, 134, -16365, 0,
210, 4329, 199, -32677, -32672, -32676, -32688,
-32690, -32705, -32661, -32659, -32689, -32686, -32687,
-16330, 65, -32716, 186, -28583, -32717, -32715,
-32713, 52, -32664, 4201, 186, -32717, -32715,
55, -16328, 0, 197, 197, 52, 52,
197, -28581, -28580, 186, -28581, 4188, 4318,
194, -28581, 4188, 9437, 194, 194, 454,
16407, 216, 194, -28566, -28565, 186, -28566,
4203, 194, -28564, -28563, 186, -28564, 4205,
183, 183, 186, 183, -16365, 0, 183,
4580, 16429, 5095, 9444, 5348, 186, -28583,
-16328, 0, 16409, -16365, 0, 9437, 5348,
217, -32701, 16450, -32701, 216, -32700, 0,
-32701, -32706, 216, 243, 217, -16318, 0,
-32552, 0, -32700, 0, -32706, 0, 215,
-32550, 228, -28616, -28615, 0, 4096, 218,
218, -28616, 0, -32677, -32676, -16361, -32710,
-32669, -32662, -32661, -32660, -32659, 740, -32039,
740, -32719, 4096, 194, -32719, -32718, -32604,
-32726, -32725, -32724, -32720, 4096, 710, 6116,
-32719, 0, 710, 6116, -28581, 4188, 218,
122, 50, 16409, -32726, -32725, -32724, -32719,
4096, 710, 454, 195, 195, 195, 454,
-28581, 4188, 194, -28566, -28565, -28564, 4205,
195, 195, 195, 710, 4836, 5095, 4829,
-32726, -32725, -32724, -32719, 4096, 4827, 4828,
454, -32720, -32719, 4096, 4829, 4827, 4828,
194, -32719, 0, 710, 4836, -16291, -32677,
92, 184, 121, -28581, -28580, -32722, -32723,
4317, -32726, -32725, -32724, 0, 183, -32726,
-32725, -32724, -32720, 0, 4316, 195, 195,
195, 454, -28581, 4188, 4315, 183, 4317,
-32726, -32725, 0, 195, 195, 4315, 4317,
-32726, 0, 195, -32677, -32676, -16361, 16431,
228, 228, 47, -32610, -32611, 5345, -32609,
-32608, -32607, 0, 4320, 4319, 5345, -32609,
-32608, 0, 4319, 5345, -32609, 0, -32613,
-16361, 16431, 222, 222, 156, -32677, 92,
183, 186, 1222, 16435, 228, 16403, 4324,
138, 8420, -32723, 4189, 93, 454, 148,
-32674, 16546, 16409, -32597, 182, -16383, 16388,
234, -16365, -32595, 172, -32678, 234, 90,
244, 246, -16365, 0, 235, -32678, 234,
-16365, 246, -16365, 0, -32678, 234, 90,
16407, 222, 16405, 222, 145, 16407, 222,
16405, 222, 146, 16407, 1252, 154, 5348,
-16365, 142, 126, 182, -16383, 16391, 90,
-16365, 127, -32678, 238, 90, 125, 239,
-16365, 8319, 8430, 128, 126, -16361, 127,
190, 240, 189, 16409, 182, -16383, 16391,
90, -16365, 0, -32678, 240, 90, 16623,
-16365, 0, 244, 232, 1252, 1252, 137,
1252, 137, 1252, 137, 1252, 137, 1252,
137, 222, -16365, 0, 131, 194, -16360,
-16333, -16332, 124, 181, -16292, -16277, 16493,
-31802, 5342, -28581, 4188, 4263, 181, 186,
454, 16475, 183, -28583, 199, 5598, 9438,
222, -32677, -32676, 16407, 186, 228, 135,
16409, -32632, 0, -32677, 92, -32677, -32676,
-32662, -32661, -32660, -32659, 165, -32677, 92,
188, -32662, 107, 188, -32660, 109, -32732,
37, -16344, 4318, 148, -32674, 16424, 222,
16405, 222, 174, -28644, -32734, -32680, -28641,
-32733, -32730, -32735, -32727, -32738, 4326, -32738,
-32739, -32741, -32736, 199, -28644, -32680, -28641,
4326, -32739, -32741, 199, -32738, -32739, -32741,
-32736, -32729, 199, -32616, 199, -32739, -32741,
-32729, 199, -32616, -32729, 199, -28644, -32680,
4326, -32738, -32739, -32741, 199, 245, 4318,
245, 16409, 152, 4318, 16409, 152, 245,
-32672, -32671, -32670, 99, 16407, 200, 144,
185, -32677, 92, 16407, -32582, 200, 200,
187, 141, -32677, 92, 16410, 191, -32677,
-32676, -32662, -32661, -32660, 109, 198, [720 ... 1720] = 0};
// 581 %FOR j = 1, 1, bp %CYCLE
static short int GLINK[1721] = {-1, 71, 72, 38, 46, 47, 67,
67, 75, 67, 0, 67, 51, 76,
79, 53, 55, 80, 67, 81, 82,
83, 67, 84, 26, 41, 85, 86,
57, 57, 89, 93, 96, 97, 102,
103, 104, 107, 46, 67, 67, 0,
110, 110, 111, 52, 49, 0, 61,
67, 62, 0, 67, 0, 111, 112,
112, 58, 113, 114, 115, 64, 67,
66, 116, 117, 68, 0, 67, 122,
67, 0, 73, 123, 123, 67, 77,
67, 40, 77, 67, 67, 0, 124,
127, 128, 87, 86, 0, 90, 131,
89, 0, 94, 93, 0, 132, 98,
137, 100, 97, 0, 138, 67, 105,
104, 0, 108, 107, 0, 67, 67,
67, 139, 140, 141, 0, 118, 120,
116, 142, 116, 67, 71, 125, 67,
0, 67, 129, 85, 0, 143, 133,
144, 135, 145, 0, 156, 157, 59,
158, 67, 119, 91, 159, 146, 145,
148, 146, 151, 0, 153, 153, 154,
146, 0, 99, 160, 67, 134, 161,
162, 165, 161, 141, 162, 162, 168,
172, 174, 175, 176, 177, 178, 179,
182, 185, 188, 189, 180, 190, 190,
183, 191, 191, 186, 191, 191, 0,
188, 192, 193, 194, 0, 196, 0,
0, 198, 197, 0, 201, 200, 0,
204, 205, 0, 228, 232, 219, 234,
235, 0, 236, 237, 238, 0, 232,
226, 244, 245, 221, 248, 249, 250,
251, 245, 0, 252, 229, 249, 250,
251, 253, 0, 0, 188, 254, 260,
239, 269, 269, 242, 191, 191, 270,
246, 272, 272, 229, 273, 274, 275,
276, 0, 255, 266, 266, 258, 267,
267, 261, 266, 266, 264, 267, 267,
232, 268, 232, 0, 277, 0, 278,
232, 273, 232, 282, 283, 279, 285,
253, 0, 0, 286, 0, 232, 0,
288, 0, 290, 0, 292, 294, 0,
0, 297, 0, 0, 299, 301, 0,
303, 0, 305, 0, 307, 0, 0,
310, 313, 314, 315, 0, 0, 316,
311, 314, 0, 332, 332, 328, 349,
350, 351, 351, 351, 351, 330, 282,
352, 358, 0, 333, 341, 347, 359,
360, 361, 362, 363, 0, 342, 343,
345, 0, 346, 0, 269, 269, 0,
0, 366, 353, 371, 372, 373, 374,
0, 375, 376, 377, 383, 384, 364,
385, 385, 367, 269, 269, 269, 269,
389, 390, 391, 392, 393, 0, 378,
360, 361, 362, 341, 0, 379, 380,
386, 363, 341, 0, 353, 354, 355,
375, 395, 0, 396, 0, 400, 269,
269, 401, 0, 411, 411, 406, 417,
407, 418, 419, 420, 0, 412, 418,
419, 420, 421, 0, 409, 406, 424,
417, 422, 425, 425, 408, 415, 427,
430, 431, 0, 426, 432, 428, 434,
436, 0, 433, 269, 269, 441, 442,
282, 443, 0, 446, 451, 447, 446,
452, 451, 0, 449, 448, 454, 453,
457, 0, 455, 459, 458, 0, 269,
464, 465, 282, 466, 0, 469, 469,
470, 471, 472, 473, 474, 475, 476,
477, 0, 479, 269, 481, 0, 483,
485, 485, 205, 490, 488, 496, 497,
491, 494, 490, 0, 491, 491, 0,
498, 499, 501, 0, 0, 504, 506,
510, 499, 508, 0, 506, 506, 504,
512, 513, 514, 515, 0, 517, 518,
519, 520, 0, 522, 523, 524, 525,
522, 0, 528, 529, 531, 536, 532,
534, 0, 532, 0, 537, 538, 539,
541, 542, 542, 0, 544, 546, 0,
547, 548, 549, 533, 551, 553, 558,
554, 556, 0, 554, 0, 559, 560,
557, 0, 563, 205, 0, 566, 564,
568, 565, 570, 567, 572, 569, 574,
571, 576, 575, 0, 579, 580, 592,
593, 584, 205, 585, 588, 588, 588,
590, 205, 594, 594, 595, 596, 597,
581, 600, 598, 601, 0, 205, 205,
205, 606, 606, 607, 608, 609, 605,
610, 612, 0, 193, 193, 193, 193,
193, 193, 193, 193, 0, 623, 623,
192, 626, 626, 0, 626, 626, 631,
633, 282, 282, 634, 282, 282, 637,
638, 639, 0, 650, 677, 684, 666,
655, 205, 205, 205, 205, 650, 659,
668, 685, 666, 0, 662, 686, 666,
662, 668, 685, 0, 670, 674, 689,
666, 205, 0, 205, 0, 674, 689,
205, 0, 666, 205, 0, 680, 692,
680, 659, 668, 685, 0, 650, 687,
662, 688, 205, 690, 691, 666, 680,
697, 697, 697, 697, 698, 699, 700,
0, 703, 703, 704, 706, 707, 708,
708, 700, 711, 711, 712, 713, 719,
719, 719, 719, 719, 719, 0, [720 ... 1720] = 0};
// 582 printsymbol(buff(j))
const short int KDICT[576] = {
0, 511, 131, 531, 131, 551, 559, 131, 567, 575, 583, 603, 623, 631,
663, 671, 129, 129, 129, 129, 129, 129, 129, 129, 129, 129, 691, 698,
707, 751, 795, 131, 131, 824, 900, 960, 1076, 1120, 1280, 128, 128, 1392,
128, 128, 1460, 1556, 1592, 1660, 1748, 128, 1828, 2044, 2240, 2272, 128, 2312,
128, 128, 128, 2331, 2339, 2371, 2379, 2399, 131, 131, 131, 131, 131, 131,
131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131, 131,
131, 131, 131, 131, 131, 131, 131, 131, 2407, 131, 2379, -32351, 16428, 25,
16428, 29, -32349, 16433, 1, 16434, 1, -16127, 0, 16427, 21, 16407, 0, 16409,
0, -32323, -10840, 40, 16471, 0, -32341, -10580, 32, 16473, 117, 16384, 19, -31955,
-32322, -10580, 36, -9290, 0, 16473, 113, 16432, 13, -32337, 16427, 46, 16427, 17,
16405, 0, 16404, 0, -31556, -31939, -32322, -9551, 2, 16433, 1, 16433, 5, 16426,
5, -31606, -32323, -9807, 0, -32374, -9678, 0, 16436, 0, 16435, 0, -31939, -32322,
16433, 4, 16426, 9, 16433, 3, -30772, -31666, 10578, 11457, -32344, 16413, 2, 16411,
2, 68, -32374, 16440, 0, 16440, 0, 8393, 83, 16408, 0, -31291, 10841, 69,
-32311, 16412, 18, 10830, 9157, 10565, 16412, 18, 9415, 78, 16458, 0, -32049, 8665,
8908, 16455, 0, -30131, 78, -31277, 84, -32055, 10194, 76, 16469, 0, 10958, 69,
16447, 32, 84, -32319, 16418, 2, 10830, 16418, 2, 8909, 10830, 16406, 0, -31927,
10073, 9921, 8649, 16419, 5, 9153, 10190, 8915, 16469, 1, -27956, -31282, 88, -31927,
8916, 10066, 9793, 16419, 3, 84, 16447, 4, 68, -32305, 16459, 2, 70, -30650,
-31284, 80, -31931, 10194, 10567, 9921, 16460, 1, 9938, 16461, 0, 10697, 84, 16467,
3, 9801, 69, 16460, 0, 8915, 16452, 0, -29631, -30903, -31282, -31793, 10069, 10819,
10185, 78, 16416, 9, 82, 16445, 0, 16416, 9, 9422, 9299, -32315, 16453, 0,
10700, 69, 16454, 0, 10700, 69, 16464, 1210, -30778, 78, -31549, 8916, 8903, 82,
-32344, 16412, 17, 16472, 17, 10956, 8900, 16470, 0, 16446, 44, -30143, -30647, 10063,
71, -31671, -32302, 16412, 20, 8389, 76, 16412, 36, 10830, 9157, 10565, 16412, 20,
10835, 16467, 1, 8898, 76, 16425, 6, -31935, 10063, 10825, 10575, 16465, 109, 80,
16416, 10, -32191, 10831, 16442, 0, 8909, -32314, 16414, 1, -31794, 10069, 10819, 10185,
78, 16416, 10, 16416, 10, -30770, -31408, -32174, 10071, 16418, 1, -32374, 16441, 2,
16441, 2, 9428, 10063, 16402, 0, -32315, 16448, 0, 8918, 10830, 16448, 0, -30523,
82, -31419, -31927, 9167, 8402, 77, 16457, 0, 77, 16419, 6, 9412, 8387, 8916,
16415, 123, 9938, 16419, 7, -31931, 10959, 9428, 8910, 16415, 104, -28351, -30397, -31024,
-32045, 10964, 10066, 16464, 1319, 9813, 7892, -32323, 16462, 1384, 16463, 1241, 8389, 84,
16456, 0, 10575, 68, -32314, 16421, 64, 10575, 8397, 84, -32301, 16422, 9, 8912,
67, 16422, 12, 76, -32301, 16412, 33, -31924, 10190, 9938, 9793, 16468, 1, 10063,
71, 16468, 4, -27704, -28983, -29488, -31276, -31913, 10713, 8916, 77, 16419, 4, 10825,
9283, 16417, 12, -31423, -31921, 9426, 9166, 40, 16420, 48, 80, 16466, 115, 10834,
16451, 0, 8645, 16423, 0, 10055, 9793, -32315, 16449, 0, 8918, 10830, 16449, 0,
10575, 84, -32311, 16412, 19, 10830, 9157, 10565, 16412, 19, -32056, 10962, 69, 16464,
1354, 10053, 16450, 0, 78, -32052, 9428, 76, 16444, 182, 10693, 83, 16446, 46,
9416, 8908, 16443, 180, 16407, 0, -31939, -32292, -10454, 51, 16426, 13, 16433, 1,
16409, 0, -32290, -10454, 51, 16426, 13, 16410, 0, 16431, 14, -32323, 16430, 51,
16433, 1};
// 583 %REPEAT
void FLUSHBUFFER(void) {
// 584 select output(listing)
int J;
// 585 %FINISH
if (FAULTY != 0) goto L_0001;
// 586 bp = 0
_imp_SELECTOUTPUT(1);
// 587 %END
// %for J = 1, 1, BP %cycle
{
int _final = BP;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle J = 1, 1, BP");
J = 0;
L_0002:
if (J == _final) goto L_0003;
J += 1;
// 588 %ROUTINE print ident(%INTEGER p, mode)
_imp_PRINTSYMBOL(BUFF[J - 1]);
// 589 %INTEGER j, ad
goto L_0002;
}
L_0003:;
// 590 p = tag(p)_text
_imp_SELECTOUTPUT(2);
// 591 %IF p = 0 %START
L_0001:;
// 592 bp = bp+1 %AND buff(bp) = '?' %if Mode # 0
BP = 0;
// 593 %RETURN
return;
} /* end of FLUSHBUFFER */
// 594 %FINISH
void PRINTIDENT(int P, int MODE) {
// 595 ad = addr(dict(p+1))
int J;
int AD;
// 596 %IF mode = 0 %THEN printstring(string(ad)) %ELSE %START
P = TAG[P].TEXT;
// 597 %FOR j = ad+1, 1, ad+byteinteger(ad) %CYCLE
if (P != 0) goto L_0005;
// 598 bp = bp+1
if (MODE == 0) goto L_0006;
BP = BP + 1;
BUFF[BP - 1] = 63;
L_0006:;
// 599 buff(bp) = byteinteger(j)
return;
// 600 %REPEAT
L_0005:;
// 601 %FINISH
AD = _imp_ADDR(/*?*/ &DICT[P + 1 - 1]);
// 602 %END
if (MODE != 0) goto L_0007;
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *_imp_STRING(AD) /*q*/;
(_imp_string255 *)&tmp;
})
);
goto L_0008;
L_0007:;
// 603 %ROUTINE abandon(%INTEGER n)
// %for J = AD + 1, 1, AD + *_imp_BYTEINTEGER(AD) %cycle
{
int _initial = AD + 1, _final = AD + *_imp_BYTEINTEGER(AD);
if (invalid_for_loop(_initial, 1, _final))
_imp_signal(5, 1, 0, "Illegal cycle J = AD + 1, 1, AD + *_imp_BYTEINTEGER(AD)");
J = _initial - (1);
L_0009:
if (J == _final) goto L_000A;
J += 1;
// 604 %SWITCH reason(0:9)
BP = BP + 1;
// 605 %INTEGER stream
BUFF[BP - 1] = *_imp_BYTEINTEGER(J);
// 606 stream = listing
goto L_0009;
}
L_000A:;
// 607 %CYCLE
L_0008:;
// 608 newline %IF sym # nl
return;
} /* end of PRINTIDENT */
// 609 printsymbol('*'); write(lines,4); space
void ABANDON(int N) {
// 610 ->reason(n)
int REASON_index;
int REASON_line;
char *REASON_file;
static const void *REASON[10] = {&&case_REASON_missing, &&case_REASON_missing, &&case_REASON_missing,
&&case_REASON_missing, &&case_REASON_missing, &&case_REASON_missing,
&&case_REASON_missing, &&case_REASON_missing, &&case_REASON_missing,
&&case_REASON_missing};
// 611 reason(0):printstring("compiler error!"); ->more
int STREAM;
// 612 reason(1):printstring("switch vector too large"); ->more
STREAM = 2;
// 613 reason(2):printstring("too many names"); ->more
L_000B:;
// 614 reason(3):printstring("program too complex"); ->more
if (SYM == 10) goto L_000C;
_imp_NEWLINE();
L_000C:;
// 615 reason(4):printstring("feature not implemented"); ->more
_imp_PRINTSYMBOL(42);
_imp_WRITE(LINES, 4);
_imp_SPACE();
// 616 reason(5):printstring("input ended: ")
REASON_line = __LINE__;
REASON_file = __FILE__;
REASON_index = N;
goto case_REASON_dispatch;
// 617 %IF quote # 0 %START
case_REASON_0:;
_imp_PRINTSTRING(_imp_str_literal("compiler error!"));
goto U_1000;
// 618 %IF quote < 0 %THEN printsymbol(cquote) %C
case_REASON_1:;
_imp_PRINTSTRING(_imp_str_literal("switch vector too large"));
goto U_1000;
// 619+ %ELSE printsymbol(squote)
case_REASON_2:;
_imp_PRINTSTRING(_imp_str_literal("too many names"));
goto U_1000;
// 620 %ELSE
case_REASON_3:;
_imp_PRINTSTRING(_imp_str_literal("program too complex"));
goto U_1000;
// 621 printstring("%endof")
case_REASON_4:;
_imp_PRINTSTRING(_imp_str_literal("feature not implemented"));
goto U_1000;
// 622 %IF progmode >= 0 %THEN printstring("program") %C
case_REASON_5:;
_imp_PRINTSTRING(_imp_str_literal("input ended: "));
// 623+ %ELSE printstring("file")
if (QUOTE == 0) goto L_000E;
// 624 %FINISH
if (QUOTE >= 0) goto L_000F;
_imp_PRINTSYMBOL(39);
goto L_0010;
L_000F:;
_imp_PRINTSYMBOL(34);
L_0010:;
// 625 printstring(" missing?"); ->more
goto L_0011;
L_000E:;
// 626 reason(6):printstring("too many faults!"); ->more
_imp_PRINTSTRING(_imp_str_literal("%endof"));
// 627 reason(7):printstring("string constant too long"); ->more
if (PROGMODE < 0) goto L_0012;
_imp_PRINTSTRING(_imp_str_literal("program"));
goto L_0013;
L_0012:;
_imp_PRINTSTRING(_imp_str_literal("file"));
L_0013:;
// 628 reason(8):printstring("dictionary full"); -> more
L_0011:;
// 629 reason(9):printstring("Included file ".include file." does not exist")
_imp_PRINTSTRING(_imp_str_literal(" missing?"));
goto U_1000;
// 630 more: newline
case_REASON_6:;
_imp_PRINTSTRING(_imp_str_literal("too many faults!"));
goto U_1000;
// 631 printstring("*** compilation abandoned ***"); newline
case_REASON_7:;
_imp_PRINTSTRING(_imp_str_literal("string constant too long"));
goto U_1000;
// 632 %EXIT %IF stream = report
case_REASON_8:;
_imp_PRINTSTRING(_imp_str_literal("dictionary full"));
goto U_1000;
// 633 close output
case_REASON_9:;
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &*({
_imp_string255 tmp =
_imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("Included file "),
(_imp_string *)/*?*/ &INCLUDEFILE);
(_imp_string255 *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr(" does not exist"));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
// 634 stream = report
U_1000:;
_imp_NEWLINE();
// 635 select output(report)
_imp_PRINTSTRING(_imp_str_literal("*** compilation abandoned ***"));
_imp_NEWLINE();
// 636 %REPEAT
if (STREAM != 0) goto L_0014;
goto L_0015;
L_0014:;
// 637 !IMP80 BUG??? %SIGNAL 15,15 %IF diag&4096 # 0
CLOSEOUTPUT();
// 638 %STOP
STREAM = 0;
// 639 %END
_imp_SELECTOUTPUT(0);
// 640 %ROUTINE op(%INTEGER code, param)
goto L_000B;
L_0015:;
// 641 buff(bp+1) <- code
_imp_stop(0);
// 642 buff(bp+2) <- param>>8
case_REASON_dispatch:
if (REASON_index < 0 || REASON_index > 9)
_imp_signalf(6, 3, REASON_index, "->REASON(%d) out of bounds at %s line %d", REASON_index, REASON_file,
REASON_line);
goto *REASON[REASON_index - 0];
case_REASON_missing:
_imp_signalf(8, 2, REASON_index, "switch jump to undefined label REASON(%d): at %s line %d", REASON_index,
REASON_file, REASON_line);
} /* end of ABANDON */
// 643 buff(bp+3) <- param
void OP(int CODE, int PARAM) {
// 644 bp = bp+3
BUFF[BP + 1 - 1] = (unsigned char)(CODE);
// 645 %END
BUFF[BP + 2 - 1] = (unsigned char)((unsigned int)PARAM >> 8);
// 646 %ROUTINE set const(%INTEGER m)
BUFF[BP + 3 - 1] = (unsigned char)(PARAM);
// 647 buff(bp+1) <- 'N'
BP = BP + 3;
// 648 buff(bp+5) <- m; m = m>>8
return;
} /* end of OP */
// 649 buff(bp+4) <- m; m = m>>8
void SETCONST(int M) {
// 650 buff(bp+3) <- m; m = m>>8
BUFF[BP + 1 - 1] = (unsigned char)(78);
// 651 buff(bp+2) <- m
BUFF[BP + 5 - 1] = (unsigned char)(M);
M = (unsigned int)M >> 8;
// 652 bp = bp+5
BUFF[BP + 4 - 1] = (unsigned char)(M);
M = (unsigned int)M >> 8;
// 653 %END
BUFF[BP + 3 - 1] = (unsigned char)(M);
M = (unsigned int)M >> 8;
// 654
BUFF[BP + 2 - 1] = (unsigned char)(M);
// 655
BP = BP + 5;
// 656
return;
} /* end of SETCONST */
// 657 %ROUTINE compile block(%INTEGER level, block tag, dmin, tmax, id)
void COMPILEBLOCK(int LEVEL, int BLOCKTAG, int DMIN, int TMAX, int ID) {
auto int GAPP(void);
auto void DELETENAMES(int QUIET);
auto void ANALYSE(void);
auto void COMPILE(void);
// 658
// 659 %INTEGERFNSPEC gapp
// 660 %ROUTINESPEC delete names(%INTEGER quiet)
// 661 %ROUTINESPEC analyse
// 662 %ROUTINESPEC compile
// 663
// 664 %INTEGER open; open = closed; !zero if can return from proc
int OPEN;
OPEN = 16384;
// 665 %INTEGER dbase; dbase = dmax; !dictionary base
int DBASE;
DBASE = DMAX;
// 666 %INTEGER tbase; tbase = tmax; !tag base
int TBASE;
TBASE = TMAX;
// 667 %INTEGER tstart; tstart = tmax
int TSTART;
TSTART = TMAX;
// 668 %INTEGER label; label = 4; !first internal label
int LABEL;
LABEL = 4;
// 669 %INTEGER access; access = 1; !non-zero if accessible
int ACCESS;
ACCESS = 1;
// 670 %INTEGER inhibit; inhibit = 0; !non-zero inhibits declaratons
int INHIBIT;
INHIBIT = 0;
// 671
// 672 %SHORTINTEGERNAME bflags; bflags == tag(block tag)_flags
short int *BFLAGS;
BFLAGS = (short int *)/*?*/ &TAG[BLOCKTAG].FLAGS;
// 673 %INTEGER block type; block type = bflags>>4&7
int BLOCKTYPE;
BLOCKTYPE = (unsigned int)*BFLAGS >> 4 & 7;
// 674 %INTEGER block form; block form = bflags&15
int BLOCKFORM;
BLOCKFORM = *BFLAGS & 15;
// 675 %INTEGER block fm; block fm = tag(block tag)_format
int BLOCKFM;
BLOCKFM = TAG[BLOCKTAG].FORMAT;
// 676 %INTEGER block otype; block otype = otype
int BLOCKOTYPE;
BLOCKOTYPE = OTYPE;
// 677 %INTEGERNAME block app; block app == tag(block tag)_app
int *BLOCKAPP;
BLOCKAPP = (int *)/*?*/ &TAG[BLOCKTAG].APP;
// 678
// 679 %INTEGER l, new app
int L;
int NEWAPP;
// 680
// 681 %ROUTINE fault(%INTEGER n)
void FAULT(int N) {
// 682
// 683 ! -5 : -1 - warnings
// 684 ! 1 : 22 - errors
// 685
// 686 %SWITCH fm(-5:22)
int FM_index;
int FM_line;
char *FM_file;
static const void *FM[28] = {&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing,
&&case_FM_missing, &&case_FM_missing, &&case_FM_missing, &&case_FM_missing};
// 687 %INTEGER st
int ST;
// 688
// 689 %ROUTINE print ss
void PRINTSS(void) {
// 690 %INTEGER s, p
int S;
int P;
// 691 %RETURN %IF pos = 0
if (POS != 0) goto L_0016;
return;
L_0016:;
// 692 space
_imp_SPACE();
// 693 p = 1
P = 1;
// 694 %CYCLE
L_0017:;
// 695 printsymbol(marker) %IF p = pos1
if (P != POS1) goto L_0018;
_imp_PRINTSYMBOL(94);
L_0018:;
// 696 %EXIT %IF p = pos
if (P != POS) goto L_0019;
goto L_001A;
L_0019:;
// 697 s = char(p); p = p+1
S = CHAR[P];
P = P + 1;
// 698 %EXIT %IF s = nl %OR (s='%' %AND p = pos)
if (S == 10) goto L_0004;
if (S != 37) goto L_001B;
if (P != POS) goto L_001B;
L_0004:;
goto L_001A;
L_001B:;
// 699 %IF s < ' ' %START; !beware of tabs
if (S >= 32) goto L_001C;
// 700 %IF s = ff %THEN s = nl %ELSE s = ' '
if (S != 12) goto L_001D;
S = 10;
goto L_001E;
L_001D:;
S = 32;
L_001E:;
// 701 %FINISH
L_001C:;
// 702 printsymbol(s)
_imp_PRINTSYMBOL(S);
// 703 %REPEAT
goto L_0017;
L_001A:;
// 704 pos = 0 %IF list <= 0
if (LIST > 0) goto L_001F;
POS = 0;
L_001F:;
// 705 %END
return;
} /* end of PRINTSS */
// 706
// 707 pos1 = pos2 %IF pos2 > pos1
if (POS2 <= POS1) goto L_0020;
POS1 = POS2;
L_0020:;
// 708 newline %IF sym # nl
if (SYM == 10) goto L_0021;
_imp_NEWLINE();
L_0021:;
// 709 st = report
ST = 0;
// 710 st = listing %IF n = -3; !don't report unused on the console
if (N != -3) goto L_0022;
ST = 2;
L_0022:;
// 711 %cycle
L_0023:;
// 712 SELECT OUTPUT(st)
_imp_SELECTOUTPUT(ST);
// 713 %if n < 0 %then printsymbol('?') %and pos1 = 0 %else printsymbol('*')
if (N >= 0) goto L_0024;
_imp_PRINTSYMBOL(63);
POS1 = 0;
goto L_0025;
L_0024:;
_imp_PRINTSYMBOL(42);
L_0025:;
// 714 %if st # report %start
if (ST == 0) goto L_0026;
// 715 %if list <= 0 %and pos1 # 0 %start
if (LIST > 0) goto L_0027;
if (POS1 == 0) goto L_0027;
// 716 spaces(pos1+margin); PRINTSTRING(" ! ")
_imp_SPACES(POS1 + MARGIN);
_imp_PRINTSTRING(_imp_str_literal(" ! "));
// 717 %finish
L_0027:;
// 718 %finish %else %start
goto L_0028;
L_0026:;
// 719 PRINTSTRING(include file) %if include # 0
if (INCLUDE == 0) goto L_0029;
_imp_PRINTSTRING(
*({
__typeof__(_imp_string63) tmp = INCLUDEFILE /*q*/;
(_imp_string255 *)&tmp;
})
);
L_0029:;
// 720 write(lines, 4); printsymbol(csym); space
_imp_WRITE(LINES, 4);
_imp_PRINTSYMBOL(CSYM);
_imp_SPACE();
// 721 %finish
L_0028:;
// 722 ->fm(n) %if -5 <= n <= 22
{
// Double-sided test on N (Part I)
int tmp;
if (-5 > (tmp = N)) goto L_002A;
// Double-sided test on N (Part II)
if (tmp > 22) goto L_002A;
}
FM_line = __LINE__;
FM_file = __FILE__;
FM_index = N;
goto case_FM_dispatch;
L_002A:;
// 723 PRINTSTRING("fault"); write(n, 2); ->ps
_imp_PRINTSTRING(_imp_str_literal("fault"));
_imp_WRITE(N, 2);
goto U_1001;
// 724
// 725 fm(-5):PRINTSTRING("Dubious statement"); dubious = 0; ->psd
case_FM_M5:;
_imp_PRINTSTRING(_imp_str_literal("Dubious statement"));
DUBIOUS = 0;
goto U_1002;
// 726 fm(-4):PRINTSTRING("Non-local")
case_FM_M4:;
_imp_PRINTSTRING(_imp_str_literal("Non-local"));
// 727 pos1 = for warn; for warn = 0; ->ps
POS1 = FORWARN;
FORWARN = 0;
goto U_1001;
// 728 fm(-3):print ident(x, 0); PRINTSTRING(" unused"); ->nps
case_FM_M3:;
PRINTIDENT(X, 0);
_imp_PRINTSTRING(_imp_str_literal(" unused"));
goto U_1003;
// 729 fm(-2):PRINTSTRING("""}"""); ->miss
case_FM_M2:;
_imp_PRINTSTRING(_imp_str_literal("\"}\""));
goto U_1004;
// 730 fm(-1):PRINTSTRING("access"); ->psd
case_FM_M1:;
_imp_PRINTSTRING(_imp_str_literal("access"));
goto U_1002;
// 731
// 732 fm(0): PRINTSTRING("form"); ->ps
case_FM_0:;
_imp_PRINTSTRING(_imp_str_literal("form"));
goto U_1001;
// 733 fm(1): PRINTSTRING("atom"); ->ps
case_FM_1:;
_imp_PRINTSTRING(_imp_str_literal("atom"));
goto U_1001;
// 734 fm(2): PRINTSTRING("not declared"); ->ps
case_FM_2:;
_imp_PRINTSTRING(_imp_str_literal("not declared"));
goto U_1001;
// 735 fm(3): PRINTSTRING("too complex"); ->ps
case_FM_3:;
_imp_PRINTSTRING(_imp_str_literal("too complex"));
goto U_1001;
// 736 fm(4): PRINTSTRING("duplicate "); Print Ident(x, 0); ->ps
case_FM_4:;
_imp_PRINTSTRING(_imp_str_literal("duplicate "));
PRINTIDENT(X, 0);
goto U_1001;
// 737 fm(5): PRINTSTRING("type"); ->ps
case_FM_5:;
_imp_PRINTSTRING(_imp_str_literal("type"));
goto U_1001;
// 738 fm(6): PRINTSTRING("match"); ->psd
case_FM_6:;
_imp_PRINTSTRING(_imp_str_literal("match"));
goto U_1002;
// 739 fm(7): PRINTSTRING("context"); ->psd
case_FM_7:;
_imp_PRINTSTRING(_imp_str_literal("context"));
goto U_1002;
// 740 fm(21):PRINTSTRING("context "); print ident(this, 0); ->ps
case_FM_21:;
_imp_PRINTSTRING(_imp_str_literal("context "));
PRINTIDENT(THIS, 0);
goto U_1001;
// 741 fm(8): PRINTSTRING("%cycle"); ->miss
case_FM_8:;
_imp_PRINTSTRING(_imp_str_literal("%cycle"));
goto U_1004;
// 742 fm(9): PRINTSTRING("%start"); ->miss
case_FM_9:;
_imp_PRINTSTRING(_imp_str_literal("%start"));
goto U_1004;
// 743 fm(10):PRINTSTRING("size"); WRITE(lit, 1) %if pos1 = 0;->ps
case_FM_10:;
_imp_PRINTSTRING(_imp_str_literal("size"));
if (POS1 != 0) goto L_002C;
_imp_WRITE(LIT, 1);
L_002C:;
goto U_1001;
// 744 fm(11):PRINTSTRING("bounds")
case_FM_11:;
_imp_PRINTSTRING(_imp_str_literal("bounds"));
// 745 WRITE(ocount, 1) %unless ocount < 0; ->ps
if (OCOUNT < 0) goto L_002D;
_imp_WRITE(OCOUNT, 1);
L_002D:;
goto U_1001;
// 746 fm(12):PRINTSTRING("index"); ->ps
case_FM_12:;
_imp_PRINTSTRING(_imp_str_literal("index"));
goto U_1001;
// 747 fm(13):PRINTSTRING("order"); ->psd
case_FM_13:;
_imp_PRINTSTRING(_imp_str_literal("order"));
goto U_1002;
// 748 fm(14):PRINTSTRING("not a location"); ->ps
case_FM_14:;
_imp_PRINTSTRING(_imp_str_literal("not a location"));
goto U_1001;
// 749 fm(15):PRINTSTRING("%begin"); ->miss
case_FM_15:;
_imp_PRINTSTRING(_imp_str_literal("%begin"));
goto U_1004;
// 750 fm(16):PRINTSTRING("%end"); ->miss
case_FM_16:;
_imp_PRINTSTRING(_imp_str_literal("%end"));
goto U_1004;
// 751 fm(17):PRINTSTRING("%repeat"); ->miss
case_FM_17:;
_imp_PRINTSTRING(_imp_str_literal("%repeat"));
goto U_1004;
// 752 fm(18):PRINTSTRING("%finish"); ->miss
case_FM_18:;
_imp_PRINTSTRING(_imp_str_literal("%finish"));
goto U_1004;
// 753 fm(19):PRINTSTRING("result"); ->miss
case_FM_19:;
_imp_PRINTSTRING(_imp_str_literal("result"));
goto U_1004;
// 754 fm(22):PRINTSTRING("format"); ->ps
case_FM_22:;
_imp_PRINTSTRING(_imp_str_literal("format"));
goto U_1001;
// 755 fm(20):printsymbol('"'); print ident(x, 0); printsymbol('"')
case_FM_20:;
_imp_PRINTSYMBOL(34);
PRINTIDENT(X, 0);
_imp_PRINTSYMBOL(34);
// 756 miss: PRINTSTRING(" missing"); ->nps
U_1004:;
_imp_PRINTSTRING(_imp_str_literal(" missing"));
goto U_1003;
// 757 psd: pos1 = 0
U_1002:;
POS1 = 0;
// 758 ps: print ss
U_1001:;
PRINTSS();
// 759 nps: NEWLINE
U_1003:;
_imp_NEWLINE();
// 760 %exit %if st = listing
if (ST != 2) goto L_002E;
goto L_002F;
L_002E:;
// 761 st = listing
ST = 2;
// 762 %repeat
goto L_0023;
L_002F:;
// 763 %if n >= 0 %start
if (N < 0) goto L_0030;
// 764 !IMP80 BUG??? %signal 15,15 %if diag&4096 # 0
// 765 %stop %if diag&4096 # 0
if (DIAG & 4096 == 0) goto L_0031;
_imp_stop(0);
L_0031:;
// 766 %if n # 13 %start; !order is fairly safe
if (N == 13) goto L_0032;
// 767 ocount = -1
OCOUNT = -1;
// 768 gg = 0
GG = 0;
// 769 copy = 0; quote = 0
COPY = 0;
QUOTE = 0;
// 770 search base = 0; escape class = 0
SEARCHBASE = 0;
ESCAPECLASS = 0;
// 771 gg = 0
GG = 0;
// 772 %finish
L_0032:;
// 773 faulty = faulty+1
FAULTY = FAULTY + 1;
// 774
// 775 !check that there haven't been too many faults
// 776
// 777 fault rate = fault rate+3; abandon(6) %IF fault rate > 30
FAULTRATE = FAULTRATE + 3;
if (FAULTRATE <= 30) goto L_0033;
ABANDON(6);
L_0033:;
// 778 fault rate = 3 %IF fault rate <= 0
if (FAULTRATE > 0) goto L_0034;
FAULTRATE = 3;
L_0034:;
// 779 %FINISH
L_0030:;
// 780 tbase = tstart
TBASE = TSTART;
// 781 %IF list <= 0 %AND sym # nl %START
if (LIST > 0) goto L_0035;
if (SYM == 10) goto L_0035;
// 782 error margin = column
ERRORMARGIN = COLUMN;
// 783 error sym = sym; sym = nl
ERRORSYM = SYM;
SYM = 10;
// 784 %FINISH
L_0035:;
// 785 %END
return;
case_FM_dispatch:
if (FM_index < -5 || FM_index > 22)
_imp_signalf(6, 3, FM_index, "->FM(%d) out of bounds at %s line %d", FM_index, FM_file, FM_line);
goto *FM[FM_index - -5];
case_FM_missing:
_imp_signalf(8, 2, FM_index, "switch jump to undefined label FM(%d): at %s line %d", FM_index, FM_file, FM_line);
} /* end of FAULT */
// 786
// 787 dmin = dmin-1; dict(dmin) = -1; !end marker for starts & cycles
DMIN = DMIN - 1;
DICT[DMIN - 1] = -1;
// 788 abandon(2) %IF dmax = dmin
if (DMAX != DMIN) goto L_0036;
ABANDON(2);
L_0036:;
// 789
// 790 %IF list > 0 %AND level > 0 %START
if (LIST <= 0) goto L_0037;
if (LEVEL <= 0) goto L_0037;
// 791 write(lines, 5); spaces(level*3-1)
_imp_WRITE(LINES, 5);
_imp_SPACES(LEVEL * 3 - 1);
// 792 %IF block tag = 0 %START
if (BLOCKTAG != 0) goto L_0038;
// 793 printstring("Begin")
_imp_PRINTSTRING(_imp_str_literal("Begin"));
// 794 %FINISH %ELSE %START
goto L_0039;
L_0038:;
// 795 printstring("Procedure "); print ident(block tag, 0)
_imp_PRINTSTRING(_imp_str_literal("Procedure "));
PRINTIDENT(BLOCKTAG, 0);
// 796 %FINISH
L_0039:;
// 797 newline
_imp_NEWLINE();
// 798 %FINISH
L_0037:;
// 799
// 800 !deal with procedure definition (parameters)
// 801
// 802 %IF block tag # 0 %START; !proc
if (BLOCKTAG == 0) goto L_003A;
// 803 analyse; compile %IF ss # 0
ANALYSE();
if (SS == 0) goto L_003B;
COMPILE();
L_003B:;
// 804
// 805 %IF block otype # 0 %START; !external-ish
if (BLOCKOTYPE == 0) goto L_003C;
// 806 %IF bflags&spec = 0 %START; !definition
if (*BFLAGS & 128 != 0) goto L_003D;
// 807 %IF progmode <= 0 %AND level = 1 %THEN progmode = -1 %C
if (PROGMODE > 0) goto L_003E;
if (LEVEL != 1) goto L_003E;
PROGMODE = -1;
goto L_003F;
L_003E:;
FAULT(7);
L_003F:;
// 808+ %ELSE fault(7)
// 809 %FINISH
L_003D:;
// 810 %FINISH
L_003C:;
// 811
// 812 new app = gapp; !generate app grammar
NEWAPP = GAPP();
// 813 %IF spec given # 0 %START; !definition after spec
if (SPECGIVEN == 0) goto L_0040;
// 814 fault(6) %IF new app # block app; !different from spec
if (NEWAPP == *BLOCKAPP) goto L_0041;
FAULT(6);
L_0041:;
// 815 %FINISH
L_0040:;
// 816 block app = new app; !use the latest
*BLOCKAPP = NEWAPP;
// 817
// 818 %IF level < 0 %START; !not procedure definition
if (LEVEL >= 0) goto L_0042;
// 819 delete names(0)
DELETENAMES(0);
// 820 %RETURN
return;
// 821 %FINISH
L_0042:;
// 822 %FINISH %ELSE %START
goto L_0043;
L_003A:;
// 823 open = 0; !can return from a block?
OPEN = 0;
// 824 %FINISH
L_0043:;
// 825
// 826 %CYCLE
L_0044:;
// 827 analyse
ANALYSE();
// 828 %CONTINUE %IF ss = 0
if (SS != 0) goto L_0045;
goto L_0046;
L_0045:;
// 829 compile
COMPILE();
// 830 fault(-5) %IF dubious # 0
if (DUBIOUS == 0) goto L_0047;
FAULT(-5);
L_0047:;
// 831 flush buffer %IF bp >= 128
if (BP < 128) goto L_0048;
FLUSHBUFFER();
L_0048:;
// 832 %IF sstype > 0 %START; !block in or out
if (SSTYPE <= 0) goto L_0049;
// 833 %EXIT %IF sstype = 2; !out
if (SSTYPE != 2) goto L_004A;
goto L_004B;
L_004A:;
// 834 compile block(spec mode, block x, dmin, tmax, id)
COMPILEBLOCK(SPECMODE, BLOCKX, DMIN, TMAX, ID);
// 835 %EXIT %IF ss < 0; !endofprogram
if (SS >= 0) goto L_004C;
goto L_004B;
L_004C:;
// 836 %FINISH
L_0049:;
// 837 %REPEAT
L_0046:;
goto L_0044;
L_004B:;
// 838 %IF list > 0 %AND level > 0 %START
if (LIST <= 0) goto L_004D;
if (LEVEL <= 0) goto L_004D;
// 839 write(lines, 5); spaces(level*3-1)
_imp_WRITE(LINES, 5);
_imp_SPACES(LEVEL * 3 - 1);
// 840 printstring("End")
_imp_PRINTSTRING(_imp_str_literal("End"));
// 841 newline
_imp_NEWLINE();
// 842 %FINISH
L_004D:;
// 843 delete names(0)
DELETENAMES(0);
// 844 %RETURN
return;
// 845
// 846 %INTEGERFN gapp; !generate app grammar (backwards)
int GAPP(void) {
auto void SETCELL(int G, int TT);
auto void CLASS(struct TAGFM * V);
// 847 %CONSTINTEGER comma = 140; !psep
// 848 %ROUTINESPEC set cell(%INTEGER g, tt)
// 849 %ROUTINESPEC class(%RECORD(tagfm)%NAME v)
// 850 %RECORD(tagfm)%NAME v
struct TAGFM *V;
// 851 %INTEGER p, link, tp, c, ap, t
int P;
int LINK;
int TP;
int C;
int AP;
int T;
// 852
// 853 %RESULT = 0 %IF tmax = local; !no app needed
if (TMAX != LOCAL) goto L_004E;
return 0;
L_004E:;
// 854
// 855 p = gmax1; link = 0; t = tmax
P = 719;
LINK = 0;
T = TMAX;
// 856
// 857 %CYCLE
L_004F:;
// 858 v == tag(t); t = t-1
V = (struct TAGFM *)/*?*/ &TAG[T];
T = T - 1;
// 859 class(v); !deduce class from tag
CLASS(V);
// 860 %IF c < 0 %START; !insert %PARAM
if (C >= 0) goto L_0050;
// 861 c = -c
C = -C;
// 862 set cell(196, tp)
SETCELL(196, TP);
// 863 tp = -1
TP = -1;
// 864 %FINISH
L_0050:;
// 865 set cell(c, tp)
SETCELL(C, TP);
// 866 %EXIT %IF t = local; !end of parameters
if (T != LOCAL) goto L_0051;
goto L_0052;
L_0051:;
// 867 set cell(comma, -1); !add the separating comma
SETCELL(140, -1);
// 868 %REPEAT
goto L_004F;
L_0052:;
// 869 abandon(3) %IF gmax > gmin
if (GMAX <= GMIN) goto L_0053;
ABANDON(3);
L_0053:;
// 870
// 871 %RESULT = link
return LINK;
// 872
// 873 %ROUTINE set cell(%INTEGER g, tt)
void SETCELL(int G, int TT) {
// 874
// 875 !add the cell to the grammar, combining common tails
// 876
// 877 %WHILE p # gmax %CYCLE
L_0054:;
if (P == GMAX) goto L_0055;
// 878 p = p+1
P = P + 1;
// 879 %IF glink(p) = link %AND gram(p) = g %START
if (GLINK[P] != LINK) goto L_0056;
if (GRAM[P] != G) goto L_0056;
// 880 %IF tt < 0 %OR (gram(p+1) = tt %AND glink(p+1)=ap) %START
if (TT < 0) goto L_0057;
if (GRAM[P + 1] != TT) goto L_0058;
if (GLINK[P + 1] != AP) goto L_0058;
L_0057:;
// 881 link = p; !already there
LINK = P;
// 882 %RETURN
return;
// 883 %FINISH
L_0058:;
// 884 %FINISH
L_0056:;
// 885 %REPEAT
goto L_0054;
L_0055:;
// 886
// 887 !add a new cell
// 888
// 889 gmax = gmax+1
GMAX = GMAX + 1;
// 890 gram(gmax) = g
GRAM[GMAX] = G;
// 891 glink(gmax) = link
GLINK[GMAX] = LINK;
// 892 link = gmax
LINK = GMAX;
// 893
// 894 %IF tt >= 0 %START; ! set type cell
if (TT < 0) goto L_0059;
// 895 gmax = gmax+1
GMAX = GMAX + 1;
// 896 gram(gmax) = tt
GRAM[GMAX] = TT;
// 897 glink(gmax) = ap
GLINK[GMAX] = AP;
// 898 %FINISH
L_0059:;
// 899
// 900 p = gmax
P = GMAX;
// 901 %END
return;
} /* end of SETCELL */
// 902
// 903 %ROUTINE class(%RECORD(tagfm)%NAME v)
void CLASS(struct TAGFM * V) {
// 904 %CONSTINTEGER err = 89
// 905 %CONSTINTEGER rtp = 100
// 906 %CONSTINTEGER fnp = 101
// 907 %CONSTINTEGER mapp = 102
// 908 %CONSTINTEGER predp = 103
// 909 %CONSTINTEGERARRAY class map(0:15) = %C
const int CLASSMAP[16] = {89, 1764, 247, [3 ... 6] = 89, -100, -101, -102, -103, 89, 214, 89, 229, 89};
// 910+ err,1764, 247, err(4), -rtp, -fnp, -mapp, -predp, err, 214,
// 911+ err, 229, err
// 912 %INTEGER tags, type, form
int TAGS;
int TYPE;
int FORM;
// 913 ap = 0
AP = 0;
// 914 tags = v_flags
TAGS = V->FLAGS;
// 915 type = tags>>4&7; form = tags&15
TYPE = (unsigned int)TAGS >> 4 & 7;
FORM = TAGS & 15;
// 916 tp = v_format<<3!type
TP = V->FORMAT << 3 | TYPE;
// 917 c = class map(form)
C = CLASSMAP[FORM];
// 918 c = 208 %AND tp = 0 %IF type = 0 %AND form = 2; !%NAME
if (TYPE != 0) goto L_005A;
if (FORM != 2) goto L_005A;
C = 208;
TP = 0;
L_005A:;
// 919 ap = v_app %IF tags¶meters # 0
if (TAGS & 4096 == 0) goto L_005B;
AP = V->APP;
L_005B:;
// 920 %END
return;
} /* end of CLASS */
// 921 %END
_imp_signal(8, 4, 0, "result missing");
} /* end of GAPP */
// 922
// 923 %ROUTINE delete names(%INTEGER quiet)
void DELETENAMES(int QUIET) {
// 924 %INTEGER flags
int FLAGS;
// 925 %RECORD(tagfm)%NAME tx
struct TAGFM *TX;
// 926 %WHILE tmax > tbase %CYCLE
L_005C:;
if (TMAX <= TBASE) goto L_005D;
// 927 x = tmax; tmax = tmax-1
X = TMAX;
TMAX = TMAX - 1;
// 928 tx == tag(x)
TX = (struct TAGFM *)/*?*/ &TAG[X];
// 929 flags = tx_flags
FLAGS = TX->FLAGS;
// 930 fault(20) %IF flags&spec # 0 %and flags&own bit = 0
if (FLAGS & 128 == 0) goto L_005E;
if (FLAGS & 512 != 0) goto L_005E;
FAULT(20);
L_005E:;
// 931 {spec with no definition & not external}
// 932 %IF flags&used bit = 0 %AND level >= 0 %AND list <= 0 %START
if (FLAGS & 32768 != 0) goto L_005F;
if (LEVEL < 0) goto L_005F;
if (LIST > 0) goto L_005F;
// 933 fault(-3) %IF quiet = 0; !unused
if (QUIET != 0) goto L_0060;
FAULT(-3);
L_0060:;
// 934 %FINISH
L_005F:;
// 935 dict(tx_text) = tx_link
DICT[TX->TEXT - 1] = TX->LINK;
// 936 %REPEAT
goto L_005C;
L_005D:;
// 937 %END
return;
} /* end of DELETENAMES */
// 938
// 939 %ROUTINE analyse
void ANALYSE(void) {
// 940
// 941 %CONSTINTEGER order bits = x'3000', order bit = x'1000'
// 942 %CONSTINTEGER escape = x'1000'
// 943 %INTEGER strp, mark, flags, prot err, k, s, c
int STRP;
int MARK;
int FLAGS;
int PROTERR;
int K;
int S;
int C;
// 944 %OWNINTEGER key = 0
static int KEY = 0;
// 945 %SHORTINTEGER node
short int NODE;
// 946 %SHORTINTEGERNAME z
short int *Z;
// 947 %RECORD(arfm)%NAME arp
struct ARFM *ARP;
// 948 !emas: %INTEGER node
// 949 !emas: %INTEGERNAME z
// 950 %SWITCH act(actions:phrasal), paction(0:15)
int ACT_index;
int ACT_line;
char *ACT_file;
static const void *ACT[21] = {&&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing,
&&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing,
&&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing,
&&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing,
&&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing, &&case_ACT_missing,
&&case_ACT_missing};
int PACTION_index;
int PACTION_line;
char *PACTION_file;
static const void *PACTION[16] = {
&&case_PACTION_missing, &&case_PACTION_missing, &&case_PACTION_missing, &&case_PACTION_missing,
&&case_PACTION_missing, &&case_PACTION_missing, &&case_PACTION_missing, &&case_PACTION_missing,
&&case_PACTION_missing, &&case_PACTION_missing, &&case_PACTION_missing, &&case_PACTION_missing,
&&case_PACTION_missing, &&case_PACTION_missing, &&case_PACTION_missing, &&case_PACTION_missing};
// 951
// 952 %ROUTINE trace analysis
void TRACEANALYSIS(void) {
// 953 !diagnostic trace routine (diagnose&1 # 0)
// 954 %INTEGER a
int A;
// 955 %ROUTINE show(%INTEGER a)
void SHOW(int A) {
// 956 %IF 0 < a < 130 %START
{
// Double-sided test on A (Part I)
int tmp;
if (0 >= (tmp = A)) goto L_0061;
// Double-sided test on A (Part II)
if (tmp >= 130) goto L_0061;
}
// 957 space
_imp_SPACE();
// 958 printstring(text(a))
_imp_PRINTSTRING(
*({
__typeof__(_imp_string8) tmp = TEXT[A] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 959 %FINISH %ELSE write(a, 3)
goto L_0062;
L_0061:;
_imp_WRITE(A, 3);
L_0062:;
// 960 %END
return;
} /* end of SHOW */
// 961 %OWNINTEGER la1=0, la2=0, lsa=0, lt=0
static int LA1 = 0;
static int LA2 = 0;
static int LSA = 0;
static int LT = 0;
// 962 newline %IF mon pos # pos %AND sym # nl
if (MONPOS == POS) goto L_0063;
if (SYM == 10) goto L_0063;
_imp_NEWLINE();
L_0063:;
// 963 mon pos = pos
MONPOS = POS;
// 964 write(g, 3)
_imp_WRITE(G, 3);
// 965 space
_imp_SPACE();
// 966 printstring(text(class))
_imp_PRINTSTRING(
*({
__typeof__(_imp_string8) tmp = TEXT[CLASS] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 967 printsymbol('"') %IF gg&trans bit # 0
if (GG & 16384 == 0) goto L_0064;
_imp_PRINTSYMBOL(34);
L_0064:;
// 968 a = gg>>8&15
A = (unsigned int)GG >> 8 & 15;
// 969 %IF a # 0 %START
if (A == 0) goto L_0065;
// 970 printsymbol('{')
_imp_PRINTSYMBOL(123);
// 971 write(a, 0)
_imp_WRITE(A, 0);
// 972 printsymbol('}')
_imp_PRINTSYMBOL(125);
// 973 %FINISH
L_0065:;
// 974 %IF atom1 # la1 %OR atom2 # la2 %OR lsa # subatom %C
if (ATOM1 != LA1) goto L_0066;
if (ATOM2 != LA2) goto L_0066;
if (LSA != SUBATOM) goto L_0066;
if (LT == TYPE) goto L_0067;
L_0066:;
// 975+ %OR lt # type %START
// 976 printstring(" [")
_imp_PRINTSTRING(_imp_str_literal(" ["));
// 977 la1 = atom1
LA1 = ATOM1;
// 978 show(la1)
SHOW(LA1);
// 979 la2 = atom2
LA2 = ATOM2;
// 980 show(la2)
SHOW(LA2);
// 981 lsa = subatom
LSA = SUBATOM;
// 982 write(lsa, 3)
_imp_WRITE(LSA, 3);
// 983 lt = type
LT = TYPE;
// 984 write(lt, 5)
_imp_WRITE(LT, 5);
// 985 printsymbol(']')
_imp_PRINTSYMBOL(93);
// 986 %FINISH
L_0067:;
// 987 newline
_imp_NEWLINE();
// 988 %END
return;
} /* end of TRACEANALYSIS */
// 989
// 990 %ROUTINE get sym
void GETSYM(void) {
// 991 readsymbol(sym)
_imp_READSYMBOL(/*?*/ &SYM);
// 992 pos = pos+1 %IF pos # 133
if (POS == 133) goto L_0068;
POS = POS + 1;
L_0068:;
// 993 char(pos) = sym
CHAR[POS] = SYM;
// 994 printsymbol(sym) %IF list <= 0
if (LIST > 0) goto L_0069;
_imp_PRINTSYMBOL(SYM);
L_0069:;
// 995 column = column+1
COLUMN = COLUMN + 1;
// 996 %END
return;
} /* end of GETSYM */
// 997 %ROUTINE read sym
void READSYM(void) {
// 998 %owninteger Last = 0
static int LAST = 0;
// 999 %CONSTBYTEINTEGERARRAY mapped(0:127) = %C
const unsigned char MAPPED[128] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 33, 34, 35, 36, 1, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51,
52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77,
78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 65, 66, 67, 68, 69, 70, 71,
72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 2, 124, 125, 126, 0};
// 1000+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, nl, 0, 3 , 0, 0, 0,
// 1001+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
// 1002+ 0 ,'!','"','#', '$', 1 ,'&', 39, '(',')','*','+', ',','-','.','/',
// 1003+ '0','1','2','3', '4','5','6','7', '8','9',':',';', '<','=','>','?',
// 1004+ '@','A','B','C', 'D','E','F','G', 'H','I','J','K', 'L','M','N','O',
// 1005+ 'P','Q','R','S', 'T','U','V','W', 'X','Y','Z','[', '\',']','^','_',
// 1006+ '`','A','B','C', 'D','E','F','G', 'H','I','J','K', 'L','M','N','O',
// 1007+ 'P','Q','R','S', 'T','U','V','W', 'X','Y','Z', 2 , '|','}','~', 0
// 1008
// 1009 !! 0 = space
// 1010 !! 1 = %
// 1011 !! 2 = {
// 1012 !! 3 = ff
// 1013 !! other values represent themselves
// 1014
// 1015 %IF sym = nl %START
if (SYM != 10) goto L_006A;
// 1016 s1: lines = lines+1
U_1005:;
LINES = LINES + 1;
// 1017 printsymbol(end mark) %if end mark # 0
if (ENDMARK == 0) goto L_006B;
_imp_PRINTSYMBOL(ENDMARK);
L_006B:;
// 1018 s11: pos = 0; pos1 = 0; pos2 = 0; margin = 0; column = 0
U_1006:;
POS = 0;
POS1 = 0;
POS2 = 0;
MARGIN = 0;
COLUMN = 0;
// 1019 Last = 0
LAST = 0;
// 1020 end mark = 0
ENDMARK = 0;
// 1021 %IF list <= 0 %START
if (LIST > 0) goto L_006C;
// 1022 %IF include # 0 %START
if (INCLUDE == 0) goto L_006D;
// 1023 printstring(" &"); write(lines, -4)
_imp_PRINTSTRING(_imp_str_literal(" &"));
_imp_WRITE(LINES, -4);
// 1024 %FINISH %ELSE write(lines, 5)
goto L_006E;
L_006D:;
_imp_WRITE(LINES, 5);
L_006E:;
// 1025 csym = cont; printsymbol(csym)
CSYM = CONT;
_imp_PRINTSYMBOL(CSYM);
// 1026 space
_imp_SPACE();
// 1027 %IF error margin # 0 %START
if (ERRORMARGIN == 0) goto L_006F;
// 1028 lines = lines-1
LINES = LINES - 1;
// 1029 spaces(error margin)
_imp_SPACES(ERRORMARGIN);
// 1030 error margin = 0
ERRORMARGIN = 0;
// 1031 %IF error sym # 0 %START
if (ERRORSYM == 0) goto L_0070;
// 1032 printsymbol(error sym)
_imp_PRINTSYMBOL(ERRORSYM);
// 1033 pos = 1
POS = 1;
// 1034 !IMP80 BUG???
// 1035 !! char(1) = error sym
// 1036 byteinteger(addr(char(0))+1) = error sym
*_imp_BYTEINTEGER(_imp_ADDR(/*?*/ &CHAR[0]) + 1) = ERRORSYM;
// 1037 sym = error sym; error sym = 0
SYM = ERRORSYM;
ERRORSYM = 0;
// 1038 ->s5
goto U_1007;
// 1039 %FINISH
L_0070:;
// 1040 %FINISH
L_006F:;
// 1041 %FINISH
L_006C:;
// 1042 s2: symtype = 1
U_1008:;
SYMTYPE = 1;
// 1043 %FINISH
L_006A:;
// 1044 s3:readsymbol(sym)
U_1009:;
_imp_READSYMBOL(/*?*/ &SYM);
// 1045 pos = pos+1 %IF pos # 133
if (POS == 133) goto L_0071;
POS = POS + 1;
L_0071:;
// 1046 char(pos) = sym
CHAR[POS] = SYM;
// 1047 printsymbol(sym) %IF list <= 0
if (LIST > 0) goto L_0072;
_imp_PRINTSYMBOL(SYM);
L_0072:;
// 1048 column = column+1
COLUMN = COLUMN + 1;
// 1049 s5:%IF sym # nl %START
U_1007:;
if (SYM == 10) goto L_0073;
// 1050 Last = Sym
LAST = SYM;
// 1051 %RETURN %IF quote # 0; !dont alter strings
if (QUOTE == 0) goto L_0074;
return;
L_0074:;
// 1052 sym = mapped(sym&127)
SYM = MAPPED[SYM & 127];
// 1053 %IF sym <= 3 %START; !special symbol
if (SYM > 3) goto L_0075;
// 1054 ->s2 %IF sym = 0; !space (or dubious control)
if (SYM != 0) goto L_0076;
goto U_1008;
L_0076:;
// 1055 symtype = 2 %AND ->s3 %IF sym = 1; !%
if (SYM != 1) goto L_0077;
SYMTYPE = 2;
goto U_1009;
L_0077:;
// 1056 cont = '+' %AND ->s11 %IF sym = 3; !ff
if (SYM != 3) goto L_0078;
CONT = 43;
goto U_1006;
L_0078:;
// 1057 !must be {
// 1058 %CYCLE
L_0079:;
// 1059 get sym
GETSYM();
// 1060 ->s3 %IF sym = '}'
if (SYM != 125) goto L_007A;
goto U_1009;
L_007A:;
// 1061 ->s4 %IF sym = nl
if (SYM != 10) goto L_007B;
goto U_100A;
L_007B:;
// 1062 %REPEAT
goto L_0079;
// 1063 %FINISH
L_0075:;
// 1064 key = kdict(sym)
KEY = KDICT[SYM - 32];
// 1065 %IF key&3 = 0 %AND symtype = 2 %START; !keyword
if (KEY & 3 != 0) goto L_007C;
if (SYMTYPE != 2) goto L_007C;
// 1066 %IF sym = 'C' %AND nextsymbol = nl %START; !%C...
if (SYM != 67) goto L_007D;
if (_imp_NEXTSYMBOL() != 10) goto L_007D;
// 1067 getsym; cont = '+'; ->s1
GETSYM();
CONT = 43;
goto U_1005;
// 1068 %FINISH
L_007D:;
// 1069 %ELSE
goto L_007E;
L_007C:;
// 1070 symtype = key&3-2
SYMTYPE = (KEY & 3) - 2;
// 1071 %FINISH
L_007E:;
// 1072 %RETURN
return;
// 1073 %FINISH
L_0073:;
// 1074 s4:symtype = quote
U_100A:;
SYMTYPE = QUOTE;
// 1075 ->S1 %if last = 0 %and Quote = 0
if (LAST != 0) goto L_007F;
if (QUOTE != 0) goto L_007F;
goto U_1005;
L_007F:;
// 1076 Cont = '+'
CONT = 43;
// 1077 %END
return;
} /* end of READSYM */
// 1078
// 1079 %INTEGERFN format selected
int FORMATSELECTED(void) {
// 1080 format list = tag(format)_app; !number of names
FORMATLIST = TAG[FORMAT].APP;
// 1081 %IF format list < 0 %START; !forward ref
if (FORMATLIST >= 0) goto L_0080;
// 1082 atom1 = error+22
ATOM1 = 32768 + 22;
// 1083 %RESULT = 0
return 0;
// 1084 %FINISH
L_0080:;
// 1085 %IF sym = '_' %START
if (SYM != 95) goto L_0081;
// 1086 escape class = esc rec
ESCAPECLASS = 255;
// 1087 search base = tag(format)_format
SEARCHBASE = TAG[FORMAT].FORMAT;
// 1088 %FINISH
L_0081:;
// 1089 %RESULT = 1
return 1;
// 1090 %END
} /* end of FORMATSELECTED */
// 1091
// 1092 %ROUTINE code atom(%INTEGER target)
void CODEATOM(int TARGET) {
// 1093 %INTEGER dbase, da
int DBASE;
int DA;
// 1094 %INTEGER base, n, mul, pend quote
int BASE;
int N;
int MUL;
int PENDQUOTE;
// 1095 %INTEGER j,k,l, pt
int J;
int K;
int L;
int PT;
// 1096
// 1097 %ROUTINE lookup(%INTEGER d)
void LOOKUP(int D) {
// 1098 %CONSTINTEGER magic = 6700421
// 1099 %INTEGER new name, vid, k1, k2, form
int NEWNAME;
int VID;
int K1;
int K2;
int FORM;
// 1100 %RECORD(tagfm)%NAME t
struct TAGFM *T;
// 1101 !emas: %LONGINTEGER k0
// 1102 %INTEGER new
int NEW;
// 1103
// 1104 !first locate the text of the name
// 1105
// 1106 new = addr(dict(dmax+1))
NEW = _imp_ADDR(/*?*/ &DICT[DMAX + 1 - 1]);
// 1107
// 1108 !******** Machine code to inhibit overflow test ********
// 1109
// 1110 ! *LI_1,magic
// 1111 ! * M_0,hash value
// 1112 ! *ST_1,K2
// 1113
// 1114 {K2 = hash value*magic}
// 1115 K2 = hash value*magic ;! requires NOCHECK option
K2 = HASHVALUE * 6700421;
// 1116 ! we could fix this properly by a shift+add loop
// 1117 !*******************************************************
// 1118
// 1119 k2 = k2>>(32-2*name bits)!1
K2 = (unsigned int)K2 >> 32 - 2 * 11 | 1;
// 1120 !emas: k0 = magic
// 1121 !emas: k1 = (k0*hash value)&X'7FFFFFFF'
// 1122 !emas: k2 = k1>>(32-2*name bits)!1
// 1123 k1 = k2>>name bits; !giving name bits
K1 = (unsigned int)K2 >> 11;
// 1124 %CYCLE
L_0082:;
// 1125 newname = hash(k1)
NEWNAME = HASH[K1];
// 1126 %EXIT %IF newname = 0; !not in
if (NEWNAME != 0) goto L_0083;
goto L_0084;
L_0083:;
// 1127 ->in %IF string(addr(dict(newname+1))) = string(new)
if (_imp_strcmp((_imp_string *)_imp_STRING(_imp_ADDR(/*?*/ &DICT[NEWNAME + 1 - 1])),
(_imp_string *)_imp_STRING(NEW)) != 0)
goto L_0085;
goto U_100B;
L_0085:;
// 1128 k1 = (k1+k2)&max names
K1 = K1 + K2 & 2047;
// 1129 %REPEAT
goto L_0082;
L_0084:;
// 1130
// 1131 ! not found
// 1132
// 1133 spare names = spare names-1
SPARENAMES = SPARENAMES - 1;
// 1134 abandon(2) %IF spare names <= 0
if (SPARENAMES > 0) goto L_0086;
ABANDON(2);
L_0086:;
// 1135 hash(k1) = dmax; !put it in
HASH[K1] = DMAX;
// 1136 dict(dmax) = -1
DICT[DMAX - 1] = -1;
// 1137 newname = dmax; dmax = dp; ->not in
NEWNAME = DMAX;
DMAX = DP;
goto U_100C;
// 1138
// 1139 in: search base = rbase %IF this >= 0 %AND d # 0; !record elem defn
U_100B:;
if (THIS < 0) goto L_0087;
if (D == 0) goto L_0087;
SEARCHBASE = RBASE;
L_0087:;
// 1140 %IF search base # 0 %START; !record subname
if (SEARCHBASE == 0) goto L_0088;
// 1141 new = -1
NEW = -1;
// 1142 x = search base
X = SEARCHBASE;
// 1143 %CYCLE
L_0089:;
// 1144 ->not in %IF x < format list
if (X >= FORMATLIST) goto L_008A;
goto U_100C;
L_008A:;
// 1145 %EXIT %IF tag(x)_text = new name
if (TAG[X].TEXT != NEWNAME) goto L_008B;
goto L_008C;
L_008B:;
// 1146 x = x-1
X = X - 1;
// 1147 %REPEAT
goto L_0089;
L_008C:;
// 1148 %FINISH %ELSE %START; !hash in for normal names
goto L_008D;
L_0088:;
// 1149 x = dict(newname)
X = DICT[NEWNAME - 1];
// 1150 ->not in %IF x <= limit; !wrong level
if (X > LIMIT) goto L_008E;
goto U_100C;
L_008E:;
// 1151 %FINISH
L_008D:;
// 1152
// 1153 subatom = x; !name found, extract info
SUBATOM = X;
// 1154 t == tag(x)
T = (struct TAGFM *)/*?*/ &TAG[X];
// 1155 atom flags = t_flags
ATOMFLAGS = T->FLAGS;
// 1156 format = t_format; app = t_app
FORMAT = T->FORMAT;
APP = T->APP;
// 1157 protection = atom flags&prot
PROTECTION = ATOMFLAGS & 256;
// 1158 type = atom flags>>4&7; atom1 = amap(atom flags&15)
TYPE = (unsigned int)ATOMFLAGS >> 4 & 7;
ATOM1 = AMAP[ATOMFLAGS & 15];
// 1159
// 1160 %IF diag&8 # 0 %START
if (DIAG & 8 == 0) goto L_008F;
// 1161 printstring("lookup:")
_imp_PRINTSTRING(_imp_str_literal("lookup:"));
// 1162 write(atom1, 3)
_imp_WRITE(ATOM1, 3);
// 1163 write(type, 1)
_imp_WRITE(TYPE, 1);
// 1164 write(app, 3)
_imp_WRITE(APP, 3);
// 1165 write(format, 5)
_imp_WRITE(FORMAT, 5);
// 1166 write(atom flags, 3)
_imp_WRITE(ATOMFLAGS, 3);
// 1167 newline
_imp_NEWLINE();
// 1168 %FINISH
L_008F:;
// 1169
// 1170 %IF d = 0 %START; !old name wanted
if (D != 0) goto L_0090;
// 1171 t_flags <- t_flags!used bit
T->FLAGS = (int)(T->FLAGS | 32768);
// 1172 search base = 0
SEARCHBASE = 0;
// 1173
// 1174 %IF atom flags&subname # 0 %AND format # 0 %START; !a record
if (ATOMFLAGS & 2048 == 0) goto L_0091;
if (FORMAT == 0) goto L_0091;
// 1175 %RETURN %IF format selected = 0
if (FORMATSELECTED() != 0) goto L_0092;
return;
L_0092:;
// 1176 %FINISH
L_0091:;
// 1177
// 1178 %IF atom flags¶meters # 0 %START; !proc or array
if (ATOMFLAGS & 4096 == 0) goto L_0093;
// 1179
// 1180 %IF app = 0 %START; !no parameters needed
if (APP != 0) goto L_0094;
// 1181 atom2 = atom1
ATOM2 = ATOM1;
// 1182 atom1 = atom1-4
ATOM1 = ATOM1 - 4;
// 1183 %IF 97 <= atom1 <= 98 %START
{
// Double-sided test on ATOM1 (Part I)
int tmp;
if (97 > (tmp = ATOM1)) goto L_0095;
// Double-sided test on ATOM1 (Part II)
if (tmp > 98) goto L_0095;
}
// 1184 map gg = atom1; atom1 = var
MAPGG = ATOM1;
ATOM1 = 91;
// 1185 %FINISH
L_0095:;
// 1186 %FINISH %ELSE %START
goto L_0096;
L_0094:;
// 1187 %IF sym = '(' %START
if (SYM != 40) goto L_0097;
// 1188 search base = 0; !ignore format for now
SEARCHBASE = 0;
// 1189 %IF atom1 >= 106 %START; !arrays
if (ATOM1 < 106) goto L_0098;
// 1190 app = phrase(app+200)
APP = PHRASE[APP + 200 - 200];
// 1191 escape class = esc array
ESCAPECLASS = 254;
// 1192 atom1 = (atom1-106)>>1+91; !a,an->v na,nan->n
ATOM1 = ((unsigned int)ATOM1 - 106 >> 1) + 91;
// 1193 %FINISH %ELSE %START; !procedures
goto L_0099;
L_0098:;
// 1194 escape class = esc proc
ESCAPECLASS = 253;
// 1195 atom1 = atom1-4
ATOM1 = ATOM1 - 4;
// 1196 %FINISH
L_0099:;
// 1197 phrase(200) = app
PHRASE[0] = APP;
// 1198 %FINISH
L_0097:;
// 1199 %FINISH
L_0096:;
// 1200 pos2 = pos; %return
POS2 = POS;
return;
// 1201 %FINISH
L_0093:;
// 1202
// 1203 !deal with constintegers etc
// 1204
// 1205 %IF atom flags&const bit # 0 %AND atom1 = var %START
if (ATOMFLAGS & 8192 == 0) goto L_009A;
if (ATOM1 != 91) goto L_009A;
// 1206 map gg = const; atom2 = const
MAPGG = 93;
ATOM2 = 93;
// 1207 subatom = -subatom %IF type = integer
if (TYPE != 1) goto L_009B;
SUBATOM = -SUBATOM;
L_009B:;
// 1208 %FINISH
L_009A:;
// 1209 %RETURN
return;
// 1210
// 1211 %FINISH
L_0090:;
// 1212 !new name wanted
// 1213 ->not in %IF tbase # tstart; !don't fault proc parm-parm
if (TBASE == TSTART) goto L_009C;
goto U_100C;
L_009C:;
// 1214 %IF d = lab+spec+used bit %START
if (D != 3 + 128 + 32768) goto L_009D;
// 1215 t_flags = t_flags!used bit
T->FLAGS = T->FLAGS | 32768;
// 1216 %RETURN
return;
// 1217 %FINISH
L_009D:;
// 1218 %IF atom flags&spec # 0 %START; !a spec has been given
if (ATOMFLAGS & 128 == 0) goto L_009E;
// 1219 %IF d = lab %START; !define label
if (D != 3) goto L_009F;
// 1220 t_flags <- t_Flags-Spec
T->FLAGS = (int)(T->FLAGS - 128);
// 1221 %RETURN
return;
// 1222 %FINISH
L_009F:;
// 1223 %IF 7 <= decl&15 <= 10 %AND decl&spec = 0 %START
{
// Double-sided test on DECL & 15 (Part I)
int tmp;
if (7 > (tmp = DECL & 15)) goto L_00A0;
// Double-sided test on DECL & 15 (Part II)
if (tmp > 10) goto L_00A0;
}
if (DECL & 128 != 0) goto L_00A0;
// 1224
// 1225 !procedure definition after spec
// 1226
// 1227 %IF (decl!!atom flags)&b'1111111' = 0 %START; !correct type?
if ((DECL ^ ATOMFLAGS) & 127 != 0) goto L_00A1;
// 1228 t_flags = t_flags-spec
T->FLAGS = T->FLAGS - 128;
// 1229 spec given = 1
SPECGIVEN = 1;
// 1230 %RETURN
return;
// 1231 %FINISH
L_00A1:;
// 1232
// 1233 !note that an external procedure must be speced as a
// 1234 !non-external procedure.
// 1235
// 1236 %FINISH
L_00A0:;
// 1237 %IF decl&15 = recfm %START; !recordformat
if (DECL & 15 != 4) goto L_00A2;
// 1238 t_flags = record<<4+recfm
T->FLAGS = (4 << 4) + 4;
// 1239 t_format = fdef
T->FORMAT = FDEF;
// 1240 %RETURN
return;
// 1241 %FINISH
L_00A2:;
// 1242 %FINISH
L_009E:;
// 1243 %RETURN %IF last1 = jump %AND atom1 = swit
if (LAST1 != 54) goto L_00A3;
if (ATOM1 != 105) goto L_00A3;
return;
L_00A3:;
// 1244 copy = x %IF copy = 0
if (COPY != 0) goto L_00A4;
COPY = X;
L_00A4:;
// 1245
// 1246 notin:app = 0; vid = 0
U_100C:;
APP = 0;
VID = 0;
// 1247 atom1 = error+2
ATOM1 = 32768 + 2;
// 1248
// 1249 %return %if d = 0; !old name wanted
if (D != 0) goto L_00A5;
return;
L_00A5:;
// 1250 type = d>>4&7; form = d&15; atom1 = amap(form)
TYPE = (unsigned int)D >> 4 & 7;
FORM = D & 15;
ATOM1 = AMAP[FORM];
// 1251
// 1252 %IF this < 0 %START; !normal scope
if (THIS >= 0) goto L_00A6;
// 1253 new = newname
NEW = NEWNAME;
// 1254 tmax = tmax+1; x = tmax
TMAX = TMAX + 1;
X = TMAX;
// 1255 %FINISH %ELSE %START; !recordformat scope
goto L_00A7;
L_00A6:;
// 1256 new = -1
NEW = -1;
// 1257 recid = recid-1; vid = recid
RECID = RECID - 1;
VID = RECID;
// 1258 tmin = tmin-1; x = tmin
TMIN = TMIN - 1;
X = TMIN;
// 1259 format list = tmin
FORMATLIST = TMIN;
// 1260 %FINISH
L_00A7:;
// 1261
// 1262 %IF 11 <= form <= 14 %START; !arrays
{
// Double-sided test on FORM (Part I)
int tmp;
if (11 > (tmp = FORM)) goto L_00A8;
// Double-sided test on FORM (Part II)
if (tmp > 14) goto L_00A8;
}
// 1263 dim = 1 %IF dim = 0; !set dim for owns
if (DIM != 0) goto L_00A9;
DIM = 1;
L_00A9:;
// 1264 app = dim
APP = DIM;
// 1265 %FINISH
L_00A8:;
// 1266
// 1267 d = d!used bit %IF (otype > 2 %AND d&spec = 0) %OR perm # 0 %OR %C
if (OTYPE <= 2) goto L_00AA;
if (D & 128 == 0) goto L_00AB;
L_00AA:;
if (PERM != 0) goto L_00AB;
if (LEVEL != INCLUDELEVEL) goto L_00AC;
L_00AB:;
D = D | 32768;
L_00AC:;
// 1268+ Level = Include Level
// 1269
// 1270 !external definitions need not be used in the file in which
// 1271 !they are defined, so inhibit a useless unused warning.
// 1272
// 1273 t == tag(x)
T = (struct TAGFM *)/*?*/ &TAG[X];
// 1274 %IF form = lab %START
if (FORM != 3) goto L_00AD;
// 1275 id = id+1; vid = id
ID = ID + 1;
VID = ID;
// 1276 %FINISH
L_00AD:;
// 1277 t_index = vid
T->INDEX = VID;
// 1278 t_text = new name
T->TEXT = NEWNAME;
// 1279 t_flags <- d
T->FLAGS = (int)(D);
// 1280 t_app = app
T->APP = APP;
// 1281 t_format = fdef; format = fdef
T->FORMAT = FDEF;
FORMAT = FDEF;
// 1282 subatom = x
SUBATOM = X;
// 1283
// 1284 %IF new >= 0 %START; !insert into hash table
if (NEW < 0) goto L_00AE;
// 1285 t_link = dict(new); dict(new) = x
T->LINK = DICT[NEW - 1];
DICT[NEW - 1] = X;
// 1286 %IF gmin = max grammar %START; !proc param params
if (GMIN != 1720) goto L_00AF;
// 1287 tmin = tmin-1; subatom = tmin
TMIN = TMIN - 1;
SUBATOM = TMIN;
// 1288 tag(tmin) = t
TAG[TMIN] = *T;
// 1289 %FINISH
L_00AF:;
// 1290 %FINISH
L_00AE:;
// 1291 abandon(3) %IF tmax >= tmin
if (TMAX < TMIN) goto L_00B0;
ABANDON(3);
L_00B0:;
// 1292 %END
return;
} /* end of LOOKUP */
// 1293
// 1294
// 1295
// 1296 top: pos1 = pos
U_100D:;
POS1 = POS;
// 1297 subatom = 0; pend quote = 0; atom flags = 0
SUBATOM = 0;
PENDQUOTE = 0;
ATOMFLAGS = 0;
// 1298
// 1299 !app and format must be left for assigning to papp & pformat
// 1300
// 1301 ->name %IF symtype = -2; !letter
if (SYMTYPE != -2) goto L_00B1;
goto U_100E;
L_00B1:;
// 1302 ->number %IF symtype < 0; !digit
if (SYMTYPE >= 0) goto L_00B2;
goto U_100F;
L_00B2:;
// 1303 %IF symtype = 0 %START
if (SYMTYPE != 0) goto L_00B3;
// 1304 atom1 = termin; atom2 = 0
ATOM1 = 20;
ATOM2 = 0;
// 1305 %RETURN
return;
// 1306 %FINISH
L_00B3:;
// 1307 %IF symtype # 2 %START; !catch keywords here
if (SYMTYPE == 2) goto L_00B4;
// 1308 ->text %IF quote # 0; !completion of text
if (QUOTE == 0) goto L_00B5;
goto U_1010;
L_00B5:;
// 1309 ->strings %IF sym = squote; !start of string
if (SYM != 34) goto L_00B6;
goto U_1011;
L_00B6:;
// 1310 ->symbols %IF sym = cquote; !start of symbol
if (SYM != 39) goto L_00B7;
goto U_1012;
L_00B7:;
// 1311 ->number %IF sym = '.' %AND '0' <= nextsymbol <= '9'
if (SYM != 46) goto L_00B8;
{
// Double-sided test on _imp_NEXTSYMBOL() (Part I)
int tmp;
if (48 > (tmp = _imp_NEXTSYMBOL())) goto L_00B8;
// Double-sided test on _imp_NEXTSYMBOL() (Part II)
if (tmp > 57) goto L_00B8;
}
goto U_100F;
L_00B8:;
// 1312 %FINISH
L_00B4:;
// 1313
// 1314 !locate atom in fixed dict
// 1315 k = key>>2; read sym
K = (unsigned int)KEY >> 2;
READSYM();
// 1316 %CYCLE
L_00B9:;
// 1317 j = kdict(k)
J = KDICT[K - 32];
// 1318 %EXIT %IF j&x'4000' # 0
if (J & 16384 == 0) goto L_00BA;
goto L_00BB;
L_00BA:;
// 1319 %IF j&127 # sym %OR symtype < 0 %START
if (J & 127 != SYM) goto L_00BC;
if (SYMTYPE >= 0) goto L_00BD;
L_00BC:;
// 1320 ->err %UNLESS j < 0
if (J < 0) goto L_00BE;
goto U_1013;
L_00BE:;
// 1321 k = k+1
K = K + 1;
// 1322 %FINISH %ELSE %START
goto L_00BF;
L_00BD:;
// 1323 l = j>>7&127; read sym
L = (unsigned int)J >> 7 & 127;
READSYM();
// 1324 %IF j > 0 %START
if (J <= 0) goto L_00C0;
// 1325 %IF l # 0 %START
if (L == 0) goto L_00C1;
// 1326 ->err %IF l # sym %OR symtype < 0
if (L != SYM) goto L_00C2;
if (SYMTYPE >= 0) goto L_00C3;
L_00C2:;
goto U_1013;
L_00C3:;
// 1327 read sym
READSYM();
// 1328 %FINISH
L_00C1:;
// 1329 l = 1
L = 1;
// 1330 %FINISH
L_00C0:;
// 1331 k = k+l
K = K + L;
// 1332 %FINISH
L_00BF:;
// 1333 %REPEAT
goto L_00B9;
L_00BB:;
// 1334 atom1 = j&127
ATOM1 = J & 127;
// 1335 %IF atom1 = 0 %START; !comma
if (ATOM1 != 0) goto L_00C4;
// 1336 atom1 = 19; subatom = 19; atom2 = 0
ATOM1 = 19;
SUBATOM = 19;
ATOM2 = 0;
// 1337 %IF sym = nl %START
if (SYM != 10) goto L_00C5;
// 1338 %RETURN %IF ocount >= 0
if (OCOUNT < 0) goto L_00C6;
return;
L_00C6:;
// 1339
// 1340 !special action needs to be taken with <comma nl> as
// 1341 !const array lists can be enormous
// 1342
// 1343 read sym
READSYM();
// 1344 %FINISH
L_00C5:;
// 1345 %RETURN
return;
// 1346 %FINISH
L_00C4:;
// 1347 atom2 = j>>7&127
ATOM2 = (unsigned int)J >> 7 & 127;
// 1348 subatom = kdict(k+1)&x'3fff'
SUBATOM = KDICT[K + 1 - 32] & 16383;
// 1349 !!!!!cont = ' '
// 1350 %RETURN
return;
// 1351
// 1352 !report an error. adjust the error marker (pos1) to point
// 1353 !to the faulty character in an atom, but care needs to be taken
// 1354 !to prevent misleading reports in cases like ...?????
// 1355
// 1356 err: atom1 = error+1; atom2 = 0
U_1013:;
ATOM1 = 32768 + 1;
ATOM2 = 0;
// 1357 pos1 = pos %IF pos-pos1 > 2
if (POS - POS1 <= 2) goto L_00C7;
POS1 = POS;
L_00C7:;
// 1358 %RETURN
return;
// 1359
// 1360 !take care with strings and symbol constants.
// 1361 !make sure the constant is valid here before sucking it in
// 1362 !(and potentially loosing many lines)
// 1363
// 1364 symbols:atom1 = var; atom2 = const; type = integer
U_1012:;
ATOM1 = 91;
ATOM2 = 93;
TYPE = 1;
// 1365 map gg = const; protection = prot
MAPGG = 93;
PROTECTION = 256;
// 1366 subatom = lp; abandon(3) %IF lp >= lit max
SUBATOM = LP;
if (LP < 50) goto L_00C8;
ABANDON(3);
L_00C8:;
// 1367 quote = \pend quote
QUOTE = (~PENDQUOTE);
// 1368 %RETURN
return;
// 1369
// 1370 !an integer constant is acceptable so get it in and
// 1371 !get the next atom
// 1372
// 1373 chars:n = 0; cont = cquote
U_1014:;
N = 0;
CONT = 39;
// 1374 %CYCLE
L_00C9:;
// 1375 read sym
READSYM();
// 1376 %IF sym = cquote %START
if (SYM != 39) goto L_00CA;
// 1377 %EXIT %IF nextsymbol # cquote
if (_imp_NEXTSYMBOL() == 39) goto L_00CB;
goto L_00CC;
L_00CB:;
// 1378 read sym
READSYM();
// 1379 %FINISH
L_00CA:;
// 1380 %IF n&(\((-1)>>byte size)) # 0 %START; ! overflow
if (N & ~((unsigned int)(-1) >> 8) == 0) goto L_00CD;
// 1381 pos1 = pos; atom1 = error+10; %RETURN
POS1 = POS;
ATOM1 = 32768 + 10;
return;
// 1382 %FINISH
L_00CD:;
// 1383 ->err %IF quote = 0
if (QUOTE != 0) goto L_00CE;
goto U_1013;
L_00CE:;
// 1384 n = n<<byte size+sym
N = (N << 8) + SYM;
// 1385 quote = quote+1
QUOTE = QUOTE + 1;
// 1386 %REPEAT
goto L_00C9;
L_00CC:;
// 1387 quote = 0; cont = ' '
QUOTE = 0;
CONT = 32;
// 1388 readsym %IF sym # nl
if (SYM == 10) goto L_00CF;
READSYM();
L_00CF:;
// 1389 lit pool(lp) = n; lp = lp+1
LITPOOL[LP] = N;
LP = LP + 1;
// 1390 ->top
goto U_100D;
// 1391
// 1392 !sniff the grammar before getting the string
// 1393
// 1394 strings:atom1 = var; atom2 = const; type = stringv
U_1011:;
ATOM1 = 91;
ATOM2 = 93;
TYPE = 3;
// 1395 subatom = (strp-stbase)!x'4000'
SUBATOM = STRP - STBASE | 16384;
// 1396 map gg = const; protection = prot
MAPGG = 93;
PROTECTION = 256;
// 1397 quote = subatom
QUOTE = SUBATOM;
// 1398 text line = lines; !in case of errors
TEXTLINE = LINES;
// 1399 %RETURN
return;
// 1400
// 1401 !a string constant is ok here, so pull it in and get
// 1402 !the next atom
// 1403
// 1404 text: ->chars %IF quote < 0; !character consts
U_1010:;
if (QUOTE >= 0) goto L_00D0;
goto U_1014;
L_00D0:;
// 1405 l = strp; n = strp
L = STRP;
N = STRP;
// 1406 j = addr(glink(gmin-1)); !absolute limit
J = _imp_ADDR(/*?*/ &GLINK[GMIN - 1]);
// 1407 k = l+256; !string length limit
K = L + 256;
// 1408 k = j %IF j < k; !choose lower
if (J >= K) goto L_00D1;
K = J;
L_00D1:;
// 1409
// 1410 %CYCLE
L_00D2:;
// 1411 cont = squote; quote = 1
CONT = 34;
QUOTE = 1;
// 1412 %CYCLE
L_00D3:;
// 1413 read sym
READSYM();
// 1414 %IF sym = squote %START; !terminator?
if (SYM != 34) goto L_00D4;
// 1415 %EXIT %IF nextsymbol # squote; !yes ->
if (_imp_NEXTSYMBOL() == 34) goto L_00D5;
goto L_00D6;
L_00D5:;
// 1416 read sym; ! skip quote
READSYM();
// 1417 %FINISH
L_00D4:;
// 1418 l = l+1; byteinteger(l) = sym
L = L + 1;
*_imp_BYTEINTEGER(L) = SYM;
// 1419 lines = text line %AND abandon(7) %IF l >= k; !too many chars
if (L < K) goto L_00D7;
LINES = TEXTLINE;
ABANDON(7);
L_00D7:;
// 1420 %REPEAT
goto L_00D3;
L_00D6:;
// 1421 byteinteger(n) = l-n; !plug in length
*_imp_BYTEINTEGER(N) = L - N;
// 1422
// 1423 strp = l+1; !ready for next string
STRP = L + 1;
// 1424 quote = 0; cont = ' '; read sym
QUOTE = 0;
CONT = 32;
READSYM();
// 1425 code atom(target)
CODEATOM(TARGET);
// 1426 %RETURN %UNLESS atom1 = 48 %AND sym = squote; !fold "???"."+++"
if (ATOM1 != 48) goto L_00D8;
if (SYM == 34) goto L_00D9;
L_00D8:;
return;
L_00D9:;
// 1427 %REPEAT
goto L_00D2;
// 1428
// 1429 %ROUTINE get(%INTEGER limit)
void GET(int LIMIT) {
// 1430 %INTEGER s, shift
int S;
int SHIFT;
// 1431 shift = 0
SHIFT = 0;
// 1432 %IF base # 10 %START
if (BASE == 10) goto L_00DA;
// 1433 %IF base = 16 %START
if (BASE != 16) goto L_00DB;
// 1434 shift = 4
SHIFT = 4;
// 1435 %FINISH %ELSE %START
goto L_00DC;
L_00DB:;
// 1436 %IF base = 8 %START
if (BASE != 8) goto L_00DD;
// 1437 shift = 3
SHIFT = 3;
// 1438 %FINISH %ELSE %START
goto L_00DE;
L_00DD:;
// 1439 %IF base = 2 %START
if (BASE != 2) goto L_00DF;
// 1440 shift = 1
SHIFT = 1;
// 1441 %FINISH
L_00DF:;
// 1442 %FINISH
L_00DE:;
// 1443 %FINISH
L_00DC:;
// 1444 %FINISH
L_00DA:;
// 1445 n = 0
N = 0;
// 1446 %CYCLE
L_00E0:;
// 1447 %IF symtype = -1 %START; !digit
if (SYMTYPE != -1) goto L_00E1;
// 1448 s = sym-'0'
S = SYM - 48;
// 1449 %FINISH %ELSE %START
goto L_00E2;
L_00E1:;
// 1450 %IF symtype < 0 %START; !letter
if (SYMTYPE >= 0) goto L_00E3;
// 1451 s = sym-'A'+10
S = SYM - 65 + 10;
// 1452 %FINISH %ELSE %START
goto L_00E4;
L_00E3:;
// 1453 %RETURN
return;
// 1454 %FINISH
L_00E4:;
// 1455 %FINISH
L_00E2:;
// 1456 %RETURN %IF s >= limit
if (S < LIMIT) goto L_00E5;
return;
L_00E5:;
// 1457 pt = pt+1; byteinteger(pt) = sym
PT = PT + 1;
*_imp_BYTEINTEGER(PT) = SYM;
// 1458 %IF base = 10 %START; !check overflow
if (BASE != 10) goto L_00E6;
// 1459 %IF n >= max int %AND (s > max dig %OR n > max int) %START
if (N < 214748364) goto L_00E7;
if (S > 7) goto L_00E8;
if (N <= 214748364) goto L_00E7;
L_00E8:;
// 1460
// 1461 !too big for an integer,
// 1462 !so call it a real
// 1463
// 1464 base = 0; type = real; n = 0
BASE = 0;
TYPE = 2;
N = 0;
// 1465 %FINISH
L_00E7:;
// 1466 %FINISH
L_00E6:;
// 1467 %IF shift = 0 %START
if (SHIFT != 0) goto L_00E9;
// 1468 n = n*base+s
N = N * BASE + S;
// 1469 %FINISH %ELSE %START
goto L_00EA;
L_00E9:;
// 1470 n = n<<shift+s
N = (N << SHIFT) + S;
// 1471 %FINISH
L_00EA:;
// 1472 read sym
READSYM();
// 1473 %REPEAT
goto L_00E0;
// 1474 %END
} /* end of GET */
// 1475
// 1476 number:base = 10
U_100F:;
BASE = 10;
// 1477 bxk: atom1 = var; atom2 = const; type = integer; subatom = lp
U_100C:;
ATOM1 = 91;
ATOM2 = 93;
TYPE = 1;
SUBATOM = LP;
// 1478 map gg = const; protection = prot
MAPGG = 93;
PROTECTION = 256;
// 1479 abandon(3) %IF lp >= lit max
if (LP < 50) goto L_00EB;
ABANDON(3);
L_00EB:;
// 1480 pt = strp; mul = 0
PT = STRP;
MUL = 0;
// 1481 %CYCLE
L_00EC:;
// 1482 get(base)
GET(BASE);
// 1483 %EXIT %UNLESS sym = '_' %AND base # 0 %AND pend quote = 0; !change of base
if (SYM != 95) goto L_00ED;
if (BASE == 0) goto L_00ED;
if (PENDQUOTE == 0) goto L_00EE;
L_00ED:;
goto L_00EF;
L_00EE:;
// 1484 pt = pt+1; byteinteger(pt) = '_'
PT = PT + 1;
*_imp_BYTEINTEGER(PT) = 95;
// 1485 read sym
READSYM();
// 1486 base = n
BASE = N;
// 1487 %REPEAT
goto L_00EC;
L_00EF:;
// 1488
// 1489 %IF pend quote # 0 %START
if (PENDQUOTE == 0) goto L_00F0;
// 1490 ->err %IF sym # cquote
if (SYM == 39) goto L_00F1;
goto U_1013;
L_00F1:;
// 1491 readsym
READSYM();
// 1492 %FINISH
L_00F0:;
// 1493 %IF sym = '.' %START; !a real constant
if (SYM != 46) goto L_00F2;
// 1494 pt = pt+1; byteinteger(pt) = '.'
PT = PT + 1;
*_imp_BYTEINTEGER(PT) = 46;
// 1495 read sym
READSYM();
// 1496 type = real; n = base; base = 0; get(n)
TYPE = 2;
N = BASE;
BASE = 0;
GET(N);
// 1497 %FINISH
L_00F2:;
// 1498
// 1499 %IF sym = '@' %START; !an exponent
if (SYM != 64) goto L_00F3;
// 1500 pt = pt+1; byteinteger(pt) = '@'; k = pt
PT = PT + 1;
*_imp_BYTEINTEGER(PT) = 64;
K = PT;
// 1501 readsym
READSYM();
// 1502 type = integer; base = 10
TYPE = 1;
BASE = 10;
// 1503 %IF sym = '-' %START
if (SYM != 45) goto L_00F4;
// 1504 read sym; get(10); n = -n
READSYM();
GET(10);
N = -N;
// 1505 %FINISH %ELSE %START
goto L_00F5;
L_00F4:;
// 1506 get(10)
GET(10);
// 1507 %FINISH
L_00F5:;
// 1508 pt = k+1; byteinteger(pt) = lp; litpool(lp) = n; lp = lp+1
PT = K + 1;
*_imp_BYTEINTEGER(PT) = LP;
LITPOOL[LP] = N;
LP = LP + 1;
// 1509 atom1 = error+10 %IF base = 0
if (BASE != 0) goto L_00F6;
ATOM1 = 32768 + 10;
L_00F6:;
// 1510 type = real; !exponents force the type
TYPE = 2;
// 1511 %FINISH
L_00F3:;
// 1512
// 1513 %IF type = real %START
if (TYPE != 2) goto L_00F7;
// 1514 byteinteger(strp) = pt-strp
*_imp_BYTEINTEGER(STRP) = PT - STRP;
// 1515 subatom = (strp-stbase)!x'2000'; strp = pt+1
SUBATOM = STRP - STBASE | 8192;
STRP = PT + 1;
// 1516 %FINISH %ELSE %START
goto L_00F8;
L_00F7:;
// 1517 litpool(lp) = n
LITPOOL[LP] = N;
// 1518 lp = lp+1
LP = LP + 1;
// 1519 %FINISH
L_00F8:;
// 1520 %RETURN
return;
// 1521
// 1522 name: atom1 = 0 %AND %RETURN %IF 27 <= target <= 41
U_100E:;
{
// Double-sided test on TARGET (Part I)
int tmp;
if (27 > (tmp = TARGET)) goto L_00F9;
// Double-sided test on TARGET (Part II)
if (tmp > 41) goto L_00F9;
}
ATOM1 = 0;
return;
L_00F9:;
// 1523 hash value = 0
HASHVALUE = 0;
// 1524
// 1525 !*****************************
// 1526 !*machine dependent for speed*
// 1527 !*****************************
// 1528
// 1529 dp = dmax+1
DP = DMAX + 1;
// 1530 da = addr(dict(dp)); dbase = da
DA = _imp_ADDR(/*?*/ &DICT[DP - 1]);
DBASE = DA;
// 1531 %CYCLE
L_00FA:;
// 1532 hash value = hash value+(hash value+sym); !is this good enough?
HASHVALUE = HASHVALUE + (HASHVALUE + SYM);
// 1533 da = da+1; byteinteger(da) = sym
DA = DA + 1;
*_imp_BYTEINTEGER(DA) = SYM;
// 1534 read sym
READSYM();
// 1535 %EXIT %IF symtype >= 0
if (SYMTYPE < 0) goto L_00FB;
goto L_00FC;
L_00FB:;
// 1536 %REPEAT
goto L_00FA;
L_00FC:;
// 1537 %IF sym = cquote %START
if (SYM != 39) goto L_00FD;
// 1538 pend quote = 100
PENDQUOTE = 100;
// 1539 ->symbols %IF hash value = 'M'
if (HASHVALUE != 77) goto L_00FE;
goto U_1012;
L_00FE:;
// 1540 read sym
READSYM();
// 1541 %IF hash value = 'X' %THEN base = 16 %AND ->bxk
if (HASHVALUE != 88) goto L_00FF;
BASE = 16;
goto U_100C;
L_00FF:;
// 1542 %IF hash value = 'K' %C
if (HASHVALUE == 75) goto L_0100;
if (HASHVALUE != 79) goto L_0101;
L_0100:;
BASE = 8;
goto U_100C;
L_0101:;
// 1543+ %OR hash value = 'O' %THEN base = 8 %AND ->bxk
// 1544 %IF hash value = 'B' %THEN base = 2 %AND ->bxk
if (HASHVALUE != 66) goto L_0102;
BASE = 2;
goto U_100C;
L_0102:;
// 1545 ->err
goto U_1013;
// 1546 %FINISH
L_00FD:;
// 1547 n = da-dbase
N = DA - DBASE;
// 1548 byteinteger(dbase) = n
*_imp_BYTEINTEGER(DBASE) = N;
// 1549 dp = dp+(n+2)>>1
DP = DP + ((unsigned int)N + 2 >> 1);
// 1550 abandon(8) %IF dp >= dmin
if (DP < DMIN) goto L_0103;
ABANDON(8);
L_0103:;
// 1551
// 1552 atom2 = 90; !ident
ATOM2 = 90;
// 1553 %IF last1 = 0 %AND sym = ':' %START; !label
if (LAST1 != 0) goto L_0104;
if (SYM != 58) goto L_0104;
// 1554 limit = local; lookup(lab); %RETURN
LIMIT = LOCAL;
LOOKUP(3);
return;
// 1555 %FINISH
L_0104:;
// 1556 %IF last1 = jump %START; !->label
if (LAST1 != 54) goto L_0105;
// 1557 limit = local; lookup(lab+spec+used bit); %RETURN
LIMIT = LOCAL;
LOOKUP(3 + 128 + 32768);
return;
// 1558 %FINISH
L_0105:;
// 1559 %IF decl # 0 %AND target = 90 %START; !identifier
if (DECL == 0) goto L_0106;
if (TARGET != 90) goto L_0106;
// 1560 search base = fm base
SEARCHBASE = FMBASE;
// 1561 limit = local; lookup(decl)
LIMIT = LOCAL;
LOOKUP(DECL);
// 1562 search base = 0
SEARCHBASE = 0;
// 1563 %FINISH %ELSE %START
goto L_0107;
L_0106:;
// 1564 limit = 0; lookup(0)
LIMIT = 0;
LOOKUP(0);
// 1565 %FINISH
L_0107:;
// 1566 %END
return;
} /* end of CODEATOM */
// 1567
// 1568 %INTEGERFN parsed machine code
int PARSEDMACHINECODE(void) {
// 1569 ! *opcode_??????????
// 1570 %routine octal(%integer n)
void OCTAL(int N) {
// 1571 %integer m
int M;
// 1572 m = n>>3
M = (unsigned int)N >> 3;
// 1573 octal(m) %if m # 0
if (M == 0) goto L_0108;
OCTAL(M);
L_0108:;
// 1574 bp = bp+1; buff(bp) = n&7+'0'
BP = BP + 1;
BUFF[BP - 1] = (N & 7) + 48;
// 1575 %end
return;
} /* end of OCTAL */
// 1576 atom1 = error %AND %RESULT=0 %UNLESS symtype = -2; !starts with letter
if (SYMTYPE == -2) goto L_0109;
ATOM1 = 32768;
return 0;
L_0109:;
// 1577 flush buffer %IF bp >= 128
if (BP < 128) goto L_010A;
FLUSHBUFFER();
L_010A:;
// 1578 bp=bp+1 %AND buff(bp)='w'
BP = BP + 1;
BUFF[BP - 1] = 119;
// 1579 %CYCLE
L_010B:;
// 1580 bp=bp+1 %AND buff(bp)=sym
BP = BP + 1;
BUFF[BP - 1] = SYM;
// 1581 read sym
READSYM();
// 1582 %EXIT %IF symtype >= 0; !pull in letters and digits
if (SYMTYPE < 0) goto L_010C;
goto L_010D;
L_010C:;
// 1583 %REPEAT
goto L_010B;
L_010D:;
// 1584 bp=bp+1 %AND buff(bp)='_'
BP = BP + 1;
BUFF[BP - 1] = 95;
// 1585 %IF symtype # 0 %START; !not terminator
if (SYMTYPE == 0) goto L_010E;
// 1586 atom1 = error %AND %result=0 %UNLESS sym = '_'
if (SYM == 95) goto L_010F;
ATOM1 = 32768;
return 0;
L_010F:;
// 1587 read sym
READSYM();
// 1588 %WHILE symtype # 0 %CYCLE
L_0110:;
if (SYMTYPE == 0) goto L_0111;
// 1589 %IF symtype < 0 %START; !complex
if (SYMTYPE >= 0) goto L_0112;
// 1590 code atom(0); %result=0 %IF atom1&error # 0
CODEATOM(0);
if (ATOM1 & 32768 == 0) goto L_0113;
return 0;
L_0113:;
// 1591 %IF atom2 = const %AND type = integer %START
if (ATOM2 != 93) goto L_0114;
if (TYPE != 1) goto L_0114;
// 1592 %IF subatom < 0 %THEN octal(tag(-subatom)_format) %C
if (SUBATOM >= 0) goto L_0115;
OCTAL(TAG[-SUBATOM].FORMAT);
goto L_0116;
L_0115:;
OCTAL(LITPOOL[SUBATOM]);
L_0116:;
// 1593+ %ELSE octal(litpool(subatom))
// 1594 %FINISH %ELSE %START
goto L_0117;
L_0114:;
// 1595 %IF 91 <= atom1 <= 109 %START
{
// Double-sided test on ATOM1 (Part I)
int tmp;
if (91 > (tmp = ATOM1)) goto L_0118;
// Double-sided test on ATOM1 (Part II)
if (tmp > 109) goto L_0118;
}
// 1596 %if atom1 = 104 {label} %and %C
if (ATOM1 != 104) goto L_0119;
if (TAG[SUBATOM].FLAGS & 16384 != 0) goto L_0119;
// 1597+ Tag(Subatom)_Flags&Closed = 0 %start
// 1598 This = Subatom; Atom1 = Error+21
THIS = SUBATOM;
ATOM1 = 32768 + 21;
// 1599 %result = 0
return 0;
// 1600 %finish
L_0119:;
// 1601 op(' ', tag(subatom)_index)
OP(32, TAG[SUBATOM].INDEX);
// 1602 %FINISH %ELSE %START
goto L_011A;
L_0118:;
// 1603 atom1 = error; %result=0
ATOM1 = 32768;
return 0;
// 1604 %FINISH
L_011A:;
// 1605 %FINISH
L_0117:;
// 1606 %FINISH %ELSE %START
goto L_011B;
L_0112:;
// 1607 bp=bp+1 %AND buff(bp)=sym; read sym
BP = BP + 1;
BUFF[BP - 1] = SYM;
READSYM();
// 1608 %FINISH
L_011B:;
// 1609 %REPEAT
goto L_0110;
L_0111:;
// 1610 %FINISH
L_010E:;
// 1611 bp=bp+1 %AND buff(bp)=';'
BP = BP + 1;
BUFF[BP - 1] = 59;
// 1612 %RESULT=1
return 1;
// 1613 %END
} /* end of PARSEDMACHINECODE */
// 1614
// 1615 cont = ' ' %IF gg = 0
if (GG != 0) goto L_011C;
CONT = 32;
L_011C:;
// 1616 last1 = 0; mapgg = 0
LAST1 = 0;
MAPGG = 0;
// 1617 s = 0; ss = 0; sstype = -1; fdef = 0
S = 0;
SS = 0;
SSTYPE = -1;
FDEF = 0;
// 1618 fm base = 0
FMBASE = 0;
// 1619 app = 0
APP = 0;
// 1620
// 1621 !deal with alignment following an error in one statement
// 1622 !of several on a line
// 1623
// 1624 margin = column; !start of statement
MARGIN = COLUMN;
// 1625
// 1626 pos = 0
POS = 0;
// 1627 stbase = addr(glink(gmax+1)); strp = stbase; lp = 0
STBASE = _imp_ADDR(/*?*/ &GLINK[GMAX + 1]);
STRP = STBASE;
LP = 0;
// 1628 tbase = tstart; !??????????????
TBASE = TSTART;
// 1629 local = tbase
LOCAL = TBASE;
// 1630
// 1631 %IF gg = 0 %or ocount >= 0 %START; !data or not continuation(z)
if (GG == 0) goto L_011D;
if (OCOUNT < 0) goto L_011E;
L_011D:;
// 1632 again:%WHILE sym type = 0 %CYCLE; !skip redundant terminators
U_1006:;
L_011F:;
if (SYMTYPE != 0) goto L_0120;
// 1633 c = cont
C = CONT;
// 1634 cont = ' '; cont = '+' %IF ocount >= 0
CONT = 32;
if (OCOUNT < 0) goto L_0121;
CONT = 43;
L_0121:;
// 1635 read sym
READSYM();
// 1636 cont = c
CONT = C;
// 1637 %REPEAT
goto L_011F;
L_0120:;
// 1638 ->skip %IF sym = '!'; !comment
if (SYM != 33) goto L_0122;
goto U_1007;
L_0122:;
// 1639 this = -1
THIS = -1;
// 1640 code atom(0)
CODEATOM(0);
// 1641 %IF atom1 = comment %START
if (ATOM1 != 22) goto L_0123;
// 1642 skip: quote = 1
U_1007:;
QUOTE = 1;
// 1643 c = cont
C = CONT;
// 1644 read sym %AND cont = c %WHILE sym # nl; !skip to end of line
L_0124:;
if (SYM == 10) goto L_0125;
READSYM();
CONT = C;
goto L_0124;
L_0125:;
// 1645 quote = 0; symtype = 0
QUOTE = 0;
SYMTYPE = 0;
// 1646 ->again
goto U_1006;
// 1647 %FINISH
L_0123:;
// 1648 %FINISH
L_011E:;
// 1649 decl = 0; mark = 0
DECL = 0;
MARK = 0;
// 1650 gentype = 0; force = 0
GENTYPE = 0;
FORCE = 0;
// 1651 dim = 0; prot err = 0
DIM = 0;
PROTERR = 0;
// 1652 node = 0; nmax = 0; nmin = rec size+1
NODE = 0;
NMAX = 0;
NMIN = 520 + 1;
// 1653 order = 1; gmin = max grammar+1
ORDER = 1;
GMIN = 1720 + 1;
// 1654 sstype = 0 %AND ->more %IF gg # 0; !continuation
if (GG == 0) goto L_0126;
SSTYPE = 0;
goto U_1008;
L_0126:;
// 1655 ptype = 0; spec given = 0
PTYPE = 0;
SPECGIVEN = 0;
// 1656
// 1657 stats = stats+1; op('O', lines) %IF perm = 0
STATS = STATS + 1;
if (PERM != 0) goto L_0127;
OP(79, LINES);
L_0127:;
// 1658
// 1659 ->fail1 %IF atom1&error # 0; !first atom faulty
if (ATOM1 & 32768 == 0) goto L_0128;
goto U_1009;
L_0128:;
// 1660
// 1661 %IF escape class # 0 %START; !enter the hard way after
if (ESCAPECLASS == 0) goto L_0129;
// 1662 g = imp phrase; sstype = -1; ->a3
G = 25;
SSTYPE = -1;
goto U_100A;
// 1663 %FINISH
L_0129:;
// 1664
// 1665 g = initial(atom1); !pick up entry point
G = INITIAL[ATOM1];
// 1666 %IF g = 0 %START; !invalid first atom
if (G != 0) goto L_012A;
// 1667 g = initial(0); sstype = 0; ->a3; !declarator?
G = INITIAL[0];
SSTYPE = 0;
goto U_100A;
// 1668 %FINISH
L_012A:;
// 1669 %IF g < 0 %START; !phrase imp
if (G >= 0) goto L_012B;
// 1670 g = g&255
G = G & 255;
// 1671 nmax = 1
NMAX = 1;
// 1672 ar(1)_class = 0; ar(1)_link = 0; ar(1)_sub = imp phrase
AR[0].CLASS = 0;
AR[0].LINK = 0;
AR[0].SUB = 25;
// 1673 %FINISH
L_012B:;
// 1674
// 1675 gg = gram(g); class = gg&255; sstype = gg>>12&3-1
GG = GRAM[G];
CLASS = GG & 255;
SSTYPE = ((unsigned int)GG >> 12 & 3) - 1;
// 1676 ->a1
goto U_1015;
// 1677
// 1678 act(194): ptype = type; papp = app; pformat = format; ->more
case_ACT_194:;
PTYPE = TYPE;
PAPP = APP;
PFORMAT = FORMAT;
goto U_1008;
// 1679 act(196):k =g+1; ->a610
case_ACT_196:;
K = G + 1;
goto U_1016;
// 1680 act(188):k = ar(nmax)_sub+1
case_ACT_188:;
K = AR[NMAX - 1].SUB + 1;
// 1681 a610: papp = glink(k)
U_1016:;
PAPP = GLINK[K];
// 1682 k = gram(k)
K = GRAM[K];
// 1683 ->more %IF k = 0; !%NAME
if (K != 0) goto L_012D;
goto U_1008;
L_012D:;
// 1684 ptype = k&7; pformat = k>>3
PTYPE = K & 7;
PFORMAT = (unsigned int)K >> 3;
// 1685 act(183):k = type; gentype = k %IF gentype = 0 %OR k = real
case_ACT_183:;
K = TYPE;
if (GENTYPE == 0) goto L_012E;
if (K != 2) goto L_012F;
L_012E:;
GENTYPE = K;
L_012F:;
// 1686 %IF pformat < 0 %START; !general type
if (PFORMAT >= 0) goto L_0130;
// 1687 app = papp; format = pformat
APP = PAPP;
FORMAT = PFORMAT;
// 1688 k = real %IF ptype = real %AND type = integer
if (PTYPE != 2) goto L_0131;
if (TYPE != 1) goto L_0131;
K = 2;
L_0131:;
// 1689 k = force %AND force = 0 %IF force # 0
if (FORCE == 0) goto L_0132;
K = FORCE;
FORCE = 0;
L_0132:;
// 1690 %FINISH
L_0130:;
// 1691 ->fail2 %UNLESS papp = app %AND (ptype = k %OR ptype = 0)
if (PAPP != APP) goto L_0133;
if (PTYPE == K) goto L_0134;
if (PTYPE == 0) goto L_0134;
L_0133:;
goto U_1017;
L_0134:;
// 1692 ->more %IF pformat=format %OR pformat = 0 %OR format = 0
if (PFORMAT == FORMAT) goto L_0135;
if (PFORMAT == 0) goto L_0135;
if (FORMAT != 0) goto L_0136;
L_0135:;
goto U_1008;
L_0136:;
// 1693 ->fail2
goto U_1017;
// 1694 act(197):arp == ar(nmin)
case_ACT_197:;
ARP = (struct ARFM *)/*?*/ &AR[NMIN - 1];
// 1695 k = arp_sub
K = ARP->SUB;
// 1696 ->fail3 %UNLESS block form = k&15
if (BLOCKFORM == K & 15) goto L_0137;
goto U_1018;
L_0137:;
// 1697 arp_sub = k>>4
ARP->SUB = (unsigned int)K >> 4;
// 1698
// 1699 type = block type
TYPE = BLOCKTYPE;
// 1700 ptype = block type; pformat = block fm; papp = app
PTYPE = BLOCKTYPE;
PFORMAT = BLOCKFM;
PAPP = APP;
// 1701 pformat = -1 %IF ptype # record
if (PTYPE == 4) goto L_0138;
PFORMAT = -1;
L_0138:;
// 1702 ->more
goto U_1008;
// 1703 act(195):->Fail2 %if Type # 0 %and Type # Integer %and %C
case_ACT_195:;
if (TYPE == 0) goto L_0139;
if (TYPE == 1) goto L_0139;
if (TYPE == 2) goto L_0139;
goto U_1017;
L_0139:;
// 1704+ Type # Real
// 1705 arp == ar(nmin)
ARP = (struct ARFM *)/*?*/ &AR[NMIN - 1];
// 1706 k = arp_sub
K = ARP->SUB;
// 1707 arp_sub = k>>2
ARP->SUB = (unsigned int)K >> 2;
// 1708 k = k&3
K = K & 3;
// 1709 !1 = check integer
// 1710 !2 = check real
// 1711 !3 = check real + int
// 1712 ->more %IF k = 0; !0 = no action
if (K != 0) goto L_013A;
goto U_1008;
L_013A:;
// 1713 %IF k = 1 %START
if (K != 1) goto L_013B;
// 1714 force = integer
FORCE = 1;
// 1715 ->more %IF type = integer %OR type = 0
if (TYPE == 1) goto L_013C;
if (TYPE != 0) goto L_013D;
L_013C:;
goto U_1008;
L_013D:;
// 1716 ->fail2
goto U_1017;
// 1717 %FINISH
L_013B:;
// 1718 ->fail2 %UNLESS ptype = real %or ptype = 0 {or added?}
if (PTYPE == 2) goto L_013E;
if (PTYPE == 0) goto L_013E;
goto U_1017;
L_013E:;
// 1719 force = integer %IF k = 3
if (K != 3) goto L_013F;
FORCE = 1;
L_013F:;
// 1720 ->more
goto U_1008;
// 1721 act(198):!%OTHER
case_ACT_198:;
// 1722 k = gg>>8&15
K = (unsigned int)GG >> 8 & 15;
// 1723 %IF k = 0 %START; !restore atom
if (K != 0) goto L_0140;
// 1724 atom1 = last1
ATOM1 = LAST1;
// 1725 ->more
goto U_1008;
// 1726 %FINISH
L_0140:;
// 1727 %IF k = 1 %START; !test string
if (K != 1) goto L_0141;
// 1728 ->fail2 %UNLESS type = stringv
if (TYPE == 3) goto L_0142;
goto U_1017;
L_0142:;
// 1729 ->more
goto U_1008;
// 1730 %FINISH
L_0141:;
// 1731 %if k = 2 %start {fault record comparisons}
if (K != 2) goto L_0143;
// 1732 ->fail2 %if type = record
if (TYPE != 4) goto L_0144;
goto U_1017;
L_0144:;
// 1733 ->more
goto U_1008;
// 1734 %finish
L_0143:;
// 1735 %if k = 3 %start; !check OWN variable coming
if (K != 3) goto L_0145;
// 1736 code atom(0)
CODEATOM(0);
// 1737 ->A7 %if atom flags&own bit = 0
if (ATOMFLAGS & 512 != 0) goto L_0146;
goto U_1019;
L_0146:;
// 1738 ->more
goto U_1008;
// 1739 %finish
L_0145:;
// 1740 for warn = pos1 %IF x <= local; !%FORTEST
if (X > LOCAL) goto L_0147;
FORWARN = POS1;
L_0147:;
// 1741 ->more
goto U_1008;
// 1742 paction(1):%IF type = record %THEN g = phrase(242) %ELSE pformat = -1
case_PACTION_1:;
if (TYPE != 4) goto L_0149;
G = PHRASE[42];
goto L_014A;
L_0149:;
PFORMAT = -1;
L_014A:;
// 1743 ->a3
goto U_100A;
// 1744 paction(2):ptype = real; pformat = -1; ->a3
case_PACTION_2:;
PTYPE = 2;
PFORMAT = -1;
goto U_100A;
// 1745 paction(3):ptype = stringv; pformat = -1; ->a3
case_PACTION_3:;
PTYPE = 3;
PFORMAT = -1;
goto U_100A;
// 1746 paction(4):ptype = integer; pformat = -1; ->a3
case_PACTION_4:;
PTYPE = 1;
PFORMAT = -1;
goto U_100A;
// 1747 paction(5):->a3 %if ptype = integer
case_PACTION_5:;
if (PTYPE != 1) goto L_014B;
goto U_100A;
L_014B:;
// 1748 g = phrase(212) %AND pformat=-1 %IF ptype = real
if (PTYPE != 2) goto L_014C;
G = PHRASE[12];
PFORMAT = -1;
L_014C:;
// 1749 g = phrase(213) %IF ptype = stringv
if (PTYPE != 3) goto L_014D;
G = PHRASE[13];
L_014D:;
// 1750 ->a3
goto U_100A;
// 1751 paction(6):ptype = gram(ar(nmax)_sub+1)&7; pformat = -1; ->a3
case_PACTION_6:;
PTYPE = GRAM[AR[NMAX - 1].SUB + 1] & 7;
PFORMAT = -1;
goto U_100A;
// 1752 paction(7):ptype=real %IF ptype = integer; pformat = -1; ->a3
case_PACTION_7:;
if (PTYPE != 1) goto L_014E;
PTYPE = 2;
L_014E:;
PFORMAT = -1;
goto U_100A;
// 1753
// 1754 a1: last1 = class; atom1 = 0; s = subatom
U_1015:;
LAST1 = CLASS;
ATOM1 = 0;
S = SUBATOM;
// 1755
// 1756 a2: %IF gg&trans bit = 0 %START; !insert into analysis record
U_101A:;
if (GG & 16384 != 0) goto L_014F;
// 1757 z == node
Z = (short int *)/*?*/ &NODE;
// 1758 %CYCLE; !insert cell in order
L_0150:;
// 1759 k = z
K = *Z;
// 1760 %EXIT %IF gg&order bits = 0 %OR k = 0
if (GG & 12288 == 0) goto L_0151;
if (K != 0) goto L_0152;
L_0151:;
goto L_0153;
L_0152:;
// 1761 gg = gg-order bit; z == ar(k)_link
GG = GG - 4096;
Z = (short int *)/*?*/ &AR[K - 1].LINK;
// 1762 %REPEAT
goto L_0150;
L_0153:;
// 1763 gg = map gg %IF map gg # 0 %AND gg&255 = var
if (MAPGG == 0) goto L_0154;
if (GG & 255 != 91) goto L_0154;
GG = MAPGG;
L_0154:;
// 1764 nmin = nmin-1; ->fail0 %IF nmin = nmax
NMIN = NMIN - 1;
if (NMIN != NMAX) goto L_0155;
goto U_100D;
L_0155:;
// 1765 z = nmin
*Z = NMIN;
// 1766 arp == ar(nmin)
ARP = (struct ARFM *)/*?*/ &AR[NMIN - 1];
// 1767 arp_sub = s; arp_class = (gg&255)!mark
ARP->SUB = S;
ARP->CLASS = GG & 255 | MARK;
// 1768 arp_link = k
ARP->LINK = K;
// 1769 %FINISH
L_014F:;
// 1770 mark = 0; map gg = 0
MARK = 0;
MAPGG = 0;
// 1771
// 1772 more: g = glink(g); !chain down the grammar
U_1008:;
G = GLINK[G];
// 1773
// 1774 paction(0):
case_PACTION_0:;
// 1775 a3: gg = gram(g); class = gg&255
U_100A:;
GG = GRAM[G];
CLASS = GG & 255;
// 1776 trace analysis %IF diag&1 # 0
if (DIAG & 1 == 0) goto L_0156;
TRACEANALYSIS();
L_0156:;
// 1777 ->a5 %IF class = 0; !end of phrase
if (CLASS != 0) goto L_0157;
goto U_100E;
L_0157:;
// 1778
// 1779 %IF class < actions %START; !not a phrase or an action
if (CLASS >= 180) goto L_0158;
// 1780 class = atomic(class) %IF class >= figurative
if (CLASS < 130) goto L_0159;
CLASS = ATOMIC[CLASS - 130];
L_0159:;
// 1781 ->a2 %IF class >= manifest
if (CLASS < 120) goto L_015A;
goto U_101A;
L_015A:;
// 1782 code atom(class) %IF atom1 = 0
if (ATOM1 != 0) goto L_015B;
CODEATOM(CLASS);
L_015B:;
// 1783 %IF escape class # 0 %START; !escape to new grammar
if (ESCAPECLASS == 0) goto L_015C;
// 1784 class = escape class; escape class = 0
CLASS = ESCAPECLASS;
ESCAPECLASS = 0;
// 1785 g = g+escape
G = G + 4096;
// 1786
// 1787 !note that following an escape the next item is
// 1788 !forced to be transparent!
// 1789
// 1790 esc: gg = 0
U_100F:;
GG = 0;
// 1791 arp == ar(nmax+1)
ARP = (struct ARFM *)/*?*/ &AR[NMAX + 1 - 1];
// 1792 arp_papp = papp; arp_x = x; ->a4
ARP->PAPP = PAPP;
ARP->X = X;
goto U_1010;
// 1793 %FINISH
L_015C:;
// 1794
// 1795 ->a1 %IF class = atom1 %OR class = atom2
if (CLASS == ATOM1) goto L_015D;
if (CLASS != ATOM2) goto L_015E;
L_015D:;
goto U_1015;
L_015E:;
// 1796
// 1797 a7: ->fail1 %IF gg >= 0; !no alternative
U_1019:;
if (GG < 0) goto L_015F;
goto U_1009;
L_015F:;
// 1798 g = g+1
G = G + 1;
// 1799 ->a3
goto U_100A;
// 1800 %FINISH
L_0158:;
// 1801
// 1802 %IF class >= phrasal %START; !a phrase
if (CLASS < 200) goto L_0160;
// 1803 a4: nmax = nmax+1; ->fail0 %IF nmax = nmin
U_1010:;
NMAX = NMAX + 1;
if (NMAX != NMIN) goto L_0161;
goto U_100D;
L_0161:;
// 1804 arp == ar(nmax)
ARP = (struct ARFM *)/*?*/ &AR[NMAX - 1];
// 1805 arp_ptype = ptype
ARP->PTYPE = PTYPE;
// 1806 arp_pos = pos1
ARP->POS = POS1;
// 1807 arp_pformat = pformat
ARP->PFORMAT = PFORMAT;
// 1808 arp_link = gentype
ARP->LINK = GENTYPE;
// 1809 arp_class = node
ARP->CLASS = NODE;
// 1810 arp_sub = g
ARP->SUB = G;
// 1811 node = 0
NODE = 0;
// 1812 g = phrase(class)
G = PHRASE[CLASS - 200];
// 1813 ptype = force %AND force = 0 %IF force # 0
if (FORCE == 0) goto L_0162;
PTYPE = FORCE;
FORCE = 0;
L_0162:;
// 1814 gentype = 0
GENTYPE = 0;
// 1815 ->paction(gg>>8&15)
PACTION_line = __LINE__;
PACTION_file = __FILE__;
PACTION_index = (unsigned int)GG >> 8 & 15;
goto case_PACTION_dispatch;
// 1816 %FINISH
L_0160:;
// 1817
// 1818 ->act(class); !only actions left
ACT_line = __LINE__;
ACT_file = __FILE__;
ACT_index = CLASS;
goto case_ACT_dispatch;
// 1819
// 1820 a5: !reverse links
U_100E:;
// 1821
// 1822 s = 0
S = 0;
// 1823 %WHILE node # 0 %CYCLE
L_0163:;
if (NODE == 0) goto L_0164;
// 1824 z == ar(node)_link
Z = (short int *)/*?*/ &AR[NODE - 1].LINK;
// 1825 k = z; z = s; s = node; node = k
K = *Z;
*Z = S;
S = NODE;
NODE = K;
// 1826 %REPEAT
goto L_0163;
L_0164:;
// 1827 ss = s
SS = S;
// 1828
// 1829 a6: %IF nmax # 0 %START
U_1011:;
if (NMAX == 0) goto L_0165;
// 1830 k = gentype; !type of phrase
K = GENTYPE;
// 1831 arp == ar(nmax); nmax = nmax-1
ARP = (struct ARFM *)/*?*/ &AR[NMAX - 1];
NMAX = NMAX - 1;
// 1832 node = arp_class
NODE = ARP->CLASS;
// 1833 gentype = arp_link
GENTYPE = ARP->LINK;
// 1834 ptype = arp_ptype
PTYPE = ARP->PTYPE;
// 1835 pformat = arp_pformat
PFORMAT = ARP->PFORMAT;
// 1836 g = arp_sub
G = ARP->SUB;
// 1837 %IF g&escape # 0 %START
if (G & 4096 == 0) goto L_0166;
// 1838 g = g-escape
G = G - 4096;
// 1839 papp = arp_papp
PAPP = ARP->PAPP;
// 1840 mark = 255
MARK = 255;
// 1841 subatom = s
SUBATOM = S;
// 1842 ->a3
goto U_100A;
// 1843 %FINISH
L_0166:;
// 1844 gentype = k %IF gentype = 0 %OR k = real
if (GENTYPE == 0) goto L_0167;
if (K != 2) goto L_0168;
L_0167:;
GENTYPE = K;
L_0168:;
// 1845 type = gen type
TYPE = GENTYPE;
// 1846
// 1847 k = gg; !exit-point code
K = GG;
// 1848 %CYCLE
L_0169:;
// 1849 gg = gram(g)
GG = GRAM[G];
// 1850 ->a2 %IF k = 0
if (K != 0) goto L_016A;
goto U_101A;
L_016A:;
// 1851 ->fail1 %IF gg >= 0; !no alternative phrase
if (GG < 0) goto L_016B;
goto U_1009;
L_016B:;
// 1852 k = k-order bit
K = K - 4096;
// 1853 g = g+1; !sideways step
G = G + 1;
// 1854 %REPEAT
goto L_0169;
// 1855
// 1856 %FINISH
L_0165:;
// 1857
// 1858 Fault(4) %IF copy # 0
if (COPY == 0) goto L_016C;
FAULT(4);
L_016C:;
// 1859 fault(13) %IF order = 0
if (ORDER != 0) goto L_016D;
FAULT(13);
L_016D:;
// 1860 fault(-4) %IF for warn # 0
if (FORWARN == 0) goto L_016E;
FAULT(-4);
L_016E:;
// 1861 pos1 = 0
POS1 = 0;
// 1862 fault rate = fault rate-1
FAULTRATE = FAULTRATE - 1;
// 1863 %RETURN
return;
// 1864
// 1865 act(193):gg = 0 %AND ->a5 %UNLESS sym = '=' %or sym = '<'; !cdummy
case_ACT_193:;
if (SYM == 61) goto L_016F;
if (SYM == 60) goto L_016F;
GG = 0;
goto U_100E;
L_016F:;
// 1866 act(181):atom1 = amap(decl&15); !dummy
case_ACT_181:;
ATOM1 = AMAP[DECL & 15];
// 1867 ->more
goto U_1008;
// 1868
// 1869 act(182):class = escdec; g = glink(g)!escape
case_ACT_182:;
CLASS = 252;
G = GLINK[G] | 4096;
// 1870 decl = 0; otype = 0; ->esc; !decl
DECL = 0;
OTYPE = 0;
goto U_100F;
// 1871
// 1872 act(199): !compile
case_ACT_199:;
// 1873
// 1874 s = 0
S = 0;
// 1875 %WHILE node # 0 %CYCLE
L_0170:;
if (NODE == 0) goto L_0171;
// 1876 z == ar(node)_link
Z = (short int *)/*?*/ &AR[NODE - 1].LINK;
// 1877 k = z; z = s; s = node; node = k
K = *Z;
*Z = S;
S = NODE;
NODE = K;
// 1878 %repeat
goto L_0170;
L_0171:;
// 1879 ss = s
SS = S;
// 1880
// 1881 code atom(28) %IF quote # 0; !expend
if (QUOTE == 0) goto L_0172;
CODEATOM(28);
L_0172:;
// 1882 compile; ->more %IF atom1&error = 0
COMPILE();
if (ATOM1 & 32768 != 0) goto L_0173;
goto U_1008;
L_0173:;
// 1883 ->fail1
goto U_1009;
// 1884
// 1885 act(184):->fail4 %UNLESS type = integer
case_ACT_184:;
if (TYPE == 1) goto L_0174;
goto U_1012;
L_0174:;
// 1886 %IF subatom < 0 %THEN lit = tag(-subatom)_format %C
if (SUBATOM >= 0) goto L_0175;
LIT = TAG[-SUBATOM].FORMAT;
goto L_0176;
L_0175:;
LIT = LITPOOL[SUBATOM];
L_0176:;
// 1887+ %ELSE lit = lit pool(subatom)
// 1888 ->fail4 %IF lit # 0
if (LIT == 0) goto L_0177;
goto U_1012;
L_0177:;
// 1889 ->more
goto U_1008;
// 1890 act(185): !apply parameters
case_ACT_185:;
// 1891 s = 0
S = 0;
// 1892 %WHILE node # 0 %CYCLE
L_0178:;
if (NODE == 0) goto L_0179;
// 1893 z == ar(node)_link
Z = (short int *)/*?*/ &AR[NODE - 1].LINK;
// 1894 k = z; z = s; s = node; node = k
K = *Z;
*Z = S;
S = NODE;
NODE = K;
// 1895 %REPEAT
goto L_0178;
L_0179:;
// 1896 ss = s
SS = S;
// 1897
// 1898 atom1 = ar(s)_class; atom2 = 0
ATOM1 = AR[S - 1].CLASS;
ATOM2 = 0;
// 1899 atom1 = var %IF atom1 = 97 %OR atom1 = 98
if (ATOM1 == 97) goto L_017A;
if (ATOM1 != 98) goto L_017B;
L_017A:;
ATOM1 = 91;
L_017B:;
// 1900 arp == ar(nmax)
ARP = (struct ARFM *)/*?*/ &AR[NMAX - 1];
// 1901 x = arp_x
X = ARP->X;
// 1902 pos1 = arp_pos
POS1 = ARP->POS;
// 1903 pos2 = 0
POS2 = 0;
// 1904 app = 0
APP = 0;
// 1905 format = tag(x)_format
FORMAT = TAG[X].FORMAT;
// 1906 flags = tag(x)_flags
FLAGS = TAG[X].FLAGS;
// 1907 type = flags>>4&7
TYPE = (unsigned int)FLAGS >> 4 & 7;
// 1908 protection = flags&prot
PROTECTION = FLAGS & 256;
// 1909 protection = 0 %IF flags&aname # 0
if (FLAGS & 1024 == 0) goto L_017C;
PROTECTION = 0;
L_017C:;
// 1910
// 1911 %IF flags&subname # 0 %AND format # 0 %START
if (FLAGS & 2048 == 0) goto L_017D;
if (FORMAT == 0) goto L_017D;
// 1912 ->fail1 %if format selected = 0
if (FORMATSELECTED() != 0) goto L_017E;
goto U_1009;
L_017E:;
// 1913 %FINISH
L_017D:;
// 1914
// 1915 ->a6
goto U_1011;
// 1916
// 1917 act(187):protection = prot; ->more; !%SETPROT
case_ACT_187:;
PROTECTION = 256;
goto U_1008;
// 1918 act(186):->More %if protection&prot = 0
case_ACT_186:;
if (PROTECTION & 256 != 0) goto L_017F;
goto U_1008;
L_017F:;
// 1919 prot err = nmin
PROTERR = NMIN;
// 1920 ->A7
goto U_1019;
// 1921 act(191):k = protection; !%GUARD
case_ACT_191:;
K = PROTECTION;
// 1922 code atom(0)
CODEATOM(0);
// 1923 protection = k %IF atom flags&aname = 0
if (ATOMFLAGS & 1024 != 0) goto L_0180;
PROTECTION = K;
L_0180:;
// 1924 ->more
goto U_1008;
// 1925
// 1926 act(192):->fail1 %IF parsed machine code=0
case_ACT_192:;
if (PARSEDMACHINECODE() != 0) goto L_0181;
goto U_1009;
L_0181:;
// 1927 ->more
goto U_1008;
// 1928
// 1929 act(189):k = gapp; !%GAPP
case_ACT_189:;
K = GAPP();
// 1930 delete names(1)
DELETENAMES(1);
// 1931 tmax = tbase; tbase = gram (gmin); !restore tmax
TMAX = TBASE;
TBASE = GRAM[GMIN];
// 1932 local= tbase
LOCAL = TBASE;
// 1933 gmin = gmin+1
GMIN = GMIN + 1;
// 1934
// 1935 x = ar(ar(nmax)_class)_sub
X = AR[AR[NMAX - 1].CLASS - 1].SUB;
// 1936 tag(x)_app = k; !update app
TAG[X].APP = K;
// 1937 ->more
goto U_1008;
// 1938
// 1939 act(190):gmin = gmin-1; !%LOCAL
case_ACT_190:;
GMIN = GMIN - 1;
// 1940 abandon(2) %IF gmin <= gmax
if (GMIN > GMAX) goto L_0182;
ABANDON(2);
L_0182:;
// 1941 gram (gmin) = tbase; tbase = tmax
GRAM[GMIN] = TBASE;
TBASE = TMAX;
// 1942 local = tbase
LOCAL = TBASE;
// 1943 ->more
goto U_1008;
// 1944
// 1945 ! errors
// 1946
// 1947 fail4:k = error+10; ->failed; !*size
U_1012:;
K = 32768 + 10;
goto U_1013;
// 1948 fail3:k = error+7; ->failed; !*context
U_1018:;
K = 32768 + 7;
goto U_1013;
// 1949 fail2:k = error+5; pos2 = 0; ->failed; !*type
U_1017:;
K = 32768 + 5;
POS2 = 0;
goto U_1013;
// 1950 fail0:k = error+3; ->failed; !*too complex
U_100D:;
K = 32768 + 3;
goto U_1013;
// 1951 fail1:k = atom1; pos2 = 0
U_1009:;
K = ATOM1;
POS2 = 0;
// 1952
// 1953 failed:
U_1013:;
// 1954 %IF diag&32 # 0 %START
if (DIAG & 32 == 0) goto L_0183;
// 1955 printstring("Atom1 ="); write(atom1, 3)
_imp_PRINTSTRING(_imp_str_literal("Atom1 ="));
_imp_WRITE(ATOM1, 3);
// 1956 printstring(" Atom2 ="); write(atom2, 3)
_imp_PRINTSTRING(_imp_str_literal(" Atom2 ="));
_imp_WRITE(ATOM2, 3);
// 1957 printstring(" subatom ="); write(subatom, 3); newline
_imp_PRINTSTRING(_imp_str_literal(" subatom ="));
_imp_WRITE(SUBATOM, 3);
_imp_NEWLINE();
// 1958 printstring("Type ="); write(type, 1)
_imp_PRINTSTRING(_imp_str_literal("Type ="));
_imp_WRITE(TYPE, 1);
// 1959 printstring(" Ptype ="); write(ptype, 1); newline
_imp_PRINTSTRING(_imp_str_literal(" Ptype ="));
_imp_WRITE(PTYPE, 1);
_imp_NEWLINE();
// 1960 printstring("App ="); write(app, 1)
_imp_PRINTSTRING(_imp_str_literal("App ="));
_imp_WRITE(APP, 1);
// 1961 printstring(" Papp ="); write(papp, 1); newline
_imp_PRINTSTRING(_imp_str_literal(" Papp ="));
_imp_WRITE(PAPP, 1);
_imp_NEWLINE();
// 1962 printstring("Format ="); write(format, 1)
_imp_PRINTSTRING(_imp_str_literal("Format ="));
_imp_WRITE(FORMAT, 1);
// 1963 printstring(" Pformat ="); write(pformat, 1); newline
_imp_PRINTSTRING(_imp_str_literal(" Pformat ="));
_imp_WRITE(PFORMAT, 1);
_imp_NEWLINE();
// 1964 !IMP80 BUG??? %SIGNAL 13,15
// 1965 %STOP
_imp_stop(0);
// 1966 %FINISH
L_0183:;
// 1967
// 1968 quote = 0 %AND readsym %WHILE sym # nl %AND sym # ';'
L_0184:;
if (SYM == 10) goto L_0185;
if (SYM == 59) goto L_0185;
QUOTE = 0;
READSYM();
goto L_0184;
L_0185:;
// 1969 %IF k&error # 0 %START
if (K & 32768 == 0) goto L_0186;
// 1970 fault(k&255)
FAULT(K & 255);
// 1971 %FINISH %ELSE %START
goto L_0187;
L_0186:;
// 1972 %IF prot err = nmin %THEN fault(14) %ELSE fault(0)
if (PROTERR != NMIN) goto L_0188;
FAULT(14);
goto L_0189;
L_0188:;
FAULT(0);
L_0189:;
// 1973 %FINISH
L_0187:;
// 1974 gg = 0; ss = 0; symtype = 0
GG = 0;
SS = 0;
SYMTYPE = 0;
// 1975 %END; !of analyse
return;
case_ACT_dispatch:
if (ACT_index < 180 || ACT_index > 200)
_imp_signalf(6, 3, ACT_index, "->ACT(%d) out of bounds at %s line %d", ACT_index, ACT_file, ACT_line);
goto *ACT[ACT_index - 180];
case_ACT_missing:
_imp_signalf(8, 2, ACT_index, "switch jump to undefined label ACT(%d): at %s line %d", ACT_index, ACT_file,
ACT_line);
case_PACTION_dispatch:
if (PACTION_index < 0 || PACTION_index > 15)
_imp_signalf(6, 3, PACTION_index, "->PACTION(%d) out of bounds at %s line %d", PACTION_index, PACTION_file,
PACTION_line);
goto *PACTION[PACTION_index - 0];
case_PACTION_missing:
_imp_signalf(8, 2, PACTION_index, "switch jump to undefined label PACTION(%d): at %s line %d", PACTION_index,
PACTION_file, PACTION_line);
} /* end of ANALYSE */
// 1976
// 1977 %ROUTINE compile
void COMPILE(void) {
// 1978
// 1979 %CONSTINTEGER then = 4, else = 8, loop = 16
// 1980
// 1981 %SWITCH c(0:actions), litop(1:12)
int C_index;
int C_line;
char *C_file;
static const void *C[181] = {
&&case_C_0, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_27, &&case_C_28, &&case_C_29,
&&case_C_30, &&case_C_31, &&case_C_32, &&case_C_33, &&case_C_34, &&case_C_35,
&&case_C_36, &&case_C_37, &&case_C_38, &&case_C_39, &&case_C_missing, &&case_C_41,
&&case_C_42, &&case_C_43, &&case_C_44, &&case_C_45, &&case_C_46, &&case_C_47,
&&case_C_48, &&case_C_49, &&case_C_50, &&case_C_51, &&case_C_52, &&case_C_53,
&&case_C_missing, &&case_C_55, &&case_C_56, &&case_C_57, &&case_C_58, &&case_C_59,
&&case_C_60, &&case_C_missing, &&case_C_62, &&case_C_63, &&case_C_64, &&case_C_65,
&&case_C_missing, &&case_C_67, &&case_C_68, &&case_C_69, &&case_C_70, &&case_C_71,
&&case_C_72, &&case_C_missing, &&case_C_74, &&case_C_75, &&case_C_76, &&case_C_77,
&&case_C_78, &&case_C_79, &&case_C_80, &&case_C_81, &&case_C_82, &&case_C_83,
&&case_C_84, &&case_C_85, &&case_C_86, &&case_C_87, &&case_C_88, &&case_C_89,
&&case_C_90, &&case_C_91, &&case_C_92, &&case_C_93, &&case_C_missing, &&case_C_missing,
&&case_C_96, &&case_C_97, &&case_C_98, &&case_C_99, &&case_C_100, &&case_C_101,
&&case_C_102, &&case_C_103, &&case_C_104, &&case_C_105, &&case_C_106, &&case_C_107,
&&case_C_108, &&case_C_109, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_120, &&case_C_121, &&case_C_122, &&case_C_missing, &&case_C_124, &&case_C_125,
&&case_C_126, &&case_C_127, &&case_C_128, &&case_C_missing, &&case_C_130, &&case_C_131,
&&case_C_132, &&case_C_133, &&case_C_134, &&case_C_135, &&case_C_136, &&case_C_137,
&&case_C_138, &&case_C_139, &&case_C_140, &&case_C_141, &&case_C_142, &&case_C_143,
&&case_C_144, &&case_C_145, &&case_C_146, &&case_C_147, &&case_C_148, &&case_C_149,
&&case_C_missing, &&case_C_151, &&case_C_152, &&case_C_153, &&case_C_154, &&case_C_155,
&&case_C_156, &&case_C_157, &&case_C_158, &&case_C_159, &&case_C_160, &&case_C_161,
&&case_C_162, &&case_C_163, &&case_C_164, &&case_C_165, &&case_C_166, &&case_C_167,
&&case_C_168, &&case_C_missing, &&case_C_170, &&case_C_171, &&case_C_172, &&case_C_173,
&&case_C_174, &&case_C_175, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing};
int LITOP_index;
int LITOP_line;
char *LITOP_file;
static const void *LITOP[12] = {&&case_LITOP_1, &&case_LITOP_2, &&case_LITOP_3, &&case_LITOP_4,
&&case_LITOP_5, &&case_LITOP_6, &&case_LITOP_7, &&case_LITOP_8,
&&case_LITOP_9, &&case_LITOP_10, &&case_LITOP_11, &&case_LITOP_12};
// 1982
// 1983 %CONSTBYTEINTEGERARRAY operator(1:14) = %C
const unsigned char OPERATOR[14] = {91, 93, 88, 47, 38, 33, 37, 43, 45, 42, 81, 120, 46, 118};
// 1984+ '[', ']', 'X', '/', '&', '!', '%', '+',
// 1985+ '-', '*', 'Q', 'x', '.', 'v'
// 1986
// 1987 %CONSTBYTEINTEGERARRAY cc(0 : 7) = '#','=',')','<','(','>', 'k','t'
const unsigned char CC[8] = {35, 61, 41, 60, 40, 62, 107, 116};
// 1988
// 1989 %CONSTBYTEINTEGERARRAY anyform(0:15) = 1,0,1,1(4),1,0,1,1,0,1,1,1,1
const unsigned char ANYFORM[16] = {1, 0, 1, [3 ... 6] = 1, 1, 0, 1, 1, 0, 1, 1, 1, 1};
// 1990
// 1991 %CONSTSHORTINTEGERARRAY decmap(0:15) = %C
const short int DECMAP[16] = {1, 2, 4107, 4109, 5132, 5134, 3, 4, 4103, 4104, 4105, 4106, 6, 0, 0, 0};
// 1992+ 1, 2,
// 1993+ x'100B', x'100D', x'140C', x'140E',
// 1994+ 3, 4,
// 1995+ x'1007', x'1008', x'1009', x'100A',
// 1996+ 6, 0, 0, 0
// 1997 %OWNBYTEINTEGERARRAY cnest(0:15)
static unsigned char CNEST[16];
// 1998 %INTEGER lmode, clab, dupid
int LMODE;
int CLAB;
int DUPID;
// 1999 %INTEGER resln
int RESLN;
// 2000 %OWNINTEGER last def = 0
static int LASTDEF = 0;
// 2001 %OWNINTEGER lb, ub
static int LB;
static int UB;
// 2002 %INTEGER cp, ord
int CP;
int ORD;
// 2003 %INTEGER next, link, j, k, n, done
int NEXT;
int LINK;
int J;
int K;
int N;
int DONE;
// 2004 %INTEGER class
int CLASS;
// 2005 %INTEGER lit2, defs, decs, cident
int LIT2;
int DEFS;
int DECS;
int CIDENT;
// 2006 %INTEGER pending; %OWNINTEGERARRAY pstack(1:40)
int PENDING;
static int PSTACK[40];
// 2007 %OWNSTRING(8) name = ""
static _imp_string8 NAME = _imp_str_init("");
// 2008 %OWNINTEGER count = 0
static int COUNT = 0;
// 2009
// 2010 %ROUTINE def lab(%INTEGER l)
void DEFLAB(int L) {
// 2011 op(':', l)
OP(58, L);
// 2012 access = 1
ACCESS = 1;
// 2013 %END
return;
} /* end of DEFLAB */
// 2014
// 2015 %ROUTINE get next
void GETNEXT(void) {
// 2016 %RECORD(arfm)%NAME p
struct ARFM *P;
// 2017 gn: %IF next = 0 %START; !end of phrase
U_1011:;
if (NEXT != 0) goto L_018A;
// 2018 class = 0 %AND %RETURN %IF link = 0; !end of statement
if (LINK != 0) goto L_018B;
CLASS = 0;
return;
L_018B:;
// 2019 p == ar(link)
P = (struct ARFM *)/*?*/ &AR[LINK - 1];
// 2020 next = p_link
NEXT = P->LINK;
// 2021 link = p_sub
LINK = P->SUB;
// 2022 %FINISH
L_018A:;
// 2023 %CYCLE
L_018C:;
// 2024 p == ar(next)
P = (struct ARFM *)/*?*/ &AR[NEXT - 1];
// 2025 x = p_sub
X = P->SUB;
// 2026 class = p_class
CLASS = P->CLASS;
// 2027 %EXIT %IF class < actions; !an atom
if (CLASS >= 180) goto L_018D;
goto L_018E;
L_018D:;
// 2028 %IF x = 0 %START; !null phrase
if (X != 0) goto L_018F;
// 2029 next = p_link; ->gn
NEXT = P->LINK;
goto U_1011;
// 2030 %FINISH
L_018F:;
// 2031 %IF p_link # 0 %START; !follow a phrase
if (P->LINK == 0) goto L_0190;
// 2032 p_sub = link; link = next
P->SUB = LINK;
LINK = NEXT;
// 2033 %FINISH
L_0190:;
// 2034 next = x
NEXT = X;
// 2035 %REPEAT
goto L_018C;
L_018E:;
// 2036 next = p_link
NEXT = P->LINK;
// 2037 %IF diag&2 # 0 %START
if (DIAG & 2 == 0) goto L_0191;
// 2038 spaces(8-length(name)) %UNLESS name = ""
if (_imp_strcmp((_imp_string *)/*?*/ &NAME, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) == 0) goto L_0192;
_imp_SPACES(8 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &NAME));
L_0192:;
// 2039 name = text(class)
_imp_strncpy(/*?*/ &NAME, ({
__typeof__(_imp_string8) tmp; /*B*/
tmp = TEXT[CLASS];
(void *)&tmp;
}),
/*max:*/ 8);
// 2040 write(x, 2)
_imp_WRITE(X, 2);
// 2041 space
_imp_SPACE();
// 2042 printstring(name)
_imp_PRINTSTRING(
*({
__typeof__(_imp_string8) tmp = NAME /*q*/;
(_imp_string255 *)&tmp;
})
);
// 2043 space
_imp_SPACE();
// 2044 count = count-1
COUNT = COUNT - 1;
// 2045 %IF count <= 0 %START
if (COUNT > 0) goto L_0193;
// 2046 count = 5
COUNT = 5;
// 2047 name = ""
_imp_strncpy(/*?*/ &NAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 8);
// 2048 newline
_imp_NEWLINE();
// 2049 %FINISH
L_0193:;
// 2050 %FINISH
L_0191:;
// 2051 %END
return;
} /* end of GETNEXT */
// 2052
// 2053 %ROUTINE set subs(%INTEGER n)
void SETSUBS(int N) {
// 2054
// 2055 !update the app field in n array descriptors
// 2056
// 2057 %INTEGER p
int P;
// 2058 p = tmax
P = TMAX;
// 2059 %WHILE n > 0 %CYCLE
L_0194:;
if (N <= 0) goto L_0195;
// 2060 !IMP80 BUG??? %SIGNAL 15,15 %IF p < tbase
// 2061 %STOP %IF p < tbase
if (P >= TBASE) goto L_0196;
_imp_stop(0);
L_0196:;
// 2062 tag(p)_app = dimension
TAG[P].APP = DIMENSION;
// 2063 p = p-1; n = n-1
P = P - 1;
N = N - 1;
// 2064 %REPEAT
goto L_0194;
L_0195:;
// 2065 %END
return;
} /* end of SETSUBS */
// 2066
// 2067 %ROUTINE set bp
void SETBP(void) {
// 2068
// 2069 !define a constant bound pair from the last stacked constants
// 2070
// 2071 pending = pending-2
PENDING = PENDING - 2;
// 2072 lb = pstack(pending+1); ub = pstack(pending+2)
LB = PSTACK[PENDING + 1 - 1];
UB = PSTACK[PENDING + 2 - 1];
// 2073 %IF ub-lb+1 < 0 %START
if (UB - LB + 1 >= 0) goto L_0197;
// 2074 pos1 = 0; next = link; fault(11)
POS1 = 0;
NEXT = LINK;
FAULT(11);
// 2075 ub = lb
UB = LB;
// 2076 %FINISH
L_0197:;
// 2077 set const(lb); set const(ub)
SETCONST(LB);
SETCONST(UB);
// 2078 bp=bp+1 %AND buff(bp)='b' %UNLESS class = 146
if (CLASS == 146) goto L_0198;
BP = BP + 1;
BUFF[BP - 1] = 98;
L_0198:;
// 2079 %END
return;
} /* end of SETBP */
// 2080
// 2081 %ROUTINE compile end(%INTEGER type)
void COMPILEEND(int TYPE) {
// 2082
// 2083 ! type = 0:eof, 1:eop, 2:end
// 2084
// 2085 %IF access # 0 %START
if (ACCESS == 0) goto L_0199;
// 2086 open = 0
OPEN = 0;
// 2087 fault(19) %IF block form > proc; !can reach end
if (BLOCKFORM <= 7) goto L_019A;
FAULT(19);
L_019A:;
// 2088 %FINISH
L_0199:;
// 2089
// 2090 %WHILE dict(dmin) >= 0 %CYCLE; !finishes & repeats
L_019B:;
if (DICT[DMIN - 1] < 0) goto L_019C;
// 2091 fault(17+dict(dmin)&1)
FAULT(17 + (DICT[DMIN - 1] & 1));
// 2092 dmin = dmin+1
DMIN = DMIN + 1;
// 2093 %REPEAT
goto L_019B;
L_019C:;
// 2094 {delete names(0)}
// 2095 bp=bp+1 %AND buff(bp)=';'
BP = BP + 1;
BUFF[BP - 1] = 59;
// 2096 bp=bp+1 %AND buff(bp)=';' %IF type = 1; !endofprogram
if (TYPE != 1) goto L_019D;
BP = BP + 1;
BUFF[BP - 1] = 59;
L_019D:;
// 2097
// 2098 bflags = bflags!open; !show if it returns
*BFLAGS = *BFLAGS | OPEN;
// 2099
// 2100 def lab(0) %IF block tag # 0 %AND level # 1; !for jump around
if (BLOCKTAG == 0) goto L_019E;
if (LEVEL == 1) goto L_019E;
DEFLAB(0);
L_019E:;
// 2101 %IF type # 2 %START; !eop, eof
if (TYPE == 2) goto L_019F;
// 2102 fault(16) %IF level # type; !end missing
if (LEVEL == TYPE) goto L_01A0;
FAULT(16);
L_01A0:;
// 2103 %FINISH %ELSE %START
goto L_01A1;
L_019F:;
// 2104 %IF level = 0 %START
if (LEVEL != 0) goto L_01A2;
// 2105 fault(15); !spurious end
FAULT(15);
// 2106 %FINISH
L_01A2:;
// 2107 %FINISH
L_01A1:;
// 2108
// 2109 end mark = 11; !******Mouses specific******
ENDMARK = 11;
// 2110 %END
return;
} /* end of COMPILEEND */
// 2111
// 2112 %ROUTINE def(%INTEGER p)
void DEF(int P) {
// 2113
// 2114 !dump a descriptor
// 2115
// 2116 %INTEGER t, f, type
int T;
int F;
int TYPE;
// 2117 %RECORD(tagfm)%NAME v
struct TAGFM *V;
// 2118 flush buffer %if bp # 0
if (BP == 0) goto L_01A3;
FLUSHBUFFER();
L_01A3:;
// 2119 defs = defs+1
DEFS = DEFS + 1;
// 2120 v == tag(p)
V = (struct TAGFM *)/*?*/ &TAG[P];
// 2121 t = 0
T = 0;
// 2122 %UNLESS v_index < 0 %START; !no index for subnames
if (V->INDEX < 0) goto L_01A4;
// 2123 id = id+1 %AND v_index = id %IF v_index = 0
if (V->INDEX != 0) goto L_01A5;
ID = ID + 1;
V->INDEX = ID;
L_01A5:;
// 2124 last def = v_index
LASTDEF = V->INDEX;
// 2125 t = last def
T = LASTDEF;
// 2126 %FINISH
L_01A4:;
// 2127 op('$', t)
OP(36, T);
// 2128 print ident(p, 1); !output the name
PRINTIDENT(P, 1);
// 2129 t = v_flags
T = V->FLAGS;
// 2130 type = t
TYPE = T;
// 2131 type = type&(\(7<<4)) %IF type&(7<<4) >= 6<<4;!routine & pred
if (TYPE & 7 << 4 < 6 << 4) goto L_01A6;
TYPE = TYPE & ~(7 << 4);
L_01A6:;
// 2132 op(',', type&b'1111111'); !type & form
OP(44, TYPE & 127);
// 2133 f = v_format
F = V->FORMAT;
// 2134 f = tag(f)_index %IF t&x'70' = record<<4
if (T & 112 != 4 << 4) goto L_01A7;
F = TAG[F].INDEX;
L_01A7:;
// 2135 f = v_index %IF f < 0
if (F >= 0) goto L_01A8;
F = V->INDEX;
L_01A8:;
// 2136 op(',', f); !format
OP(44, F);
// 2137 f = otype+t>>4&b'1111000'
F = OTYPE + ((unsigned int)T >> 4 & 120);
// 2138 f = f!8 %IF class = 125; !add spec from %DUP
if (CLASS != 125) goto L_01A9;
F = F | 8;
L_01A9:;
// 2139 dim = v_app; !dimension
DIM = V->APP;
// 2140 dim = 0 %unless 0 < dim <= dim limit
{
// Double-sided test on DIM (Part I)
int tmp;
if (0 >= (tmp = DIM)) goto L_01AA;
// Double-sided test on DIM (Part II)
if (tmp <= 6) goto L_01AB;
}
L_01AA:;
DIM = 0;
L_01AB:;
// 2141 op(',', f+dim<<8); !otype & spec & prot
OP(44, F + (DIM << 8));
// 2142 defs = 0 %IF t¶meters = 0
if (T & 4096 != 0) goto L_01AC;
DEFS = 0;
L_01AC:;
// 2143 f = t&15
F = T & 15;
// 2144 %IF v_flags&spec # 0 %START
if (V->FLAGS & 128 == 0) goto L_01AD;
// 2145 v_flags = v_flags&(\spec) %UNLESS 3 <= f <= 10
{
// Double-sided test on F (Part I)
int tmp;
if (3 > (tmp = F)) goto L_01AE;
// Double-sided test on F (Part II)
if (tmp <= 10) goto L_01AF;
}
L_01AE:;
V->FLAGS = V->FLAGS & (~128);
L_01AF:;
// 2146 ocount = -1; !external specs have no constants
OCOUNT = -1;
// 2147 %FINISH
L_01AD:;
// 2148 dimension = 0
DIMENSION = 0;
// 2149 %if otype = 2 %and (f=2 %or f=12 %or f=14) %start
if (OTYPE != 2) goto L_01B0;
if (F == 2) goto L_01B1;
if (F == 12) goto L_01B1;
if (F != 14) goto L_01B0;
L_01B1:;
// 2150 v_flags = v_flags-1; !convert to simple
V->FLAGS = V->FLAGS - 1;
// 2151 %finish
L_01B0:;
// 2152 %END
return;
} /* end of DEF */
// 2153
// 2154 %ROUTINE def s lab(%INTEGER n)
void DEFSLAB(int N) {
// 2155
// 2156 !define a switch label, x defines the switch tag
// 2157
// 2158 %INTEGER p, l, b, w, bit
int P;
int L;
int B;
int W;
int BIT;
// 2159 p = tag(x)_format; !pointer to table
P = TAG[X].FORMAT;
// 2160 l = dict(p); !lower bound
L = DICT[P - 1];
// 2161 %IF l <= n <= dict(p+1) %START
{
// Double-sided test on N (Part I)
int tmp;
if (L > (tmp = N)) goto L_01B2;
// Double-sided test on N (Part II)
if (tmp > DICT[P + 1 - 1]) goto L_01B2;
}
// 2162 b = n-l
B = N - L;
// 2163 w = b>>4+p
W = ((unsigned int)B >> 4) + P;
// 2164 bit = 1<<(b&15)
BIT = 1 << (B & 15);
// 2165 %IF dict(w+2)&bit # 0 %START; !already set
if (DICT[W + 2 - 1] & BIT == 0) goto L_01B3;
// 2166 fault(4) %IF pending # 0
if (PENDING == 0) goto L_01B4;
FAULT(4);
L_01B4:;
// 2167 %RETURN
return;
// 2168 %FINISH
L_01B3:;
// 2169 dict(w+2) <- dict(w+2)!bit %IF pending # 0
if (PENDING == 0) goto L_01B5;
DICT[W + 2 - 1] = (short int)(DICT[W + 2 - 1] | BIT);
L_01B5:;
// 2170 set const(n)
SETCONST(N);
// 2171 op('_', tag(x)_index)
OP(95, TAG[X].INDEX);
// 2172 %FINISH %ELSE %START
goto L_01B6;
L_01B2:;
// 2173 fault(12)
FAULT(12);
// 2174 %FINISH
L_01B6:;
// 2175 access = 1
ACCESS = 1;
// 2176 %END
return;
} /* end of DEFSLAB */
// 2177
// 2178 %ROUTINE call
void CALL(void) {
// 2179 %RECORD(tagfm)%NAME T
struct TAGFM *T;
// 2180 t == tag(x)
T = (struct TAGFM *)/*?*/ &TAG[X];
// 2181 op('@', t_index)
OP(64, T->INDEX);
// 2182 access = 0 %IF t_flags&closed # 0; !never comes back
if (T->FLAGS & 16384 == 0) goto L_01B7;
ACCESS = 0;
L_01B7:;
// 2183 bp=bp+1 %AND buff(bp)='E' %IF t_app = 0; !no parameters
if (T->APP != 0) goto L_01B8;
BP = BP + 1;
BUFF[BP - 1] = 69;
L_01B8:;
// 2184 %END
return;
} /* end of CALL */
// 2185
// 2186 %ROUTINE pop def
void POPDEF(void) {
// 2187 set const(pstack(pending)); pending = pending-1
SETCONST(PSTACK[PENDING - 1]);
PENDING = PENDING - 1;
// 2188 %END
return;
} /* end of POPDEF */
// 2189
// 2190 %ROUTINE pop lit
void POPLIT(void) {
// 2191 %IF pending = 0 %THEN lit = 0 %ELSE %START
if (PENDING != 0) goto L_01B9;
LIT = 0;
goto L_01BA;
L_01B9:;
// 2192 lit = pstack(pending); pending = pending-1
LIT = PSTACK[PENDING - 1];
PENDING = PENDING - 1;
// 2193 %FINISH
L_01BA:;
// 2194 %END
return;
} /* end of POPLIT */
// 2195
// 2196
// 2197 %IF sstype < 0 %START; !executable statement
if (SSTYPE >= 0) goto L_01BB;
// 2198 %IF level = 0 %START; !outermost level
if (LEVEL != 0) goto L_01BC;
// 2199 fault(13); !*order
FAULT(13);
// 2200 %FINISH %ELSE %START
goto L_01BD;
L_01BC:;
// 2201 %IF access = 0 %START
if (ACCESS != 0) goto L_01BE;
// 2202 access = 1; fault(-1); !only a warning
ACCESS = 1;
FAULT(-1);
// 2203 %FINISH
L_01BE:;
// 2204 %FINISH
L_01BD:;
// 2205 %FINISH
L_01BB:;
// 2206
// 2207 %IF diag&2 # 0 %START
if (DIAG & 2 == 0) goto L_01BF;
// 2208 newline %IF sym # nl
if (SYM == 10) goto L_01C0;
_imp_NEWLINE();
L_01C0:;
// 2209 printstring("ss =")
_imp_PRINTSTRING(_imp_str_literal("ss ="));
// 2210 write(ss, 1)
_imp_WRITE(SS, 1);
// 2211 newline
_imp_NEWLINE();
// 2212 count = 5
COUNT = 5;
// 2213 name = ""
_imp_strncpy(/*?*/ &NAME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 8);
// 2214 %FINISH
L_01BF:;
// 2215
// 2216 next = ss
NEXT = SS;
// 2217 pending = 0; lmode = 0
PENDING = 0;
LMODE = 0;
// 2218 link = 0; decs = 0
LINK = 0;
DECS = 0;
// 2219 defs = 0; resln = 0; done = 0
DEFS = 0;
RESLN = 0;
DONE = 0;
// 2220 ord = level
ORD = LEVEL;
// 2221 ord = 1 %IF this >= 0; !recordformat declarations
if (THIS < 0) goto L_01C1;
ORD = 1;
L_01C1:;
// 2222 c(0):
case_C_0:;
// 2223 top: %IF next # link %START
U_101B:;
if (NEXT == LINK) goto L_01C3;
// 2224 get next; ->c(class)
GETNEXT();
C_line = __LINE__;
C_file = __FILE__;
C_index = CLASS;
goto case_C_dispatch;
// 2225 %FINISH
L_01C3:;
// 2226
// 2227 !all done, tidy up declarations and jumps
// 2228
// 2229 newline %IF diag&2 # 0 %AND count # 5
if (DIAG & 2 == 0) goto L_01C4;
if (COUNT == 5) goto L_01C4;
_imp_NEWLINE();
L_01C4:;
// 2230
// 2231 %IF lmode&(loop!then!else) # 0 %START; !pending labels and jumps
if (LMODE & (16 | 4 | 8) == 0) goto L_01C5;
// 2232 op('B', label-1) %IF lmode&loop # 0; !repeat
if (LMODE & 16 == 0) goto L_01C6;
OP(66, LABEL - 1);
L_01C6:;
// 2233 def lab(label) %IF lmode&then # 0; !entry from then
if (LMODE & 4 == 0) goto L_01C7;
DEFLAB(LABEL);
L_01C7:;
// 2234 def lab(label-1) %IF lmode&else # 0; !entry from else
if (LMODE & 8 == 0) goto L_01C8;
DEFLAB(LABEL - 1);
L_01C8:;
// 2235 %FINISH
L_01C5:;
// 2236
// 2237 %RETURN %IF decs = 0
if (DECS != 0) goto L_01C9;
return;
L_01C9:;
// 2238 atom1 = error %AND %RETURN %IF atom1 # 0; !%INTEGERROUTINE
if (ATOM1 == 0) goto L_01CA;
ATOM1 = 32768;
return;
L_01CA:;
// 2239 order = ord
ORDER = ORD;
// 2240 decl = decl&(\15)+decmap(decl&15); !construct declarator flags
DECL = (DECL & (~15)) + DECMAP[DECL & 15];
// 2241 atom1 = atoms(decl&15); !generate class
ATOM1 = ATOMS[DECL & 15];
// 2242 %IF otype # 0 %START; !own, const etc.
if (OTYPE == 0) goto L_01CB;
// 2243 atom1 = atom1+1 %IF atom1 # proc
if (ATOM1 == 7) goto L_01CC;
ATOM1 = ATOM1 + 1;
L_01CC:;
// 2244 %IF otype = 2 %START; !const
if (OTYPE != 2) goto L_01CD;
// 2245 n = decl&15
N = DECL & 15;
// 2246 %if n&1 # 0 %start
if (N & 1 == 0) goto L_01CE;
// 2247 decl = decl!prot
DECL = DECL | 256;
// 2248 decl = decl!const bit %IF decl&b'1111111' = iform
if (DECL & 127 != 17) goto L_01CF;
DECL = DECL | 8192;
L_01CF:;
// 2249 %finish
L_01CE:;
// 2250 %else
goto L_01D0;
L_01CD:;
// 2251 decl = decl!own bit
DECL = DECL | 512;
// 2252 %FINISH
L_01D0:;
// 2253 %FINISH
L_01CB:;
// 2254 sstype = 1 %IF sstype = 0 %AND atom1 = proc
if (SSTYPE != 0) goto L_01D1;
if (ATOM1 != 7) goto L_01D1;
SSTYPE = 1;
L_01D1:;
// 2255 atom1 = atom1+1 %IF decl&spec # 0; !onto spec variant
if (DECL & 128 == 0) goto L_01D2;
ATOM1 = ATOM1 + 1;
L_01D2:;
// 2256 ocount = 0 %AND cont = '+' %IF atom1 = 5; !own array
if (ATOM1 != 5) goto L_01D3;
OCOUNT = 0;
CONT = 43;
L_01D3:;
// 2257 %IF anyform(decl&15) = 0 %START; !check meaningful
if (ANYFORM[DECL & 15] != 0) goto L_01D4;
// 2258 %IF decl>>4&7 = record %START
if ((unsigned int)DECL >> 4 & 7 != 4) goto L_01D5;
// 2259 this = fdef %IF tag(fdef)_flags&spec # 0
if (TAG[FDEF].FLAGS & 128 == 0) goto L_01D6;
THIS = FDEF;
L_01D6:;
// 2260 atom1 = error+21 %IF fdef = this; !*context for format
if (FDEF != THIS) goto L_01D7;
ATOM1 = 32768 + 21;
L_01D7:;
// 2261 %FINISH
L_01D5:;
// 2262 atom1 = error+10 %IF fdef = 0; !*size
if (FDEF != 0) goto L_01D8;
ATOM1 = 32768 + 10;
L_01D8:;
// 2263 %FINISH
L_01D4:;
// 2264 %RETURN
return;
// 2265
// 2266 atop: access = 0; ->top
U_101C:;
ACCESS = 0;
goto U_101B;
// 2267
// 2268 ! declarators
// 2269
// 2270 c(88): !rtype
case_C_88:;
// 2271 c(28): decl = x&(\7); !stype
case_C_28:;
DECL = X & (~7);
// 2272 fdef = x&7; !precision
FDEF = X & 7;
// 2273 fdef = reals ln %IF x&b'1110001' = real<<4+1; !convert to long
if (X & 113 != (2 << 4) + 1) goto L_01D9;
FDEF = REALSLN;
L_01D9:;
// 2274 decs = 1; ->top
DECS = 1;
goto U_101B;
// 2275 c(34): !own
case_C_34:;
// 2276 c(35): otype = x; ord = 1; ->top; !external
case_C_35:;
OTYPE = X;
ORD = 1;
goto U_101B;
// 2277 c(152):decl = decl+x<<1; ->top; !xname
case_C_152:;
DECL = DECL + (X << 1);
goto U_101B;
// 2278 c(31): !proc
case_C_31:;
// 2279 c(32): spec mode = level+1; !fn/map
case_C_32:;
SPECMODE = LEVEL + 1;
// 2280 decl = decl!prot %IF x = 9; !function
if (X != 9) goto L_01DA;
DECL = DECL | 256;
L_01DA:;
// 2281 c(29): ord = 1; !array
case_C_29:;
ORD = 1;
// 2282 dim = 0
DIM = 0;
// 2283 c(30): decl = decl+x; !name
case_C_30:;
DECL = DECL + X;
// 2284 decs = 1
DECS = 1;
// 2285 ->top
goto U_101B;
// 2286 c(27): lit = 0; ! arrayd
case_C_27:;
LIT = 0;
// 2287 %IF pending # 0 %START
if (PENDING == 0) goto L_01DB;
// 2288 pop lit
POPLIT();
// 2289 %UNLESS 0<lit<=dim limit %START
{
// Double-sided test on LIT (Part I)
int tmp;
if (0 >= (tmp = LIT)) goto L_01DC;
// Double-sided test on LIT (Part II)
if (tmp <= 6) goto L_01DD;
}
L_01DC:;
// 2290 atom1 = error + 11; %RETURN
ATOM1 = 32768 + 11;
return;
// 2291 %FINISH
L_01DD:;
// 2292 %FINISH
L_01DB:;
// 2293 dim = lit
DIM = LIT;
// 2294 decl = decl + x; decs = 1
DECL = DECL + X;
DECS = 1;
// 2295 -> top
goto U_101B;
// 2296 c(37): x = x!subname; !record
case_C_37:;
X = X | 2048;
// 2297 c(36): lit = 0; !string
case_C_36:;
LIT = 0;
// 2298 %IF pending # 0 %START
if (PENDING == 0) goto L_01DE;
// 2299 pop lit
POPLIT();
// 2300 %UNLESS 0 < lit <= 255 %START; !max length wrong
{
// Double-sided test on LIT (Part I)
int tmp;
if (0 >= (tmp = LIT)) goto L_01DF;
// Double-sided test on LIT (Part II)
if (tmp <= 255) goto L_01E0;
}
L_01DF:;
// 2301 atom1 = error+10; %RETURN
ATOM1 = 32768 + 10;
return;
// 2302 %FINISH
L_01E0:;
// 2303 %FINISH
L_01DE:;
// 2304 fdef = lit; !format or length
FDEF = LIT;
// 2305 c(33): decl = x; !switch
case_C_33:;
DECL = X;
// 2306 decs = 1
DECS = 1;
// 2307 ->top
goto U_101B;
// 2308 c(39): decl = decl!spec; !spec
case_C_39:;
DECL = DECL | 128;
// 2309 ocount = -1; !no initialisation
OCOUNT = -1;
// 2310 spec mode = -1
SPECMODE = -1;
// 2311 ->top
goto U_101B;
// 2312 c(38): decl = 64+4; !recordformat (spec)
case_C_38:;
DECL = 64 + 4;
// 2313 order = 1
ORDER = 1;
// 2314 atom1 = x
ATOM1 = X;
// 2315 decl = decl!spec %if atom1 = 12; !formatspec
if (ATOM1 != 12) goto L_01E1;
DECL = DECL | 128;
L_01E1:;
// 2316 fdef = tmax+1; !format tag
FDEF = TMAX + 1;
// 2317 %return
return;
// 2318 c(175):id = id+1; tag(x)_index = id; %return; !FSID
case_C_175:;
ID = ID + 1;
TAG[X].INDEX = ID;
return;
// 2319 c(41): decs = 1; decl = x!spec!closed; ->top; !label
case_C_41:;
DECS = 1;
DECL = X | 128 | 16384;
goto U_101B;
// 2320 c(133):recid = 0; rbase = tmin-1; !fname
case_C_133:;
RECID = 0;
RBASE = TMIN - 1;
// 2321 this = x
THIS = X;
// 2322 fm base = fdef; format list = tmin
FMBASE = FDEF;
FORMATLIST = TMIN;
// 2323 def(this); ->top
DEF(THIS);
goto U_101B;
// 2324 c(148):fdef = 0 %AND ->top %IF next = 0; !reclb
case_C_148:;
if (NEXT != 0) goto L_01E2;
FDEF = 0;
goto U_101B;
L_01E2:;
// 2325 get next; !skip name
GETNEXT();
// 2326 fdef = x
FDEF = X;
// 2327 ->top
goto U_101B;
// 2328 c(127):bp=bp+1 %AND buff(bp)='}'; ->top; !%POUT
case_C_127:;
BP = BP + 1;
BUFF[BP - 1] = 125;
goto U_101B;
// 2329 c(126):bp=bp+1 %AND buff(bp)='{'; ->top; !%PIN
case_C_126:;
BP = BP + 1;
BUFF[BP - 1] = 123;
goto U_101B;
// 2330
// 2331 c(174):set bp; !rangerb
case_C_174:;
SETBP();
// 2332 c(171): !fmlb
case_C_171:;
// 2333 c(172): !fmrb
case_C_172:;
// 2334 c(173):bp=bp+1 %AND buff(bp)='~'; bp=bp+1 %AND buff(bp)=class-171+'A'; ->top; !fmor
case_C_173:;
BP = BP + 1;
BUFF[BP - 1] = 126;
BP = BP + 1;
BUFF[BP - 1] = CLASS - 171 + 65;
goto U_101B;
// 2335 c(168):rbase = -rbase; !orrb
case_C_168:;
RBASE = -RBASE;
// 2336 sstype = 0; spec mode = 0
SSTYPE = 0;
SPECMODE = 0;
// 2337
// 2338 c(147):search base = 0; !recrb
case_C_147:;
SEARCHBASE = 0;
// 2339 tag(this)_app = tmin
TAG[THIS].APP = TMIN;
// 2340 tag(this)_format = rbase
TAG[THIS].FORMAT = RBASE;
// 2341 ->top
goto U_101B;
// 2342
// 2343 c(45):bp=bp+1 %and buff(bp)='U' %IF x = 36; ->top; !sign
case_C_45:;
if (X != 36) goto L_01E3;
BP = BP + 1;
BUFF[BP - 1] = 85;
L_01E3:;
goto U_101B;
// 2344 c(46):bp=bp+1; buff(bp)='\'; ->top; !uop
case_C_46:;
BP = BP + 1;
BUFF[BP - 1] = 92;
goto U_101B;
// 2345 c(47): !mod
case_C_47:;
// 2346 c(48): !dot
case_C_48:;
// 2347 c(42): !op1
case_C_42:;
// 2348 c(43): !op2
case_C_43:;
// 2349 c(44):bp=bp+1; buff(bp)=operator(x); ->top; !op3
case_C_44:;
BP = BP + 1;
BUFF[BP - 1] = OPERATOR[X - 1];
goto U_101B;
// 2350
// 2351 !conditions & jumps
// 2352
// 2353 %ROUTINE push(%INTEGER x)
void PUSH(int X) {
// 2354 %IF cnest(cp)&2 # x %START
if (CNEST[CP] & 2 == X) goto L_01E4;
// 2355 cnest(cp) = cnest(cp)!1; x = x+4
CNEST[CP] = CNEST[CP] | 1;
X = X + 4;
// 2356 %FINISH
L_01E4:;
// 2357 clab = clab+1 %IF cnest(cp)&1 # 0
if (CNEST[CP] & 1 == 0) goto L_01E5;
CLAB = CLAB + 1;
L_01E5:;
// 2358 cnest(cp+1) = x; cp = cp+1
CNEST[CP + 1] = X;
CP = CP + 1;
// 2359 %END
return;
} /* end of PUSH */
// 2360
// 2361 %ROUTINE pop label(%INTEGER mode)
void POPLABEL(int MODE) {
// 2362 lmode = dict(dmin)
LMODE = DICT[DMIN - 1];
// 2363 %IF lmode < 0 %OR lmode&1 # mode %START
if (LMODE < 0) goto L_01E6;
if (LMODE & 1 == MODE) goto L_01E7;
L_01E6:;
// 2364 fault(mode+8)
FAULT(MODE + 8);
// 2365 %FINISH %ELSE %START
goto L_01E8;
L_01E7:;
// 2366 dmin = dmin+1; label = label-3
DMIN = DMIN + 1;
LABEL = LABEL - 3;
// 2367 %FINISH
L_01E8:;
// 2368 %END
return;
} /* end of POPLABEL */
// 2369
// 2370 c(56): !and
case_C_56:;
// 2371 c(57):push(x); ->top; !or
case_C_57:;
PUSH(X);
goto U_101B;
// 2372 c(58):cnest(cp) = cnest(cp)!!2; ->top; !not
case_C_58:;
CNEST[CP] = CNEST[CP] ^ 2;
goto U_101B;
// 2373
// 2374 c(138):x = 128+32+16+4; !csep: treat like %WHILE
case_C_138:;
X = 128 + 32 + 16 + 4;
// 2375 c(59): !while
case_C_59:;
// 2376 c(60):%IF class = 138 %THEN op('f', label-1) %C
case_C_60:;
if (CLASS != 138) goto L_01E9;
OP(102, LABEL - 1);
goto L_01EA;
L_01E9:;
DEFLAB(LABEL - 1);
L_01EA:;
// 2377+ %ELSE def lab(label-1); !until
// 2378 c(166): !runtil
case_C_166:;
// 2379 c(62):lmode = (lmode&(else!loop)) !(x>>3); !cword
case_C_62:;
LMODE = LMODE & (8 | 16) | (unsigned int)X >> 3;
// 2380 clab = label; cp = 1; cnest(1) = x&7
CLAB = LABEL;
CP = 1;
CNEST[1] = X & 7;
// 2381 ->top
goto U_101B;
// 2382 c(72):pop label(0); !repeat
case_C_72:;
POPLABEL(0);
// 2383 def lab(label+1) %IF lmode&32 # 0; ->atop
if (LMODE & 32 == 0) goto L_01EB;
DEFLAB(LABEL + 1);
L_01EB:;
goto U_101C;
// 2384 c(69):pop label(1); ->top; !finish
case_C_69:;
POPLABEL(1);
goto U_101B;
// 2385 c(163): !xelse
case_C_163:;
// 2386 c(70):pop label(1); !finish else ...
case_C_70:;
POPLABEL(1);
// 2387 fault(7) %IF lmode&3 = 3; !dangling else
if (LMODE & 3 != 3) goto L_01EC;
FAULT(7);
L_01EC:;
// 2388 c(68):lmode = (lmode&else)!3; !...else...
case_C_68:;
LMODE = LMODE & 8 | 3;
// 2389 %IF access # 0 %START
if (ACCESS == 0) goto L_01ED;
// 2390 op('F', label-1); lmode = else!3
OP(70, LABEL - 1);
LMODE = 8 | 3;
// 2391 %FINISH
L_01ED:;
// 2392 def lab(label)
DEFLAB(LABEL);
// 2393 ->top %IF next # 0
if (NEXT == 0) goto L_01EE;
goto U_101B;
L_01EE:;
// 2394
// 2395 c(120): !%MSTART
case_C_120:;
// 2396 c(67): !start
case_C_67:;
// 2397 c(71): !cycle
case_C_71:;
// 2398 stcy: def lab(label-1) %AND lmode = loop %IF lmode = 0;!cycle
U_101D:;
if (LMODE != 0) goto L_01EF;
DEFLAB(LABEL - 1);
LMODE = 16;
L_01EF:;
// 2399 dmin = dmin-1; abandon(3) %IF dmin <= dmax
DMIN = DMIN - 1;
if (DMIN > DMAX) goto L_01F0;
ABANDON(3);
L_01F0:;
// 2400 dict(dmin) = lmode
DICT[DMIN - 1] = LMODE;
// 2401 label = label+3
LABEL = LABEL + 3;
// 2402 %RETURN
return;
// 2403
// 2404 c(64):fault(13) %IF dict(dmin) >= 0 %OR inhibit # 0; !on event
case_C_64:;
if (DICT[DMIN - 1] >= 0) goto L_01F1;
if (INHIBIT == 0) goto L_01F2;
L_01F1:;
FAULT(13);
L_01F2:;
// 2405 inhibit = 1
INHIBIT = 1;
// 2406 n = 0
N = 0;
// 2407 n = x'FFFF' %IF pending = 0; !* = all events
if (PENDING != 0) goto L_01F3;
N = 65535;
L_01F3:;
// 2408 %WHILE pending > 0 %CYCLE
L_01F4:;
if (PENDING <= 0) goto L_01F5;
// 2409 pop lit; fault(10) %IF lit&(\15) # 0;!too big
POPLIT();
if (LIT & (~15) == 0) goto L_01F6;
FAULT(10);
L_01F6:;
// 2410 j = 1<<lit
J = 1 << LIT;
// 2411 dubious = 1 %IF n&j # 0
if (N & J == 0) goto L_01F7;
DUBIOUS = 1;
L_01F7:;
// 2412 n = n!j; !construct bit mask
N = N | J;
// 2413 %REPEAT
goto L_01F4;
L_01F5:;
// 2414 op('o', n); op(',', label)
OP(111, N);
OP(44, LABEL);
// 2415 lmode = then!1; ->stcy
LMODE = 4 | 1;
goto U_101D;
// 2416
// 2417
// 2418 c(104):op('J', tag(x)_index); !l
case_C_104:;
OP(74, TAG[X].INDEX);
// 2419 inhibit = 1; ->atop
INHIBIT = 1;
goto U_101C;
// 2420 c(149):stats = stats-1; !lab
case_C_149:;
STATS = STATS - 1;
// 2421 access = 1; inhibit = 1
ACCESS = 1;
INHIBIT = 1;
// 2422 op('L', tag(x)_index); ->top
OP(76, TAG[X].INDEX);
goto U_101B;
// 2423
// 2424 c(63):j = dmin; l = label-3; !exit, continue
case_C_63:;
J = DMIN;
L = LABEL - 3;
// 2425 %CYCLE
L_01F8:;
// 2426 fault(7) %AND ->top %IF dict(j) < 0
if (DICT[J - 1] >= 0) goto L_01F9;
FAULT(7);
goto U_101B;
L_01F9:;
// 2427 %EXIT %IF dict(j)&1 = 0
if (DICT[J - 1] & 1 != 0) goto L_01FA;
goto L_01FB;
L_01FA:;
// 2428 j = j+1; l = l-3
J = J + 1;
L = L - 3;
// 2429 %REPEAT
goto L_01F8;
L_01FB:;
// 2430 l = l+1 %IF x = 32; !continue
if (X != 32) goto L_01FC;
L = L + 1;
L_01FC:;
// 2431 op('F', l)
OP(70, L);
// 2432 dict(j) = dict(j)!x; !show given
DICT[J - 1] = DICT[J - 1] | X;
// 2433 ->atop
goto U_101C;
// 2434
// 2435 c(50):bp=bp+1 %AND buff(bp)='C'; ->cop; !acomp
case_C_50:;
BP = BP + 1;
BUFF[BP - 1] = 67;
goto U_101E;
// 2436
// 2437 c(49): bp = bp+1
case_C_49:;
BP = BP + 1;
// 2438 %IF next # 0 %START; !comparator
if (NEXT == 0) goto L_01FD;
// 2439 buff(bp)='"'; push(0); !double sided
BUFF[BP - 1] = 34;
PUSH(0);
// 2440 %FINISH %ELSE %START
goto L_01FE;
L_01FD:;
// 2441 buff(bp)='?'
BUFF[BP - 1] = 63;
// 2442 %FINISH
L_01FE:;
// 2443
// 2444 cop: x = x!!1 %IF cnest(cp)&2 # 0; !invert the condition
U_101E:;
if (CNEST[CP] & 2 == 0) goto L_01FF;
X = X ^ 1;
L_01FF:;
// 2445 j = cp; l = clab
J = CP;
L = CLAB;
// 2446 %WHILE cnest(j)&4 = 0 %CYCLE
L_0200:;
if (CNEST[J] & 4 != 0) goto L_0201;
// 2447 j = j-1; l = l-cnest(j)&1
J = J - 1;
L = L - (CNEST[J] & 1);
// 2448 %REPEAT
goto L_0200;
L_0201:;
// 2449 op(cc(x), l)
OP(CC[X], L);
// 2450 def lab(clab+1) %IF cnest(cp)&1 # 0
if (CNEST[CP] & 1 == 0) goto L_0202;
DEFLAB(CLAB + 1);
L_0202:;
// 2451 cp = cp-1
CP = CP - 1;
// 2452 clab = clab-cnest(cp)&1
CLAB = CLAB - (CNEST[CP] & 1);
// 2453 ->top
goto U_101B;
// 2454
// 2455 c(78): !fresult
case_C_78:;
// 2456 c(79): !mresult
case_C_79:;
// 2457 c(80): open = 0; !return, true, false
case_C_80:;
OPEN = 0;
// 2458 c(82): access = 0; !stop
case_C_82:;
ACCESS = 0;
// 2459 c(89): !addop
case_C_89:;
// 2460 c(81): bp=bp+1 %AND buff(bp)=x; ->top; !monitor
case_C_81:;
BP = BP + 1;
BUFF[BP - 1] = X;
goto U_101B;
// 2461
// 2462 c(65): pop lit; op('e', lit); ->atop; !signal
case_C_65:;
POPLIT();
OP(101, LIT);
goto U_101C;
// 2463
// 2464 c(51): bp=bp+1 %AND buff(bp)='S'; ->top; !eq
case_C_51:;
BP = BP + 1;
BUFF[BP - 1] = 83;
goto U_101B;
// 2465 c(53): bp=bp+1 %AND buff(bp)='j'; ->top; !jam transfer
case_C_53:;
BP = BP + 1;
BUFF[BP - 1] = 106;
goto U_101B;
// 2466 c(52): bp=bp+1 %AND buff(bp)='Z'; ->top; !eqeq
case_C_52:;
BP = BP + 1;
BUFF[BP - 1] = 90;
goto U_101B;
// 2467
// 2468 c(74):%IF level = 0 %START; !begin
case_C_74:;
if (LEVEL != 0) goto L_0203;
// 2469 %IF progmode <= 0 %THEN progmode = 1 %ELSE fault(7)
if (PROGMODE > 0) goto L_0204;
PROGMODE = 1;
goto L_0205;
L_0204:;
FAULT(7);
L_0205:;
// 2470 {Permit BEGIN after external defs}
// 2471 %FINISH
L_0203:;
// 2472 spec mode = level+1
SPECMODE = LEVEL + 1;
// 2473 block x = 0
BLOCKX = 0;
// 2474 bp=bp+1 %AND buff(bp)='H'; %RETURN
BP = BP + 1;
BUFF[BP - 1] = 72;
return;
// 2475 c(77):perm = 0; lines = 0; stats = 0; !endofperm
case_C_77:;
PERM = 0;
LINES = 0;
STATS = 0;
// 2476 close input
CLOSEINPUT();
// 2477 select input(source)
_imp_SELECTINPUT(1);
// 2478 list = list-1
LIST = LIST - 1;
// 2479 tbase = tmax; tstart = tmax
TBASE = TMAX;
TSTART = TMAX;
// 2480 %RETURN
return;
// 2481 c(76):%IF include # 0 %AND x = 0 %START; !end of ...
case_C_76:;
if (INCLUDE == 0) goto L_0206;
if (X != 0) goto L_0206;
// 2482 lines = include; sstype = 0; !include
LINES = INCLUDE;
SSTYPE = 0;
// 2483 close input
CLOSEINPUT();
// 2484 list = include list
LIST = INCLUDELIST;
// 2485 include level = 0
INCLUDELEVEL = 0;
// 2486 include = 0; select input(source); %RETURN
INCLUDE = 0;
_imp_SELECTINPUT(1);
return;
// 2487 %FINISH
L_0206:;
// 2488 ss = -1; !prog/file
SS = -1;
// 2489 c(75):compile end(x); %RETURN; !%END
case_C_75:;
COMPILEEND(X);
return;
// 2490
// 2491 c(85):%IF x=0 %THEN control=lit %ELSE %START; !control
case_C_85:;
if (X != 0) goto L_0207;
CONTROL = LIT;
goto L_0208;
L_0207:;
// 2492 diag = lit&x'3FFF' %IF lit>>14&3 = 1
if ((unsigned int)LIT >> 14 & 3 != 1) goto L_0209;
DIAG = LIT & 16383;
L_0209:;
// 2493 %FINISH
L_0208:;
// 2494 op('z'-x, lit)
OP(122 - X, LIT);
// 2495 ->top
goto U_101B;
// 2496 c(83):list = list+x-2; ->top; !%LIST/%ENDOFLIST
case_C_83:;
LIST = LIST + X - 2;
goto U_101B;
// 2497 c(84):reals ln = x; ->top; !%REALS long/normal
case_C_84:;
REALSLN = X;
goto U_101B;
// 2498 c(86):%IF include # 0 %START; !include "file"
case_C_86:;
if (INCLUDE == 0) goto L_020A;
// 2499 fault(7); %RETURN
FAULT(7);
return;
// 2500 %FINISH
L_020A:;
// 2501 get next; !sconst
GETNEXT();
// 2502 include file = string(x-x'4000'+stbase)
_imp_strncpy(/*?*/ &INCLUDEFILE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *_imp_STRING(X - 16384 + STBASE);
(void *)&tmp;
}),
/*max:*/ 63);
// 2503 %begin
{ /*%begin*/
// 2504 %on 9 %start; Abandon(9); %finish
if (!_imp_on_event(9)) goto L_020B;
ABANDON(9);
L_020B:;
// 2505 open input(3, include file)
OPENINPUT(3,
*({
__typeof__(_imp_string63) tmp = INCLUDEFILE /*q*/;
(_imp_string255 *)&tmp;
})
);
// 2506 %end
goto end_1000;
end_1000:;
}
// 2507 include = lines; lines = 0
INCLUDE = LINES;
LINES = 0;
// 2508 include list = list; include level = level
INCLUDELIST = LIST;
INCLUDELEVEL = LEVEL;
// 2509 select input(3)
_imp_SELECTINPUT(3);
// 2510 ->top
goto U_101B;
// 2511
// 2512 c(154):dimension = dimension+1; !dbsep
case_C_154:;
DIMENSION = DIMENSION + 1;
// 2513 fault(11) %IF dimension = dim limit+1
if (DIMENSION != 6 + 1) goto L_020C;
FAULT(11);
L_020C:;
// 2514 ->top
goto U_101B;
// 2515 c(145):set bp; ->top; !crb
case_C_145:;
SETBP();
goto U_101B;
// 2516 c(146):set bp; !rcrb
case_C_146:;
SETBP();
// 2517 c(142): !bplrb
case_C_142:;
// 2518 dimension = 1 %IF dimension = 0
if (DIMENSION != 0) goto L_020D;
DIMENSION = 1;
L_020D:;
// 2519 op('d', dimension); op(',', defs)
OP(100, DIMENSION);
OP(44, DEFS);
// 2520 %IF class # 146 %START
if (CLASS == 146) goto L_020E;
// 2521 set subs(defs)
SETSUBS(DEFS);
// 2522 fault(13) %IF dict(dmin) >= 0 %OR inhibit # 0 %OR level=0
if (DICT[DMIN - 1] >= 0) goto L_020F;
if (INHIBIT != 0) goto L_020F;
if (LEVEL != 0) goto L_0210;
L_020F:;
FAULT(13);
L_0210:;
// 2523 %FINISH
L_020E:;
// 2524 dimension = 0; defs = 0
DIMENSION = 0;
DEFS = 0;
// 2525 ->top
goto U_101B;
// 2526 c(128):id = dupid; ->top; !EDUP
case_C_128:;
ID = DUPID;
goto U_101B;
// 2527 c(130):block x = x
case_C_130:;
BLOCKX = X;
// 2528 op('F', 0) %IF decl&spec = 0 %AND level # 0; !jump round proc
if (DECL & 128 != 0) goto L_0211;
if (LEVEL == 0) goto L_0211;
OP(70, 0);
L_0211:;
// 2529 c(125):dupid = id; !%DUP
case_C_125:;
DUPID = ID;
// 2530 %return %if Level < 0 {spec about}
if (LEVEL >= 0) goto L_0212;
return;
L_0212:;
// 2531 c(90): def(x); ->top; !ident
case_C_90:;
DEF(X);
goto U_101B;
// 2532 c(131): !cident
case_C_131:;
// 2533 %IF tag(x)_flags&(b'1111111'+const bit) = iform+const bit %START
if (TAG[X].FLAGS & 127 + 8192 != 17 + 8192) goto L_0213;
// 2534 tag(x)_format = lit
TAG[X].FORMAT = LIT;
// 2535 %FINISH %ELSE %START
goto L_0214;
L_0213:;
// 2536 set const(lit) %IF pending # 0
if (PENDING == 0) goto L_0215;
SETCONST(LIT);
L_0215:;
// 2537 def(x)
DEF(X);
// 2538 op('A', 1)
OP(65, 1);
// 2539 %FINISH
L_0214:;
// 2540 cident = x
CIDENT = X;
// 2541 ->top
goto U_101B;
// 2542 c(124):dubious = 1 %IF tag(cident)_flags&prot # 0; !%DUBIOUS
case_C_124:;
if (TAG[CIDENT].FLAGS & 256 == 0) goto L_0216;
DUBIOUS = 1;
L_0216:;
// 2543 ->top
goto U_101B;
// 2544 c(97): !f
case_C_97:;
// 2545 c(98): !m
case_C_98:;
// 2546 c(99): !p
case_C_99:;
// 2547 c(96): call; ->top; !r
case_C_96:;
CALL();
goto U_101B;
// 2548
// 2549 c(165): !nlab
case_C_165:;
// 2550 c(100): !rp
case_C_100:;
// 2551 c(101): !fp
case_C_101:;
// 2552 c(102): !mp
case_C_102:;
// 2553 c(103): !pp
case_C_103:;
// 2554 c(91): !v
case_C_91:;
// 2555 c(92): !n
case_C_92:;
// 2556 c(106): !a
case_C_106:;
// 2557 c(107): !an
case_C_107:;
// 2558 c(108): !na
case_C_108:;
// 2559 c(109): !nan
case_C_109:;
// 2560 k = tag(x)_index
K = TAG[X].INDEX;
// 2561 %IF k < 0 %THEN op('n', -k) %ELSE op('@', k)
if (K >= 0) goto L_0217;
OP(110, -K);
goto L_0218;
L_0217:;
OP(64, K);
L_0218:;
// 2562 ->top
goto U_101B;
// 2563 c(121):set const(0); ->top; !special for zero
case_C_121:;
SETCONST(0);
goto U_101B;
// 2564 c(167):bp=bp+1; buff(bp)='G'; ->pstr; !aconst (alias)
case_C_167:;
BP = BP + 1;
BUFF[BP - 1] = 71;
goto U_101F;
// 2565 c(const): !const
case_C_93:;
// 2566 %IF x < 0 %START; !constinteger
if (X >= 0) goto L_0219;
// 2567 set const(tag(-x)_format); ->top
SETCONST(TAG[-X].FORMAT);
goto U_101B;
// 2568 %FINISH
L_0219:;
// 2569 %IF x&x'4000' # 0 %START; !strings
if (X & 16384 == 0) goto L_021A;
// 2570 bp=bp+1 %AND buff(bp)=''''
BP = BP + 1;
BUFF[BP - 1] = 39;
// 2571 pstr: x = x-x'4000'+stbase
U_101F:;
X = X - 16384 + STBASE;
// 2572 k = byteinteger(x)
K = *_imp_BYTEINTEGER(X);
// 2573 bp=bp+1 %AND buff(bp)=k
BP = BP + 1;
BUFF[BP - 1] = K;
// 2574 k = k+x
K = K + X;
// 2575 %CYCLE
L_021B:;
// 2576 ->top %IF x = k
if (X != K) goto L_021C;
goto U_101B;
L_021C:;
// 2577 x = x+1; bp=bp+1 %AND buff(bp)=byteinteger(x)
X = X + 1;
BP = BP + 1;
BUFF[BP - 1] = *_imp_BYTEINTEGER(X);
// 2578 %REPEAT
goto L_021B;
// 2579 %FINISH
L_021A:;
// 2580 %IF x&x'2000' # 0 %START; !real
if (X & 8192 == 0) goto L_021D;
// 2581 x = x-x'2000'+stbase
X = X - 8192 + STBASE;
// 2582 k = byteinteger(x)
K = *_imp_BYTEINTEGER(X);
// 2583 op('D', k); bp=bp+1 %AND buff(bp)=','
OP(68, K);
BP = BP + 1;
BUFF[BP - 1] = 44;
// 2584 k = k+x
K = K + X;
// 2585 %CYCLE
L_021E:;
// 2586 ->top %IF x = k
if (X != K) goto L_021F;
goto U_101B;
L_021F:;
// 2587 x = x+1; j = byteinteger(x)
X = X + 1;
J = *_imp_BYTEINTEGER(X);
// 2588 %IF j = '@' %START
if (J != 64) goto L_0220;
// 2589 op('@', litpool(byteinteger(x+1))); ->top
OP(64, LITPOOL[*_imp_BYTEINTEGER(X + 1)]);
goto U_101B;
// 2590 %FINISH
L_0220:;
// 2591 bp=bp+1 %AND buff(bp)=j
BP = BP + 1;
BUFF[BP - 1] = J;
// 2592 %REPEAT
goto L_021E;
// 2593 %FINISH
L_021D:;
// 2594 set const(lit pool(x))
SETCONST(LITPOOL[X]);
// 2595 ->top
goto U_101B;
// 2596
// 2597 c(137):bp=bp+1 %AND buff(bp)='i'; ->top; !asep
case_C_137:;
BP = BP + 1;
BUFF[BP - 1] = 105;
goto U_101B;
// 2598 c(141):bp=bp+1 %AND buff(bp)='a'; ->top; !arb
case_C_141:;
BP = BP + 1;
BUFF[BP - 1] = 97;
goto U_101B;
// 2599
// 2600 !own arrays
// 2601
// 2602 c(132):ocount = ub-lb+1
case_C_132:;
OCOUNT = UB - LB + 1;
// 2603 def(x); !oident
DEF(X);
// 2604 dimension = 1; set subs(1)
DIMENSION = 1;
SETSUBS(1);
// 2605 %IF next = 0 %START; !no initialisation
if (NEXT != 0) goto L_0221;
// 2606 op('A', ocount) %IF ocount > 0
if (OCOUNT <= 0) goto L_0222;
OP(65, OCOUNT);
L_0222:;
// 2607 ocount = -1
OCOUNT = -1;
// 2608 %FINISH %ELSE %START; !initialisation given
goto L_0223;
L_0221:;
// 2609 get next
GETNEXT();
// 2610 %FINISH
L_0223:;
// 2611 ->top
goto U_101B;
// 2612 c(162):lit = ocount; ->ins; !indef
case_C_162:;
LIT = OCOUNT;
goto U_1020;
// 2613 c(143):pop lit; !orb
case_C_143:;
POPLIT();
// 2614 ins: fault(10) %AND lit = 0 %IF lit < 0
U_1020:;
if (LIT >= 0) goto L_0224;
FAULT(10);
LIT = 0;
L_0224:;
// 2615 get next
GETNEXT();
// 2616 ->inst
goto U_1021;
// 2617 c(139): !osep (x=19)
case_C_139:;
// 2618 c(153):lit = 1
case_C_153:;
LIT = 1;
// 2619 inst: pop def %IF pending # 0; !ownt (x=0)
U_1021:;
if (PENDING == 0) goto L_0225;
POPDEF();
L_0225:;
// 2620 op('A', lit)
OP(65, LIT);
// 2621 ocount = ocount-lit
OCOUNT = OCOUNT - LIT;
// 2622 %IF ocount >= 0 %START
if (OCOUNT < 0) goto L_0226;
// 2623 ->top %IF x # 0; !more coming
if (X == 0) goto L_0227;
goto U_101B;
L_0227:;
// 2624 ocount = -1 %AND %RETURN %IF ocount = 0; !all done
if (OCOUNT != 0) goto L_0228;
OCOUNT = -1;
return;
L_0228:;
// 2625 %FINISH
L_0226:;
// 2626 fault(11); %RETURN
FAULT(11);
return;
// 2627
// 2628 c(swit):op('W', tag(x)_index); inhibit = 1; ->atop
case_C_105:;
OP(87, TAG[X].INDEX);
INHIBIT = 1;
goto U_101C;
// 2629 c(134):def(x); !swid
case_C_134:;
DEF(X);
// 2630 n = ub-lb+1
N = UB - LB + 1;
// 2631 n = (n+15)>>4; !slots needed (includes zero)
N = (unsigned int)N + 15 >> 4;
// 2632 j = dmax; dmax = dmax+n+2
J = DMAX;
DMAX = DMAX + N + 2;
// 2633 abandon(1) %IF dmax >= dmin
if (DMAX < DMIN) goto L_0229;
ABANDON(1);
L_0229:;
// 2634 tag(x)_format = j
TAG[X].FORMAT = J;
// 2635 dict(j) = lb; dict(j+1) = ub
DICT[J - 1] = LB;
DICT[J + 1 - 1] = UB;
// 2636 %CYCLE
L_022A:;
// 2637 n = n-1
N = N - 1;
// 2638 ->top %IF n < 0
if (N >= 0) goto L_022B;
goto U_101B;
L_022B:;
// 2639 j = j+1; dict(j+1) = 0
J = J + 1;
DICT[J + 1 - 1] = 0;
// 2640 %REPEAT
goto L_022A;
// 2641 c(151):stats = stats-1; !slab
case_C_151:;
STATS = STATS - 1;
// 2642 fault(7) %AND %RETURN %IF x < tbase
if (X >= TBASE) goto L_022C;
FAULT(7);
return;
L_022C:;
// 2643 %IF pending # 0 %START; !explicit label
if (PENDING == 0) goto L_022D;
// 2644 def s lab(pstack(1))
DEFSLAB(PSTACK[0]);
// 2645 %FINISH %ELSE %START
goto L_022E;
L_022D:;
// 2646 fault(4) %AND %RETURN %IF tag(x)_app # 0
if (TAG[X].APP == 0) goto L_022F;
FAULT(4);
return;
L_022F:;
// 2647 tag(x)_app = 1
TAG[X].APP = 1;
// 2648 n = tag(x)_format
N = TAG[X].FORMAT;
// 2649 %FOR j = dict(n), 1, dict(n+1) %CYCLE
// %for J = DICT[N - 1], 1, DICT[N + 1 - 1] %cycle
{
int _initial = DICT[N - 1], _final = DICT[N + 1 - 1];
if (invalid_for_loop(_initial, 1, _final))
_imp_signal(5, 1, 0, "Illegal cycle J = DICT[N - 1], 1, DICT[N + 1 - 1]");
J = _initial - (1);
L_0230:
if (J == _final) goto L_0231;
J += 1;
// 2650 def s lab(j)
DEFSLAB(J);
// 2651 flush buffer %IF bp >= 128
if (BP < 128) goto L_0233;
FLUSHBUFFER();
L_0233:;
// 2652 %REPEAT
goto L_0230;
}
L_0231:;
// 2653 %FINISH
L_022E:;
// 2654 inhibit = 1
INHIBIT = 1;
// 2655 %RETURN
return;
// 2656
// 2657 c(140):bp=bp+1 %AND buff(bp)='p'; ->top; !psep
case_C_140:;
BP = BP + 1;
BUFF[BP - 1] = 112;
goto U_101B;
// 2658 c(144):buff(bp+1)='p'; buff(bp+2)='E'; bp=bp+2; ->top; !prb
case_C_144:;
BUFF[BP + 1 - 1] = 112;
BUFF[BP + 2 - 1] = 69;
BP = BP + 2;
goto U_101B;
// 2659
// 2660 !constant expressions
// 2661
// 2662 c(155): !pconst
case_C_155:;
// 2663 %IF x < 0 %THEN lit = tag(-x)_format %c
if (X >= 0) goto L_0234;
LIT = TAG[-X].FORMAT;
goto L_0235;
L_0234:;
LIT = LITPOOL[X];
L_0235:;
// 2664+ %ELSE lit = lit pool(x)
// 2665 pending = pending+1; pstack(pending) = lit; ->top
PENDING = PENDING + 1;
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2666 c(156):lit = pstack(pending); lit = -lit %IF lit < 0
case_C_156:;
LIT = PSTACK[PENDING - 1];
if (LIT >= 0) goto L_0236;
LIT = -LIT;
L_0236:;
// 2667 pstack(pending) = lit; ->top; !cmod
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2668 c(157):lit = -pstack(pending); pstack(pending) = lit; ->top; !csign
case_C_157:;
LIT = -PSTACK[PENDING - 1];
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2669 c(158):lit = \pstack(pending); pstack(pending) = lit; ->top; !cuop
case_C_158:;
LIT = (~PSTACK[PENDING - 1]);
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2670 c(159): !cop1
case_C_159:;
// 2671 c(160): !cop2
case_C_160:;
// 2672 c(161):pending = pending-1; !cop3
case_C_161:;
PENDING = PENDING - 1;
// 2673 lit2 = pstack(pending+1); lit = pstack(pending)
LIT2 = PSTACK[PENDING + 1 - 1];
LIT = PSTACK[PENDING - 1];
// 2674 ->litop(x>>2)
LITOP_line = __LINE__;
LITOP_file = __FILE__;
LITOP_index = (unsigned int)X >> 2;
goto case_LITOP_dispatch;
// 2675 litop(10):lit = lit*lit2; ->setl
case_LITOP_10:;
LIT = LIT * LIT2;
goto U_1022;
// 2676 litop(12):
case_LITOP_12:;
// 2677 litop(3):n = 1; !lit = lit\\lit2
case_LITOP_3:;
N = 1;
// 2678 fault(10) %IF lit2 < 0
if (LIT2 >= 0) goto L_0237;
FAULT(10);
L_0237:;
// 2679 %WHILE lit2 > 0 %CYCLE
L_0238:;
if (LIT2 <= 0) goto L_0239;
// 2680 lit2 = lit2-1
LIT2 = LIT2 - 1;
// 2681 n = n*lit
N = N * LIT;
// 2682 %REPEAT
goto L_0238;
L_0239:;
// 2683 lit = n; ->setl
LIT = N;
goto U_1022;
// 2684 litop(1):lit = lit<<lit2; ->setl
case_LITOP_1:;
LIT = LIT << LIT2;
goto U_1022;
// 2685 litop(2):lit = lit>>lit2; ->setl
case_LITOP_2:;
LIT = (unsigned int)LIT >> LIT2;
goto U_1022;
// 2686 litop(5):lit = lit&lit2; ->setl
case_LITOP_5:;
LIT = LIT & LIT2;
goto U_1022;
// 2687 litop(11):
case_LITOP_11:;
// 2688 litop(4):%IF lit2 = 0 %THEN fault(10) %ELSE lit = lit//lit2
case_LITOP_4:;
if (LIT2 != 0) goto L_023A;
FAULT(10);
goto L_023B;
L_023A:;
LIT = ((long)LIT / (long)LIT2);
L_023B:;
// 2689 ->setl
goto U_1022;
// 2690 litop(8):lit = lit+lit2; ->setl
case_LITOP_8:;
LIT = LIT + LIT2;
goto U_1022;
// 2691 litop(9):lit = lit-lit2; ->setl
case_LITOP_9:;
LIT = LIT - LIT2;
goto U_1022;
// 2692 litop(6):lit = lit!lit2; ->setl
case_LITOP_6:;
LIT = LIT | LIT2;
goto U_1022;
// 2693 litop(7):lit = lit!!lit2
case_LITOP_7:;
LIT = LIT ^ LIT2;
// 2694
// 2695 setl: pstack(pending) = lit; ->top
U_1022:;
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2696
// 2697 c(170):Fault(4) %if IMPCOM_Option # ""
case_C_170:;
if (_imp_strcmp((_imp_string *)/*?*/ &IMPCOM.OPTION, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) == 0)
goto L_023C;
FAULT(4);
L_023C:;
// 2698 IMPCOM_Option = String(x-x'4000'+Stbase); !Option string
_imp_strncpy(/*?*/ &IMPCOM.OPTION, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *_imp_STRING(X - 16384 + STBASE);
(void *)&tmp;
}),
/*max:*/ 255);
// 2699 ->Top
goto U_101B;
// 2700
// 2701 !string resolution
// 2702
// 2703 c(135):resln = 2; ->top; !dotl
case_C_135:;
RESLN = 2;
goto U_101B;
// 2704 c(136):resln = resln+1; ->top; !dotr
case_C_136:;
RESLN = RESLN + 1;
goto U_101B;
// 2705 c(55): op('r', resln); resln = 0; ->top; !resop
case_C_55:;
OP(114, RESLN);
RESLN = 0;
goto U_101B;
// 2706 c(164):op('r', resln+4); resln = 0; !cresop
case_C_164:;
OP(114, RESLN + 4);
RESLN = 0;
// 2707 c(122):x = 6; ->cop; !%PRED
case_C_122:;
X = 6;
goto U_101E;
// 2708 c(87): set const(pstack(1)); !mass
case_C_87:;
SETCONST(PSTACK[0]);
// 2709 bp=bp+1 %AND buff(bp)='P'; ->top
BP = BP + 1;
BUFF[BP - 1] = 80;
goto U_101B;
// 2710 %END
case_C_dispatch:
if (C_index < 0 || C_index > 180)
_imp_signalf(6, 3, C_index, "->C(%d) out of bounds at %s line %d", C_index, C_file, C_line);
goto *C[C_index - 0];
case_C_missing:
_imp_signalf(8, 2, C_index, "switch jump to undefined label C(%d): at %s line %d", C_index, C_file, C_line);
case_LITOP_dispatch:
if (LITOP_index < 1 || LITOP_index > 12)
_imp_signalf(6, 3, LITOP_index, "->LITOP(%d) out of bounds at %s line %d", LITOP_index, LITOP_file, LITOP_line);
goto *LITOP[LITOP_index - 1];
} /* end of COMPILE */
// 2711
// 2712 %END; !of compile block
return;
} /* end of COMPILEBLOCK */
// 2713
// 2714 %ON 9 %START
if (!_imp_on_event(9)) goto L_023D;
// 2715 abandon(5)
ABANDON(5);
// 2716 %FINISH
L_023D:;
// 2717
// 2718 impcom_flags = 0
IMPCOM.FLAGS = 0;
// 2719 impcom_option = ""
_imp_strncpy(/*?*/ &IMPCOM.OPTION, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 255);
// 2720
// 2721 list = 15 %IF Impcom_Flags&x'1000' # 0
if (IMPCOM.FLAGS & 4096 == 0) goto L_023E;
LIST = 15;
L_023E:;
// 2722
// 2723 open output(2, "LISTING");
OPENOUTPUT(2, _imp_str_literal("LISTING"));
// 2724 open input(2, "prims.inc");
OPENINPUT(2, _imp_str_literal("prims.inc"));
// 2725 select input(2); selectoutput(listing)
_imp_SELECTINPUT(2);
_imp_SELECTOUTPUT(2);
// 2726 tag(max tag) = 0; !%BEGIN defn
TAG[800] = (struct TAGFM){0};
// 2727 tag(0) = 0; tag(0)_flags = 7; !%BEGIN tag!
TAG[0] = (struct TAGFM){0};
TAG[0].FLAGS = 7;
// 2728 Hash(x) = 0 %FOR x = 0, 1, max names
// %for X = 0, 1, 2047 %cycle
{
X = -1;
L_023F:
if (X == 2047) goto L_0240;
X += 1;
HASH[X] = 0;
goto L_023F;
}
L_0240:;
// 2729 printstring(" Edinburgh IMP77 Compiler - Version ")
_imp_PRINTSTRING(_imp_str_literal(" Edinburgh IMP77 Compiler - Version "));
// 2730 printstring(version); newlines(2)
_imp_PRINTSTRING(
*({
__typeof__(_imp_string4) tmp = VERSION /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINES(2);
// 2731 op('l', 0)
OP(108, 0);
// 2732 compile block(0, 0, max dict, 0, 0)
COMPILEBLOCK(0, 0, 6000, 0, 0);
// 2733 bp=bp+1 %AND buff(bp)=nl {for bouncing off}
BP = BP + 1;
BUFF[BP - 1] = 10;
// 2734 flush buffer
FLUSHBUFFER();
// 2735 Impcom_Statements = stats
IMPCOM.STATEMENTS = STATS;
// 2736 Impcom_Statements = -faulty %IF faulty # 0
if (FAULTY == 0) goto L_0242;
IMPCOM.STATEMENTS = -FAULTY;
L_0242:;
// 2737 %ENDOFPROGRAM
_imp_stop(0);
return 0;
end_0:;
}