#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 !IMP syntax checker - based on M68000 IMP compiler
// 2 ! (qv for fuller annotation)
// 3 ! Hamish Dewar Computer Science Edinburgh University 1983
// 4 !
// 5 %constinteger MAXNAME=127
// 6 %recordformat EDFILE(%integer start1,lim1, {part 1}
struct EDFILE {
union {
struct {
int START1;
int LIM1;
int START2;
int LIM2;
int LIM;
int LBEG;
int FP;
int CHANGE;
int FLAG;
int LINE;
int DIFF;
int SHIFT;
unsigned char TOP;
unsigned char WIN;
unsigned char BOT;
unsigned char MIN;
unsigned char ROW;
unsigned char COL;
_imp_string127 NAME;
};
};
};
// 7+ start2,lim2, {part2}
// 8+ lim, {VMLIM}
// 9+ lbeg,fp,change,flag,
// 10+ line {line number of current pos},
// 11+ diff {diff between LINE and ROW},
// 12+ shift {right shift of window on file},
// 13+ %byteinteger top {top row of sub_window},
// 14+ win {floating top},
// 15+ bot {bottom row +1 of sub_window},
// 16+ min {minimum window size},
// 17+ row {last row position},
// 18+ col {last col position},
// 19+ %string(maxname) name)
// 20 !
// 21 %external%routine%spec EDI(%record(edfile)%name main,sec,
extern void EDI(struct EDFILE *MAIN, struct EDFILE *SEC, _imp_string255 MESSAGE);
// 22+ %string(255) message)
// 23 %external%routine%spec CONNECT EDFILE(%record(edfile)%name f)
extern void CONNECTEDFILE(struct EDFILE *F);
// 24 %external%routine%spec DISCONNECT EDFILE(%record(edfile)%name f)
extern void DISCONNECTEDFILE(struct EDFILE *F);
// 25 !
// 26 !$IF VAX
// 27 %conststring(13) permfile="ECCE_PERM"
const _imp_string13 PERMFILE = _imp_str_init("ECCE_PERM");
// 28 !$IF AMDAHL
// 29 {%conststring(18) permfile="ERCLIB:VECCE.IPERM"
// 30 !$FINISH
// 31
// 32 !! control
// 33 %constinteger logbit= 16_00040000 {print log},
// 34+ warnbit= 16_00020000 {print warnings},
// 35+ nonsbit= 16_00010000 {print nonstandard reports},
// 36+ DICTLIST= 16_00001000 {list dict entries},
// 37+ EXPLIST= 16_00000800 {list EXP entries}
// 38 %owninteger control=warnbit+nonsbit
static int CONTROL = 196608;
// 39 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 40 %externalroutine ECCECI(%record(edfile)%name main)
void ECCECI(struct EDFILE *MAIN) {
// 41 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 42 %ownstring(maxname) extraname
static _imp_string127 EXTRANAME;
// 43 %ownrecord(edfile) extra=0,null=0
static struct EDFILE EXTRA = {0};
static struct EDFILE NULL = {0};
// 44 %integer curstart,curlim
int CURSTART;
int CURLIM;
// 45 %integer nonstop
int NONSTOP;
// 46 %owninteger change=0
static int CHANGE = 0;
// 47 !! Fault numbers
// 48 %constinteger FORMERR=0, ATOMERR=1, NAMERR=2, CATERR=3, SIZERR=4,
// 49+ ASSERR=5, TYPERR=6, DUPERR=7,
// 50+ NOSTART=8, NOCYCLE=9,
// 51+ ORDERERR=10, MATCHERR=11, RANGERR=12, NONLITERAL=13,
// 52+ BOUNDSERR=14, ACCESSERR=15, NOTINLOOP=16,
// 53+ NOTINROUT=17, NOTINFUN=18, NOTINPRED=19,
// 54+ PLEXERR=20, NOIF=21, NONSTAND=22, NOTIN=23,
// 55+ INDEXERR=24,
// 56+ MOPERR=27, NOTERM=28, NONSTARTER=29,
// 57+ NONVAR=30, NONREF=31, TOOMANY=32, TOOFEW=33,
// 58+ UNWANTED=34, NOPARM=35, UNENDING=37,
// 59+ SELFREF=38
// 60 %constinteger NOEND=40, NOBEGIN=41,
// 61+ IDMISSING=42, NOFINISH=43, NOREPEAT=44,
// 62+ COUNTERR=45, NORESULT=46
// 63 %constinteger ERRMAX=46
// 64 %constinteger POINT=64,WARN=128
// 65 %owninteger FAULTNUM=0
static int FAULTNUM = 0;
// 66 %owninteger FAULTS=0; !fault count
static int FAULTS = 0;
// 67 !
// 68 %constinteger MAXINT=16_7FFFFFFF, MININT=\MAXINT,
// 69+ MAX10=maxint//10, MAXDIG=maxint-max10*10
// 70 %constinteger FALSE=0, TRUE=1
// 71 %integer I
int I;
// 72 !
// 73 !! Program statistics
// 74 %owninteger STATEMENTS=0; !statement count
static int STATEMENTS = 0;
// 75 !%owninteger ATOMS=0; !atom count
// 76 !%owninteger IDENTATOMS=0; !identifier count
// 77 !%owninteger NUMATOMS=0; !numeric atom count
// 78 !%owninteger MISSES=0; !ident mismatches
// 79 !%owninteger ZAPS=0
// 80 !
// 81 !!!!!!!!!!!!!!!! Operand Representation !!!!!!!!!!!!!!!!!!!
// 82
// 83 %constinteger SMALLMIN=-1000, SMALLMAX=1000,
// 84+ LITMIN=smallmax+1, LITMAX=smallmax+1000,
// 85+ D0=litmax+1, D1=d0+1, D2=d0+2, D6=d0+6, D7=d0+7,
// 86+ A0=d0+8, A1=a0+1, A6=a0+6, A7=a0+7,
// 87+ INDA0=a0+8,
// 88+ POSTA0=inda0+8, POSTA7=posta0+7,
// 89+ PREA0=posta0+8, PREA7=prea0+7,
// 90+ DICTMIN=prea0+8, DICTMAX=prea0+1200,
// 91+ LABMIN=dictmax+1, LAB1=labmin+1, LABMAX=labmin+20,
// 92+ EXPMIN=labmax+1, EXPMAX=labmax+300,
// 93+ UNDEF=expmax+1, AD=16_4000
// 94 %constinteger MAXDREG=d0+4, MAXAREG=a0+3
// 95 %constinteger D0B=1, D1B=2, D2B=4,
// 96+ A0B=16_100, A1B=16_200, A2B=16_400
// 97 %constinteger ALLREGS=2_0000111100011111; !a3:a0 & d4:d0
// 98 %owninteger FREE=allregs
static int FREE = 3871;
// 99 %constinteger NULLTYPE=dictmin,
// 100+ RECY=nulltype+1, ARRY=recy+1, STRINGY=arry+1,
// 101+ REALY=stringy+1, INTY=realy+1,
// 102+ CHARTYPE=inty+1, BOOLTYPE=chartype+1,
// 103+ FALSECONST=booltype+1, TRUECONST=booltype+2,
// 104+ INTTYPE=trueconst+1, SHORTTYPE=inttype+1,
// 105+ HALFTYPE=shorttype+1, BYTETYPE=halftype+1,
// 106+ MITETYPE=bytetype+1, BITTYPE=MITETYPE+1,
// 107+ LONGINTTYPE=bittype+1,
// 108+ REALTYPE=longinttype+1, LONGREALTYPE=realtype+1
// 109 %constinteger PURETYPE=8191, DIRECT=8192, INDIRECT=16384
// 110 %constinteger ANYINT=inty+direct, ANYINTVAR=inty+indirect,
// 111+ ANYSTRING=stringy+direct, ANYSTRINGVAR=stringy+indirect
// 112 %constinteger ANYNAME=nulltype+indirect
// 113
// 114 !
// 115 %owninteger dictshown=dictmin
static int DICTSHOWN = 2041;
// 116
// 117 !!!!!!!!!!!!!!!!!!!!!!! Big Literals !!!!!!!!!!!!!!!!!!!!!!!
// 118 %owninteger LITPOS=litmin, SLITPOS=litmax
static int LITPOS = 1001;
static int SLITPOS = 2000;
// 119 %integerarray LITSTORE(litmin:litmax)
int LITSTORE[1000];
struct _imp_dv LITSTORE_dv = {LITSTORE, sizeof(int) /*, dims, <bounds> */};
// 120 !
// 121 !!!!!!!!!!!!!!!!!!!!!!!!!! MODE VALUES !!!!!!!!!!!!!!!!!!!!!!!!!
// 122 !Size codes:
// 123 %constinteger bytesize=1, wordsize=2, longsize=3
// 124 %constinteger sizemask=16_C0, sizeshift=6
// 125 !Address modes:
// 126 %constinteger dmode=0, amode=2_001000,
// 127+ indmode=2_010000, postmode=2_011000, premode=2_100000,
// 128+ dispmode=2_101000, indexmode=2_110000, absmode=2_111000,
// 129+ pcmode=2_111010, litmode=2_111100
// 130 %constinteger ownmode=dispmode+6; !d(A6)
// 131 !
// 132 !!!!!!!!!!!!!!!!!!!!!!!! Identifiers !!!!!!!!!!!!!!!!!!!!!!!!
// 133 !
// 134 %recordformat OBJINFO %C
struct OBJINFO {
union {
struct {
int FLAGS;
int TYPE;
union {
struct {
int EXTRA;
unsigned char SPARE;
unsigned char MODE;
};
struct {
int LOW;
};
};
int VAL;
};
};
};
// 135+ (%integer flags,type,
// 136+ (%integer extra, %byteinteger spare,mode %or %integer low),
// 137+ %integer val)
// 138 %recordformat IDENTINFO %C
struct IDENTINFO {
union {
struct {
union {
struct {
int FLAGS;
int TYPE;
union {
struct {
int EXTRA;
unsigned char SPARE;
unsigned char MODE;
};
struct {
int LOW;
};
};
int VAL;
};
struct {
struct OBJINFO DETAILS;
};
};
int TEXT;
int LINK;
};
};
};
// 139+ ((%integer flags,type,
// 140+ (%integer extra, %byteinteger spare,mode %or %integer low),
// 141+ %integer val %or %record(objinfo) details),
// 142+ %integer text,link)
// 143 !
// 144 ! Significance of FLAGS:
// 145 %constinteger VAR=16_0001, LAB=16_0002, PROC=16_0004, STATIC=16_0008,
// 146+ SPEC=16_0010, EXT=16_0020, PARM=16_0040, MORE=16_0080,
// 147+ TYPEID=16_0100, OKFLAG=16_0200, ALT=16_0800,
// 148+ RFLAG=16_1000,WFLAG=16_2000
// 149 !
// 150 ! Significance of VAL:
// 151 ! for literal : the actual value
// 152 ! for variable : machine address (displacement)
// 153 ! for undefined label : reference chain
// 154 ! for undefined procedure : "
// 155 ! for base type : (index to) range
// 156 ! for record type : size of record in bytes
// 157 !
// 158 ! Identifier dictionary:
// 159 %record(identinfo)%array DICT(d0:labmax)
struct IDENTINFO DICT[1254];
struct _imp_dv DICT_dv = {DICT, sizeof(struct IDENTINFO) /*, dims, <bounds> */};
// 160 ! indexing DICT:
// 161 %owninteger DLIM=trueconst+1; !dict limit (up)
static int DLIM = 2051;
// 162 %owninteger DLIM0
static int DLIM0;
// 163 %owninteger PERMLIM=dictmin
static int PERMLIM = 2041;
// 164 %owninteger DMIN=dictmax-1; !dict upper limit (down)
static int DMIN = 3232;
// 165
// 166 ! Text of identifiers (indexed by _TEXT):
// 167 %constinteger CHARBOUND=6000
// 168 %byteintegerarray CHAR(0:charbound)
unsigned char CHAR[6001];
struct _imp_dv CHAR_dv = {CHAR, sizeof(unsigned char) /*, dims, <bounds> */};
// 169 %integer CHARBASE,CHARLIM,CHARMIN; !pointers
int CHARBASE;
int CHARLIM;
int CHARMIN;
// 170 %integer NEWLEN
int NEWLEN;
// 171
// 172 ! Hash index to DICT:
// 173 %integerarray HASHINDEX(0:255)
int HASHINDEX[256];
struct _imp_dv HASHINDEX_dv = {HASHINDEX, sizeof(int) /*, dims, <bounds> */};
// 174 %integername HEAD; !head of ident search list
int *HEAD;
// 175 !
// 176 !!!!!!!!!!!!!!!!!!!!! Complex operands !!!!!!!!!!!!!!!!!!!!!!!
// 177 !%recordformat EXPINFO(%integer act,x,y)
// 178 !%record(expinfo)%array EXP(expmin:expmax)
// 179 %owninteger EXPLO=expmax+1, OLDEXPLO=expmax+1
static int EXPLO = 3555;
static int OLDEXPLO = 3555;
// 180 %constinteger NP0=expmin
// 181 %owninteger NP,CONDNP,INSTNP
static int NP;
static int CONDNP;
static int INSTNP;
// 182
// 183 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 184 !!!!!!!!!!!!!!!!!! Keywords and operators !!!!!!!!!!!!!!!!!!!!
// 185 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 186 !*!!!!!!! Keyword codes -- used by KEYGEN to produce tables !!
// 187 %constinteger END=1 {end},
// 188+ REPEAT=2 {repeat},
// 189+ FINISH=3 {finish},
// 190+ ELSE=4 {else},
// 191+ BEGIN=5 {begin},
// 192+ EXIT=6 {exit_1,continue_0},
// 193+ RETURN=7 {return},
// 194+ TF=8 {true_1,false_0},
// 195+ RESULT=9 {result},
// 196+ STOP=10 {stop},
// 197+ GOTO=11 {goto},
// 198+ SIGNAL=12 {signal},
// 199+ MONITOR=13 {monitor},
// 200+ ON=15 {on},
// 201+ IU=16 {if_0,unless_1},
// 202+ WHILE=17 {while},
// 203+ UNTIL=18 {until_1},
// 204+ FOR=19 {for},
// 205+ THEN=20 {then},
// 206+ START=21 {start},
// 207+ CYCLE=22 {cycle},
// 208+ KEYLABEL=23 {label},
// 209+ PREFIX=24 {const_9,constant_9,own_8,external_40,system_40,dynamic_40},
// 210+ KRANGE=25 {short_1,half_2,byte_3,mite_4,bit_5},
// 211+ KEYLONG=26 {long},
// 212+ KEYINTEGER=27 {integer},
// 213+ KEYREAL=28 {real},
// 214+ KEYSTRING=29 {string},
// 215+ KEYRECORD=30 {record},
// 216+ KEYFORMAT=31 {format},
// 217+ FNMAP=32 {fn_0,function_0,map_1},
// 218+ RPRED=33 {routine_0,predicate_1},
// 219+ KEYSPEC=34 {spec},
// 220+ KEYARRAY=35 {array},
// 221+ KEYNAME=36 {name},
// 222+ KEYSWITCH=37 {switch},
// 223+ OF=38 {of},
// 224+ KEYFILE=39 {file},
// 225+ PROGRAM=40 {program},
// 226+ KEYLIST=41 {list},
// 227+ KEYCONTROL=42 {control},
// 228+ COMMENT=43 {comment},
// 229+ KEYEVENT=44 {event},
// 230+ INCLUDE=45 {include},
// 231+ ALIAS=46 {alias},
// 232+ KEYNOT=47 {not},
// 233+ KEYAND=64 {and},
// 234+ KEYOR=65 {or}
// 235 %CONSTintegerARRAY SYMINIT(97:122) = %C
const int SYMINIT[26] = {2, 15, 27, 57, 64, 87, 118, 122, 126, 1, 1, 141, 154,
168, 175, 184, 1, 199, 230, 270, 278, 1, 288, 1, 1, 1};
struct _imp_dv SYMINIT_dv = {SYMINIT, sizeof(int) /*, dims, <bounds> */};
// 236+ 2, 15, 27, 57, 64, 87,118,122,126, 1, 1,141,154,168,175,184,
// 237+ 1,199,230,270,278, 1,288, 1, 1, 1
// 238
// 239 %CONSTBYTEINTEGERARRAY SYMBOL(1:292) = %C
const unsigned char SYMBOL[292] = {
128, 114, 114, 97, 121, 163, 108, 105, 97, 115, 174, 110, 100, 192, 101, 103, 105, 110, 133, 121, 116, 101, 153,
105, 116, 153, 111, 110, 116, 105, 110, 117, 101, 134, 121, 99, 108, 101, 150, 109, 109, 101, 110, 116, 171, 115,
116, 97, 110, 116, 152, 152, 114, 111, 108, 170, 121, 110, 97, 109, 105, 99, 152, 110, 100, 129, 108, 115, 101,
132, 120, 105, 116, 134, 118, 101, 110, 116, 172, 116, 101, 114, 110, 97, 108, 152, 105, 110, 105, 115, 104, 131,
97, 108, 115, 101, 136, 111, 114, 109, 97, 116, 159, 110, 160, 117, 110, 99, 116, 105, 111, 110, 160, 147, 108,
101, 167, 111, 116, 111, 139, 97, 108, 102, 153, 102, 144, 110, 116, 101, 103, 101, 114, 155, 99, 108, 117, 100,
101, 173, 97, 98, 101, 108, 151, 111, 110, 103, 154, 105, 115, 116, 169, 111, 110, 105, 116, 111, 114, 141, 105,
116, 101, 153, 97, 112, 160, 97, 109, 101, 164, 111, 116, 175, 110, 143, 119, 110, 152, 102, 166, 114, 193, 114,
101, 100, 105, 99, 97, 116, 101, 161, 111, 103, 114, 97, 109, 168, 101, 112, 101, 97, 116, 130, 111, 117, 116,
105, 110, 101, 161, 116, 117, 114, 110, 135, 115, 117, 108, 116, 137, 97, 108, 156, 99, 111, 114, 100, 158, 116,
111, 112, 138, 105, 103, 110, 97, 108, 140, 121, 115, 116, 101, 109, 152, 104, 111, 114, 116, 153, 112, 101, 99,
162, 119, 105, 116, 99, 104, 165, 97, 114, 116, 149, 114, 105, 110, 103, 157, 114, 117, 101, 136, 104, 101, 110,
148, 110, 108, 101, 115, 115, 144, 116, 105, 108, 146, 104, 105, 108, 101, 145};
struct _imp_dv SYMBOL_dv = {SYMBOL, sizeof(unsigned char) /*, dims, <bounds> */};
// 240+ 128,114,114, 97,121,163,108,105, 97,115,174,110,100,192,101,103,
// 241+ 105,110,133,121,116,101,153,105,116,153,111,110,116,105,110,117,
// 242+ 101,134,121, 99,108,101,150,109,109,101,110,116,171,115,116, 97,
// 243+ 110,116,152,152,114,111,108,170,121,110, 97,109,105, 99,152,110,
// 244+ 100,129,108,115,101,132,120,105,116,134,118,101,110,116,172,116,
// 245+ 101,114,110, 97,108,152,105,110,105,115,104,131, 97,108,115,101,
// 246+ 136,111,114,109, 97,116,159,110,160,117,110, 99,116,105,111,110,
// 247+ 160,147,108,101,167,111,116,111,139, 97,108,102,153,102,144,110,
// 248+ 116,101,103,101,114,155, 99,108,117,100,101,173, 97, 98,101,108,
// 249+ 151,111,110,103,154,105,115,116,169,111,110,105,116,111,114,141,
// 250+ 105,116,101,153, 97,112,160, 97,109,101,164,111,116,175,110,143,
// 251+ 119,110,152,102,166,114,193,114,101,100,105, 99, 97,116,101,161,
// 252+ 111,103,114, 97,109,168,101,112,101, 97,116,130,111,117,116,105,
// 253+ 110,101,161,116,117,114,110,135,115,117,108,116,137, 97,108,156,
// 254+ 99,111,114,100,158,116,111,112,138,105,103,110, 97,108,140,121,
// 255+ 115,116,101,109,152,104,111,114,116,153,112,101, 99,162,119,105,
// 256+ 116, 99,104,165, 97,114,116,149,114,105,110,103,157,114,117,101,
// 257+ 136,104,101,110,148,110,108,101,115,115,144,116,105,108,146,104,
// 258+ 105,108,101,145
// 259
// 260 %CONSTBYTEINTEGERARRAY ALTDISP(1:292) = %C
const unsigned char ALTDISP[292] = {
0, 5, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 0, 0, 3, 0, 0, 5, 8, 12, 17, 23, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 40, 3, 0, 0,
4, 0, 0, 0, 4, 8, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 40, 6, 27, 0, 0, 0, 0, 5, 0, 0, 0, 0, 6, 0,
14, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0, 6, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 0, 0, 4, 0, 0, 4, 0,
0, 1, 4, 0, 0, 0, 0, 0, 0, 2, 0, 3, 0, 8, 2, 0, 0, 0, 0, 8, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0,
6, 12, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 5, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 4, 30,
0, 0, 6, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 40, 5, 0, 0, 0, 1, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0,
0, 0, 0, 0, 0, 4, 0, 0, 1, 0, 0, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0};
struct _imp_dv ALTDISP_dv = {ALTDISP, sizeof(unsigned char) /*, dims, <bounds> */};
// 261+ 0, 5, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 5, 0,
// 262+ 0, 0, 0, 4, 0, 0, 3, 0, 0, 5, 8, 12, 17, 23, 0, 0,
// 263+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4,
// 264+ 0, 0, 9, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 40, 3,
// 265+ 0, 0, 4, 0, 0, 0, 4, 8, 0, 1, 0, 0, 0, 0, 0, 0,
// 266+ 0, 0, 0, 0, 0, 40, 6, 27, 0, 0, 0, 0, 5, 0, 0, 0,
// 267+ 0, 6, 0, 14, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0,
// 268+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2, 0, 0,
// 269+ 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0,
// 270+ 0, 4, 0, 0, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 0, 0,
// 271+ 4, 0, 0, 4, 0, 0, 1, 4, 0, 0, 0, 0, 0, 0, 2, 0,
// 272+ 3, 0, 8, 2, 0, 0, 0, 0, 8, 0, 0, 0, 0, 0, 0, 1,
// 273+ 0, 0, 0, 0, 0, 0, 6, 12, 0, 0, 0, 0, 0, 0, 0, 0,
// 274+ 0, 0, 0, 5, 0, 0, 0, 0, 5, 0, 0, 0, 0, 3, 0, 0,
// 275+ 0, 0, 0, 0, 0, 4, 30, 0, 0, 6, 0, 0, 0, 0, 0, 6,
// 276+ 0, 0, 0, 0, 40, 5, 0, 0, 0, 1, 4, 0, 0, 0, 0, 0,
// 277+ 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0,
// 278+ 1, 0, 0, 0, 0, 0, 5, 0, 0, 0, 1, 0, 0, 0, 1, 0,
// 279+ 0, 0, 0, 0
// 280
// 281
// 282 !*!!!!!! end of generated tables !!!!!!!!!!!!!!!!!!!!!!!!!!!
// 283 !
// 284 %constinteger TERMINATOR=52, CONST=53, IDENT=54,
// 285+ AREF=55, RECREF=56,
// 286+ MODSIGN=57,
// 287+ COLON=58, COMMA=59, RIGHT=60, RIGHTBRACKET=61,
// 288+ DUD=63
// 289
// 290 !Operators (in banks of 8 acc to rank)
// 291 %constinteger BOOLAND=64, BOOLOR=65, BOOLNOT=66,
// 292+ FLOAT=67, IMOD=68, FMOD=69
// 293 %constinteger EQUALS=70, NOTEQ=71, LESSEQ=72,
// 294+ LESS=73, GREATEQ=74, GREATER=75,
// 295+ EQEQ=76, NOTEQEQ=77, RESOLVE=79
// 296 %constinteger PLUS=80, MINUS=81, LOGOR=82,
// 297+ LOGXOR=83, CONCAT=84
// 298 %constinteger MULT=88, FDIV=89, IDIV=90,
// 299+ LOGAND=91
// 300 %constinteger FPOWER=96, IPOWER=97,
// 301+ LSHIFT=100, RSHIFT=101, LOGNOT=102
// 302 %constinteger FCALL=106, MCALL=107
// 303 %constinteger ATOMMAX=107
// 304
// 305 ! Instruction actions:
// 306 %constinteger swgoto=35, rcall=mcall+2,
// 307+ assign=41, jamassign=42, plusass=43,
// 308+ compare=44, jump=45, label=46, adecl=47
// 309 %constinteger actmax=49
// 310 !
// 311 !Branch cases ( = machine condition-code)
// 312 %constinteger EQ=2_0111, NE=2_0110,
// 313+ GT=2_1110, LE=2_1111,
// 314+ LT=2_1101, GE=2_1100,
// 315+ CC=2_0100, CS=2_0101
// 316 %constinteger DOUBLE=16
// 317
// 318 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 319 ! Perm procedure identifiers which are recognised explicitly and
// 320 ! either implemented in-line or mapped to system entry-point
// 321 %constinteger DSHORT=dictmin+6, DLENGTH=dshort+1, DCHARNO=dlength+1,
// 322+ DADDR=dcharno+1, DTOSTR=daddr+1,
// 323+ DREM=dtostr+1,
// 324+ DNEXTSYM=drem+1, DREADSYM=dnextsym+1,
// 325+ DPRINTSTR=dreadsym+3,
// 326+ DREAD=dictmin+27,
// 327+ DNEWLINE=dictmin+41
// 328 !System entry-points used explicitly
// 329 %constinteger SIGENTRY=16_1114, SCOMPENTRY=16_1128,
// 330+ BOUNDENTRY=16_1134, AGETENTRY=16_1138,
// 331+ INDEXENTRY=16_113C, IREADENTRY=16_1118
// 332
// 333 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 334
// 335 %owninteger STARTS=0, CYCLES=0
static int STARTS = 0;
static int CYCLES = 0;
// 336 %owninteger LOOPLAB=0
static int LOOPLAB = 0;
// 337 %owninteger CURLAB=lab1
static int CURLAB = 3235;
// 338 !
// 339 %recordformat BLOCKINF(%integer sp, delta, fortemps, flags, type,
struct BLOCKINF {
union {
struct {
int SP;
int DELTA;
int FORTEMPS;
int FLAGS;
int TYPE;
int LOCALDPOS;
int PARLIM;
int LOCALTEXT;
int LOCALPC;
int LOCALSPC;
int PIDPOS;
int ACCESS;
int FORWARD;
int EVENTS;
int EVENTPC;
int FAULTS;
int RETURN;
int SHORTS;
};
};
};
// 340+ localdpos, parlim, localtext, localpc,
// 341+ localspc, pidpos, access, forward, events,
// 342+ eventpc, faults, return, shorts)
// 343 !Flag bits (VAR=1 from D_FLAGS)
// 344 %constinteger WRONGCC=2, NONLOCALREF=4, DYNARRAY=8
// 345 %constinteger HADON=16_10, HADINST=16_20
// 346
// 347 %constinteger OUTERLEVEL=0, MAXLEVEL=16
// 348 %owninteger LEVEL=outerlevel; !current block level
static int LEVEL = 0;
// 349 %record(blockinf) C; !info for current block
struct BLOCKINF C;
// 350 %record(blockinf)%array HOLD(0:maxlevel-1); !info for global blocks
struct BLOCKINF HOLD[16 - 1 + 1];
struct _imp_dv HOLD_dv = {HOLD, sizeof(struct BLOCKINF) /*, dims, <bounds> */};
// 351
// 352 ! Final core image
// 353 %constinteger PUREBOUND=0, OWNBASE=purebound+1,
// 354+ FINALBOUND=ownbase+8191
// 355 %byteintegerarray FINAL(0:finalbound); !for switch info only
unsigned char FINAL[8193];
struct _imp_dv FINAL_dv = {FINAL, sizeof(unsigned char) /*, dims, <bounds> */};
// 356 %owninteger FINALAD=2, OWNAD=ownbase
static int FINALAD = 2;
static int OWNAD = 1;
// 357 !%owninteger FIRSTENTRY=finalbound, FIRSTDPOS=dictmax
// 358 !%ownintegername CONSTAD; !== ownad or finalad
// 359 !%owninteger CONSTBOUND=purebound; !for const/code
// 360 ! =finalbound; !for own
// 361 %owninteger PC=0, SPC=finalbound; !for switch info
static int PC = 0;
static int SPC = 8192;
// 362
// 363 !Recognition:-
// 364 %constinteger CASEMASK=95, CASEBIT=32; !for case conversion
// 365
// 366 !Memo variables for current statement:-
// 367 %owninteger ITEM=0; !current operand
static int ITEM = 0;
// 368 %record(objinfo) T; !full typeinfo for ITEM
struct OBJINFO T;
// 369 %record(identinfo)%name DITEM
struct IDENTINFO *DITEM;
// 370 %owninteger ELEMENTS; !range details
static int ELEMENTS;
// 371 %owninteger HASH
static int HASH;
// 372 %owninteger SPECCING=0, MCODING=0
static int SPECCING = 0;
static int MCODING = 0;
// 373 %owninteger DECLMODE, DSIZE
static int DECLMODE;
static int DSIZE;
// 374 %ownrecord(identinfo) D; !declaration details
static struct IDENTINFO D;
// 375
// 376 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 377
// 378 !! Source file input and listing
// 379 %owninteger ATOM=0; !current lexical atom
static int ATOM = 0;
// 380 %owninteger MATCHED=1; !indic that atom has been matched
static int MATCHED = 1;
// 381 %owninteger SYM=nl; !current input symbol
static int SYM = 10;
// 382 %owninteger LINE=0; !current line number
static int LINE = 0;
// 383 %owninteger MAINLINE=0
static int MAINLINE = 0;
// 384 %owninteger DIAGLINE=-9999
static int DIAGLINE = -9999;
// 385 %owninteger PROLINE=0
static int PROLINE = 0;
// 386 %owninteger MODESYM='&'; !space or '+' or '&' or '"'
static int MODESYM = 38;
// 387 !%owninteger OUTCOL=0; !output line position
// 388 ! Pointers to source file:
// 389 %owninteger LINESTART=0
static int LINESTART = 0;
// 390 %owninteger FP=0; !(file pointer) current position
static int FP = 0;
// 391 %owninteger CHARS=0
static int CHARS = 0;
// 392 %owninteger ATOMP=0; !start of current atom
static int ATOMP = 0;
// 393 %owninteger FAULTP=0; !fault position
static int FAULTP = 0;
// 394 %owninteger MAINFP
static int MAINFP;
// 395 %owninteger STRINGP,EXPP
static int STRINGP;
static int EXPP;
// 396 %owninteger listout=0
static int LISTOUT = 0;
// 397 !
// 398 !! Listing, diagnostic and report routines
// 399 !
// 400 %ownstring(255) rep=""
static _imp_string255 REP = _imp_str_init("");
// 401 !
// 402 %routine NEWLINE
void NEWLINE(void) {
// 403 print string(rep); print symbol(nl)
_imp_PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = REP/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
_imp_PRINTSYMBOL(10);
// 404 rep = ""
/* clang-format off */
_imp_strncpy(/*?*/&REP, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 405 %end
return;
} /* end of NEWLINE */
// 406 !
// 407 %routine PUT SYM(%integer k)
void PUTSYM(int K) {
// 408 rep = rep.tostring(k) %if length(rep) < 132
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP) >= 132) goto L_0001;
/* clang-format off */
_imp_strncpy(/*?*/&REP, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&REP, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(K); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
L_0001:;
// 409 %end
return;
} /* end of PUTSYM */
// 410 !
// 411 %routine PRINT STRING(%string(255) s)
void PRINTSTRING(_imp_string255 S) {
// 412 rep = rep.s %if length(rep) < 132
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP) >= 132) goto L_0002;
/* clang-format off */
_imp_strncpy(/*?*/&REP, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&REP, (_imp_string *)/*?*/&S); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
L_0002:;
// 413 %end
return;
} /* end of PRINTSTRING */
// 414 !
// 415 %routine SPACES(%integer n)
void SPACES(int N) {
// 416 %while n > 0 %cycle
L_0003:;
if (N <= 0) goto L_0004;
// 417 rep = rep." "; n = n-1
/* clang-format off */
_imp_strncpy(/*?*/&REP, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&REP, (_imp_string *)/*?*/_imp_str_literal_ptr(" ")); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
N = N - 1;
// 418 %repeat
goto L_0003;
L_0004:;
// 419 %end
return;
} /* end of SPACES */
// 420 !
// 421 %routine WRITE(%integer val,p)
void WRITE(int VAL, int P) {
// 422 %routine PD(%integer v)
void PD(int V) {
// 423 p = p-1
P = P - 1;
// 424 pd(v//10) %and v = v-v//10*10 %if v <= -10
if (V > -10) goto L_0005;
PD(((long)V / (long)10));
V = V - ((long)V / (long)10) * 10;
L_0005:;
// 425 spaces(p) %and p = 0 %if p > 0
if (P <= 0) goto L_0006;
SPACES(P);
P = 0;
L_0006:;
// 426 put sym('0'-v)
PUTSYM(48 - V);
// 427 %end
return;
} /* end of PD */
// 428 %if val < 0 %start
if (VAL >= 0) goto L_0007;
// 429 put sym('-'); pd(val)
PUTSYM(45);
PD(VAL);
// 430 %finish %else pd(-val)
goto L_0008;
L_0007:;
PD(-VAL);
L_0008:;
// 431 %end
return;
} /* end of WRITE */
// 432
// 433 !%routine put ident(%integer t)
// 434 ! rep = rep.string(charbase+t)
// 435 !!%integer l
// 436 ! t = t+charbase
// 437 ! l = byteinteger(t); l = 11 %if l > 11
// 438 ! %while l > 0 %cycle
// 439 ! l = l-1; t = t+1
// 440 ! put sym(byteinteger(t))
// 441 ! %repeat
// 442 !%end
// 443 !
// 444 !%routine mark at(%integer col)
// 445 ! put sym(' ') %while outcol < col; put sym('|')
// 446 !%end
// 447 !
// 448 !%routine show dict(%integer from)
// 449 !%integer f,i
// 450 !%record(identinfo) d
// 451 !%constbyteintegerarray flagsym(0:7) =
// 452 ! 'V','L','P','O','S','E', 'A', 'M'
// 453 !%constbyteintegerarray dsym(0:3) =
// 454 ! ' ','D','I','!'
// 455 !%conststring(6)%array typetext(0:7) =
// 456 ! "NULL ", "RECORD", "ARRAY ", "STRING",
// 457 ! "REALY ", "INTY ", "CHAR ", "BOOL "
// 458 ! %return %if from >= dlim
// 459 ! newline %and outcol = 0 %if outcol # 0
// 460 ! print string(" __identifier___flags___type___extra___value___")
// 461 ! newline; outcol = 0
// 462 ! %cycle
// 463 ! spaces(5); outcol = 5
// 464 ! pdec(from); mark at(10)
// 465 ! d = dict(from)
// 466 ! put sym(' ')
// 467 ! put ident(d_text)
// 468 ! mark at(23)
// 469 ! %for i = 7,-1,0 %cycle
// 470 ! %if d_flags>>i&1 = 0 %then put sym(' ') %c
// 471 ! %else put sym(flagsym(i))
// 472 ! %repeat
// 473 ! put sym('|')
// 474 ! i = d_type-nulltype
// 475 ! %if 0 <= i <= 7 %then printstring(typetext(i)) %c
// 476 ! %else putsym(dsym(d_type>>13)) %and pdec(d_type&puretype)
// 477 ! mark at(39)
// 478 ! put sym(' '); pdec(d_extra); mark at(47)
// 479 ! put sym(' '); pdec(d_val); mark at(56)
// 480 ! newline; outcol = 0
// 481 ! from = from+1
// 482 ! %repeat %until from = dlim
// 483 ! print string(" +----------------------------------------------+")
// 484 ! newline; outcol = 0
// 485 !%end
// 486 !
// 487 !%routine show exp(%integer from,to)
// 488 !![out of date]
// 489 !%conststring(7)%array acttext(0:63) =
// 490 ! "?0", "?1", "ADD", "SUB",
// 491 ! "?4", "LOGAND", "LOGOR", "LOGXOR",
// 492 ! "NEGATE", "LOGNOT", "LSHIFT", "RSHIFT",
// 493 ! "IABS", "FABS", "?14", "?15",
// 494 ! "MULT", "IDIV", "IPOWER", "FPLUS",
// 495 ! "FMINUS", "FMULT", "FDIV", "FPOWER",
// 496 ! "FNEGATE", "FLOAT", "CONCAT", "BOOLNOT",
// 497 ! "BOOLAND", "BOOLOR", "MEMBER", "MODULO",
// 498 ! "RECREF", "AREF", "INDRECT", "SWJUMP",
// 499 ! "FCALL", "MCALL", "?38", "RCALL",
// 500 ! "?40", "ASSIGN", "JAMASS", "PLUSASS",
// 501 ! "COMPARE", "JUMP", "LABEL", "ADECL",
// 502 ! "?48", "?49", "?50", "?51",
// 503 ! "?52", "?53", "?54", "?55",
// 504 ! "?56", "?57", "?58", "?59",
// 505 ! "?60", "?61", "?62", "?63"
// 506 !%routine put operand(%integer i)
// 507 ! %if dictmin <= i <= dictmax %then put ident(dict(i)_text) %else pdec(i)
// 508 !%end
// 509 ! %return %if from >= np
// 510 ! newline %and outcol = 0 %if outcol # 0
// 511 ! print string(" __action_____first_______second____")
// 512 ! newline; outcol = 0
// 513 ! %cycle
// 514 ! spaces(5); outcol = 5
// 515 ! pdec(from); mark at(10)
// 516 ! put sym(' '); printstring(acttext(exp(from)_act&63))
// 517 ! mark at(20); put sym(' ')
// 518 ! put operand(exp(from)_x)
// 519 ! mark at(32); put sym(' ')
// 520 ! put operand(exp(from)_y)
// 521 ! mark at(44)
// 522 ! newline; outcol = 0
// 523 ! from = from+1
// 524 ! %if from = to %start
// 525 ! from = explo
// 526 ! %exit %if from >= oldexplo
// 527 ! printstring(" |---------------------------------|")
// 528 ! newline; outcol = 0
// 529 ! %finish
// 530 ! %repeat %until from >= oldexplo
// 531 ! oldexplo = explo
// 532 ! print string(" +---------------------------------+")
// 533 ! newline; outcol = 0
// 534 !%end
// 535 !
// 536 !! Fault reporting
// 537 !
// 538 %routine REPORT(%integer n,joker)
void REPORT(int N, int JOKER) {
// 539 %integer mark,start,errline,k,editfp
int MARK;
int START;
int ERRLINE;
int K;
int EDITFP;
// 540 %routine PRINT IDENT(%integer x)
void PRINTIDENT(int X) {
// 541 put sym('"')
PUTSYM(34);
// 542 print string(string(dict(x)_text+charbase))
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = *_imp_STRING(DICT[X - 2001].TEXT + CHARBASE)/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 543 put sym('"')
PUTSYM(34);
// 544 %end
return;
} /* end of PRINTIDENT */
// 545 %routine PRINT TEXT(%integer x,stream)
void PRINTTEXT(int X, int STREAM) {
// 546 %constinteger esc=27
// 547 %integer k,p
int K;
int P;
// 548 %switch s(0:errmax)
int S_index;
int S_line;
char *S_file;
static const void *S[47] = {
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing};
// 549 put sym(mark)
PUTSYM(MARK);
// 550 write(line,4)
WRITE(LINE, 4);
// 551 put sym(modesym); put sym(' ')
PUTSYM(MODESYM);
PUTSYM(32);
// 552 ->s(n&63)
S_line = __LINE__;
S_file = __FILE__;
S_index = N & 63;
goto case_S_dispatch;
// 553 s(formerr): printstring("Faulty form"); -> print
case_S_0:;
PRINTSTRING(_imp_str_literal("Faulty form"));
goto U_1000;
// 554 s(atomerr): printstring("Unknown atom"); -> print
case_S_1:;
PRINTSTRING(_imp_str_literal("Unknown atom"));
goto U_1000;
// 555 s(namerr): printstring("Unknown name"); -> print
case_S_2:;
PRINTSTRING(_imp_str_literal("Unknown name"));
goto U_1000;
// 556 s(caterr): printstring("Unsuitable"); -> print
case_S_3:;
PRINTSTRING(_imp_str_literal("Unsuitable"));
goto U_1000;
// 557 s(sizerr): printstring("Size"); -> print
case_S_4:;
PRINTSTRING(_imp_str_literal("Size"));
goto U_1000;
// 558 s(typerr): printstring("Wrong type"); -> print
case_S_6:;
PRINTSTRING(_imp_str_literal("Wrong type"));
goto U_1000;
// 559 s(boundserr): printstring("Inside out"); -> print
case_S_14:;
PRINTSTRING(_imp_str_literal("Inside out"));
goto U_1000;
// 560 s(unending): printstring("Endless loop"); -> print
case_S_37:;
PRINTSTRING(_imp_str_literal("Endless loop"));
goto U_1000;
// 561 s(indexerr): printstring("Index"); -> print
case_S_24:;
PRINTSTRING(_imp_str_literal("Index"));
goto U_1000;
// 562 s(accesserr): printstring("Not accessible");-> print
case_S_15:;
PRINTSTRING(_imp_str_literal("Not accessible"));
goto U_1000;
// 563 s(notinloop): printstring("Not in loop"); -> print
case_S_16:;
PRINTSTRING(_imp_str_literal("Not in loop"));
goto U_1000;
// 564 s(notinrout): printstring("Not in routine");-> print
case_S_17:;
PRINTSTRING(_imp_str_literal("Not in routine"));
goto U_1000;
// 565 s(notinfun): printstring("Not in fn/map"); -> print
case_S_18:;
PRINTSTRING(_imp_str_literal("Not in fn/map"));
goto U_1000;
// 566 s(notinpred): printstring("Not in pred"); -> print
case_S_19:;
PRINTSTRING(_imp_str_literal("Not in pred"));
goto U_1000;
// 567 s(plexerr): printstring("Too complex!"); -> print
case_S_20:;
PRINTSTRING(_imp_str_literal("Too complex!"));
goto U_1000;
// 568 s(duperr): printstring("Duplicate"); -> print
case_S_7:;
PRINTSTRING(_imp_str_literal("Duplicate"));
goto U_1000;
// 569 s(ordererr): printstring("Out of order"); -> print
case_S_10:;
PRINTSTRING(_imp_str_literal("Out of order"));
goto U_1000;
// 570 s(matcherr): printstring("Mismatch"); -> print
case_S_11:;
PRINTSTRING(_imp_str_literal("Mismatch"));
goto U_1000;
// 571 s(rangerr): printstring("Out of range"); -> print
case_S_12:;
PRINTSTRING(_imp_str_literal("Out of range"));
goto U_1000;
// 572 s(nonliteral):printstring("Not literal"); -> print
case_S_13:;
PRINTSTRING(_imp_str_literal("Not literal"));
goto U_1000;
// 573 s(nonstand): printstring("Nonstandard"); -> print
case_S_22:;
PRINTSTRING(_imp_str_literal("Nonstandard"));
goto U_1000;
// 574 s(notin): printstring("Not in yet"); -> print
case_S_23:;
PRINTSTRING(_imp_str_literal("Not in yet"));
goto U_1000;
// 575 s(moperr): printstring("Faulty operand");-> print
case_S_27:;
PRINTSTRING(_imp_str_literal("Faulty operand"));
goto U_1000;
// 576 s(nocycle): printstring("Missing %CYCLE"); -> print
case_S_9:;
PRINTSTRING(_imp_str_literal("Missing %CYCLE"));
goto U_1000;
// 577 s(nostart): printstring("Missing %START"); -> print
case_S_8:;
PRINTSTRING(_imp_str_literal("Missing %START"));
goto U_1000;
// 578 s(noif): printstring("Missing %IF"); -> print
case_S_21:;
PRINTSTRING(_imp_str_literal("Missing %IF"));
goto U_1000;
// 579 s(noterm): printstring("';' missing"); -> print
case_S_28:;
PRINTSTRING(_imp_str_literal("';' missing"));
goto U_1000;
// 580 s(nonstarter):printstring("Non-starter"); -> print
case_S_29:;
PRINTSTRING(_imp_str_literal("Non-starter"));
goto U_1000;
// 581 s(nonvar): printstring("Not variable"); -> print
case_S_30:;
PRINTSTRING(_imp_str_literal("Not variable"));
goto U_1000;
// 582 s(nonref): printstring("Not reference"); -> print
case_S_31:;
PRINTSTRING(_imp_str_literal("Not reference"));
goto U_1000;
// 583 s(noparm): printstring("No parameters"); -> print
case_S_35:;
PRINTSTRING(_imp_str_literal("No parameters"));
goto U_1000;
// 584 s(toofew): printstring("Too few"); -> print
case_S_33:;
PRINTSTRING(_imp_str_literal("Too few"));
goto U_1000;
// 585 s(unwanted): printstring("Unwanted"); -> print
case_S_34:;
PRINTSTRING(_imp_str_literal("Unwanted"));
goto U_1000;
// 586 s(toomany): printstring("Too many"); -> print
case_S_32:;
PRINTSTRING(_imp_str_literal("Too many"));
goto U_1000;
// 587 s(selfref): printstring("Self-reference"); -> print
case_S_38:;
PRINTSTRING(_imp_str_literal("Self-reference"));
goto U_1000;
// 588 s(nobegin): printstring("Extra %END"); -> print
case_S_41:;
PRINTSTRING(_imp_str_literal("Extra %END"));
goto U_1000;
// 589 print:
U_1000:;
// 590 spaces(21-length(rep))
SPACES(21 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP));
// 591 p = start
P = START;
// 592 %if p < faultp-50 %then p = faultp-47 %and printstring("...") %c
if (P >= FAULTP - 50) goto L_000A;
P = FAULTP - 47;
PRINTSTRING(_imp_str_literal("..."));
goto L_000B;
L_000A:;
PUTSYM(32);
L_000B:;
// 593+ %else put sym(' ')
// 594 %cycle
L_000C:;
// 595 k = byteinteger(p); p = p+1
K = *_imp_BYTEINTEGER(P);
P = P + 1;
// 596 %if p = faultp %start
if (P != FAULTP) goto L_000D;
// 597 !$IF VAX
// 598 put sym(esc) %and put sym('F') %if stream = 0
if (STREAM != 0) goto L_000E;
PUTSYM(27);
PUTSYM(70);
L_000E:;
// 599 !$FINISH
// 600 put sym('~')
PUTSYM(126);
// 601 !$IF VAX
// 602 put sym(esc) %and put sym('G') %if stream = 0
if (STREAM != 0) goto L_000F;
PUTSYM(27);
PUTSYM(71);
L_000F:;
// 603 !$FINISH
// 604 %finish
L_000D:;
// 605 %exit %if k = nl
if (K != 10) goto L_0010;
goto L_0011;
L_0010:;
// 606 %if ' ' <= k <= '~' %then put sym(k) %c
{
// Double-sided test on K (Part I)
int tmp;
if (32 > (tmp = K)) goto L_0012;
// Double-sided test on K (Part II)
if (tmp > 126) goto L_0012;
}
PUTSYM(K);
goto L_0013;
L_0012:;
PUTSYM(91);
WRITE(K, -1);
PUTSYM(93);
L_0013:;
// 607+ %else put sym('[') %and write(k,-1) %and put sym(']')
// 608 %repeat
goto L_000C;
L_0011:;
// 609 %return
return;
// 610 s(noend): printstring("%END"); ->mend
case_S_40:;
PRINTSTRING(_imp_str_literal("%END"));
goto U_1001;
// 611 s(noresult): printstring("Result"); ->mend
case_S_46:;
PRINTSTRING(_imp_str_literal("Result"));
goto U_1001;
// 612 s(nofinish): printstring("%FINISH"); ->mend0
case_S_43:;
PRINTSTRING(_imp_str_literal("%FINISH"));
goto U_1002;
// 613 s(norepeat): printstring("%REPEAT")
case_S_44:;
PRINTSTRING(_imp_str_literal("%REPEAT"));
// 614 mend0: printstring(" etc") %if curlab > lab1+2
U_1002:;
if (CURLAB <= 3235 + 2) goto L_0014;
PRINTSTRING(_imp_str_literal(" etc"));
L_0014:;
// 615 -> mend
goto U_1001;
// 616 s(idmissing):
case_S_42:;
// 617 %cycle
L_0015:;
// 618 ! newline %and spaces(8) %and outcol = 8 %if outcol > 50
// 619 put sym(' ')
PUTSYM(32);
// 620 print ident(x)
PRINTIDENT(X);
// 621 print string("(?)") %if dict(x)_flags&spec = 0; !switch
if (DICT[X - 2001].FLAGS & 16 != 0) goto L_0016;
PRINTSTRING(_imp_str_literal("(?)"));
L_0016:;
// 622 x = dict(x)_val
X = DICT[X - 2001].VAL;
// 623 %repeat %until x = 0
if (X == 0) goto L_0017;
goto L_0015;
L_0017:;
// 624 mend:
U_1001:;
// 625 printstring(" missing")
PRINTSTRING(_imp_str_literal(" missing"));
// 626 %if c_type # 0 %start
if (C.TYPE == 0) goto L_0018;
// 627 print string(" at END of ")
PRINTSTRING(_imp_str_literal(" at END of "));
// 628 print ident(c_pidpos)
PRINTIDENT(C.PIDPOS);
// 629 %finish %else n = 0
goto L_0019;
L_0018:;
N = 0;
L_0019:;
// 630 %return
return;
// 631 s(counterr):
case_S_45:;
// 632 %if elements < 0 %start
if (ELEMENTS >= 0) goto L_001A;
// 633 write(-elements,0); printstring(" extra")
WRITE(-ELEMENTS, 0);
PRINTSTRING(_imp_str_literal(" extra"));
// 634 %finish %else %start
goto L_001B;
L_001A:;
// 635 write(elements,0); printstring(" missing")
WRITE(ELEMENTS, 0);
PRINTSTRING(_imp_str_literal(" missing"));
// 636 %finish
L_001B:;
// 637 printstring(" value(s) for ")
PRINTSTRING(_imp_str_literal(" value(s) for "));
// 638 print ident(x)
PRINTIDENT(X);
// 639 %return
return;
// 640 s(asserr):
case_S_5:;
// 641 print ident(x)
PRINTIDENT(X);
// 642 print string(" void")
PRINTSTRING(_imp_str_literal(" void"));
// 643 %end
return;
case_S_dispatch:
if (S_index < 0 || S_index > 46)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
goto *S[S_index - 0];
case_S_missing:
_imp_signalf(8, 2, S_index, "switch jump to undefined label S(%d): at %s line %d", S_index, S_file, S_line);
} /* end of PRINTTEXT */
// 644
// 645 !Warning or error
// 646 mark = '?'
MARK = 63;
// 647 %if n&warn = 0 %start
if (N & 128 != 0) goto L_001C;
// 648 mark = '*'
MARK = 42;
// 649 c_faults = c_faults+1; faults = faults+1
C.FAULTS = C.FAULTS + 1;
FAULTS = FAULTS + 1;
// 650 %finish
L_001C:;
// 651 faultnum = 0; c_access = -1
FAULTNUM = 0;
C.ACCESS = -1;
// 652 !Ignore uncorrected earlier error
// 653 %return %if main_start1 <= fp < change
{
// Double-sided test on FP (Part I)
int tmp;
if (MAIN->START1 > (tmp = FP)) goto L_001D;
// Double-sided test on FP (Part II)
if (tmp >= CHANGE) goto L_001D;
}
return;
L_001D:;
// 654 !Track back if before current line
// 655 start = linestart; errline = line
START = LINESTART;
ERRLINE = LINE;
// 656 %if n&point = 0 %then faultp = 0 %else %start
if (N & 64 != 0) goto L_001E;
FAULTP = 0;
goto L_001F;
L_001E:;
// 657 faultp = joker %if joker > 0
if (JOKER <= 0) goto L_0020;
FAULTP = JOKER;
L_0020:;
// 658 %while faultp <= start %cycle
L_0021:;
if (FAULTP > START) goto L_0022;
// 659 start = start-1
START = START - 1;
// 660 errline = errline-1 %if byteinteger(start) = nl
if (*_imp_BYTEINTEGER(START) != 10) goto L_0023;
ERRLINE = ERRLINE - 1;
L_0023:;
// 661 %repeat
goto L_0021;
L_0022:;
// 662 start = start-1 %while start # curstart %and byteinteger(start-1) # nl
L_0024:;
if (START == CURSTART) goto L_0025;
if (*_imp_BYTEINTEGER(START - 1) == 10) goto L_0025;
START = START - 1;
goto L_0024;
L_0025:;
// 663 %finish
L_001F:;
// 664 editfp = start; editfp = faultp-1 %if faultp > start
EDITFP = START;
if (FAULTP <= START) goto L_0026;
EDITFP = FAULTP - 1;
L_0026:;
// 665 editfp = mainfp %if curlim = extra_lim2
if (CURLIM != EXTRA.LIM2) goto L_0027;
EDITFP = MAINFP;
L_0027:;
// 666 start = start+1 %while byteinteger(start) = ' '
L_0028:;
if (*_imp_BYTEINTEGER(START) != 32) goto L_0029;
START = START + 1;
goto L_0028;
L_0029:;
// 667 print text(joker,0)
PRINTTEXT(JOKER, 0);
// 668 newline %and %return %if n&warn # 0 %or nonstop # 0
if (N & 128 != 0) goto L_002A;
if (NONSTOP == 0) goto L_002B;
L_002A:;
NEWLINE();
return;
L_002B:;
// 669 main_fp = editfp; main_line = line
MAIN->FP = EDITFP;
MAIN->LINE = LINE;
// 670 %if change # 0 %then main_change = 16_7FFFFFFE
if (CHANGE == 0) goto L_002C;
MAIN->CHANGE = 2147483646;
L_002C:;
// 671 edi(main,null,rep)
EDI(MAIN, /*?*/ &NULL,
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = REP/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 672 rep = ""
/* clang-format off */
_imp_strncpy(/*?*/&REP, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 673 nonstop = 1 %if main_flag = 'I'
if (MAIN->FLAG != 73) goto L_002D;
NONSTOP = 1;
L_002D:;
// 674 %stop %if main_flag < 0
if (MAIN->FLAG >= 0) goto L_002E;
_imp_stop(0);
L_002E:;
// 675 %signal 12 %if main_change < 16_7FFFFFFE {change made}
if (MAIN->CHANGE >= 2147483646) goto L_002F;
_imp_signal(12, 0, 0, "");
L_002F:;
// 676 %end;
return;
} /* end of REPORT */
// ?K unused
// 677 ; !report
// 677
// 678 %routine CROAK(%string(255) s)
void CROAK(_imp_string255 S) {
// 679 print string("** ".s.". Checking abandoned at line ")
PRINTSTRING(
/* clang-format off */
*({ __typeof__(_imp_string255) tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&*({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/_imp_str_literal_ptr("** "), (_imp_string *)/*?*/&S); (_imp_string255 *)&tmp;}), (_imp_string *)/*?*/_imp_str_literal_ptr(". Checking abandoned at line ")); (_imp_string255 *)&tmp;})/*q*/; (_imp_string255 *)&tmp; })
/* clang-format on */
);
// 680 write(line,0); newline
WRITE(LINE, 0);
NEWLINE();
// 681 nonstop = -999
NONSTOP = -999;
// 682 %signal 12
_imp_signal(12, 0, 0, "");
// 683 %end
return;
} /* end of CROAK */
// 684
// 685 %routine FAULT(%integer n)
void FAULT(int N) {
// 686 !Note fault number and position of (earliest) fault
// 687 ! for subsequent reporting (warnings and weak errors)
// 688 faultnum = n %and faultp = atomp %if faultnum = 0
if (FAULTNUM != 0) goto L_0030;
FAULTNUM = N;
FAULTP = ATOMP;
L_0030:;
// 689 %end
return;
} /* end of FAULT */
// 690 %routine EXPFAULT(%integer n)
void EXPFAULT(int N) {
// 691 faultnum = n!point %and faultp = expp %if faultnum = 0 %or expp < faultp
if (FAULTNUM == 0) goto L_0031;
if (EXPP >= FAULTP) goto L_0032;
L_0031:;
FAULTNUM = N | 64;
FAULTP = EXPP;
L_0032:;
// 692 %end
return;
} /* end of EXPFAULT */
// 693
// 694 %constinteger pred=1, uparr=1<<1, nocomma=1<<2, overload=1<<3,
// 695+ ranges=1<<4, nolength=1<<5, initass=1<<6, kgoto=1<<7,
// 696+ hyphen=1<<8, naming=1<<9, klabel=1<<10, ibmhex=1<<11,
// 697+ oldcycle=1<<12, loop2=1<<13
// 698 %routine NONSTANDARD(%integer case)
void NONSTANDARD(int CASE) {
// 699 %owninteger hadit=0
static int HADIT = 0;
// 700 %if control&nonsbit # 0 %and case&hadit = 0 %start
if (CONTROL & 65536 == 0) goto L_0033;
if (CASE & HADIT != 0) goto L_0033;
// 701 hadit = hadit+case
HADIT = HADIT + CASE;
// 702 fault(nonstand+point+warn)
FAULT(22 + 64 + 128);
// 703 %finish
L_0033:;
// 704 %end
return;
} /* end of NONSTANDARD */
// 705
// 706 %routine ERROR(%integer case)
void ERROR(int CASE) {
// 707 report(case,atomp)
REPORT(CASE, ATOMP);
// 708 %signal 14
_imp_signal(14, 0, 0, "");
// 709 %end
return;
} /* end of ERROR */
// 710
// 711 %routine NAME ERROR
void NAMEERROR(void) {
// 712 !check if the culprit has occurred before
// 713 !and, if not, add it to the pool of unknowns stored at the
// 714 !far end of the dictionary.
// 715 %while item < 0 %c
L_0034:;
if (ITEM >= 0) goto L_0035;
/* clang-format off */
if (_imp_strcmp((_imp_string *)_imp_STRING(DICT[-ITEM - 2001].TEXT + CHARBASE), (_imp_string *)_imp_STRING(CHARLIM)) == 0) goto L_0035;
/* clang-format on */
// 716+ %and string(dict(-item)_text+charbase) # string(charlim) %cycle
// 717 item = dict(-item)_link
ITEM = DICT[-ITEM - 2001].LINK;
// 718 %repeat
goto L_0034;
L_0035:;
// 719 %if item >= 0 %start; !first time
if (ITEM < 0) goto L_0036;
// 720 report(namerr+point,atomp)
REPORT(2 + 64, ATOMP);
// 721 %if charmin-newlen-80 >= charlim %start
if (CHARMIN - NEWLEN - 80 < CHARLIM) goto L_0037;
// 722 dmin = dmin-1
DMIN = DMIN - 1;
// 723 charmin = charmin-newlen-1
CHARMIN = CHARMIN - NEWLEN - 1;
// 724 string(charmin) = string(charlim)
*_imp_STRING(CHARMIN) = *_imp_STRING(CHARLIM);
// 725 dict(dmin)_text = charmin-charbase
DICT[DMIN - 2001].TEXT = CHARMIN - CHARBASE;
// 726 head == dict(head)_link %while head > 0; !find last link
L_0038:;
if (*HEAD <= 0) goto L_0039;
HEAD = (int *)/*?*/ &DICT[*HEAD - 2001].LINK;
goto L_0038;
L_0039:;
// 727 dict(dmin)_link = head; head = -dmin
DICT[DMIN - 2001].LINK = *HEAD;
*HEAD = -DMIN;
// 728 %finish
L_0037:;
// 729 %finish
L_0036:;
// 730 %signal 14
_imp_signal(14, 0, 0, "");
// 731 %end
return;
} /* end of NAMEERROR */
// 732
// 733 %routine SYNTAX ERROR
void SYNTAXERROR(void) {
// 734 %integer e
int E;
// 735 e = formerr+point; e = atomerr+point %if atom = dud
E = 0 + 64;
if (ATOM != 63) goto L_003A;
E = 1 + 64;
L_003A:;
// 736 report(e,atomp)
REPORT(E, ATOMP);
// 737 %signal 14
_imp_signal(14, 0, 0, "");
// 738 %end
return;
} /* end of SYNTAXERROR */
// 739
// 740 !!!!!!!!!!!!!!!!!!!! CELL CONSTRUCTORS !!!!!!!!!!!!!!!!!!!
// 741 !
// 742 !%integerfn litref(%integer v)
// 743 !%integer i
// 744 ! %result = v %if smallmin <= v <= smallmax
// 745 ! litstore(litpos) = v
// 746 ! i = litmin-1
// 747 ! i = i+1 %until litstore(i) = v
// 748 ! %if i = litpos %start
// 749 ! litpos = litpos+1
// 750 ! croak("Too many literals") %if litpos >= slitpos
// 751 ! %finish
// 752 ! %result = i
// 753 !%end
// 754
// 755 !%integerfn litval(%integer v)
// 756 ! %result = v %if v <= smallmax
// 757 ! %result = litstore(v)
// 758 !%end
// 759
// 760 %integerfn floated(%integer item)
int FLOATED(int ITEM) {
// 761 %result = 0 %if item = 0
if (ITEM != 0) goto L_003B;
return 0;
L_003B:;
// 762 %result = explo;!expref(float,item,0)
return EXPLO;
// 763 %end
} /* end of FLOATED */
// 764
// 765 !%predicate is short (%integer v)
// 766 ! %true %if -32768 <= v <= 32767
// 767 ! %false
// 768 !%end
// 769
// 770 !%predicate is mite (%integer v)
// 771 ! %true %if -128 <= v <= 127
// 772 ! %false
// 773 !%end
// 774
// 775 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 776 !!!!!!!!!!!!!!!!! CODE GENERATION !!!!!!!!!!!!!!!!!!!!!!!!
// 777 !
// 778 %routine forget
void FORGET(void) {
// 779 %end
return;
} /* end of FORGET */
// 780 %routine forget all
void FORGETALL(void) {
// 781 %integer i,j
int I;
int J;
// 782 litpos = litmin; explo = expmax+1; oldexplo = explo
LITPOS = 1001;
EXPLO = 3554 + 1;
OLDEXPLO = EXPLO;
// 783 %end
return;
} /* end of FORGETALL */
// ?J unused
// ?I unused
// 784 !
// 785 %routine set label(%integer b)
void SETLABEL(int B) {
// 786 %end;
return;
} /* end of SETLABEL */
// ?B unused
// 787 ; !set label
void SETUSERLABEL(int DPOS) {
// 787 %routine set user label(%integer dpos)
// 788 %end
return;
} /* end of SETUSERLABEL */
// ?DPOS unused
// 789 %routine compile(%integer from,to)
void COMPILE(int FROM, int TO) {
// 790 ! show exp(from,to) %if control&explist # 0
// 791 np = np0
NP = 3255;
// 792 %end
return;
} /* end of COMPILE */
// ?TO unused
// ?FROM unused
// 793 %routine compile entry
void COMPILEENTRY(void) {
// 794 %end
return;
} /* end of COMPILEENTRY */
// 795 %routine compile end
void COMPILEEND(void) {
// 796 %end; !compile end
return;
} /* end of COMPILEEND */
// 797 !!!!!!!!!!!!!!! end of Code Generation !!!!!!!!!!!!!!!!!!!!!!!
// 798 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 799
// 800 %routine PUT3(%integer act,x,y)
void PUT3(int ACT, int X, int Y) {
// 801 ! exp(np)_act = act; exp(np)_x = x; exp(np)_y = y
// 802 ! np = np+1
// 803 %end
return;
} /* end of PUT3 */
// ?Y unused
// ?X unused
// ?ACT unused
// 804 !
// 805 %routine PUT2(%integer act,x)
void PUT2(int ACT, int X) {
// 806 %end
return;
} /* end of PUT2 */
// ?X unused
// ?ACT unused
// 807 !
// 808 %integerfn TEMPVAR
int TEMPVAR(void) {
// 809 %result = dlim
return DLIM;
// 810 %end
} /* end of TEMPVAR */
// 811
// 812 %routine OPEN BLOCK(%integer pidpos)
void OPENBLOCK(int PIDPOS) {
// 813 forget; !a bit extreme
FORGET();
// 814 croak("Too many levels") %if level = maxlevel
if (LEVEL != 16) goto L_003C;
CROAK(_imp_str_literal("Too many levels"));
L_003C:;
// 815 hold(level) = c; level = level+1
HOLD[LEVEL] = C;
LEVEL = LEVEL + 1;
// 816 c = 0
C = (struct BLOCKINF){0};
// 817 starts = 0; cycles = 0
STARTS = 0;
CYCLES = 0;
// 818 curlab = lab1; looplab = 0
CURLAB = 3235;
LOOPLAB = 0;
// 819 forget all
FORGETALL();
// 820 c_flags = 0; c_type = d_type
C.FLAGS = 0;
C.TYPE = D.TYPE;
// 821 c_pidpos = pidpos
C.PIDPOS = PIDPOS;
// 822 c_localdpos = dlim; c_parlim = dlim; c_localtext = charlim
C.LOCALDPOS = DLIM;
C.PARLIM = DLIM;
C.LOCALTEXT = CHARLIM;
// 823 c_localpc = pc; c_localspc = spc
C.LOCALPC = PC;
C.LOCALSPC = SPC;
// 824 c_access = 1
C.ACCESS = 1;
// 825 %end; !OPEN BLOCK
return;
} /* end of OPENBLOCK */
// 826
// 827 %routine CLOSE BLOCK
void CLOSEBLOCK(void) {
// 828 %integer i
int I;
// 829 %integer miss,dpos
int MISS;
int DPOS;
// 830 %integername p
int *P;
// 831 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 832 !Check identifier usage
// 833 miss = 0; p == miss
MISS = 0;
P = (int *)/*?*/ &MISS;
// 834 dpos = c_localdpos
DPOS = C.LOCALDPOS;
// 835 %while dpos # dlim %cycle
L_003D:;
if (DPOS == DLIM) goto L_003E;
// 836 dp == dict(dpos)
DP = (struct IDENTINFO *)/*?*/ &DICT[DPOS - 2001];
// 837 ! %if (dp_xtype = ptrxtype %and dp_type = dpos)
// 838 %if dp_flags&(proc+lab) # 0 %and dp_flags&(ext+spec) = spec %start
if (DP->FLAGS & 4 + 2 == 0) goto L_003F;
if (DP->FLAGS & 32 + 16 != 16) goto L_003F;
// 839 p = dpos; p == dp_val; p = 0
*P = DPOS;
P = (int *)/*?*/ &DP->VAL;
*P = 0;
// 840 %finish
L_003F:;
// 841 ! %if hashindex(dp_spare) = dpos %start
// 842 ! dp_link = dict(dp_link)_link %while dp_link >= c_localdpos
// 843 ! hashindex(dp_spare) = dp_link
// 844 ! %finish
// 845 ! dpos = dp_xtype %if dp_type = 0 %and dp_xtype > dpos; !skip fields
// 846 dpos = dpos+1
DPOS = DPOS + 1;
// 847 %repeat
goto L_003D;
L_003E:;
// 848 report(idmissing,miss) %if miss # 0
if (MISS == 0) goto L_0040;
REPORT(42, MISS);
L_0040:;
// 849 compile end
COMPILEEND();
// 850 pc = c_localpc; spc = c_localspc
PC = C.LOCALPC;
SPC = C.LOCALSPC;
// 851 dlim = c_parlim; charlim = c_localtext
DLIM = C.PARLIM;
CHARLIM = C.LOCALTEXT;
// 852 %for i = 0,1,255 %cycle
// %for I = 0, 1, 255 %cycle
{
I = -1;
L_0041:
if (I == 255) goto L_0042;
I += 1;
// 853 hashindex(i) = dict(hashindex(i))_link %while hashindex(i) >= c_localdpos
L_0044:;
if (HASHINDEX[I] < C.LOCALDPOS) goto L_0045;
HASHINDEX[I] = DICT[HASHINDEX[I] - 2001].LINK;
goto L_0044;
L_0045:;
// 854 %repeat
goto L_0041;
}
L_0042:;
// 855 level = level-1; c = hold(level)
LEVEL = LEVEL - 1;
C = HOLD[LEVEL];
// 856 starts = 0; cycles = 0
STARTS = 0;
CYCLES = 0;
// 857 %end; !CLOSE BLOCK
return;
} /* end of CLOSEBLOCK */
// 858
// 859 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 860 !!!!!!!!!!!!!!!!!!!! Source input !!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 861 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 862 !
// 863 %routine SWITCH INPUT
void SWITCHINPUT(void) {
// 864 ! croak("Input ended") %if fp = main_lim2
// 865 %signal 12 %if fp = main_lim2
if (FP != MAIN->LIM2) goto L_0046;
_imp_signal(12, 0, 0, "");
L_0046:;
// 866 %if nonstop < 0 %start; !perming
if (NONSTOP >= 0) goto L_0047;
// 867 nonstop = nonstop+3; permlim = dlim
NONSTOP = NONSTOP + 3;
PERMLIM = DLIM;
// 868 c_localdpos = dlim; c_parlim = dlim
C.LOCALDPOS = DLIM;
C.PARLIM = DLIM;
// 869 statements = 0
STATEMENTS = 0;
// 870 %finish
L_0047:;
// 871 %if fp # main_lim1 %start
if (FP == MAIN->LIM1) goto L_0048;
// 872 nonstop = nonstop-1
NONSTOP = NONSTOP - 1;
// 873 fp = mainfp; line = mainline
FP = MAINFP;
LINE = MAINLINE;
// 874 curstart = main_start1; curlim = main_lim1
CURSTART = MAIN->START1;
CURLIM = MAIN->LIM1;
// 875 %finish %else fp = main_start2
goto L_0049;
L_0048:;
FP = MAIN->START2;
L_0049:;
// 876 %if main_start2 <= fp <= main_lim2 %start
{
// Double-sided test on FP (Part I)
int tmp;
if (MAIN->START2 > (tmp = FP)) goto L_004A;
// Double-sided test on FP (Part II)
if (tmp > MAIN->LIM2) goto L_004A;
}
// 877 curstart = main_start2; curlim = main_lim2
CURSTART = MAIN->START2;
CURLIM = MAIN->LIM2;
// 878 %finish
L_004A:;
// 879 modesym = ' '; sym = nl
MODESYM = 32;
SYM = 10;
// 880 %end
return;
} /* end of SWITCHINPUT */
// 881
// 882 %routine READ LINE
void READLINE(void) {
// 883 ! Read (or otherwise make available) the next source line
// 884 ! Skip remnant of previous line if SYM # NL *NB*
// 885 ! Set LINESTART to point to start of new line
// 886 report(faultnum,faultp) %if faultnum # 0
if (FAULTNUM == 0) goto L_004B;
REPORT(FAULTNUM, FAULTP);
L_004B:;
// 887 %while sym # nl %cycle; !Skip remnant
L_004C:;
if (SYM == 10) goto L_004D;
// 888 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 889 %repeat
goto L_004C;
L_004D:;
// 890 %while fp = curlim %cycle
L_004E:;
if (FP != CURLIM) goto L_004F;
// 891 switch input
SWITCHINPUT();
// 892 %repeat
goto L_004E;
L_004F:;
// 893 line = line+1; linestart = fp
LINE = LINE + 1;
LINESTART = FP;
// 894 sym = 0
SYM = 0;
// 895 %end; !READ LINE
return;
} /* end of READLINE */
// 896 !
// 897 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 898 !!!!!!!!!!!!!!!!!!!! Lexical processing !!!!!!!!!!!!!!!!!!!!!!
// 899 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 900
// 901 %owninteger percent=0, subatom=0
static int PERCENT = 0;
static int SUBATOM = 0;
// 902 !
// 903 !Aliases:
// 904 %constinteger ARROW=resolve
// 905 %constinteger EXCLAM=logor, EXCLAM2=logxor, DOT=concat
// 906 %constinteger STAR=mult, SLASH=fdiv, SLASH2=idiv,
// 907+ AMPERSAND=logand
// 908 %constinteger BACKSLASH=fpower, BACKSLASH2=ipower,
// 909+ UPARROW=fpower, UPARROW2=ipower,
// 910+ TILDE=lognot
// 911 %constinteger LEFT=aref, UNDERLINE=recref, LEFTBRACKET=106
// 912
// 913 %constinteger SIMPLE=104, MAJOR=plus,
// 914+ SCOND=equals, COND=keyand
// 915 !
// 916 ! Type compatibility vectors:
// 917 %constinteger RECOK=1<<0, ARROK=1<<1, STRINGOK=1<<2,
// 918+ REALOK=1<<3, INTOK=1<<4, CHAROK=1<<5,
// 919+ BOOLOK=1<<6, ENUMOK=1<<7, SETOK=1<<8
// 920 %constinteger ZNOP=1<<9, REFONLY=1<<10, VARONLY=1<<11
// 921 %constinteger ARITHOK=intok+realok,
// 922+ ORDOK=intok+charok+boolok+enumok,
// 923+ ANY=realok+ordok+stringok+arrok+recok
// 924 !
// 925 %constintegerarray opbits(64:atommax) =
const int OPBITS[44] = {64, 64, 0, 0, 0, 0, 255, 255, 508, 252, 508, 252, 255, 255, 0,
4, 792, 792, 528, 528, 4, 0, 0, 0, 24, 24, 16, 16, 0, 0,
0, 0, 24, 16, 0, 0, 528, 528, 16, 0, 2, 1, 0, 0};
struct _imp_dv OPBITS_dv = {OPBITS, sizeof(int) /*, dims, <bounds> */};
// 926+ {BOOLAND} boolok,
// 927+ {BOOLOR} boolok,
// 928+ 0, 0, 0, 0,
// 929+ {EQUALS} any,
// 930+ {NOTEQ} any,
// 931+ {LESSEQ} setok+stringok+ordok+realok,
// 932+ {LESS} stringok+ordok+realok,
// 933+ {GREATEQ} setok+stringok+ordok+realok,
// 934+ {GREATER} stringok+ordok+realok,
// 935+ any,
// 936+ any,
// 937+ 0,
// 938+ {RESOLVE} stringok,
// 939+ {PLUS} znop+setok+arithok,
// 940+ {MINUS} znop+setok+arithok,
// 941+ {LOGOR} znop+intok,
// 942+ {LOGXOR} znop+intok,
// 943+ {CONCAT} stringok,
// 944+ 0, 0, 0,
// 945+ {MULT} arithok,
// 946+ {FDIV} arithok,
// 947+ {IDIV} intok,
// 948+ {LOGAND} intok,
// 949+ 0, 0, 0, 0,
// 950+ {FPOWER} arithok,
// 951+ {IPOWER} intok,
// 952+ 0, 0,
// 953+ {LSHIFT} znop+intok,
// 954+ {RSHIFT} znop+intok,
// 955+ {LOGNOT} intok,
// 956+ 0,
// 957+ {AREF} arrok,
// 958+ {RECREF} recok,
// 959+ {} 0, 0
// 960 !
// 961 %integerfn NEXT ATOM
int NEXTATOM(void) {
// 962 !Encode next atom from source file
// 963 ![Time-critical]
// 964 %switch s(0:255)
int S_index;
int S_line;
char *S_file;
static const void *S[256] = {
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing};
// 965 %constinteger tab=9
// 966 %integer i,j,p,radix,digits
int I;
int J;
int P;
int RADIX;
int DIGITS;
// 967 %real rval
float RVAL;
// 968 %constbyteintegerarray map(0:127) =
const unsigned char MAP[128] = {[0 ... 47] = 0,
48,
49,
50,
51,
52,
53,
54,
55,
56,
57,
0,
0,
0,
0,
0,
0,
0,
97,
98,
99,
100,
101,
102,
103,
104,
105,
106,
107,
108,
109,
110,
111,
112,
113,
114,
115,
116,
117,
118,
119,
120,
121,
122,
0,
0,
0,
0,
0,
0,
97,
98,
99,
100,
101,
102,
103,
104,
105,
106,
107,
108,
109,
110,
111,
112,
113,
114,
115,
116,
117,
118,
119,
120,
121,
122,
0,
0,
0,
0,
0};
struct _imp_dv MAP_dv = {MAP, sizeof(unsigned char) /*, dims, <bounds> */};
// 969+ 0 ('0'),
// 970+ '0','1','2','3','4','5','6','7','8','9',
// 971+ 0, 0, 0, 0, 0, 0, 0,
// 972+ 'a','b','c','d','e','f','g','h','i','j','k','l','m',
// 973+ 'n','o','p','q','r','s','t','u','v','w','x','y','z',
// 974+ 0, 0, 0, 0, 0, 0,
// 975+ 'a','b','c','d','e','f','g','h','i','j','k','l','m',
// 976+ 'n','o','p','q','r','s','t','u','v','w','x','y','z',
// 977+ 0, 0, 0, 0, 0
// 978
// 979 %routine assemble real
void ASSEMBLEREAL(void) {
// 980 j = 0
J = 0;
// 981 %cycle
L_0050:;
// 982 %cycle
L_0051:;
// 983 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 984 %repeat %until sym # ' '
if (SYM != 32) goto L_0052;
goto L_0051;
L_0052:;
// 985 i = sym-'0'
I = SYM - 48;
// 986 %return %unless 0 <= i < radix
{
// Double-sided test on I (Part I)
int tmp;
if (0 > (tmp = I)) goto L_0053;
// Double-sided test on I (Part II)
if (tmp < RADIX) goto L_0054;
}
L_0053:;
return;
L_0054:;
// 987 rval = rval*radix+i; j = j+1
RVAL = RVAL * RADIX + I;
J = J + 1;
// 988 %repeat
goto L_0050;
// 989 %end
} /* end of ASSEMBLEREAL */
// 990
// 991 ! atoms = atoms+1
// 992 matched = 0
MATCHED = 0;
// 993 again: s(tab):
U_1003:;
case_S_9:;
// 994 read line %if sym = nl
if (SYM != 10) goto L_0056;
READLINE();
L_0056:;
// 995 %cycle
L_0057:;
// 996 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 997 %repeat %until sym # ' '
if (SYM != 32) goto L_0058;
goto L_0057;
L_0058:;
// 998 atomp = fp; !(actually one after)
ATOMP = FP;
// 999 -> s(sym)
S_line = __LINE__;
S_file = __FILE__;
S_index = SYM;
goto case_S_dispatch;
// 1000 linebreak: s(nl):
U_1004:;
case_S_10:;
// 1001 %result = terminator %if atom # comma
if (ATOM == 59) goto L_0059;
return 52;
L_0059:;
// 1002 -> again
goto U_1003;
// 1003
// 1004 s('{'):
case_S_123:;
// 1005 %cycle
L_005A:;
// 1006 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 1007 -> linebreak %if sym = nl
if (SYM != 10) goto L_005B;
goto U_1004;
L_005B:;
// 1008 %repeat %until sym = '}'
if (SYM == 125) goto L_005C;
goto L_005A;
L_005C:;
// 1009 -> again
goto U_1003;
// 1010
// 1011 s('+'): %result = plus
case_S_43:;
return 80;
// 1012 s('-'): fp = fp+1 %and %result = arrow %if byteinteger(fp) = '>'
case_S_45:;
if (*_imp_BYTEINTEGER(FP) != 62) goto L_005D;
FP = FP + 1;
return 79;
L_005D:;
// 1013 -> again %if byteinteger(fp) = nl
if (*_imp_BYTEINTEGER(FP) != 10) goto L_005E;
goto U_1003;
L_005E:;
// 1014 %result = minus
return 81;
// 1015 s('*'): %result = star
case_S_42:;
return 88;
// 1016 s('/'): fp = fp+1 %and %result = slash2 %if byteinteger(fp) = '/'
case_S_47:;
if (*_imp_BYTEINTEGER(FP) != 47) goto L_005F;
FP = FP + 1;
return 90;
L_005F:;
// 1017 %result = slash
return 89;
// 1018 s('\'): fp = fp+1 %and %result = backslash2 %if byteinteger(fp) = '\'
case_S_92:;
if (*_imp_BYTEINTEGER(FP) != 92) goto L_0060;
FP = FP + 1;
return 97;
L_0060:;
// 1019 %result = backslash
return 96;
// 1020 s('^'): nonstandard(uparr)
case_S_94:;
NONSTANDARD(2);
// 1021 fp = fp+1 %and %result = uparrow2 %if byteinteger(fp) = '^'
if (*_imp_BYTEINTEGER(FP) != 94) goto L_0061;
FP = FP + 1;
return 97;
L_0061:;
// 1022 %result = uparrow
return 96;
// 1023 s('!'): fp = fp+1 %and %result = exclam2 %if byteinteger(fp) = '!'
case_S_33:;
if (*_imp_BYTEINTEGER(FP) != 33) goto L_0062;
FP = FP + 1;
return 83;
L_0062:;
// 1024 %result = exclam
return 82;
// 1025 s('&'): %result = ampersand
case_S_38:;
return 91;
// 1026 s('.'): %result = dot
case_S_46:;
return 84;
// 1027 s('='): fp = fp+1 %and %result = eqeq %if byteinteger(fp) = '='
case_S_61:;
if (*_imp_BYTEINTEGER(FP) != 61) goto L_0063;
FP = FP + 1;
return 76;
L_0063:;
// 1028 %result = equals
return 70;
// 1029 s('#'): fp = fp+1 %and %result = noteqeq %if byteinteger(fp) = '#'
case_S_35:;
if (*_imp_BYTEINTEGER(FP) != 35) goto L_0064;
FP = FP + 1;
return 77;
L_0064:;
// 1030 %result = noteq
return 71;
// 1031 s('<'): fp = fp+1 %and %result = lesseq %if byteinteger(fp) = '='
case_S_60:;
if (*_imp_BYTEINTEGER(FP) != 61) goto L_0065;
FP = FP + 1;
return 72;
L_0065:;
// 1032 fp = fp+1 %and %result = noteq %if byteinteger(fp) = '>'
if (*_imp_BYTEINTEGER(FP) != 62) goto L_0066;
FP = FP + 1;
return 71;
L_0066:;
// 1033 fp = fp+1 %and %result = lshift %if byteinteger(fp) = '<'
if (*_imp_BYTEINTEGER(FP) != 60) goto L_0067;
FP = FP + 1;
return 100;
L_0067:;
// 1034 %result = less
return 73;
// 1035 s('>'): fp = fp+1 %and %result = greateq %if byteinteger(fp) = '='
case_S_62:;
if (*_imp_BYTEINTEGER(FP) != 61) goto L_0068;
FP = FP + 1;
return 74;
L_0068:;
// 1036 fp = fp+1 %and %result = rshift %if byteinteger(fp) = '>'
if (*_imp_BYTEINTEGER(FP) != 62) goto L_0069;
FP = FP + 1;
return 101;
L_0069:;
// 1037 %result = greater
return 75;
// 1038 s('_'): %result = underline
case_S_95:;
return 56;
// 1039 s(':'): %result = colon
case_S_58:;
return 58;
// 1040 s(','): %result = comma
case_S_44:;
return 59;
// 1041 s(';'): %result = terminator
case_S_59:;
return 52;
// 1042 s('('): %result = left
case_S_40:;
return 55;
// 1043 s(')'): %result = right
case_S_41:;
return 60;
// 1044 s('|'): %result = modsign
case_S_124:;
return 57;
// 1045
// 1046 s('E'): s('e'):
case_S_69:;
case_S_101:;
// 1047 fp = fp+1 %and -> stringconst %if byteinteger(fp) = '"'
if (*_imp_BYTEINTEGER(FP) != 34) goto L_006A;
FP = FP + 1;
goto U_1005;
L_006A:;
// 1048 s('M'): s('m'): s('C'): s('c'):
case_S_77:;
case_S_109:;
case_S_67:;
case_S_99:;
// 1049 fp = fp+1 %and -> charconst %if byteinteger(fp) = ''''
if (*_imp_BYTEINTEGER(FP) != 39) goto L_006B;
FP = FP + 1;
goto U_1006;
L_006B:;
// 1050 s('A'):s('B'):s('D'):s('F'):s('G'):s('H'):
case_S_65:;
case_S_66:;
case_S_68:;
case_S_70:;
case_S_71:;
case_S_72:;
// 1051 s('I'):s('J'):s('K'):s('L'):s('N'):s('O'):s('P'):
case_S_73:;
case_S_74:;
case_S_75:;
case_S_76:;
case_S_78:;
case_S_79:;
case_S_80:;
// 1052 s('Q'):s('R'):s('S'):s('T'):s('U'):s('V'):s('W'):s('X'):
case_S_81:;
case_S_82:;
case_S_83:;
case_S_84:;
case_S_85:;
case_S_86:;
case_S_87:;
case_S_88:;
// 1053 s('Y'):s('Z'):s('a'):s('b'):s('d'):s('f'):
case_S_89:;
case_S_90:;
case_S_97:;
case_S_98:;
case_S_100:;
case_S_102:;
// 1054 s('g'):s('h'):s('i'):s('j'):s('k'):s('l'):s('n'):
case_S_103:;
case_S_104:;
case_S_105:;
case_S_106:;
case_S_107:;
case_S_108:;
case_S_110:;
// 1055 s('o'):s('p'):s('q'):s('r'):s('s'):s('t'):s('u'):s('v'):
case_S_111:;
case_S_112:;
case_S_113:;
case_S_114:;
case_S_115:;
case_S_116:;
case_S_117:;
case_S_118:;
// 1056 s('w'):s('x'):s('y'):s('z'):
case_S_119:;
case_S_120:;
case_S_121:;
case_S_122:;
// 1057 -> keyword %if percent # 0
if (PERCENT == 0) goto L_006C;
goto U_1007;
L_006C:;
// 1058 ! identatoms = identatoms+1
// 1059 newlen = charlim+1; hash = sym!casebit; !lower-case (if letter)
NEWLEN = CHARLIM + 1;
HASH = SYM | 32;
// 1060 byteinteger(newlen) = hash
*_imp_BYTEINTEGER(NEWLEN) = HASH;
// 1061 %cycle
L_006D:;
// 1062 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 1063 %repeat %until sym # ' '
if (SYM != 32) goto L_006E;
goto L_006D;
L_006E:;
// 1064 !$IF AMDAHL
// 1065 { %if sym = '''' %start
// 1066 { radix = 16 %and -> ibm %if hash = 'x'
// 1067 { radix = 8 %and -> ibm %if hash = 'k'
// 1068 { radix = 2 %and -> ibm %if hash = 'b'
// 1069 { %finish
// 1070 !$FINISH
// 1071 sym = map(sym)
SYM = MAP[SYM];
// 1072 %if sym # 0 %start
if (SYM == 0) goto L_006F;
// 1073 %cycle
L_0070:;
// 1074 newlen = newlen+1; byteinteger(newlen) = sym
NEWLEN = NEWLEN + 1;
*_imp_BYTEINTEGER(NEWLEN) = SYM;
// 1075 hash = hash<<1!!sym
HASH = HASH << 1 ^ SYM;
// 1076 %cycle
L_0071:;
// 1077 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 1078 %repeat %until sym # ' '
if (SYM != 32) goto L_0072;
goto L_0071;
L_0072:;
// 1079 sym = map(sym)
SYM = MAP[SYM];
// 1080 %repeat %until sym = 0
if (SYM == 0) goto L_0073;
goto L_0070;
L_0073:;
// 1081 %finish
L_006F:;
// 1082 fp = fp-1
FP = FP - 1;
// 1083 newlen = newlen-charlim; byteinteger(charlim) = newlen
NEWLEN = NEWLEN - CHARLIM;
*_imp_BYTEINTEGER(CHARLIM) = NEWLEN;
// 1084 head == hashindex(hash&255)
HEAD = (int *)/*?*/ &HASHINDEX[HASH & 255];
// 1085 item = head
ITEM = *HEAD;
// 1086 %if item > 0 %start
if (ITEM <= 0) goto L_0074;
// 1087 %cycle
L_0075:;
// 1088 %result = ident %if item <= 0
if (ITEM > 0) goto L_0076;
return 54;
L_0076:;
// 1089 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM - 2001];
// 1090 %exit %if string(ditem_text+charbase) = string(charlim)
/* clang-format off */
if (_imp_strcmp((_imp_string *)_imp_STRING(DITEM->TEXT + CHARBASE), (_imp_string *)_imp_STRING(CHARLIM)) != 0) goto L_0077;
/* clang-format on */
goto L_0078;
L_0077:;
// 1091 ! misses = misses+1
// 1092 item = ditem_link
ITEM = DITEM->LINK;
// 1093 %repeat %until item <= 0
if (ITEM <= 0) goto L_0078;
goto L_0075;
L_0078:;
// 1094 %finish
L_0074:;
// 1095 %result = ident
return 54;
// 1096
// 1097 s('%'):
case_S_37:;
// 1098 sym = byteinteger(fp)
SYM = *_imp_BYTEINTEGER(FP);
// 1099 -> again %unless 'a' <= sym!casebit <= 'z'
{
// Double-sided test on SYM | 32 (Part I)
int tmp;
if (97 > (tmp = SYM | 32)) goto L_0043;
// Double-sided test on SYM | 32 (Part II)
if (tmp <= 122) goto L_0079;
}
L_0043:;
goto U_1003;
L_0079:;
// 1100 fp = fp+1
FP = FP + 1;
// 1101 keyword:
U_1007:;
// 1102 percent = 0
PERCENT = 0;
// 1103 p = syminit(sym!casebit)
P = SYMINIT[(SYM | 32) - 97];
// 1104 %cycle
L_007A:;
// 1105 ! %cycle
// 1106 ! sym = byteinteger(fp)!casebit
// 1107 ! %exit %if symbol(p) # sym
// 1108 %while symbol(p) = byteinteger(fp)!casebit %cycle
L_007B:;
if (SYMBOL[P - 1] != *_imp_BYTEINTEGER(FP) | 32) goto L_007C;
// 1109 p = p+1; fp = fp+1
P = P + 1;
FP = FP + 1;
// 1110 %repeat
goto L_007B;
L_007C:;
// 1111 %exit %if symbol(p) >= 128
if (SYMBOL[P - 1] < 128) goto L_007D;
goto L_007E;
L_007D:;
// 1112 atom = altdisp(p)
ATOM = ALTDISP[P - 1];
// 1113 %if atom = 0 %start
if (ATOM != 0) goto L_007F;
// 1114 %result = dud %unless sym!casebit = 'c' %and byteinteger(fp) = nl
if (SYM | 32 != 99) goto L_0080;
if (*_imp_BYTEINTEGER(FP) == 10) goto L_0081;
L_0080:;
return 63;
L_0081:;
// 1115 read line
READLINE();
// 1116 ->again
goto U_1003;
// 1117 %finish
L_007F:;
// 1118 p = p+atom
P = P + ATOM;
// 1119 %repeat
goto L_007A;
L_007E:;
// 1120 percent = 1 %if 'a' <= byteinteger(fp)!casebit <= 'z'
{
// Double-sided test on *_imp_BYTEINTEGER(FP) | 32 (Part I)
unsigned char tmp;
if (97 > (tmp = *_imp_BYTEINTEGER(FP) | 32)) goto L_0082;
// Double-sided test on *_imp_BYTEINTEGER(FP) | 32 (Part II)
if (tmp > 122) goto L_0082;
}
PERCENT = 1;
L_0082:;
// 1121 subatom = altdisp(p)
SUBATOM = ALTDISP[P - 1];
// 1122 atom = symbol(p)-128
ATOM = SYMBOL[P - 1] - 128;
// 1123 %result = dud %if atom = 0
if (ATOM != 0) goto L_0083;
return 63;
L_0083:;
// 1124 %result = atom
return ATOM;
// 1125
// 1126 !$IF AMDAHL
// 1127 {ibm:
// 1128 { nonstandard(ibmhex)
// 1129 { item = -1; t_val = 0
// 1130 { -> ibm1
// 1131 !$FINISH
// 1132 s('0'):s('1'):s('2'):s('3'):s('4'):s('5'):s('6'):s('7'):s('8'):s('9'):
case_S_48:;
case_S_49:;
case_S_50:;
case_S_51:;
case_S_52:;
case_S_53:;
case_S_54:;
case_S_55:;
case_S_56:;
case_S_57:;
// 1133 item = 0; t_type = inty
ITEM = 0;
T.TYPE = 2046;
// 1134 radix = 10; t_val = sym-'0'
RADIX = 10;
T.VAL = SYM - 48;
// 1135 ibm1:
U_1008:;
// 1136 %cycle
L_0084:;
// 1137 %cycle
L_0085:;
// 1138 %cycle
L_0086:;
// 1139 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 1140 %repeat %until sym # ' '
if (SYM != 32) goto L_0087;
goto L_0086;
L_0087:;
// 1141 i = sym-'0'
I = SYM - 48;
// 1142 %if radix = 10 %start
if (RADIX != 10) goto L_0088;
// 1143 %exit %if i < 0 %or i >= 10
if (I < 0) goto L_0089;
if (I < 10) goto L_008A;
L_0089:;
goto L_008B;
L_008A:;
// 1144 %if t_val > max10 %or (t_val=max10 %and i > maxdig) %start
if (T.VAL > 214748364) goto L_008C;
if (T.VAL != 214748364) goto L_008D;
if (I <= 7) goto L_008D;
L_008C:;
// 1145 t_type = realy; rval = t_val
T.TYPE = 2045;
RVAL = T.VAL;
// 1146 assemble real
ASSEMBLEREAL();
// 1147 %exit
goto L_008B;
// 1148 %finish
L_008D:;
// 1149 t_val = t_val*10+i
T.VAL = T.VAL * 10 + I;
// 1150 %finish %else %start
goto L_008E;
L_0088:;
// 1151 i = sym!casebit-'a'+10 %if i >= 10
if (I < 10) goto L_008F;
I = (SYM | 32) - 97 + 10;
L_008F:;
// 1152 %exit %if i < 0 %or i >= radix
if (I < 0) goto L_0090;
if (I < RADIX) goto L_0091;
L_0090:;
goto L_008B;
L_0091:;
// 1153 j = radix
J = RADIX;
// 1154 %cycle
L_0092:;
// 1155 i = i+t_val %if j&1 # 0
if (J & 1 == 0) goto L_0093;
I = I + T.VAL;
L_0093:;
// 1156 t_val = t_val<<1; j = j>>1
T.VAL = T.VAL << 1;
J = (unsigned int)J >> 1;
// 1157 %repeat %until j = 0
if (J == 0) goto L_0094;
goto L_0092;
L_0094:;
// 1158 t_val = i
T.VAL = I;
// 1159 %finish
L_008E:;
// 1160 %repeat
goto L_0085;
L_008B:;
// 1161 %exit %unless sym = '_'
if (SYM == 95) goto L_0095;
goto L_0096;
L_0095:;
// 1162 radix = t_val
RADIX = T.VAL;
// 1163 %result = dud %if radix = 0
if (RADIX != 0) goto L_0097;
return 63;
L_0097:;
// 1164 t_val = 0
T.VAL = 0;
// 1165 %repeat
goto L_0084;
L_0096:;
// 1166 %if sym = '.' %start
if (SYM != 46) goto L_0098;
// 1167 t_type = realy %and rval = t_val %if t_type = inty
if (T.TYPE != 2046) goto L_0099;
T.TYPE = 2045;
RVAL = T.VAL;
L_0099:;
// 1168 assemble real
ASSEMBLEREAL();
// 1169 %result = dud %if j = 0
if (J != 0) goto L_009A;
return 63;
L_009A:;
// 1170 rval = rval/radix\j
RVAL = (double)(RVAL / (_imp_REXP(RADIX, J)));
// 1171 %finish
L_0098:;
// 1172 ! %if t_type = realy %start; !vax->ieee
// 1173 ! t_val = integer(addr(rval))
// 1174 ! t_val = t_val<<16+t_val>>16-16_01000000
// 1175 ! %finish
// 1176 ! numatoms = numatoms+1
// 1177 !$IF AMDAHL
// 1178 { %if item < 0 %start
// 1179 { %result = dud %if sym # ''''
// 1180 { item = 0
// 1181 { %finish %else %start
// 1182 { fp = fp-1; sym = 0
// 1183 { %finish
// 1184 !$IF VAX OR APM
// 1185 fp = fp-1; sym = 0
FP = FP - 1;
SYM = 0;
// 1186 !$FINISH
// 1187 %result = const
return 53;
// 1188
// 1189 s(''''):
case_S_39:;
// 1190 charconst:
U_1006:;
// 1191 item = 0; t_type = inty
ITEM = 0;
T.TYPE = 2046;
// 1192 t_val = 0
T.VAL = 0;
// 1193 %cycle
L_009B:;
// 1194 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 1195 %result = dud %if sym = nl; !?allow
if (SYM != 10) goto L_009C;
return 63;
L_009C:;
// 1196 %if sym = '''' %start
if (SYM != 39) goto L_009D;
// 1197 %exit %unless byteinteger(fp) = ''''
if (*_imp_BYTEINTEGER(FP) == 39) goto L_009E;
goto L_009F;
L_009E:;
// 1198 fp = fp+1
FP = FP + 1;
// 1199 %finish
L_009D:;
// 1200 t_val = t_val<<8+sym
T.VAL = (T.VAL << 8) + SYM;
// 1201 %repeat
goto L_009B;
L_009F:;
// 1202 %result = const %if t_val # 0
if (T.VAL == 0) goto L_00A0;
return 53;
L_00A0:;
// 1203 %result = dud
return 63;
// 1204
// 1205 s('"'):
case_S_34:;
// 1206 stringconst:
U_1005:;
// 1207 item = 0; t_type = stringy
ITEM = 0;
T.TYPE = 2044;
// 1208 stringp = atomp; !for include
STRINGP = ATOMP;
// 1209 t_val = 0
T.VAL = 0;
// 1210 i = line; j = linestart
I = LINE;
J = LINESTART;
// 1211 %cycle
L_00A1:;
// 1212 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 1213 %if sym = '"' %start
if (SYM != 34) goto L_00A2;
// 1214 %exit %if byteinteger(fp) # '"'
if (*_imp_BYTEINTEGER(FP) == 34) goto L_00A3;
goto L_00A4;
L_00A3:;
// 1215 fp = fp+1
FP = FP + 1;
// 1216 %finish
L_00A2:;
// 1217 t_val = t_val+1
T.VAL = T.VAL + 1;
// 1218 %if t_val > 255 %start
if (T.VAL <= 255) goto L_00A5;
// 1219 sym = 0
SYM = 0;
// 1220 fp = atomp; linestart = j
FP = ATOMP;
LINESTART = J;
// 1221 %result = dud
return 63;
// 1222 %finish
L_00A5:;
// 1223 read line %if sym = nl
if (SYM != 10) goto L_00A6;
READLINE();
L_00A6:;
// 1224 %repeat
goto L_00A1;
L_00A4:;
// 1225 %result = const
return 53;
// 1226
// 1227 s(*):
case_S_default:;
// 1228 %result = dud
return 63;
// 1229 %end;
case_S_dispatch:
if (S_index < 0 || S_index > 255)
_imp_signalf(6, 3, S_index, "->S(%d) out of bounds at %s line %d", S_index, S_file, S_line);
goto *S[S_index - 0];
case_S_missing:
_imp_signalf(8, 2, S_index, "switch jump to undefined label S(%d): at %s line %d", S_index, S_file, S_line);
} /* end of NEXTATOM */
// ?IBM1 unused
// ?DIGITS unused
// 1230 ; !NEXT ATOM
// 1230
// 1231 %routine LOOKUP FIELD IDENT(%integer list)
void LOOKUPFIELDIDENT(int LIST) {
// 1232 item = list; %return %if item = 0
ITEM = LIST;
if (ITEM != 0) goto L_00A7;
return;
L_00A7:;
// 1233 %cycle
L_00A8:;
// 1234 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM - 2001];
// 1235 %if ditem_flags&typeid = 0 %start
if (DITEM->FLAGS & 256 != 0) goto L_00A9;
// 1236 %return %if string(ditem_text+charbase) = string(charlim)
/* clang-format off */
if (_imp_strcmp((_imp_string *)_imp_STRING(DITEM->TEXT + CHARBASE), (_imp_string *)_imp_STRING(CHARLIM)) != 0) goto L_00AA;
/* clang-format on */
return;
L_00AA:;
// 1237 %exit %if ditem_flags&more = 0
if (DITEM->FLAGS & 128 != 0) goto L_00AB;
goto L_00AC;
L_00AB:;
// 1238 %finish
L_00A9:;
// 1239 item = item+1; !misses = misses+1
ITEM = ITEM + 1;
// 1240 %repeat
goto L_00A8;
L_00AC:;
// 1241 item = 0
ITEM = 0;
// 1242 %end
return;
} /* end of LOOKUPFIELDIDENT */
// 1243
// 1244 %predicate A (%integer k)
int A(int K) {
// 1245 !Basic atom-testing predicate
// 1246 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_00AD;
ATOM = NEXTATOM();
L_00AD:;
// 1247 %false %if k # atom
if (K == ATOM) goto L_00AE;
return 0 /*FALSE*/;
L_00AE:;
// 1248 matched = 1
MATCHED = 1;
// 1249 %true
return 1 /*TRUE*/;
// 1250 %end
} /* end of A */
// 1251
// 1252 %routine GET(%integer k)
void GET(int K) {
// 1253 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_00AF;
ATOM = NEXTATOM();
L_00AF:;
// 1254 matched = 1
MATCHED = 1;
// 1255 %return %if atom = k
if (ATOM != K) goto L_00B0;
return;
L_00B0:;
// 1256 syntax error %if atom = dud
if (ATOM != 63) goto L_00B1;
SYNTAXERROR();
L_00B1:;
// 1257 faultp = atomp; report(formerr+point,-k)
FAULTP = ATOMP;
REPORT(0 + 64, -K);
// 1258 %signal 14
_imp_signal(14, 0, 0, "");
// 1259 %end
return;
} /* end of GET */
// 1260
// 1261 %routine ALLOW(%integer k)
void ALLOW(int K) {
// 1262 %if a(k) %start
if (!(A(K))) goto L_00B2;
// 1263 %finish
L_00B2:;
// 1264 %end
return;
} /* end of ALLOW */
// 1265
// 1266 %routine DECLARE
void DECLARE(void) {
// 1267 %if speccing = 0 %start; !not within spec params
if (SPECCING != 0) goto L_00B3;
// 1268 %if item >= c_localdpos %start; !there already
if (ITEM < C.LOCALDPOS) goto L_00B4;
// 1269 %if d_flags&spec = 0 %and d_flags+spec = ditem_flags %c
if (D.FLAGS & 16 != 0) goto L_00B5;
if (D.FLAGS + 16 != DITEM->FLAGS) goto L_00B5;
if (DITEM->TYPE != D.TYPE) goto L_00B5;
// 1270+ %and ditem_type = d_type %start
// 1271 ditem_flags = ditem_flags-spec
DITEM->FLAGS = DITEM->FLAGS - 16;
// 1272 %return
return;
// 1273 %finish
L_00B5:;
// 1274 fault(duperr+point)
FAULT(7 + 64);
// 1275 %finish
L_00B4:;
// 1276 d_link = head; head = dlim; !insert in list
D.LINK = *HEAD;
*HEAD = DLIM;
// 1277 ! d_spare = hash&255
// 1278 %if item > 0 %then d_text = ditem_text %c
if (ITEM <= 0) goto L_00B6;
D.TEXT = DITEM->TEXT;
goto L_00B7;
L_00B6:;
// 1279+ %else %start
// 1280 d_text = charlim-charbase; charlim = charlim+newlen+1
D.TEXT = CHARLIM - CHARBASE;
CHARLIM = CHARLIM + NEWLEN + 1;
// 1281 croak("Identifier space exhausted") %if charlim+80 >= charmin
if (CHARLIM + 80 < CHARMIN) goto L_00B8;
CROAK(_imp_str_literal("Identifier space exhausted"));
L_00B8:;
// 1282 %finish
L_00B7:;
// 1283 %finish %else d_text = 0
goto L_00B9;
L_00B3:;
D.TEXT = 0;
L_00B9:;
// 1284 item = dlim; ditem == dict(item)
ITEM = DLIM;
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM - 2001];
// 1285 ditem = d
*DITEM = D;
// 1286 dlim = dlim+1; croak("Too many identifiers") %if dlim >= dmin
DLIM = DLIM + 1;
if (DLIM < DMIN) goto L_00BA;
CROAK(_imp_str_literal("Too many identifiers"));
L_00BA:;
// 1287 %end; !DECLARE
return;
} /* end of DECLARE */
// 1288
// 1289 %routine DECLARE ANON
void DECLAREANON(void) {
// 1290 d_text = 0; d_link = 0
D.TEXT = 0;
D.LINK = 0;
// 1291 dict(dlim) = d
DICT[DLIM - 2001] = D;
// 1292 dlim = dlim+1; croak("Too many identifiers") %if dlim >= dmin
DLIM = DLIM + 1;
if (DLIM < DMIN) goto L_00BB;
CROAK(_imp_str_literal("Too many identifiers"));
L_00BB:;
// 1293 %end
return;
} /* end of DECLAREANON */
// 1294
// 1295 %owninteger jammy
static int JAMMY;
// 1296 %predicate A ASSOP
int AASSOP(void) {
// 1297 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_00BC;
ATOM = NEXTATOM();
L_00BC:;
// 1298 %if atom # equals %and atom # eqeq %start
if (ATOM == 70) goto L_00BD;
if (ATOM == 76) goto L_00BD;
// 1299 %false %unless atom = less %and byteinteger(fp) = '-'
if (ATOM != 73) goto L_00BE;
if (*_imp_BYTEINTEGER(FP) == 45) goto L_00BF;
L_00BE:;
return 0 /*FALSE*/;
L_00BF:;
// 1300 jammy = 2; fp = fp+1
JAMMY = 2;
FP = FP + 1;
// 1301 %finish %else jammy = 0
goto L_00C0;
L_00BD:;
JAMMY = 0;
L_00C0:;
// 1302 matched = 1
MATCHED = 1;
// 1303 %true
return 1 /*TRUE*/;
// 1304 %end
} /* end of AASSOP */
// 1305
// 1306 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1307 !!!!!!!!!!!!!!!!!!!! Expressions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1308 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1309
// 1310 %owninteger literal=0
static int LITERAL = 0;
auto void GETEXPRESSION(int RANK, int CONTROL);
// 1311 %routinespec get EXPRESSION(%integer rank,control)
// 1312
// 1313 %integerfn COMPAT(%integer control)
int COMPAT(int CONTROL) {
// 1314 %if t_type = inty %start
if (T.TYPE != 2046) goto L_00C1;
// 1315 %if control&intok = 0 %and control&realok # 0 %start
if (CONTROL & 16 != 0) goto L_00C2;
if (CONTROL & 8 == 0) goto L_00C2;
// 1316 item = floated(item)
ITEM = FLOATED(ITEM);
// 1317 t_type = realy
T.TYPE = 2045;
// 1318 %finish
L_00C2:;
// 1319 %result = control&(intok+realok)
return CONTROL & 16 + 8;
// 1320 %finish
L_00C1:;
// 1321 %result = control&(boolok>>(booltype-t_type)) %if t_type <= booltype
if (T.TYPE > 2048) goto L_00C3;
return CONTROL & (unsigned int)64 >> 2048 - T.TYPE;
L_00C3:;
// 1322 %result = control&enumok %if t_type < direct
if (T.TYPE >= 8192) goto L_00C4;
return CONTROL & 128;
L_00C4:;
// 1323 %result = control&arrok
return CONTROL & 2;
// 1324 %end
} /* end of COMPAT */
// 1325 !
// 1326 %integerfn LISTMATCH(%integer alist,blist)
int LISTMATCH(int ALIST, int BLIST) {
// 1327 %record(identinfo)%name ap,bp
struct IDENTINFO *AP;
struct IDENTINFO *BP;
// 1328 %result = 1 %if alist = blist
if (ALIST != BLIST) goto L_00C5;
return 1;
L_00C5:;
// 1329 %result = 0 %if alist < dictmin %or blist < dictmin
if (ALIST < 2041) goto L_00C6;
if (BLIST >= 2041) goto L_00C7;
L_00C6:;
return 0;
L_00C7:;
// 1330 %cycle
L_00C8:;
// 1331 ap == dict(alist); bp == dict(blist)
AP = (struct IDENTINFO *)/*?*/ &DICT[ALIST - 2001];
BP = (struct IDENTINFO *)/*?*/ &DICT[BLIST - 2001];
// 1332 %result = 0 %if ap_type # bp_type; !for now
if (AP->TYPE == BP->TYPE) goto L_00C9;
return 0;
L_00C9:;
// 1333 alist = alist+1; blist = blist+1
ALIST = ALIST + 1;
BLIST = BLIST + 1;
// 1334 %repeat %until ap_flags&bp_flags&more = 0
if (AP->FLAGS & BP->FLAGS & 128 == 0) goto L_00CA;
goto L_00C8;
L_00CA:;
// 1335 %result = 0 %if ap_flags&more # 0 %or bp_flags&more # 0; !for now
if (AP->FLAGS & 128 != 0) goto L_00CB;
if (BP->FLAGS & 128 == 0) goto L_00CC;
L_00CB:;
return 0;
L_00CC:;
// 1336 %result = 1
return 1;
// 1337 %end
} /* end of LISTMATCH */
// 1338 !
// 1339 %routine GET REFERENCE(%integer reftype)
void GETREFERENCE(int REFTYPE) {
// 1340 %integer type,temp
int TYPE;
int TEMP;
// 1341 get EXPRESSION(simple,refonly+any)
GETEXPRESSION(104, 1024 + 255);
// 1342 type = ditem_type&puretype; reftype = reftype&puretype
TYPE = DITEM->TYPE & 8191;
REFTYPE = REFTYPE & 8191;
// 1343 %return %if reftype = type
if (REFTYPE != TYPE) goto L_00CD;
return;
L_00CD:;
// 1344 %if type < reftype %start
if (TYPE >= REFTYPE) goto L_00CE;
// 1345 temp = type; type = reftype; reftype = temp
TEMP = TYPE;
TYPE = REFTYPE;
REFTYPE = TEMP;
// 1346 %finish
L_00CE:;
// 1347 %return %if reftype = nulltype; !untyped %name
if (REFTYPE != 2041) goto L_00CF;
return;
L_00CF:;
// 1348 type = dict(type)_type
TYPE = DICT[TYPE - 2001].TYPE;
// 1349 %return %if type <= inty %and type = reftype
if (TYPE > 2046) goto L_00D0;
if (TYPE != REFTYPE) goto L_00D0;
return;
L_00D0:;
// 1350 %return %if type >= direct %and type = dict(reftype)_type; !aname
if (TYPE < 8192) goto L_00D1;
if (TYPE != DICT[REFTYPE - 2001].TYPE) goto L_00D1;
return;
L_00D1:;
// 1351 expfault(typerr+point)
EXPFAULT(6 + 64);
// 1352 %end
return;
} /* end of GETREFERENCE */
// 1353 !
// 1354 %routine GET VALUE(%integer valtype)
void GETVALUE(int VALTYPE) {
// 1355 %record(identinfo)%name dp,p
struct IDENTINFO *DP;
struct IDENTINFO *P;
// 1356 get EXPRESSION(major,any)
GETEXPRESSION(80, 255);
// 1357 valtype = valtype&puretype
VALTYPE = VALTYPE & 8191;
// 1358 dp == dict(valtype)
DP = (struct IDENTINFO *)/*?*/ &DICT[VALTYPE - 2001];
// 1359 %if t_type # dp_type %start; !base types differ
if (T.TYPE == DP->TYPE) goto L_00D2;
// 1360 %return %if item = 0 = t_val; !zero
{
// Double-sided test on 0 (Part I)
int tmp;
if (ITEM != (tmp = 0)) goto L_00D3;
// Double-sided test on 0 (Part II)
if (tmp != T.VAL) goto L_00D3;
}
return;
L_00D3:;
// 1361 %if dp_type = realy %and t_type = inty %start
if (DP->TYPE != 2045) goto L_00D4;
if (T.TYPE != 2046) goto L_00D4;
// 1362 !float
// 1363 t_type = realy
T.TYPE = 2045;
// 1364 %return
return;
// 1365 %finish
L_00D4:;
// 1366 %else %if t_type >= inty; !scalar
goto L_00D5;
L_00D2:;
if (T.TYPE < 2046) goto L_00D6;
// 1367 %if item = 0 %start
if (ITEM != 0) goto L_00D7;
// 1368 %return %if dp_low <= t_val <= dp_val
{
// Double-sided test on T.VAL (Part I)
int tmp;
if (DP->LOW > (tmp = T.VAL)) goto L_00D8;
// Double-sided test on T.VAL (Part II)
if (tmp > DP->VAL) goto L_00D8;
}
return;
L_00D8:;
// 1369 jammy = jammy!1 %if jammy >= 0
if (JAMMY < 0) goto L_00D9;
JAMMY = JAMMY | 1;
L_00D9:;
// 1370 %finish %else %start
goto L_00DA;
L_00D7:;
// 1371 %if t_low >= dp_low %start
if (T.LOW < DP->LOW) goto L_00DB;
// 1372 %return %if t_val <= dp_val
if (T.VAL > DP->VAL) goto L_00DC;
return;
L_00DC:;
// 1373 jammy = jammy!1 %if jammy >= 0
if (JAMMY < 0) goto L_00DD;
JAMMY = JAMMY | 1;
L_00DD:;
// 1374 %return %if t_low <= dp_val
if (T.LOW > DP->VAL) goto L_00DE;
return;
L_00DE:;
// 1375 %finish %else %start
goto L_00DF;
L_00DB:;
// 1376 jammy = jammy!1 %if jammy >= 0
if (JAMMY < 0) goto L_00E0;
JAMMY = JAMMY | 1;
L_00E0:;
// 1377 %return %if t_val >= dp_low
if (T.VAL < DP->LOW) goto L_00E1;
return;
L_00E1:;
// 1378 %finish
L_00DF:;
// 1379 %finish
L_00DA:;
// 1380 expfault(rangerr+point) %if jammy < 2
if (JAMMY >= 2) goto L_00E2;
EXPFAULT(12 + 64);
L_00E2:;
// 1381 %return
return;
// 1382 %else %if t_type = stringy
L_00D6:;
if (T.TYPE != 2044) goto L_00E3;
// 1383 %if t_val > dp_val %start; !VALUE = LENGTH*
if (T.VAL <= DP->VAL) goto L_00E4;
// 1384 jammy = jammy!1 %if jammy >= 0
if (JAMMY < 0) goto L_00E5;
JAMMY = JAMMY | 1;
L_00E5:;
// 1385 expfault(rangerr+point) %if item = 0 %and jammy < 2
if (ITEM != 0) goto L_00E6;
if (JAMMY >= 2) goto L_00E6;
EXPFAULT(12 + 64);
L_00E6:;
// 1386 %finish
L_00E4:;
// 1387 %return
return;
// 1388 %else %if t_type = recy
L_00E3:;
if (T.TYPE != 2042) goto L_00E7;
// 1389 %return %if t_extra = dp_extra
if (T.EXTRA != DP->EXTRA) goto L_00E8;
return;
L_00E8:;
// 1390 jammy = jammy!1 %and %return %if jammy >= 2
if (JAMMY < 2) goto L_00E9;
JAMMY = JAMMY | 1;
return;
L_00E9:;
// 1391 !partial assignment?
// 1392 %else %if t_type = realy
goto L_00D5;
L_00E7:;
if (T.TYPE != 2045) goto L_00EA;
// 1393 %return
return;
// 1394 %finish
L_00EA:;
L_00D5:;
// 1395 expfault(typerr+point)
EXPFAULT(6 + 64);
// 1396 %end;
return;
} /* end of GETVALUE */
// ?P unused
// 1397 ; !GET VALUE
// 1397 !
// 1398 %routine GET LITERAL(%integer littype)
void GETLITERAL(int LITTYPE) {
// 1399 literal = literal+1
LITERAL = LITERAL + 1;
// 1400 get VALUE(littype)
GETVALUE(LITTYPE);
// 1401 literal = literal-1
LITERAL = LITERAL - 1;
// 1402 %end
return;
} /* end of GETLITERAL */
// 1403 !
// 1404 %routine GET LITINT
void GETLITINT(void) {
// 1405 literal = literal+1
LITERAL = LITERAL + 1;
// 1406 get EXPRESSION(major,intok)
GETEXPRESSION(80, 16);
// 1407 literal = literal-1
LITERAL = LITERAL - 1;
// 1408 %end
return;
} /* end of GETLITINT */
// 1409 !
// 1410 %routine GET LITSTRING
void GETLITSTRING(void) {
// 1411 %integer holditem
int HOLDITEM;
// 1412 !Must be quoted string (for %alias and %include)
// 1413 holditem = item; !preserve
HOLDITEM = ITEM;
// 1414 get(const)
GET(53);
// 1415 error(typerr+point) %if t_type # stringy
if (T.TYPE == 2044) goto L_00EB;
ERROR(6 + 64);
L_00EB:;
// 1416 item = holditem; !restore
ITEM = HOLDITEM;
// 1417 %end
return;
} /* end of GETLITSTRING */
// 1418 !
// 1419 %routine GET PARMLIST
void GETPARMLIST(void) {
// 1420 %record(identinfo)%name hp,dp
struct IDENTINFO *HP;
struct IDENTINFO *DP;
// 1421 %integer i,j,headitem,headact,dpos,case,procnp,first
int I;
int J;
int HEADITEM;
int HEADACT;
int DPOS;
int CASE;
int PROCNP;
int FIRST;
// 1422 headitem = item; hp == ditem
HEADITEM = ITEM;
HP = (struct IDENTINFO *)DITEM;
// 1423 headact = rcall
HEADACT = 109;
// 1424 !stack procedure ident
// 1425 ! procnp = np; put3(headact,headitem,0)
// 1426 i = 0; first = 1
I = 0;
FIRST = 1;
// 1427 dpos = headitem; dp == hp
DPOS = HEADITEM;
DP = (struct IDENTINFO *)HP;
// 1428 %cycle
L_00EC:;
// 1429 !Set up expression state from formal param details
// 1430 error(toomany+point) %if dp_flags&more = 0
if (DP->FLAGS & 128 != 0) goto L_00ED;
ERROR(32 + 64);
L_00ED:;
// 1431 dpos = dpos+1 %and dp == dict(dpos) %until dp_flags&parm # 0
L_00EE:;
DPOS = DPOS + 1;
DP = (struct IDENTINFO *)/*?*/ &DICT[DPOS - 2001];
if (DP->FLAGS & 64 != 0) goto L_00EF;
goto L_00EE;
L_00EF:;
// 1432 %if dp_flags&proc # 0 %start
if (DP->FLAGS & 4 == 0) goto L_00F0;
// 1433 get(ident)
GET(54);
// 1434 name error %if item <= 0
if (ITEM > 0) goto L_00F1;
NAMEERROR();
L_00F1:;
// 1435 fault(typerr+point) %if ditem_flags&proc = 0; !for now
if (DITEM->FLAGS & 4 != 0) goto L_00F2;
FAULT(6 + 64);
L_00F2:;
// 1436 fault(caterr+point) %if item > headitem
if (ITEM <= HEADITEM) goto L_00F3;
FAULT(3 + 64);
L_00F3:;
// 1437 %else %if dp_type < indirect; !value
goto L_00F4;
L_00F0:;
if (DP->TYPE >= 16384) goto L_00F5;
// 1438 ! %if pp_type&numericmask # 0 %then case = i&7 %and i = i+1 %c
// 1439 ! %else case = i>>3+8 %and i = i+8
// 1440 case = i&7; i = i+1
CASE = I & 7;
I = I + 1;
// 1441 get VALUE(dp_type)
GETVALUE(DP->TYPE);
// 1442 %finish %else %start; !name or proc
goto L_00F4;
L_00F5:;
// 1443 case = i>>3+8; i = i+8
CASE = ((unsigned int)I >> 3) + 8;
I = I + 8;
// 1444 get REFERENCE(dp_type)
GETREFERENCE(DP->TYPE);
// 1445 %finish
L_00F4:;
// 1446 ! case = case<<8+headact
// 1447 ! item = litref(t_val) %if item = 0
// 1448 ! j = np-1
// 1449 ! %if first = 0 %start
// 1450 ! j = np
// 1451 ! !NB Don't re-order parameters for implicits
// 1452 ! %if item >= expmin %and headitem > dnewline %start
// 1453 ! %while j > procnp %and exp(j-1)_y < expmin %cycle
// 1454 ! exp(j)_act = exp(j-1)_act; exp(j)_y = exp(j-1)_y
// 1455 ! j = j-1
// 1456 ! %repeat
// 1457 ! %finish
// 1458 ! exp(np)_x = 0; np = np+1
// 1459 ! %finish
// 1460 ! exp(j)_act = case; exp(j)_y = item
// 1461 ! first = 0
// 1462 %repeat %until %not a(comma)
if (!(A(59))) goto L_00F6;
goto L_00EC;
L_00F6:;
// 1463 ! %if hp_type # nulltype %start
// 1464 ! i = explo
// 1465 ! %while i <= expmax %cycle
// 1466 ! %if exp(i)_x = headitem %start; ![enough?]
// 1467 ! item = i; j = procnp
// 1468 ! %cycle
// 1469 ! %exit %if exp(i)_y # exp(j)_y
// 1470 ! i = i+1; j = j+1
// 1471 ! ->okf %if j >= np
// 1472 ! %repeat
// 1473 ! %finish
// 1474 ! i = i+1
// 1475 ! %repeat
// 1476 ! %cycle
// 1477 ! explo = explo-1; np = np-1
// 1478 ! exp(explo) = exp(np)
// 1479 ! %repeat %until np = procnp
// 1480 item = explo
ITEM = EXPLO;
// 1481 !okf:np = procnp
// 1482 ! %finish
// 1483 %end;
return;
} /* end of GETPARMLIST */
// ?PROCNP unused
// ?J unused
// 1484 ; !get PARMLIST
// 1484
// 1485 %routine GET RESOLUTION
void GETRESOLUTION(void) {
// 1486 %if %not a(left) %start
if (A(55)) goto L_00F7;
// 1487 get REFERENCE(anystringvar)
GETREFERENCE(18428);
// 1488 get(dot)
GET(84);
// 1489 get(left)
GET(55);
// 1490 %finish
L_00F7:;
// 1491 get VALUE(anystring)
GETVALUE(10236);
// 1492 get(right)
GET(60);
// 1493 %if a(dot) %start
if (!(A(84))) goto L_00F8;
// 1494 get REFERENCE(anystringvar)
GETREFERENCE(18428);
// 1495 %finish
L_00F8:;
// 1496 %end
return;
} /* end of GETRESOLUTION */
// 1497 !
// 1498 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1499 !
// 1500 %routine GET EXPRESSION(%integer rank,control)
void GETEXPRESSION(int RANK, int CONTROL) {
// 1501 !Main expression recognition routine
// 1502 !To bring together the treatment of all binary operators
// 1503 ! and ensure fast recognition of simple expressions,
// 1504 ! expressions of different levels are handled by
// 1505 ! precedence techniques rather than syntactically
// 1506 !CONTROL defines acceptability
// 1507 %integer type,f,opok,c1,op,atomp1,item1
int TYPE;
int F;
int OPOK;
int C1;
int OP;
int ATOMP1;
int ITEM1;
// 1508 %record(objinfo) t1
struct OBJINFO T1;
// 1509 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 1510
// 1511 %integerfn litval
int LITVAL(void) {
// 1512 %switch lit(64:atommax)
int LIT_index;
int LIT_line;
char *LIT_file;
static const void *LIT[44] = {
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing,
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing,
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing,
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing,
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing,
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing,
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing,
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing,
&&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing, &&case_LIT_missing};
// 1513 -> lit(op)
LIT_line = __LINE__;
LIT_file = __FILE__;
LIT_index = OP;
goto case_LIT_dispatch;
// 1514 lit(plus): %result = t1_val+t_val
case_LIT_80:;
return T1.VAL + T.VAL;
// 1515 lit(minus): %result = t1_val-t_val
case_LIT_81:;
return T1.VAL - T.VAL;
// 1516 lit(mult): %result = t1_val*t_val
case_LIT_88:;
return T1.VAL * T.VAL;
// 1517 lit(idiv): %result = t1_val//t_val %if t_val # 0
case_LIT_90:;
if (T.VAL == 0) goto L_00FA;
return ((long)T1.VAL / (long)T.VAL);
L_00FA:;
// 1518 fault(rangerr)
FAULT(12);
// 1519 %result = 0
return 0;
// 1520 lit(logand):
case_LIT_91:;
// 1521 lit(booland): %result = t1_val&t_val
case_LIT_64:;
return T1.VAL & T.VAL;
// 1522 lit(logor):
case_LIT_82:;
// 1523 lit(boolor): %result = t1_val!t_val
case_LIT_65:;
return T1.VAL | T.VAL;
// 1524 lit(logxor): %result = t1_val!!t_val
case_LIT_83:;
return T1.VAL ^ T.VAL;
// 1525 lit(lshift): %result = t1_val<<t_val
case_LIT_100:;
return T1.VAL << T.VAL;
// 1526 lit(rshift): %result = t1_val>>t_val
case_LIT_101:;
return (unsigned int)T1.VAL >> T.VAL;
// 1527 lit(boolnot): %result = t_val!!true
case_LIT_66:;
return T.VAL ^ 1;
// 1528 lit(lognot): %result = \t_val
case_LIT_102:;
return (~T.VAL);
// 1529 !lit(negate): %result = -t_val
// 1530 lit(equals): %result = true %if t1_val = t_val
case_LIT_70:;
if (T1.VAL != T.VAL) goto L_00FB;
return 1;
L_00FB:;
// 1531 %result = false
return 0;
// 1532 lit(noteq): %result = true %if t1_val # t_val
case_LIT_71:;
if (T1.VAL == T.VAL) goto L_00FC;
return 1;
L_00FC:;
// 1533 %result = false
return 0;
// 1534 lit(lesseq): %result = true %if t1_val <= t_val
case_LIT_72:;
if (T1.VAL > T.VAL) goto L_00FD;
return 1;
L_00FD:;
// 1535 %result = false
return 0;
// 1536 lit(less): %result = true %if t1_val < t_val
case_LIT_73:;
if (T1.VAL >= T.VAL) goto L_00FE;
return 1;
L_00FE:;
// 1537 %result = false
return 0;
// 1538 lit(greateq): %result = true %if t1_val >= t_val
case_LIT_74:;
if (T1.VAL < T.VAL) goto L_00FF;
return 1;
L_00FF:;
// 1539 %result = false
return 0;
// 1540 lit(greater): %result = true %if t1_val > t_val
case_LIT_75:;
if (T1.VAL <= T.VAL) goto L_0100;
return 1;
L_0100:;
// 1541 %result = false
return 0;
// 1542 lit(concat): %result = t1_val+t_val
case_LIT_84:;
return T1.VAL + T.VAL;
// 1543 lit(*): !report(notwhat,-op)
case_LIT_default:;
// 1544 %result = 1
return 1;
// 1545 %end
case_LIT_dispatch:
if (LIT_index < 64 || LIT_index > 107)
_imp_signalf(6, 3, LIT_index, "->LIT(%d) out of bounds at %s line %d", LIT_index, LIT_file, LIT_line);
goto *LIT[LIT_index - 64];
case_LIT_missing:
_imp_signalf(8, 2, LIT_index, "switch jump to undefined label LIT(%d): at %s line %d", LIT_index, LIT_file,
LIT_line);
} /* end of LITVAL */
// 1546
// 1547 !Get leading operand
// 1548 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_0101;
ATOM = NEXTATOM();
L_0101:;
// 1549 atomp1 = atomp; !note position for reports
ATOMP1 = ATOMP;
// 1550 %if atom = ident %start
if (ATOM != 54) goto L_0102;
// 1551 matched = 1
MATCHED = 1;
// 1552 name error %if item <= 0
if (ITEM > 0) goto L_0103;
NAMEERROR();
L_0103:;
// 1553 fault(selfref+point) %if item >= dlim0
if (ITEM < DLIM0) goto L_0104;
FAULT(38 + 64);
L_0104:;
// 1554 type = ditem_type
TYPE = DITEM->TYPE;
// 1555 %if control&(refonly+varonly) # 0 %start
if (CONTROL & 1024 + 2048 == 0) goto L_0105;
// 1556 error(nonvar+point) %if control&varonly # 0 %and f&var = 0
if (CONTROL & 2048 == 0) goto L_0106;
if (F & 1 != 0) goto L_0106;
ERROR(30 + 64);
L_0106:;
// 1557 error(nonref+point) %if type < direct
if (TYPE >= 8192) goto L_0107;
ERROR(31 + 64);
L_0107:;
// 1558 %finish
L_0105:;
// 1559 f = ditem_flags
F = DITEM->FLAGS;
// 1560 %if inty <= type <= booltype %and f&proc = 0 %start; !literal
{
// Double-sided test on TYPE (Part I)
int tmp;
if (2046 > (tmp = TYPE)) goto L_0108;
// Double-sided test on TYPE (Part II)
if (tmp > 2048) goto L_0108;
}
if (F & 4 != 0) goto L_0108;
// 1561 item = 0; t = ditem_details
ITEM = 0;
T = DITEM->DETAILS;
// 1562 %else
goto L_0109;
L_0108:;
// 1563 fault(nonliteral+point) %if literal > 0
if (LITERAL <= 0) goto L_010A;
FAULT(13 + 64);
L_010A:;
// 1564 %if f&proc # 0 %start
if (F & 4 == 0) goto L_010B;
// 1565 ditem == dict(type) %and type = ditem_type %if f&parm # 0
if (F & 64 == 0) goto L_010C;
DITEM = (struct IDENTINFO *)/*?*/ &DICT[TYPE - 2001];
TYPE = DITEM->TYPE;
L_010C:;
// 1566 error(caterr+point) %if type = nulltype; !routine
if (TYPE != 2041) goto L_010D;
ERROR(3 + 64);
L_010D:;
// 1567 %if a(left) %start
if (!(A(55))) goto L_010E;
// 1568 dp == ditem
DP = (struct IDENTINFO *)DITEM;
// 1569 get PARMLIST; get(right)
GETPARMLIST();
GET(60);
// 1570 ditem == dp
DITEM = (struct IDENTINFO *)DP;
// 1571 %else
goto L_010F;
L_010E:;
// 1572 error(toofew+point) %if ditem_flags&more # 0
if (DITEM->FLAGS & 128 == 0) goto L_0110;
ERROR(33 + 64);
L_0110:;
// 1573 item = explo;!expref(f&var+fcall,item,0)
ITEM = EXPLO;
// 1574 %finish
L_010F:;
// 1575 %finish
L_010B:;
// 1576 %cycle
L_0111:;
// 1577 dp == dict(type&puretype); t = dp_details
DP = (struct IDENTINFO *)/*?*/ &DICT[(TYPE & 8191) - 2001];
T = DP->DETAILS;
// 1578 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_0112;
ATOM = NEXTATOM();
L_0112:;
// 1579 %exit %if atom # underline %and atom # left
if (ATOM == 56) goto L_0113;
if (ATOM == 55) goto L_0113;
goto L_0114;
L_0113:;
// 1580 matched = 1
MATCHED = 1;
// 1581 item1 = item
ITEM1 = ITEM;
// 1582 %if atom = left %start
if (ATOM != 55) goto L_0115;
// 1583 %cycle
L_0116:;
// 1584 syntax error %if t_type < direct; !element type
if (T.TYPE >= 8192) goto L_0117;
SYNTAXERROR();
L_0117:;
// 1585 type = t_type
TYPE = T.TYPE;
// 1586 get VALUE(t_val); !index
GETVALUE(T.VAL);
// 1587 item = explo;!expref(aref,item1,item,t_val)
ITEM = EXPLO;
// 1588 ditem == dp
DITEM = (struct IDENTINFO *)DP;
// 1589 %exit %if %not a(comma)
if (A(59)) goto L_0118;
goto L_0119;
L_0118:;
// 1590 dp == dict(type&puretype); t = dp_details
DP = (struct IDENTINFO *)/*?*/ &DICT[(TYPE & 8191) - 2001];
T = DP->DETAILS;
// 1591 item1 = item
ITEM1 = ITEM;
// 1592 %repeat
goto L_0116;
L_0119:;
// 1593 get(right)
GET(60);
// 1594 %else; !rec subfield
goto L_011A;
L_0115:;
// 1595 syntax error %if t_type # recy
if (T.TYPE == 2042) goto L_011B;
SYNTAXERROR();
L_011B:;
// 1596 get(ident)
GET(54);
// 1597 lookup field ident(t_extra)
LOOKUPFIELDIDENT(T.EXTRA);
// 1598 error(namerr+point) %if item <= 0
if (ITEM > 0) goto L_011C;
ERROR(2 + 64);
L_011C:;
// 1599 type = ditem_type
TYPE = DITEM->TYPE;
// 1600 item = explo;!expref(recref,item,item1)
ITEM = EXPLO;
// 1601 %finish
L_011A:;
// 1602 %repeat
goto L_0111;
L_0114:;
// 1603 -> final %if control&(varonly+refonly) # 0
if (CONTROL & 2048 + 1024 == 0) goto L_011D;
goto U_1009;
L_011D:;
// 1604 %finish
L_0109:;
// 1605 %else
goto L_011E;
L_0102:;
// 1606 error(nonvar+point) %if control&varonly # 0
if (CONTROL & 2048 == 0) goto L_011F;
ERROR(30 + 64);
L_011F:;
// 1607 error(nonref+point) %if control&refonly # 0
if (CONTROL & 1024 == 0) goto L_0120;
ERROR(31 + 64);
L_0120:;
// 1608 %if a(const) %start
if (!(A(53))) goto L_0121;
// 1609 %else %if atom = minus; !leave unmatched
goto L_0122;
L_0121:;
if (ATOM != 81) goto L_0123;
// 1610 item = 0; t = 0; t_type = inty
ITEM = 0;
T = (struct OBJINFO){0};
T.TYPE = 2046;
// 1611 %else %if a(left)
goto L_0122;
L_0123:;
if (!(A(55))) goto L_0124;
// 1612 %if rank < major %start; !condition
if (RANK >= 80) goto L_0125;
// 1613 get EXPRESSION(cond,any)
GETEXPRESSION(64, 255);
// 1614 %finish %else %start
goto L_0126;
L_0125:;
// 1615 jammy = jammy-4
JAMMY = JAMMY - 4;
// 1616 c1 = control; c1 = c1!intok %if c1&realok # 0
C1 = CONTROL;
if (C1 & 8 == 0) goto L_0127;
C1 = C1 | 16;
L_0127:;
// 1617 get EXPRESSION(major,c1)
GETEXPRESSION(80, C1);
// 1618 jammy = jammy+4
JAMMY = JAMMY + 4;
// 1619 %finish
L_0126:;
// 1620 get(right)
GET(60);
// 1621 %else %if a(keynot)
goto L_0122;
L_0124:;
if (!(A(47))) goto L_0128;
// 1622 syntax error %if rank >= major
if (RANK < 80) goto L_0129;
SYNTAXERROR();
L_0129:;
// 1623 get EXPRESSION(scond,any)
GETEXPRESSION(70, 255);
// 1624 %if item = 0 %then t_val = t_val!!true %c
if (ITEM != 0) goto L_012A;
T.VAL = T.VAL ^ 1;
goto L_012B;
L_012A:;
ITEM = EXPLO;
L_012B:;
// 1625+ %else item = explo;!expref(boolnot,item,0)
// 1626 %else %if atom = backslash
goto L_0122;
L_0128:;
if (ATOM != 96) goto L_012C;
// 1627 item = 0; t = 0; t_type = inty
ITEM = 0;
T = (struct OBJINFO){0};
T.TYPE = 2046;
// 1628 atom = tilde
ATOM = 102;
// 1629 %else %if a(modsign)
goto L_0122;
L_012C:;
if (!(A(57))) goto L_012D;
// 1630 fault(typerr+point) %if control&arithok = 0
if (CONTROL & 24 != 0) goto L_012E;
FAULT(6 + 64);
L_012E:;
// 1631 get EXPRESSION(major,arithok)
GETEXPRESSION(80, 24);
// 1632 get(modsign)
GET(57);
// 1633 %if item = 0 %start
if (ITEM != 0) goto L_012F;
// 1634 %if t_val < 0 %start
if (T.VAL >= 0) goto L_0130;
// 1635 %if t_val # minint %then t_val = -t_val %else expfault(rangerr)
if (T.VAL == -2147483648) goto L_0131;
T.VAL = -T.VAL;
goto L_0132;
L_0131:;
EXPFAULT(12);
L_0132:;
// 1636 %finish
L_0130:;
// 1637 %else %if t_type = inty
goto L_0133;
L_012F:;
if (T.TYPE != 2046) goto L_0134;
// 1638 item = explo;!expref(imod,item,0)
ITEM = EXPLO;
// 1639 %else %if t_type = realy
goto L_0133;
L_0134:;
if (T.TYPE != 2045) goto L_0135;
// 1640 item = explo;!expref(fmod,item,0)
ITEM = EXPLO;
// 1641 %else
goto L_0133;
L_0135:;
// 1642 error(typerr)
ERROR(6);
// 1643 %finish
L_0133:;
// 1644 %else
goto L_0122;
L_012D:;
// 1645 syntax error
SYNTAXERROR();
// 1646 %finish
L_0122:;
// 1647 %finish
L_011E:;
// 1648 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_0136;
ATOM = NEXTATOM();
L_0136:;
// 1649 %while atom >= rank %cycle
L_0137:;
if (ATOM < RANK) goto L_0138;
// 1650 op = atom; matched = 1
OP = ATOM;
MATCHED = 1;
// 1651 opok = opbits(op); c1 = compat(opok); ![may change ITEM,T_TYPE]
OPOK = OPBITS[OP - 64];
C1 = COMPAT(OPOK);
// 1652 fault(typerr+point) %if c1 = 0
if (C1 != 0) goto L_0139;
FAULT(6 + 64);
L_0139:;
// 1653 item1 = item; t1 = t
ITEM1 = ITEM;
T1 = T;
// 1654 %if op >= major %start; !non-conditional
if (OP < 80) goto L_013A;
// 1655 %if op = dot %then get EXPRESSION(dot,stringok) {right-associate} %c
if (OP != 84) goto L_013B;
GETEXPRESSION(84, 4);
goto L_013C;
L_013B:;
GETEXPRESSION((OP & (~7)) + 8, C1);
L_013C:;
// 1656+ %else get EXPRESSION(op&(\7)+8,c1)
// 1657 %if t_type = realy %and t1_type = inty %start
if (T.TYPE != 2045) goto L_013D;
if (T1.TYPE != 2046) goto L_013D;
// 1658 item1 = floated(item1); t1_type = realy
ITEM1 = FLOATED(ITEM1);
T1.TYPE = 2045;
// 1659 %finish
L_013D:;
// 1660 ! op = op+? %if t_type = realy %and opok&intok # 0
// 1661 %else
goto L_013E;
L_013A:;
// 1662 %if op = resolve %start
if (OP != 79) goto L_013F;
// 1663 get RESOLUTION
GETRESOLUTION();
// 1664 %else %if op >= eqeq
goto L_0140;
L_013F:;
if (OP < 76) goto L_0141;
// 1665 get EXPRESSION(simple,any+refonly)
GETEXPRESSION(104, 255 + 1024);
// 1666 %else %if op >= equals
goto L_0140;
L_0141:;
if (OP < 70) goto L_0142;
// 1667 get EXPRESSION(major,c1)
GETEXPRESSION(80, C1);
// 1668 %if equals <= atom < eqeq %start
{
// Double-sided test on ATOM (Part I)
int tmp;
if (70 > (tmp = ATOM)) goto L_0143;
// Double-sided test on ATOM (Part II)
if (tmp >= 76) goto L_0143;
}
// 1669 op = atom; matched = 1
OP = ATOM;
MATCHED = 1;
// 1670 get EXPRESSION(major,c1)
GETEXPRESSION(80, C1);
// 1671 %finish
L_0143:;
// 1672 %if t_type = realy %and t1_type = inty %start
if (T.TYPE != 2045) goto L_0144;
if (T1.TYPE != 2046) goto L_0144;
// 1673 item1 = floated(item1); t1_type = realy
ITEM1 = FLOATED(ITEM1);
T1.TYPE = 2045;
// 1674 %finish
L_0144:;
// 1675 %else
goto L_0140;
L_0142:;
// 1676 get EXPRESSION(scond,any)
GETEXPRESSION(70, 255);
// 1677 %if atom >= cond %start
if (ATOM < 64) goto L_0145;
// 1678 syntax error %if atom # op
if (ATOM == OP) goto L_0146;
SYNTAXERROR();
L_0146:;
// 1679 %finish
L_0145:;
// 1680 %finish
L_0140:;
// 1681 t_type = booltype
T.TYPE = 2048;
// 1682 t_low = 0 %and t_val = 1 %if item # 0
if (ITEM == 0) goto L_0147;
T.LOW = 0;
T.VAL = 1;
L_0147:;
// 1683 %finish
L_013E:;
// 1684 %if item1 = 0 %start; !first operand literal
if (ITEM1 != 0) goto L_0148;
// 1685 %if item = 0 %start; !both literal
if (ITEM != 0) goto L_0149;
// 1686 t_val = litval
T.VAL = LITVAL();
// 1687 %continue %if item = 0
if (ITEM != 0) goto L_014A;
goto L_014B;
L_014A:;
// 1688 ! item1 = litref(t1_val)
// 1689 ! %else %if inverse(op) # 0; !invertable
// 1690 ! op = inverse(op)
// 1691 ! temp = t; t = t1; t1 = temp; !standardise order
// 1692 ! item1 = item; item = 0
// 1693 %else
goto L_014C;
L_0149:;
// 1694 ! item1 = litref(t1_val)
// 1695 %finish
L_014C:;
// 1696 %finish
L_0148:;
// 1697 %if item = 0 %start; !second operand literal
if (ITEM != 0) goto L_014D;
// 1698 %if op = minus %and t_type = inty %start; !standardise
if (OP != 81) goto L_014E;
if (T.TYPE != 2046) goto L_014E;
// 1699 t_val = -t_val %if t_val # minint; op = plus
if (T.VAL == -2147483648) goto L_014F;
T.VAL = -T.VAL;
L_014F:;
OP = 80;
// 1700 %finish
L_014E:;
// 1701 item = item1 %and %continue %if t_val = 0 %and opok&znop # 0
if (T.VAL != 0) goto L_0150;
if (OPOK & 512 == 0) goto L_0150;
ITEM = ITEM1;
goto L_014B;
L_0150:;
// 1702 %finish
L_014D:;
// 1703 item = explo;!expref(op,item1,item,t_val)
ITEM = EXPLO;
// 1704 t_low = minint; t_val = maxint; !?real
T.LOW = -2147483648;
T.VAL = 2147483647;
// 1705 %repeat
L_014B:;
goto L_0137;
L_0138:;
// 1706 final:
U_1009:;
// 1707 expp = atomp1; !restore to start
EXPP = ATOMP1;
// 1708 expfault(typerr) %if compat(control) = 0
if (COMPAT(CONTROL) != 0) goto L_0151;
EXPFAULT(6);
L_0151:;
// 1709 %end; !get EXPRESSION
return;
} /* end of GETEXPRESSION */
// 1710
// 1711 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1712 !!!!!!!!!!!!!!!!!!!! Conditions and loops !!!!!!!!!!!!!!!!!!!!
// 1713 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1714 !
// 1715 %routine GET CONDITION
void GETCONDITION(void) {
// 1716 %integer polarity
int POLARITY;
// 1717 polarity = subatom
POLARITY = SUBATOM;
// 1718 condnp = np
CONDNP = NP;
// 1719 get EXPRESSION(cond,any)
GETEXPRESSION(64, 255);
// 1720 ! put3(jump+polarity,item,0)
// 1721 %end; !get CONDITION
return;
} /* end of GETCONDITION */
// 1722
// 1723 %routine GET STATEMENTS(%integer stopper)
void GETSTATEMENTS(int STOPPER) {
// 1724 %integer holdnp,holdlooplab
int HOLDNP;
int HOLDLOOPLAB;
// 1725 %switch initial(0:atommax)
int INITIAL_index;
int INITIAL_line;
char *INITIAL_file;
static const void *INITIAL[108] = {
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing,
&&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing, &&case_INITIAL_missing};
// 1726
// 1727 %routine GET INSTRUCTION
void GETINSTRUCTION(void) {
// 1728 %integer item1,hold,act
int ITEM1;
int HOLD;
int ACT;
// 1729 %record(identinfo)%name ditem1
struct IDENTINFO *DITEM1;
// 1730 %routine putact
void PUTACT(void) {
// 1731 ! put3(act,t_val,hold)
// 1732 %end
return;
} /* end of PUTACT */
// 1733 !
// 1734 %if c_flags < hadinst %start; !first in block
if (C.FLAGS >= 32) goto L_0152;
// 1735 c_flags = c_flags+hadinst
C.FLAGS = C.FLAGS + 32;
// 1736 fault(ordererr) %if level <= outerlevel
if (LEVEL > 0) goto L_0153;
FAULT(10);
L_0153:;
// 1737 %finish
L_0152:;
// 1738 instnp = np
INSTNP = NP;
// 1739 %cycle
L_0154:;
// 1740 %if a(ident) %start
if (!(A(54))) goto L_0155;
// 1741 name error %if item <= 0
if (ITEM > 0) goto L_0156;
NAMEERROR();
L_0156:;
// 1742 %if ditem_flags&var # 0 %start
if (DITEM->FLAGS & 1 == 0) goto L_0157;
// 1743 matched = 0
MATCHED = 0;
// 1744 get EXPRESSION(simple,any)
GETEXPRESSION(104, 255);
// 1745 item1 = item; ditem1 == ditem
ITEM1 = ITEM;
DITEM1 = (struct IDENTINFO *)DITEM;
// 1746 %if a(equals) %start
if (!(A(70))) goto L_0158;
// 1747 get VALUE(ditem1_type)
GETVALUE(DITEM1->TYPE);
// 1748 ! put2(assign,item1)
// 1749 %else %if a(eqeq)
goto L_0159;
L_0158:;
if (!(A(76))) goto L_015A;
// 1750 syntax error %if ditem1_type < indirect
if (DITEM1->TYPE >= 16384) goto L_015B;
SYNTAXERROR();
L_015B:;
// 1751 get REFERENCE(ditem1_type)
GETREFERENCE(DITEM1->TYPE);
// 1752 item = item+ad %if item # 0
if (ITEM == 0) goto L_015C;
ITEM = ITEM + 16384;
L_015C:;
// 1753 ! put2(assign,item1+ad)
// 1754 %else %if atom = less %and byteinteger(fp) = '-'
goto L_0159;
L_015A:;
if (ATOM != 73) goto L_015D;
if (*_imp_BYTEINTEGER(FP) != 45) goto L_015D;
// 1755 fp = fp+1; matched = 1
FP = FP + 1;
MATCHED = 1;
// 1756 jammy = 2
JAMMY = 2;
// 1757 get VALUE(ditem1_type)
GETVALUE(DITEM1->TYPE);
// 1758 ! put2(jamassign,item1)
// 1759 %else
goto L_0159;
L_015D:;
// 1760 syntax error %if %not a(arrow)
if (A(79)) goto L_015E;
SYNTAXERROR();
L_015E:;
// 1761 get RESOLUTION
GETRESOLUTION();
// 1762 ! put2(resolve,item1)
// 1763 %finish
L_0159:;
// 1764 %else
goto L_015F;
L_0157:;
// 1765 error(caterr+point) %if ditem_flags&proc = 0
if (DITEM->FLAGS & 4 != 0) goto L_0160;
ERROR(3 + 64);
L_0160:;
// 1766 ditem == dict(ditem_type) %if ditem_flags&parm # 0
if (DITEM->FLAGS & 64 == 0) goto L_0161;
DITEM = (struct IDENTINFO *)/*?*/ &DICT[DITEM->TYPE - 2001];
L_0161:;
// 1767 error(caterr+point) %if ditem_type # nulltype
if (DITEM->TYPE == 2041) goto L_0162;
ERROR(3 + 64);
L_0162:;
// 1768 %if a(left) %start
if (!(A(55))) goto L_0163;
// 1769 get PARMLIST; get(right)
GETPARMLIST();
GET(60);
// 1770 %else; !parameterless routine
goto L_0164;
L_0163:;
// 1771 error(toofew+point) %if ditem_flags&more # 0
if (DITEM->FLAGS & 128 == 0) goto L_0165;
ERROR(33 + 64);
L_0165:;
// 1772 ! put3(rcall,item,0)
// 1773 %finish
L_0164:;
// 1774 %finish
L_015F:;
// 1775 %finish %else %start
goto L_0166;
L_0155:;
// 1776 act = atom; hold = subatom; t_val = 0
ACT = ATOM;
HOLD = SUBATOM;
T.VAL = 0;
// 1777 c_access = 0
C.ACCESS = 0;
// 1778 %if a(monitor) %start
if (!(A(13))) goto L_0167;
// 1779 c_access = 1
C.ACCESS = 1;
// 1780 ! fault(monitor<<8)
// 1781 %else %if a(exit); !%exit, %continue
goto L_0168;
L_0167:;
if (!(A(6))) goto L_0169;
// 1782 %if looplab = 0 %then fault(notinloop+point) %c
if (LOOPLAB != 0) goto L_016A;
FAULT(16 + 64);
goto L_016B;
L_016A:;
T.VAL = LOOPLAB;
PUTACT();
L_016B:;
// 1783+ %else t_val = looplab %and putact
// 1784 %exit
goto L_016C;
// 1785 %else %if a(return)
L_0169:;
if (!(A(7))) goto L_016D;
// 1786 %if c_type # nulltype %then fault(notinrout+point) %c
if (C.TYPE == 2041) goto L_016E;
FAULT(17 + 64);
goto L_016F;
L_016E:;
PUTACT();
L_016F:;
// 1787+ %else putact
// 1788 %exit
goto L_016C;
// 1789 %else %if a(result)
L_016D:;
if (!(A(9))) goto L_0170;
// 1790 error(notinfun+point) %if c_type <= nulltype
if (C.TYPE > 2041) goto L_0171;
ERROR(18 + 64);
L_0171:;
// 1791 syntax error %if %not a assop
if (AASSOP()) goto L_0172;
SYNTAXERROR();
L_0172:;
// 1792 %if c_type < direct %start; !function
if (C.TYPE >= 8192) goto L_0173;
// 1793 fault(caterr+point) %if atom = eqeq
if (ATOM != 76) goto L_0174;
FAULT(3 + 64);
L_0174:;
// 1794 get VALUE(c_type)
GETVALUE(C.TYPE);
// 1795 ! put2(result,0)
// 1796 %else; !map
goto L_0175;
L_0173:;
// 1797 fault(caterr+point) %if atom # eqeq
if (ATOM == 76) goto L_0176;
FAULT(3 + 64);
L_0176:;
// 1798 get REFERENCE(c_type+(indirect-direct))
GETREFERENCE(C.TYPE + (16384 - 8192));
// 1799 ! put2(result,0)
// 1800 %finish
L_0175:;
// 1801 %exit
goto L_016C;
// 1802 %else %if a(tf); !%true, %false
L_0170:;
if (!(A(8))) goto L_0177;
// 1803 %if c_type # booltype %then fault(notinpred+point) %c
if (C.TYPE == 2048) goto L_0178;
FAULT(19 + 64);
goto L_0179;
L_0178:;
PUTACT();
L_0179:;
// 1804+ %else putact
// 1805 %exit
goto L_016C;
// 1806 %else %if a(arrow) %or a(goto)
L_0177:;
if (A(79)) goto L_017A;
if (!(A(11))) goto L_017B;
L_017A:;
// 1807 nonstandard(kgoto) %if atom = goto
if (ATOM != 11) goto L_017C;
NONSTANDARD(128);
L_017C:;
// 1808 get(ident)
GET(54);
// 1809 %if byteinteger(fp) # '(' %start
if (*_imp_BYTEINTEGER(FP) == 40) goto L_017D;
// 1810 %if item < c_localdpos %or ditem_flags&lab = 0 %c
if (ITEM < C.LOCALDPOS) goto L_017E;
if (DITEM->FLAGS & 2 == 0) goto L_017E;
if (DITEM->TYPE == 2041) goto L_017F;
L_017E:;
// 1811+ %or ditem_type # nulltype %start
// 1812 d_flags = spec+lab; d_type = nulltype
D.FLAGS = 16 + 2;
D.TYPE = 2041;
// 1813 declare
DECLARE();
// 1814 %finish
L_017F:;
// 1815 ! put3(jump,item,0)
// 1816 %finish %else %start
goto L_0180;
L_017D:;
// 1817 name error %if item < c_localdpos
if (ITEM >= C.LOCALDPOS) goto L_0181;
NAMEERROR();
L_0181:;
// 1818 syntax error %if ditem_flags&lab = 0 %or ditem_type = nulltype
if (DITEM->FLAGS & 2 == 0) goto L_0182;
if (DITEM->TYPE != 2041) goto L_0183;
L_0182:;
SYNTAXERROR();
L_0183:;
// 1819 get(left)
GET(55);
// 1820 get VALUE(ditem_type); !index
GETVALUE(DITEM->TYPE);
// 1821 get(right)
GET(60);
// 1822 %finish
L_0180:;
// 1823 %exit
goto L_016C;
// 1824 %else %if a(stop)
L_017B:;
if (!(A(10))) goto L_0184;
// 1825 putact
PUTACT();
// 1826 %exit
goto L_016C;
// 1827 %else %if a(signal)
L_0184:;
if (!(A(12))) goto L_0185;
// 1828 c_access = 1
C.ACCESS = 1;
// 1829 allow(keyevent)
ALLOW(44);
// 1830 get LITINT
GETLITINT();
// 1831 expfault(rangerr+point) %unless 0 <= t_val <= 15
{
// Double-sided test on T.VAL (Part I)
int tmp;
if (0 > (tmp = T.VAL)) goto L_0186;
// Double-sided test on T.VAL (Part II)
if (tmp <= 15) goto L_0187;
}
L_0186:;
EXPFAULT(12 + 64);
L_0187:;
// 1832 hold = t_val; t_val = 0
HOLD = T.VAL;
T.VAL = 0;
// 1833 get LITINT %if a(comma)
if (!(A(59))) goto L_0188;
GETLITINT();
L_0188:;
// 1834 hold = t_val<<4+hold
HOLD = (T.VAL << 4) + HOLD;
// 1835 item = 0; t_val = 0
ITEM = 0;
T.VAL = 0;
// 1836 get VALUE(anyint) %if a(comma)
if (!(A(59))) goto L_0189;
GETVALUE(10238);
L_0189:;
// 1837 ! put2(act,hold)
// 1838 %exit
goto L_016C;
// 1839 %else
L_0185:;
// 1840 syntax error
SYNTAXERROR();
// 1841 %finish
L_0168:;
// 1842 %finish
L_0166:;
// 1843 %repeat %until %not a(keyand)
if (!(A(64))) goto L_016C;
goto L_0154;
L_016C:;
// 1844 %end; !GET INSTRUCTION
return;
} /* end of GETINSTRUCTION */
// 1845
// 1846 %routine GET FOR CLAUSE
void GETFORCLAUSE(void) {
// 1847 %integer loopvar,k,s,start,sval,i,inc,ival,e,n,temp
int LOOPVAR;
int K;
int S;
int START;
int SVAL;
int I;
int INC;
int IVAL;
int E;
int N;
int TEMP;
// 1848 %integer eval
int EVAL;
// 1849 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 1850 holdnp = np; temp = 0
HOLDNP = NP;
TEMP = 0;
// 1851 dict(curlab)_val = 1; !dummy
DICT[CURLAB - 2001].VAL = 1;
// 1852 condnp = np
CONDNP = NP;
// 1853 get(ident)
GET(54);
// 1854 name error %if item <= 0
if (ITEM > 0) goto L_018A;
NAMEERROR();
L_018A:;
// 1855 fault(typerr+point) %if dict(ditem_type&puretype)_type # inty
if (DICT[(DITEM->TYPE & 8191) - 2001].TYPE == 2046) goto L_018B;
FAULT(6 + 64);
L_018B:;
// 1856 fault(caterr+point+warn) %if ditem_type # direct+inttype
if (DITEM->TYPE == 8192 + 2051) goto L_018C;
FAULT(3 + 64 + 128);
L_018C:;
// 1857 loopvar = item; dp == ditem
LOOPVAR = ITEM;
DP = (struct IDENTINFO *)DITEM;
// 1858 get(equals)
GET(70);
// 1859 get VALUE(ditem_type)
GETVALUE(DITEM->TYPE);
// 1860 start = item; sval = t_val
START = ITEM;
SVAL = T.VAL;
// 1861 get(comma)
GET(59);
// 1862 get VALUE(anyint)
GETVALUE(10238);
// 1863 inc = item; ival = t_val
INC = ITEM;
IVAL = T.VAL;
// 1864 expfault(rangerr+point) %and ival = 1 %if inc = 0 = ival
{
// Double-sided test on 0 (Part I)
int tmp;
if (INC != (tmp = 0)) goto L_018D;
// Double-sided test on 0 (Part II)
if (tmp != IVAL) goto L_018D;
}
EXPFAULT(12 + 64);
IVAL = 1;
L_018D:;
// 1865 get(comma)
GET(59);
// 1866 get VALUE(ditem_type)
GETVALUE(DITEM->TYPE);
// 1867 !Deal with INC and replace START by START-INC
// 1868 ! k = undef
// 1869 ! k = exp(start)_y %if start >= expmin %and exp(start)_act = plus
// 1870 %if inc = 0 %start; !literal increment
if (INC != 0) goto L_018E;
// 1871 i = 1; !litref(ival)
I = 1;
// 1872 %if start = 0 %start; !START and INC both literal
if (START != 0) goto L_018F;
// 1873 sval = sval-ival; s = 1; !litref(sval)
SVAL = SVAL - IVAL;
S = 1;
// 1874 ! %else %if k <= litmax; !START is x+lit
// 1875 ! k = ival-litval(k)
// 1876 ! s = exp(start)_x; s = explo;!expref(plus,s,litref(k)) %if k # 0
// 1877 %else
goto L_0190;
L_018F:;
// 1878 s = explo;!expref(plus,start,litref(-ival))
S = EXPLO;
// 1879 %finish
L_0190:;
// 1880 %finish %else %start; !allocate temp var
goto L_0191;
L_018E:;
// 1881 ! i = tempvar; put3(assign,i,inc); temp = temp-4
// 1882 ! %if start = inc %start; !identical
// 1883 ! s = 0; sval = 0
// 1884 ! %else %if k = inc; !START is x+INC
// 1885 ! s = exp(start)_x
// 1886 ! %else
// 1887 ! s = start; s = litref(sval) %if s = 0
// 1888 s = explo;!expref(minus,s,i)
S = EXPLO;
// 1889 ! %finish
// 1890 %finish
L_0191:;
// 1891 ! %if item = 0 %start; !literal end-value
// 1892 ! e = litref(t_val); eval = t_val
// 1893 ! %finish %else %start
// 1894 ! e = tempvar; put3(assign,e,item); temp = temp-4
// 1895 ! %finish
// 1896 ! put3(assign,loopvar,s)
// 1897 ! put3(label,curlab,0)
// 1898 %if start!inc!item = 0 %start; !all literal
if (START | INC | ITEM != 0) goto L_0192;
// 1899 k = t_val-sval; n = k//ival
K = T.VAL - SVAL;
N = ((long)K / (long)IVAL);
// 1900 fault(boundserr) %if n < 0
if (N >= 0) goto L_0193;
FAULT(14);
L_0193:;
// 1901 fault(unending) %if n*ival # k
if (N * IVAL == K) goto L_0194;
FAULT(37);
L_0194:;
// 1902 ! %if 0 <= t_val <= 32767 %start
// 1903 ! temp = loopvar
// 1904 ! %finish
// 1905 %finish
L_0192:;
// 1906 ! %if temp <= 0 %start
// 1907 ! c_fortemps = c_fortemps-temp; !ie increment
// 1908 ! put3(compare,loopvar,e)
// 1909 ! put3(eq,0,curlab+1)
// 1910 ! %finish
// 1911 ! put3(plusass,loopvar,i)
// 1912 ! compile(holdnp,np)
// 1913 %end;
return;
} /* end of GETFORCLAUSE */
// ?EVAL unused
// ?E unused
// 1914 ; !get FORCLAUSE
// 1914
// 1915 %routine GET SWITCH INDEX
void GETSWITCHINDEX(void) {
// 1916 %integer item1
int ITEM1;
// 1917 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 1918 item1 = item; dp == ditem
ITEM1 = ITEM;
DP = (struct IDENTINFO *)DITEM;
// 1919 get(left)
GET(55);
// 1920 item = 1
ITEM = 1;
// 1921 %if a(star) %start
if (!(A(88))) goto L_0195;
// 1922 fault(duperr+point) %if dp_spare # 0
if (DP->SPARE == 0) goto L_0196;
FAULT(7 + 64);
L_0196:;
// 1923 dp_spare = 1
DP->SPARE = 1;
// 1924 %else
goto L_0197;
L_0195:;
// 1925 get LITERAL(dp_type)
GETLITERAL(DP->TYPE);
// 1926 !beware faulty declaration or index
// 1927 %if dp_type > inttype %and faultnum = 0 %start
if (DP->TYPE <= 2051) goto L_0198;
if (FAULTNUM != 0) goto L_0198;
// 1928 t_val = t_val-dict(dp_type)_low+dp_val
T.VAL = T.VAL - DICT[DP->TYPE - 2001].LOW + DP->VAL;
// 1929 expfault(duperr+point) %if final(t_val) # 0
if (FINAL[T.VAL] == 0) goto L_0199;
EXPFAULT(7 + 64);
L_0199:;
// 1930 ! define jumps(final(t_val)); !in case of lit jumps
// 1931 final(t_val) = 1
FINAL[T.VAL] = 1;
// 1932 %finish
L_0198:;
// 1933 %finish
L_0197:;
// 1934 get(right)
GET(60);
// 1935 c_access = 1
C.ACCESS = 1;
// 1936 %end
return;
} /* end of GETSWITCHINDEX */
// 1937
// 1938 ![unsure of efficiency implications of trapping overflow lower down]
// 1939 %on %event 1,14 %start
if (!_imp_on_event(1, 14)) goto L_019A;
// 1940 !$IF VAX
// 1941 report(rangerr,0) %if event_event = 1
if (_imp_EVENT().EVENT != 1) goto L_019B;
REPORT(12, 0);
L_019B:;
// 1942 !$IF AMDAHL
// 1943 { report(rangerr,0) %if eventinf>>8 = 1
// 1944 !$FINISH
// 1945 -> skip
goto U_100A;
// 1946 %finish
L_019A:;
// 1947 !!!!!!!!!!!!!!!!!!! Start of new statement !!!!!!!!!!!!!!!!!!!
// 1948 next:
U_100B:;
// 1949 statements = statements+1
STATEMENTS = STATEMENTS + 1;
// 1950 next1:
U_100C:;
// 1951 report(faultnum,faultp) %if faultnum # 0
if (FAULTNUM == 0) goto L_019C;
REPORT(FAULTNUM, FAULTP);
L_019C:;
// 1952 d = 0; declmode = 0; dsize = 0
D = (struct IDENTINFO){0};
DECLMODE = 0;
DSIZE = 0;
// 1953 dlim0 = dlim; elements = 0
DLIM0 = DLIM;
ELEMENTS = 0;
// 1954 speccing = 0; mcoding = 0
SPECCING = 0;
MCODING = 0;
// 1955 literal = 0; jammy = 0
LITERAL = 0;
JAMMY = 0;
// 1956 dict(curlab)_val = 0; dict(curlab+1)_val = 0
DICT[CURLAB - 2001].VAL = 0;
DICT[CURLAB + 1 - 2001].VAL = 0;
// 1957 np = np0; instnp = np0; condnp = np0
NP = 3255;
INSTNP = 3255;
CONDNP = 3255;
// 1958 ! constad == finalad; constbound = purebound
// 1959 %if explo < expmin+50 %or litpos > litmax-50 %start
if (EXPLO < 3255 + 50) goto L_019D;
if (LITPOS <= 2000 - 50) goto L_019E;
L_019D:;
// 1960 !zaps = zaps+1; zaps = zaps+999 %if litpos > litmax-50
// 1961 forget all
FORGETALL();
// 1962 %finish
L_019E:;
// 1963 t_val = 0
T.VAL = 0;
// 1964 !
// 1965 initial(terminator):
case_INITIAL_52:;
// 1966 atom = next atom; matched = 1
ATOM = NEXTATOM();
MATCHED = 1;
// 1967 -> initial(atom)
INITIAL_line = __LINE__;
INITIAL_file = __FILE__;
INITIAL_index = ATOM;
goto case_INITIAL_dispatch;
// 1968 initial(star): initial(exclam): initial(exclam2):
case_INITIAL_88:;
case_INITIAL_82:;
case_INITIAL_83:;
// 1969 read line
READLINE();
// 1970 -> next1
goto U_100C;
// 1971 term:
U_1009:;
// 1972 get(terminator)
GET(52);
// 1973 -> next
goto U_100B;
// 1974
// 1975 skip:
U_100A:;
// 1976 c_access = -1
C.ACCESS = -1;
// 1977 %if atom # terminator %start
if (ATOM == 52) goto L_01A0;
// 1978 %cycle
L_01A1:;
// 1979 subatom = atom; atom = next atom
SUBATOM = ATOM;
ATOM = NEXTATOM();
// 1980 %repeat %until atom = terminator
if (ATOM == 52) goto L_01A2;
goto L_01A1;
L_01A2:;
// 1981 starts = starts+1 %if subatom = start
if (SUBATOM != 21) goto L_01A3;
STARTS = STARTS + 1;
L_01A3:;
// 1982 cycles = cycles+1 %if subatom = cycle
if (SUBATOM != 22) goto L_01A4;
CYCLES = CYCLES + 1;
L_01A4:;
// 1983 %finish
L_01A0:;
// 1984 -> next
goto U_100B;
// 1985
// 1986 initial(dud):
case_INITIAL_63:;
// 1987 syntax error; !ie atom error
SYNTAXERROR();
// 1988
// 1989 initial(*):
case_INITIAL_default:;
// 1990 error(nonstarter+point)
ERROR(29 + 64);
// 1991
// 1992 initial(ident):
case_INITIAL_54:;
// 1993 %if byteinteger(fp) = ':' %start; !simple label
if (*_imp_BYTEINTEGER(FP) != 58) goto L_01A5;
// 1994 fp = fp+1
FP = FP + 1;
// 1995 d_flags = lab; d_type = nulltype
D.FLAGS = 2;
D.TYPE = 2041;
// 1996 declare
DECLARE();
// 1997 set user label(item)
SETUSERLABEL(ITEM);
// 1998 ->next
goto U_100B;
// 1999 %finish
L_01A5:;
// 2000 name error %if item <= 0
if (ITEM > 0) goto L_01A6;
NAMEERROR();
L_01A6:;
// 2001 %if ditem_flags&lab # 0 %start
if (DITEM->FLAGS & 2 == 0) goto L_01A7;
// 2002 get SWITCH INDEX
GETSWITCHINDEX();
// 2003 get(colon)
GET(58);
// 2004 ->next
goto U_100B;
// 2005 %finish
L_01A7:;
// 2006 initial(return): initial(result): initial(tf):
case_INITIAL_7:;
case_INITIAL_9:;
case_INITIAL_8:;
// 2007 initial(stop): initial(signal): initial(monitor):
case_INITIAL_10:;
case_INITIAL_12:;
case_INITIAL_13:;
// 2008 initial(exit): initial(goto): initial(arrow):
case_INITIAL_6:;
case_INITIAL_11:;
case_INITIAL_79:;
// 2009 matched = 0
MATCHED = 0;
// 2010 get INSTRUCTION
GETINSTRUCTION();
// 2011 -> next %if a(terminator)
if (!(A(52))) goto L_01A8;
goto U_100B;
L_01A8:;
// 2012 c_access = 1
C.ACCESS = 1;
// 2013 %if a(iu) %start
if (!(A(16))) goto L_01A9;
// 2014 holdnp = np
HOLDNP = NP;
// 2015 get CONDITION
GETCONDITION();
// 2016 ! compile(holdnp,np)
// 2017 %else %if a(while)
goto L_01AA;
L_01A9:;
if (!(A(17))) goto L_01AB;
// 2018 holdnp = np
HOLDNP = NP;
// 2019 ! put3(label,curlab,0)
// 2020 get CONDITION
GETCONDITION();
// 2021 ! compile(holdnp,np)
// 2022 ! put3(jump,curlab,0)
// 2023 ! put3(label,curlab+1,0)
// 2024 %else %if a(for)
goto L_01AA;
L_01AB:;
if (!(A(19))) goto L_01AC;
// 2025 get FOR CLAUSE
GETFORCLAUSE();
// 2026 ! put3(jump,curlab,0)
// 2027 ! put3(label,curlab+1,0)
// 2028 %else
goto L_01AA;
L_01AC:;
// 2029 syntax error %if %not a(until)
if (A(18)) goto L_01AD;
SYNTAXERROR();
L_01AD:;
// 2030 get CONDITION
GETCONDITION();
// 2031 %finish
L_01AA:;
// 2032 -> term
goto U_1009;
// 2033
// 2034 initial(iu): !%if, %unless
case_INITIAL_16:;
// 2035 %cycle
L_01AE:;
// 2036 holdnp = np
HOLDNP = NP;
// 2037 get CONDITION
GETCONDITION();
// 2038 ! compile(holdnp,np)
// 2039 %if a(then) %start
if (!(A(20))) goto L_01AF;
// 2040 -> fudge %if a(start)
if (!(A(21))) goto L_01B0;
goto U_100D;
L_01B0:;
// 2041 get INSTRUCTION
GETINSTRUCTION();
// 2042 %finish %else %start
goto L_01B1;
L_01AF:;
// 2043 get(start)
GET(21);
// 2044 fudge:
U_100D:;
// 2045 %cycle
L_01B2:;
// 2046 get(terminator)
GET(52);
// 2047 curlab = curlab+2
CURLAB = CURLAB + 2;
// 2048 get STATEMENTS(else)
GETSTATEMENTS(4);
// 2049 curlab = curlab-2
CURLAB = CURLAB - 2;
// 2050 %exit %if atom # else; !%finish ->
if (ATOM == 4) goto L_01B3;
goto L_01B4;
L_01B3:;
// 2051 get CONDITION %if a(iu)
if (!(A(16))) goto L_01B5;
GETCONDITION();
L_01B5:;
// 2052 %repeat
goto L_01B2;
L_01B4:;
// 2053 %return %if atom # finish
if (ATOM == 3) goto L_01B6;
return;
L_01B6:;
// 2054 %finish
L_01B1:;
// 2055 %exit %if %not a(else)
if (A(4)) goto L_01B7;
goto L_01B8;
L_01B7:;
// 2056 -> fudge %if a(start)
if (!(A(21))) goto L_01B9;
goto U_100D;
L_01B9:;
// 2057 get INSTRUCTION %and %exit %if %not a(iu)
if (A(16)) goto L_01BA;
GETINSTRUCTION();
goto L_01B8;
L_01BA:;
// 2058 %repeat
goto L_01AE;
L_01B8:;
// 2059 -> term
goto U_1009;
// 2060
// 2061 initial(cycle):
case_INITIAL_22:;
// 2062 %if a(terminator) %start
if (!(A(52))) goto L_01BB;
// 2063 holdlooplab = looplab; looplab = curlab
HOLDLOOPLAB = LOOPLAB;
LOOPLAB = CURLAB;
// 2064 curlab = curlab+2
CURLAB = CURLAB + 2;
// 2065 get STATEMENTS(repeat)
GETSTATEMENTS(2);
// 2066 curlab = curlab-2; looplab = holdlooplab
CURLAB = CURLAB - 2;
LOOPLAB = HOLDLOOPLAB;
// 2067 %return %if atom # repeat
if (ATOM == 2) goto L_01BC;
return;
L_01BC:;
// 2068 get CONDITION %if a(until)
if (!(A(18))) goto L_01BD;
GETCONDITION();
L_01BD:;
// 2069 -> term
goto U_1009;
// 2070 %finish
L_01BB:;
// 2071 nonstandard(oldcycle)
NONSTANDARD(4096);
// 2072 get FOR CLAUSE
GETFORCLAUSE();
// 2073 -> for1
goto U_100E;
// 2074 initial(while):
case_INITIAL_17:;
// 2075 holdnp = np
HOLDNP = NP;
// 2076 ! put3(label,curlab,0)
// 2077 get CONDITION
GETCONDITION();
// 2078 ! compile(holdnp,np)
// 2079 get(cycle)
GET(22);
// 2080 get(terminator)
GET(52);
// 2081 holdlooplab = looplab; looplab = curlab
HOLDLOOPLAB = LOOPLAB;
LOOPLAB = CURLAB;
// 2082 curlab = curlab+2
CURLAB = CURLAB + 2;
// 2083 get STATEMENTS(repeat)
GETSTATEMENTS(2);
// 2084 curlab = curlab-2; looplab = holdlooplab
CURLAB = CURLAB - 2;
LOOPLAB = HOLDLOOPLAB;
// 2085 %return %if atom # repeat
if (ATOM == 2) goto L_01BE;
return;
L_01BE:;
// 2086 nonstandard(loop2) %and get CONDITION %if a(until)
if (!(A(18))) goto L_01BF;
NONSTANDARD(8192);
GETCONDITION();
L_01BF:;
// 2087 ! put3(jump,curlab,0)
// 2088 ! put3(label,curlab+1,0)
// 2089 ->term
goto U_1009;
// 2090 initial(for):
case_INITIAL_19:;
// 2091 get FOR CLAUSE
GETFORCLAUSE();
// 2092 get(cycle)
GET(22);
// 2093 for1:
U_100E:;
// 2094 get(terminator)
GET(52);
// 2095 holdlooplab = looplab; looplab = curlab
HOLDLOOPLAB = LOOPLAB;
LOOPLAB = CURLAB;
// 2096 curlab = curlab+2
CURLAB = CURLAB + 2;
// 2097 get STATEMENTS(repeat)
GETSTATEMENTS(2);
// 2098 curlab = curlab-2; looplab = holdlooplab
CURLAB = CURLAB - 2;
LOOPLAB = HOLDLOOPLAB;
// 2099 %return %if atom # repeat
if (ATOM == 2) goto L_01C0;
return;
L_01C0:;
// 2100 ! put3(repeat,0,0)
// 2101 -> term
goto U_1009;
// 2102
// 2103 initial(on):
case_INITIAL_15:;
// 2104 fault(ordererr+point) %if c_flags >= hadon %or level <= outerlevel
if (C.FLAGS >= 16) goto L_01C1;
if (LEVEL > 0) goto L_01C2;
L_01C1:;
FAULT(10 + 64);
L_01C2:;
// 2105 c_flags = c_flags!hadon
C.FLAGS = C.FLAGS | 16;
// 2106 matched = 1
MATCHED = 1;
// 2107 allow(keyevent)
ALLOW(44);
// 2108 %cycle
L_01C3:;
// 2109 get LITINT
GETLITINT();
// 2110 expfault(rangerr+point) %unless 0 <= t_val <= 15
{
// Double-sided test on T.VAL (Part I)
int tmp;
if (0 > (tmp = T.VAL)) goto L_01C4;
// Double-sided test on T.VAL (Part II)
if (tmp <= 15) goto L_01C5;
}
L_01C4:;
EXPFAULT(12 + 64);
L_01C5:;
// 2111 c_events = c_events!1<<t_val
C.EVENTS = C.EVENTS | 1 << T.VAL;
// 2112 %repeat %until %not a(comma)
if (!(A(59))) goto L_01C6;
goto L_01C3;
L_01C6:;
// 2113 get(start)
GET(21);
// 2114 ! put3(on,0,0)
// 2115 curlab = curlab+2
CURLAB = CURLAB + 2;
// 2116 get STATEMENTS(finish)
GETSTATEMENTS(3);
// 2117 curlab = curlab-2
CURLAB = CURLAB - 2;
// 2118 %return %if atom # finish
if (ATOM == 3) goto L_01C7;
return;
L_01C7:;
// 2119 -> term
goto U_1009;
// 2120 !
// 2121 initial(else):
case_INITIAL_4:;
// 2122 -> skip %if starts # 0
if (STARTS == 0) goto L_01C8;
goto U_100A;
L_01C8:;
// 2123 %return %if stopper = else
if (STOPPER != 4) goto L_01C9;
return;
L_01C9:;
// 2124 error(noif) %if stopper = finish
if (STOPPER != 3) goto L_01CA;
ERROR(21);
L_01CA:;
// 2125 initial(finish):
case_INITIAL_3:;
// 2126 starts = starts-1 %and -> skip %if starts # 0
if (STARTS == 0) goto L_01CB;
STARTS = STARTS - 1;
goto U_100A;
L_01CB:;
// 2127 %return %if stopper = finish %or stopper = else
if (STOPPER == 3) goto L_01CC;
if (STOPPER != 4) goto L_01CD;
L_01CC:;
return;
L_01CD:;
// 2128 error(nostart)
ERROR(8);
// 2129 initial(repeat):
case_INITIAL_2:;
// 2130 cycles = cycles-1 %and -> skip %if cycles # 0
if (CYCLES == 0) goto L_01CE;
CYCLES = CYCLES - 1;
goto U_100A;
L_01CE:;
// 2131 %return %if stopper = repeat
if (STOPPER != 2) goto L_01CF;
return;
L_01CF:;
// 2132 error(nocycle)
ERROR(9);
// 2133
// 2134 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 2135 !!!!!!!!!!!!!!!!!!!! Declarations !!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 2136 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 2137 !
// 2138 %integerfn NEWATYPE(%integer eltype,xtype)
int NEWATYPE(int ELTYPE, int XTYPE) {
// 2139 %integer dpos
int DPOS;
// 2140 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 2141 %ownrecord(identinfo) d=0
static struct IDENTINFO D = {0};
// 2142 dpos = dictmin
DPOS = 2041;
// 2143 %cycle
L_01D0:;
// 2144 dp == dict(dpos)
DP = (struct IDENTINFO *)/*?*/ &DICT[DPOS - 2001];
// 2145 %result = dpos+direct %if dp_flags&typeid # 0 %c
if (DP->FLAGS & 256 == 0) goto L_01D1;
if (DP->TYPE != ELTYPE) goto L_01D1;
if (DP->VAL != XTYPE) goto L_01D1;
return DPOS + 8192;
L_01D1:;
// 2146+ %and dp_type = eltype %and dp_val = xtype
// 2147 dpos = dpos+1
DPOS = DPOS + 1;
// 2148 %repeat %until dpos = dlim
if (DPOS == DLIM) goto L_01D2;
goto L_01D0;
L_01D2:;
// 2149 d_flags = typeid; d_type = eltype; d_val = xtype
D.FLAGS = 256;
D.TYPE = ELTYPE;
D.VAL = XTYPE;
// 2150 dict(dpos) = d
DICT[DPOS - 2001] = D;
// 2151 dlim = dlim+1; croak("Too many identifers") %if dlim >= dmin
DLIM = DLIM + 1;
if (DLIM < DMIN) goto L_01D3;
CROAK(_imp_str_literal("Too many identifers"));
L_01D3:;
// 2152 %result = dpos+direct
return DPOS + 8192;
// 2153 %end
} /* end of NEWATYPE */
// 2154 !
// 2155 %integerfn NEWSTYPE(%integer max)
int NEWSTYPE(int MAX) {
// 2156 %integer dpos
int DPOS;
// 2157 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 2158 %ownrecord(identinfo) d=0
static struct IDENTINFO D = {0};
// 2159 dpos = dictmin
DPOS = 2041;
// 2160 %cycle
L_01D4:;
// 2161 dp == dict(dpos)
DP = (struct IDENTINFO *)/*?*/ &DICT[DPOS - 2001];
// 2162 %result = dpos %if dp_type = stringy %and dp_val = max
if (DP->TYPE != 2044) goto L_01D5;
if (DP->VAL != MAX) goto L_01D5;
return DPOS;
L_01D5:;
// 2163 dpos = dpos+1
DPOS = DPOS + 1;
// 2164 %repeat %until dpos = dlim
if (DPOS == DLIM) goto L_01D6;
goto L_01D4;
L_01D6:;
// 2165 d_flags = typeid; d_type = stringy
D.FLAGS = 256;
D.TYPE = 2044;
// 2166 d_val = max
D.VAL = MAX;
// 2167 dict(dpos) = d
DICT[DPOS - 2001] = D;
// 2168 dlim = dlim+1; croak("Too many identifers") %if dlim >= dmin
DLIM = DLIM + 1;
if (DLIM < DMIN) goto L_01D7;
CROAK(_imp_str_literal("Too many identifers"));
L_01D7:;
// 2169 %result = dpos
return DPOS;
// 2170 %end
} /* end of NEWSTYPE */
// 2171 !
// 2172 %integerfn NEWRANGE(%integer type,lower,upper)
int NEWRANGE(int TYPE, int LOWER, int UPPER) {
// 2173 %integer dpos
int DPOS;
// 2174 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 2175 %ownrecord(identinfo) d=0
static struct IDENTINFO D = {0};
// 2176 fault(boundserr) %and upper = lower %if lower > upper
if (LOWER <= UPPER) goto L_01D8;
FAULT(14);
UPPER = LOWER;
L_01D8:;
// 2177 elements = maxint
ELEMENTS = 2147483647;
// 2178 elements = upper-lower %if upper!!lower >= 0 %c
if (UPPER ^ LOWER >= 0) goto L_01D9;
if ((-2147483648) + UPPER - LOWER >= 0) goto L_01DA;
L_01D9:;
ELEMENTS = UPPER - LOWER;
L_01DA:;
// 2179+ %or minint+upper-lower < 0
// 2180 elements = elements+1 %if elements # maxint
if (ELEMENTS == 2147483647) goto L_01DB;
ELEMENTS = ELEMENTS + 1;
L_01DB:;
// 2181 dpos = dictmin
DPOS = 2041;
// 2182 %cycle
L_01DC:;
// 2183 dp == dict(dpos)
DP = (struct IDENTINFO *)/*?*/ &DICT[DPOS - 2001];
// 2184 %result = dpos %if dp_flags = typeid %and dp_type = type %c
if (DP->FLAGS != 256) goto L_01DD;
if (DP->TYPE != TYPE) goto L_01DD;
if (DP->LOW != LOWER) goto L_01DD;
if (DP->VAL != UPPER) goto L_01DD;
return DPOS;
L_01DD:;
// 2185+ %and dp_low = lower %and dp_val = upper
// 2186 dpos = dpos+1
DPOS = DPOS + 1;
// 2187 %repeat %until dpos = dlim
if (DPOS == DLIM) goto L_01DE;
goto L_01DC;
L_01DE:;
// 2188 d_flags = typeid; d_type = type
D.FLAGS = 256;
D.TYPE = TYPE;
// 2189 d_low = lower; d_val = upper
D.LOW = LOWER;
D.VAL = UPPER;
// 2190 dict(dpos) = d
DICT[DPOS - 2001] = D;
// 2191 dlim = dlim+1; croak("Too many identifers") %if dlim >= dmin
DLIM = DLIM + 1;
if (DLIM < DMIN) goto L_01DF;
CROAK(_imp_str_literal("Too many identifers"));
L_01DF:;
// 2192 %result = dpos
return DPOS;
// 2193 %end
} /* end of NEWRANGE */
// 2194
// 2195 %routine GET LITBOUNDS
void GETLITBOUNDS(void) {
// 2196 %integer lower
int LOWER;
// 2197 get(left)
GET(55);
// 2198 get LITINT; lower = t_val
GETLITINT();
LOWER = T.VAL;
// 2199 get(colon)
GET(58);
// 2200 get LITINT;
GETLITINT();
// 2201 get(right)
GET(60);
// 2202 t_low = lower
T.LOW = LOWER;
// 2203 item = newrange(inty,t_low,t_val); !always integer at present
ITEM = NEWRANGE(2046, T.LOW, T.VAL);
// 2204 %end
return;
} /* end of GETLITBOUNDS */
// 2205
// 2206 %routine GET IDENT
void GETIDENT(void) {
// 2207 dlim0 = dlim
DLIM0 = DLIM;
// 2208 get(ident)
GET(54);
// 2209 declare
DECLARE();
// 2210 get LITSTRING %if d_flags&ext # 0 %and a(alias)
if (D.FLAGS & 32 == 0) goto L_01E0;
if (!(A(46))) goto L_01E0;
GETLITSTRING();
L_01E0:;
// 2211 %end
return;
} /* end of GETIDENT */
// 2212
// 2213 %routine GET IDENTLIST
void GETIDENTLIST(void) {
// 2214 dlim0 = dlim
DLIM0 = DLIM;
// 2215 %cycle
L_01E1:;
// 2216 get(ident)
GET(54);
// 2217 declare
DECLARE();
// 2218 get LITSTRING %if d_flags&ext # 0 %and a(alias)
if (D.FLAGS & 32 == 0) goto L_01E2;
if (!(A(46))) goto L_01E2;
GETLITSTRING();
L_01E2:;
// 2219 %repeat %until %not a(comma)
if (!(A(59))) goto L_01E3;
goto L_01E1;
L_01E3:;
// 2220 %end
return;
} /* end of GETIDENTLIST */
// 2221
// 2222 %routine GET TYPE(%integer flags)
void GETTYPE(int FLAGS) {
// 2223 %owninteger fbase
static int FBASE;
// 2224 %ownrecord(identinfo)%name formp,fieldp
static struct IDENTINFO *FORMP;
static struct IDENTINFO *FIELDP;
// 2225 !
// 2226 %routine GET FORMATDEF; !(%integername base)
void GETFORMATDEF(void) {
// 2227 %integer disp,max,base
int DISP;
int MAX;
int BASE;
// 2228 %routine GET FIELD IDENT
void GETFIELDIDENT(void) {
// 2229 get(ident)
GET(54);
// 2230 %if item > 0 %then d_text = ditem_text %c
if (ITEM <= 0) goto L_01E4;
D.TEXT = DITEM->TEXT;
goto L_01E5;
L_01E4:;
// 2231+ %else %start
// 2232 d_text = charlim-charbase; charlim = charlim+newlen+1
D.TEXT = CHARLIM - CHARBASE;
CHARLIM = CHARLIM + NEWLEN + 1;
// 2233 croak("Identifier space exhausted") %if charlim+80 >= charmin
if (CHARLIM + 80 < CHARMIN) goto L_01E6;
CROAK(_imp_str_literal("Identifier space exhausted"));
L_01E6:;
// 2234 %finish
L_01E5:;
// 2235 ditem == dict(dlim); fieldp == ditem
DITEM = (struct IDENTINFO *)/*?*/ &DICT[DLIM - 2001];
FIELDP = (struct IDENTINFO *)DITEM;
// 2236 ditem = d
*DITEM = D;
// 2237 %if formp_extra = 0 %then formp_extra = dlim %c
if (FORMP->EXTRA != 0) goto L_01E7;
FORMP->EXTRA = DLIM;
goto L_01E8;
L_01E7:;
// 2238+ %else %start
// 2239 ! lookup field ident(formp_extra)
// 2240 ! fault(duperr+point) %and item = dlim %if item # dlim
// 2241 %finish
L_01E8:;
// 2242 dlim = dlim+1; croak("Too many identifiers") %if dlim >= dmin
DLIM = DLIM + 1;
if (DLIM < DMIN) goto L_01E9;
CROAK(_imp_str_literal("Too many identifiers"));
L_01E9:;
// 2243 %end
return;
} /* end of GETFIELDIDENT */
// 2244 %routine get UNIT
void GETUNIT(void) {
// 2245 %cycle
L_01EA:;
// 2246 %if a(left) %start
if (!(A(55))) goto L_01EB;
// 2247 get FORMATDEF; get(right)
GETFORMATDEF();
GET(60);
// 2248 %return %if %not a(comma)
if (A(59)) goto L_01EC;
return;
L_01EC:;
// 2249 %else
goto L_01ED;
L_01EB:;
// 2250 get TYPE(static+more)
GETTYPE(8 + 128);
// 2251 %if d_flags&parm = 0 %start; !not array
if (D.FLAGS & 64 != 0) goto L_01EE;
// 2252 %cycle
L_01EF:;
// 2253 disp = disp+1 %if disp&1 # 0 %and dsize # 1
if (DISP & 1 == 0) goto L_01F0;
if (DSIZE == 1) goto L_01F0;
DISP = DISP + 1;
L_01F0:;
// 2254 d_val = disp
D.VAL = DISP;
// 2255 disp = disp+dsize
DISP = DISP + DSIZE;
// 2256 get FIELD IDENT
GETFIELDIDENT();
// 2257 %return %if %not a(comma)
if (A(59)) goto L_01F1;
return;
L_01F1:;
// 2258 atom = next atom
ATOM = NEXTATOM();
// 2259 %repeat %until atom # ident
if (ATOM != 54) goto L_01F2;
goto L_01EF;
L_01F2:;
// 2260 %else; !array
goto L_01F3;
L_01EE:;
// 2261 d_flags = d_flags-parm
D.FLAGS = D.FLAGS - 64;
// 2262 disp = disp+1 %if disp&1 # 0; d_val = disp
if (DISP & 1 == 0) goto L_01F4;
DISP = DISP + 1;
L_01F4:;
D.VAL = DISP;
// 2263 get FIELD IDENT
GETFIELDIDENT();
// 2264 get LITBOUNDS
GETLITBOUNDS();
// 2265 fieldp_type = newatype(d_type,item)
FIELDP->TYPE = NEWATYPE(D.TYPE, ITEM);
// 2266 disp = disp+dsize*elements
DISP = DISP + DSIZE * ELEMENTS;
// 2267 %return %if %not a(comma)
if (A(59)) goto L_01F5;
return;
L_01F5:;
// 2268 %finish
L_01F3:;
// 2269 %finish
L_01ED:;
// 2270 %repeat
goto L_01EA;
// 2271 %end
} /* end of GETUNIT */
// 2272 max = 0; base = 0
MAX = 0;
BASE = 0;
// 2273 %cycle
L_01F6:;
// 2274 disp = base
DISP = BASE;
// 2275 get UNIT
GETUNIT();
// 2276 max = disp %if max < disp
if (MAX >= DISP) goto L_01F7;
MAX = DISP;
L_01F7:;
// 2277 %repeat %until %not a(keyor)
if (!(A(65))) goto L_01F8;
goto L_01F6;
L_01F8:;
// 2278 base = max
BASE = MAX;
// 2279 %end; !get FORMATDEF
return;
} /* end of GETFORMATDEF */
// 2280
// 2281 dsize = 0; d_mode = 0; d_val = 0
DSIZE = 0;
D.MODE = 0;
D.VAL = 0;
// 2282 d_type = nulltype
D.TYPE = 2041;
// 2283 %if a(rpred) %start; !%routine,(%integerfn)
if (!(A(33))) goto L_01F9;
// 2284 flags = flags&(\static) %if flags&ext # 0
if (FLAGS & 32 == 0) goto L_01FA;
FLAGS = FLAGS & (~8);
L_01FA:;
// 2285 syntax error %if flags&static # 0
if (FLAGS & 8 == 0) goto L_01FB;
SYNTAXERROR();
L_01FB:;
// 2286 nonstandard(pred) %and d_type = booltype %if subatom # 0
if (SUBATOM == 0) goto L_01FC;
NONSTANDARD(1);
D.TYPE = 2048;
L_01FC:;
// 2287 d_flags = flags+proc; declmode = declmode+pcmode
D.FLAGS = FLAGS + 4;
DECLMODE = DECLMODE + 58;
// 2288 %return
return;
// 2289 %finish
L_01F9:;
// 2290 %if a(krange) %start; !%byte,%short,%half,%mite
if (!(A(25))) goto L_01FD;
// 2291 d_type = inttype+subatom; dsize = 1
D.TYPE = 2051 + SUBATOM;
DSIZE = 1;
// 2292 dsize = 2 %if d_type = shorttype %or d_type = halftype
if (D.TYPE == 2052) goto L_01FE;
if (D.TYPE != 2053) goto L_01FF;
L_01FE:;
DSIZE = 2;
L_01FF:;
// 2293 nonstandard(ranges) %if d_type >= mitetype
if (D.TYPE < 2055) goto L_0200;
NONSTANDARD(16);
L_0200:;
// 2294 allow(keyinteger)
ALLOW(27);
// 2295 %else %if a(keyinteger); !%integer
goto L_0201;
L_01FD:;
if (!(A(27))) goto L_0202;
// 2296 d_type = inttype; dsize = 4
D.TYPE = 2051;
DSIZE = 4;
// 2297 atom = next atom
ATOM = NEXTATOM();
// 2298 %if atom = left %start
if (ATOM != 55) goto L_0203;
// 2299 get LITBOUNDS
GETLITBOUNDS();
// 2300 d_type = item
D.TYPE = ITEM;
// 2301 dsize = 2 %if elements <= 65536 %and t_low >= -32768
if (ELEMENTS > 65536) goto L_0204;
if (T.LOW < -32768) goto L_0204;
DSIZE = 2;
L_0204:;
// 2302 dsize = 1 %if elements <= 256 %and t_low >= -128
if (ELEMENTS > 256) goto L_0205;
if (T.LOW < -128) goto L_0205;
DSIZE = 1;
L_0205:;
// 2303 %finish
L_0203:;
// 2304 %else %if a(keylong); !%long
goto L_0201;
L_0202:;
if (!(A(26))) goto L_0206;
// 2305 d_type = longinttype; dsize = 8
D.TYPE = 2057;
DSIZE = 8;
// 2306 d_type = longrealtype %and get(keyreal) %if %not a(keyinteger)
if (A(27)) goto L_0207;
D.TYPE = 2059;
GET(28);
L_0207:;
// 2307 %else %if a(keyreal); !%real
goto L_0201;
L_0206:;
if (!(A(28))) goto L_0208;
// 2308 d_type = realtype; dsize = 4
D.TYPE = 2058;
DSIZE = 4;
// 2309 %else %if a(keystring); !%string
goto L_0201;
L_0208:;
if (!(A(29))) goto L_0209;
// 2310 d_type = stringy
D.TYPE = 2044;
// 2311 t_val = 255; dsize = 256
T.VAL = 255;
DSIZE = 256;
// 2312 %if a(left) %start
if (!(A(55))) goto L_020A;
// 2313 t_val = 0
T.VAL = 0;
// 2314 %if %not a(star) %start
if (A(88)) goto L_020B;
// 2315 get LITINT
GETLITINT();
// 2316 expfault(rangerr+point) %and t_val = 255 %unless 0 < t_val <= 255
{
// Double-sided test on T.VAL (Part I)
int tmp;
if (0 >= (tmp = T.VAL)) goto L_020C;
// Double-sided test on T.VAL (Part II)
if (tmp <= 255) goto L_020D;
}
L_020C:;
EXPFAULT(12 + 64);
T.VAL = 255;
L_020D:;
// 2317 %finish
L_020B:;
// 2318 get(right)
GET(60);
// 2319 %finish %else nonstandard(nolength)
goto L_020E;
L_020A:;
NONSTANDARD(32);
L_020E:;
// 2320 %if t_val # 0 %start
if (T.VAL == 0) goto L_020F;
// 2321 d_type = newstype(t_val)
D.TYPE = NEWSTYPE(T.VAL);
// 2322 dsize = (t_val+2)&(\1); !+1 & evened up
DSIZE = T.VAL + 2 & (~1);
// 2323 %finish
L_020F:;
// 2324 %else %if a(keyrecord); !%record
goto L_0201;
L_0209:;
if (!(A(30))) goto L_0210;
// 2325 d_type = recy
D.TYPE = 2042;
// 2326 %if a(keyformat) %start
if (!(A(31))) goto L_0211;
// 2327 syntax error %if flags&(static+ext) # 0
if (FLAGS & 8 + 32 == 0) goto L_0212;
SYNTAXERROR();
L_0212:;
// 2328 %if a(keyspec) %start
if (!(A(34))) goto L_0213;
// 2329 d_flags = typeid+spec
D.FLAGS = 256 + 16;
// 2330 get IDENT
GETIDENT();
// 2331 %finish %else %start
goto L_0214;
L_0213:;
// 2332 d_flags = typeid
D.FLAGS = 256;
// 2333 get IDENT
GETIDENT();
// 2334 formp == ditem
FORMP = (struct IDENTINFO *)DITEM;
// 2335 get(left)
GET(55);
// 2336 fbase = 0
FBASE = 0;
// 2337 get FORMATDEF
GETFORMATDEF();
// 2338 fieldp_flags = fieldp_flags-more
FIELDP->FLAGS = FIELDP->FLAGS - 128;
// 2339 get(right)
GET(60);
// 2340 %finish
L_0214:;
// 2341 d_flags = typeid
D.FLAGS = 256;
// 2342 %return
return;
// 2343 %finish
L_0211:;
// 2344 get(left)
GET(55);
// 2345 %if %not a(star) %start
if (A(88)) goto L_0215;
// 2346 %if %not a(ident) %start
if (A(54)) goto L_0216;
// 2347 get FORMATDEF
GETFORMATDEF();
// 2348 fieldp_flags = fieldp_flags-more
FIELDP->FLAGS = FIELDP->FLAGS - 128;
// 2349 get(right)
GET(60);
// 2350 d_flags = typeid
D.FLAGS = 256;
// 2351 declare anon
DECLAREANON();
// 2352 %finish
L_0216:;
// 2353 name error %if item <= 0
if (ITEM > 0) goto L_0217;
NAMEERROR();
L_0217:;
// 2354 syntax error %if ditem_type # recy
if (DITEM->TYPE == 2042) goto L_0218;
SYNTAXERROR();
L_0218:;
// 2355 d_type = item; dsize = ditem_val
D.TYPE = ITEM;
DSIZE = DITEM->VAL;
// 2356 %finish
L_0215:;
// 2357 get(right)
GET(60);
// 2358 %else
goto L_0201;
L_0210:;
// 2359 syntax error %if atom # keyname; !untyped %name
if (ATOM == 36) goto L_0219;
SYNTAXERROR();
L_0219:;
// 2360 %finish
L_0201:;
// 2361 !End of basic type info: set item size in DECLMODE
// 2362 %if dsize <= 4 %start
if (DSIZE > 4) goto L_021A;
// 2363 %if dsize <= 2 %then declmode = dsize<<sizeshift %c
if (DSIZE > 2) goto L_021B;
DECLMODE = DSIZE << 6;
goto L_021C;
L_021B:;
DECLMODE = 3 << 6;
L_021C:;
// 2364+ %else declmode = longsize<<sizeshift
// 2365 %finish
L_021A:;
// 2366 !Appendages
// 2367 %if a(fnmap) %start; !%fn, %map
if (!(A(32))) goto L_021D;
// 2368 flags = flags&(\static) %if flags&ext # 0
if (FLAGS & 32 == 0) goto L_021E;
FLAGS = FLAGS & (~8);
L_021E:;
// 2369 syntax error %if flags&static # 0
if (FLAGS & 8 == 0) goto L_021F;
SYNTAXERROR();
L_021F:;
// 2370 flags = flags+var %and d_type = d_type+direct %if subatom # 0; !map
if (SUBATOM == 0) goto L_0220;
FLAGS = FLAGS + 1;
D.TYPE = D.TYPE + 8192;
L_0220:;
// 2371 d_flags = flags+proc; declmode = declmode+pcmode
D.FLAGS = FLAGS + 4;
DECLMODE = DECLMODE + 58;
// 2372 %return
return;
// 2373 %finish
L_021D:;
// 2374 d_type = d_type+direct
D.TYPE = D.TYPE + 8192;
// 2375 %while a(keyarray) %or a(keyname) %cycle
L_0221:;
if (A(35)) goto L_0222;
if (!(A(36))) goto L_0223;
L_0222:;
// 2376 %if atom = keyarray %start; !%array
if (ATOM != 35) goto L_0224;
// 2377 nonstandard(naming) %if d_type >= indirect
if (D.TYPE < 16384) goto L_0225;
NONSTANDARD(512);
L_0225:;
// 2378 %if %not a(keyname) %start
if (A(36)) goto L_0226;
// 2379 syntax error %if flags&parm # 0
if (FLAGS & 64 == 0) goto L_0227;
SYNTAXERROR();
L_0227:;
// 2380 flags = flags+parm; !as indic
FLAGS = FLAGS + 64;
// 2381 %exit
goto L_0223;
// 2382 %finish
L_0226:;
// 2383 d_type = newatype(d_type,inty)
D.TYPE = NEWATYPE(D.TYPE, 2046);
// 2384 %finish
L_0224:;
// 2385 syntax error %if d_type >= indirect
if (D.TYPE < 16384) goto L_0228;
SYNTAXERROR();
L_0228:;
// 2386 d_type = d_type+(indirect-direct)
D.TYPE = D.TYPE + (16384 - 8192);
// 2387 dsize = 4
DSIZE = 4;
// 2388 %repeat
goto L_0221;
L_0223:;
// 2389 d_flags = flags!!var
D.FLAGS = FLAGS ^ 1;
// 2390 %end; !GET TYPE
return;
} /* end of GETTYPE */
// 2391 !
// 2392 %routine GET OWN ARRAY DECLARATION
void GETOWNARRAYDECLARATION(void) {
// 2393 %integer holdval,dpos
int HOLDVAL;
int DPOS;
// 2394 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 2395 ! constad = constad+1 %if constad&1 # 0
// 2396 ! d_val = constad
// 2397 ! d_val = d_val-ownbase %if d_val >= ownbase
// 2398 get IDENT
GETIDENT();
// 2399 dpos = item; dp == ditem
DPOS = ITEM;
DP = (struct IDENTINFO *)DITEM;
// 2400 get LITBOUNDS
GETLITBOUNDS();
// 2401 dp_type = newatype(d_type,item)
DP->TYPE = NEWATYPE(D.TYPE, ITEM);
// 2402 %if a assop %start
if (!(AASSOP())) goto L_0229;
// 2403 allow(terminator)
ALLOW(52);
// 2404 %cycle
L_022A:;
// 2405 get LITERAL(d_type)
GETLITERAL(D.TYPE);
// 2406 faultnum = rangerr+point+warn %if faultnum = rangerr+point
if (FAULTNUM != 12 + 64) goto L_022B;
FAULTNUM = 12 + 64 + 128;
L_022B:;
// 2407 holdval = t_val
HOLDVAL = T.VAL;
// 2408 t_val = 1
T.VAL = 1;
// 2409 %if a(left) %start
if (!(A(55))) goto L_022C;
// 2410 t_val = elements
T.VAL = ELEMENTS;
// 2411 get LITINT %if %not a(star)
if (A(88)) goto L_022D;
GETLITINT();
L_022D:;
// 2412 get(right)
GET(60);
// 2413 %finish
L_022C:;
// 2414 ! plant const(holdval,t_val)
// 2415 elements = elements-t_val
ELEMENTS = ELEMENTS - T.VAL;
// 2416 %repeat %until %not a(comma)
if (!(A(59))) goto L_022E;
goto L_022A;
L_022E:;
// 2417 report(counterr,dpos) %if elements # 0 %and faultnum = 0
if (ELEMENTS == 0) goto L_022F;
if (FAULTNUM != 0) goto L_022F;
REPORT(45, DPOS);
L_022F:;
// 2418 %finish
L_0229:;
// 2419 ! plant const(0,elements) %if elements > 0
// 2420 %end; !get OWN ADECL
return;
} /* end of GETOWNARRAYDECLARATION */
// 2421
// 2422 %routine GET ARRAY DECLARATION
void GETARRAYDECLARATION(void) {
// 2423 !ie get IDENTLISTS and BOUNDS
// 2424 %integer i,dlim1,hold,holdval,type
int I;
int DLIM1;
int HOLD;
int HOLDVAL;
int TYPE;
// 2425
// 2426 !%routine put bound pair
// 2427 ! hold = litref(holdval) %if hold = 0
// 2428 ! item = litref(t_val) %if item = 0
// 2429 ! put3(r,hold,item); !(range),lower,upper
// 2430 !%end
// 2431
// 2432 %routine GET BOUNDS
void GETBOUNDS(void) {
// 2433 %integer range
int RANGE;
// 2434 get VALUE(anyint)
GETVALUE(10238);
// 2435 hold = item; t_val = minint %if hold # 0
HOLD = ITEM;
if (HOLD == 0) goto L_0230;
T.VAL = -2147483648;
L_0230:;
// 2436 holdval = t_val
HOLDVAL = T.VAL;
// 2437 get(colon)
GET(58);
// 2438 get VALUE(anyint)
GETVALUE(10238);
// 2439 t_val = maxint %if item # 0
if (ITEM == 0) goto L_0231;
T.VAL = 2147483647;
L_0231:;
// 2440 range = newrange(inty,holdval,t_val)
RANGE = NEWRANGE(2046, HOLDVAL, T.VAL);
// 2441 GET BOUNDS %if a(comma)
if (!(A(59))) goto L_0232;
GETBOUNDS();
L_0232:;
// 2442 type = newatype(type,range)
TYPE = NEWATYPE(TYPE, RANGE);
// 2443 %end
return;
} /* end of GETBOUNDS */
// 2444
// 2445 %cycle
L_0233:;
// 2446 type = d_type
TYPE = D.TYPE;
// 2447 get IDENTLIST
GETIDENTLIST();
// 2448 dlim1 = dlim
DLIM1 = DLIM;
// 2449 get(left)
GET(55);
// 2450 GET BOUNDS
GETBOUNDS();
// 2451 get(right)
GET(60);
// 2452 ! %if hold = 0 = item {both literal} %and np = np0 {1-dim} %c
// 2453 ! %and elements <= 32767 {safe to multiply?} %c
// 2454 ! %and (elements*dsize*(dlim-dpos))<<1-c_sp-c_delta <= 32000 %start
// 2455 ! d_par = parref(inty,0,r,0)
// 2456 ! %finish %else %start
// 2457 ! put bound pair
// 2458 ! d_par = 0
// 2459 ! i = np
// 2460 ! %while i # np0 %cycle
// 2461 ! i = i-1
// 2462 ! d_par = parref(inty,0,exp(i)_act,d_par)
// 2463 ! %repeat
// 2464 ! exp(np0)_act = adecl
// 2465 ! %finish
// 2466 ! i = np
// 2467 %while dlim0 # dlim1 %cycle
L_0234:;
if (DLIM0 == DLIM1) goto L_0235;
// 2468 ! %if i = np0 %start
// 2469 ! c_delta = c_delta-elements*dsize
// 2470 ! c_delta = c_delta-1 %if c_delta&1 # 0
// 2471 ! dict(dlim0)_flags = dict(dlim0)_flags!static
// 2472 ! %finish %else %start
// 2473 ! np = i; compile(np0,np0)
// 2474 ! c_flags = c_flags!dynarray
// 2475 ! %finish
// 2476 ! dict(dlim0)_val = c_sp+c_delta
// 2477 dict(dlim0)_type = type
DICT[DLIM0 - 2001].TYPE = TYPE;
// 2478 dlim0 = dlim0+1
DLIM0 = DLIM0 + 1;
// 2479 %repeat
goto L_0234;
L_0235:;
// 2480 %repeat %until %not a(comma)
if (!(A(59))) goto L_0236;
goto L_0233;
L_0236:;
// 2481 %end;
return;
} /* end of GETARRAYDECLARATION */
// ?I unused
// 2482 ; !get BOUNDS
// 2482
// 2483 %routine GET PARMDEF
void GETPARMDEF(void) {
// 2484 %integer headitem,dpos,dlim1
int HEADITEM;
int DPOS;
int DLIM1;
// 2485 %record(identinfo)%name headditem,dp
struct IDENTINFO *HEADDITEM;
struct IDENTINFO *DP;
// 2486 %integerfn PARMMATCH(%integer apos)
int PARMMATCH(int APOS) {
// 2487 %integer bpos
int BPOS;
// 2488 %record(identinfo)%name ap,bp
struct IDENTINFO *AP;
struct IDENTINFO *BP;
// 2489 bpos = dlim1
BPOS = DLIM1;
// 2490 ap == dict(apos)
AP = (struct IDENTINFO *)/*?*/ &DICT[APOS - 2001];
// 2491 %while bpos # dlim %cycle
L_0237:;
if (BPOS == DLIM) goto L_0238;
// 2492 %result = 0 %if ap_flags&more = 0
if (AP->FLAGS & 128 != 0) goto L_0239;
return 0;
L_0239:;
// 2493 apos = apos+1 %and ap == dict(apos) %until ap_flags&parm # 0
L_023A:;
APOS = APOS + 1;
AP = (struct IDENTINFO *)/*?*/ &DICT[APOS - 2001];
if (AP->FLAGS & 64 != 0) goto L_023B;
goto L_023A;
L_023B:;
// 2494 bp == dict(bpos)
BP = (struct IDENTINFO *)/*?*/ &DICT[BPOS - 2001];
// 2495 %result = 0 %if ap_type # bp_type; !for now
if (AP->TYPE == BP->TYPE) goto L_023C;
return 0;
L_023C:;
// 2496 bpos = bpos+1
BPOS = BPOS + 1;
// 2497 %repeat
goto L_0237;
L_0238:;
// 2498 %result = 1 %if ap_flags&more = 0
if (AP->FLAGS & 128 != 0) goto L_023D;
return 1;
L_023D:;
// 2499 %result = 0
return 0;
// 2500 %end
} /* end of PARMMATCH */
// 2501 !
// 2502 headitem = item; headditem == ditem
HEADITEM = ITEM;
HEADDITEM = (struct IDENTINFO *)DITEM;
// 2503 dlim1 = dlim
DLIM1 = DLIM;
// 2504 %if a(left) %start
if (!(A(55))) goto L_023E;
// 2505 %cycle
L_023F:;
// 2506 get TYPE(parm!more) %if atom # ident
if (ATOM == 54) goto L_0240;
GETTYPE(64 | 128);
L_0240:;
// 2507 %if d_flags&proc = 0 %start
if (D.FLAGS & 4 != 0) goto L_0241;
// 2508 get IDENT
GETIDENT();
// 2509 %exit %if %not a(comma) %and atom = right
if (A(59)) goto L_0242;
if (ATOM != 60) goto L_0242;
goto L_0243;
L_0242:;
// 2510 %if atom # comma %then nonstandard(nocomma) %c
if (ATOM == 59) goto L_0244;
NONSTANDARD(4);
goto L_0245;
L_0244:;
ATOM = NEXTATOM();
L_0245:;
// 2511+ %else atom = next atom
// 2512 %finish %else %start
goto L_0246;
L_0241:;
// 2513 get IDENT
GETIDENT();
// 2514 speccing = speccing+2
SPECCING = SPECCING + 2;
// 2515 get PARMDEF
GETPARMDEF();
// 2516 speccing = speccing-2
SPECCING = SPECCING - 2;
// 2517 %exit %if %not a(comma)
if (A(59)) goto L_0247;
goto L_0243;
L_0247:;
// 2518 %finish
L_0246:;
// 2519 %repeat
goto L_023F;
L_0243:;
// 2520 dict(dlim-1)_flags = dict(dlim-1)_flags-more
DICT[DLIM - 1 - 2001].FLAGS = DICT[DLIM - 1 - 2001].FLAGS - 128;
// 2521 get(right)
GET(60);
// 2522 %finish
L_023E:;
// 2523 %if speccing >= 2 %start
if (SPECCING < 2) goto L_0248;
// 2524 dpos = dictmin
DPOS = 2041;
// 2525 %cycle
L_0249:;
// 2526 dp == dict(dpos)
DP = (struct IDENTINFO *)/*?*/ &DICT[DPOS - 2001];
// 2527 %if dp_flags&proc # 0 %and dp_type = headditem_type %start
if (DP->FLAGS & 4 == 0) goto L_024A;
if (DP->TYPE != HEADDITEM->TYPE) goto L_024A;
// 2528 %if parmmatch(dpos) # 0 %start
if (PARMMATCH(DPOS) == 0) goto L_024B;
// 2529 headditem_type = dpos; dlim = dlim1
HEADDITEM->TYPE = DPOS;
DLIM = DLIM1;
// 2530 %return
return;
// 2531 %finish
L_024B:;
// 2532 %finish
L_024A:;
// 2533 dpos = dpos+1
DPOS = DPOS + 1;
// 2534 %repeat %until dpos >= headitem
if (DPOS >= HEADITEM) goto L_024C;
goto L_0249;
L_024C:;
// 2535 fault(caterr); dlim = dlim1
FAULT(3);
DLIM = DLIM1;
// 2536 %return
return;
// 2537 %finish
L_0248:;
// 2538 %if speccing = 0 %and headditem_flags&spec # 0 %start
if (SPECCING != 0) goto L_024D;
if (HEADDITEM->FLAGS & 16 == 0) goto L_024D;
// 2539 headditem_flags = headditem_flags-spec
HEADDITEM->FLAGS = HEADDITEM->FLAGS - 16;
// 2540 fault(matcherr) %if parmmatch(headitem) = 0
if (PARMMATCH(HEADITEM) != 0) goto L_024E;
FAULT(11);
L_024E:;
// 2541 %else
goto L_024F;
L_024D:;
// 2542 headditem_flags = headditem_flags!more %if dlim # dlim1
if (DLIM == DLIM1) goto L_0250;
HEADDITEM->FLAGS = HEADDITEM->FLAGS | 128;
L_0250:;
// 2543 %finish
L_024F:;
// 2544 %end; !get PARMDEF
return;
} /* end of GETPARMDEF */
// 2545
// 2546 initial(keylabel): nonstandard(klabel)
case_INITIAL_23:;
NONSTANDARD(1024);
// 2547 d_flags = lab+spec; d_type = nulltype
D.FLAGS = 2 + 16;
D.TYPE = 2041;
// 2548 get IDENTLIST
GETIDENTLIST();
// 2549 -> term
goto U_1009;
// 2550
// 2551 initial(prefix):
case_INITIAL_24:;
// 2552 d_flags = subatom; ! !wflag!okflag
D.FLAGS = SUBATOM;
// 2553 ! fault(prefix<<8) %if d_flags&extmask # 0
// 2554 atom = next atom
ATOM = NEXTATOM();
// 2555 initial(krange): initial(keylong):
case_INITIAL_25:;
case_INITIAL_26:;
// 2556 initial(keyinteger): initial(keyreal):
case_INITIAL_27:;
case_INITIAL_28:;
// 2557 initial(keystring): initial(keyrecord):
case_INITIAL_29:;
case_INITIAL_30:;
// 2558 initial(rpred):
case_INITIAL_33:;
// 2559 matched = 0
MATCHED = 0;
// 2560 get TYPE(d_flags)
GETTYPE(D.FLAGS);
// 2561 %if a(keyspec) %start
if (!(A(34))) goto L_0251;
// 2562 %if a(left) %start
if (!(A(55))) goto L_0252;
// 2563 get LITINT; get(right)
GETLITINT();
GET(60);
// 2564 declmode = declmode&sizemask+absmode
DECLMODE = (DECLMODE & 192) + 56;
// 2565 d_val = t_val
D.VAL = T.VAL;
// 2566 get IDENT
GETIDENT();
// 2567 speccing = 1 %and get PARMDEF %if d_flags&proc # 0
if (D.FLAGS & 4 == 0) goto L_0253;
SPECCING = 1;
GETPARMDEF();
L_0253:;
// 2568 -> term
goto U_1009;
// 2569 %finish
L_0252:;
// 2570 d_flags = d_flags+spec
D.FLAGS = D.FLAGS + 16;
// 2571 get IDENTLIST %and -> term %if d_flags&proc = 0
if (D.FLAGS & 4 != 0) goto L_0254;
GETIDENTLIST();
goto U_1009;
L_0254:;
// 2572 %finish
L_0251:;
// 2573 %if d_flags&proc # 0 %start
if (D.FLAGS & 4 == 0) goto L_0255;
// 2574 get(ident)
GET(54);
// 2575 %if item >= c_localdpos %and ditem_type = d_type %c
if (ITEM < C.LOCALDPOS) goto L_0256;
if (DITEM->TYPE != D.TYPE) goto L_0256;
if (DITEM->FLAGS & 4 == 0) goto L_0256;
// 2576+ %and ditem_flags&proc # 0 %start
// 2577 %if ditem_flags&spec = 0 %or d_flags&spec # 0 %start
if (DITEM->FLAGS & 16 == 0) goto L_0257;
if (D.FLAGS & 16 == 0) goto L_0258;
L_0257:;
// 2578 item = 0; d_flags = d_flags+alt
ITEM = 0;
D.FLAGS = D.FLAGS + 2048;
// 2579 declare
DECLARE();
// 2580 %finish
L_0258:;
// 2581 %finish %else declare
goto L_0259;
L_0256:;
DECLARE();
L_0259:;
// 2582 get LITSTRING %if d_flags&ext # 0 %and a(alias)
if (D.FLAGS & 32 == 0) goto L_025A;
if (!(A(46))) goto L_025A;
GETLITSTRING();
L_025A:;
// 2583 %if d_flags&spec # 0 %start
if (D.FLAGS & 16 == 0) goto L_025B;
// 2584 speccing = 1
SPECCING = 1;
// 2585 get PARMDEF
GETPARMDEF();
// 2586 %finish %else %start
goto L_025C;
L_025B:;
// 2587 open block(item)
OPENBLOCK(ITEM);
// 2588 get PARMDEF
GETPARMDEF();
// 2589 c_parlim = dlim
C.PARLIM = DLIM;
// 2590 compile entry
COMPILEENTRY();
// 2591 get(terminator)
GET(52);
// 2592 get STATEMENTS(end)
GETSTATEMENTS(1);
// 2593 ! %if c_access > 0 %start
// 2594 ! report(noresult,0) %if c_type > nulltype; !fn/map/pred
// 2595 ! %finish
// 2596 close block
CLOSEBLOCK();
// 2597 %finish
L_025C:;
// 2598 %else %if d_flags = typeid {dealt with}
goto L_025D;
L_0255:;
if (D.FLAGS != 256) goto L_025E;
// 2599 %else %if d_flags&parm # 0; !array
goto L_025D;
L_025E:;
if (D.FLAGS & 64 == 0) goto L_025F;
// 2600 d_flags = d_flags-parm
D.FLAGS = D.FLAGS - 64;
// 2601 %if d_flags&static # 0 %start
if (D.FLAGS & 8 == 0) goto L_0260;
// 2602 get OWN ARRAY DECLARATION
GETOWNARRAYDECLARATION();
// 2603 %finish %else %start
goto L_0261;
L_0260:;
// 2604 %if d_flags&static = 0 %and c_flags >= hadon %start
if (D.FLAGS & 8 != 0) goto L_0262;
if (C.FLAGS < 16) goto L_0262;
// 2605 fault(ordererr); c_flags = c_flags&(\(hadon+hadinst))
FAULT(10);
C.FLAGS = C.FLAGS & ~(16 + 32);
// 2606 %finish
L_0262:;
// 2607 get ARRAY DECLARATION
GETARRAYDECLARATION();
// 2608 %finish
L_0261:;
// 2609 %else %if d_flags = static {const}
goto L_025D;
L_025F:;
if (D.FLAGS != 8) goto L_0263;
// 2610 d_type = dict(d_type&puretype)_type
D.TYPE = DICT[(D.TYPE & 8191) - 2001].TYPE;
// 2611 d_type = d_type+direct %if d_type = recy %or d_type = stringy
if (D.TYPE == 2042) goto L_0264;
if (D.TYPE != 2044) goto L_0265;
L_0264:;
D.TYPE = D.TYPE + 8192;
L_0265:;
// 2612 %cycle
L_0266:;
// 2613 get IDENT
GETIDENT();
// 2614 syntax error %if %not a assop
if (AASSOP()) goto L_0267;
SYNTAXERROR();
L_0267:;
// 2615 get LITERAL(d_type)
GETLITERAL(D.TYPE);
// 2616 faultnum = rangerr+point+warn %if faultnum = rangerr+point
if (FAULTNUM != 12 + 64) goto L_0268;
FAULTNUM = 12 + 64 + 128;
L_0268:;
// 2617 dict(dlim-1)_val = t_val
DICT[DLIM - 1 - 2001].VAL = T.VAL;
// 2618 %repeat %until %not a(comma)
if (!(A(59))) goto L_0269;
goto L_0266;
L_0269:;
// 2619 %else %if d_flags&static # 0 {own}
goto L_025D;
L_0263:;
if (D.FLAGS & 8 == 0) goto L_026A;
// 2620 ! constad == ownad; constbound = finalbound
// 2621 declmode = declmode+ownmode
DECLMODE = DECLMODE + 46;
// 2622 %cycle
L_026B:;
// 2623 ! constad = constad+1 %if constad&1 # 0 %and dsize # 1
// 2624 ! t_val = constad-ownbase
// 2625 get IDENT
GETIDENT();
// 2626 t_val = 0
T.VAL = 0;
// 2627 %if a assop %start
if (!(AASSOP())) goto L_026C;
// 2628 ! %if d_flags&direct = 0
// 2629 get LITERAL(d_type)
GETLITERAL(D.TYPE);
// 2630 faultnum = rangerr+point+warn %if faultnum = rangerr+point
if (FAULTNUM != 12 + 64) goto L_026D;
FAULTNUM = 12 + 64 + 128;
L_026D:;
// 2631 %finish
L_026C:;
// 2632 elements = 1
ELEMENTS = 1;
// 2633 ! plant const(t_val,1)
// 2634 %repeat %until %not a(comma)
if (!(A(59))) goto L_026E;
goto L_026B;
L_026E:;
// 2635 %else; !dynamic variable
goto L_025D;
L_026A:;
// 2636 ! declmode = declmode+dispmode+level
// 2637 %if d_flags&static = 0 %and c_flags >= hadon %start
if (D.FLAGS & 8 != 0) goto L_026F;
if (C.FLAGS < 16) goto L_026F;
// 2638 fault(ordererr); c_flags = c_flags&(\(hadon+hadinst))
FAULT(10);
C.FLAGS = C.FLAGS & ~(16 + 32);
// 2639 %finish
L_026F:;
// 2640 %cycle
L_0270:;
// 2641 !problematic c_delta = c_delta-1 %if c_delta&1 # 0 %and dsize # 1
// 2642 c_delta = c_delta-dsize
C.DELTA = C.DELTA - DSIZE;
// 2643 c_delta = c_delta-1 %if c_delta&1 # 0
if (C.DELTA & 1 == 0) goto L_0271;
C.DELTA = C.DELTA - 1;
L_0271:;
// 2644 t_val = c_sp+c_delta
T.VAL = C.SP + C.DELTA;
// 2645 get IDENT
GETIDENT();
// 2646 %if a assop %start
if (!(AASSOP())) goto L_0272;
// 2647 nonstandard(initass)
NONSTANDARD(64);
// 2648 %if d_type >= indirect %start
if (D.TYPE < 16384) goto L_0273;
// 2649 fault(caterr+point) %if atom # eqeq
if (ATOM == 76) goto L_0274;
FAULT(3 + 64);
L_0274:;
// 2650 get REFERENCE(d_type)
GETREFERENCE(D.TYPE);
// 2651 item = item+ad %if item # 0
if (ITEM == 0) goto L_0275;
ITEM = ITEM + 16384;
L_0275:;
// 2652 ! put3(assign,dlim-1+ad,item)
// 2653 %finish %else %start
goto L_0276;
L_0273:;
// 2654 fault(caterr+point) %if atom = eqeq
if (ATOM != 76) goto L_0277;
FAULT(3 + 64);
L_0277:;
// 2655 get VALUE(d_type)
GETVALUE(D.TYPE);
// 2656 ! put2(assign,dlim-1)
// 2657 %finish
L_0276:;
// 2658 ! compile(np0,np0)
// 2659 %finish
L_0272:;
// 2660 %repeat %until %not a(comma)
if (!(A(59))) goto L_0278;
goto L_0270;
L_0278:;
// 2661 %finish
L_025D:;
// 2662 -> term
goto U_1009;
// 2663
// 2664 %routine GET SWITCH DECLARATION
void GETSWITCHDECLARATION(void) {
// 2665 %integer i,j,dlim1
int I;
int J;
int DLIM1;
// 2666 matched = 1
MATCHED = 1;
// 2667 %cycle
L_0279:;
// 2668 d_flags = lab; d_type = nulltype
D.FLAGS = 2;
D.TYPE = 2041;
// 2669 declmode = pcmode+wordsize<<sizeshift
DECLMODE = 58 + (2 << 6);
// 2670 get IDENTLIST
GETIDENTLIST();
// 2671 dlim1 = dlim
DLIM1 = DLIM;
// 2672 get LITBOUNDS
GETLITBOUNDS();
// 2673 %cycle; !For each ident in group
L_027A:;
// 2674 %exit %if spc-elements <= 0; !ignore if too many
if (SPC - ELEMENTS > 0) goto L_027B;
goto L_027C;
L_027B:;
// 2675 %for i = 1,1,elements %cycle
// %for I = 1, 1, ELEMENTS %cycle
{
int _final = ELEMENTS;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, ELEMENTS");
I = 0;
L_027D:
if (I == _final) goto L_027E;
I += 1;
// 2676 spc = spc-1; final(spc) = 0
SPC = SPC - 1;
FINAL[SPC] = 0;
// 2677 %repeat
goto L_027D;
}
L_027E:;
// 2678 dict(dlim0)_val = spc
DICT[DLIM0 - 2001].VAL = SPC;
// 2679 dict(dlim0)_type = item
DICT[DLIM0 - 2001].TYPE = ITEM;
// 2680 dlim0 = dlim0+1
DLIM0 = DLIM0 + 1;
// 2681 %repeat %until dlim0 = dlim1
if (DLIM0 == DLIM1) goto L_027C;
goto L_027A;
L_027C:;
// 2682 %repeat %until %not a(comma)
if (!(A(59))) goto L_0280;
goto L_0279;
L_0280:;
// 2683 %end
return;
} /* end of GETSWITCHDECLARATION */
// ?J unused
// 2684 initial(keyswitch):
case_INITIAL_37:;
// 2685 get SWITCH DECLARATION
GETSWITCHDECLARATION();
// 2686 ->term
goto U_1009;
// 2687
// 2688 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 2689 !!!!!!!!!!!!!!! Control statements !!!!!!!!!!!!!!!!!!!!!!!!!!!
// 2690 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 2691 !
// 2692 initial(keycontrol):
case_INITIAL_42:;
// 2693 get LITINT
GETLITINT();
// 2694 control = 0 %if t_val = 0
if (T.VAL != 0) goto L_0281;
CONTROL = 0;
L_0281:;
// 2695 control = control!!t_val
CONTROL = CONTROL ^ T.VAL;
// 2696 ->term
goto U_1009;
// 2697
// 2698 initial(include):
case_INITIAL_45:;
// 2699 get LITSTRING
GETLITSTRING();
// 2700 extra_name = ""
/* clang-format off */
_imp_strncpy(/*?*/&EXTRA.NAME, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = _imp_str_literal(""); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 2701 %while t_val > 0 %cycle
L_0282:;
if (T.VAL <= 0) goto L_0283;
// 2702 extra_name = extra_name.tostring(byteinteger(atomp))
/* clang-format off */
_imp_strncpy(/*?*/&EXTRA.NAME, ({__typeof__(_imp_string255) tmp;/*B*/ tmp = *({_imp_string255 tmp = _imp_join((_imp_string *)/*?*/&EXTRA.NAME, ({__typeof__(_imp_string1) tmp; /*E*/ tmp = _imp_TOSTRING(*_imp_BYTEINTEGER(ATOMP)); (void *)&tmp;})); (_imp_string255 *)&tmp;}); (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 2703 atomp = atomp+1; t_val = t_val-1
ATOMP = ATOMP + 1;
T.VAL = T.VAL - 1;
// 2704 %repeat
goto L_0282;
L_0283:;
// 2705 get(terminator)
GET(52);
// 2706 %if faultnum = 0 %start
if (FAULTNUM != 0) goto L_0284;
// 2707 connect edfile(extra)
CONNECTEDFILE(/*?*/ &EXTRA);
// 2708 nonstop = -999 %and %signal 12 %if extra_flag # 0
if (EXTRA.FLAG == 0) goto L_0285;
NONSTOP = -999;
_imp_signal(12, 0, 0, "");
L_0285:;
// 2709 mainfp = fp; mainline = line
MAINFP = FP;
MAINLINE = LINE;
// 2710 line = 0; sym = nl
LINE = 0;
SYM = 10;
// 2711 fp = extra_start2; curstart = fp; curlim = extra_lim2
FP = EXTRA.START2;
CURSTART = FP;
CURLIM = EXTRA.LIM2;
// 2712 modesym = '&'; nonstop = nonstop+1
MODESYM = 38;
NONSTOP = NONSTOP + 1;
// 2713 %finish
L_0284:;
// 2714 ->next
goto U_100B;
// 2715
// 2716 initial(keylist):
case_INITIAL_41:;
// 2717 ->term
goto U_1009;
// 2718
// 2719 initial(begin):
case_INITIAL_5:;
// 2720 c_sp = -8
C.SP = -8;
// 2721 get(terminator)
GET(52);
// 2722 open block(0)
OPENBLOCK(0);
// 2723 get STATEMENTS(0)
GETSTATEMENTS(0);
// 2724 close block
CLOSEBLOCK();
// 2725 -> term %if stopper >= 0
if (STOPPER < 0) goto L_0286;
goto U_1009;
L_0286:;
// 2726 %return
return;
// 2727
// 2728 initial(end):
case_INITIAL_1:;
// 2729 %if %not a(of) %start
if (A(38)) goto L_0287;
// 2730 fault(nofinish) %if stopper = else %or stopper = finish
if (STOPPER == 4) goto L_0288;
if (STOPPER != 3) goto L_0289;
L_0288:;
FAULT(43);
L_0289:;
// 2731 fault(norepeat) %if stopper = repeat
if (STOPPER != 2) goto L_028A;
FAULT(44);
L_028A:;
// 2732 %return %if stopper >= 0
if (STOPPER < 0) goto L_028B;
return;
L_028B:;
// 2733 fault(nobegin)
FAULT(41);
// 2734 ->term
goto U_1009;
// 2735 %finish
L_0287:;
// 2736 %if a(keylist) %start
if (!(A(41))) goto L_028C;
// 2737 ->term
goto U_1009;
// 2738 %finish
L_028C:;
// 2739 %if a(keyfile) %start
if (!(A(39))) goto L_028D;
// 2740 %if curlim = extra_lim2 %start
if (CURLIM != EXTRA.LIM2) goto L_028E;
// 2741 switch input
SWITCHINPUT();
// 2742 ->next
goto U_100B;
// 2743 %finish
L_028E:;
// 2744 %finish %else get(program)
goto L_028F;
L_028D:;
GET(40);
L_028F:;
// 2745 %end; !GET STATEMENTS
return;
case_INITIAL_dispatch:
if (INITIAL_index < 0 || INITIAL_index > 107)
_imp_signalf(6, 3, INITIAL_index, "->INITIAL(%d) out of bounds at %s line %d", INITIAL_index, INITIAL_file,
INITIAL_line);
goto *INITIAL[INITIAL_index - 0];
case_INITIAL_missing:
_imp_signalf(8, 2, INITIAL_index, "switch jump to undefined label INITIAL(%d): at %s line %d", INITIAL_index,
INITIAL_file, INITIAL_line);
} /* end of GETSTATEMENTS */
// 2746
// 2747 %routine INIT(%integer t,l,h)
void INIT(int T, int L, int H) {
// 2748 d_flags = typeid; d_type = t; d_low = l; d_val = h
D.FLAGS = 256;
D.TYPE = T;
D.LOW = L;
D.VAL = H;
// 2749 dict(dlim) = d; dlim = dlim+1
DICT[DLIM - 2001] = D;
DLIM = DLIM + 1;
// 2750 %end
return;
} /* end of INIT */
// 2751
// 2752 %on %event 12 %start
if (!_imp_on_event(12)) goto L_0290;
// 2753 -> printout %if fp = main_lim2
if (FP != MAIN->LIM2) goto L_0291;
goto U_100F;
L_0291:;
// 2754 -> ended %if main_flag < 0 %or nonstop = -999; !abandon or CROAK
if (MAIN->FLAG < 0) goto L_0292;
if (NONSTOP != -999) goto L_0293;
L_0292:;
goto U_1010;
L_0293:;
// 2755 change = main_change
CHANGE = MAIN->CHANGE;
// 2756 %finish
L_0290:;
// 2757
// 2758 printstring(" IMP Checker "); newline
PRINTSTRING(_imp_str_literal(" IMP Checker "));
NEWLINE();
// 2759 hashindex(i) = 0 %for i = 0,1,255; !hash table empty
// %for I = 0, 1, 255 %cycle
{
I = -1;
L_0294:
if (I == 255) goto L_0295;
I += 1;
HASHINDEX[I] = 0;
goto L_0294;
}
L_0295:;
// 2760 charbase = addr(char(0)); byteinteger(charbase) = 0; !for anon ident
CHARBASE = _imp_ADDR(/*?*/ &CHAR[0]);
*_imp_BYTEINTEGER(CHARBASE) = 0;
// 2761 charlim = charbase+1
CHARLIM = CHARBASE + 1;
// 2762 charmin = charlim+charbound; !(1 over top)
CHARMIN = CHARLIM + 6000;
// 2763 dict(i)_val = 0 %for i = d0,1,labmax
// %for I = 2001, 1, 3254 %cycle
{
I = 2000;
L_0297:
if (I == 3254) goto L_0298;
I += 1;
DICT[I - 2001].VAL = 0;
goto L_0297;
}
L_0298:;
// 2764 d_flags = typeid; d_low = minint; d_val = maxint
D.FLAGS = 256;
D.LOW = -2147483648;
D.VAL = 2147483647;
// 2765 dmin = dictmax-1; dlim = dictmin
DMIN = 3233 - 1;
DLIM = 2041;
// 2766 %cycle
L_0299:;
// 2767 d_type = dlim; dict(dlim) = d
D.TYPE = DLIM;
DICT[DLIM - 2001] = D;
// 2768 dlim = dlim+1
DLIM = DLIM + 1;
// 2769 %repeat %until dlim > booltype
if (DLIM > 2048) goto L_029A;
goto L_0299;
L_029A:;
// 2770 d_flags = 0
D.FLAGS = 0;
// 2771 init(booltype,0,0)
INIT(2048, 0, 0);
// 2772 init(booltype,0,1)
INIT(2048, 0, 1);
// 2773 d_flags = typeid
D.FLAGS = 256;
// 2774 init(inty,minint,maxint)
INIT(2046, -2147483648, 2147483647);
// 2775 init(inty,-32768,32767)
INIT(2046, -32768, 32767);
// 2776 init(inty,0,65535)
INIT(2046, 0, 65535);
// 2777 init(inty,0,255)
INIT(2046, 0, 255);
// 2778 init(inty,-128,127)
INIT(2046, -128, 127);
// 2779 init(inty,0,1)
INIT(2046, 0, 1);
// 2780 init(inty,minint,maxint)
INIT(2046, -2147483648, 2147483647);
// 2781 init(realy,minint,maxint)
INIT(2045, -2147483648, 2147483647);
// 2782 init(realy,minint,maxint)
INIT(2045, -2147483648, 2147483647);
// 2783 c = 0; c_localdpos = dlim; c_parlim = dlim
C = (struct BLOCKINF){0};
C.LOCALDPOS = DLIM;
C.PARLIM = DLIM;
// 2784 level = outerlevel
LEVEL = 0;
// 2785 spc = finalbound
SPC = 8192;
// 2786 faults = 0; line = 0; mainline = 0
FAULTS = 0;
LINE = 0;
MAINLINE = 0;
// 2787 !
// 2788 mainfp = main_start1
MAINFP = MAIN->START1;
// 2789 extra_name = permfile
/* clang-format off */
_imp_strncpy(/*?*/&EXTRA.NAME, ({__typeof__(_imp_string13) tmp;/*B*/ tmp = PERMFILE; (void *)&tmp;}), /*max:*/255);
/* clang-format on */
// 2790 connect edfile(extra)
CONNECTEDFILE(/*?*/ &EXTRA);
// 2791 nonstop = -999 %and %signal 12 %if extra_flag # 0
if (EXTRA.FLAG == 0) goto L_029B;
NONSTOP = -999;
_imp_signal(12, 0, 0, "");
L_029B:;
// 2792 fp = extra_start2; curstart = fp; curlim = extra_lim2
FP = EXTRA.START2;
CURSTART = FP;
CURLIM = EXTRA.LIM2;
// 2793 nonstop = -2; nonstop = -1 %if main_flag = 'I'
NONSTOP = -2;
if (MAIN->FLAG != 73) goto L_029C;
NONSTOP = -1;
L_029C:;
// 2794 sym = nl
SYM = 10;
// 2795 get STATEMENTS(-1)
GETSTATEMENTS(-1);
// 2796 ! report(noend,0) %if level < mainlevel
// 2797 ! report(nobegin,0) %if level > mainlevel
// 2798 ! compile end %while level >= mainlevel
// 2799 printout:
U_100F:;
// 2800 ! time2 = cputime
// 2801 %if faults = 0 %start
if (FAULTS != 0) goto L_029D;
// 2802 write(statements,1)
WRITE(STATEMENTS, 1);
// 2803 print string(" statements checked ")
PRINTSTRING(_imp_str_literal(" statements checked "));
// 2804 %finish %else %start
goto L_029E;
L_029D:;
// 2805 write(faults,1)
WRITE(FAULTS, 1);
// 2806 print string(" fault")
PRINTSTRING(_imp_str_literal(" fault"));
// 2807 put sym('s') %if faults > 1
if (FAULTS <= 1) goto L_029F;
PUTSYM(115);
L_029F:;
// 2808 print string(" reported ")
PRINTSTRING(_imp_str_literal(" reported "));
// 2809 %finish
L_029E:;
// 2810 newline
NEWLINE();
// 2811 ended:
U_1010:;
// 2812 newline; !*for now to ensure message not erased*
NEWLINE();
// 2813 ! %if control&logbit # 0 %start
// 2814 !! write(zaps,1); print symbol('Z')
// 2815 ! write(statements,1); print symbol('S')
// 2816 ! statements = 1 %if statements = 0
// 2817 ! atoms = atoms+statements
// 2818 ! print(atoms/statements,1,1); print symbol('A')
// 2819 ! print(numatoms/statements,1,1); print symbol('N')
// 2820 ! print(identatoms/statements,1,1); print symbol('I')
// 2821 ! print(misses/identatoms,1,2); print symbol('H')
// 2822 ! print((time2-time1)/statements,3,3); print symbol('M')
// 2823 !! write(finalad,1); print symbol('B')
// 2824 !! write(ownad-ownbase,1); print symbol('O')
// 2825 ! newline
// 2826 ! %finish
// 2827
// 2828 %end;
return;
} /* end of ECCECI */
// ?LISTMATCH unused
// ?LEFTBRACKET unused
// ?TEMPVAR unused
// ?PUT2 unused
// ?PUT3 unused
// ?COMPILE unused
// ?SETLABEL unused
// ?IBMHEX unused
// ?HYPHEN unused
// ?OVERLOAD unused
// ?LISTOUT unused
// ?CHARS unused
// ?PROLINE unused
// ?DIAGLINE unused
// ?CASEMASK unused
// ?OWNAD unused
// ?FINALAD unused
// ?DYNARRAY unused
// ?NONLOCALREF unused
// ?WRONGCC unused
// ?IREADENTRY unused
// ?INDEXENTRY unused
// ?AGETENTRY unused
// ?BOUNDENTRY unused
// ?SCOMPENTRY unused
// ?SIGENTRY unused
// ?DNEWLINE unused
// ?DREAD unused
// ?DPRINTSTR unused
// ?DOUBLE unused
// ?CS unused
// ?CC unused
// ?GE unused
// ?LT unused
// ?LE unused
// ?GT unused
// ?NE unused
// ?EQ unused
// ?ACTMAX unused
// ?ADECL unused
// ?LABEL unused
// ?JUMP unused
// ?COMPARE unused
// ?PLUSASS unused
// ?JAMASSIGN unused
// ?ASSIGN unused
// ?SWGOTO unused
// ?FCALL unused
// ?FMOD unused
// ?IMOD unused
// ?FLOAT unused
// ?RIGHTBRACKET unused
// ?COMMENT unused
// ?WFLAG unused
// ?RFLAG unused
// ?OKFLAG unused
// ?LITMODE unused
// ?INDEXMODE unused
// ?PREMODE unused
// ?POSTMODE unused
// ?INDMODE unused
// ?AMODE unused
// ?DMODE unused
// ?BYTESIZE unused
// ?LITSTORE unused
// ?SLITPOS unused
// ?DICTSHOWN unused
// ?ANYNAME unused
// ?ANYINTVAR unused
// ?FALSECONST unused
// ?FREE unused
// ?A2B unused
// ?A1B unused
// ?A0B unused
// ?D2B unused
// ?D1B unused
// ?D0B unused
// ?MAXAREG unused
// ?MAXDREG unused
// ?UNDEF unused
// ?PREA7 unused
// ?POSTA7 unused
// ?A7 unused
// ?A6 unused
// ?A1 unused
// ?D7 unused
// ?D6 unused
// ?D2 unused
// ?D1 unused
// ?SMALLMIN unused
// ?EXTRANAME unused
// 2829 ; !of ECCECI