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