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