#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 ! IMP77 compiler first pass
// 2
// 3 !###########################################################
// 4 ! This program is a Copyright work. #
// 5 ! #
// 6 ! Over the last 40+ years a long and distinguished list of #
// 7 ! institutions, individuals and other entities have made #
// 8 ! contributions to portions of this program and may have a #
// 9 ! reasonable claim over rights to certain parts of the #
// 10 ! program. #
// 11 ! #
// 12 ! This version is therefore provided for education and #
// 13 ! demonstration purposes only #
// 14 !###########################################################
// 15
// 16 %begin
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
// 17 %conststring(4) version = "8.4"
const _imp_string4 VERSION = _imp_str_init("8.4");
// 18
// 19 !configuration parameters
// 20 { minus one represents all bits set for an %integer }
// 21 { %integer could be 16,32,64 bits wide depending on the }
// 22 { processor being targeted }
// 23 { i.e 8086 (16 bits), 80386 (32 bits), i86_64 (64 bits) }
// 24 %constinteger minus one = -1;
// 25 ! Wee change needed to cross-compile the compiler when going from 16 bit to 32 bit world
// 26 ! %constinteger minus one = 16_7fff;
// 27
// 28 { now to set up various constants }
// 29 %constinteger max int = ((minus one)>>1)//10
// 30 %constinteger max dig = (minus one)>>1-maxint*10
// 31 %constinteger byte size = 8; !bits per byte
// 32 %constinteger max tag = 800; !max no. of tags
// 33 %constinteger max dict = 6000; !max extent of dictionary
// 34 %constinteger name bits = 11; !size of name table as a power of two
// 35 %constinteger max names = 1<<namebits-1;!table limit (a mask, eg 255)
// 36 %owninteger spare names = max names
static int SPARENAMES = 2047;
// 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 %constinteger ff = 12; !form feed
// 43 %constinteger marker = '^'; !marker for faults
// 44 %constinteger squote = '"'; !string quote
// 45 %constinteger cquote = ''''; !character quote
// 46
// 47 !streams
// 48 %constinteger report = 0, source = 1
// 49 %constinteger object = 1, listing = 2
// 50
// 51 !types
// 52 %constinteger integer = 1
// 53 %constinteger real = 2
// 54 %constinteger stringv = 3
// 55 %constinteger record = 4
// 56
// 57 !forms
// 58 %constinteger iform = integer<<4+1
// 59 %constinteger var = 91
// 60 %constinteger const = 93
// 61 %constinteger swit = 105
// 62 %constinteger comment = 22
// 63 %constinteger termin = 20
// 64 %constinteger lab = 3
// 65 %constinteger jump = 54
// 66 %constinteger recfm = 4
// 67 %constinteger proc = 7; !class for proc
// 68
// 69 !phrase entries
// 70 %constinteger escdec = 252
// 71 %constinteger escproc = 253
// 72 %constinteger escarray = 254
// 73 %constinteger escrec = 255
// 74
// 75 !%recordformat arfm(%shortinteger class,sub,link,ptype,papp,pformat,x,pos);!imp77:
// 76 %recordformat arfm(%integer class,sub,link,ptype,papp,pformat,x,pos)
struct ARFM {
union {
struct {
int CLASS;
int SUB;
int LINK;
int PTYPE;
int PAPP;
int PFORMAT;
int X;
int POS;
};
};
};
// 77
// 78 %recordformat tagfm(%integer app, format, %integer flags, index, text, link)
struct TAGFM {
union {
struct {
int APP;
int FORMAT;
int FLAGS;
int INDEX;
int TEXT;
int LINK;
};
};
};
// 79
// 80 !flags
// 81 ! *===.===.===.===.===.====.====.====.===.======.======*
// 82 ! ! u ! c ! c ! p ! s ! a ! o ! pr ! s ! type ! form !
// 83 ! ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 3 ! 4 !
// 84 ! *===^===^===^===^===^====^====^====^===^======^======*
// 85 ! u c c p s a o p s t f
// 86 ! s l o a u n w r p y o
// 87 ! e o n r b a n o e p r
// 88 ! d s s a n m t c e m
// 89 ! e t m a e
// 90 ! d s m
// 91 ! e
// 92 !
// 93 !
// 94
// 95 %constinteger used bit = 2_1000000000000000
// 96 %constinteger closed = 2_0100000000000000
// 97 %constinteger const bit = 2_0010000000000000
// 98 %constinteger parameters = 2_0001000000000000
// 99 %constinteger subname = 2_0000100000000000
// 100 %constinteger aname = 2_0000010000000000
// 101 %constinteger own bit = 2_0000001000000000
// 102 %constinteger prot = 2_0000000100000000
// 103 %constinteger spec = 2_0000000010000000
// 104
// 105 %constinteger trans bit = 16_4000
// 106 %constinteger error = 16_8000
// 107
// 108 %record(arfm)%array ar(1:rec size)
struct ARFM AR[520];
struct _imp_dv AR_dv = {AR, sizeof(struct ARFM) /*, dims, <bounds> */};
// 109
// 110 %owninteger class = 0; !class of atom wanted
static int CLASS = 0;
// 111 %owninteger x = 0; !usually last tag
static int X = 0;
// 112 %owninteger atom1 = 0; !atom class (major)
static int ATOM1 = 0;
// 113 %owninteger atom2 = 0; !atom class (minor)
static int ATOM2 = 0;
// 114 %owninteger subatom = 0; !extra info about atom
static int SUBATOM = 0;
// 115 %owninteger type = 0
static int TYPE = 0;
// 116 %owninteger app = 0
static int APP = 0;
// 117 %owninteger format = 0; !atom info
static int FORMAT = 0;
// 118 %integer hash value
int HASHVALUE;
// 119 %owninteger faulty = 0; !fault indicator
static int FAULTY = 0;
// 120 %owninteger fault rate = 0; !fault rate count
static int FAULTRATE = 0;
// 121 %owninteger lines = 0; !current line number
static int LINES = 0;
// 122 %owninteger text line = 0; !starting line for string const
static int TEXTLINE = 0;
// 123 %owninteger margin = 0; !statement start margin
static int MARGIN = 0;
// 124 %owninteger error margin = 0
static int ERRORMARGIN = 0;
// 125 %owninteger error sym = 0
static int ERRORSYM = 0;
// 126 %owninteger column = 0
static int COLUMN = 0;
// 127 %owninteger stats = 0; !statements compiled
static int STATS = 0;
// 128 %owninteger mon pos = 0; !flag for diagnose
static int MONPOS = 0;
// 129 %owninteger sym = nl; !current input symbol
static int SYM = 10;
// 130 %owninteger symtype = 0; !type of current symbol
static int SYMTYPE = 0;
// 131 %owninteger quote = 0; !>0 strings, <0 chars
static int QUOTE = 0;
// 132 %owninteger end mark = 0; !%end flag
static int ENDMARK = 0;
// 133 %owninteger cont = ' '
static int CONT = 32;
// 134 %owninteger csym = ' '; !listing continuation marker
static int CSYM = 32;
// 135 %owninteger decl = 0; !current declarator flags
static int DECL = 0;
// 136 %owninteger dim = 0; !arrayname dimension
static int DIM = 0;
// 137 %owninteger spec given = 0
static int SPECGIVEN = 0;
// 138
// 139 %owninteger escape class = 0; !when and where to escape
static int ESCAPECLASS = 0;
// 140 %owninteger protection = 0
static int PROTECTION = 0;
// 141 %owninteger atom flags = 0
static int ATOMFLAGS = 0;
// 142 %owninteger otype = 0; !current 'own' type
static int OTYPE = 0;
// 143 %owninteger reals ln = 1; ! =4 for %REALSLONG
static int REALSLN = 1;
// 144 %owninteger last1 = 0; !previous atom class
static int LAST1 = 0;
// 145 %owninteger gen type = 0
static int GENTYPE = 0;
// 146 %owninteger ptype = 0; !current phrase type
static int PTYPE = 0;
// 147 %owninteger papp = 0; !current phrase parameters
static int PAPP = 0;
// 148 %owninteger pformat = 0; !current phrase format
static int PFORMAT = 0;
// 149 %owninteger force = 0; !force next ptype
static int FORCE = 0;
// 150 %owninteger g = 0
static int G = 0;
// 151 %owninteger gg = 0
static int GG = 0;
// 152 %owninteger map gg = 0; !grammar entries
static int MAPGG = 0;
// 153 %owninteger fdef = 0; !current format definition
static int FDEF = 0;
// 154 %owninteger this = -1; !current recordformat tag
static int THIS = -1;
// 155 %owninteger nmin = 0; !analysis record atom pointer
static int NMIN = 0;
// 156 %owninteger nmax = 0; !analysis record phrase pointer
static int NMAX = 0;
// 157 %owninteger rbase = 0; !record format definition base
static int RBASE = 0;
// 158 %owninteger dmax = 1
static int DMAX = 1;
// 159 %owninteger tmin = max tag; !upper bound on tags
static int TMIN = 800;
// 160 %owninteger ss = 0; !source statement entry
static int SS = 0;
// 161 %string(63) include file
_imp_string63 INCLUDEFILE;
// 162 %owninteger include list = 0
static int INCLUDELIST = 0;
// 163 %owninteger include level= 0
static int INCLUDELEVEL = 0;
// 164 %owninteger include = 0; !=0 unused, #0 being used
static int INCLUDE = 0;
// 165 %owninteger perm = 1; !1 = compiling perm, 0 = program
static int PERM = 1;
// 166 %owninteger progmode = 0; !-1 = file, 1 = begin/eop
static int PROGMODE = 0;
// 167 %owninteger sstype = 0; !-1:exec stat
static int SSTYPE = 0;
// 168 ! 0: declaration
// 169 ! 1: block in
// 170 ! 2: block out
// 171 %owninteger spec mode = 0; !>=0: definition
static int SPECMODE = 0;
// 172 ! -1: proc spec
// 173 ! -2: recordformat
// 174 %owninteger ocount = -1; !own constants wanted
static int OCOUNT = -1;
// 175 %owninteger limit = 0; !lookup limit
static int LIMIT = 0;
// 176 %owninteger copy = 0; !duplicate name flag
static int COPY = 0;
// 177 %owninteger order = 0; !out of sequence flag
static int ORDER = 0;
// 178 %owninteger for warn = 0; !non-local flag
static int FORWARN = 0;
// 179 %owninteger dubious = 0; !flag for dubious statements
static int DUBIOUS = 0;
// 180 %owninteger dp = 1
static int DP = 1;
// 181 %owninteger pos1 = 0
static int POS1 = 0;
// 182 %owninteger pos2 = 0; !error position
static int POS2 = 0;
// 183 %owninteger pos = 0; !input line index
static int POS = 0;
// 184 %owninteger dimension = 0; !current array dimension
static int DIMENSION = 0;
// 185 %owninteger local = 0; !search limit for locals
static int LOCAL = 0;
// 186 %owninteger fm base = 0; !entry for format decls
static int FMBASE = 0;
// 187 %owninteger search base = 0; !entry for record_names
static int SEARCHBASE = 0;
// 188 %owninteger format list = 0; !size of current format list
static int FORMATLIST = 0;
// 189 %integer recid
int RECID;
// 190 %ownbyteintegerarray char(0:133) = ; !input line
static unsigned char CHAR[134] = {
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10};
struct _imp_dv CHAR_dv = {CHAR, sizeof(unsigned char) /*, dims, <bounds> */};
// 191+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 192+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 193+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 194+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 195+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 196+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 197+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 198+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 199+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 200+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 201+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 202+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 203+ 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
// 204+ 10, 10, 10, 10
// 205 %integerarray lit pool(0:lit max)
int LITPOOL[51];
struct _imp_dv LITPOOL_dv = {LITPOOL, sizeof(int) /*, dims, <bounds> */};
// 206 %owninteger lit = 0; !current literal (integer)
static int LIT = 0;
// 207 %owninteger lp = 0; !literals pointer
static int LP = 0;
// 208 %owninteger block x = 0; !block tag
static int BLOCKX = 0;
// 209 %owninteger list = 1; !<= to enable
static int LIST = 1;
// 210 %owninteger control = 0
static int CONTROL = 0;
// 211 %owninteger diag = 0; !diagnose flags
static int DIAG = 0;
// 212 %integerarray hash(0:max names)
int HASH[2048];
struct _imp_dv HASH_dv = {HASH, sizeof(int) /*, dims, <bounds> */};
// 213 %record(tagfm)%array tag(0:max tag)
struct TAGFM TAG[801];
struct _imp_dv TAG_dv = {TAG, sizeof(struct TAGFM) /*, dims, <bounds> */};
// 214 %integerarray dict(1:max dict)
int DICT[6000];
struct _imp_dv DICT_dv = {DICT, sizeof(int) /*, dims, <bounds> */};
// 215 %byteintegerarray buff(1:512)
unsigned char BUFF[512];
struct _imp_dv BUFF_dv = {BUFF, sizeof(unsigned char) /*, dims, <bounds> */};
// 216 %owninteger bp = 0
static int BP = 0;
// 217
// 218 { grammar related constants }
// 219 %constinteger max grammar = 1720
// 220 %owninteger gmin = max grammar ;! upper bound on grammar
static int GMIN = 1720;
// 221 %constinteger manifest = 120, figurative = 130
// 222 %constinteger actions = 180, phrasal = 200
// 223
// 224 %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};
struct _imp_dv AMAP_dv = {AMAP, sizeof(unsigned char) /*, dims, <bounds> */};
// 225+ 89, 91, 92, 104, 94, 93, 105, 100, 101, 102, 103, 106, 107, 108, 109, 89
// 226 ! ? v n l fm const swit rp fp mp pp a an na nan ?
// 227
// 228 %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};
struct _imp_dv ATOMS_dv = {ATOMS, sizeof(unsigned char) /*, dims, <bounds> */};
// 229+ 7, 7, 7, 4, 1, 4, 1, 89
// 230
// 231 !*** start of generated tables ***
// 232 ! %include "i77.tables.imp"
// 233 %endoflist
// 572 !%endoffile
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")};
struct _imp_dv TEXT_dv = {TEXT, sizeof(_imp_string) /*, dims, <bounds> */};
// 573 !*** end of generated tables ***
static int GMAX = 719;
// 574
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};
struct _imp_dv INITIAL_dv = {INITIAL, sizeof(short int) /*, dims, <bounds> */};
// 575 %routine flush buffer( %integer limit )
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};
struct _imp_dv ATOMIC_dv = {ATOMIC, sizeof(unsigned char) /*, dims, <bounds> */};
// 576 %integer j
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};
struct _imp_dv PHRASE_dv = {PHRASE, sizeof(short int) /*, dims, <bounds> */};
// 577 %if bp >= limit %start
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};
struct _imp_dv GRAM_dv = {GRAM, sizeof(short int) /*, dims, <bounds> */};
// 578 %if faulty = 0 %start
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};
struct _imp_dv GLINK_dv = {GLINK, sizeof(short int) /*, dims, <bounds> */};
// 579 selectoutput(object)
const short int KDICT[587] = {
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, 1600, 1636, 1704, 1792, 128, 1872, 2088, 2284, 2316, 128, 2356,
128, 128, 128, 2375, 2383, 2415, 2423, 2443, 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, 2451, 131, 2459, -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, -28735, -29239, 10063,
71, -30263, -31668, -32302, 16412, 20, 8389, 76, 16412, 36, 10063, 71, -32311, 16412,
21, 10830, 9157, 10565, 16412, 21, 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};
struct _imp_dv KDICT_dv = {KDICT, sizeof(short int) /*, dims, <bounds> */};
// 580 %for j = 1, 1, bp %cycle
void FLUSHBUFFER(int LIMIT) {
// 581 printsymbol(buff(j))
int J;
// 582 %repeat
if (BP < LIMIT) goto L_0001;
// 583 selectoutput(listing)
if (FAULTY != 0) goto L_0002;
// 584 %finish
_imp_SELECTOUTPUT(1);
// 585 bp = 0
// %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_0003:
if (J == _final) goto L_0004;
J += 1;
// 586 %finish
_imp_PRINTSYMBOL(BUFF[J - 1]);
// 587 %end
goto L_0003;
}
L_0004:;
// 588
_imp_SELECTOUTPUT(2);
// 589 %routine add char( %byteinteger ch )
L_0002:;
// 590 bp = bp + 1
BP = 0;
// 591 buff(bp) = ch
L_0001:;
// 592 %end
return;
} /* end of FLUSHBUFFER */
// 593
void ADDCHAR(unsigned char CH) {
// 594 %routine op(%integer code, param)
BP = BP + 1;
// 595 buff(bp+1) = code
BUFF[BP - 1] = CH;
// 596 buff(bp+2) = param>>8
return;
} /* end of ADDCHAR */
// 597 buff(bp+3) = param
void OP(int CODE, int PARAM) {
// 598 bp = bp+3
BUFF[BP + 1 - 1] = CODE;
// 599 %end
BUFF[BP + 2 - 1] = (unsigned int)PARAM >> 8;
// 600
BUFF[BP + 3 - 1] = PARAM;
// 601 %routine set const(%integer m)
BP = BP + 3;
// 602 buff(bp+1) = 'N'
return;
} /* end of OP */
// 603 buff(bp+5) = m; m = m>>8
void SETCONST(int M) {
// 604 buff(bp+4) = m; m = m>>8
BUFF[BP + 1 - 1] = 78;
// 605 buff(bp+3) = m; m = m>>8
BUFF[BP + 5 - 1] = M;
M = (unsigned int)M >> 8;
// 606 buff(bp+2) = m
BUFF[BP + 4 - 1] = M;
M = (unsigned int)M >> 8;
// 607 bp = bp+5
BUFF[BP + 3 - 1] = M;
M = (unsigned int)M >> 8;
// 608 %end
BUFF[BP + 2 - 1] = M;
// 609
BP = BP + 5;
// 610 %routine octal(%integer n)
return;
} /* end of SETCONST */
// 611 %integer m
void OCTAL(int N) {
// 612 m = n>>3
int M;
// 613 octal(m) %if m # 0
M = (unsigned int)N >> 3;
// 614 add char( n&7+'0' )
if (M == 0) goto L_0006;
OCTAL(M);
L_0006:;
// 615 %end
ADDCHAR((N & 7) + 48);
// 616
return;
} /* end of OCTAL */
// 617 %routine hexadecimal(%integer n)
void HEXADECIMAL(int N) {
// 618 %integer m
int M;
// 619 m = n>>4
M = (unsigned int)N >> 4;
// 620 hexadecimal(m) %if m # 0
if (M == 0) goto L_0007;
HEXADECIMAL(M);
L_0007:;
// 621 %if n&15 > 9 %then add char( n&15+'A' ) %else add char( n&15+'0' )
if (N & 15 <= 9) goto L_0008;
ADDCHAR((N & 15) + 65);
goto L_0009;
L_0008:;
ADDCHAR((N & 15) + 48);
L_0009:;
// 622 %end
return;
} /* end of HEXADECIMAL */
// 623
// 624 %routine print ident(%integer p, mode)
void PRINTIDENT(int P, int MODE) {
// 625
// 626 %routine putit(%integer ch)
void PUTIT(int CH) {
// 627 %if mode = 0 %then %start
if (MODE != 0) goto L_000A;
// 628 printsymbol(ch)
_imp_PRINTSYMBOL(CH);
// 629 %else
goto L_000B;
L_000A:;
// 630 add char( ch )
ADDCHAR(CH);
// 631 %finish
L_000B:;
// 632 %end
return;
} /* end of PUTIT */
// 633
// 634 %integer k, l
int K;
int L;
// 635 p = tag(p)_text
P = TAG[P].TEXT;
// 636 %if p = 0 %start
if (P != 0) goto L_000C;
// 637 putit('?')
PUTIT(63);
// 638 %return
return;
// 639 %finish
L_000C:;
// 640 p = p+1; ! advance to name string
P = P + 1;
// 641 k = dict(p)
K = DICT[P - 1];
// 642 l = k & 255; ! length
L = K & 255;
// 643 %while l > 0 %cycle
L_000D:;
if (L <= 0) goto L_000E;
// 644 putit(k>>8)
PUTIT((unsigned int)K >> 8);
// 645 l = l-1
L = L - 1;
// 646 p = p+1
P = P + 1;
// 647 k = dict(p)
K = DICT[P - 1];
// 648 %exit %if l = 0
if (L != 0) goto L_000F;
goto L_000E;
L_000F:;
// 649 putit(k&255)
PUTIT(K & 255);
// 650 l = l-1
L = L - 1;
// 651 %repeat
goto L_000D;
L_000E:;
// 652 %end
return;
} /* end of PRINTIDENT */
// 653
// 654 %routine abandon(%integer n)
void ABANDON(int N) {
// 655 %switch reason(0:9)
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};
// 656 %integer stream
int STREAM;
// 657 stream = listing
STREAM = 2;
// 658 %cycle
L_0010:;
// 659 newline %if sym # nl
if (SYM == 10) goto L_0011;
_imp_NEWLINE();
L_0011:;
// 660 printsymbol('*'); write(lines,4); space
_imp_PRINTSYMBOL(42);
_imp_WRITE(LINES, 4);
_imp_SPACE();
// 661 ->reason(n)
REASON_line = __LINE__;
REASON_file = __FILE__;
REASON_index = N;
goto case_REASON_dispatch;
// 662 reason(0): printstring("compiler error!"); ->more
case_REASON_0:;
_imp_PRINTSTRING(_imp_str_literal("compiler error!"));
goto U_1000;
// 663 reason(1): printstring("switch vector too large"); ->more
case_REASON_1:;
_imp_PRINTSTRING(_imp_str_literal("switch vector too large"));
goto U_1000;
// 664 reason(2): printstring("too many names"); ->more
case_REASON_2:;
_imp_PRINTSTRING(_imp_str_literal("too many names"));
goto U_1000;
// 665 reason(3): printstring("program too complex"); ->more
case_REASON_3:;
_imp_PRINTSTRING(_imp_str_literal("program too complex"));
goto U_1000;
// 666 reason(4): printstring("feature not implemented"); ->more
case_REASON_4:;
_imp_PRINTSTRING(_imp_str_literal("feature not implemented"));
goto U_1000;
// 667 reason(5): printstring("input ended: ")
case_REASON_5:;
_imp_PRINTSTRING(_imp_str_literal("input ended: "));
// 668 %if quote # 0 %start
if (QUOTE == 0) goto L_0013;
// 669 %if quote < 0 %then printsymbol(cquote) %else printsymbol(squote)
if (QUOTE >= 0) goto L_0014;
_imp_PRINTSYMBOL(39);
goto L_0015;
L_0014:;
_imp_PRINTSYMBOL(34);
L_0015:;
// 670 %else
goto L_0016;
L_0013:;
// 671 printstring("%endof")
_imp_PRINTSTRING(_imp_str_literal("%endof"));
// 672 %if progmode >= 0 %then printstring("program") %else printstring("file")
if (PROGMODE < 0) goto L_0017;
_imp_PRINTSTRING(_imp_str_literal("program"));
goto L_0018;
L_0017:;
_imp_PRINTSTRING(_imp_str_literal("file"));
L_0018:;
// 673 %finish
L_0016:;
// 674 printstring(" missing?"); ->more
_imp_PRINTSTRING(_imp_str_literal(" missing?"));
goto U_1000;
// 675 reason(6): printstring("too many faults!"); ->more
case_REASON_6:;
_imp_PRINTSTRING(_imp_str_literal("too many faults!"));
goto U_1000;
// 676 reason(7): printstring("string constant too long"); ->more
case_REASON_7:;
_imp_PRINTSTRING(_imp_str_literal("string constant too long"));
goto U_1000;
// 677 reason(8): printstring("dictionary full"); ->more
case_REASON_8:;
_imp_PRINTSTRING(_imp_str_literal("dictionary full"));
goto U_1000;
// 678 reason(9): printstring("Included file ".include file." does not exist")
case_REASON_9:;
_imp_PRINTSTRING(
/* clang-format off */
*({ __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; })
/* clang-format on */
);
// 679
// 680 more: newline
U_1000:;
_imp_NEWLINE();
// 681 printstring("*** compilation abandoned ***"); newline
_imp_PRINTSTRING(_imp_str_literal("*** compilation abandoned ***"));
_imp_NEWLINE();
// 682 %exit %if stream = report
if (STREAM != 0) goto L_0019;
goto L_001A;
L_0019:;
// 683 close output
_imp_CLOSEOUTPUT();
// 684 stream = report
STREAM = 0;
// 685 select output(report)
_imp_SELECTOUTPUT(0);
// 686 %repeat
goto L_0010;
L_001A:;
// 687 !%signal 15,15 %if diag&4096 # 0
// 688 %stop
_imp_stop(0);
// 689 %end
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 */
// 690
// 691 %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);
// 692
// 693 %integerfnspec gapp
// 694 %routinespec delete names(%integer quiet)
// 695 %routinespec analyse
// 696 %routinespec compile
// 697
// 698 %integer open; open = closed; !zero if can return from proc
int OPEN;
OPEN = 16384;
// 699 %integer dbase; dbase = dmax; !dictionary base
int DBASE;
DBASE = DMAX;
// 700 %integer tbase; tbase = tmax; !tag base
int TBASE;
TBASE = TMAX;
// 701 %integer tstart; tstart = tmax
int TSTART;
TSTART = TMAX;
// 702 %integer label; label = 4; !first internal label
int LABEL;
LABEL = 4;
// 703 %integer access; access = 1; !non-zero if accessible
int ACCESS;
ACCESS = 1;
// 704 %integer inhibit; inhibit = 0; !non-zero inhibits declaratons
int INHIBIT;
INHIBIT = 0;
// 705
// 706 %integername bflags; bflags == tag(block tag)_flags
int *BFLAGS;
BFLAGS = (int *)/*?*/ &TAG[BLOCKTAG].FLAGS;
// 707 %integer block type; block type = bflags>>4&7
int BLOCKTYPE;
BLOCKTYPE = (unsigned int)*BFLAGS >> 4 & 7;
// 708 %integer block form; block form = bflags&15
int BLOCKFORM;
BLOCKFORM = *BFLAGS & 15;
// 709 %integer block fm; block fm = tag(block tag)_format
int BLOCKFM;
BLOCKFM = TAG[BLOCKTAG].FORMAT;
// 710 %integer block otype; block otype = otype
int BLOCKOTYPE;
BLOCKOTYPE = OTYPE;
// 711 %integername block app; block app == tag(block tag)_app
int *BLOCKAPP;
BLOCKAPP = (int *)/*?*/ &TAG[BLOCKTAG].APP;
// 712
// 713 %integer l, new app
int L;
int NEWAPP;
// 714
// 715 %routine fault(%integer n)
void FAULT(int N) {
// 716 ! -5 : -1 - warnings
// 717 ! 1 : 22 - errors
// 718
// 719 %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};
// 720 %integer st
int ST;
// 721
// 722 %routine print ss
void PRINTSS(void) {
// 723 %integer s, p
int S;
int P;
// 724 %return %if pos = 0
if (POS != 0) goto L_001B;
return;
L_001B:;
// 725 space
_imp_SPACE();
// 726 p = 1
P = 1;
// 727 %cycle
L_001C:;
// 728 printsymbol(marker) %if p = pos1
if (P != POS1) goto L_001D;
_imp_PRINTSYMBOL(94);
L_001D:;
// 729 %exit %if p = pos
if (P != POS) goto L_001E;
goto L_001F;
L_001E:;
// 730 s = char(p); p = p+1
S = CHAR[P];
P = P + 1;
// 731 %exit %if s = nl %or (s='%' %and p = pos)
if (S == 10) goto L_0020;
if (S != 37) goto L_0021;
if (P != POS) goto L_0021;
L_0020:;
goto L_001F;
L_0021:;
// 732 %if s < ' ' %start; !beware of tabs
if (S >= 32) goto L_0022;
// 733 %if s = ff %then s = nl %else s = ' '
if (S != 12) goto L_0023;
S = 10;
goto L_0024;
L_0023:;
S = 32;
L_0024:;
// 734 %finish
L_0022:;
// 735 printsymbol(s)
_imp_PRINTSYMBOL(S);
// 736 %repeat
goto L_001C;
L_001F:;
// 737 pos = 0 %if list <= 0
if (LIST > 0) goto L_0025;
POS = 0;
L_0025:;
// 738 %end
return;
} /* end of PRINTSS */
// 739
// 740 pos1 = pos2 %if pos2 > pos1
if (POS2 <= POS1) goto L_0026;
POS1 = POS2;
L_0026:;
// 741 newline %if sym # nl
if (SYM == 10) goto L_0027;
_imp_NEWLINE();
L_0027:;
// 742 st = report
ST = 0;
// 743 st = listing %if n = -3; !don't report unused on the console
if (N != -3) goto L_0028;
ST = 2;
L_0028:;
// 744 %cycle
L_0029:;
// 745 select output(st)
_imp_SELECTOUTPUT(ST);
// 746 %if n < 0 %then printsymbol('?') %and pos1 = 0 %else printsymbol('*')
if (N >= 0) goto L_002A;
_imp_PRINTSYMBOL(63);
POS1 = 0;
goto L_002B;
L_002A:;
_imp_PRINTSYMBOL(42);
L_002B:;
// 747 %if st # report %start
if (ST == 0) goto L_002C;
// 748 %if list <= 0 %and pos1 # 0 %start
if (LIST > 0) goto L_002D;
if (POS1 == 0) goto L_002D;
// 749 spaces(pos1+margin); printstring(" ! ")
_imp_SPACES(POS1 + MARGIN);
_imp_PRINTSTRING(_imp_str_literal(" ! "));
// 750 %finish
L_002D:;
// 751 %finish %else %start
goto L_002E;
L_002C:;
// 752 printstring(include file) %if include # 0
if (INCLUDE == 0) goto L_002F;
_imp_PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string63) tmp = INCLUDEFILE/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
L_002F:;
// 753 write(lines, 4); printsymbol(csym); space
_imp_WRITE(LINES, 4);
_imp_PRINTSYMBOL(CSYM);
_imp_SPACE();
// 754 %finish
L_002E:;
// 755 ->fm(n) %if -5 <= n %and n <= 22
if (-5 > N) goto L_0030;
if (N > 22) goto L_0030;
FM_line = __LINE__;
FM_file = __FILE__;
FM_index = N;
goto case_FM_dispatch;
L_0030:;
// 756 printstring("fault"); write(n, 2); ->ps
_imp_PRINTSTRING(_imp_str_literal("fault"));
_imp_WRITE(N, 2);
goto U_1001;
// 757
// 758 fm(-5): printstring("Dubious statement"); dubious = 0; ->psd
case_FM_M5:;
_imp_PRINTSTRING(_imp_str_literal("Dubious statement"));
DUBIOUS = 0;
goto U_1002;
// 759 fm(-4): printstring("Non-local")
case_FM_M4:;
_imp_PRINTSTRING(_imp_str_literal("Non-local"));
// 760 pos1 = for warn; for warn = 0; ->ps
POS1 = FORWARN;
FORWARN = 0;
goto U_1001;
// 761 fm(-3): print ident(x, 0); printstring(" unused"); ->nps
case_FM_M3:;
PRINTIDENT(X, 0);
_imp_PRINTSTRING(_imp_str_literal(" unused"));
goto U_1003;
// 762 fm(-2): printstring("""}"""); ->miss
case_FM_M2:;
_imp_PRINTSTRING(_imp_str_literal("\"}\""));
goto U_1004;
// 763 fm(-1): printstring("access"); ->psd
case_FM_M1:;
_imp_PRINTSTRING(_imp_str_literal("access"));
goto U_1002;
// 764 fm(0): printstring("form"); ->ps
case_FM_0:;
_imp_PRINTSTRING(_imp_str_literal("form"));
goto U_1001;
// 765 fm(1): printstring("atom"); ->ps
case_FM_1:;
_imp_PRINTSTRING(_imp_str_literal("atom"));
goto U_1001;
// 766 fm(2): printstring("not declared"); ->ps
case_FM_2:;
_imp_PRINTSTRING(_imp_str_literal("not declared"));
goto U_1001;
// 767 fm(3): printstring("too complex"); ->ps
case_FM_3:;
_imp_PRINTSTRING(_imp_str_literal("too complex"));
goto U_1001;
// 768 fm(4): printstring("duplicate "); Print Ident(x, 0); ->ps
case_FM_4:;
_imp_PRINTSTRING(_imp_str_literal("duplicate "));
PRINTIDENT(X, 0);
goto U_1001;
// 769 fm(5): printstring("type"); ->ps
case_FM_5:;
_imp_PRINTSTRING(_imp_str_literal("type"));
goto U_1001;
// 770 fm(6): printstring("match"); ->psd
case_FM_6:;
_imp_PRINTSTRING(_imp_str_literal("match"));
goto U_1002;
// 771 fm(7): printstring("context"); ->psd
case_FM_7:;
_imp_PRINTSTRING(_imp_str_literal("context"));
goto U_1002;
// 772 fm(8): printstring("%cycle"); ->miss
case_FM_8:;
_imp_PRINTSTRING(_imp_str_literal("%cycle"));
goto U_1004;
// 773 fm(9): printstring("%start"); ->miss
case_FM_9:;
_imp_PRINTSTRING(_imp_str_literal("%start"));
goto U_1004;
// 774 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_0032;
_imp_WRITE(LIT, 1);
L_0032:;
goto U_1001;
// 775 fm(11): printstring("bounds")
case_FM_11:;
_imp_PRINTSTRING(_imp_str_literal("bounds"));
// 776 write(ocount, 1) %unless ocount < 0; ->ps
if (OCOUNT < 0) goto L_0033;
_imp_WRITE(OCOUNT, 1);
L_0033:;
goto U_1001;
// 777 fm(12): printstring("index"); ->ps
case_FM_12:;
_imp_PRINTSTRING(_imp_str_literal("index"));
goto U_1001;
// 778 fm(13): printstring("order"); ->psd
case_FM_13:;
_imp_PRINTSTRING(_imp_str_literal("order"));
goto U_1002;
// 779 fm(14): printstring("not a location"); ->ps
case_FM_14:;
_imp_PRINTSTRING(_imp_str_literal("not a location"));
goto U_1001;
// 780 fm(15): printstring("%begin"); ->miss
case_FM_15:;
_imp_PRINTSTRING(_imp_str_literal("%begin"));
goto U_1004;
// 781 fm(16): printstring("%end"); ->miss
case_FM_16:;
_imp_PRINTSTRING(_imp_str_literal("%end"));
goto U_1004;
// 782 fm(17): printstring("%repeat"); ->miss
case_FM_17:;
_imp_PRINTSTRING(_imp_str_literal("%repeat"));
goto U_1004;
// 783 fm(18): printstring("%finish"); ->miss
case_FM_18:;
_imp_PRINTSTRING(_imp_str_literal("%finish"));
goto U_1004;
// 784 fm(19): printstring("result"); ->miss
case_FM_19:;
_imp_PRINTSTRING(_imp_str_literal("result"));
goto U_1004;
// 785 fm(20): printsymbol('"'); print ident(x, 0); printsymbol('"'); ->miss
case_FM_20:;
_imp_PRINTSYMBOL(34);
PRINTIDENT(X, 0);
_imp_PRINTSYMBOL(34);
goto U_1004;
// 786 fm(21): printstring("context "); print ident(this, 0); ->ps
case_FM_21:;
_imp_PRINTSTRING(_imp_str_literal("context "));
PRINTIDENT(THIS, 0);
goto U_1001;
// 787 fm(22): printstring("format"); ->ps
case_FM_22:;
_imp_PRINTSTRING(_imp_str_literal("format"));
goto U_1001;
// 788
// 789 miss: printstring(" missing"); ->nps
U_1004:;
_imp_PRINTSTRING(_imp_str_literal(" missing"));
goto U_1003;
// 790 psd: pos1 = 0
U_1002:;
POS1 = 0;
// 791 ps: print ss
U_1001:;
PRINTSS();
// 792 nps: newline
U_1003:;
_imp_NEWLINE();
// 793 %exit %if st = listing
if (ST != 2) goto L_0034;
goto L_0035;
L_0034:;
// 794 st = listing
ST = 2;
// 795 %repeat
goto L_0029;
L_0035:;
// 796 %if n >= 0 %start
if (N < 0) goto L_0036;
// 797 !%signal 15,15 %if diag&4096 # 0
// 798 %if n # 13 %start; !order is fairly safe
if (N == 13) goto L_0037;
// 799 ocount = -1
OCOUNT = -1;
// 800 gg = 0
GG = 0;
// 801 copy = 0; quote = 0
COPY = 0;
QUOTE = 0;
// 802 search base = 0; escape class = 0
SEARCHBASE = 0;
ESCAPECLASS = 0;
// 803 gg = 0
GG = 0;
// 804 %finish
L_0037:;
// 805 faulty = faulty+1
FAULTY = FAULTY + 1;
// 806
// 807 !check that there haven't been too many faults
// 808
// 809 fault rate = fault rate+3; abandon(6) %if fault rate > 30
FAULTRATE = FAULTRATE + 3;
if (FAULTRATE <= 30) goto L_0038;
ABANDON(6);
L_0038:;
// 810 fault rate = 3 %if fault rate <= 0
if (FAULTRATE > 0) goto L_0039;
FAULTRATE = 3;
L_0039:;
// 811 %finish
L_0036:;
// 812 tbase = tstart
TBASE = TSTART;
// 813 %if list <= 0 %and sym # nl %start
if (LIST > 0) goto L_003A;
if (SYM == 10) goto L_003A;
// 814 error margin = column
ERRORMARGIN = COLUMN;
// 815 error sym = sym; sym = nl
ERRORSYM = SYM;
SYM = 10;
// 816 %finish
L_003A:;
// 817 %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 */
// 818
// 819 dmin = dmin-1; dict(dmin) = -1; !end marker for starts & cycles
DMIN = DMIN - 1;
DICT[DMIN - 1] = -1;
// 820 abandon(2) %if dmax = dmin
if (DMAX != DMIN) goto L_003B;
ABANDON(2);
L_003B:;
// 821
// 822 %if list > 0 %and level > 0 %start
if (LIST <= 0) goto L_003C;
if (LEVEL <= 0) goto L_003C;
// 823 write(lines, 5); spaces(level*3-1)
_imp_WRITE(LINES, 5);
_imp_SPACES(LEVEL * 3 - 1);
// 824 %if block tag = 0 %start
if (BLOCKTAG != 0) goto L_003D;
// 825 printstring("Begin")
_imp_PRINTSTRING(_imp_str_literal("Begin"));
// 826 %finish %else %start
goto L_003E;
L_003D:;
// 827 printstring("Procedure "); print ident(block tag, 0)
_imp_PRINTSTRING(_imp_str_literal("Procedure "));
PRINTIDENT(BLOCKTAG, 0);
// 828 %finish
L_003E:;
// 829 newline
_imp_NEWLINE();
// 830 %finish
L_003C:;
// 831
// 832 !deal with procedure definition (parameters)
// 833 %if block tag # 0 %start; !proc
if (BLOCKTAG == 0) goto L_003F;
// 834 analyse; compile %if ss # 0
ANALYSE();
if (SS == 0) goto L_0040;
COMPILE();
L_0040:;
// 835
// 836 %if block otype # 0 %start; !external-ish
if (BLOCKOTYPE == 0) goto L_0041;
// 837 %if bflags&spec = 0 %start; !definition
if (*BFLAGS & 128 != 0) goto L_0042;
// 838 %if progmode <= 0 %and level = 1 %then progmode = -1 %else fault(7)
if (PROGMODE > 0) goto L_0043;
if (LEVEL != 1) goto L_0043;
PROGMODE = -1;
goto L_0044;
L_0043:;
FAULT(7);
L_0044:;
// 839 %finish
L_0042:;
// 840 %finish
L_0041:;
// 841
// 842 new app = gapp; !generate app grammar
NEWAPP = GAPP();
// 843 %if spec given # 0 %start; !definition after spec
if (SPECGIVEN == 0) goto L_0045;
// 844 fault(6) %if new app # block app; !different from spec
if (NEWAPP == *BLOCKAPP) goto L_0046;
FAULT(6);
L_0046:;
// 845 %finish
L_0045:;
// 846 block app = new app; !use the latest
*BLOCKAPP = NEWAPP;
// 847
// 848 %if level < 0 %start; !not procedure definition
if (LEVEL >= 0) goto L_0047;
// 849 delete names(0)
DELETENAMES(0);
// 850 %return
return;
// 851 %finish
L_0047:;
// 852 %finish %else %start
goto L_0048;
L_003F:;
// 853 open = 0; !can return from a block?
OPEN = 0;
// 854 %finish
L_0048:;
// 855
// 856 %cycle
L_0049:;
// 857 analyse
ANALYSE();
// 858 %if ss # 0 %start
if (SS == 0) goto L_004A;
// 859 compile
COMPILE();
// 860 fault(-5) %if dubious # 0
if (DUBIOUS == 0) goto L_004B;
FAULT(-5);
L_004B:;
// 861 flush buffer( 128 ) ;! flush if bp >= 128
FLUSHBUFFER(128);
// 862 %if sstype > 0 %start; !block in or out
if (SSTYPE <= 0) goto L_004C;
// 863 %exit %if sstype = 2; !out
if (SSTYPE != 2) goto L_004D;
goto L_004E;
L_004D:;
// 864 compile block(spec mode, block x, dmin, tmax, id)
COMPILEBLOCK(SPECMODE, BLOCKX, DMIN, TMAX, ID);
// 865 %exit %if ss < 0; !endofprogram
if (SS >= 0) goto L_004F;
goto L_004E;
L_004F:;
// 866 %finish
L_004C:;
// 867 %finish
L_004A:;
// 868 %repeat
goto L_0049;
L_004E:;
// 869 %if list > 0 %and level > 0 %start
if (LIST <= 0) goto L_0050;
if (LEVEL <= 0) goto L_0050;
// 870 write(lines, 5); spaces(level*3-1)
_imp_WRITE(LINES, 5);
_imp_SPACES(LEVEL * 3 - 1);
// 871 printstring("End")
_imp_PRINTSTRING(_imp_str_literal("End"));
// 872 newline
_imp_NEWLINE();
// 873 %finish
L_0050:;
// 874 delete names(0)
DELETENAMES(0);
// 875 %return
return;
// 876
// 877 ! generate app grammar (backwards)
// 878 %integerfn gapp
int GAPP(void) {
auto void SETCELL(int G, int TT);
auto void CLASS(struct TAGFM * V);
// 879 %constinteger comma = 140; !psep
// 880 %routinespec set cell(%integer g, tt)
// 881 %routinespec class(%record(tagfm)%name v)
// 882 %record(tagfm)%name v
struct TAGFM *V;
// 883 %integer p, link, tp, c, ap, t
int P;
int LINK;
int TP;
int C;
int AP;
int T;
// 884
// 885 %result = 0 %if tmax = local; !no app needed
if (TMAX != LOCAL) goto L_0051;
return 0;
L_0051:;
// 886
// 887 p = gmax1; link = 0; t = tmax
P = 719;
LINK = 0;
T = TMAX;
// 888
// 889 %cycle
L_0052:;
// 890 v == tag(t); t = t-1
V = (struct TAGFM *)/*?*/ &TAG[T];
T = T - 1;
// 891 class(v); ! deduce class from tag
CLASS(V);
// 892 %if c < 0 %start; ! insert %PARAM
if (C >= 0) goto L_0053;
// 893 c = -c
C = -C;
// 894 set cell(196, tp)
SETCELL(196, TP);
// 895 tp = -1
TP = -1;
// 896 %finish
L_0053:;
// 897 set cell(c, tp)
SETCELL(C, TP);
// 898 %exit %if t = local; ! end of parameters
if (T != LOCAL) goto L_0054;
goto L_0055;
L_0054:;
// 899 set cell(comma, -1); ! add the separating comma
SETCELL(140, -1);
// 900 %repeat
goto L_0052;
L_0055:;
// 901 abandon(3) %if gmax > gmin
if (GMAX <= GMIN) goto L_0056;
ABANDON(3);
L_0056:;
// 902
// 903 %result = link
return LINK;
// 904
// 905 %routine set cell(%integer g, tt)
void SETCELL(int G, int TT) {
// 906 ! add the cell to the grammar, combining common tails
// 907 %while p # gmax %cycle
L_0057:;
if (P == GMAX) goto L_0058;
// 908 p = p+1
P = P + 1;
// 909 %if glink(p) = link %and gram(p) = g %start
if (GLINK[P] != LINK) goto L_0059;
if (GRAM[P] != G) goto L_0059;
// 910 %if tt < 0 %or (gram(p+1) = tt %and glink(p+1)=ap) %start
if (TT < 0) goto L_0005;
if (GRAM[P + 1] != TT) goto L_005A;
if (GLINK[P + 1] != AP) goto L_005A;
L_0005:;
// 911 link = p; ! already there
LINK = P;
// 912 %return
return;
// 913 %finish
L_005A:;
// 914 %finish
L_0059:;
// 915 %repeat
goto L_0057;
L_0058:;
// 916
// 917 !add a new cell
// 918 gmax = gmax+1
GMAX = GMAX + 1;
// 919 gram(gmax) = g
GRAM[GMAX] = G;
// 920 glink(gmax) = link
GLINK[GMAX] = LINK;
// 921 link = gmax
LINK = GMAX;
// 922
// 923 %if tt >= 0 %start; ! set type cell
if (TT < 0) goto L_005B;
// 924 gmax = gmax+1
GMAX = GMAX + 1;
// 925 gram(gmax) = tt
GRAM[GMAX] = TT;
// 926 glink(gmax) = ap
GLINK[GMAX] = AP;
// 927 %finish
L_005B:;
// 928 p = gmax
P = GMAX;
// 929
// 930 %end
return;
} /* end of SETCELL */
// 931
// 932 %routine class(%record(tagfm)%name v)
void CLASS(struct TAGFM * V) {
// 933 %constinteger err = 89
// 934 %constinteger rtp = 100
// 935 %constinteger fnp = 101
// 936 %constinteger mapp = 102
// 937 %constinteger predp = 103
// 938 %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};
struct _imp_dv CLASSMAP_dv = {CLASSMAP, sizeof(int) /*, dims, <bounds> */};
// 939+ err,1764, 247, err(4), -rtp, -fnp, -mapp, -predp, err, 214,
// 940+ ! err,1764, 247, err(4), -rtp, -fnp, -mapp, -predp, err, 214,
// 941+ err, 229, err
// 942 ! err, 229, err
// 943 %integer tags, type, form
int TAGS;
int TYPE;
int FORM;
// 944
// 945 ap = 0
AP = 0;
// 946 tags = v_flags
TAGS = V->FLAGS;
// 947 type = tags>>4&7; form = tags&15
TYPE = (unsigned int)TAGS >> 4 & 7;
FORM = TAGS & 15;
// 948 tp = v_format<<3!type
TP = V->FORMAT << 3 | TYPE;
// 949 c = class map(form)
C = CLASSMAP[FORM];
// 950 c = 208 %and tp = 0 %if type = 0 %and form = 2; !%name
if (TYPE != 0) goto L_005C;
if (FORM != 2) goto L_005C;
C = 208;
TP = 0;
L_005C:;
// 951 ap = v_app %if tags¶meters # 0
if (TAGS & 4096 == 0) goto L_005D;
AP = V->APP;
L_005D:;
// 952 %end
return;
} /* end of CLASS */
// 953 %end
_imp_signal(8, 4, 0, "result missing");
} /* end of GAPP */
// 954
// 955 %routine delete names(%integer quiet)
void DELETENAMES(int QUIET) {
// 956 %integer flags
int FLAGS;
// 957 %record(tagfm)%name tx
struct TAGFM *TX;
// 958
// 959 %while tmax > tbase %cycle
L_005E:;
if (TMAX <= TBASE) goto L_005F;
// 960 x = tmax; tmax = tmax-1
X = TMAX;
TMAX = TMAX - 1;
// 961 tx == tag(x)
TX = (struct TAGFM *)/*?*/ &TAG[X];
// 962 flags = tx_flags
FLAGS = TX->FLAGS;
// 963 fault(20) %if flags&spec # 0 %and flags&own bit = 0
if (FLAGS & 128 == 0) goto L_0060;
if (FLAGS & 512 != 0) goto L_0060;
FAULT(20);
L_0060:;
// 964 !{spec with no definition & not external}
// 965 %if flags&used bit = 0 %and level >= 0 %and list <= 0 %start
if (FLAGS & 32768 != 0) goto L_0061;
if (LEVEL < 0) goto L_0061;
if (LIST > 0) goto L_0061;
// 966 fault(-3) %if quiet = 0; !unused
if (QUIET != 0) goto L_0062;
FAULT(-3);
L_0062:;
// 967 %finish
L_0061:;
// 968 dict(tx_text) = tx_link
DICT[TX->TEXT - 1] = TX->LINK;
// 969 %repeat
goto L_005E;
L_005F:;
// 970 %end
return;
} /* end of DELETENAMES */
// 971
// 972 %routine analyse
void ANALYSE(void) {
// 973 %constinteger order bits = 16_3000, order bit = 16_1000
// 974 %constinteger escape = 16_1000
// 975 %integer strp, mark, flags, prot err, k, s, c
int STRP;
int MARK;
int FLAGS;
int PROTERR;
int K;
int S;
int C;
// 976 %owninteger key = 0
static int KEY = 0;
// 977 %integer node
int NODE;
// 978 %integername z
int *Z;
// 979 %record(arfm)%name arp
struct ARFM *ARP;
// 980 %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};
// 981
// 982 %routine trace analysis
void TRACEANALYSIS(void) {
// 983 !diagnostic trace routine (diagnose&1 # 0)
// 984 %integer a
int A;
// 985
// 986 %routine show(%integer a)
void SHOW(int A) {
// 987 %if 0 < a %and a < 130 %start
if (0 >= A) goto L_0063;
if (A >= 130) goto L_0063;
// 988 space
_imp_SPACE();
// 989 printstring(text(a))
_imp_PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string8) tmp = TEXT[A]/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 990 %finish %else write(a, 3)
goto L_0064;
L_0063:;
_imp_WRITE(A, 3);
L_0064:;
// 991 %end
return;
} /* end of SHOW */
// 992
// 993 %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;
// 994 newline %if mon pos # pos %and sym # nl
if (MONPOS == POS) goto L_0065;
if (SYM == 10) goto L_0065;
_imp_NEWLINE();
L_0065:;
// 995 mon pos = pos
MONPOS = POS;
// 996 write(g, 3)
_imp_WRITE(G, 3);
// 997 space
_imp_SPACE();
// 998 printstring(text(class))
_imp_PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string8) tmp = TEXT[CLASS]/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 999 printsymbol('"') %if gg&trans bit # 0
if (GG & 16384 == 0) goto L_0066;
_imp_PRINTSYMBOL(34);
L_0066:;
// 1000 a = gg>>8&15
A = (unsigned int)GG >> 8 & 15;
// 1001 %if a # 0 %start
if (A == 0) goto L_0067;
// 1002 printsymbol('{')
_imp_PRINTSYMBOL(123);
// 1003 write(a, 0)
_imp_WRITE(A, 0);
// 1004 printsymbol('}')
_imp_PRINTSYMBOL(125);
// 1005 %finish
L_0067:;
// 1006 %if atom1 # la1 %or atom2 # la2 %or lsa # subatom %or lt # type %start
if (ATOM1 != LA1) goto L_0068;
if (ATOM2 != LA2) goto L_0068;
if (LSA != SUBATOM) goto L_0068;
if (LT == TYPE) goto L_0069;
L_0068:;
// 1007 printstring(" [")
_imp_PRINTSTRING(_imp_str_literal(" ["));
// 1008 la1 = atom1
LA1 = ATOM1;
// 1009 show(la1)
SHOW(LA1);
// 1010 la2 = atom2
LA2 = ATOM2;
// 1011 show(la2)
SHOW(LA2);
// 1012 lsa = subatom
LSA = SUBATOM;
// 1013 write(lsa, 3)
_imp_WRITE(LSA, 3);
// 1014 lt = type
LT = TYPE;
// 1015 write(lt, 5)
_imp_WRITE(LT, 5);
// 1016 printsymbol(']')
_imp_PRINTSYMBOL(93);
// 1017 %finish
L_0069:;
// 1018 newline
_imp_NEWLINE();
// 1019 %end
return;
} /* end of TRACEANALYSIS */
// 1020
// 1021 %routine get sym
void GETSYM(void) {
// 1022 readsymbol(sym)
_imp_READSYMBOL(/*?*/ &SYM);
// 1023 abandon(5) %if sym < 0
if (SYM >= 0) goto L_006A;
ABANDON(5);
L_006A:;
// 1024 pos = pos+1 %if pos # 133
if (POS == 133) goto L_006B;
POS = POS + 1;
L_006B:;
// 1025 char(pos) = sym
CHAR[POS] = SYM;
// 1026 printsymbol(sym) %if list <= 0
if (LIST > 0) goto L_006C;
_imp_PRINTSYMBOL(SYM);
L_006C:;
// 1027 column = column+1
COLUMN = COLUMN + 1;
// 1028 %end
return;
} /* end of GETSYM */
// 1029
// 1030 %routine read sym
void READSYM(void) {
// 1031 %owninteger Last = 0
static int LAST = 0;
// 1032 %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};
struct _imp_dv MAPPED_dv = {MAPPED, sizeof(unsigned char) /*, dims, <bounds> */};
// 1033+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 10, 0, 3, 0, 0, 0,
// 1034+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
// 1035+ 0,'!','"','#', '$', 1,'&', 39, '(',')','*','+', ',','-','.','/',
// 1036+ '0','1','2','3', '4','5','6','7', '8','9',':',';', '<','=','>','?',
// 1037+ '@','A','B','C', 'D','E','F','G', 'H','I','J','K', 'L','M','N','O',
// 1038+ 'P','Q','R','S', 'T','U','V','W', 'X','Y','Z','[', '\',']','^','_',
// 1039+ '`','A','B','C', 'D','E','F','G', 'H','I','J','K', 'L','M','N','O',
// 1040+ 'P','Q','R','S', 'T','U','V','W', 'X','Y','Z', 2 , '|','}','~', 0
// 1041
// 1042 !! 0 = space
// 1043 !! 1 = %
// 1044 !! 2 = {
// 1045 !! 3 = ff
// 1046 !! other values represent themselves
// 1047
// 1048 %if sym = nl %start
if (SYM != 10) goto L_006D;
// 1049 s1: lines = lines+1
U_1005:;
LINES = LINES + 1;
// 1050 printsymbol(end mark) %if end mark # 0
if (ENDMARK == 0) goto L_006E;
_imp_PRINTSYMBOL(ENDMARK);
L_006E:;
// 1051 s11: pos = 0; pos1 = 0; pos2 = 0; margin = 0; column = 0
U_1006:;
POS = 0;
POS1 = 0;
POS2 = 0;
MARGIN = 0;
COLUMN = 0;
// 1052 Last = 0
LAST = 0;
// 1053 end mark = 0
ENDMARK = 0;
// 1054 %if list <= 0 %start
if (LIST > 0) goto L_006F;
// 1055 %if include # 0 %start
if (INCLUDE == 0) goto L_0070;
// 1056 printstring(" &"); write(lines, -4)
_imp_PRINTSTRING(_imp_str_literal(" &"));
_imp_WRITE(LINES, -4);
// 1057 %finish %else write(lines, 5)
goto L_0071;
L_0070:;
_imp_WRITE(LINES, 5);
L_0071:;
// 1058 csym = cont; printsymbol(csym)
CSYM = CONT;
_imp_PRINTSYMBOL(CSYM);
// 1059 space
_imp_SPACE();
// 1060 %if error margin # 0 %start
if (ERRORMARGIN == 0) goto L_0072;
// 1061 lines = lines-1
LINES = LINES - 1;
// 1062 spaces(error margin)
_imp_SPACES(ERRORMARGIN);
// 1063 error margin = 0
ERRORMARGIN = 0;
// 1064 %if error sym # 0 %start
if (ERRORSYM == 0) goto L_0073;
// 1065 printsymbol(error sym)
_imp_PRINTSYMBOL(ERRORSYM);
// 1066 pos = 1; char(1) = error sym
POS = 1;
CHAR[1] = ERRORSYM;
// 1067 sym = error sym; error sym = 0
SYM = ERRORSYM;
ERRORSYM = 0;
// 1068 ->s5
goto U_1007;
// 1069 %finish
L_0073:;
// 1070 %finish
L_0072:;
// 1071 %finish
L_006F:;
// 1072 s2: symtype = 1
U_1008:;
SYMTYPE = 1;
// 1073 %finish
L_006D:;
// 1074 s3: readsymbol(sym)
U_1009:;
_imp_READSYMBOL(/*?*/ &SYM);
// 1075 abandon(5) %if sym < 0
if (SYM >= 0) goto L_0074;
ABANDON(5);
L_0074:;
// 1076 pos = pos+1 %if pos # 133
if (POS == 133) goto L_0075;
POS = POS + 1;
L_0075:;
// 1077 char(pos) = sym
CHAR[POS] = SYM;
// 1078 printsymbol(sym) %if list <= 0
if (LIST > 0) goto L_0076;
_imp_PRINTSYMBOL(SYM);
L_0076:;
// 1079 column = column+1
COLUMN = COLUMN + 1;
// 1080 s5: %if sym # nl %start
U_1007:;
if (SYM == 10) goto L_0077;
// 1081 Last = Sym
LAST = SYM;
// 1082 %return %if quote # 0; !dont alter strings
if (QUOTE == 0) goto L_0078;
return;
L_0078:;
// 1083 sym = mapped(sym&127)
SYM = MAPPED[SYM & 127];
// 1084 %if sym <= 3 %start; !special symbol
if (SYM > 3) goto L_0079;
// 1085 ->s2 %if sym = 0; !space (or dubious control)
if (SYM != 0) goto L_007A;
goto U_1008;
L_007A:;
// 1086 symtype = 2 %and ->s3 %if sym = 1; !%
if (SYM != 1) goto L_007B;
SYMTYPE = 2;
goto U_1009;
L_007B:;
// 1087 cont = '+' %and ->s11 %if sym = 3; !ff
if (SYM != 3) goto L_007C;
CONT = 43;
goto U_1006;
L_007C:;
// 1088 !must be {
// 1089 %cycle
L_007D:;
// 1090 get sym
GETSYM();
// 1091 ->s3 %if sym = '}'
if (SYM != 125) goto L_007E;
goto U_1009;
L_007E:;
// 1092 ->s4 %if sym = nl
if (SYM != 10) goto L_007F;
goto U_100A;
L_007F:;
// 1093 %repeat
goto L_007D;
// 1094 %finish
L_0079:;
// 1095 key = kdict(sym)
KEY = KDICT[SYM - 32];
// 1096 %if key&3 = 0 %and symtype = 2 %start; !keyword
if (KEY & 3 != 0) goto L_0080;
if (SYMTYPE != 2) goto L_0080;
// 1097 %if sym = 'C' %and nextsymbol = nl %start; !%c...
if (SYM != 67) goto L_0081;
if (_imp_NEXTSYMBOL() != 10) goto L_0081;
// 1098 getsym; cont = '+'; ->s1
GETSYM();
CONT = 43;
goto U_1005;
// 1099 %finish
L_0081:;
// 1100 %else
goto L_0082;
L_0080:;
// 1101 symtype = key&3-2
SYMTYPE = (KEY & 3) - 2;
// 1102 %finish
L_0082:;
// 1103 %return
return;
// 1104 %finish
L_0077:;
// 1105 s4: symtype = quote
U_100A:;
SYMTYPE = QUOTE;
// 1106 ->S1 %if last = 0 %and Quote = 0
if (LAST != 0) goto L_0083;
if (QUOTE != 0) goto L_0083;
goto U_1005;
L_0083:;
// 1107 Cont = '+'
CONT = 43;
// 1108 %end
return;
} /* end of READSYM */
// 1109
// 1110 %integerfn format selected
int FORMATSELECTED(void) {
// 1111 format list = tag(format)_app; !number of names
FORMATLIST = TAG[FORMAT].APP;
// 1112 %if format list < 0 %start; !forward ref
if (FORMATLIST >= 0) goto L_0084;
// 1113 atom1 = error+22
ATOM1 = 32768 + 22;
// 1114 %result = 0
return 0;
// 1115 %finish
L_0084:;
// 1116 %if sym = '_' %start
if (SYM != 95) goto L_0085;
// 1117 escape class = esc rec
ESCAPECLASS = 255;
// 1118 search base = tag(format)_format
SEARCHBASE = TAG[FORMAT].FORMAT;
// 1119 %finish
L_0085:;
// 1120 %result = 1
return 1;
// 1121 %end
} /* end of FORMATSELECTED */
// 1122
// 1123 %routine code atom(%integer target)
void CODEATOM(int TARGET) {
// 1124 %integer dbase, da
int DBASE;
int DA;
// 1125 %integer base, n, mul, pend quote
int BASE;
int N;
int MUL;
int PENDQUOTE;
// 1126 %integer j,k,l, pt
int J;
int K;
int L;
int PT;
// 1127
// 1128 %routine lookup(%integer d)
void LOOKUP(int D) {
// 1129 %integer new name, vid, k1, k2, form
int NEWNAME;
int VID;
int K1;
int K2;
int FORM;
// 1130 %record(tagfm)%name t
struct TAGFM *T;
// 1131 %integer new
int NEW;
// 1132
// 1133 ! twee little function because SKIMP86 can't do string compare properly
// 1134 ! returns 1 if the two names are the same, else zero
// 1135 %integerfn dict match(%integer ptr1, ptr2)
int DICTMATCH(int PTR1, int PTR2) {
// 1136 %integer len;
int LEN;
// 1137 ! start with a cheap check of the length and first character
// 1138 %if dict(ptr1) # dict(ptr2) %then %result = 0
if (DICT[PTR1 - 1] == DICT[PTR2 - 1]) goto L_0086;
return 0;
L_0086:;
// 1139 len = dict(ptr1) & 255
LEN = DICT[PTR1 - 1] & 255;
// 1140 ptr1 = ptr1 + 1
PTR1 = PTR1 + 1;
// 1141 ptr2 = ptr2 + 1
PTR2 = PTR2 + 1;
// 1142 len = len - 1
LEN = LEN - 1;
// 1143 %while len >= 2 %cycle
L_0087:;
if (LEN < 2) goto L_0088;
// 1144 %if dict(ptr1) # dict(ptr2) %then %result = 0
if (DICT[PTR1 - 1] == DICT[PTR2 - 1]) goto L_0089;
return 0;
L_0089:;
// 1145 ptr1 = ptr1 + 1
PTR1 = PTR1 + 1;
// 1146 ptr2 = ptr2 + 1
PTR2 = PTR2 + 1;
// 1147 len = len - 2
LEN = LEN - 2;
// 1148 %repeat
goto L_0087;
L_0088:;
// 1149 ! if the string was odd length, we might need one last byte checked
// 1150 %if len = 1 %start
if (LEN != 1) goto L_008A;
// 1151 %if dict(ptr1)&255 # dict(ptr2)&255 %then %result = 0
if (DICT[PTR1 - 1] & 255 == DICT[PTR2 - 1] & 255) goto L_008B;
return 0;
L_008B:;
// 1152 %finish
L_008A:;
// 1153 %result = 1
return 1;
// 1154 %end
} /* end of DICTMATCH */
// 1155
// 1156 !first locate the text of the name
// 1157 new = dmax+1; ! points to text of string in dictionary
NEW = DMAX + 1;
// 1158 k1 = hash value & max names; ! rather crude hash!
K1 = HASHVALUE & 2047;
// 1159
// 1160 %cycle
L_008C:;
// 1161 newname = hash(k1)
NEWNAME = HASH[K1];
// 1162 %exit %if newname = 0; !not in
if (NEWNAME != 0) goto L_008D;
goto L_008E;
L_008D:;
// 1163 ->in %if dict match(newname+1, new) = 1
if (DICTMATCH(NEWNAME + 1, NEW) != 1) goto L_008F;
goto U_100B;
L_008F:;
// 1164 k1 = (k1+1)&max names
K1 = K1 + 1 & 2047;
// 1165 %repeat
goto L_008C;
L_008E:;
// 1166
// 1167 ! not found
// 1168 spare names = spare names-1
SPARENAMES = SPARENAMES - 1;
// 1169 abandon(2) %if spare names <= 0
if (SPARENAMES > 0) goto L_0090;
ABANDON(2);
L_0090:;
// 1170 hash(k1) = dmax; !put it in
HASH[K1] = DMAX;
// 1171 dict(dmax) = -1
DICT[DMAX - 1] = -1;
// 1172 newname = dmax; dmax = dp; ->not in
NEWNAME = DMAX;
DMAX = DP;
goto U_100C;
// 1173
// 1174 in: search base = rbase %if this >= 0 %and d # 0; !record elem defn
U_100B:;
if (THIS < 0) goto L_0091;
if (D == 0) goto L_0091;
SEARCHBASE = RBASE;
L_0091:;
// 1175 %if search base # 0 %start; !record subname
if (SEARCHBASE == 0) goto L_0092;
// 1176 new = -1
NEW = -1;
// 1177 x = search base
X = SEARCHBASE;
// 1178 %cycle
L_0093:;
// 1179 ->not in %if x < format list
if (X >= FORMATLIST) goto L_0094;
goto U_100C;
L_0094:;
// 1180 %exit %if tag(x)_text = new name
if (TAG[X].TEXT != NEWNAME) goto L_0095;
goto L_0096;
L_0095:;
// 1181 x = x-1
X = X - 1;
// 1182 %repeat
goto L_0093;
L_0096:;
// 1183 %finish %else %start; !hash in for normal names
goto L_0097;
L_0092:;
// 1184 x = dict(newname)
X = DICT[NEWNAME - 1];
// 1185 ->not in %if x <= limit; !wrong level
if (X > LIMIT) goto L_0098;
goto U_100C;
L_0098:;
// 1186 %finish
L_0097:;
// 1187
// 1188 subatom = x; !name found, extract info
SUBATOM = X;
// 1189 t == tag(x)
T = (struct TAGFM *)/*?*/ &TAG[X];
// 1190 atom flags = t_flags
ATOMFLAGS = T->FLAGS;
// 1191 format = t_format; app = t_app
FORMAT = T->FORMAT;
APP = T->APP;
// 1192 protection = atom flags&prot
PROTECTION = ATOMFLAGS & 256;
// 1193 type = atom flags>>4&7; atom1 = amap(atom flags&15)
TYPE = (unsigned int)ATOMFLAGS >> 4 & 7;
ATOM1 = AMAP[ATOMFLAGS & 15];
// 1194
// 1195 %if diag&8 # 0 %start
if (DIAG & 8 == 0) goto L_0099;
// 1196 printstring("lookup:")
_imp_PRINTSTRING(_imp_str_literal("lookup:"));
// 1197 write(atom1, 3)
_imp_WRITE(ATOM1, 3);
// 1198 write(type, 1)
_imp_WRITE(TYPE, 1);
// 1199 write(app, 3)
_imp_WRITE(APP, 3);
// 1200 write(format, 5)
_imp_WRITE(FORMAT, 5);
// 1201 write(atom flags, 3)
_imp_WRITE(ATOMFLAGS, 3);
// 1202 newline
_imp_NEWLINE();
// 1203 %finish
L_0099:;
// 1204
// 1205 %if d = 0 %start; !old name wanted
if (D != 0) goto L_009A;
// 1206 t_flags = t_flags!used bit
T->FLAGS = T->FLAGS | 32768;
// 1207 search base = 0
SEARCHBASE = 0;
// 1208
// 1209 %if atom flags&subname # 0 %and format # 0 %start; !a record
if (ATOMFLAGS & 2048 == 0) goto L_009B;
if (FORMAT == 0) goto L_009B;
// 1210 %return %if format selected = 0
if (FORMATSELECTED() != 0) goto L_009C;
return;
L_009C:;
// 1211 %finish
L_009B:;
// 1212
// 1213 %if atom flags¶meters # 0 %start; !proc or array
if (ATOMFLAGS & 4096 == 0) goto L_009D;
// 1214 %if app = 0 %start; !no parameters needed
if (APP != 0) goto L_009E;
// 1215 atom2 = atom1
ATOM2 = ATOM1;
// 1216 atom1 = atom1-4
ATOM1 = ATOM1 - 4;
// 1217 %if 97 <= atom1 %and atom1 <= 98 %start
if (97 > ATOM1) goto L_009F;
if (ATOM1 > 98) goto L_009F;
// 1218 map gg = atom1; atom1 = var
MAPGG = ATOM1;
ATOM1 = 91;
// 1219 %finish
L_009F:;
// 1220 %finish %else %start
goto L_00A0;
L_009E:;
// 1221 %if sym = '(' %start
if (SYM != 40) goto L_00A1;
// 1222 search base = 0; !ignore format for now
SEARCHBASE = 0;
// 1223 %if atom1 >= 106 %start; !arrays
if (ATOM1 < 106) goto L_00A2;
// 1224 app = phrase(app+200)
APP = PHRASE[APP + 200 - 200];
// 1225 escape class = esc array
ESCAPECLASS = 254;
// 1226 atom1 = (atom1-106)>>1+91; !a,an->v na,nan->n
ATOM1 = ((unsigned int)ATOM1 - 106 >> 1) + 91;
// 1227 %finish %else %start; !procedures
goto L_00A3;
L_00A2:;
// 1228 escape class = esc proc
ESCAPECLASS = 253;
// 1229 atom1 = atom1-4
ATOM1 = ATOM1 - 4;
// 1230 %finish
L_00A3:;
// 1231 phrase(200) = app
PHRASE[0] = APP;
// 1232 %finish
L_00A1:;
// 1233 %finish
L_00A0:;
// 1234 pos2 = pos; %return
POS2 = POS;
return;
// 1235 %finish
L_009D:;
// 1236
// 1237 !deal with constintegers etc
// 1238 %if atom flags&const bit # 0 %and atom1 = var %start
if (ATOMFLAGS & 8192 == 0) goto L_00A4;
if (ATOM1 != 91) goto L_00A4;
// 1239 map gg = const; atom2 = const
MAPGG = 93;
ATOM2 = 93;
// 1240 subatom = -subatom %if type = integer
if (TYPE != 1) goto L_00A5;
SUBATOM = -SUBATOM;
L_00A5:;
// 1241 %finish
L_00A4:;
// 1242 %return
return;
// 1243 %finish
L_009A:;
// 1244 !new name wanted
// 1245 ->not in %if tbase # tstart; !don't fault proc parm-parm
if (TBASE == TSTART) goto L_00A6;
goto U_100C;
L_00A6:;
// 1246 %if d = lab+spec+used bit %start
if (D != 3 + 128 + 32768) goto L_00A7;
// 1247 t_flags = t_flags!used bit
T->FLAGS = T->FLAGS | 32768;
// 1248 %return
return;
// 1249 %finish
L_00A7:;
// 1250 %if atom flags&spec # 0 %start; !a spec has been given
if (ATOMFLAGS & 128 == 0) goto L_00A8;
// 1251 %if d = lab %start; !define label
if (D != 3) goto L_00A9;
// 1252 t_flags = t_Flags-Spec
T->FLAGS = T->FLAGS - 128;
// 1253 %return
return;
// 1254 %finish
L_00A9:;
// 1255 %if 7 <= decl&15 %and decl&15 <= 10 %and decl&spec = 0 %start
if (7 > DECL & 15) goto L_00AA;
if (DECL & 15 > 10) goto L_00AA;
if (DECL & 128 != 0) goto L_00AA;
// 1256 !procedure definition after spec
// 1257 %if (decl!!atom flags)&2_1111111 = 0 %start; !correct type?
if ((DECL ^ ATOMFLAGS) & 127 != 0) goto L_00AB;
// 1258 t_flags = t_flags-spec
T->FLAGS = T->FLAGS - 128;
// 1259 spec given = 1
SPECGIVEN = 1;
// 1260 %return
return;
// 1261 %finish
L_00AB:;
// 1262 !note that an external procedure must be speced as a
// 1263 !non-external procedure.
// 1264 %finish
L_00AA:;
// 1265 %if decl&15 = recfm %start; !recordformat
if (DECL & 15 != 4) goto L_00AC;
// 1266 t_flags = record<<4+recfm
T->FLAGS = (4 << 4) + 4;
// 1267 t_format = fdef
T->FORMAT = FDEF;
// 1268 %return
return;
// 1269 %finish
L_00AC:;
// 1270 %finish
L_00A8:;
// 1271 %return %if last1 = jump %and atom1 = swit
if (LAST1 != 54) goto L_00AD;
if (ATOM1 != 105) goto L_00AD;
return;
L_00AD:;
// 1272 copy = x %if copy = 0
if (COPY != 0) goto L_00AE;
COPY = X;
L_00AE:;
// 1273 notin: app = 0; vid = 0
U_100C:;
APP = 0;
VID = 0;
// 1274 atom1 = error+2
ATOM1 = 32768 + 2;
// 1275
// 1276 %return %if d = 0; !old name wanted
if (D != 0) goto L_00AF;
return;
L_00AF:;
// 1277 type = d>>4&7; form = d&15; atom1 = amap(form)
TYPE = (unsigned int)D >> 4 & 7;
FORM = D & 15;
ATOM1 = AMAP[FORM];
// 1278
// 1279 %if this < 0 %start; !normal scope
if (THIS >= 0) goto L_00B0;
// 1280 new = newname
NEW = NEWNAME;
// 1281 tmax = tmax+1; x = tmax
TMAX = TMAX + 1;
X = TMAX;
// 1282 %finish %else %start; !recordformat scope
goto L_00B1;
L_00B0:;
// 1283 new = -1
NEW = -1;
// 1284 recid = recid-1; vid = recid
RECID = RECID - 1;
VID = RECID;
// 1285 tmin = tmin-1; x = tmin
TMIN = TMIN - 1;
X = TMIN;
// 1286 format list = tmin
FORMATLIST = TMIN;
// 1287 %finish
L_00B1:;
// 1288
// 1289 %if 11 <= form %and form <= 14 %start; !arrays
if (11 > FORM) goto L_00B2;
if (FORM > 14) goto L_00B2;
// 1290 dim = 1 %if dim = 0; !set dim for owns
if (DIM != 0) goto L_00B3;
DIM = 1;
L_00B3:;
// 1291 app = dim
APP = DIM;
// 1292 %finish
L_00B2:;
// 1293
// 1294 d = d!used bit %if (otype > 2 %and d&spec = 0) %or perm # 0 %or Level = Include Level
if (OTYPE <= 2) goto L_00B4;
if (D & 128 == 0) goto L_00B5;
L_00B4:;
if (PERM != 0) goto L_00B5;
if (LEVEL != INCLUDELEVEL) goto L_00B6;
L_00B5:;
D = D | 32768;
L_00B6:;
// 1295
// 1296 !external definitions need not be used in the file in which
// 1297 !they are defined, so inhibit a useless unused warning.
// 1298
// 1299 t == tag(x)
T = (struct TAGFM *)/*?*/ &TAG[X];
// 1300 %if form = lab %start
if (FORM != 3) goto L_00B7;
// 1301 id = id+1; vid = id
ID = ID + 1;
VID = ID;
// 1302 %finish
L_00B7:;
// 1303 t_index = vid
T->INDEX = VID;
// 1304 t_text = new name
T->TEXT = NEWNAME;
// 1305 t_flags = d
T->FLAGS = D;
// 1306 t_app = app
T->APP = APP;
// 1307 t_format = fdef; format = fdef
T->FORMAT = FDEF;
FORMAT = FDEF;
// 1308 subatom = x
SUBATOM = X;
// 1309
// 1310 %if new >= 0 %start; !insert into hash table
if (NEW < 0) goto L_00B8;
// 1311 t_link = dict(new); dict(new) = x
T->LINK = DICT[NEW - 1];
DICT[NEW - 1] = X;
// 1312 %if gmin = max grammar %start; !proc param params
if (GMIN != 1720) goto L_00B9;
// 1313 tmin = tmin-1; subatom = tmin
TMIN = TMIN - 1;
SUBATOM = TMIN;
// 1314 tag(tmin) = t
TAG[TMIN] = *T;
// 1315 %finish
L_00B9:;
// 1316 %finish
L_00B8:;
// 1317 abandon(3) %if tmax >= tmin
if (TMAX < TMIN) goto L_00BA;
ABANDON(3);
L_00BA:;
// 1318 %end
return;
} /* end of LOOKUP */
// ?K2 unused
// 1319
// 1320 top: pos1 = pos
U_100D:;
POS1 = POS;
// 1321 subatom = 0; pend quote = 0; atom flags = 0
SUBATOM = 0;
PENDQUOTE = 0;
ATOMFLAGS = 0;
// 1322
// 1323 !app and format must be left for assigning to papp & pformat
// 1324 ->name %if symtype = -2; ! letter
if (SYMTYPE != -2) goto L_00BB;
goto U_100E;
L_00BB:;
// 1325 ->number %if symtype < 0; ! digit
if (SYMTYPE >= 0) goto L_00BC;
goto U_100F;
L_00BC:;
// 1326 %if symtype = 0 %start
if (SYMTYPE != 0) goto L_00BD;
// 1327 atom1 = termin; atom2 = 0
ATOM1 = 20;
ATOM2 = 0;
// 1328 %return
return;
// 1329 %finish
L_00BD:;
// 1330 %if symtype # 2 %start; ! catch keywords here
if (SYMTYPE == 2) goto L_00BE;
// 1331 ->text %if quote # 0; ! completion of text
if (QUOTE == 0) goto L_00BF;
goto U_1010;
L_00BF:;
// 1332 ->strings %if sym = squote; ! start of string
if (SYM != 34) goto L_00C0;
goto U_1011;
L_00C0:;
// 1333 ->symbols %if sym = cquote; ! start of symbol
if (SYM != 39) goto L_00C1;
goto U_1012;
L_00C1:;
// 1334 ->number %if sym = '.' %and '0' <= nextsymbol %and nextsymbol <= '9'
if (SYM != 46) goto L_00C2;
if (48 > _imp_NEXTSYMBOL()) goto L_00C2;
if (_imp_NEXTSYMBOL() > 57) goto L_00C2;
goto U_100F;
L_00C2:;
// 1335 %finish
L_00BE:;
// 1336
// 1337 ! locate atom in fixed dict
// 1338 k = key>>2; read sym
K = (unsigned int)KEY >> 2;
READSYM();
// 1339 %cycle
L_00C3:;
// 1340 j = kdict(k)
J = KDICT[K - 32];
// 1341 %exit %if j&16_4000 # 0
if (J & 16384 == 0) goto L_00C4;
goto L_00C5;
L_00C4:;
// 1342 %if j&127 # sym %or symtype < 0 %start
if (J & 127 != SYM) goto L_00C6;
if (SYMTYPE >= 0) goto L_00C7;
L_00C6:;
// 1343 ->err %unless j < 0
if (J < 0) goto L_00C8;
goto U_1013;
L_00C8:;
// 1344 k = k+1
K = K + 1;
// 1345 %finish %else %start
goto L_00C9;
L_00C7:;
// 1346 l = j>>7&127; read sym
L = (unsigned int)J >> 7 & 127;
READSYM();
// 1347 %if j > 0 %start
if (J <= 0) goto L_00CA;
// 1348 %if l # 0 %start
if (L == 0) goto L_00CB;
// 1349 ->err %if l # sym %or symtype < 0
if (L != SYM) goto L_00CC;
if (SYMTYPE >= 0) goto L_00CD;
L_00CC:;
goto U_1013;
L_00CD:;
// 1350 read sym
READSYM();
// 1351 %finish
L_00CB:;
// 1352 l = 1
L = 1;
// 1353 %finish
L_00CA:;
// 1354 k = k+l
K = K + L;
// 1355 %finish
L_00C9:;
// 1356 %repeat
goto L_00C3;
L_00C5:;
// 1357 atom1 = j&127
ATOM1 = J & 127;
// 1358 %if atom1 = 0 %start; ! comma
if (ATOM1 != 0) goto L_00CE;
// 1359 atom1 = 19; subatom = 19; atom2 = 0
ATOM1 = 19;
SUBATOM = 19;
ATOM2 = 0;
// 1360 %if sym = nl %start
if (SYM != 10) goto L_00CF;
// 1361 %return %if ocount >= 0
if (OCOUNT < 0) goto L_00D0;
return;
L_00D0:;
// 1362
// 1363 ! special action needs to be taken with <comma nl> as
// 1364 ! const array lists can be enormous
// 1365 read sym
READSYM();
// 1366 %finish
L_00CF:;
// 1367 %return
return;
// 1368 %finish
L_00CE:;
// 1369 atom2 = j>>7&127
ATOM2 = (unsigned int)J >> 7 & 127;
// 1370 subatom = kdict(k+1)&16_3fff
SUBATOM = KDICT[K + 1 - 32] & 16383;
// 1371 !!!!!cont = ' '
// 1372 %return
return;
// 1373
// 1374 ! report an error. adjust the error marker (pos1) to point
// 1375 ! to the faulty character in an atom, but care needs to be taken
// 1376 ! to prevent misleading reports in cases like ...?????
// 1377
// 1378 err: atom1 = error+1; atom2 = 0
U_1013:;
ATOM1 = 32768 + 1;
ATOM2 = 0;
// 1379 pos1 = pos %if pos-pos1 > 2
if (POS - POS1 <= 2) goto L_00D1;
POS1 = POS;
L_00D1:;
// 1380 %return
return;
// 1381
// 1382 ! take care with strings and symbol constants.
// 1383 ! make sure the constant is valid here before sucking it in
// 1384 ! (and potentially loosing many lines)
// 1385
// 1386 symbols: atom1 = var; atom2 = const; type = integer
U_1012:;
ATOM1 = 91;
ATOM2 = 93;
TYPE = 1;
// 1387 map gg = const; protection = prot
MAPGG = 93;
PROTECTION = 256;
// 1388 subatom = lp; abandon(3) %if lp >= lit max
SUBATOM = LP;
if (LP < 50) goto L_00D2;
ABANDON(3);
L_00D2:;
// 1389 quote = \pend quote
QUOTE = (~PENDQUOTE);
// 1390 %return
return;
// 1391
// 1392 ! an integer constant is acceptable so get it in and
// 1393 ! get the next atom
// 1394 chars: n = 0; cont = cquote
U_1014:;
N = 0;
CONT = 39;
// 1395 %cycle
L_00D3:;
// 1396 read sym
READSYM();
// 1397 %if sym = cquote %start
if (SYM != 39) goto L_00D4;
// 1398 %exit %if nextsymbol # cquote
if (_imp_NEXTSYMBOL() == 39) goto L_00D5;
goto L_00D6;
L_00D5:;
// 1399 read sym
READSYM();
// 1400 %finish
L_00D4:;
// 1401 %if n&(\((-1)>>byte size)) # 0 %start; ! overflow
if (N & ~((unsigned int)(-1) >> 8) == 0) goto L_00D7;
// 1402 pos1 = pos; atom1 = error+10; %return
POS1 = POS;
ATOM1 = 32768 + 10;
return;
// 1403 %finish
L_00D7:;
// 1404 ->err %if quote = 0
if (QUOTE != 0) goto L_00D8;
goto U_1013;
L_00D8:;
// 1405 n = n<<byte size+sym
N = (N << 8) + SYM;
// 1406 quote = quote+1
QUOTE = QUOTE + 1;
// 1407 %repeat
goto L_00D3;
L_00D6:;
// 1408 quote = 0; cont = ' '
QUOTE = 0;
CONT = 32;
// 1409 readsym %if sym # nl
if (SYM == 10) goto L_00D9;
READSYM();
L_00D9:;
// 1410 lit pool(lp) = n; lp = lp+1
LITPOOL[LP] = N;
LP = LP + 1;
// 1411 ->top
goto U_100D;
// 1412
// 1413 !sniff the grammar before getting the string
// 1414 strings: atom1 = var; atom2 = const; type = stringv
U_1011:;
ATOM1 = 91;
ATOM2 = 93;
TYPE = 3;
// 1415 subatom = strp!16_4000
SUBATOM = STRP | 16384;
// 1416 map gg = const; protection = prot
MAPGG = 93;
PROTECTION = 256;
// 1417 quote = subatom
QUOTE = SUBATOM;
// 1418 text line = lines; ! in case of errors
TEXTLINE = LINES;
// 1419 %return
return;
// 1420
// 1421 ! a string constant is ok here, so pull it in and get
// 1422 ! the next atom
// 1423 ! ABD - temp variable to help pack bytes into words
// 1424 %integer flipflop
int FLIPFLOP;
// 1425
// 1426 text: ->chars %if quote < 0; ! character consts
U_1010:;
if (QUOTE >= 0) goto L_00DA;
goto U_1014;
L_00DA:;
// 1427 l = strp; ! point to beginning
L = STRP;
// 1428 k = 0; ! length so far
K = 0;
// 1429 flipflop = 0; ! space for the length is up the spout
FLIPFLOP = 0;
// 1430
// 1431 %cycle
L_00DB:;
// 1432 cont = squote; quote = 1
CONT = 34;
QUOTE = 1;
// 1433 %cycle
L_00DC:;
// 1434 read sym
READSYM();
// 1435 %if sym = squote %start; ! terminator?
if (SYM != 34) goto L_00DD;
// 1436 %exit %if nextsymbol # squote; ! yes ->
if (_imp_NEXTSYMBOL() == 34) goto L_00DE;
goto L_00DF;
L_00DE:;
// 1437 read sym; ! skip quote
READSYM();
// 1438 %finish
L_00DD:;
// 1439 %if flipflop >= 0 %start
if (FLIPFLOP < 0) goto L_00E0;
// 1440 glink(strp) = sym<<8 + flipflop
GLINK[STRP] = (SYM << 8) + FLIPFLOP;
// 1441 strp = strp+1
STRP = STRP + 1;
// 1442 flipflop = -1
FLIPFLOP = -1;
// 1443 %else
goto L_00E1;
L_00E0:;
// 1444 flipflop = sym
FLIPFLOP = SYM;
// 1445 %finish
L_00E1:;
// 1446 k = k+1
K = K + 1;
// 1447 lines = text line %and abandon(7) %if k > 255; ! too many chars
if (K <= 255) goto L_00E2;
LINES = TEXTLINE;
ABANDON(7);
L_00E2:;
// 1448 %repeat
goto L_00DC;
L_00DF:;
// 1449 %if flipflop >=0 %start; ! tail-end charlie
if (FLIPFLOP < 0) goto L_00E3;
// 1450 glink(strp) = flipflop
GLINK[STRP] = FLIPFLOP;
// 1451 strp = strp+1
STRP = STRP + 1;
// 1452 %finish
L_00E3:;
// 1453 glink(l) = glink(l)!k; ! plug in length
GLINK[L] = GLINK[L] | K;
// 1454
// 1455 quote = 0; cont = ' '; read sym
QUOTE = 0;
CONT = 32;
READSYM();
// 1456 code atom(target)
CODEATOM(TARGET);
// 1457 %return %unless atom1 = 48 %and sym = squote; ! fold "???"."+++"
if (ATOM1 != 48) goto L_00E4;
if (SYM == 34) goto L_00E5;
L_00E4:;
return;
L_00E5:;
// 1458 %repeat
goto L_00DB;
// 1459
// 1460 %routine get(%integer limit)
void GET(int LIMIT) {
// 1461 %integer s, shift
int S;
int SHIFT;
// 1462 shift = 0
SHIFT = 0;
// 1463 %if base # 10 %start
if (BASE == 10) goto L_00E6;
// 1464 %if base = 16 %start
if (BASE != 16) goto L_00E7;
// 1465 shift = 4
SHIFT = 4;
// 1466 %finish %else %start
goto L_00E8;
L_00E7:;
// 1467 %if base = 8 %start
if (BASE != 8) goto L_00E9;
// 1468 shift = 3
SHIFT = 3;
// 1469 %finish %else %start
goto L_00EA;
L_00E9:;
// 1470 %if base = 2 %start
if (BASE != 2) goto L_00EB;
// 1471 shift = 1
SHIFT = 1;
// 1472 %finish
L_00EB:;
// 1473 %finish
L_00EA:;
// 1474 %finish
L_00E8:;
// 1475 %finish
L_00E6:;
// 1476 n = 0
N = 0;
// 1477 %cycle
L_00EC:;
// 1478 %if symtype = -1 %start; ! digit
if (SYMTYPE != -1) goto L_00ED;
// 1479 s = sym-'0'
S = SYM - 48;
// 1480 %finish %else %start
goto L_00EE;
L_00ED:;
// 1481 %if symtype < 0 %start; ! letter
if (SYMTYPE >= 0) goto L_00EF;
// 1482 s = sym-'A'+10
S = SYM - 65 + 10;
// 1483 %finish %else %start
goto L_00F0;
L_00EF:;
// 1484 %return
return;
// 1485 %finish
L_00F0:;
// 1486 %finish
L_00EE:;
// 1487 %return %if s >= limit
if (S < LIMIT) goto L_00F1;
return;
L_00F1:;
// 1488 pt = pt+1; glink(pt) = sym
PT = PT + 1;
GLINK[PT] = SYM;
// 1489 %if base = 10 %start; ! check overflow
if (BASE != 10) goto L_00F2;
// 1490 %if n >= max int %and (s > max dig %or n > max int) %start
if (N < 214748364) goto L_00F3;
if (S > 7) goto L_00F4;
if (N <= 214748364) goto L_00F3;
L_00F4:;
// 1491 !too big for an integer,
// 1492 !so call it a real
// 1493 base = 0; type = real; n = 0
BASE = 0;
TYPE = 2;
N = 0;
// 1494 %finish
L_00F3:;
// 1495 %finish
L_00F2:;
// 1496 %if shift = 0 %start
if (SHIFT != 0) goto L_00F5;
// 1497 n = n*base+s
N = N * BASE + S;
// 1498 %finish %else %start
goto L_00F6;
L_00F5:;
// 1499 n = n<<shift+s
N = (N << SHIFT) + S;
// 1500 %finish
L_00F6:;
// 1501 read sym
READSYM();
// 1502 %repeat
goto L_00EC;
// 1503 %end
} /* end of GET */
// 1504
// 1505 number: base = 10
U_100F:;
BASE = 10;
// 1506 bxk: atom1 = var; atom2 = const; type = integer; subatom = lp
U_100C:;
ATOM1 = 91;
ATOM2 = 93;
TYPE = 1;
SUBATOM = LP;
// 1507 map gg = const; protection = prot
MAPGG = 93;
PROTECTION = 256;
// 1508 abandon(3) %if lp >= lit max
if (LP < 50) goto L_00F7;
ABANDON(3);
L_00F7:;
// 1509 pt = strp; mul = 0
PT = STRP;
MUL = 0;
// 1510 %cycle
L_00F8:;
// 1511 get(base)
GET(BASE);
// 1512 %exit %unless sym = '_' %and base # 0 %and pend quote = 0; ! change of base
if (SYM != 95) goto L_00F9;
if (BASE == 0) goto L_00F9;
if (PENDQUOTE == 0) goto L_00FA;
L_00F9:;
goto L_00FB;
L_00FA:;
// 1513 pt = pt+1; glink(pt) = '_'
PT = PT + 1;
GLINK[PT] = 95;
// 1514 read sym
READSYM();
// 1515 base = n
BASE = N;
// 1516 %repeat
goto L_00F8;
L_00FB:;
// 1517
// 1518 %if pend quote # 0 %start
if (PENDQUOTE == 0) goto L_00FC;
// 1519 ->err %if sym # cquote
if (SYM == 39) goto L_00FD;
goto U_1013;
L_00FD:;
// 1520 readsym
READSYM();
// 1521 %finish
L_00FC:;
// 1522 %if sym = '.' %start; ! a real constant
if (SYM != 46) goto L_00FE;
// 1523 pt = pt+1; glink(pt) = '.'
PT = PT + 1;
GLINK[PT] = 46;
// 1524 read sym
READSYM();
// 1525 type = real; n = base; base = 0; get(n)
TYPE = 2;
N = BASE;
BASE = 0;
GET(N);
// 1526 %finish
L_00FE:;
// 1527
// 1528 %if sym = '@' %start; ! an exponent
if (SYM != 64) goto L_00FF;
// 1529 pt = pt+1; glink(pt) = '@'; k = pt
PT = PT + 1;
GLINK[PT] = 64;
K = PT;
// 1530 readsym
READSYM();
// 1531 type = integer; base = 10
TYPE = 1;
BASE = 10;
// 1532 %if sym = '-' %start
if (SYM != 45) goto L_0100;
// 1533 read sym; get(10); n = -n
READSYM();
GET(10);
N = -N;
// 1534 %finish %else %start
goto L_0101;
L_0100:;
// 1535 get(10)
GET(10);
// 1536 %finish
L_0101:;
// 1537 pt = k+1; glink(pt) = lp; litpool(lp) = n; lp = lp+1
PT = K + 1;
GLINK[PT] = LP;
LITPOOL[LP] = N;
LP = LP + 1;
// 1538 atom1 = error+10 %if base = 0
if (BASE != 0) goto L_0102;
ATOM1 = 32768 + 10;
L_0102:;
// 1539 type = real; ! exponents force the type
TYPE = 2;
// 1540 %finish
L_00FF:;
// 1541
// 1542 %if type = real %start
if (TYPE != 2) goto L_0103;
// 1543 glink(strp) = pt-strp; ! store the length (difference)
GLINK[STRP] = PT - STRP;
// 1544 subatom = (strp)!16_2000; strp = pt+1
SUBATOM = STRP | 8192;
STRP = PT + 1;
// 1545 %finish %else %start
goto L_0104;
L_0103:;
// 1546 litpool(lp) = n
LITPOOL[LP] = N;
// 1547 lp = lp+1
LP = LP + 1;
// 1548 %finish
L_0104:;
// 1549 %return
return;
// 1550
// 1551 name: atom1 = 0 %and %return %if 27 <= target %and target <= 41
U_100E:;
if (27 > TARGET) goto L_0105;
if (TARGET > 41) goto L_0105;
ATOM1 = 0;
return;
L_0105:;
// 1552 hash value = 0
HASHVALUE = 0;
// 1553
// 1554 ! ABD changed to remove dependency on direct addressing
// 1555 dp = dmax+1
DP = DMAX + 1;
// 1556 dbase = dp
DBASE = DP;
// 1557 n = 0
N = 0;
// 1558 dict(dp) = 0
DICT[DP - 1] = 0;
// 1559 %cycle
L_0106:;
// 1560 hash value = hash value+(hash value+sym); ! is this good enough?
HASHVALUE = HASHVALUE + (HASHVALUE + SYM);
// 1561 dict(dp) = dict(dp) ! (sym << 8);
DICT[DP - 1] = DICT[DP - 1] | SYM << 8;
// 1562 n = n+1
N = N + 1;
// 1563 dp = dp+1
DP = DP + 1;
// 1564 read sym
READSYM();
// 1565 %exit %if symtype >= 0
if (SYMTYPE < 0) goto L_0107;
goto L_0108;
L_0107:;
// 1566 dict(dp) = sym;
DICT[DP - 1] = SYM;
// 1567 n = n+1
N = N + 1;
// 1568 read sym
READSYM();
// 1569 %exit %if symtype >= 0
if (SYMTYPE < 0) goto L_0109;
goto L_0108;
L_0109:;
// 1570 %repeat
goto L_0106;
L_0108:;
// 1571 %if sym = cquote %start
if (SYM != 39) goto L_010A;
// 1572 pend quote = 100
PENDQUOTE = 100;
// 1573 ->symbols %if hash value = 'M'
if (HASHVALUE != 77) goto L_010B;
goto U_1012;
L_010B:;
// 1574 read sym
READSYM();
// 1575 %if hash value = 'X' %then base = 16 %and ->bxk
if (HASHVALUE != 88) goto L_010C;
BASE = 16;
goto U_100C;
L_010C:;
// 1576 %if hash value = 'K' %or hash value = 'O' %then base = 8 %and ->bxk
if (HASHVALUE == 75) goto L_010D;
if (HASHVALUE != 79) goto L_010E;
L_010D:;
BASE = 8;
goto U_100C;
L_010E:;
// 1577 %if hash value = 'B' %then base = 2 %and ->bxk
if (HASHVALUE != 66) goto L_010F;
BASE = 2;
goto U_100C;
L_010F:;
// 1578 ->err
goto U_1013;
// 1579 %finish
L_010A:;
// 1580 dict(dbase) = dict(dbase)!n
DICT[DBASE - 1] = DICT[DBASE - 1] | N;
// 1581 %if n&1 = 0 %then dp = dp+1
if (N & 1 != 0) goto L_0110;
DP = DP + 1;
L_0110:;
// 1582 abandon(8) %if dp >= dmin
if (DP < DMIN) goto L_0111;
ABANDON(8);
L_0111:;
// 1583
// 1584 atom2 = 90; ! ident
ATOM2 = 90;
// 1585 %if last1 = 0 %and sym = ':' %start; ! label
if (LAST1 != 0) goto L_0112;
if (SYM != 58) goto L_0112;
// 1586 limit = local; lookup(lab); %return
LIMIT = LOCAL;
LOOKUP(3);
return;
// 1587 %finish
L_0112:;
// 1588 %if last1 = jump %start; ! ->label
if (LAST1 != 54) goto L_0113;
// 1589 limit = local; lookup(lab+spec+used bit); %return
LIMIT = LOCAL;
LOOKUP(3 + 128 + 32768);
return;
// 1590 %finish
L_0113:;
// 1591 %if decl # 0 %and target = 90 %start; ! identifier
if (DECL == 0) goto L_0114;
if (TARGET != 90) goto L_0114;
// 1592 search base = fm base
SEARCHBASE = FMBASE;
// 1593 limit = local; lookup(decl)
LIMIT = LOCAL;
LOOKUP(DECL);
// 1594 search base = 0
SEARCHBASE = 0;
// 1595 %finish %else %start
goto L_0115;
L_0114:;
// 1596 limit = 0; lookup(0)
LIMIT = 0;
LOOKUP(0);
// 1597 %finish
L_0115:;
// 1598 %end
return;
} /* end of CODEATOM */
// ?DA unused
// 1599
// 1600 %integerfn parsed machine code
int PARSEDMACHINECODE(void) {
// 1601 ! *opcode_??????????
// 1602 atom1 = error %and %result=0 %unless symtype = -2; ! starts with letter
if (SYMTYPE == -2) goto L_0116;
ATOM1 = 32768;
return 0;
L_0116:;
// 1603 flush buffer( 128 ); ! flush if bp >= 128
FLUSHBUFFER(128);
// 1604 add char( 'w' )
ADDCHAR(119);
// 1605 %cycle
L_0117:;
// 1606 add char( sym ); read sym
ADDCHAR(SYM);
READSYM();
// 1607 %repeat %until Sym = '_' %or Symtype = 0; ! pull in letters and digits
if (SYM == 95) goto L_0118;
if (SYMTYPE == 0) goto L_0118;
goto L_0117;
L_0118:;
// 1608 add char( '_' )
ADDCHAR(95);
// 1609 %if symtype # 0 %start; ! not terminator
if (SYMTYPE == 0) goto L_0119;
// 1610 read sym
READSYM();
// 1611 %while symtype # 0 %cycle
L_011A:;
if (SYMTYPE == 0) goto L_011B;
// 1612 %if symtype < 0 %start; ! complex
if (SYMTYPE >= 0) goto L_011C;
// 1613 code atom(0); %result=0 %if atom1&error # 0
CODEATOM(0);
if (ATOM1 & 32768 == 0) goto L_011D;
return 0;
L_011D:;
// 1614 %if atom2 = const %and type = integer %start
if (ATOM2 != 93) goto L_011E;
if (TYPE != 1) goto L_011E;
// 1615 %if subatom < 0 %then set const(tag(-subatom)_format) %else set const(litpool(subatom))
if (SUBATOM >= 0) goto L_011F;
SETCONST(TAG[-SUBATOM].FORMAT);
goto L_0120;
L_011F:;
SETCONST(LITPOOL[SUBATOM]);
L_0120:;
// 1616 %finish %else %if 91 <= atom1 %and atom1 <= 109 %start
goto L_0121;
L_011E:;
if (91 > ATOM1) goto L_0122;
if (ATOM1 > 109) goto L_0122;
// 1617 %if atom1 = 104 %and Tag(Subatom)_Flags&Closed = 0 %start
if (ATOM1 != 104) goto L_0123;
if (TAG[SUBATOM].FLAGS & 16384 != 0) goto L_0123;
// 1618 This = Subatom; Atom1 = Error+21
THIS = SUBATOM;
ATOM1 = 32768 + 21;
// 1619 %result = 0
return 0;
// 1620 %finish
L_0123:;
// 1621 op(' ', tag(subatom)_index)
OP(32, TAG[SUBATOM].INDEX);
// 1622 %finish %else %start
goto L_0121;
L_0122:;
// 1623 atom1 = error; %result=0
ATOM1 = 32768;
return 0;
// 1624 %finish
L_0121:;
// 1625 %finish %else %start
goto L_0124;
L_011C:;
// 1626 sym = sym!128 %if symtype = 2 {underline with %}
if (SYMTYPE != 2) goto L_0125;
SYM = SYM | 128;
L_0125:;
// 1627 add char( sym ); read sym
ADDCHAR(SYM);
READSYM();
// 1628 %finish
L_0124:;
// 1629 %repeat
goto L_011A;
L_011B:;
// 1630 %finish
L_0119:;
// 1631 add char( ';' )
ADDCHAR(59);
// 1632 %result=1
return 1;
// 1633 %end
} /* end of PARSEDMACHINECODE */
// 1634
// 1635 cont = ' ' %if gg = 0
if (GG != 0) goto L_0126;
CONT = 32;
L_0126:;
// 1636 last1 = 0; mapgg = 0
LAST1 = 0;
MAPGG = 0;
// 1637 s = 0; ss = 0; sstype = -1; fdef = 0
S = 0;
SS = 0;
SSTYPE = -1;
FDEF = 0;
// 1638 fm base = 0
FMBASE = 0;
// 1639 app = 0
APP = 0;
// 1640
// 1641 ! deal with alignment following an error in one statement
// 1642 ! of several on a line
// 1643 margin = column; ! start of statement
MARGIN = COLUMN;
// 1644 pos = 0
POS = 0;
// 1645 strp = gmax+1; lp = 0
STRP = GMAX + 1;
LP = 0;
// 1646 tbase = tstart; ! ??????????????
TBASE = TSTART;
// 1647 local = tbase
LOCAL = TBASE;
// 1648
// 1649 %if gg = 0 %or ocount >= 0 %start; ! data or not continuation(z)
if (GG == 0) goto L_0127;
if (OCOUNT < 0) goto L_0128;
L_0127:;
// 1650 again: %while sym type = 0 %cycle; ! skip redundant terminators
U_1006:;
L_0129:;
if (SYMTYPE != 0) goto L_012A;
// 1651 c = cont
C = CONT;
// 1652 cont = ' '; cont = '+' %if ocount >= 0
CONT = 32;
if (OCOUNT < 0) goto L_012B;
CONT = 43;
L_012B:;
// 1653 read sym
READSYM();
// 1654 cont = c
CONT = C;
// 1655 %repeat
goto L_0129;
L_012A:;
// 1656 ->skip %if sym = '!'; ! comment
if (SYM != 33) goto L_012C;
goto U_1007;
L_012C:;
// 1657 this = -1
THIS = -1;
// 1658 code atom(0)
CODEATOM(0);
// 1659 %if atom1 = comment %start
if (ATOM1 != 22) goto L_012D;
// 1660 skip: quote = 1
U_1007:;
QUOTE = 1;
// 1661 c = cont
C = CONT;
// 1662 read sym %and cont = c %while sym # nl; ! skip to end of line
L_012E:;
if (SYM == 10) goto L_012F;
READSYM();
CONT = C;
goto L_012E;
L_012F:;
// 1663 quote = 0; symtype = 0
QUOTE = 0;
SYMTYPE = 0;
// 1664 ->again
goto U_1006;
// 1665 %finish
L_012D:;
// 1666 %finish
L_0128:;
// 1667 decl = 0; mark = 0
DECL = 0;
MARK = 0;
// 1668 gentype = 0; force = 0
GENTYPE = 0;
FORCE = 0;
// 1669 dim = 0; prot err = 0
DIM = 0;
PROTERR = 0;
// 1670 node = 0; nmax = 0; nmin = rec size+1
NODE = 0;
NMAX = 0;
NMIN = 520 + 1;
// 1671 order = 1; gmin = max grammar+1
ORDER = 1;
GMIN = 1720 + 1;
// 1672 sstype = 0 %and ->more %if gg # 0; ! continuation
if (GG == 0) goto L_0130;
SSTYPE = 0;
goto U_1008;
L_0130:;
// 1673 ptype = 0; spec given = 0
PTYPE = 0;
SPECGIVEN = 0;
// 1674
// 1675 stats = stats+1; op('O', lines) %if perm = 0
STATS = STATS + 1;
if (PERM != 0) goto L_0131;
OP(79, LINES);
L_0131:;
// 1676
// 1677 ->fail1 %if atom1&error # 0; ! first atom faulty
if (ATOM1 & 32768 == 0) goto L_0132;
goto U_1009;
L_0132:;
// 1678
// 1679 %if escape class # 0 %start; ! enter the hard way after
if (ESCAPECLASS == 0) goto L_0133;
// 1680 g = imp phrase; sstype = -1; ->a3
G = 25;
SSTYPE = -1;
goto U_100A;
// 1681 %finish
L_0133:;
// 1682
// 1683 g = initial(atom1); ! pick up entry point
G = INITIAL[ATOM1];
// 1684 %if g = 0 %start; ! invalid first atom
if (G != 0) goto L_0134;
// 1685 g = initial(0); sstype = 0; ->a3; ! declarator?
G = INITIAL[0];
SSTYPE = 0;
goto U_100A;
// 1686 %finish
L_0134:;
// 1687 %if g < 0 %start; ! phrase imp
if (G >= 0) goto L_0135;
// 1688 g = g&255
G = G & 255;
// 1689 nmax = 1
NMAX = 1;
// 1690 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;
// 1691 %finish
L_0135:;
// 1692
// 1693 gg = gram(g); class = gg&255; sstype = gg>>12&3-1
GG = GRAM[G];
CLASS = GG & 255;
SSTYPE = ((unsigned int)GG >> 12 & 3) - 1;
// 1694 ->a1
goto U_1015;
// 1695
// 1696 act(194): ptype = type; papp = app; pformat = format; ->more
case_ACT_194:;
PTYPE = TYPE;
PAPP = APP;
PFORMAT = FORMAT;
goto U_1008;
// 1697 act(196): k =g+1; ->a610
case_ACT_196:;
K = G + 1;
goto U_1016;
// 1698 act(188): k = ar(nmax)_sub+1
case_ACT_188:;
K = AR[NMAX - 1].SUB + 1;
// 1699 a610: papp = glink(k)
U_1016:;
PAPP = GLINK[K];
// 1700 k = gram(k)
K = GRAM[K];
// 1701 ->more %if k = 0; ! %name
if (K != 0) goto L_0137;
goto U_1008;
L_0137:;
// 1702 ptype = k&7; pformat = k>>3
PTYPE = K & 7;
PFORMAT = (unsigned int)K >> 3;
// 1703 act(183): k = type; gentype = k %if gentype = 0 %or k = real
case_ACT_183:;
K = TYPE;
if (GENTYPE == 0) goto L_0138;
if (K != 2) goto L_0139;
L_0138:;
GENTYPE = K;
L_0139:;
// 1704 %if pformat < 0 %start; ! general type
if (PFORMAT >= 0) goto L_013A;
// 1705 app = papp; format = pformat
APP = PAPP;
FORMAT = PFORMAT;
// 1706 k = real %if ptype = real %and type = integer
if (PTYPE != 2) goto L_013B;
if (TYPE != 1) goto L_013B;
K = 2;
L_013B:;
// 1707 k = force %and force = 0 %if force # 0
if (FORCE == 0) goto L_013C;
K = FORCE;
FORCE = 0;
L_013C:;
// 1708 %finish
L_013A:;
// 1709 ->fail2 %unless papp = app %and (ptype = k %or ptype = 0)
if (PAPP != APP) goto L_013D;
if (PTYPE == K) goto L_013E;
if (PTYPE == 0) goto L_013E;
L_013D:;
goto U_1017;
L_013E:;
// 1710 ->more %if pformat=format %or pformat = 0 %or format = 0
if (PFORMAT == FORMAT) goto L_013F;
if (PFORMAT == 0) goto L_013F;
if (FORMAT != 0) goto L_0140;
L_013F:;
goto U_1008;
L_0140:;
// 1711 ->fail2
goto U_1017;
// 1712 act(197): arp == ar(nmin)
case_ACT_197:;
ARP = (struct ARFM *)/*?*/ &AR[NMIN - 1];
// 1713 k = arp_sub
K = ARP->SUB;
// 1714 ->fail3 %unless block form = k&15
if (BLOCKFORM == K & 15) goto L_0141;
goto U_1018;
L_0141:;
// 1715 arp_sub = k>>4
ARP->SUB = (unsigned int)K >> 4;
// 1716
// 1717 type = block type
TYPE = BLOCKTYPE;
// 1718 ptype = block type; pformat = block fm; papp = app
PTYPE = BLOCKTYPE;
PFORMAT = BLOCKFM;
PAPP = APP;
// 1719 pformat = -1 %if ptype # record
if (PTYPE == 4) goto L_0142;
PFORMAT = -1;
L_0142:;
// 1720 ->more
goto U_1008;
// 1721 act(195): ->Fail2 %if Type # 0 %and Type # Integer %and Type # Real
case_ACT_195:;
if (TYPE == 0) goto L_0143;
if (TYPE == 1) goto L_0143;
if (TYPE == 2) goto L_0143;
goto U_1017;
L_0143:;
// 1722 arp == ar(nmin)
ARP = (struct ARFM *)/*?*/ &AR[NMIN - 1];
// 1723 k = arp_sub
K = ARP->SUB;
// 1724 arp_sub = k>>2
ARP->SUB = (unsigned int)K >> 2;
// 1725 k = k&3
K = K & 3;
// 1726 ! 1 = check integer
// 1727 ! 2 = check real
// 1728 ! 3 = check real + int
// 1729 ->more %if k = 0; ! 0 = no action
if (K != 0) goto L_0144;
goto U_1008;
L_0144:;
// 1730 %if k = 1 %start
if (K != 1) goto L_0145;
// 1731 force = integer
FORCE = 1;
// 1732 ->more %if type = integer %or type = 0
if (TYPE == 1) goto L_0146;
if (TYPE != 0) goto L_0147;
L_0146:;
goto U_1008;
L_0147:;
// 1733 ->fail2
goto U_1017;
// 1734 %finish
L_0145:;
// 1735 ->fail2 %unless ptype = real %or ptype = 0; ! {or added?}
if (PTYPE == 2) goto L_0148;
if (PTYPE == 0) goto L_0148;
goto U_1017;
L_0148:;
// 1736 force = integer %if k = 3
if (K != 3) goto L_0149;
FORCE = 1;
L_0149:;
// 1737 ->more
goto U_1008;
// 1738 act(198): ! %OTHER
case_ACT_198:;
// 1739 k = gg>>8&15
K = (unsigned int)GG >> 8 & 15;
// 1740 %if k = 0 %start; ! restore atom
if (K != 0) goto L_014A;
// 1741 atom1 = last1
ATOM1 = LAST1;
// 1742 ->more
goto U_1008;
// 1743 %finish
L_014A:;
// 1744 %if k = 1 %start; ! test string
if (K != 1) goto L_014B;
// 1745 ->fail2 %unless type = stringv
if (TYPE == 3) goto L_014C;
goto U_1017;
L_014C:;
// 1746 ->more
goto U_1008;
// 1747 %finish
L_014B:;
// 1748 %if k = 2 %start; ! {fault record comparisons}
if (K != 2) goto L_014D;
// 1749 ->fail2 %if type = record
if (TYPE != 4) goto L_014E;
goto U_1017;
L_014E:;
// 1750 ->more
goto U_1008;
// 1751 %finish
L_014D:;
// 1752 %if k = 3 %start; ! check OWN variable coming
if (K != 3) goto L_014F;
// 1753 code atom(0)
CODEATOM(0);
// 1754 ->A7 %if atom flags&own bit = 0
if (ATOMFLAGS & 512 != 0) goto L_0150;
goto U_1019;
L_0150:;
// 1755 ->more
goto U_1008;
// 1756 %finish
L_014F:;
// 1757 for warn = pos1 %if x <= local; ! %for TEST
if (X > LOCAL) goto L_0151;
FORWARN = POS1;
L_0151:;
// 1758 ->more
goto U_1008;
// 1759 paction(1): %if type = record %then g = phrase(242) %else pformat = -1; ->a3
case_PACTION_1:;
if (TYPE != 4) goto L_0153;
G = PHRASE[42];
goto L_0154;
L_0153:;
PFORMAT = -1;
L_0154:;
goto U_100A;
// 1760 paction(2): ptype = real; pformat = -1; ->a3
case_PACTION_2:;
PTYPE = 2;
PFORMAT = -1;
goto U_100A;
// 1761 paction(3): ptype = stringv; pformat = -1; ->a3
case_PACTION_3:;
PTYPE = 3;
PFORMAT = -1;
goto U_100A;
// 1762 paction(4): ptype = integer; pformat = -1; ->a3
case_PACTION_4:;
PTYPE = 1;
PFORMAT = -1;
goto U_100A;
// 1763 paction(5): ->a3 %if ptype = integer
case_PACTION_5:;
if (PTYPE != 1) goto L_0155;
goto U_100A;
L_0155:;
// 1764 g = phrase(212) %and pformat=-1 %if ptype = real
if (PTYPE != 2) goto L_0156;
G = PHRASE[12];
PFORMAT = -1;
L_0156:;
// 1765 g = phrase(213) %if ptype = stringv
if (PTYPE != 3) goto L_0157;
G = PHRASE[13];
L_0157:;
// 1766 ->a3
goto U_100A;
// 1767 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;
// 1768 paction(7): ptype=real %if ptype = integer; pformat = -1; ->a3
case_PACTION_7:;
if (PTYPE != 1) goto L_0158;
PTYPE = 2;
L_0158:;
PFORMAT = -1;
goto U_100A;
// 1769
// 1770 a1: last1 = class; atom1 = 0; s = subatom
U_1015:;
LAST1 = CLASS;
ATOM1 = 0;
S = SUBATOM;
// 1771 a2: %if gg&trans bit = 0 %start; ! insert into analysis record
U_101A:;
if (GG & 16384 != 0) goto L_0159;
// 1772 z == node
Z = (int *)/*?*/ &NODE;
// 1773 %cycle; ! insert cell in order
L_015A:;
// 1774 k = z
K = *Z;
// 1775 %exit %if gg&order bits = 0 %or k = 0
if (GG & 12288 == 0) goto L_015B;
if (K != 0) goto L_015C;
L_015B:;
goto L_015D;
L_015C:;
// 1776 gg = gg-order bit; z == ar(k)_link
GG = GG - 4096;
Z = (int *)/*?*/ &AR[K - 1].LINK;
// 1777 %repeat
goto L_015A;
L_015D:;
// 1778 gg = map gg %if map gg # 0 %and gg&255 = var
if (MAPGG == 0) goto L_015E;
if (GG & 255 != 91) goto L_015E;
GG = MAPGG;
L_015E:;
// 1779 nmin = nmin-1; ->fail0 %if nmin = nmax
NMIN = NMIN - 1;
if (NMIN != NMAX) goto L_015F;
goto U_100D;
L_015F:;
// 1780 z = nmin
*Z = NMIN;
// 1781 arp == ar(nmin)
ARP = (struct ARFM *)/*?*/ &AR[NMIN - 1];
// 1782 arp_sub = s; arp_class = (gg&255)!mark
ARP->SUB = S;
ARP->CLASS = GG & 255 | MARK;
// 1783 arp_link = k
ARP->LINK = K;
// 1784 %finish
L_0159:;
// 1785 mark = 0; map gg = 0
MARK = 0;
MAPGG = 0;
// 1786 more: g = glink(g); ! chain down the grammar
U_1008:;
G = GLINK[G];
// 1787 paction(0):
case_PACTION_0:;
// 1788 a3: gg = gram(g); class = gg&255
U_100A:;
GG = GRAM[G];
CLASS = GG & 255;
// 1789 trace analysis %if diag&1 # 0
if (DIAG & 1 == 0) goto L_0160;
TRACEANALYSIS();
L_0160:;
// 1790 ->a5 %if class = 0; ! end of phrase
if (CLASS != 0) goto L_0161;
goto U_100E;
L_0161:;
// 1791
// 1792 %if class < actions %start; ! not a phrase or an action
if (CLASS >= 180) goto L_0162;
// 1793 class = atomic(class) %if class >= figurative
if (CLASS < 130) goto L_0163;
CLASS = ATOMIC[CLASS - 130];
L_0163:;
// 1794 ->a2 %if class >= manifest
if (CLASS < 120) goto L_0164;
goto U_101A;
L_0164:;
// 1795 code atom(class) %if atom1 = 0
if (ATOM1 != 0) goto L_0165;
CODEATOM(CLASS);
L_0165:;
// 1796 %if escape class # 0 %start; ! escape to new grammar
if (ESCAPECLASS == 0) goto L_0166;
// 1797 class = escape class; escape class = 0
CLASS = ESCAPECLASS;
ESCAPECLASS = 0;
// 1798 g = g+escape
G = G + 4096;
// 1799
// 1800 ! note that following an escape the next item is
// 1801 ! forced to be transparent!
// 1802
// 1803 esc: gg = 0
U_100F:;
GG = 0;
// 1804 arp == ar(nmax+1)
ARP = (struct ARFM *)/*?*/ &AR[NMAX + 1 - 1];
// 1805 arp_papp = papp; arp_x = x; ->a4
ARP->PAPP = PAPP;
ARP->X = X;
goto U_1010;
// 1806 %finish
L_0166:;
// 1807
// 1808 ->a1 %if class = atom1 %or class = atom2
if (CLASS == ATOM1) goto L_0167;
if (CLASS != ATOM2) goto L_0168;
L_0167:;
goto U_1015;
L_0168:;
// 1809
// 1810 a7: ->fail1 %if gg >= 0; ! no alternative
U_1019:;
if (GG < 0) goto L_0169;
goto U_1009;
L_0169:;
// 1811 g = g+1
G = G + 1;
// 1812 ->a3
goto U_100A;
// 1813 %finish
L_0162:;
// 1814
// 1815 %if class >= phrasal %start; ! a phrase
if (CLASS < 200) goto L_016A;
// 1816 a4: nmax = nmax+1; ->fail0 %if nmax = nmin
U_1010:;
NMAX = NMAX + 1;
if (NMAX != NMIN) goto L_016B;
goto U_100D;
L_016B:;
// 1817 arp == ar(nmax)
ARP = (struct ARFM *)/*?*/ &AR[NMAX - 1];
// 1818 arp_ptype = ptype
ARP->PTYPE = PTYPE;
// 1819 arp_pos = pos1
ARP->POS = POS1;
// 1820 arp_pformat = pformat
ARP->PFORMAT = PFORMAT;
// 1821 arp_link = gentype
ARP->LINK = GENTYPE;
// 1822 arp_class = node
ARP->CLASS = NODE;
// 1823 arp_sub = g
ARP->SUB = G;
// 1824 node = 0
NODE = 0;
// 1825 g = phrase(class)
G = PHRASE[CLASS - 200];
// 1826 ptype = force %and force = 0 %if force # 0
if (FORCE == 0) goto L_016C;
PTYPE = FORCE;
FORCE = 0;
L_016C:;
// 1827 gentype = 0
GENTYPE = 0;
// 1828 ->paction(gg>>8&15)
PACTION_line = __LINE__;
PACTION_file = __FILE__;
PACTION_index = (unsigned int)GG >> 8 & 15;
goto case_PACTION_dispatch;
// 1829 %finish
L_016A:;
// 1830 ->act(class); ! only actions left
ACT_line = __LINE__;
ACT_file = __FILE__;
ACT_index = CLASS;
goto case_ACT_dispatch;
// 1831
// 1832 a5: ;! reverse links
U_100E:;
// 1833 s = 0
S = 0;
// 1834 %while node # 0 %cycle
L_016D:;
if (NODE == 0) goto L_016E;
// 1835 z == ar(node)_link
Z = (int *)/*?*/ &AR[NODE - 1].LINK;
// 1836 k = z; z = s; s = node; node = k
K = *Z;
*Z = S;
S = NODE;
NODE = K;
// 1837 %repeat
goto L_016D;
L_016E:;
// 1838 ss = s
SS = S;
// 1839 a6: %if nmax # 0 %start
U_1011:;
if (NMAX == 0) goto L_016F;
// 1840 k = gentype; ! type of phrase
K = GENTYPE;
// 1841 arp == ar(nmax); nmax = nmax-1
ARP = (struct ARFM *)/*?*/ &AR[NMAX - 1];
NMAX = NMAX - 1;
// 1842 node = arp_class
NODE = ARP->CLASS;
// 1843 gentype = arp_link
GENTYPE = ARP->LINK;
// 1844 ptype = arp_ptype
PTYPE = ARP->PTYPE;
// 1845 pformat = arp_pformat
PFORMAT = ARP->PFORMAT;
// 1846 g = arp_sub
G = ARP->SUB;
// 1847 %if g&escape # 0 %start
if (G & 4096 == 0) goto L_0170;
// 1848 g = g-escape
G = G - 4096;
// 1849 papp = arp_papp
PAPP = ARP->PAPP;
// 1850 mark = 255
MARK = 255;
// 1851 subatom = s
SUBATOM = S;
// 1852 ->a3
goto U_100A;
// 1853 %finish
L_0170:;
// 1854 gentype = k %if gentype = 0 %or k = real
if (GENTYPE == 0) goto L_0171;
if (K != 2) goto L_0172;
L_0171:;
GENTYPE = K;
L_0172:;
// 1855 type = gen type
TYPE = GENTYPE;
// 1856
// 1857 k = gg; ! exit-point code
K = GG;
// 1858 %cycle
L_0173:;
// 1859 gg = gram(g)
GG = GRAM[G];
// 1860 ->a2 %if k = 0
if (K != 0) goto L_0174;
goto U_101A;
L_0174:;
// 1861 ->fail1 %if gg >= 0; ! no alternative phrase
if (GG < 0) goto L_0175;
goto U_1009;
L_0175:;
// 1862 k = k-order bit
K = K - 4096;
// 1863 g = g+1; ! sideways step
G = G + 1;
// 1864 %repeat
goto L_0173;
// 1865 %finish
L_016F:;
// 1866
// 1867 Fault(4) %if copy # 0
if (COPY == 0) goto L_0176;
FAULT(4);
L_0176:;
// 1868 fault(13) %if order = 0
if (ORDER != 0) goto L_0177;
FAULT(13);
L_0177:;
// 1869 fault(-4) %if for warn # 0
if (FORWARN == 0) goto L_0178;
FAULT(-4);
L_0178:;
// 1870 pos1 = 0
POS1 = 0;
// 1871 fault rate = fault rate-1
FAULTRATE = FAULTRATE - 1;
// 1872 %return
return;
// 1873
// 1874 act(193): gg = 0 %and ->a5 %unless sym = '=' %or sym = '<'; ! cdummy
case_ACT_193:;
if (SYM == 61) goto L_0179;
if (SYM == 60) goto L_0179;
GG = 0;
goto U_100E;
L_0179:;
// 1875 act(181): atom1 = amap(decl&15); ! dummy
case_ACT_181:;
ATOM1 = AMAP[DECL & 15];
// 1876 ->more
goto U_1008;
// 1877
// 1878 act(182): class = escdec; g = glink(g)!escape; ! an example of ! as an operator
case_ACT_182:;
CLASS = 252;
G = GLINK[G] | 4096;
// 1879 decl = 0; otype = 0; ->esc; ! decl
DECL = 0;
OTYPE = 0;
goto U_100F;
// 1880
// 1881 act(199): ; ! compile
case_ACT_199:;
// 1882 s = 0
S = 0;
// 1883 %while node # 0 %cycle
L_017A:;
if (NODE == 0) goto L_017B;
// 1884 z == ar(node)_link
Z = (int *)/*?*/ &AR[NODE - 1].LINK;
// 1885 k = z; z = s; s = node; node = k
K = *Z;
*Z = S;
S = NODE;
NODE = K;
// 1886 %repeat
goto L_017A;
L_017B:;
// 1887 ss = s
SS = S;
// 1888
// 1889 code atom(28) %if quote # 0; ! expend
if (QUOTE == 0) goto L_017C;
CODEATOM(28);
L_017C:;
// 1890 compile; ->more %if atom1&error = 0
COMPILE();
if (ATOM1 & 32768 != 0) goto L_017D;
goto U_1008;
L_017D:;
// 1891 ->fail1
goto U_1009;
// 1892
// 1893 act(184): ->fail4 %unless type = integer
case_ACT_184:;
if (TYPE == 1) goto L_017E;
goto U_1012;
L_017E:;
// 1894 %if subatom < 0 %then lit = tag(-subatom)_format %else lit = lit pool(subatom)
if (SUBATOM >= 0) goto L_017F;
LIT = TAG[-SUBATOM].FORMAT;
goto L_0180;
L_017F:;
LIT = LITPOOL[SUBATOM];
L_0180:;
// 1895 ->fail4 %if lit # 0
if (LIT == 0) goto L_0181;
goto U_1012;
L_0181:;
// 1896 ->more
goto U_1008;
// 1897 act(185): ; ! apply parameters
case_ACT_185:;
// 1898 s = 0
S = 0;
// 1899 %while node # 0 %cycle
L_0182:;
if (NODE == 0) goto L_0183;
// 1900 z == ar(node)_link
Z = (int *)/*?*/ &AR[NODE - 1].LINK;
// 1901 k = z; z = s; s = node; node = k
K = *Z;
*Z = S;
S = NODE;
NODE = K;
// 1902 %repeat
goto L_0182;
L_0183:;
// 1903 ss = s
SS = S;
// 1904
// 1905 atom1 = ar(s)_class; atom2 = 0
ATOM1 = AR[S - 1].CLASS;
ATOM2 = 0;
// 1906 atom1 = var %if atom1 = 97 %or atom1 = 98
if (ATOM1 == 97) goto L_0184;
if (ATOM1 != 98) goto L_0185;
L_0184:;
ATOM1 = 91;
L_0185:;
// 1907 arp == ar(nmax)
ARP = (struct ARFM *)/*?*/ &AR[NMAX - 1];
// 1908 x = arp_x
X = ARP->X;
// 1909 pos1 = arp_pos
POS1 = ARP->POS;
// 1910 pos2 = 0
POS2 = 0;
// 1911 app = 0
APP = 0;
// 1912 format = tag(x)_format
FORMAT = TAG[X].FORMAT;
// 1913 flags = tag(x)_flags
FLAGS = TAG[X].FLAGS;
// 1914 type = flags>>4&7
TYPE = (unsigned int)FLAGS >> 4 & 7;
// 1915 protection = flags&prot
PROTECTION = FLAGS & 256;
// 1916 protection = 0 %if flags&aname # 0
if (FLAGS & 1024 == 0) goto L_0186;
PROTECTION = 0;
L_0186:;
// 1917
// 1918 %if flags&subname # 0 %and format # 0 %start
if (FLAGS & 2048 == 0) goto L_0187;
if (FORMAT == 0) goto L_0187;
// 1919 ->fail1 %if format selected = 0
if (FORMATSELECTED() != 0) goto L_0188;
goto U_1009;
L_0188:;
// 1920 %finish
L_0187:;
// 1921
// 1922 ->a6
goto U_1011;
// 1923
// 1924 act(187): protection = prot; ->more; ! %SETPROT
case_ACT_187:;
PROTECTION = 256;
goto U_1008;
// 1925 act(186): ->More %if protection&prot = 0
case_ACT_186:;
if (PROTECTION & 256 != 0) goto L_0189;
goto U_1008;
L_0189:;
// 1926 prot err = nmin
PROTERR = NMIN;
// 1927 ->A7
goto U_1019;
// 1928 act(191): k = protection; ! %GUARD
case_ACT_191:;
K = PROTECTION;
// 1929 code atom(0)
CODEATOM(0);
// 1930 protection = k %if atom flags&aname = 0
if (ATOMFLAGS & 1024 != 0) goto L_018A;
PROTECTION = K;
L_018A:;
// 1931 ->more
goto U_1008;
// 1932
// 1933 act(192): ->fail1 %if parsed machine code=0
case_ACT_192:;
if (PARSEDMACHINECODE() != 0) goto L_018B;
goto U_1009;
L_018B:;
// 1934 ->more
goto U_1008;
// 1935
// 1936 act(189): k = gapp; ! %GAPP
case_ACT_189:;
K = GAPP();
// 1937 delete names(1)
DELETENAMES(1);
// 1938 tmax = tbase; tbase = gram (gmin); ! restore tmax
TMAX = TBASE;
TBASE = GRAM[GMIN];
// 1939 local= tbase
LOCAL = TBASE;
// 1940 gmin = gmin+1
GMIN = GMIN + 1;
// 1941
// 1942 x = ar(ar(nmax)_class)_sub
X = AR[AR[NMAX - 1].CLASS - 1].SUB;
// 1943 tag(x)_app = k; ! update app
TAG[X].APP = K;
// 1944 ->more
goto U_1008;
// 1945
// 1946 act(190): gmin = gmin-1; ! %LOCAL
case_ACT_190:;
GMIN = GMIN - 1;
// 1947 abandon(2) %if gmin <= gmax
if (GMIN > GMAX) goto L_018C;
ABANDON(2);
L_018C:;
// 1948 gram (gmin) = tbase; tbase = tmax
GRAM[GMIN] = TBASE;
TBASE = TMAX;
// 1949 local = tbase
LOCAL = TBASE;
// 1950 ->more
goto U_1008;
// 1951
// 1952 ! errors
// 1953
// 1954 fail4: k = error+10; ->failed; ! *size
U_1012:;
K = 32768 + 10;
goto U_1013;
// 1955 fail3: k = error+7; ->failed; ! *context
U_1018:;
K = 32768 + 7;
goto U_1013;
// 1956 fail2: k = error+5; pos2 = 0; ->failed; ! *type
U_1017:;
K = 32768 + 5;
POS2 = 0;
goto U_1013;
// 1957 fail0: k = error+3; ->failed; ! *too complex
U_100D:;
K = 32768 + 3;
goto U_1013;
// 1958 fail1: k = atom1; pos2 = 0
U_1009:;
K = ATOM1;
POS2 = 0;
// 1959 failed: %if diag&32 # 0 %start
U_1013:;
if (DIAG & 32 == 0) goto L_018D;
// 1960 printstring("Atom1 ="); write(atom1, 3)
_imp_PRINTSTRING(_imp_str_literal("Atom1 ="));
_imp_WRITE(ATOM1, 3);
// 1961 printstring(" Atom2 ="); write(atom2, 3)
_imp_PRINTSTRING(_imp_str_literal(" Atom2 ="));
_imp_WRITE(ATOM2, 3);
// 1962 printstring(" subatom ="); write(subatom, 3); newline
_imp_PRINTSTRING(_imp_str_literal(" subatom ="));
_imp_WRITE(SUBATOM, 3);
_imp_NEWLINE();
// 1963 printstring("Type ="); write(type, 1)
_imp_PRINTSTRING(_imp_str_literal("Type ="));
_imp_WRITE(TYPE, 1);
// 1964 printstring(" Ptype ="); write(ptype, 1); newline
_imp_PRINTSTRING(_imp_str_literal(" Ptype ="));
_imp_WRITE(PTYPE, 1);
_imp_NEWLINE();
// 1965 printstring("App ="); write(app, 1)
_imp_PRINTSTRING(_imp_str_literal("App ="));
_imp_WRITE(APP, 1);
// 1966 printstring(" Papp ="); write(papp, 1); newline
_imp_PRINTSTRING(_imp_str_literal(" Papp ="));
_imp_WRITE(PAPP, 1);
_imp_NEWLINE();
// 1967 printstring("Format ="); write(format, 1)
_imp_PRINTSTRING(_imp_str_literal("Format ="));
_imp_WRITE(FORMAT, 1);
// 1968 printstring(" Pformat ="); write(pformat, 1); newline
_imp_PRINTSTRING(_imp_str_literal(" Pformat ="));
_imp_WRITE(PFORMAT, 1);
_imp_NEWLINE();
// 1969 !%signal 13,15
// 1970 %finish
L_018D:;
// 1971
// 1972 quote = 0 %and readsym %while sym # nl %and sym # ';'
L_018E:;
if (SYM == 10) goto L_018F;
if (SYM == 59) goto L_018F;
QUOTE = 0;
READSYM();
goto L_018E;
L_018F:;
// 1973 %if k&error # 0 %start
if (K & 32768 == 0) goto L_0190;
// 1974 fault(k&255)
FAULT(K & 255);
// 1975 %finish %else %start
goto L_0191;
L_0190:;
// 1976 %if prot err = nmin %then fault(14) %else fault(0)
if (PROTERR != NMIN) goto L_0192;
FAULT(14);
goto L_0193;
L_0192:;
FAULT(0);
L_0193:;
// 1977 %finish
L_0191:;
// 1978 gg = 0; ss = 0; symtype = 0
GG = 0;
SS = 0;
SYMTYPE = 0;
// 1979 %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 */
// 1980
// 1981 %routine compile
void COMPILE(void) {
// 1982 %constinteger then = 4, else = 8, loop = 16
// 1983
// 1984 %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};
// 1985
// 1986 %constbyteintegerarray operator(1:14) = '[', ']', 'X', '/', '&', '!', '%', '+', '-', '*', 'Q', 'x', '.', 'v'
const unsigned char OPERATOR[14] = {91, 93, 88, 47, 38, 33, 37, 43, 45, 42, 81, 120, 46, 118};
struct _imp_dv OPERATOR_dv = {OPERATOR, sizeof(unsigned char) /*, dims, <bounds> */};
// 1987 %constbyteintegerarray cc(0 : 7) = '#','=',')','<','(','>', 'k','t'
const unsigned char CC[8] = {35, 61, 41, 60, 40, 62, 107, 116};
struct _imp_dv CC_dv = {CC, sizeof(unsigned char) /*, dims, <bounds> */};
// 1988 %constbyteintegerarray anyform(0:15) = 1,0,1,1,1,1,1,1,0,1,1,0,1,1,1,1
const unsigned char ANYFORM[16] = {1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 1, 1, 1, 1};
struct _imp_dv ANYFORM_dv = {ANYFORM, sizeof(unsigned char) /*, dims, <bounds> */};
// 1989
// 1990 %constintegerarray decmap(0:15) = %c
const int DECMAP[16] = {1, 2, 4107, 4109, 5132, 5134, 3, 4, 4103, 4104, 4105, 4106, 6, 0, 0, 0};
struct _imp_dv DECMAP_dv = {DECMAP, sizeof(int) /*, dims, <bounds> */};
// 1991+ 1, 2,
// 1992+ 16_100B, 16_100D, 16_140C, 16_140E,
// 1993+ 3, 4,
// 1994+ 16_1007, 16_1008, 16_1009, 16_100A,
// 1995+ 6, 0, 0, 0
// 1996 %ownbyteintegerarray cnest(0:15)
static unsigned char CNEST[16];
struct _imp_dv CNEST_dv = {CNEST, sizeof(unsigned char) /*, dims, <bounds> */};
// 1997 %integer lmode, clab, dupid
int LMODE;
int CLAB;
int DUPID;
// 1998 %integer resln
int RESLN;
// 1999 %owninteger last def = 0
static int LASTDEF = 0;
// 2000 %owninteger lb, ub
static int LB;
static int UB;
// 2001 %integer cp, ord
int CP;
int ORD;
// 2002 %integer next, link, j, k, n, done
int NEXT;
int LINK;
int J;
int K;
int N;
int DONE;
// 2003 %integer class
int CLASS;
// 2004 %integer lit2, defs, decs, cident
int LIT2;
int DEFS;
int DECS;
int CIDENT;
// 2005 %integer pending; %ownintegerarray pstack(1:40)
int PENDING;
static int PSTACK[40];
struct _imp_dv PSTACK_dv = {PSTACK, sizeof(int) /*, dims, <bounds> */};
// 2006 %ownstring(8) name = ""
static _imp_string8 NAME = _imp_str_init("");
// 2007 %owninteger count = 0
static int COUNT = 0;
// 2008
// 2009 %routine def lab(%integer l)
void DEFLAB(int L) {
// 2010 op(':', l)
OP(58, L);
// 2011 access = 1
ACCESS = 1;
// 2012 %end
return;
} /* end of DEFLAB */
// 2013
// 2014 %routine get next
void GETNEXT(void) {
// 2015 %record(arfm)%name p
struct ARFM *P;
// 2016 gn: %if next = 0 %start; ! end of phrase
U_1011:;
if (NEXT != 0) goto L_0194;
// 2017 class = 0 %and %return %if link = 0; ! end of statement
if (LINK != 0) goto L_0195;
CLASS = 0;
return;
L_0195:;
// 2018 p == ar(link)
P = (struct ARFM *)/*?*/ &AR[LINK - 1];
// 2019 next = p_link
NEXT = P->LINK;
// 2020 link = p_sub
LINK = P->SUB;
// 2021 %finish
L_0194:;
// 2022 %cycle
L_0196:;
// 2023 p == ar(next)
P = (struct ARFM *)/*?*/ &AR[NEXT - 1];
// 2024 x = p_sub
X = P->SUB;
// 2025 class = p_class
CLASS = P->CLASS;
// 2026 %exit %if class < actions; ! an atom
if (CLASS >= 180) goto L_0197;
goto L_0198;
L_0197:;
// 2027 %if x = 0 %start; ! null phrase
if (X != 0) goto L_0199;
// 2028 next = p_link; ->gn
NEXT = P->LINK;
goto U_1011;
// 2029 %finish
L_0199:;
// 2030 %if p_link # 0 %start; ! follow a phrase
if (P->LINK == 0) goto L_019A;
// 2031 p_sub = link; link = next
P->SUB = LINK;
LINK = NEXT;
// 2032 %finish
L_019A:;
// 2033 next = x
NEXT = X;
// 2034 %repeat
goto L_0196;
L_0198:;
// 2035 next = p_link
NEXT = P->LINK;
// 2036 %if diag&2 # 0 %start
if (DIAG & 2 == 0) goto L_019B;
// 2037 spaces(8-length(name)) %unless length(name) = 0
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &NAME) == 0) goto L_019C;
_imp_SPACES(8 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &NAME));
L_019C:;
// 2038 name = text(class)
/* clang-format off */
_imp_strncpy(/*?*/&NAME, ({__typeof__(_imp_string8) tmp;/*B*/ tmp = TEXT[CLASS]; (void *)&tmp;}), /*max:*/8);
/* clang-format on */
// 2039 write(x, 2)
_imp_WRITE(X, 2);
// 2040 space
_imp_SPACE();
// 2041 printstring(name)
_imp_PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string8) tmp = NAME/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 2042 space
_imp_SPACE();
// 2043 count = count-1
COUNT = COUNT - 1;
// 2044 %if count <= 0 %start
if (COUNT > 0) goto L_019D;
// 2045 count = 5
COUNT = 5;
// 2046 name = ""
/* clang-format off */
_imp_strncpy(/*?*/&NAME, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/8);
/* clang-format on */
// 2047 newline
_imp_NEWLINE();
// 2048 %finish
L_019D:;
// 2049 %finish
L_019B:;
// 2050 %end
return;
} /* end of GETNEXT */
// 2051
// 2052 %routine set subs(%integer n)
void SETSUBS(int N) {
// 2053 !update the app field in n array descriptors
// 2054 %integer p
int P;
// 2055 p = tmax
P = TMAX;
// 2056 %while n > 0 %cycle
L_019E:;
if (N <= 0) goto L_019F;
// 2057 !%signal 15,15 %if p < tbase
// 2058 tag(p)_app = dimension
TAG[P].APP = DIMENSION;
// 2059 p = p-1; n = n-1
P = P - 1;
N = N - 1;
// 2060 %repeat
goto L_019E;
L_019F:;
// 2061 %end
return;
} /* end of SETSUBS */
// 2062
// 2063 %routine set bp
void SETBP(void) {
// 2064 !define a constant bound pair from the last stacked constants
// 2065 pending = pending-2
PENDING = PENDING - 2;
// 2066 lb = pstack(pending+1); ub = pstack(pending+2)
LB = PSTACK[PENDING + 1 - 1];
UB = PSTACK[PENDING + 2 - 1];
// 2067 %if ub-lb+1 < 0 %start
if (UB - LB + 1 >= 0) goto L_01A0;
// 2068 pos1 = 0; next = link; fault(11)
POS1 = 0;
NEXT = LINK;
FAULT(11);
// 2069 ub = lb
UB = LB;
// 2070 %finish
L_01A0:;
// 2071 set const(lb); set const(ub)
SETCONST(LB);
SETCONST(UB);
// 2072 add char( 'b' ) %unless class = 146
if (CLASS == 146) goto L_01A1;
ADDCHAR(98);
L_01A1:;
// 2073 %end
return;
} /* end of SETBP */
// 2074
// 2075 %routine compile end(%integer type)
void COMPILEEND(int TYPE) {
// 2076 ! type = 0:eof, 1:eop, 2:end
// 2077 %if access # 0 %start
if (ACCESS == 0) goto L_01A2;
// 2078 open = 0
OPEN = 0;
// 2079 fault(19) %if block form > proc; ! can reach end
if (BLOCKFORM <= 7) goto L_01A3;
FAULT(19);
L_01A3:;
// 2080 %finish
L_01A2:;
// 2081
// 2082 %while dict(dmin) >= 0 %cycle; ! finishes & repeats
L_01A4:;
if (DICT[DMIN - 1] < 0) goto L_01A5;
// 2083 fault(17+dict(dmin)&1)
FAULT(17 + (DICT[DMIN - 1] & 1));
// 2084 dmin = dmin+1
DMIN = DMIN + 1;
// 2085 %repeat
goto L_01A4;
L_01A5:;
// 2086 !{delete names(0)}
// 2087 add char( ';' )
ADDCHAR(59);
// 2088 add char( ';' ) %if type = 1; ! endofprogram
if (TYPE != 1) goto L_01A6;
ADDCHAR(59);
L_01A6:;
// 2089
// 2090 bflags = bflags!open; ! show if it returns
*BFLAGS = *BFLAGS | OPEN;
// 2091
// 2092 def lab(0) %if block tag # 0 %and level # 1; ! for jump around
if (BLOCKTAG == 0) goto L_01A7;
if (LEVEL == 1) goto L_01A7;
DEFLAB(0);
L_01A7:;
// 2093 %if type # 2 %start; ! eop, eof
if (TYPE == 2) goto L_01A8;
// 2094 fault(16) %if level # type; ! end missing
if (LEVEL == TYPE) goto L_01A9;
FAULT(16);
L_01A9:;
// 2095 %finish %else %start
goto L_01AA;
L_01A8:;
// 2096 %if level = 0 %start
if (LEVEL != 0) goto L_01AB;
// 2097 fault(15); ! spurious end
FAULT(15);
// 2098 %finish
L_01AB:;
// 2099 %finish
L_01AA:;
// 2100
// 2101 end mark = 11; !******Mouses specific******
ENDMARK = 11;
// 2102 %end
return;
} /* end of COMPILEEND */
// 2103
// 2104 %routine def(%integer p)
void DEF(int P) {
// 2105 !dump a descriptor
// 2106 %integer t, f, type
int T;
int F;
int TYPE;
// 2107 %record(tagfm)%name v
struct TAGFM *V;
// 2108 flush buffer( 1 ); ! flush if bp > 0
FLUSHBUFFER(1);
// 2109 defs = defs+1
DEFS = DEFS + 1;
// 2110 v == tag(p)
V = (struct TAGFM *)/*?*/ &TAG[P];
// 2111 t = 0
T = 0;
// 2112 %unless v_index < 0 %start; ! no index for subnames
if (V->INDEX < 0) goto L_01AC;
// 2113 id = id+1 %and v_index = id %if v_index = 0
if (V->INDEX != 0) goto L_01AD;
ID = ID + 1;
V->INDEX = ID;
L_01AD:;
// 2114 last def = v_index
LASTDEF = V->INDEX;
// 2115 t = last def
T = LASTDEF;
// 2116 %finish
L_01AC:;
// 2117 op('$', t)
OP(36, T);
// 2118 print ident(p, 1); ! output the name
PRINTIDENT(P, 1);
// 2119 t = v_flags
T = V->FLAGS;
// 2120 type = t
TYPE = T;
// 2121 type = type&(\(7<<4)) %if type&(7<<4) >= 6<<4;!routine & pred
if (TYPE & 7 << 4 < 6 << 4) goto L_01AE;
TYPE = TYPE & ~(7 << 4);
L_01AE:;
// 2122 op(',', type&2_1111111); ! type & form
OP(44, TYPE & 127);
// 2123 f = v_format
F = V->FORMAT;
// 2124 f = tag(f)_index %if t&16_70 = record<<4
if (T & 112 != 4 << 4) goto L_01AF;
F = TAG[F].INDEX;
L_01AF:;
// 2125 f = v_index %if f < 0
if (F >= 0) goto L_01B0;
F = V->INDEX;
L_01B0:;
// 2126 op(',', f); ! format
OP(44, F);
// 2127 f = otype+t>>4&2_1111000
F = OTYPE + ((unsigned int)T >> 4 & 120);
// 2128 f = f!8 %if class = 125; ! add spec from %DUP
if (CLASS != 125) goto L_01B1;
F = F | 8;
L_01B1:;
// 2129 dim = v_app; ! dimension
DIM = V->APP;
// 2130 dim = 0 %unless 0 < dim %and dim <= dim limit
if (0 >= DIM) goto L_01B2;
if (DIM <= 6) goto L_01B3;
L_01B2:;
DIM = 0;
L_01B3:;
// 2131 op(',', f+dim<<8); ! otype & spec & prot
OP(44, F + (DIM << 8));
// 2132 defs = 0 %if t¶meters = 0
if (T & 4096 != 0) goto L_01B4;
DEFS = 0;
L_01B4:;
// 2133 f = t&15
F = T & 15;
// 2134 %if v_flags&spec # 0 %start
if (V->FLAGS & 128 == 0) goto L_01B5;
// 2135 v_flags = v_flags&(\spec) %unless 3 <= f %and f <= 10
if (3 > F) goto L_01B6;
if (F <= 10) goto L_01B7;
L_01B6:;
V->FLAGS = V->FLAGS & (~128);
L_01B7:;
// 2136 ocount = -1; ! external specs have no constants
OCOUNT = -1;
// 2137 %finish
L_01B5:;
// 2138 dimension = 0
DIMENSION = 0;
// 2139 %if otype = 2 %and (f=2 %or f=12 %or f=14) %start
if (OTYPE != 2) goto L_01B8;
if (F == 2) goto L_01B9;
if (F == 12) goto L_01B9;
if (F != 14) goto L_01B8;
L_01B9:;
// 2140 v_flags = v_flags-1; ! convert to simple
V->FLAGS = V->FLAGS - 1;
// 2141 %finish
L_01B8:;
// 2142 %end
return;
} /* end of DEF */
// 2143
// 2144 %routine def s lab(%integer n)
void DEFSLAB(int N) {
// 2145 ! define a switch label, x defines the switch tag
// 2146 %integer p, l, b, w, bit
int P;
int L;
int B;
int W;
int BIT;
// 2147 p = tag(x)_format; ! pointer to table
P = TAG[X].FORMAT;
// 2148 l = dict(p); ! lower bound
L = DICT[P - 1];
// 2149 %if l <= n %and n <= dict(p+1) %start
if (L > N) goto L_01BA;
if (N > DICT[P + 1 - 1]) goto L_01BA;
// 2150 b = n-l
B = N - L;
// 2151 w = b>>4+p
W = ((unsigned int)B >> 4) + P;
// 2152 bit = 1<<(b&15)
BIT = 1 << (B & 15);
// 2153 %if dict(w+2)&bit # 0 %start; ! already set
if (DICT[W + 2 - 1] & BIT == 0) goto L_01BB;
// 2154 fault(4) %if pending # 0
if (PENDING == 0) goto L_01BC;
FAULT(4);
L_01BC:;
// 2155 %return
return;
// 2156 %finish
L_01BB:;
// 2157 dict(w+2) = dict(w+2)!bit %if pending # 0
if (PENDING == 0) goto L_01BD;
DICT[W + 2 - 1] = DICT[W + 2 - 1] | BIT;
L_01BD:;
// 2158 set const(n)
SETCONST(N);
// 2159 op('_', tag(x)_index)
OP(95, TAG[X].INDEX);
// 2160 %finish %else %start
goto L_01BE;
L_01BA:;
// 2161 fault(12)
FAULT(12);
// 2162 %finish
L_01BE:;
// 2163 access = 1
ACCESS = 1;
// 2164 %end
return;
} /* end of DEFSLAB */
// 2165
// 2166 %routine call
void CALL(void) {
// 2167 %record(tagfm)%name T
struct TAGFM *T;
// 2168 t == tag(x)
T = (struct TAGFM *)/*?*/ &TAG[X];
// 2169 op('@', t_index)
OP(64, T->INDEX);
// 2170 access = 0 %if t_flags&closed # 0; ! never comes back
if (T->FLAGS & 16384 == 0) goto L_01BF;
ACCESS = 0;
L_01BF:;
// 2171 add char( 'E' ) %if t_app = 0; ! no parameters
if (T->APP != 0) goto L_01C0;
ADDCHAR(69);
L_01C0:;
// 2172 %end
return;
} /* end of CALL */
// 2173
// 2174 %routine pop def
void POPDEF(void) {
// 2175 set const(pstack(pending)); pending = pending-1
SETCONST(PSTACK[PENDING - 1]);
PENDING = PENDING - 1;
// 2176 %end
return;
} /* end of POPDEF */
// 2177
// 2178 %routine pop lit
void POPLIT(void) {
// 2179 %if pending = 0 %then lit = 0 %else %start
if (PENDING != 0) goto L_01C1;
LIT = 0;
goto L_01C2;
L_01C1:;
// 2180 lit = pstack(pending); pending = pending-1
LIT = PSTACK[PENDING - 1];
PENDING = PENDING - 1;
// 2181 %finish
L_01C2:;
// 2182 %end
return;
} /* end of POPLIT */
// 2183
// 2184 !conditions & jumps
// 2185 %routine push(%integer x)
void PUSH(int X) {
// 2186 %if cnest(cp)&2 # x %start
if (CNEST[CP] & 2 == X) goto L_01C3;
// 2187 cnest(cp) = cnest(cp)!1; x = x+4
CNEST[CP] = CNEST[CP] | 1;
X = X + 4;
// 2188 %finish
L_01C3:;
// 2189 clab = clab+1 %if cnest(cp)&1 # 0
if (CNEST[CP] & 1 == 0) goto L_01C4;
CLAB = CLAB + 1;
L_01C4:;
// 2190 cnest(cp+1) = x; cp = cp+1
CNEST[CP + 1] = X;
CP = CP + 1;
// 2191 %end
return;
} /* end of PUSH */
// 2192
// 2193 %routine pop label(%integer mode)
void POPLABEL(int MODE) {
// 2194 lmode = dict(dmin)
LMODE = DICT[DMIN - 1];
// 2195 %if lmode < 0 %or lmode&1 # mode %start
if (LMODE < 0) goto L_01C5;
if (LMODE & 1 == MODE) goto L_01C6;
L_01C5:;
// 2196 fault(mode+8)
FAULT(MODE + 8);
// 2197 %finish %else %start
goto L_01C7;
L_01C6:;
// 2198 dmin = dmin+1; label = label-3
DMIN = DMIN + 1;
LABEL = LABEL - 3;
// 2199 %finish
L_01C7:;
// 2200 %end
return;
} /* end of POPLABEL */
// 2201
// 2202 %if sstype < 0 %start; ! executable statement
if (SSTYPE >= 0) goto L_01C8;
// 2203 %if level = 0 %start; ! outermost level
if (LEVEL != 0) goto L_01C9;
// 2204 fault(13); ! *order
FAULT(13);
// 2205 %finish %else %start
goto L_01CA;
L_01C9:;
// 2206 %if access = 0 %start
if (ACCESS != 0) goto L_01CB;
// 2207 access = 1; fault(-1); ! only a warning
ACCESS = 1;
FAULT(-1);
// 2208 %finish
L_01CB:;
// 2209 %finish
L_01CA:;
// 2210 %finish
L_01C8:;
// 2211
// 2212 %if diag&2 # 0 %start
if (DIAG & 2 == 0) goto L_01CC;
// 2213 newline %if sym # nl
if (SYM == 10) goto L_01CD;
_imp_NEWLINE();
L_01CD:;
// 2214 printstring("ss =")
_imp_PRINTSTRING(_imp_str_literal("ss ="));
// 2215 write(ss, 1)
_imp_WRITE(SS, 1);
// 2216 newline
_imp_NEWLINE();
// 2217 count = 5
COUNT = 5;
// 2218 name = ""
/* clang-format off */
_imp_strncpy(/*?*/&NAME, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/8);
/* clang-format on */
// 2219 %finish
L_01CC:;
// 2220
// 2221 next = ss
NEXT = SS;
// 2222 pending = 0; lmode = 0
PENDING = 0;
LMODE = 0;
// 2223 link = 0; decs = 0
LINK = 0;
DECS = 0;
// 2224 defs = 0; resln = 0; done = 0
DEFS = 0;
RESLN = 0;
DONE = 0;
// 2225 ord = level
ORD = LEVEL;
// 2226 ord = 1 %if this >= 0; ! recordformat declarations
if (THIS < 0) goto L_01CE;
ORD = 1;
L_01CE:;
// 2227 c(0):
case_C_0:;
// 2228 top: %if next # link %start
U_101B:;
if (NEXT == LINK) goto L_01D0;
// 2229 get next; ->c(class)
GETNEXT();
C_line = __LINE__;
C_file = __FILE__;
C_index = CLASS;
goto case_C_dispatch;
// 2230 %finish
L_01D0:;
// 2231
// 2232 !all done, tidy up declarations and jumps
// 2233 newline %if diag&2 # 0 %and count # 5
if (DIAG & 2 == 0) goto L_01D1;
if (COUNT == 5) goto L_01D1;
_imp_NEWLINE();
L_01D1:;
// 2234
// 2235 %if lmode&(loop!then!else) # 0 %start; ! pending labels and jumps
if (LMODE & (16 | 4 | 8) == 0) goto L_01D2;
// 2236 op('B', label-1) %if lmode&loop # 0; ! repeat
if (LMODE & 16 == 0) goto L_01D3;
OP(66, LABEL - 1);
L_01D3:;
// 2237 def lab(label) %if lmode&then # 0; ! entry from then
if (LMODE & 4 == 0) goto L_01D4;
DEFLAB(LABEL);
L_01D4:;
// 2238 def lab(label-1) %if lmode&else # 0; ! entry from else
if (LMODE & 8 == 0) goto L_01D5;
DEFLAB(LABEL - 1);
L_01D5:;
// 2239 %finish
L_01D2:;
// 2240
// 2241 %return %if decs = 0
if (DECS != 0) goto L_01D6;
return;
L_01D6:;
// 2242 atom1 = error %and %return %if atom1 # 0; ! %integerroutine
if (ATOM1 == 0) goto L_01D7;
ATOM1 = 32768;
return;
L_01D7:;
// 2243 order = ord
ORDER = ORD;
// 2244 decl = decl&(\15)+decmap(decl&15); ! construct declarator flags
DECL = (DECL & (~15)) + DECMAP[DECL & 15];
// 2245 atom1 = atoms(decl&15); ! generate class
ATOM1 = ATOMS[DECL & 15];
// 2246 %if otype # 0 %start; ! own, const etc.
if (OTYPE == 0) goto L_01D8;
// 2247 atom1 = atom1+1 %if atom1 # proc
if (ATOM1 == 7) goto L_01D9;
ATOM1 = ATOM1 + 1;
L_01D9:;
// 2248 %if otype = 2 %start; ! const
if (OTYPE != 2) goto L_01DA;
// 2249 n = decl&15
N = DECL & 15;
// 2250 %if n&1 # 0 %start
if (N & 1 == 0) goto L_01DB;
// 2251 decl = decl!prot
DECL = DECL | 256;
// 2252 decl = decl!const bit %if decl&2_1111111 = iform
if (DECL & 127 != 17) goto L_01DC;
DECL = DECL | 8192;
L_01DC:;
// 2253 %finish
L_01DB:;
// 2254 %else
goto L_01DD;
L_01DA:;
// 2255 decl = decl!own bit
DECL = DECL | 512;
// 2256 %finish
L_01DD:;
// 2257 %finish
L_01D8:;
// 2258 sstype = 1 %if sstype = 0 %and atom1 = proc
if (SSTYPE != 0) goto L_01DE;
if (ATOM1 != 7) goto L_01DE;
SSTYPE = 1;
L_01DE:;
// 2259 atom1 = atom1+1 %if decl&spec # 0; ! onto spec variant
if (DECL & 128 == 0) goto L_01DF;
ATOM1 = ATOM1 + 1;
L_01DF:;
// 2260 ocount = 0 %and cont = '+' %if atom1 = 5; ! own array
if (ATOM1 != 5) goto L_01E0;
OCOUNT = 0;
CONT = 43;
L_01E0:;
// 2261 %if anyform(decl&15) = 0 %start; ! check meaningful
if (ANYFORM[DECL & 15] != 0) goto L_01E1;
// 2262 %if decl>>4&7 = record %start
if ((unsigned int)DECL >> 4 & 7 != 4) goto L_01E2;
// 2263 this = fdef %if tag(fdef)_flags&spec # 0
if (TAG[FDEF].FLAGS & 128 == 0) goto L_01E3;
THIS = FDEF;
L_01E3:;
// 2264 atom1 = error+21 %if fdef = this; ! *context for format
if (FDEF != THIS) goto L_01E4;
ATOM1 = 32768 + 21;
L_01E4:;
// 2265 %finish
L_01E2:;
// 2266 atom1 = error+10 %if fdef = 0; ! *size
if (FDEF != 0) goto L_01E5;
ATOM1 = 32768 + 10;
L_01E5:;
// 2267 %finish
L_01E1:;
// 2268 %return
return;
// 2269
// 2270 atop: access = 0; ->top
U_101C:;
ACCESS = 0;
goto U_101B;
// 2271 ! declarators
// 2272 c(88): ; ! rtype
case_C_88:;
// 2273 c(28): decl = x&(\7); ! stype
case_C_28:;
DECL = X & (~7);
// 2274 fdef = x&7; ! precision
FDEF = X & 7;
// 2275 fdef = reals ln %if x&2_1110001 = real<<4+1; ! convert to long
if (X & 113 != (2 << 4) + 1) goto L_01E6;
FDEF = REALSLN;
L_01E6:;
// 2276 decs = 1; ->top
DECS = 1;
goto U_101B;
// 2277 c(34): ; ! own
case_C_34:;
// 2278 c(35): otype = x; ord = 1; ->top; ! external
case_C_35:;
OTYPE = X;
ORD = 1;
goto U_101B;
// 2279 c(152): decl = decl+x<<1; ->top; ! xname
case_C_152:;
DECL = DECL + (X << 1);
goto U_101B;
// 2280 c(31): ; ! proc
case_C_31:;
// 2281 c(32): spec mode = level+1; ! fn/map
case_C_32:;
SPECMODE = LEVEL + 1;
// 2282 decl = decl!prot %if x = 9; ! function
if (X != 9) goto L_01E7;
DECL = DECL | 256;
L_01E7:;
// 2283 c(29): ord = 1; ! array
case_C_29:;
ORD = 1;
// 2284 dim = 0
DIM = 0;
// 2285 c(30): decl = decl+x; ! name
case_C_30:;
DECL = DECL + X;
// 2286 decs = 1
DECS = 1;
// 2287 ->top
goto U_101B;
// 2288 c(27): lit = 0; ! arrayd
case_C_27:;
LIT = 0;
// 2289 %if pending # 0 %start
if (PENDING == 0) goto L_01E8;
// 2290 pop lit
POPLIT();
// 2291 %unless 0<lit %and lit<=dim limit %start
if (0 >= LIT) goto L_01E9;
if (LIT <= 6) goto L_01EA;
L_01E9:;
// 2292 atom1 = error + 11; %return
ATOM1 = 32768 + 11;
return;
// 2293 %finish
L_01EA:;
// 2294 %finish
L_01E8:;
// 2295 dim = lit
DIM = LIT;
// 2296 decl = decl + x; decs = 1
DECL = DECL + X;
DECS = 1;
// 2297 -> top
goto U_101B;
// 2298 c(37): x = x!subname; ! record
case_C_37:;
X = X | 2048;
// 2299 c(36): lit = 0; ! string
case_C_36:;
LIT = 0;
// 2300 %if pending # 0 %start
if (PENDING == 0) goto L_01EB;
// 2301 pop lit
POPLIT();
// 2302 %unless 0 < lit %and lit <= 255 %start; ! max length wrong
if (0 >= LIT) goto L_01EC;
if (LIT <= 255) goto L_01ED;
L_01EC:;
// 2303 atom1 = error+10; %return
ATOM1 = 32768 + 10;
return;
// 2304 %finish
L_01ED:;
// 2305 %finish
L_01EB:;
// 2306 fdef = lit; ! format or length
FDEF = LIT;
// 2307 c(33): decl = x; ! switch
case_C_33:;
DECL = X;
// 2308 decs = 1
DECS = 1;
// 2309 ->top
goto U_101B;
// 2310 c(39): decl = decl!spec; ! spec
case_C_39:;
DECL = DECL | 128;
// 2311 ocount = -1; ! no initialisation
OCOUNT = -1;
// 2312 spec mode = -1
SPECMODE = -1;
// 2313 ->top
goto U_101B;
// 2314 c(38): decl = 64+4; ! recordformat (spec)
case_C_38:;
DECL = 64 + 4;
// 2315 order = 1
ORDER = 1;
// 2316 atom1 = x
ATOM1 = X;
// 2317 decl = decl!spec %if atom1 = 12; ! formatspec
if (ATOM1 != 12) goto L_01EE;
DECL = DECL | 128;
L_01EE:;
// 2318 fdef = tmax+1; ! format tag
FDEF = TMAX + 1;
// 2319 %return
return;
// 2320 c(175): id = id+1; tag(x)_index = id; %return; ! FSID
case_C_175:;
ID = ID + 1;
TAG[X].INDEX = ID;
return;
// 2321 c(41): decs = 1; decl = x!spec!closed; ->top; ! label
case_C_41:;
DECS = 1;
DECL = X | 128 | 16384;
goto U_101B;
// 2322 c(133): recid = 0; rbase = tmin-1; ! fname
case_C_133:;
RECID = 0;
RBASE = TMIN - 1;
// 2323 this = x
THIS = X;
// 2324 fm base = fdef; format list = tmin
FMBASE = FDEF;
FORMATLIST = TMIN;
// 2325 def(this); ->top
DEF(THIS);
goto U_101B;
// 2326 c(148): fdef = 0 %and ->top %if next = 0; ! reclb
case_C_148:;
if (NEXT != 0) goto L_01EF;
FDEF = 0;
goto U_101B;
L_01EF:;
// 2327 get next; ! skip name
GETNEXT();
// 2328 fdef = x
FDEF = X;
// 2329 ->top
goto U_101B;
// 2330
// 2331 c(127): add char( '}' ); ->top; ! %POUT
case_C_127:;
ADDCHAR(125);
goto U_101B;
// 2332 c(126): add char( '{' ); ->top; ! %PIN
case_C_126:;
ADDCHAR(123);
goto U_101B;
// 2333 c(174): set bp; ! rangerb
case_C_174:;
SETBP();
// 2334 c(171): ; ! fmlb
case_C_171:;
// 2335 c(172): ; ! fmrb
case_C_172:;
// 2336 c(173): add char( '~' )
case_C_173:;
ADDCHAR(126);
// 2337 add char( class-171+'A' ); ->top; ! fmor
ADDCHAR(CLASS - 171 + 65);
goto U_101B;
// 2338 c(168): rbase = -rbase; ! orrb
case_C_168:;
RBASE = -RBASE;
// 2339 sstype = 0; spec mode = 0
SSTYPE = 0;
SPECMODE = 0;
// 2340
// 2341 c(147): search base = 0; ! recrb
case_C_147:;
SEARCHBASE = 0;
// 2342 tag(this)_app = tmin
TAG[THIS].APP = TMIN;
// 2343 tag(this)_format = rbase
TAG[THIS].FORMAT = RBASE;
// 2344 ->top
goto U_101B;
// 2345
// 2346 c(45): add char( 'U' ) %if x = 36; ->top; ! sign
case_C_45:;
if (X != 36) goto L_01F0;
ADDCHAR(85);
L_01F0:;
goto U_101B;
// 2347 c(46): add char( '\' ); ->top; ! uop
case_C_46:;
ADDCHAR(92);
goto U_101B;
// 2348 c(47):; ! mod
case_C_47:;
// 2349 c(48):; ! dot
case_C_48:;
// 2350 c(42):; ! op1
case_C_42:;
// 2351 c(43):; ! op2
case_C_43:;
// 2352 c(44): add char( operator(x) ); ->top; ! op3
case_C_44:;
ADDCHAR(OPERATOR[X - 1]);
goto U_101B;
// 2353 c(56): ; ! and
case_C_56:;
// 2354 c(57): push(x); ->top; ! or
case_C_57:;
PUSH(X);
goto U_101B;
// 2355 c(58): cnest(cp) = cnest(cp)!!2; ->top; ! not
case_C_58:;
CNEST[CP] = CNEST[CP] ^ 2;
goto U_101B;
// 2356 c(138): x = 128+32+16+4; ! csep: treat like %while
case_C_138:;
X = 128 + 32 + 16 + 4;
// 2357 c(59): ; ! while
case_C_59:;
// 2358 c(60): %if class = 138 %then op('f', label-1) %else def lab(label-1); ! until
case_C_60:;
if (CLASS != 138) goto L_01F1;
OP(102, LABEL - 1);
goto L_01F2;
L_01F1:;
DEFLAB(LABEL - 1);
L_01F2:;
// 2359 c(166): ; ! runtil
case_C_166:;
// 2360 c(62): lmode = (lmode&(else!loop)) !(x>>3); ! cword
case_C_62:;
LMODE = LMODE & (8 | 16) | (unsigned int)X >> 3;
// 2361 clab = label; cp = 1; cnest(1) = x&7
CLAB = LABEL;
CP = 1;
CNEST[1] = X & 7;
// 2362 ->top
goto U_101B;
// 2363 c(72): pop label(0); ! repeat
case_C_72:;
POPLABEL(0);
// 2364 def lab(label+1) %if lmode&32 # 0; ->atop
if (LMODE & 32 == 0) goto L_01F3;
DEFLAB(LABEL + 1);
L_01F3:;
goto U_101C;
// 2365 c(69): pop label(1); ->top; ! finish
case_C_69:;
POPLABEL(1);
goto U_101B;
// 2366 c(163): ; ! xelse
case_C_163:;
// 2367 c(70): pop label(1); ! finish else ...
case_C_70:;
POPLABEL(1);
// 2368 fault(7) %if lmode&3 = 3; ! dangling else
if (LMODE & 3 != 3) goto L_01F4;
FAULT(7);
L_01F4:;
// 2369 c(68): lmode = (lmode&else)!3; ! ...else...
case_C_68:;
LMODE = LMODE & 8 | 3;
// 2370 %if access # 0 %start
if (ACCESS == 0) goto L_01F5;
// 2371 op('F', label-1); lmode = else!3
OP(70, LABEL - 1);
LMODE = 8 | 3;
// 2372 %finish
L_01F5:;
// 2373 def lab(label)
DEFLAB(LABEL);
// 2374 ->top %if next # 0
if (NEXT == 0) goto L_01F6;
goto U_101B;
L_01F6:;
// 2375 c(120): ; ! %MSTART
case_C_120:;
// 2376 c(67): ; ! start
case_C_67:;
// 2377 c(71): ; ! cycle
case_C_71:;
// 2378 stcy: def lab(label-1) %and lmode = loop %if lmode = 0; ! cycle
U_101D:;
if (LMODE != 0) goto L_01F7;
DEFLAB(LABEL - 1);
LMODE = 16;
L_01F7:;
// 2379 dmin = dmin-1; abandon(3) %if dmin <= dmax
DMIN = DMIN - 1;
if (DMIN > DMAX) goto L_01F8;
ABANDON(3);
L_01F8:;
// 2380 dict(dmin) = lmode
DICT[DMIN - 1] = LMODE;
// 2381 label = label+3
LABEL = LABEL + 3;
// 2382 %return
return;
// 2383
// 2384 c(64): fault(13) %if dict(dmin) >= 0 %or inhibit # 0; ! on event
case_C_64:;
if (DICT[DMIN - 1] >= 0) goto L_01F9;
if (INHIBIT == 0) goto L_01FA;
L_01F9:;
FAULT(13);
L_01FA:;
// 2385 inhibit = 1
INHIBIT = 1;
// 2386 n = 0
N = 0;
// 2387 n = 16_FFFF %if pending = 0; ! * = all events
if (PENDING != 0) goto L_01FB;
N = 65535;
L_01FB:;
// 2388 %while pending > 0 %cycle
L_01FC:;
if (PENDING <= 0) goto L_01FD;
// 2389 pop lit; fault(10) %if lit&(\15) # 0; ! too big
POPLIT();
if (LIT & (~15) == 0) goto L_01FE;
FAULT(10);
L_01FE:;
// 2390 j = 1<<lit
J = 1 << LIT;
// 2391 dubious = 1 %if n&j # 0
if (N & J == 0) goto L_01FF;
DUBIOUS = 1;
L_01FF:;
// 2392 n = n!j; ! construct bit mask
N = N | J;
// 2393 %repeat
goto L_01FC;
L_01FD:;
// 2394 op('o', n); op(',', label)
OP(111, N);
OP(44, LABEL);
// 2395 lmode = then!1; ->stcy
LMODE = 4 | 1;
goto U_101D;
// 2396
// 2397 c(104): op('J', tag(x)_index); ! l
case_C_104:;
OP(74, TAG[X].INDEX);
// 2398 inhibit = 1; ->atop
INHIBIT = 1;
goto U_101C;
// 2399 c(149): stats = stats-1; ! lab
case_C_149:;
STATS = STATS - 1;
// 2400 access = 1; inhibit = 1
ACCESS = 1;
INHIBIT = 1;
// 2401 op('L', tag(x)_index); ->top
OP(76, TAG[X].INDEX);
goto U_101B;
// 2402
// 2403 c(63): j = dmin; l = label-3; ! exit, continue
case_C_63:;
J = DMIN;
L = LABEL - 3;
// 2404 %cycle
L_0200:;
// 2405 fault(7) %and ->top %if dict(j) < 0
if (DICT[J - 1] >= 0) goto L_0201;
FAULT(7);
goto U_101B;
L_0201:;
// 2406 %exit %if dict(j)&1 = 0
if (DICT[J - 1] & 1 != 0) goto L_0202;
goto L_0203;
L_0202:;
// 2407 j = j+1; l = l-3
J = J + 1;
L = L - 3;
// 2408 %repeat
goto L_0200;
L_0203:;
// 2409 l = l+1 %if x = 32; ! continue
if (X != 32) goto L_0204;
L = L + 1;
L_0204:;
// 2410 op('F', l)
OP(70, L);
// 2411 dict(j) = dict(j)!x; ! show given
DICT[J - 1] = DICT[J - 1] | X;
// 2412 ->atop
goto U_101C;
// 2413
// 2414 c(50): add char( 'C' ); ->cop; ! acomp
case_C_50:;
ADDCHAR(67);
goto U_101E;
// 2415 c(49):
case_C_49:;
// 2416 %if next # 0 %start; ! comparator
if (NEXT == 0) goto L_0205;
// 2417 add char( '"' )
ADDCHAR(34);
// 2418 push(0); ! double sided
PUSH(0);
// 2419 %finish %else %start
goto L_0206;
L_0205:;
// 2420 add char( '?' )
ADDCHAR(63);
// 2421 %finish
L_0206:;
// 2422
// 2423 cop: x = x!!1 %if cnest(cp)&2 # 0; ! invert the condition
U_101E:;
if (CNEST[CP] & 2 == 0) goto L_0207;
X = X ^ 1;
L_0207:;
// 2424 j = cp; l = clab
J = CP;
L = CLAB;
// 2425 %while cnest(j)&4 = 0 %cycle
L_0208:;
if (CNEST[J] & 4 != 0) goto L_0209;
// 2426 j = j-1; l = l-cnest(j)&1
J = J - 1;
L = L - (CNEST[J] & 1);
// 2427 %repeat
goto L_0208;
L_0209:;
// 2428 op(cc(x), l)
OP(CC[X], L);
// 2429 def lab(clab+1) %if cnest(cp)&1 # 0
if (CNEST[CP] & 1 == 0) goto L_020A;
DEFLAB(CLAB + 1);
L_020A:;
// 2430 cp = cp-1
CP = CP - 1;
// 2431 clab = clab-cnest(cp)&1
CLAB = CLAB - (CNEST[CP] & 1);
// 2432 ->top
goto U_101B;
// 2433
// 2434 c(78): ; ! fresult
case_C_78:;
// 2435 c(79): ; ! mresult
case_C_79:;
// 2436 c(80): open = 0; ! return, true, false
case_C_80:;
OPEN = 0;
// 2437 c(82): access = 0; ! stop
case_C_82:;
ACCESS = 0;
// 2438 c(89): ; ! addop
case_C_89:;
// 2439 c(81): add char( x ); ->top; ! monitor
case_C_81:;
ADDCHAR(X);
goto U_101B;
// 2440 c(65): pop lit; op('e', lit); ->atop; ! signal
case_C_65:;
POPLIT();
OP(101, LIT);
goto U_101C;
// 2441 c(51): add char( 'S' ); ->top; ! eq
case_C_51:;
ADDCHAR(83);
goto U_101B;
// 2442 c(53): add char( 'j' ); ->top; ! jam transfer
case_C_53:;
ADDCHAR(106);
goto U_101B;
// 2443 c(52): add char( 'Z' ); ->top; ! eqeq
case_C_52:;
ADDCHAR(90);
goto U_101B;
// 2444 c(74): %if level = 0 %start; ! begin
case_C_74:;
if (LEVEL != 0) goto L_020B;
// 2445 %if progmode <= 0 %then progmode = 1 %else fault(7)
if (PROGMODE > 0) goto L_020C;
PROGMODE = 1;
goto L_020D;
L_020C:;
FAULT(7);
L_020D:;
// 2446 !{Permit BEGIN after external defs}
// 2447 %finish
L_020B:;
// 2448 spec mode = level+1
SPECMODE = LEVEL + 1;
// 2449 block x = 0
BLOCKX = 0;
// 2450 add char( 'H' )
ADDCHAR(72);
// 2451 %return
return;
// 2452 c(77): perm = 0; lines = 0; stats = 0; ! endofperm
case_C_77:;
PERM = 0;
LINES = 0;
STATS = 0;
// 2453 close input
_imp_CLOSEINPUT();
// 2454 select input(source)
_imp_SELECTINPUT(1);
// 2455 list = list-1
LIST = LIST - 1;
// 2456 tbase = tmax; tstart = tmax
TBASE = TMAX;
TSTART = TMAX;
// 2457 %return
return;
// 2458 c(76): %if include # 0 %and x = 0 %start; ! end of ...
case_C_76:;
if (INCLUDE == 0) goto L_020E;
if (X != 0) goto L_020E;
// 2459 lines = include; sstype = 0; ! include
LINES = INCLUDE;
SSTYPE = 0;
// 2460 close input
_imp_CLOSEINPUT();
// 2461 list = include list
LIST = INCLUDELIST;
// 2462 include level = 0
INCLUDELEVEL = 0;
// 2463 include = 0; select input(source); %return
INCLUDE = 0;
_imp_SELECTINPUT(1);
return;
// 2464 %finish
L_020E:;
// 2465 ss = -1; ! prog/file
SS = -1;
// 2466 c(75): compile end(x); %return; ! %end
case_C_75:;
COMPILEEND(X);
return;
// 2467
// 2468 c(85): %if x=0 %then control=lit %else %start; ! control
case_C_85:;
if (X != 0) goto L_020F;
CONTROL = LIT;
goto L_0210;
L_020F:;
// 2469 diag = lit&16_3FFF %if lit>>14&3 = 1
if ((unsigned int)LIT >> 14 & 3 != 1) goto L_0211;
DIAG = LIT & 16383;
L_0211:;
// 2470 %finish
L_0210:;
// 2471 op('z'-x, lit)
OP(122 - X, LIT);
// 2472 ->top
goto U_101B;
// 2473 c(83): list = list+x-2; ->top; ! %LIST/%endoflist
case_C_83:;
LIST = LIST + X - 2;
goto U_101B;
// 2474 c(84): reals ln = x; ->top; ! %REALS long/normal
case_C_84:;
REALSLN = X;
goto U_101B;
// 2475 c(86): %if include # 0 %start; ! include "file"
case_C_86:;
if (INCLUDE == 0) goto L_0212;
// 2476 fault(7); %return
FAULT(7);
return;
// 2477 %finish
L_0212:;
// 2478 get next; ! sconst
GETNEXT();
// 2479 x = x-16_4000
X = X - 16384;
// 2480 j = glink(x)
J = GLINK[X];
// 2481 k = j&255
K = J & 255;
// 2482 !ABD - another little copy loop because SKIMP can't do the string map
// 2483 include file = ""
/* clang-format off */
_imp_strncpy(/*?*/&INCLUDEFILE, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/63);
/* clang-format on */
// 2484 %cycle
L_0213:;
// 2485 k = k-1; %exit %if k < 0
K = K - 1;
if (K >= 0) goto L_0214;
goto L_0215;
L_0214:;
// 2486 include file = include file.tostring(j>>8)
/* clang-format off */
_imp_strncpy(/*?*/&INCLUDEFILE, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&INCLUDEFILE, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING((unsigned int)J >> 8); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/63);
/* clang-format on */
// 2487 x = x+1
X = X + 1;
// 2488 j = glink(x)
J = GLINK[X];
// 2489 k = k-1; %exit %if k < 0
K = K - 1;
if (K >= 0) goto L_0216;
goto L_0215;
L_0216:;
// 2490 include file = include file.tostring(j&255)
/* clang-format off */
_imp_strncpy(/*?*/&INCLUDEFILE, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&INCLUDEFILE, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(J & 255); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/63);
/* clang-format on */
// 2491 %repeat
goto L_0213;
L_0215:;
// 2492 ! include file = string(x-16_4000+stbase)
// 2493 ! remove this event block for SKIMP or pre-event IMP versions
// 2494 %begin
{ /*%begin*/
// 2495 %on 9 %start; Abandon(9); %finish
if (!_imp_on_event(9)) goto L_0217;
ABANDON(9);
L_0217:;
// 2496 open input(3, include file)
_imp_OPENINPUT(3,
/* clang-format off */
*({ __typeof__(_imp_string63) tmp = INCLUDEFILE/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 2497 %end
goto end_1000;
end_1000:;
}
// 2498 include = lines; lines = 0
INCLUDE = LINES;
LINES = 0;
// 2499 include list = list; include level = level
INCLUDELIST = LIST;
INCLUDELEVEL = LEVEL;
// 2500 select input(3)
_imp_SELECTINPUT(3);
// 2501 ->top
goto U_101B;
// 2502
// 2503 c(154): dimension = dimension+1; ! dbsep
case_C_154:;
DIMENSION = DIMENSION + 1;
// 2504 fault(11) %if dimension = dim limit+1
if (DIMENSION != 6 + 1) goto L_0218;
FAULT(11);
L_0218:;
// 2505 ->top
goto U_101B;
// 2506 c(145): set bp; ->top; ! crb
case_C_145:;
SETBP();
goto U_101B;
// 2507 c(146): set bp; ! rcrb
case_C_146:;
SETBP();
// 2508 c(142): ; ! bplrb
case_C_142:;
// 2509 dimension = 1 %if dimension = 0
if (DIMENSION != 0) goto L_0219;
DIMENSION = 1;
L_0219:;
// 2510 op('d', dimension); op(',', defs)
OP(100, DIMENSION);
OP(44, DEFS);
// 2511 %if class # 146 %start
if (CLASS == 146) goto L_021A;
// 2512 set subs(defs)
SETSUBS(DEFS);
// 2513 fault(13) %if dict(dmin) >= 0 %or inhibit # 0 %or level=0
if (DICT[DMIN - 1] >= 0) goto L_021B;
if (INHIBIT != 0) goto L_021B;
if (LEVEL != 0) goto L_021C;
L_021B:;
FAULT(13);
L_021C:;
// 2514 %finish
L_021A:;
// 2515 dimension = 0; defs = 0
DIMENSION = 0;
DEFS = 0;
// 2516 ->top
goto U_101B;
// 2517 c(128): id = dupid; ->top; ! EDUP
case_C_128:;
ID = DUPID;
goto U_101B;
// 2518 c(130): block x = x
case_C_130:;
BLOCKX = X;
// 2519 op('F', 0) %if decl&spec = 0 %and level # 0; ! jump round proc
if (DECL & 128 != 0) goto L_021D;
if (LEVEL == 0) goto L_021D;
OP(70, 0);
L_021D:;
// 2520 c(125): dupid = id; ! %DUP
case_C_125:;
DUPID = ID;
// 2521 %return %if Level < 0; ! {spec about}
if (LEVEL >= 0) goto L_021E;
return;
L_021E:;
// 2522 c(90): def(x); ->top; ! ident
case_C_90:;
DEF(X);
goto U_101B;
// 2523 c(131): ; ! cident
case_C_131:;
// 2524 %if tag(x)_flags&(2_1111111+const bit) = iform+const bit %start
if (TAG[X].FLAGS & 127 + 8192 != 17 + 8192) goto L_021F;
// 2525 tag(x)_format = lit
TAG[X].FORMAT = LIT;
// 2526 %finish %else %start
goto L_0220;
L_021F:;
// 2527 set const(lit) %if pending # 0
if (PENDING == 0) goto L_0221;
SETCONST(LIT);
L_0221:;
// 2528 def(x)
DEF(X);
// 2529 op('A', 1)
OP(65, 1);
// 2530 %finish
L_0220:;
// 2531 cident = x
CIDENT = X;
// 2532 ->top
goto U_101B;
// 2533 c(124): dubious = 1 %if tag(cident)_flags&prot # 0; ! %DUBIOUS
case_C_124:;
if (TAG[CIDENT].FLAGS & 256 == 0) goto L_0222;
DUBIOUS = 1;
L_0222:;
// 2534 ->top
goto U_101B;
// 2535 c(97): ; ! f
case_C_97:;
// 2536 c(98): ; ! m
case_C_98:;
// 2537 c(99): ; ! p
case_C_99:;
// 2538 c(96): call; ->top; ! r
case_C_96:;
CALL();
goto U_101B;
// 2539 c(165): ; ! nlab
case_C_165:;
// 2540 c(100): ; ! rp
case_C_100:;
// 2541 c(101): ; ! fp
case_C_101:;
// 2542 c(102): ; ! mp
case_C_102:;
// 2543 c(103): ; ! pp
case_C_103:;
// 2544 c(91): ; ! v
case_C_91:;
// 2545 c(92): ; ! n
case_C_92:;
// 2546 c(106): ; ! a
case_C_106:;
// 2547 c(107): ; ! an
case_C_107:;
// 2548 c(108): ; ! na
case_C_108:;
// 2549 c(109): ; ! nan
case_C_109:;
// 2550 k = tag(x)_index
K = TAG[X].INDEX;
// 2551 %if k < 0 %then op('n', -k) %else op('@', k)
if (K >= 0) goto L_0223;
OP(110, -K);
goto L_0224;
L_0223:;
OP(64, K);
L_0224:;
// 2552 ->top
goto U_101B;
// 2553 c(121): set const(0); ->top; ! special for zero
case_C_121:;
SETCONST(0);
goto U_101B;
// 2554 c(167): add char( 'G' ); ->pstr; ! aconst (alias)
case_C_167:;
ADDCHAR(71);
goto U_101F;
// 2555 c(const): ; ! const
case_C_93:;
// 2556 %if x < 0 %start; ! constinteger
if (X >= 0) goto L_0225;
// 2557 set const(tag(-x)_format); ->top
SETCONST(TAG[-X].FORMAT);
goto U_101B;
// 2558 %finish
L_0225:;
// 2559 %if x&16_4000 # 0 %start; ! strings
if (X & 16384 == 0) goto L_0226;
// 2560 add char( '''' )
ADDCHAR(39);
// 2561 pstr: x = x-16_4000
U_101F:;
X = X - 16384;
// 2562 j = glink(x)
J = GLINK[X];
// 2563 k = j&255
K = J & 255;
// 2564 add char( k )
ADDCHAR(K);
// 2565 %cycle
L_0227:;
// 2566 k = k-1; ->top %if k < 0
K = K - 1;
if (K >= 0) goto L_0228;
goto U_101B;
L_0228:;
// 2567 add char( j>>8 );
ADDCHAR((unsigned int)J >> 8);
// 2568 x = x+1
X = X + 1;
// 2569 j = glink(x)
J = GLINK[X];
// 2570 k = k-1; ->top %if k < 0
K = K - 1;
if (K >= 0) goto L_0229;
goto U_101B;
L_0229:;
// 2571 add char( j&255 )
ADDCHAR(J & 255);
// 2572 %repeat
goto L_0227;
// 2573 %finish
L_0226:;
// 2574 %if x&16_2000 # 0 %start; ! real - ABD also string-like, but NOT packed
if (X & 8192 == 0) goto L_022A;
// 2575 x = x-16_2000
X = X - 8192;
// 2576 k = glink(x)
K = GLINK[X];
// 2577 op('D', k); add char( ',' )
OP(68, K);
ADDCHAR(44);
// 2578 %cycle
L_022B:;
// 2579 ->top %if k = 0
if (K != 0) goto L_022C;
goto U_101B;
L_022C:;
// 2580 k = k-1
K = K - 1;
// 2581 x = x+1; j = glink(x)
X = X + 1;
J = GLINK[X];
// 2582 %if j = '@' %start
if (J != 64) goto L_022D;
// 2583 op('@', litpool(glink(x+1))); ->top
OP(64, LITPOOL[GLINK[X + 1]]);
goto U_101B;
// 2584 %finish
L_022D:;
// 2585 add char( j )
ADDCHAR(J);
// 2586 %repeat
goto L_022B;
// 2587 %finish
L_022A:;
// 2588 set const(lit pool(x))
SETCONST(LITPOOL[X]);
// 2589 ->top
goto U_101B;
// 2590
// 2591 c(137): add char( 'i' ); ->top; ! asep
case_C_137:;
ADDCHAR(105);
goto U_101B;
// 2592 c(141): add char( 'a' ); ->top; ! arb
case_C_141:;
ADDCHAR(97);
goto U_101B;
// 2593
// 2594 !own arrays
// 2595 c(132): ocount = ub-lb+1
case_C_132:;
OCOUNT = UB - LB + 1;
// 2596 def(x); ! oident
DEF(X);
// 2597 dimension = 1; set subs(1)
DIMENSION = 1;
SETSUBS(1);
// 2598 %if next = 0 %start; ! no initialisation
if (NEXT != 0) goto L_022E;
// 2599 op('A', ocount) %if ocount > 0
if (OCOUNT <= 0) goto L_022F;
OP(65, OCOUNT);
L_022F:;
// 2600 ocount = -1
OCOUNT = -1;
// 2601 %finish %else %start; ! initialisation given
goto L_0230;
L_022E:;
// 2602 get next
GETNEXT();
// 2603 %finish
L_0230:;
// 2604 ->top
goto U_101B;
// 2605 c(162): lit = ocount; ->ins; ! indef
case_C_162:;
LIT = OCOUNT;
goto U_1020;
// 2606 c(143): pop lit; ! orb
case_C_143:;
POPLIT();
// 2607 ins: fault(10) %and lit = 0 %if lit < 0
U_1020:;
if (LIT >= 0) goto L_0231;
FAULT(10);
LIT = 0;
L_0231:;
// 2608 get next
GETNEXT();
// 2609 ->inst
goto U_1021;
// 2610 c(139): ; ! osep (x=19)
case_C_139:;
// 2611 c(153): lit = 1
case_C_153:;
LIT = 1;
// 2612 inst: pop def %if pending # 0; ! ownt (x=0)
U_1021:;
if (PENDING == 0) goto L_0232;
POPDEF();
L_0232:;
// 2613 op('A', lit)
OP(65, LIT);
// 2614 ocount = ocount-lit
OCOUNT = OCOUNT - LIT;
// 2615 %if ocount >= 0 %start
if (OCOUNT < 0) goto L_0233;
// 2616 ->top %if x # 0; ! more coming
if (X == 0) goto L_0234;
goto U_101B;
L_0234:;
// 2617 ocount = -1 %and %return %if ocount = 0; ! all done
if (OCOUNT != 0) goto L_0235;
OCOUNT = -1;
return;
L_0235:;
// 2618 %finish
L_0233:;
// 2619 fault(11); %return
FAULT(11);
return;
// 2620
// 2621 c(swit): op('W', tag(x)_index); inhibit = 1; ->atop
case_C_105:;
OP(87, TAG[X].INDEX);
INHIBIT = 1;
goto U_101C;
// 2622 c(134): def(x); ! swid
case_C_134:;
DEF(X);
// 2623 n = ub-lb+1
N = UB - LB + 1;
// 2624 n = (n+15)>>4; ! slots needed (includes zero)
N = (unsigned int)N + 15 >> 4;
// 2625 j = dmax; dmax = dmax+n+2
J = DMAX;
DMAX = DMAX + N + 2;
// 2626 abandon(1) %if dmax >= dmin
if (DMAX < DMIN) goto L_0236;
ABANDON(1);
L_0236:;
// 2627 tag(x)_format = j
TAG[X].FORMAT = J;
// 2628 dict(j) = lb; dict(j+1) = ub
DICT[J - 1] = LB;
DICT[J + 1 - 1] = UB;
// 2629 %cycle
L_0237:;
// 2630 n = n-1
N = N - 1;
// 2631 ->top %if n < 0
if (N >= 0) goto L_0238;
goto U_101B;
L_0238:;
// 2632 j = j+1; dict(j+1) = 0
J = J + 1;
DICT[J + 1 - 1] = 0;
// 2633 %repeat
goto L_0237;
// 2634 c(151): stats = stats-1; ! slab
case_C_151:;
STATS = STATS - 1;
// 2635 fault(7) %and %return %if x < tbase
if (X >= TBASE) goto L_0239;
FAULT(7);
return;
L_0239:;
// 2636 %if pending # 0 %start; ! explicit label
if (PENDING == 0) goto L_023A;
// 2637 def s lab(pstack(1))
DEFSLAB(PSTACK[0]);
// 2638 %finish %else %start
goto L_023B;
L_023A:;
// 2639 fault(4) %and %return %if tag(x)_app # 0
if (TAG[X].APP == 0) goto L_023C;
FAULT(4);
return;
L_023C:;
// 2640 tag(x)_app = 1
TAG[X].APP = 1;
// 2641 n = tag(x)_format
N = TAG[X].FORMAT;
// 2642 %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_023D:
if (J == _final) goto L_023E;
J += 1;
// 2643 def s lab(j)
DEFSLAB(J);
// 2644 flush buffer( 128 ); ! flush if bp >= 128
FLUSHBUFFER(128);
// 2645 %repeat
goto L_023D;
}
L_023E:;
// 2646 %finish
L_023B:;
// 2647 inhibit = 1
INHIBIT = 1;
// 2648 %return
return;
// 2649
// 2650 c(140): add char( 'p' ); ->top; ! psep
case_C_140:;
ADDCHAR(112);
goto U_101B;
// 2651 c(144): ; ! prb
case_C_144:;
// 2652 add char( 'p' );
ADDCHAR(112);
// 2653 add char( 'E' ); ->top
ADDCHAR(69);
goto U_101B;
// 2654
// 2655 !constant expressions
// 2656 c(155): ; ! pconst
case_C_155:;
// 2657 %if x < 0 %then lit = tag(-x)_format %else lit = lit pool(x)
if (X >= 0) goto L_0240;
LIT = TAG[-X].FORMAT;
goto L_0241;
L_0240:;
LIT = LITPOOL[X];
L_0241:;
// 2658 pending = pending+1; pstack(pending) = lit; ->top
PENDING = PENDING + 1;
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2659 c(156): lit = pstack(pending); lit = -lit %if lit < 0
case_C_156:;
LIT = PSTACK[PENDING - 1];
if (LIT >= 0) goto L_0242;
LIT = -LIT;
L_0242:;
// 2660 pstack(pending) = lit; ->top; !cmod
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2661 c(157): lit = -pstack(pending); pstack(pending) = lit; ->top; ! csign
case_C_157:;
LIT = -PSTACK[PENDING - 1];
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2662 c(158): lit = \pstack(pending); pstack(pending) = lit; ->top; ! cuop
case_C_158:;
LIT = (~PSTACK[PENDING - 1]);
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2663 c(159): ; ! cop1
case_C_159:;
// 2664 c(160): ; ! cop2
case_C_160:;
// 2665 c(161): pending = pending-1; ! cop3
case_C_161:;
PENDING = PENDING - 1;
// 2666 lit2 = pstack(pending+1); lit = pstack(pending)
LIT2 = PSTACK[PENDING + 1 - 1];
LIT = PSTACK[PENDING - 1];
// 2667 ->litop(x>>2)
LITOP_line = __LINE__;
LITOP_file = __FILE__;
LITOP_index = (unsigned int)X >> 2;
goto case_LITOP_dispatch;
// 2668
// 2669 litop(1): lit = lit<<lit2; ->setl
case_LITOP_1:;
LIT = LIT << LIT2;
goto U_1022;
// 2670 litop(2): lit = lit>>lit2; ->setl
case_LITOP_2:;
LIT = (unsigned int)LIT >> LIT2;
goto U_1022;
// 2671 litop(3): n = 1; ! lit = lit\\lit2
case_LITOP_3:;
N = 1;
// 2672 fault(10) %if lit2 < 0
if (LIT2 >= 0) goto L_0243;
FAULT(10);
L_0243:;
// 2673 %while lit2 > 0 %cycle
L_0244:;
if (LIT2 <= 0) goto L_0245;
// 2674 lit2 = lit2-1
LIT2 = LIT2 - 1;
// 2675 n = n*lit
N = N * LIT;
// 2676 %repeat
goto L_0244;
L_0245:;
// 2677 lit = n; ->setl
LIT = N;
goto U_1022;
// 2678 litop(4): %if lit2 = 0 %then fault(10) %else lit = lit//lit2
case_LITOP_4:;
if (LIT2 != 0) goto L_0246;
FAULT(10);
goto L_0247;
L_0246:;
LIT = ((long)LIT / (long)LIT2);
L_0247:;
// 2679 ->setl
goto U_1022;
// 2680 litop(5): lit = lit&lit2; ->setl
case_LITOP_5:;
LIT = LIT & LIT2;
goto U_1022;
// 2681 litop(6): lit = lit!lit2; ->setl
case_LITOP_6:;
LIT = LIT | LIT2;
goto U_1022;
// 2682 litop(7): lit = lit!!lit2; ->setl
case_LITOP_7:;
LIT = LIT ^ LIT2;
goto U_1022;
// 2683 litop(8): lit = lit+lit2; ->setl
case_LITOP_8:;
LIT = LIT + LIT2;
goto U_1022;
// 2684 litop(9): lit = lit-lit2; ->setl
case_LITOP_9:;
LIT = LIT - LIT2;
goto U_1022;
// 2685 litop(10): lit = lit*lit2; ->setl
case_LITOP_10:;
LIT = LIT * LIT2;
goto U_1022;
// 2686 litop(11): lit = lit+lit2; ->setl
case_LITOP_11:;
LIT = LIT + LIT2;
goto U_1022;
// 2687 litop(12): n = 1; ! lit = lit\\lit2
case_LITOP_12:;
N = 1;
// 2688 fault(10) %if lit2 < 0
if (LIT2 >= 0) goto L_0248;
FAULT(10);
L_0248:;
// 2689 %while lit2 > 0 %cycle
L_0249:;
if (LIT2 <= 0) goto L_024A;
// 2690 lit2 = lit2-1
LIT2 = LIT2 - 1;
// 2691 n = n*lit
N = N * LIT;
// 2692 %repeat
goto L_0249;
L_024A:;
// 2693 lit = n; ->setl
LIT = N;
goto U_1022;
// 2694 setl: pstack(pending) = lit; ->top
U_1022:;
PSTACK[PENDING - 1] = LIT;
goto U_101B;
// 2695
// 2696 c(170): ;
case_C_170:;
// 2697 !Fault(4) %if IMPCOM_Option # ""
// 2698 !IMPCOM_Option = String(x-x'4000'+Stbase); ! Option string
// 2699 ->Top
goto U_101B;
// 2700
// 2701 !string resolution
// 2702 c(135): resln = 2; ->top; ! dotl
case_C_135:;
RESLN = 2;
goto U_101B;
// 2703 c(136): resln = resln+1; ->top; ! dotr
case_C_136:;
RESLN = RESLN + 1;
goto U_101B;
// 2704 c(55): op('r', resln); resln = 0; ->top; ! resop
case_C_55:;
OP(114, RESLN);
RESLN = 0;
goto U_101B;
// 2705 c(164): op('r', resln+4); resln = 0; ! cresop
case_C_164:;
OP(114, RESLN + 4);
RESLN = 0;
// 2706 c(122): x = 6; ->cop; ! %PRED
case_C_122:;
X = 6;
goto U_101E;
// 2707 c(87): set const(pstack(1)); ! mass
case_C_87:;
SETCONST(PSTACK[0]);
// 2708 bp=bp+1 %and buff(bp)='P'; ->top
BP = BP + 1;
BUFF[BP - 1] = 80;
goto U_101B;
// 2709 %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 */
// 2710
// 2711 %end; ! of compile block
return;
} /* end of COMPILEBLOCK */
// 2712
// 2713 %on 9 %start
if (!_imp_on_event(9)) goto L_024B;
// 2714 abandon(5)
ABANDON(5);
// 2715 %finish
L_024B:;
// 2716
// 2717 selectinput(2); selectoutput(listing)
_imp_SELECTINPUT(2);
_imp_SELECTOUTPUT(2);
// 2718 tag(max tag) = 0; ! %begin defn
TAG[800] = (struct TAGFM){0};
// 2719 tag(0) = 0; tag(0)_flags = 7; ! %begin tag!
TAG[0] = (struct TAGFM){0};
TAG[0].FLAGS = 7;
// 2720 Hash(x) = 0 %for x = 0, 1, max names
// %for X = 0, 1, 2047 %cycle
{
X = -1;
L_024C:
if (X == 2047) goto L_024D;
X += 1;
HASH[X] = 0;
goto L_024C;
}
L_024D:;
// 2721 printstring(" Edinburgh IMP77 Compiler - Version ")
_imp_PRINTSTRING(_imp_str_literal(" Edinburgh IMP77 Compiler - Version "));
// 2722 ! printstring(" Preston IMP2020 Compiler - Version ")
// 2723 printstring(version); newlines(2)
_imp_PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string4) tmp = VERSION/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
_imp_NEWLINES(2);
// 2724 op('l', 0)
OP(108, 0);
// 2725 compile block(0, 0, max dict, 0, 0)
COMPILEBLOCK(0, 0, 6000, 0, 0);
// 2726 add char( nl ); ! {for bouncing off}
ADDCHAR(10);
// 2727 flush buffer( 0 ); ! flush if bp >= 0
FLUSHBUFFER(0);
// 2728
// 2729 x = listing
X = 2;
// 2730 newline
_imp_NEWLINE();
// 2731 %cycle
L_024F:;
// 2732 %if faulty = 0 %start
if (FAULTY != 0) goto L_0250;
// 2733 write(stats, 5)
_imp_WRITE(STATS, 5);
// 2734 printstring(" Statements compiled")
_imp_PRINTSTRING(_imp_str_literal(" Statements compiled"));
// 2735 %else
goto L_0251;
L_0250:;
// 2736 printstring(" Program contains ")
_imp_PRINTSTRING(_imp_str_literal(" Program contains "));
// 2737 write(faulty, 1)
_imp_WRITE(FAULTY, 1);
// 2738 printstring(" fault")
_imp_PRINTSTRING(_imp_str_literal(" fault"));
// 2739 printsymbol('s') %unless faulty = 1
if (FAULTY == 1) goto L_0252;
_imp_PRINTSYMBOL(115);
L_0252:;
// 2740 %finish
L_0251:;
// 2741 newline
_imp_NEWLINE();
// 2742 %exit %if x = report
if (X != 0) goto L_0253;
goto L_0254;
L_0253:;
// 2743 x = report
X = 0;
// 2744 selectoutput(report)
_imp_SELECTOUTPUT(0);
// 2745 %repeat
goto L_024F;
L_0254:;
// 2746
// 2747 %if faulty # 0 %then %stop; ! try to flag to shell that we failed
if (FAULTY == 0) goto L_0255;
_imp_stop(0);
L_0255:;
// 2748
// 2749 %endofprogram
_imp_stop(0);
return 0;
end_0:;
}