#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 %begin
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
// 2
// 3 !!%external%string(255)%fn%spec cliparam
// 4 !!%external%integer%fn%spec cputime
// 5
// 6 !!%external%routine%spec open output(%integer stream, %string (255) s)
// 7
// 8 %const %integer TRUE = 1, FALSE = 0
// 9
// 10 %string(255)cliparam; cliparam = "adec"
_imp_string255 CLIPARAM;
_imp_strncpy(/*?*/ &CLIPARAM, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("adec");
(void *)&tmp;
}),
/*max:*/ 255);
// 11
// 12 !$IF ECSVAX
// 13 {%conststring(51) title = %c
// 14 {" EUCSD IMP Compiler for M68000. VAX Version 2.2g"
// 15 !$IF APM
// 16 %conststring(51) title = %c
const _imp_string51 TITLE = _imp_str_init(" EUCSD IMP Compiler for M68000. APM Version 2.2g");
// 17+ " EUCSD IMP Compiler for M68000. APM Version 2.2g"
// 18 !$FINISH
// 19 !
// 20 ! Hamish Dewar Computer Science Edinburgh University 1982/83/84
// 21 !
// 22 %constinteger WHICH=M'.imp'
// 23
// 24 !<<BOTH [markers for parts common to Pascal]
// 25
// 26 !General notes:
// 27 ! The main data structure DICT is used for identifier, type, label
// 28 ! and expression representation (with some aliasing). The fixedsize
// 29 ! cell has a number of advantages which outweigh the Procustean factor
// 30 ! (and the 16-byte size is efficiently addressed)
// 31 !
// 32 ! Major routines (like EVAL) which have variables heavily used by
// 33 ! nested routines are not placed below level 1 for efficiency of
// 34 ! addressing. (Making the compiler an external procedure rather
// 35 ! than a main program would seriously impact this efficiency).
// 36 !
// 37 !!!!!!!!!!!!!!!!!! File handling definitions !!!!!!!!!!!!!!!!!!!!!
// 38 !
// 39 %constinteger MAXNAME=127
// 40 %string(maxname) MAINFILE,OBJFILE
_imp_string127 MAINFILE;
_imp_string127 OBJFILE;
// 41
// 42 ! Editor-compatible file-mapping record:
// 43 %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;
unsigned char TOP;
unsigned char WIN;
unsigned char BOT;
unsigned char MIN;
unsigned char ROW;
unsigned char COL;
_imp_string127 NAME;
};
};
};
// 44+ start2,lim2, {part 2}
// 45+ lim, {VMLIM}
// 46+ lbeg,fp,change,flag,
// 47+ line {line number of current pos},
// 48+ diff {diff between LINE and ROW},
// 49+ %byte top {top row of sub_window},
// 50+ win {floating top},
// 51+ bot {bottom row of sub_window},
// 52+ min {minimum window size},
// 53+ row {last row position},
// 54+ col {last col position},
// 55+ %string(maxname) name)
// 56 !
// 57 !!%external%routine%spec EDI(%record(edfile)%name main,sec,
// 58 !! %string(255) message)
// 59 {PAM: parameter acquisition module}
// 60 %constinteger NEWGROUP=1, NODEFAULT=2
// 61 !!%external%routine%spec DEFINE PARAM %alias "PAM_DEFSTRING" %c
// 62 !! (%string(255) name, %name variable, %integer flags)
// 63 !!%external%routine%spec DEFINE INT PARAM %alias "PAM_DEFINT" %c
// 64 !! (%string(255) name, %name variable, %integer flags)
// 65 !!%external%routine%spec DEFINE BOOLEAN PARAMS %alias "PAM_DEFBOOL" %c
// 66 !! (%string(255) name, %name variable, %integer flags)
// 67 !!%external%routine%spec PROCESS PARAMETERS %alias "PAM_PROCESS"(%string(255)!! parm)
// 68 !!%external%routine%spec CONNECT EDFILE(%record(edfile)%name f)
// 69 !!%external%routine%spec DISCONNECT EDFILE(%record(edfile)%name f)
// 70 !!%external%string(8)%fnspec DATE
// 71 !!%external%string(5)%fnspec TIME
// 72
// 73 %string(8) DATE; DATE = "02/02/02"
_imp_string8 DATE;
_imp_strncpy(/*?*/ &DATE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("02/02/02");
(void *)&tmp;
}),
/*max:*/ 8);
// 74 %string(5) TIME; TIME = "02:02"
_imp_string5 TIME;
_imp_strncpy(/*?*/ &TIME, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("02:02");
(void *)&tmp;
}),
/*max:*/ 5);
// 75 %integer CPUTIME; CPUTIME = 123
int CPUTIME;
CPUTIME = 123;
// 76 !
// 77 %owninteger ITEM=0; ![high-frequency]
static int ITEM = 0;
// 78 %owninteger LISTOUT=0 {set to 2 if listing to file}
static int LISTOUT = 0;
// 79 !! Compiler control
// 80
// 81 %constinteger ARRBIT= 16_80000000 {array bound check}
// 82 %constinteger LOOPBIT= 16_40000000 {%for loop check}
// 83 %constinteger CAPBIT= 16_20000000 {capacity check}
// 84 %constinteger OVERBIT= 16_10000000 {overflow check}
// 85 %constinteger ASSBIT= 16_08000000 {integer-unassigned check}
// 86 %constinteger STRASSBIT=16_04000000 {string-unassigned check}
// 87 %constinteger SASSBIT= 16_02000000 {short-unassigned check}
// 88 %constinteger BASSBIT= 16_01000000 {byte-unassigned check}
// 89 %constinteger ASSMASK=assbit!strassbit!sassbit!bassbit
// 90 %constinteger LINEBIT= 16_00800000 {set line number}
// 91 %constinteger DIAGBIT= 16_00400000
// 92 %constinteger TRACEBIT= 16_00200000 {plant TRAP 15}
// 93 %constinteger STACKBIT= 16_00100000 {stack over-run check}
// 94 %constinteger CHECKBIT= 16_00080000 {for NOCHECK}
// 95 %constinteger SYSBIT= 16_00040000 {special treatment of SIGNAL}
// 96 %constinteger STRICTBIT=16_00020000
// 97 %constinteger VOLBIT =16_00010000
// 98 %constinteger HALFBIT= 16_00008000 {halfword MULT/DIV}
// 99 %constinteger LOWBIT = 16_00004000 {low-level features permitted}
// 100 %constinteger EDITBIT= 16_00002000
// 101 %constinteger RUNBIT= 16_00001000
// 102 %constinteger FORCEBIT= 16_00000800
// 103 %constinteger LOGBIT= 16_00000400 {print log}
// 104 %constinteger WARNBIT= 16_00000200 {print warnings}
// 105 %constinteger NONSBIT= 16_00000100 {nonstandard features permitted}
// 106 %constinteger PERMBIT= 16_00000080 {for PRIM compilation}
// 107 %constinteger NEWBIT= 16_00000040 {Pascal: new treatment of pointers}
// 108 %constinteger CODELIST= 16_00000020 {list code}
// 109 %constinteger DICTLIST= 16_00000010 {list dict entries}
// 110 %constinteger EXPLIST= 16_00000008 {list EXP entries}
// 111 %constinteger MAPLIST= 16_00000004 {print space map}
// 112 %constinteger TTLIST= 16_00000002 {list to terminal}
// 113 %constinteger LIST= 16_00000001 {do list}
// 114
// 115
// 116 %constinteger LISTBITS=codelist+dictlist+explist+maplist+ttlist+list
// 117 %owninteger CONTROL=warnbit+checkbit+linebit+diagbit+editbit+volbit %c
static int CONTROL = -321314304;
// 118+ +strassbit+assbit+arrbit+loopbit+capbit+stackbit
// 119 %integer INITCON,TIME1,TIME2
int INITCON;
int TIME1;
int TIME2;
// 120 !Events:-
// 121 %constinteger OFLOW=1, FAIL=11, DONE=12, REDO=13, ABANDON=14
// 122 !
// 123 !
// 124 %constinteger MAXINT=16_7FFFFFFF, MININT=\MAXINT
// 125 %constinteger SIGN16=\16_7FFF, SIGN=\16_7FFFFFFF
// 126 !
// 127 !!!!!!!!!!!!!!!! Operand Representation !!!!!!!!!!!!!!!!!!!
// 128 ! Operands (largely, Expressions) are denoted by integers in a
// 129 ! contiguous range as follows:
// 130 !
// 131 ! <= 0 Literals (including 'addresses' within FINAL)
// 132 ! [see LITREF and LITVAL for interpretation]
// 133 ! Dictionary
// 134 ! __16___16____16____8____8____32____16___16__
// 135 ! [dummy @ 0] -> |flags|type| link| reg|mode|value|text|hlink|
// 136 ! D0 [@1] -> R | | | size| | | | | |
// 137 ! | | |xtype| | | | | |
// 138 ! D7 -> | | | | | | | | |
// 139 ! A0 -> E | | | | | | | | |
// 140 ! | | | | | | | | |
// 141 ! A7 -> G | | | | | | | | |
// 142 ! INDA0 -> | | | | | | | | |
// 143 ! S | | | | | | | | |
// 144 ! PREA7 -> | | | | | | | | |
// 145 ! I | | | | | | | | |
// 146 ! D | | | | | | | | |
// 147 ! E | | | | | | | | |
// 148 ! N | | | | | | | | |
// 149 ! T | | | | | | | | |
// 150 ! S | | | | | | | | |
// 151 ! |_____|____|_____|____|____|_____|____|____|
// 152 ! DICTLIM -> | -- |-- | -- | -- |mode|value| -- | -- |
// 153 ! C L | | | | | | | | |
// 154 ! O A | | | | | | | | |
// 155 ! M B | | | | | | | | |
// 156 ! P S | | | | | | | | |
// 157 ! |_____|____|_____|____|____|_____|____|____|
// 158 ! LABLIM -> |flags|type| act |----|mode|value|arg1|arg2|
// 159 ! C | | | | | | | | |
// 160 ! O | | | | | | | | |
// 161 ! M E | | | | | | | | |
// 162 ! P X | | | | | | | | |
// 163 ! L P | | | | | | | | |
// 164 ! E S | | | | | | | | |
// 165 ! X |_____|____|_____|____|____|_____|____|____|
// 166 ! EXPLIM ->
// 167
// 168 %constinteger SMALLMIN=-1024, SMALLMAX=1023,
// 169+ LITMAX=smallmin-(smallmax+1), LITMIN=litmax-199,
// 170+ LITMITE=-255, LITQUICK=-16, ONE=-(1<<1)
// 171 %constinteger D0=1, D1=d0+1, D2=d0+2, D7=d0+7,
// 172+ A0=d0+8, A1=a0+1, A6=a0+6, A7=a0+7,
// 173+ INDA0=a0+8, INDA7=inda0+7,
// 174+ POSTA0=inda0+8, POSTA7=posta0+7,
// 175+ PREA0=posta0+8, PREA7=prea0+7,
// 176+ UNDEF=a7
// 177 %owninteger DICTLIM=1000, FINALBOUND=64 {see Init for adjustment}
static int DICTLIM = 1000;
static int FINALBOUND = 64;
// 178 %integer LABLIM,NP0,EXPLIM {continuing from DICTLIM}
int LABLIM;
int NP0;
int EXPLIM;
// 179 %integer CHARBOUND {derived from DICTLIM}
int CHARBOUND;
// 180 %constinteger LABELS=42 {enough for Pascal reserveds},
// 181+ TRIPLES=200
// 182 %constinteger AD=16384 {any item + AD >= EXPLIM}
// 183
// 184 %constinteger BREG=D0+4, LINELOC=d0+5
// 185 %constinteger F1=a0+6, GB=a0+5, MB=a0+4; !level 1, global base, main base
// 186 %constinteger MAXDREG=d0+3, MAXAREG=a0+3
// 187 %constinteger D0B=1, D1B=2, D2B=4, BREGB=16,
// 188+ A0B=16_100, A1B=16_200, A2B=16_400
// 189 %constinteger ANYDREG=16_00FF-bregb, ANYAREG=16_FF00,
// 190+ ANYREG=16_FFFF
// 191 %constinteger DEFAULTFREE=2<<(maxdreg-d0)-1+(2<<(maxareg-a0)-1)<<8+bregb
// 192 %integer MAXCALLDREG, MAXCALLAREG
int MAXCALLDREG;
int MAXCALLAREG;
// 193 %integer FREE
int FREE;
// 194
// 195 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 196 !!!!!!!!!!!!!!!!!!!!!!! Big Literals !!!!!!!!!!!!!!!!!!!!!!!
// 197 %integer LITPOS
int LITPOS;
// 198 %integerarray LITSTORE(litmin:litmax)
int LITSTORE[200];
// 199 !
// 200 !!!!!!!!! Registers, Identifiers, Labels, Expressions !!!!!!!!!
// 201 !
// 202 ! Operand attributes:
// 203 %recordformat OBJINFO %C
struct OBJINFO {
union {
struct {
short int FLAGS;
short int TYPE;
union {
struct {
short int LINK;
};
struct {
short int XTYPE;
};
struct {
short int SIZE;
};
struct {
short int ACT;
};
};
unsigned char REG;
unsigned char MODE;
int VAL;
};
};
};
// 204+ (%short FLAGS,TYPE,
// 205+ (%short LINK %or %short XTYPE %or %short SIZE %or %short ACT),
// 206+ %byte REG,MODE,
// 207+ %integer VAL)
// 208 %recordformat IDENTINFO %C
struct IDENTINFO {
union {
struct {
union {
struct {
short int FLAGS;
short int TYPE;
union {
struct {
short int LINK;
};
struct {
short int XTYPE;
};
struct {
short int SIZE;
};
struct {
short int ACT;
};
};
unsigned char REG;
unsigned char MODE;
int VAL;
};
struct {
struct OBJINFO DETAILS;
};
};
union {
struct {
short int TEXT;
short int HLINK;
};
struct {
short int X;
short int Y;
};
};
};
};
};
// 209+ ((%short FLAGS,TYPE,
// 210+ (%short LINK %or %short XTYPE %or %short SIZE %or %short ACT),
// 211+ %byte REG,MODE,
// 212+ %integer VAL %or %record(objinfo) DETAILS),
// 213+ (%short TEXT,HLINK %or %short X,Y))
// 214 !
// 215 !Machine addressing modes:
// 216 %constinteger AREGMODE=2_001000,
// 217+ DISPMODE=2_101000, INDEXMODE=2_110000, ABSMODE=2_111000,
// 218+ PCMODE=2_111010, LITMODE=2_111100
// 219 !Conversion factors for address register modes (from AREGMODE)
// 220 %constinteger INDIR=8, POST=16, PRE=24
// 221 !Additional source-related modes:
// 222 %constinteger LABMODE=2_10000000+pcmode,
// 223+ PROCMODE=2_11000000+pcmode,
// 224+ GLOBALMODE=dispmode+(gb-a0),
// 225+ OWNMODE=2_01000000+dispmode+(mb-a0),
// 226+ CONSTMODE=2_01000000+pcmode,
// 227+ FRAMEMODE=2_10000000+dispmode
// 228 ! + 01000000 for dynamic array
// 229 !
// 230 ! MODE,VAL:
// 231 ! %const simple : LITMODE the actual value
// 232 ! %const structure : CONSTMODE address in code area
// 233 ! variable etc : mode byte address/displacement
// 234 ! undefined label : LABMODE reference chain
// 235 ! undefined procedure : PROCMODE reference chain
// 236 ! record format : 0 size of record in bytes
// 237 !
// 238 ! Significance of FLAGS:
// 239 %constinteger CAT =16_000F, {category: typeid only}
// 240+ WRITABLE=16_0001,
// 241+ READABLE=16_0002, {not write only}
// 242+ VOLATILE=16_0004,
// 243+ ARRFLAG =16_0008, {bound check needed}
// 244+ ALT =16_0008, {alternative proc}
// 245+ WFLAG =16_0010, {has been written to}
// 246+ RFLAG =16_0020, {has been read from}
// 247+ OKFLAG =16_0040, {no unassigned check needed, CC OK for fun}
// 248+ NORET =16_0040, {routine does not return}
// 249+ MFLAG =16_0080, {has had mem access}
// 250+ SPEC =16_0100, {unbodied spec or forward label}
// 251+ TYPEID =16_0200, {type identifier}
// 252+ PACKED =16_0400,
// 253+ INDIRECT=16_0800,
// 254+ PROC =16_3000, {procedure not data}
// 255+ PROC1 =16_1000,
// 256+ PROC2 =16_2000,
// 257+ EXT =16_4000, {external}
// 258+ NAME =sign16
// 259 %constinteger HERITABLE=writable+readable+volatile %c
// 260+ +wflag+rflag+okflag+arrflag
// 261 !
// 262 !CATegories (type identifiers only):
// 263 %constinteger INTY=0, CHARY=1, BOOLY=2, ENUMY=3,
// 264+ POINTY=4, REALY=5,
// 265+ STRINGY=8, ARRY=9, SETY=10,
// 266+ RECY=12, FILEY=13,
// 267+ NONORD=12
// 268
// 269 %ownrecord(objinfo) DEFINEDLABEL=0,
static struct OBJINFO DEFINEDLABEL = {0};
static struct OBJINFO FORWARDLABEL = {0};
static struct OBJINFO BEGINBLOCK = {0};
static struct OBJINFO TYPEIDENT = {0};
// 270+ FORWARDLABEL=0,
// 271+ BEGINBLOCK=0,
// 272+ TYPEIDENT=0
// 273 !!!!!!!!!!!!!!!!! File and control initialisation !!!!!!!!!!!!!!!
// 274 !
// 275 %constinteger MAIN=1
// 276 %record(edfile)%array FILE(1:3)
struct EDFILE FILE[3];
// 277 %record(edfile)%name CUR
struct EDFILE *CUR;
// 278 %integerarray FCONTROL(1:3)
int FCONTROL[3];
// 279 %integer CURFILE,LASTFILE; !current source file no (0:3)
int CURFILE;
int LASTFILE;
// 280 %integer CURSTART,CURLIM; !current source file bounds
int CURSTART;
int CURLIM;
// 281
// 282 %routine SET OPTIONS(%string(255) parm)
void SETOPTIONS(_imp_string255 PARM) {
// 283 %owninteger remove warning
static int REMOVEWARNING;
// 284 %constinteger CHECKS=assmask+arrbit+loopbit+capbit+overbit
// 285 !! define boolean params( %c
// 286 !! "ARR,LOOP,CAP,OVER,ASS,STRASS,SASS,BASS,LINE,DIAG,TRACE,STACK,".%C
// 287 !! "CHECK,SYS,STRICT,VOL,HALF,LOW,EDIT,RUN,FORCE,LOG,WARN,NONS,PERM,NEW,".%C
// 288 !! "CODE,DICT,EXP,MAP,TT,LIST",control,0)
// 289 !! process parameters(parm)
// 290 remove warning = ADDR(parm)
REMOVEWARNING = _imp_ADDR(/*?*/ &PARM);
// 291 !NOCHECK => removal of checkbits
// 292 control = control&(\checks) %if control&checkbit = 0
if (CONTROL & 524288 != 0) goto L_0001;
CONTROL = CONTROL & (~-16777216);
L_0001:;
// 293 control = control&(\editbit) %if control&listbits # 0
if (CONTROL & 63 == 0) goto L_0002;
CONTROL = CONTROL & (~8192);
L_0002:;
// 294 %end
return;
} /* end of SETOPTIONS */
// 295
// 296 %routine SET EXTENSION(%string(maxname)%name f,%string(4) ext)
void SETEXTENSION(_imp_string127 * F, _imp_string4 EXT) {
// 297 %integer strip
int STRIP;
// 298 %integer%fn last4(%string(*)%name s)
int LAST4(_imp_string * S) {
// 299 %integer i,e
int I;
int E;
// 300 i = 0; e = 0
I = 0;
E = 0;
// 301 %while i < length(s) %cycle
L_0003:;
if (I >= *_imp_LENGTH((_imp_string255 *)/*p*/ S)) goto L_0004;
// 302 i = i+1; e = e<<8+charno(s,i)
I = I + 1;
E = (E << 8) + *_imp_CHARNO((_imp_string255 *)/*p*/ S, I);
// 303 %repeat
goto L_0003;
L_0004:;
// 304 %result = e
return E;
// 305 %end
} /* end of LAST4 */
// 306 strip = last4(ext)
STRIP = LAST4((_imp_string255 *)/*p*/ /*?*/ &EXT);
// 307 f = mainfile %and strip = which %if f = ""
if (_imp_strcmp((_imp_string *)F, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) != 0) goto L_0005;
*F = MAINFILE;
STRIP = 778661232;
L_0005:;
// 308 length(f) = length(f)-4 %if last4(f)!16_202020 = strip
if (LAST4((_imp_string255 *)/*p*/ F) | 2105376 != STRIP) goto L_0006;
*_imp_LENGTH((_imp_string255 *)/*p*/ F) = *_imp_LENGTH((_imp_string255 *)/*p*/ F) - 4;
L_0006:;
// 309 f = f.ext
*F = *
*({
_imp_string255 tmp = _imp_join(({
__typeof__(_imp_string127) tmp; /*D*/
tmp = *F;
(void *)&tmp;
}),
(_imp_string *)/*?*/ &EXT);
(_imp_string255 *)&tmp;
})
;
// 310 %end
return;
} /* end of SETEXTENSION */
// 311
// 312
// 313 %routine OPEN FILES
void OPENFILES(void) {
// 314 %string(maxname) LISTFILE; LISTFILE=""
_imp_string127 LISTFILE;
_imp_strncpy(/*?*/ &LISTFILE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 127);
// 315 objfile = ""
_imp_strncpy(/*?*/ &OBJFILE, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 127);
// 316 !! define param("SOURCE",mainfile,nodefault)
// 317 !! define param("OFILE",objfile,newgroup)
// 318 !! define param("LFILE",listfile,0)
// 319 !! define int param("IDents",dictlim,newgroup)
// 320 !! define int param("KBytes",finalbound,0)
// 321 file(main) = 0
FILE[0] = (struct EDFILE){0};
// 322 set options(cliparam)
SETOPTIONS(
*({
__typeof__(_imp_string255) tmp = CLIPARAM /*q*/;
(_imp_string255 *)&tmp;
})
);
// 323 control = control&(\linebit) %if control&diagbit = 0; !*temp*
if (CONTROL & 4194304 != 0) goto L_0007;
CONTROL = CONTROL & (~8388608);
L_0007:;
// 324 !Main file
// 325 file(main)_name = mainfile; file(main)_flag = 32768
_imp_strncpy(/*?*/ &FILE[0].NAME, ({
__typeof__(_imp_string127) tmp; /*B*/
tmp = MAINFILE;
(void *)&tmp;
}),
/*max:*/ 255);
FILE[0].FLAG = 32768;
// 326 time1 = time1-cputime
TIME1 = TIME1 - CPUTIME;
// 327 !! connect edfile(file(main))
// 328 time1 = time1+cputime
TIME1 = TIME1 + CPUTIME;
// 329 %stop %if file(main)_flag # 0
if (FILE[0].FLAG == 0) goto L_0008;
_imp_stop(0);
L_0008:;
// 330
// 331 !Listing file
// 332 %if listfile # "" %or control&(list+ttlist) # 0 %start
if (_imp_strcmp((_imp_string *)/*?*/ &LISTFILE, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) != 0) goto L_0009;
if (CONTROL & 1 + 2 == 0) goto L_000A;
L_0009:;
// 333 %if control&ttlist = 0 %start
if (CONTROL & 2 != 0) goto L_000B;
// 334 set extension(listfile,".lis")
SETEXTENSION((_imp_string127 *)/*p*/ /*?*/ &LISTFILE, _imp_str_literal_size(4, ".lis"));
// 335 listout = 2
LISTOUT = 2;
// 336 open output(listout,listfile)
_imp_OPENOUTPUT(LISTOUT,
*({
__typeof__(_imp_string127) tmp = LISTFILE /*q*/;
(_imp_string255 *)&tmp;
})
);
// 337 %finish
L_000B:;
// 338 control = control&(\(editbit+ttlist))
CONTROL = CONTROL & ~(8192 + 2);
// 339 control = control!list %if control&listbits = 0
if (CONTROL & 63 != 0) goto L_000C;
CONTROL = CONTROL | 1;
L_000C:;
// 340 %finish
L_000A:;
// 341 select output(listout)
_imp_SELECTOUTPUT(LISTOUT);
// 342 %if control&listbits # 0 %start
if (CONTROL & 63 == 0) goto L_000D;
// 343 control = control!list %if control&listbits # maplist
if (CONTROL & 63 == 4) goto L_000E;
CONTROL = CONTROL | 1;
L_000E:;
// 344 newlines(2)
_imp_NEWLINES(2);
// 345 printstring(title)
_imp_PRINTSTRING(
*({
__typeof__(_imp_string51) tmp = TITLE /*q*/;
(_imp_string255 *)&tmp;
})
);
// 346 newlines(2)
_imp_NEWLINES(2);
// 347 printstring(" "); printstring(file(main)_name)
_imp_PRINTSTRING(_imp_str_literal(" "));
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = FILE[0].NAME /*q*/;
(_imp_string255 *)&tmp;
})
);
// 348 printstring(" compiled on "); printstring(date)
_imp_PRINTSTRING(_imp_str_literal(" compiled on "));
_imp_PRINTSTRING(
*({
__typeof__(_imp_string8) tmp = DATE /*q*/;
(_imp_string255 *)&tmp;
})
);
// 349 printstring(" at "); printstring(time)
_imp_PRINTSTRING(_imp_str_literal(" at "));
_imp_PRINTSTRING(
*({
__typeof__(_imp_string5) tmp = TIME /*q*/;
(_imp_string255 *)&tmp;
})
);
// 350 newlines(2)
_imp_NEWLINES(2);
// 351 %finish
L_000D:;
// 352 initcon = control
INITCON = CONTROL;
// 353 %end
return;
} /* end of OPENFILES */
// 354
// 355 time1 = 0
TIME1 = 0;
// 356 open files
OPENFILES();
// 357 dictlim = dictlim+300; !allow for presets
DICTLIM = DICTLIM + 300;
// 358 charbound = dictlim*8
CHARBOUND = DICTLIM * 8;
// 359 finalbound = finalbound<<10+4095; !kilobytes -> bytes + (min) owns
FINALBOUND = (FINALBOUND << 10) + 4095;
// 360 lablim = dictlim+labels
LABLIM = DICTLIM + 42;
// 361 explim = lablim+triples
EXPLIM = LABLIM + 200;
// 362 np0 = lablim+4
NP0 = LABLIM + 4;
// 363 file(main)_change = 16_7FFFFFFF
FILE[0].CHANGE = 2147483647;
// 364 forwardlabel_flags = spec; forwardlabel_mode = labmode
FORWARDLABEL.FLAGS = 256;
FORWARDLABEL.MODE = 186;
// 365 definedlabel_mode = labmode
DEFINEDLABEL.MODE = 186;
// 366 beginblock_mode = procmode
BEGINBLOCK.MODE = 250;
// 367 typeident_flags = typeid+recy
TYPEIDENT.FLAGS = 512 + 12;
// 368 !
// 369 !!!!!!!!!!!!!!!! end of file and control initialisation !!!!!!!!
// 370 !
// 371 %record(identinfo)%array DICT(0:explim-1)
struct IDENTINFO DICT[EXPLIM - 1 + 1];
// 372 ! indexing DICT:
// 373 %integer DLIM; !dict limit (up)
int DLIM;
// 374 %integer DLIM0
int DLIM0;
// 375 %integer DMIN; !dict upper limit (down)
int DMIN;
// 376 %integer DMIN0
int DMIN0;
// 377 %integer DICTSHOWN
int DICTSHOWN;
// 378 %integer INCLIM
int INCLIM;
// 379 %record(identinfo)%name DLINK,DFORMAT,DTEMP,DTEMP2,DTSPREL,DINT
struct IDENTINFO *DLINK;
struct IDENTINFO *DFORMAT;
struct IDENTINFO *DTEMP;
struct IDENTINFO *DTEMP2;
struct IDENTINFO *DTSPREL;
struct IDENTINFO *DINT;
// 380 %integer SUBBED
int SUBBED;
// 381 %integer RANGES
int RANGES;
// 382
// 383 ! The identifier dictionary grows as declarations are
// 384 ! encountered, sequentially from 0 up, so that the
// 385 ! identifiers within a declaration group and within any block
// 386 ! are contiguous and may be processed thus (eg at block end).
// 387 ! However, searching is always through the hash links, with a
// 388 ! start-point given by the array HASHINDEX. The final link
// 389 ! value is zero.
// 390 ! Identifiers are normally added at the start of the hash list
// 391 ! (hence pushing down any global instance of the same name),
// 392 ! but identifiers which have been reported as 'not declared'
// 393 ! are added at the end of the list, using a negative link value.
// 394 ! This tail section is used to avoid repeated reports for the
// 395 ! same name (and is ultra-global, ie never removed).
// 396 !
// 397 ! For record formats, the format name is stored in the usual way
// 398 ! and contains in LINK a pointer to the field-names which are linked
// 399 ! through what is normally the hash link. Searching for field-names
// 400 ! proceeds along this chain, as if following hash links.
// 401 !
// 402 ! HLINK is the hash link (index to DICT)
// 403 !
// 404 ! TEXT is the pointer (index to CHAR) to the text of the identifier
// 405 ! stored as a standard string
// 406
// 407 ! Text of identifiers (indexed by _TEXT):
// 408 %bytearray CHAR(0:charbound)
unsigned char CHAR[CHARBOUND + 1];
// 409 %integer CHAR0,CHARLIM,CHARMIN; !pointers
int CHAR0;
int CHARLIM;
int CHARMIN;
// 410 %integer NEWLEN
int NEWLEN;
// 411
// 412 ! Hash index to DICT:
// 413 %shortarray HASHINDEX(0:255)
short int HASHINDEX[256];
// 414 %shortname HEAD; !head of ident search list
short int *HEAD;
// 415 !
// 416 !
// 417 !<<IMP
// 418
// 419 !* PRIMGEN marker 1
// 420 %constinteger NULL=41
// 421 %constinteger PROCSTAR=42
// 422 %constinteger INTTYPE=43
// 423 %constinteger SHORTTYPE=46
// 424 %constinteger HALFTYPE=49
// 425 %constinteger BYTETYPE=52
// 426 %constinteger MITETYPE=55
// 427 %constinteger BOOLTYPE=58
// 428 %constinteger CHARTYPE=61
// 429 %constinteger STRINGSTAR=62
// 430 %constinteger STRING1=63
// 431 %constinteger STRINGTYPE=64
// 432 %constinteger ARRSTAR=65
// 433 %constinteger NULLSETTYPE=66
// 434 %constinteger RECSTAR=67
// 435 %constinteger REALTYPE=69
// 436 %constinteger SIGNAL=73
// 437 %constinteger DADDR=74
// 438 %constinteger DSIZEOF=77
// 439 %constinteger INDEX=78
// 440 %constinteger LENREF=79
// 441 %constinteger SINDEX=82
// 442 %constinteger IMUL=86
// 443 %constinteger IDIV=87
// 444 %constinteger IPOW=88
// 445 %constinteger FNEG=89
// 446 %constinteger FADD=90
// 447 %constinteger FSUB=91
// 448 %constinteger FMUL=92
// 449 %constinteger FDIV=93
// 450 %constinteger FPOW=94
// 451 %constinteger FLOAT=95
// 452 %constinteger DREM=98
// 453 %constinteger UNASS=102
// 454 %constinteger ADOK=103
// 455 %constinteger STACKOK=104
// 456 %constinteger ASIZE=105
// 457 %constinteger CONCAT=106
// 458 %constinteger DTOSTRING=107
// 459 %constinteger AGET=109
// 460 %constinteger FOROK=110
// 461 %constinteger CHECK=111
// 462 %constinteger SCOMP=112
// 463 %constinteger STRCOPY=113
// 464 %constinteger STRTOSTK=114
// 465 %constinteger DNEW=115
// 466 %constinteger RESOLVES=117
// 467 %constinteger DEVENTF=128
// 468 %constinteger DEVENT=134
// 469 %constinteger DNIL=137
// 470 %constinteger DPRINTSTR=155
// 471 %constinteger DWRITE=183
// 472
// 473 %constinteger OPMAX=resolves
// 474
// 475 %routine SET HASHHEAD(%string(*)%name s)
void SETHASHHEAD(_imp_string * S) {
// 476 %integer h,i
int H;
int I;
// 477 h = 0
H = 0;
// 478 h = h<<1!!charno(s,i) %for i = 1,1,length(s)
// %for I = 1, 1, *_imp_LENGTH((_imp_string255 *)/*p*/S) %cycle
{
int _final = *_imp_LENGTH((_imp_string255 *)/*p*/ S);
if (invalid_for_loop(1, 1, _final))
_imp_signal(5, 1, 0, "Illegal cycle I = 1, 1, *_imp_LENGTH((_imp_string255 *)/*p*/S)");
I = 0;
L_000F:
if (I == _final) goto L_0010;
I += 1;
H = H << 1 ^ *_imp_CHARNO((_imp_string255 *)/*p*/ S, I);
goto L_000F;
}
L_0010:;
// 479 head == hashindex(h&255)
HEAD = (short int *)/*?*/ &HASHINDEX[H & 255];
// 480 %end
return;
} /* end of SETHASHHEAD */
// 481
// 482 %routine PRESET
void PRESET(void) {
// 483 !* PRIMGEN marker 2
// 484 %const%integer CMAX=775
// 485 %OWN%byte%array CHARINIT(0:CMAX) =
static unsigned char CHARINIT[776] = {
0, 2, 100, 48, 2, 100, 49, 2, 100, 50, 2, 100, 51, 2, 100, 52, 2, 100, 53, 2, 100, 54,
2, 100, 55, 2, 97, 48, 2, 97, 49, 2, 97, 50, 2, 97, 51, 2, 97, 52, 2, 97, 53, 2,
97, 54, 2, 97, 55, 7, 105, 110, 116, 101, 103, 101, 114, 6, 77, 65, 88, 73, 78, 84, 12, 115,
104, 111, 114, 116, 105, 110, 116, 101, 103, 101, 114, 11, 104, 97, 108, 102, 105, 110, 116, 101, 103, 101,
114, 11, 98, 121, 116, 101, 105, 110, 116, 101, 103, 101, 114, 11, 109, 105, 116, 101, 105, 110, 116, 101,
103, 101, 114, 7, 66, 79, 79, 76, 69, 65, 78, 5, 70, 65, 76, 83, 69, 4, 84, 82, 85, 69,
4, 99, 104, 97, 114, 6, 115, 116, 114, 105, 110, 103, 5, 97, 114, 114, 97, 121, 6, 114, 101, 99,
111, 114, 100, 4, 84, 69, 88, 84, 4, 114, 101, 97, 108, 8, 108, 111, 110, 103, 114, 101, 97, 108,
6, 83, 73, 71, 78, 65, 76, 4, 97, 100, 100, 114, 6, 115, 105, 122, 101, 111, 102, 5, 73, 78,
68, 69, 88, 6, 108, 101, 110, 103, 116, 104, 6, 99, 104, 97, 114, 110, 111, 4, 73, 77, 85, 76,
4, 73, 68, 73, 86, 4, 73, 80, 79, 87, 4, 70, 78, 69, 71, 4, 70, 65, 68, 68, 4, 70,
83, 85, 66, 4, 70, 77, 85, 76, 4, 70, 68, 73, 86, 4, 70, 80, 79, 87, 5, 102, 108, 111,
97, 116, 3, 114, 101, 109, 5, 85, 78, 65, 83, 83, 4, 65, 68, 79, 75, 7, 83, 84, 65, 67,
75, 79, 75, 5, 65, 83, 73, 90, 69, 6, 67, 79, 78, 67, 65, 84, 8, 116, 111, 115, 116, 114,
105, 110, 103, 4, 65, 71, 69, 84, 5, 70, 79, 82, 79, 75, 5, 67, 72, 69, 67, 75, 5, 83,
67, 79, 77, 80, 7, 83, 84, 82, 67, 79, 80, 89, 8, 83, 84, 82, 84, 79, 83, 84, 75, 3,
110, 101, 119, 8, 114, 101, 115, 111, 108, 118, 101, 115, 9, 115, 117, 98, 115, 116, 114, 105, 110, 103,
7, 101, 118, 101, 110, 116, 102, 109, 5, 101, 118, 101, 110, 116, 3, 115, 117, 98, 4, 108, 105, 110,
101, 5, 101, 120, 116, 114, 97, 7, 109, 101, 115, 115, 97, 103, 101, 5, 101, 118, 101, 110, 116, 2,
110, 108, 3, 115, 110, 108, 3, 110, 105, 108, 7, 100, 105, 115, 112, 111, 115, 101, 5, 114, 111, 117,
110, 100, 5, 116, 114, 117, 110, 99, 8, 102, 114, 97, 99, 116, 105, 111, 110, 3, 105, 110, 116, 5,
105, 110, 116, 112, 116, 6, 102, 114, 97, 99, 112, 116, 4, 115, 113, 114, 116, 10, 110, 101, 120, 116,
115, 121, 109, 98, 111, 108, 10, 114, 101, 97, 100, 115, 121, 109, 98, 111, 108, 10, 115, 107, 105, 112,
115, 121, 109, 98, 111, 108, 11, 112, 114, 105, 110, 116, 115, 121, 109, 98, 111, 108, 11, 112, 114, 105,
110, 116, 115, 116, 114, 105, 110, 103, 9, 111, 112, 101, 110, 105, 110, 112, 117, 116, 10, 111, 112, 101,
110, 111, 117, 116, 112, 117, 116, 11, 115, 101, 108, 101, 99, 116, 105, 110, 112, 117, 116, 12, 115, 101,
108, 101, 99, 116, 111, 117, 116, 112, 117, 116, 8, 115, 101, 116, 105, 110, 112, 117, 116, 9, 115, 101,
116, 111, 117, 116, 112, 117, 116, 10, 114, 101, 115, 101, 116, 105, 110, 112, 117, 116, 11, 114, 101, 115,
101, 116, 111, 117, 116, 112, 117, 116, 10, 99, 108, 111, 115, 101, 105, 110, 112, 117, 116, 11, 99, 108,
111, 115, 101, 111, 117, 116, 112, 117, 116, 6, 112, 114, 111, 109, 112, 116, 7, 110, 101, 119, 108, 105,
110, 101, 5, 115, 112, 97, 99, 101, 6, 115, 112, 97, 99, 101, 115, 8, 110, 101, 119, 108, 105, 110,
101, 115, 4, 114, 101, 97, 100, 138, 114, 101, 97, 100, 115, 116, 114, 105, 110, 103, 4, 114, 101, 97,
100, 136, 114, 101, 97, 100, 114, 101, 97, 108, 4, 114, 101, 97, 100, 5, 119, 114, 105, 116, 101, 7,
99, 112, 117, 116, 105, 109, 101, 5, 112, 114, 105, 110, 116, 7, 112, 114, 105, 110, 116, 102, 108, 8,
105, 110, 115, 116, 114, 101, 97, 109, 9, 111, 117, 116, 115, 116, 114, 101, 97, 109, 8, 99, 108, 105,
112, 97, 114, 97, 109, 0};
// 486+ 0,
// 487+ 2,'d','0',
// 488+ 2,'d','1',
// 489+ 2,'d','2',
// 490+ 2,'d','3',
// 491+ 2,'d','4',
// 492+ 2,'d','5',
// 493+ 2,'d','6',
// 494+ 2,'d','7',
// 495+ 2,'a','0',
// 496+ 2,'a','1',
// 497+ 2,'a','2',
// 498+ 2,'a','3',
// 499+ 2,'a','4',
// 500+ 2,'a','5',
// 501+ 2,'a','6',
// 502+ 2,'a','7',
// 503+ 7,'i','n','t','e','g','e','r',
// 504+ 6,'M','A','X','I','N','T',
// 505+ 12,'s','h','o','r','t','i','n','t','e','g','e','r',
// 506+ 11,'h','a','l','f','i','n','t','e','g','e','r',
// 507+ 11,'b','y','t','e','i','n','t','e','g','e','r',
// 508+ 11,'m','i','t','e','i','n','t','e','g','e','r',
// 509+ 7,'B','O','O','L','E','A','N',
// 510+ 5,'F','A','L','S','E',
// 511+ 4,'T','R','U','E',
// 512+ 4,'c','h','a','r',
// 513+ 6,'s','t','r','i','n','g',
// 514+ 5,'a','r','r','a','y',
// 515+ 6,'r','e','c','o','r','d',
// 516+ 4,'T','E','X','T',
// 517+ 4,'r','e','a','l',
// 518+ 8,'l','o','n','g','r','e','a','l',
// 519+ 6,'S','I','G','N','A','L',
// 520+ 4,'a','d','d','r',
// 521+ 6,'s','i','z','e','o','f',
// 522+ 5,'I','N','D','E','X',
// 523+ 6,'l','e','n','g','t','h',
// 524+ 6,'c','h','a','r','n','o',
// 525+ 4,'I','M','U','L',
// 526+ 4,'I','D','I','V',
// 527+ 4,'I','P','O','W',
// 528+ 4,'F','N','E','G',
// 529+ 4,'F','A','D','D',
// 530+ 4,'F','S','U','B',
// 531+ 4,'F','M','U','L',
// 532+ 4,'F','D','I','V',
// 533+ 4,'F','P','O','W',
// 534+ 5,'f','l','o','a','t',
// 535+ 3,'r','e','m',
// 536+ 5,'U','N','A','S','S',
// 537+ 4,'A','D','O','K',
// 538+ 7,'S','T','A','C','K','O','K',
// 539+ 5,'A','S','I','Z','E',
// 540+ 6,'C','O','N','C','A','T',
// 541+ 8,'t','o','s','t','r','i','n','g',
// 542+ 4,'A','G','E','T',
// 543+ 5,'F','O','R','O','K',
// 544+ 5,'C','H','E','C','K',
// 545+ 5,'S','C','O','M','P',
// 546+ 7,'S','T','R','C','O','P','Y',
// 547+ 8,'S','T','R','T','O','S','T','K',
// 548+ 3,'n','e','w',
// 549+ 8,'r','e','s','o','l','v','e','s',
// 550+ 9,'s','u','b','s','t','r','i','n','g',
// 551+ 7,'e','v','e','n','t','f','m',
// 552+ 5,'e','v','e','n','t',
// 553+ 3,'s','u','b',
// 554+ 4,'l','i','n','e',
// 555+ 5,'e','x','t','r','a',
// 556+ 7,'m','e','s','s','a','g','e',
// 557+ 5,'e','v','e','n','t',
// 558+ 2,'n','l',
// 559+ 3,'s','n','l',
// 560+ 3,'n','i','l',
// 561+ 7,'d','i','s','p','o','s','e',
// 562+ 5,'r','o','u','n','d',
// 563+ 5,'t','r','u','n','c',
// 564+ 8,'f','r','a','c','t','i','o','n',
// 565+ 3,'i','n','t',
// 566+ 5,'i','n','t','p','t',
// 567+ 6,'f','r','a','c','p','t',
// 568+ 4,'s','q','r','t',
// 569+ 10,'n','e','x','t','s','y','m','b','o','l',
// 570+ 10,'r','e','a','d','s','y','m','b','o','l',
// 571+ 10,'s','k','i','p','s','y','m','b','o','l',
// 572+ 11,'p','r','i','n','t','s','y','m','b','o','l',
// 573+ 11,'p','r','i','n','t','s','t','r','i','n','g',
// 574+ 9,'o','p','e','n','i','n','p','u','t',
// 575+ 10,'o','p','e','n','o','u','t','p','u','t',
// 576+ 11,'s','e','l','e','c','t','i','n','p','u','t',
// 577+ 12,'s','e','l','e','c','t','o','u','t','p','u','t',
// 578+ 8,'s','e','t','i','n','p','u','t',
// 579+ 9,'s','e','t','o','u','t','p','u','t',
// 580+ 10,'r','e','s','e','t','i','n','p','u','t',
// 581+ 11,'r','e','s','e','t','o','u','t','p','u','t',
// 582+ 10,'c','l','o','s','e','i','n','p','u','t',
// 583+ 11,'c','l','o','s','e','o','u','t','p','u','t',
// 584+ 6,'p','r','o','m','p','t',
// 585+ 7,'n','e','w','l','i','n','e',
// 586+ 5,'s','p','a','c','e',
// 587+ 6,'s','p','a','c','e','s',
// 588+ 8,'n','e','w','l','i','n','e','s',
// 589+ 4,'r','e','a','d', 138,'r','e','a','d','s','t','r','i','n','g',
// 590+ 4,'r','e','a','d', 136,'r','e','a','d','r','e','a','l',
// 591+ 4,'r','e','a','d',
// 592+ 5,'w','r','i','t','e',
// 593+ 7,'c','p','u','t','i','m','e',
// 594+ 5,'p','r','i','n','t',
// 595+ 7,'p','r','i','n','t','f','l',
// 596+ 8,'i','n','s','t','r','e','a','m',
// 597+ 9,'o','u','t','s','t','r','e','a','m',
// 598+ 8,'c','l','i','p','a','r','a','m',
// 599+ 0
// 600 %constinteger PREMAX=196
// 601 %own%short%array DICTINIT(41*6:PREMAX*6+5) =
static short int DICTINIT[936] = {
516, -1, 0, 0, 0, 0, 527, -1, 0, 0, 0, 4, 512, 43,
4, 56, -32768, 0, 0, -44, 4, 60, -32768, 0, 0, 43, 4, 60,
32767, -1, 512, 43, 2, 56, -32768, 0, 0, -44, 2, 60, -1, -32768,
0, -44, 2, 60, 0, 32767, 512, 43, 2, 56, -32768, 0, 0, -44,
2, 60, 0, 0, 0, -44, 2, 60, 0, -1, 512, 43, 1, 56,
-32768, 0, 0, -44, 1, 60, 0, 0, 0, -44, 1, 60, 0, 255,
512, 43, 1, 56, -32768, 0, 0, -44, 1, 60, -1, -128, 0, -44,
1, 60, 0, 127, 514, 58, 1, 0, 0, 0, 0, 58, 1, 60,
0, 0, 0, 58, 1, 60, 0, 1, 513, 61, 255, 0, 0, 0,
520, 61, 0, 0, 0, 0, 520, -62, -2, 0, 0, 0, 520, -62,
-256, 0, 0, 0, 521, 0, 0, 0, 0, 0, 522, -1, 0, 0,
0, 0, 524, 0, 0, 0, 0, 0, 525, 61, 4, 0, 0, 0,
517, 0, 4, 0, 0, 0, 517, 0, 4, 0, 0, 0, 0, -1,
0, 0, 0, 0, 0, -1, 0, 0, 0, 0, 4256, 42, 0, 56,
0, 16122, 4098, 75, 0, 56, 0, 0, 0, -44, 76, 0, 0, 4,
-32701, -1, 0, 6313, -1, -4, 4098, 75, 0, 56, 0, 0, 4096, 42,
0, 56, -32767, 2861, 4099, 80, 0, 56, 0, 0, 0, -53, 81, 6144,
0, 4, -32701, -63, 0, 6313, -1, -4, 4099, 83, 0, 56, 0, 0,
0, -53, 84, 6144, 0, 4, -32701, -63, 85, 6313, -1, -4, 67, -44,
0, 169, -1, -8, 4256, 42, 0, 56, 0, 16116, 4256, 42, 0, 56,
0, 16110, 4096, 42, 0, 56, 0, 16098, 4096, 42, 0, 56, 0, 16092,
4096, 42, 0, 56, 0, 16086, 4096, 42, 0, 56, 0, 16080, 4096, 42,
0, 56, 0, 16074, 4096, 42, 0, 56, 0, 16068, 4096, 42, 0, 56,
0, 16062, 4098, 96, 0, 56, 0, 16056, 0, -70, 97, 0, 0, 4,
67, -44, 0, 169, -1, -4, 4098, 99, 0, 56, 0, 0, 0, -44,
100, 0, 0, 4, 67, -44, 101, 169, -1, -4, 67, -44, 0, 425,
-1, -8, 4096, 42, 0, 56, -32722, 2578, 4096, 42, 0, 56, -32704, 2064,
4096, 42, 0, 56, -32688, 2839, 4096, 42, 0, 56, -32665, 3097, 4096, 42,
0, 56, -32640, 2077, 4098, 108, 0, 56, -32611, 6, 0, -64, 97, 6144,
0, 4, 4096, 42, 0, 56, -32605, 2597, 4096, 42, 0, 56, -32568, 2334,
4096, 42, 0, 56, -32538, 1806, 4096, 42, 0, 56, -32524, 2626, 4096, 42,
0, 56, -32458, 2070, 4096, 42, 0, 56, -32436, 2090, 4103, 116, 0, 56,
0, 16008, 0, -68, 76, 6144, 0, 4, 22786, 118, 0, 108, 0, 0,
0, -59, 119, 0, 0, 0, -32701, -63, 120, 6313, -1, -4, 67, -65,
121, 6569, -1, -260, -32701, -63, 122, 6825, -1, -264, -32701, -63, 0, 7081,
-1, -268, 4098, 124, 0, 56, -32394, 15, 0, -65, 125, 6144, 0, 4,
-32701, -63, 126, 6313, -1, -4, 67, -44, 127, 169, -1, -8, 67, -44,
0, 425, -1, -12, 524, 0, 129, 0, -1, -264, 3, 52, 0, 0,
0, 0, 3, 52, 0, 0, 0, 1, 3, 46, 0, 0, 0, 2,
3, 43, 0, 0, 0, 4, 3, 64, 0, 0, 0, 8, 67, 128,
0, 45, 0, 32, 66, 43, 0, 60, 0, 10, 66, 61, 0, 60,
0, 10, 67, 67, 0, 56, 0, 0, 4096, 139, 0, 56, 0, 16002,
0, -1, 76, 0, 0, 4, 4098, 141, 0, 56, 0, 16050, 0, -44,
142, 0, 0, 4, 67, -70, 0, 169, -1, -4, 4098, 141, 0, 56,
0, 16044, 4098, 145, 0, 56, 0, 16038, 0, -70, 142, 0, 0, 4,
4098, 141, 0, 56, 0, 16032, 4098, 141, 0, 56, 0, 16026, 4098, 145,
0, 56, 0, 16020, 4098, 145, 0, 56, 0, 16014, 4098, 132, 0, 56,
0, 15996, 4098, 132, 0, 56, 0, 15990, 4096, 42, 0, 56, 0, 15990,
4256, 154, 0, 56, 0, 15984, 0, -1, 97, 0, 0, 4, 4096, 156,
0, 56, 0, 15978, 0, -1, 157, 0, 0, 4, 67, -65, 0, 6313,
-1, -256, 26880, 159, 0, 108, 0, 0, 0, -1, 160, 0, 0, 0,
67, -44, 161, 169, -1, -4, 67, -65, 0, 6313, -1, -260, 26880, 159,
0, 108, 0, 0, 4096, 154, 0, 56, 0, 15960, 4096, 154, 0, 56,
0, 15954, 26880, 166, 0, 108, 0, 0, 0, -1, 97, 0, 0, 0,
26880, 166, 0, 108, 0, 0, 26880, 0, 0, 108, 0, 0, 26880, 0,
0, 108, 0, 0, 4096, 42, 0, 56, 0, 15936, 4096, 42, 0, 56,
0, 15930, 26880, 173, 0, 108, 0, 0, 0, -1, 157, 0, 0, 0,
4096, 42, 0, 56, -32379, 4, 4096, 42, 0, 56, -32375, 4, 22784, 166,
0, 108, 0, 0, 22784, 166, 0, 108, 0, 0, 22790, 179, 0, 108,
0, 0, 0, -65, 0, 6144, 0, 0, 22798, 181, 0, 108, 0, 0,
0, -70, 0, 0, 0, 0, 22798, 1, 0, 108, 0, 0, 22784, 184,
0, 108, 0, 0, 0, -1, 100, 0, 0, 0, 26886, 1, 0, 108,
0, 0, 22784, 187, 0, 108, 0, 0, 0, -1, 188, 0, 0, 0,
67, -70, 189, 169, -1, -4, 67, -44, 190, 425, -1, -8, 67, -44,
0, 681, -1, -12, 22784, 192, 0, 108, 0, 0, 0, -1, 193, 0,
0, 0, 67, -70, 101, 169, -1, -4, 67, 43, 0, 45, 0, 392,
67, 43, 0, 45, 0, 396, 67, 64, 0, 45, 0, 464};
// 602+ 516,-1,0,0,0,0,
// 603+ 527,-1,0,0,0,4,
// 604+ 512,43,4,56,-32768,0,
// 605+ 0,-44,4,60,-32768,0,
// 606+ 0,43,4,60,32767,-1,
// 607+ 512,43,2,56,-32768,0,
// 608+ 0,-44,2,60,-1,-32768,
// 609+ 0,-44,2,60,0,32767,
// 610+ 512,43,2,56,-32768,0,
// 611+ 0,-44,2,60,0,0,
// 612+ 0,-44,2,60,0,-1,
// 613+ 512,43,1,56,-32768,0,
// 614+ 0,-44,1,60,0,0,
// 615+ 0,-44,1,60,0,255,
// 616+ 512,43,1,56,-32768,0,
// 617+ 0,-44,1,60,-1,-128,
// 618+ 0,-44,1,60,0,127,
// 619+ 514,58,1,0,0,0,
// 620+ 0,58,1,60,0,0,
// 621+ 0,58,1,60,0,1,
// 622+ 513,61,255,0,0,0,
// 623+ 520,61,0,0,0,0,
// 624+ 520,-62,-2,0,0,0,
// 625+ 520,-62,-256,0,0,0,
// 626+ 521,0,0,0,0,0,
// 627+ 522,-1,0,0,0,0,
// 628+ 524,0,0,0,0,0,
// 629+ 525,61,4,0,0,0,
// 630+ 517,0,4,0,0,0,
// 631+ 517,0,4,0,0,0,
// 632+ 0,-1,0,0,0,0,
// 633+ 0,-1,0,0,0,0,
// 634+ 4256,42,0,56,0,16122,
// 635+ 4098,75,0,56,0,0,
// 636+ 0,-44,76,0,0,4,
// 637+ -32701,-1,0,6313,-1,-4,
// 638+ 4098,75,0,56,0,0,
// 639+ 4096,42,0,56,-32767,2861,
// 640+ 4099,80,0,56,0,0,
// 641+ 0,-53,81,6144,0,4,
// 642+ -32701,-63,0,6313,-1,-4,
// 643+ 4099,83,0,56,0,0,
// 644+ 0,-53,84,6144,0,4,
// 645+ -32701,-63,85,6313,-1,-4,
// 646+ 67,-44,0,169,-1,-8,
// 647+ 4256,42,0,56,0,16116,
// 648+ 4256,42,0,56,0,16110,
// 649+ 4096,42,0,56,0,16098,
// 650+ 4096,42,0,56,0,16092,
// 651+ 4096,42,0,56,0,16086,
// 652+ 4096,42,0,56,0,16080,
// 653+ 4096,42,0,56,0,16074,
// 654+ 4096,42,0,56,0,16068,
// 655+ 4096,42,0,56,0,16062,
// 656+ 4098,96,0,56,0,16056,
// 657+ 0,-70,97,0,0,4,
// 658+ 67,-44,0,169,-1,-4,
// 659+ 4098,99,0,56,0,0,
// 660+ 0,-44,100,0,0,4,
// 661+ 67,-44,101,169,-1,-4,
// 662+ 67,-44,0,425,-1,-8,
// 663+ 4096,42,0,56,-32722,2578,
// 664+ 4096,42,0,56,-32704,2064,
// 665+ 4096,42,0,56,-32688,2839,
// 666+ 4096,42,0,56,-32665,3097,
// 667+ 4096,42,0,56,-32640,2077,
// 668+ 4098,108,0,56,-32611,6,
// 669+ 0,-64,97,6144,0,4,
// 670+ 4096,42,0,56,-32605,2597,
// 671+ 4096,42,0,56,-32568,2334,
// 672+ 4096,42,0,56,-32538,1806,
// 673+ 4096,42,0,56,-32524,2626,
// 674+ 4096,42,0,56,-32458,2070,
// 675+ 4096,42,0,56,-32436,2090,
// 676+ 4103,116,0,56,0,16008,
// 677+ 0,-68,76,6144,0,4,
// 678+ 22786,118,0,108,0,0,
// 679+ 0,-59,119,0,0,0,
// 680+ -32701,-63,120,6313,-1,-4,
// 681+ 67,-65,121,6569,-1,-260,
// 682+ -32701,-63,122,6825,-1,-264,
// 683+ -32701,-63,0,7081,-1,-268,
// 684+ 4098,124,0,56,-32394,15,
// 685+ 0,-65,125,6144,0,4,
// 686+ -32701,-63,126,6313,-1,-4,
// 687+ 67,-44,127,169,-1,-8,
// 688+ 67,-44,0,425,-1,-12,
// 689+ 524,0,129,0,-1,-264,
// 690+ 3,52,0,0,0,0,
// 691+ 3,52,0,0,0,1,
// 692+ 3,46,0,0,0,2,
// 693+ 3,43,0,0,0,4,
// 694+ 3,64,0,0,0,8,
// 695+ 67,128,0,45,0,32,
// 696+ 66,43,0,60,0,10,
// 697+ 66,61,0,60,0,10,
// 698+ 67,67,0,56,0,0,
// 699+ 4096,139,0,56,0,16002,
// 700+ 0,-1,76,0,0,4,
// 701+ 4098,141,0,56,0,16050,
// 702+ 0,-44,142,0,0,4,
// 703+ 67,-70,0,169,-1,-4,
// 704+ 4098,141,0,56,0,16044,
// 705+ 4098,145,0,56,0,16038,
// 706+ 0,-70,142,0,0,4,
// 707+ 4098,141,0,56,0,16032,
// 708+ 4098,141,0,56,0,16026,
// 709+ 4098,145,0,56,0,16020,
// 710+ 4098,145,0,56,0,16014,
// 711+ 4098,132,0,56,0,15996,
// 712+ 4098,132,0,56,0,15990,
// 713+ 4096,42,0,56,0,15990,
// 714+ 4256,154,0,56,0,15984,
// 715+ 0,-1,97,0,0,4,
// 716+ 4096,156,0,56,0,15978,
// 717+ 0,-1,157,0,0,4,
// 718+ 67,-65,0,6313,-1,-256,
// 719+ 26880,159,0,108,0,0,
// 720+ 0,-1,160,0,0,0,
// 721+ 67,-44,161,169,-1,-4,
// 722+ 67,-65,0,6313,-1,-260,
// 723+ 26880,159,0,108,0,0,
// 724+ 4096,154,0,56,0,15960,
// 725+ 4096,154,0,56,0,15954,
// 726+ 26880,166,0,108,0,0,
// 727+ 0,-1,97,0,0,0,
// 728+ 26880,166,0,108,0,0,
// 729+ 26880,0,0,108,0,0,
// 730+ 26880,0,0,108,0,0,
// 731+ 4096,42,0,56,0,15936,
// 732+ 4096,42,0,56,0,15930,
// 733+ 26880,173,0,108,0,0,
// 734+ 0,-1,157,0,0,0,
// 735+ 4096,42,0,56,-32379,4,
// 736+ 4096,42,0,56,-32375,4,
// 737+ 22784,166,0,108,0,0,
// 738+ 22784,166,0,108,0,0,
// 739+ 22790,179,0,108,0,0,
// 740+ 0,-65,0,6144,0,0,
// 741+ 22798,181,0,108,0,0,
// 742+ 0,-70,0,0,0,0,
// 743+ 22798,1,0,108,0,0,
// 744+ 22784,184,0,108,0,0,
// 745+ 0,-1,100,0,0,0,
// 746+ 26886,1,0,108,0,0,
// 747+ 22784,187,0,108,0,0,
// 748+ 0,-1,188,0,0,0,
// 749+ 67,-70,189,169,-1,-4,
// 750+ 67,-44,190,425,-1,-8,
// 751+ 67,-44,0,681,-1,-12,
// 752+ 22784,192,0,108,0,0,
// 753+ 0,-1,193,0,0,0,
// 754+ 67,-70,101,169,-1,-4,
// 755+ 67,43,0,45,0,392,
// 756+ 67,43,0,45,0,396,
// 757+ 67,64,0,45,0,464
// 758
// 759 %integer i,ci,anons
int I;
int CI;
int ANONS;
// 760 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 761
// 762 %routine PUT CHAR
void PUTCHAR(void) {
// 763 byteinteger(charlim) = charinit(ci)
*_imp_BYTEINTEGER(CHARLIM) = CHARINIT[CI];
// 764 charlim = charlim+1; ci = ci+1
CHARLIM = CHARLIM + 1;
CI = CI + 1;
// 765 %end
return;
} /* end of PUTCHAR */
// 766
// 767 %routine TEXTSET(%record(identinfo)%name dp)
void TEXTSET(struct IDENTINFO * DP) {
// 768 %integer len
int LEN;
// 769 dp_hlink = 0
DP->HLINK = 0;
// 770 %if dp_type < 0 %start; !convention for *anon*
if (DP->TYPE >= 0) goto L_0012;
// 771 dp_type = \dp_type
DP->TYPE = (~DP->TYPE);
// 772 dp_text = 0
DP->TEXT = 0;
// 773 anons = anons-1
ANONS = ANONS - 1;
// 774 dp_hlink = ranges %and ranges = dlim %if anons = 0 %and dlim <= mitetype+2
if (ANONS != 0) goto L_0013;
if (DLIM > 55 + 2) goto L_0013;
DP->HLINK = RANGES;
RANGES = DLIM;
L_0013:;
// 775 %else
goto L_0014;
L_0012:;
// 776 dp_text = ci
DP->TEXT = CI;
// 777 %if charinit(ci+1)&32 # 0 %start; !not upper-case
if (CHARINIT[CI + 1] & 32 == 0) goto L_0015;
// 778 %if deventf < dlim < devent %start
{
// Double-sided test on DLIM (Part I)
int tmp;
if (128 >= (tmp = DLIM)) goto L_0016;
// Double-sided test on DLIM (Part II)
if (tmp >= 134) goto L_0016;
}
// 779 head = dlim; head == dp_hlink
*HEAD = DLIM;
HEAD = (short int *)/*?*/ &DP->HLINK;
// 780 %else
goto L_0017;
L_0016:;
// 781 set hashhead(string(addr(charinit(ci))))
SETHASHHEAD((_imp_string255 *)/*p*/ _imp_STRING(_imp_ADDR(/*?*/ &CHARINIT[CI])));
// 782 dp_hlink = head; head = dlim
DP->HLINK = *HEAD;
*HEAD = DLIM;
// 783 head == dp_link %if dlim = deventf
if (DLIM != 128) goto L_0018;
HEAD = (short int *)/*?*/ &DP->LINK;
L_0018:;
// 784 %finish
L_0017:;
// 785 %finish
L_0015:;
// 786 len = charinit(ci)
LEN = CHARINIT[CI];
// 787 put char %and len = len-1 %until len < 0
L_0019:;
PUTCHAR();
LEN = LEN - 1;
if (LEN < 0) goto L_001A;
goto L_0019;
L_001A:;
// 788 len = charinit(ci)-128
LEN = CHARINIT[CI] - 128;
// 789 put char %and len = len-1 %while len >= 0
L_001B:;
if (LEN < 0) goto L_001C;
PUTCHAR();
LEN = LEN - 1;
goto L_001B;
L_001C:;
// 790 anons = 2
ANONS = 2;
// 791 %finish
L_0014:;
// 792 %end
return;
} /* end of TEXTSET */
// 793
// 794 hashindex(i) = 0 %for i = 0,1,255; !hash table empty
// %for I = 0, 1, 255 %cycle
{
I = -1;
L_001D:
if (I == 255) goto L_001E;
I += 1;
HASHINDEX[I] = 0;
goto L_001D;
}
L_001E:;
// 795 byteinteger(char0) = 0; !for anon ident
*_imp_BYTEINTEGER(CHAR0) = 0;
// 796 charlim = char0+1
CHARLIM = CHAR0 + 1;
// 797 charmin = charlim+charbound; !(1 over top)
CHARMIN = CHARLIM + CHARBOUND;
// 798 ranges = 0
RANGES = 0;
// 799
// 800 ci = 1
CI = 1;
// 801 anons = 100
ANONS = 100;
// 802 dict(0) = 0
DICT[0] = (struct IDENTINFO){0};
// 803 dlim = d0
DLIM = 1;
// 804 %cycle
L_001F:;
// 805 dp == dict(dlim)
DP = (struct IDENTINFO *)/*?*/ &DICT[DLIM];
// 806 %if dlim <= prea7 %start
if (DLIM > 40) goto L_0020;
// 807 dp = 0
*DP = (struct IDENTINFO){0};
// 808 dp_flags = okflag+writable+readable; dp_mode = dlim-d0
DP->FLAGS = 64 + 1 + 2;
DP->MODE = DLIM - 1;
// 809 dp_type = inttype
DP->TYPE = 43;
// 810 textset(dp) %if dlim <= a7
if (DLIM > 16) goto L_0021;
TEXTSET(DP);
L_0021:;
// 811 %else
goto L_0022;
L_0020:;
// 812 dp_details = record(addr(dictinit(dlim*6)))
DP->DETAILS = *_imp_RECORD(_imp_ADDR(/*?*/ &DICTINIT[DLIM * 6 - 246]));
// 813 textset(dp)
TEXTSET(DP);
// 814 %finish
L_0022:;
// 815 dlim = dlim+1
DLIM = DLIM + 1;
// 816 %exit %if control&permbit # 0 %and dlim >= signal
if (CONTROL & 128 == 0) goto L_0023;
if (DLIM < 73) goto L_0023;
goto L_0024;
L_0023:;
// 817 %repeat %until dlim > premax
if (DLIM > 196) goto L_0024;
goto L_001F;
L_0024:;
// 818 dictshown = dlim
DICTSHOWN = DLIM;
// 819 i = dictlim
I = DICTLIM;
// 820 %cycle
L_0025:;
// 821 dp == dict(i)
DP = (struct IDENTINFO *)/*?*/ &DICT[I];
// 822 dp = 0
*DP = (struct IDENTINFO){0};
// 823 dp_mode = labmode
DP->MODE = 186;
// 824 i = i+1
I = I + 1;
// 825 %repeat %until i = np0
if (I == NP0) goto L_0026;
goto L_0025;
L_0026:;
// 826 %end; !preset
return;
} /* end of PRESET */
// 827
// 828 !<<BOTH
// 829
// 830 ! The last part of DICT (from LABLIM to EXPLIM) is used for
// 831 ! the intermediate representation of the components of source
// 832 ! statements between the recognition stage and the code generation
// 833 ! stage.
// 834 ! The part from LABLIM+4 (NP0) up is used as a temporary pipeline
// 835 ! for non-expression cells (instructions, conditions, etc)
// 836 ! and the part down from EXPLIM for the canonical and
// 837 ! persistent representation of expressions (including name
// 838 ! expressions).
// 839 ! In this part of the array the ident components PLIST (etc), TEXT
// 840 ! and HLINK are replaced by ACT, X and Y representing an operation
// 841 ! and (up to) two operands.
// 842 %integer EXPLO,OLDEXPLO
int EXPLO;
int OLDEXPLO;
// 843 %integer NP,STARTNP
int NP;
int STARTNP;
// 844
// 845 !Operator codes:
// 846 ! Machine operator index values 1-31:
// 847 %constinteger MOVE=1, ADD=2, SUB=3
// 848 %constinteger CMP=4, AND=5, OR=6, EOR=7
// 849 %constinteger NOT=8, NEG=9, LSL=10, LSR=11
// 850 %constinteger MULS=12, DIVS=13, MULU=14, DIVU=15
// 851 %constinteger BRA=16, BSR=17
// 852 %constinteger BCC=20, BCS=21, BNE=22, BEQ=23
// 853 %constinteger BVC=24, BVS=25
// 854 %constinteger BGE=28, BLT=29, BGT=30, BLE=31
// 855 %constinteger COMPARE=cmp, GOTO=bra
// 856 ! Other built-in operators
// 857 %constinteger JAMASS=32, OKASS=33, ASSIGN=34, INCASS=35
// 858 %constinteger FORASS=36, STOP=37, RETURN=38, REPEAT=39
// 859 %constinteger ELSE=40, JUMPOUT=41, SETTRAP=42, SWGOTO=43
// 860 %constinteger LABEL=44, RECREF=45, PREL=46, STOREMAP=47
// 861 %constinteger IABS=48, FABS=49, END=50
// 862 ! PLUS OPERATORS DEFINED IN DICTIONARY > BOPMAX <= OPMAX
// 863 !
// 864 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 865
// 866 %integer STARTS, CYCLES
int STARTS;
int CYCLES;
// 867 %integer CURLAB
int CURLAB;
// 868 %integer PENDOUT, PENDCOND, PENDIN, POLARITY, CONDOP
int PENDOUT;
int PENDCOND;
int PENDIN;
int POLARITY;
int CONDOP;
// 869 %ownshortinteger EXTSPECS=0, EXTERNS=0
static short int EXTSPECS = 0;
static short int EXTERNS = 0;
// 870 !
// 871 %recordformat CONTENTINFO(%short ccx,ccy,line,
struct CONTENTINFO {
union {
struct {
short int CCX;
short int CCY;
short int LINE;
short int CONTENT[16];
};
};
};
// 872+ %shortarray content(d0:a7))
// 873 %recordformat BLOCKINF(%integer sp, stack, extra, totstack, free, status,
struct BLOCKINF {
union {
struct {
int SP;
int STACK;
int EXTRA;
int TOTSTACK;
int FREE;
int STATUS;
int TYPE;
int LOCALDPOS;
int PARLIM;
int LOCALTEXT;
int LOCALAD;
int VINTAGE;
int LOCALPC;
int LOCALSWPC;
int PID;
int ACCESS;
int FORWARD;
int LAB1;
int LOOPLAB;
int EVENTSP;
int FAULTS;
int RETURN;
int SHORTS;
int TEMPS;
int DYNARRAY;
int OLDCONTROL;
int MODE;
int VAL;
struct IDENTINFO *DPID;
struct CONTENTINFO REG;
};
};
};
// 874+ type, localdpos, parlim, localtext, localad, vintage,
// 875+ localpc, localswpc, pid, access, forward, lab1, looplab,
// 876+ eventsp, faults, return, shorts, temps,
// 877+ dynarray, oldcontrol, mode,val,
// 878+ %record(identinfo)%name dpid,
// 879+ %record(contentinfo) reg)
// 880 !STATUS flag bits
// 881 %constinteger UNKNOWN =16_0002,
// 882+ WRONGCC =16_0004,
// 883+ ONSTACK =16_0008,
// 884+ GLOBBED =16_0010,
// 885+ LABGLOBBED =16_0020, {Pascal}
// 886+ HADSPEC =16_0040,
// 887+ HADSWITCH =16_0080,
// 888+ HADON =16_1000,
// 889+ HADORDERERR=16_2000,
// 890+ HADINST =16_4000 {max flag}
// 891
// 892 %constinteger OUTERLEVEL=0, MAXLEVEL=7
// 893 %integer LEVEL; !current block level
int LEVEL;
// 894 %integer VINTAGE; !current block number
int VINTAGE;
// 895 %record(blockinf) C; !info for current block
struct BLOCKINF C;
// 896 %record(blockinf)%array HOLD(0:maxlevel-1); !info for global blocks
struct BLOCKINF HOLD[7 - 1 + 1];
// 897 %record(contentinfo)%array LREG(0:labels)
struct CONTENTINFO LREG[43];
// 898
// 899 ! Code storage for currently open blocks
// 900 %constinteger PROGBOUND=16383
// 901 %shortarray PROG(0:progbound)
short int PROG[16384];
// 902 %bytearray PFLAG(0:progbound)
unsigned char PFLAG[16384];
// 903 %constinteger SHORTJUMP=1, JUMP=2, LONGJUMP=3,
// 904+ GLOBAL=4, {NEGGLOBAL=5, BIGGLOBAL=6,} INDGLOBAL=7,
// 905+ ZEROSHORTS=8
// 906 %integer PC,SWPC
int PC;
int SWPC;
// 907 ! Final core image
// 908 %bytearray FINAL(0:finalbound)
unsigned char FINAL[FINALBOUND + 1];
// 909 ! Declaration records (to select relevant context)
// 910 %integer CAD,OWNAD,JOKERAD,OWNBASE
int CAD;
int OWNAD;
int JOKERAD;
int OWNBASE;
// 911 %integer FINAL0,ACCOUNTED
int FINAL0;
int ACCOUNTED;
// 912 !
// 913 %integer FIRSTENTRY, FIRSTPOS
int FIRSTENTRY;
int FIRSTPOS;
// 914
// 915 !Memo variables for current statement:-
// 916 %own%integer {ITEM,}TYPE=0,VALUE=0; !current operand
static int TYPE = 0;
static int VALUE = 0;
// 917 %record(identinfo)%name DITEM
struct IDENTINFO *DITEM;
// 918 %integer SPECCING
int SPECCING;
// 919 %integer DUMP
int DUMP;
// 920
// 921 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 922
// 923 !! Source file input and listing
// 924 %owninteger ATOM=0; !current lexical atom
static int ATOM = 0;
// 925 %integer MATCHED; !indic that atom has been matched
int MATCHED;
// 926 %integer SYM; !current input symbol
int SYM;
// 927 %integer LINE; !current line number
int LINE;
// 928 %owninteger CODEFLAG=' '; !or ^
static int CODEFLAG = 32;
// 929 %integer LISTFLAG; !' ' or '&' or '+' or '"'
int LISTFLAG;
// 930 ! Pointers to source file:
// 931 %integer LINESTART
int LINESTART;
// 932 %integer FP; !(file pointer) current position
int FP;
// 933 %integer ATOMP; !start of current atom
int ATOMP;
// 934 %integer EXPP
int EXPP;
// 935 !
// 936 !! Utility routines
// 937
// 938 %integerfn IS SHORT(%integer v)
int ISSHORT(int V) {
// 939 %result = TRUE %if -32768 <= v <= 32767
{
// Double-sided test on V (Part I)
int tmp;
if (-32768 > (tmp = V)) goto L_0027;
// Double-sided test on V (Part II)
if (tmp > 32767) goto L_0027;
}
return 1;
L_0027:;
// 940 %result = FALSE
return 0;
// 941 %end
} /* end of ISSHORT */
// 942
// 943 %integerfn IS MITE(%integer v)
int ISMITE(int V) {
// 944 %result = TRUE %if -128 <= v <= 127
{
// Double-sided test on V (Part I)
int tmp;
if (-128 > (tmp = V)) goto L_0028;
// Double-sided test on V (Part II)
if (tmp > 127) goto L_0028;
}
return 1;
L_0028:;
// 945 %result = FALSE
return 0;
// 946 %end
} /* end of ISMITE */
// 947
// 948 %integer%fn MITE(%integer v)
int MITE(int V) {
// 949 v = v&255; v = v-256 %if v&128 # 0
V = V & 255;
if (V & 128 == 0) goto L_0029;
V = V - 256;
L_0029:;
// 950 %result = v
return V;
// 951 %end
} /* end of MITE */
// 952
// 953 %record(identinfo)%map TYPECELL(%integer t)
struct IDENTINFO *TYPECELL(int T)
{
// 954 %result == dict(t)
return /*?*/ &DICT[T];
// 955 %end
} /* end of TYPECELL */
// 956
// 957 %integer%fn CATEGORY(%integer t)
int CATEGORY(int T) {
// 958 %result = dict(t)_flags&(packed+cat)
return DICT[T].FLAGS & 1024 + 15;
// 959 %end
} /* end of CATEGORY */
// 960
// 961 %integer%fn LITVAL(%integer v)
int LITVAL(int V) {
// 962 %result = v %if v = 0
if (V != 0) goto L_002A;
return V;
L_002A:;
// 963 %if v > litmax %start; !not stored literal
if (V <= -2048) goto L_002B;
// 964 %result = (-v)>>1 %if v&1 = 0
if (V & 1 != 0) goto L_002C;
return (unsigned int)-V >> 1;
L_002C:;
// 965 %result = \((-v)>>1)
return ~((unsigned int)-V >> 1);
// 966 %finish
L_002B:;
// 967 %result = litstore(v)
return LITSTORE[V + 2247];
// 968 %end
} /* end of LITVAL */
// 969 !
// 970 !!!!!!!!!!!!!! Listing, diagnostic and report routines !!!!!!!!!!!!!!
// 971 !
// 972 %integer FAULTS, OTHERS, FAULTNUM, FAULTP
int FAULTS;
int OTHERS;
int FAULTNUM;
int FAULTP;
// 973 !
// 974 !! Program statistics
// 975 %integer STATEMENTS; !statement count
int STATEMENTS;
// 976 %integer COMMENTS; !comment count
int COMMENTS;
// 977 %integer ATOMS; !atom count
int ATOMS;
// 978 %integer IDENTATOMS; !identifier count
int IDENTATOMS;
// 979 %integer LITATOMS; !numeric atom count
int LITATOMS;
// 980 %integer ZAPS; !enforced cleardown of lits/exps
int ZAPS;
// 981 %integer STEPS; !stepping stones inserted
int STEPS;
// 982 !%integer MAXIDENTS, MAXCHARS, MAXLITS
// 983 %integer JUMPS,SHORTS
int JUMPS;
int SHORTS;
// 984 !
// 985 %string(255) REP
_imp_string255 REP;
// 986 !
// 987 %routine PRINT LINE
void PRINTLINE(void) {
// 988 print string(rep); print symbol(nl)
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = REP /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_PRINTSYMBOL(10);
// 989 rep = ""
_imp_strncpy(/*?*/ &REP, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 255);
// 990 %end
return;
} /* end of PRINTLINE */
// 991 !
// 992 %routine PUT SYM(%integer k)
void PUTSYM(int K) {
// 993 rep = rep.tostring(k)
_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);
// 994 %end
return;
} /* end of PUTSYM */
// 995 !
// 996 %routine PUT STRING(%string(255) s)
void PUTSTRING(_imp_string255 S) {
// 997 rep = rep.s
_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);
// 998 %end
return;
} /* end of PUTSTRING */
// 999 !
// 1000 !
// 1001 %routine PUT NUM(%integer val)
void PUTNUM(int VAL) {
// 1002 %routine PD(%integer v)
void PD(int V) {
// 1003 pd(v//10) %and v = v-v//10*10 %if v <= -10
if (V > -10) goto L_002D;
PD(((long)V / (long)10));
V = V - ((long)V / (long)10) * 10;
L_002D:;
// 1004 put sym('0'-v)
PUTSYM(48 - V);
// 1005 %end
return;
} /* end of PD */
// 1006 %if val < 0 %then put sym('-') %and pd(val) %c
if (VAL >= 0) goto L_002E;
PUTSYM(45);
PD(VAL);
goto L_002F;
L_002E:;
PD(-VAL);
L_002F:;
// 1007+ %else pd(-val)
// 1008 %end
return;
} /* end of PUTNUM */
// 1009 !
// 1010 %routine PUT IDENT(%integer p,mode)
void PUTIDENT(int P, int MODE) {
// 1011 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 1012 %cycle
L_0030:;
// 1013 print line %if length(rep) > 50
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP) <= 50) goto L_0031;
PRINTLINE();
L_0031:;
// 1014 spaces(6) %if rep = ""
if (_imp_strcmp((_imp_string *)/*?*/ &REP, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) != 0) goto L_0032;
_imp_SPACES(6);
L_0032:;
// 1015 dp == dict(p)
DP = (struct IDENTINFO *)/*?*/ &DICT[P];
// 1016 put sym(' ') %and put sym('"') %if mode # 0
if (MODE == 0) goto L_0033;
PUTSYM(32);
PUTSYM(34);
L_0033:;
// 1017 %if dp_text > 0 %start
if (DP->TEXT <= 0) goto L_0034;
// 1018 put string(string(char0+dp_text))
PUTSTRING(
*({
__typeof__(_imp_string255) tmp = *_imp_STRING(CHAR0 + DP->TEXT) /*q*/;
(_imp_string255 *)&tmp;
})
);
// 1019 %finish %else %if dp_text < 0 %start
goto L_0035;
L_0034:;
if (DP->TEXT >= 0) goto L_0036;
// 1020 put num(\dp_text)
PUTNUM((~DP->TEXT));
// 1021 %else
goto L_0035;
L_0036:;
// 1022 put num(p)
PUTNUM(P);
// 1023 %finish
L_0035:;
// 1024 put sym('"') %if mode # 0
if (MODE == 0) goto L_0037;
PUTSYM(34);
L_0037:;
// 1025 %return %if mode <= 0
if (MODE > 0) goto L_0038;
return;
L_0038:;
// 1026 p = dp_hlink
P = DP->HLINK;
// 1027 %repeat %until p = 0
if (P == 0) goto L_0039;
goto L_0030;
L_0039:;
// 1028 %end
return;
} /* end of PUTIDENT */
// 1029 !
// 1030 {?}%routine SPACES(%integer n)
void SPACES(int N) {
// 1031 {?} %while n > 0 %cycle
L_003A:;
if (N <= 0) goto L_003B;
// 1032 {?} put sym(' '); n = n-1
PUTSYM(32);
N = N - 1;
// 1033 {?} %repeat
goto L_003A;
L_003B:;
// 1034 {?}%end
return;
} /* end of SPACES */
// 1035 {?}!
// 1036 {?}%routine PUT SPNUM(%integer val)
void PUTSPNUM(int VAL) {
// 1037 {?} put sym(' ') %if val >= 0
if (VAL < 0) goto L_003C;
PUTSYM(32);
L_003C:;
// 1038 {?} put num(val)
PUTNUM(VAL);
// 1039 {?}%end
return;
} /* end of PUTSPNUM */
// 1040 {?}
// 1041 {?}%constbytearray hexsym(0:15) =
const unsigned char HEXSYM[16] = {48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 65, 66, 67, 68, 69, 70};
// 1042+ {?}'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
// 1043 {?}
// 1044 {?}%routine PUT HEX(%integer val)
void PUTHEX(int VAL) {
// 1045 {?}%integer i
int I;
// 1046 {?} put sym(hexsym(val>>i&15)) %for i = 12,-4,0
// %for I = 12, -4, 0 %cycle
{
I = 16;
L_003D:
if (I == 0) goto L_003E;
I -= 4;
PUTSYM(HEXSYM[(unsigned int)VAL >> I & 15]);
goto L_003D;
}
L_003E:;
// 1047 {?}%end
return;
} /* end of PUTHEX */
// 1048 {?}!
// 1049 {?}%routine PUT OPERAND(%integer v)
void PUTOPERAND(int V) {
// 1050 {?}%integer i
int I;
// 1051 {?}%routine INTERPRET(%integer mode)
void INTERPRET(int MODE) {
// 1052 {?}%switch s(0:7)
int S_index;
int S_line;
char *S_file;
static const void *S[8] = {&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing};
// 1053 {?} ->s(mode>>3&7)
S_line = __LINE__;
S_file = __FILE__;
S_index = (unsigned int)MODE >> 3 & 7;
goto case_S_dispatch;
// 1054 {?}s(0): !DREG
case_S_0:;
// 1055 {?} put sym('D')
PUTSYM(68);
// 1056 {?}putrno:
U_1000:;
// 1057 {?} put sym(mode&7+'0')
PUTSYM((MODE & 7) + 48);
// 1058 {?} %return
return;
// 1059 {?}s(1): !AREG
case_S_1:;
// 1060 {?} %if mode >= framemode-dispmode %then put sym('F') %else put sym('A')
if (MODE < 168 - 40) goto L_0040;
PUTSYM(70);
goto L_0041;
L_0040:;
PUTSYM(65);
L_0041:;
// 1061 {?} -> putrno
goto U_1000;
// 1062 {?}s(4): !PRE
case_S_4:;
// 1063 {?} put sym('-')
PUTSYM(45);
// 1064 {?}s(2): !INDIRECT
case_S_2:;
// 1065 {?}ind:
U_1001:;
// 1066 {?} put sym('(')
PUTSYM(40);
// 1067 {?} interpret(mode&2_11000111+aregmode)
INTERPRET((MODE & 199) + 8);
// 1068 {?} put sym(')')
PUTSYM(41);
// 1069 {?} %return
return;
// 1070 {?}s(3): !POST
case_S_3:;
// 1071 {?} interpret(mode-8); !ind
INTERPRET(MODE - 8);
// 1072 {?} put sym('+')
PUTSYM(43);
// 1073 {?} %return
return;
// 1074 {?}s(5): !DISP
case_S_5:;
// 1075 {?} put num(i)
PUTNUM(I);
// 1076 {?} ->ind
goto U_1001;
// 1077 {?}s(6): !INDEX
case_S_6:;
// 1078 {?} put num(mite(i))
PUTNUM(MITE(I));
// 1079 {?} put sym('(')
PUTSYM(40);
// 1080 {?} interpret(mode+(aregmode-indexmode))
INTERPRET(MODE + (8 - 48));
// 1081 {?} put sym(',')
PUTSYM(44);
// 1082 {?} interpret(i>>12&15)
INTERPRET((unsigned int)I >> 12 & 15);
// 1083 {?} put sym('.')
PUTSYM(46);
// 1084 {?} %if i&16_800 = 0 %then put sym('W') %else put sym('L')
if (I & 2048 != 0) goto L_0042;
PUTSYM(87);
goto L_0043;
L_0042:;
PUTSYM(76);
L_0043:;
// 1085 {?} put sym(')')
PUTSYM(41);
// 1086 {?} %return
return;
// 1087 {?}s(7): !MISC
case_S_7:;
// 1088 {?} %if mode&63 = pcmode %start
if (MODE & 63 != 58) goto L_0044;
// 1089 {?} put num(i) %if mode = pcmode; !suppress if not explicit
if (MODE != 58) goto L_0045;
PUTNUM(I);
L_0045:;
// 1090 {?} put string("(PC)")
PUTSTRING(_imp_str_literal("(PC)"));
// 1091 {?} %return
return;
// 1092 {?} %finish
L_0044:;
// 1093 {?} %if mode <= absmode+1 %start
if (MODE > 56 + 1) goto L_0046;
// 1094 {?} put sym('$')
PUTSYM(36);
// 1095 {?} put hex(i>>16) %if mode = absmode+1 %or %not is short(i)=TRUE
if (MODE == 56 + 1) goto L_0047;
if (ISSHORT(I) == 1) goto L_0048;
L_0047:;
PUTHEX((unsigned int)I >> 16);
L_0048:;
// 1096 {?} %else
goto L_0049;
L_0046:;
// 1097 {?} put sym(hexsym(mode>>4&3))
PUTSYM(HEXSYM[(unsigned int)MODE >> 4 & 3]);
// 1098 {?} put sym(hexsym(mode&15))
PUTSYM(HEXSYM[MODE & 15]);
// 1099 {?} put sym('_')
PUTSYM(95);
// 1100 {?} %finish
L_0049:;
// 1101 {?} put hex(i)
PUTHEX(I);
// 1102 {?}%end
return;
case_S_dispatch:
if (S_index < 0 || S_index > 7)
_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 INTERPRET */
// 1103 {?}
// 1104 {?} %if v <= 0 %start; !literal
if (V > 0) goto L_004A;
// 1105 {?} v = litval(v)
V = LITVAL(V);
// 1106 {?} put sym('#')
PUTSYM(35);
// 1107 {?} %if is mite(v)=TRUE %then put num(v) %else %start
if (ISMITE(V) != 1) goto L_004B;
PUTNUM(V);
goto L_004C;
L_004B:;
// 1108 {?} put sym('$')
PUTSYM(36);
// 1109 {?} put hex(v>>16) %if v>>16 # 0
if ((unsigned int)V >> 16 == 0) goto L_004D;
PUTHEX((unsigned int)V >> 16);
L_004D:;
// 1110 {?} put hex(v&16_FFFF)
PUTHEX(V & 65535);
// 1111 {?} %finish
L_004C:;
// 1112 {?} %finish %else %if v <= prea7 %start; !register
goto L_004E;
L_004A:;
if (V > 40) goto L_004F;
// 1113 {?} interpret(v-d0)
INTERPRET(V - 1);
// 1114 {?} %finish %else %if v < dictlim %start; !identifier
goto L_004E;
L_004F:;
if (V >= DICTLIM) goto L_0050;
// 1115 {?} put ident(v,0)
PUTIDENT(V, 0);
// 1116 {?} %finish %else %if v < lablim %start; !internal label
goto L_004E;
L_0050:;
if (V >= LABLIM) goto L_0051;
// 1117 {?} put sym('L')
PUTSYM(76);
// 1118 {?} put num(v-dictlim)
PUTNUM(V - DICTLIM);
// 1119 {?} %else; !complex
goto L_004E;
L_0051:;
// 1120 {?} i = dict(v)_val
I = DICT[V].VAL;
// 1121 {?} interpret(dict(v)_mode)
INTERPRET(DICT[V].MODE);
// 1122 {?} %finish
L_004E:;
// 1123 {?}%end; !put operand
return;
} /* end of PUTOPERAND */
// 1124 {?}
// 1125 {?}%routine MARK AT(%integer col)
void MARKAT(int COL) {
// 1126 {?} put sym(' ') %while length(rep) < col; put sym('|')
L_0052:;
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP) >= COL) goto L_0053;
PUTSYM(32);
goto L_0052;
L_0053:;
PUTSYM(124);
// 1127 {?}%end
return;
} /* end of MARKAT */
// 1128 {?}!
// 1129 {?}%routine SHOW DICT(%integer from)
void SHOWDICT(int FROM) {
// 1130 {?}%integer i
int I;
// 1131 {?}%record(identinfo) d
struct IDENTINFO D;
// 1132 {?}%constbytearray flagsym(0:15) =
const unsigned char FLAGSYM[16] = {87, 82, 86, 65, 119, 114, 111, 109, 83, 84, 75, 63, 80, 112, 69, 42};
// 1133+ {?} 'W','R','V','A','w','r','o','m','S','T','K','?','P','p','E','*'
// 1134 {?}%constbytearray catsym(0:15) =
const unsigned char CATSYM[16] = {73, 67, 66, 69, 64, 88, 63, 63, 83, 65, 90, 63, 82, 70, 63, 63};
// 1135+ {?} 'I', 'C', 'B', 'E', '@', 'X', '?', '?',
// 1136+ {?} 'S', 'A', 'Z', '?', 'R', 'F', '?', '?'
// 1137 {?}
// 1138 {?} %return %if from >= dlim
if (FROM < DLIM) goto L_0054;
return;
L_0054:;
// 1139 !<<IMP
// 1140 {?} print line %if rep # ""
if (_imp_strcmp((_imp_string *)/*?*/ &REP, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) == 0) goto L_0055;
PRINTLINE();
L_0055:;
// 1141 {?} byteinteger(charlim) = 0
*_imp_BYTEINTEGER(CHARLIM) = 0;
// 1142 {?} spaces(6)
SPACES(6);
// 1143 {?} put string("___identifier____flags___type__link__par_mode___value____")
PUTSTRING(_imp_str_literal("___identifier____flags___type__link__par_mode___value____"));
// 1144 {?} print line
PRINTLINE();
// 1145 {?} %cycle
L_0056:;
// 1146 {?} put spnum(from); mark at(6)
PUTSPNUM(FROM);
MARKAT(6);
// 1147 {?} d = dict(from)
D = DICT[FROM];
// 1148 {?} put sym(' '); put ident(from,0)
PUTSYM(32);
PUTIDENT(FROM, 0);
// 1149 {?} %if d_text > 0 %start
if (D.TEXT <= 0) goto L_0057;
// 1150 {?} i = char0+d_text; i = i+byteinteger(i)+1
I = CHAR0 + D.TEXT;
I = I + *_imp_BYTEINTEGER(I) + 1;
// 1151 {?} %if byteinteger(i)&128 # 0 %start
if (*_imp_BYTEINTEGER(I) & 128 == 0) goto L_0058;
// 1152 {?} byteinteger(i) = byteinteger(i)-128
*_imp_BYTEINTEGER(I) = *_imp_BYTEINTEGER(I) - 128;
// 1153 {?} put sym(':'); put string(string(i))
PUTSYM(58);
PUTSTRING(
*({
__typeof__(_imp_string255) tmp = *_imp_STRING(I) /*q*/;
(_imp_string255 *)&tmp;
})
);
// 1154 {?} byteinteger(i) = byteinteger(i)+128
*_imp_BYTEINTEGER(I) = *_imp_BYTEINTEGER(I) + 128;
// 1155 {?} %finish
L_0058:;
// 1156 {?} %finish
L_0057:;
// 1157 {?} mark at(22)
MARKAT(22);
// 1158 {?} %if d_flags&typeid # 0 %then put sym(catsym(d_flags&cat)) %and i = 4 %c
if (D.FLAGS & 512 == 0) goto L_0059;
PUTSYM(CATSYM[D.FLAGS & 15]);
I = 4;
goto L_005A;
L_0059:;
PUTSYM(32);
I = 0;
L_005A:;
// 1159+ {?} %else put sym(' ') %and i = 0
// 1160 {?} %cycle
L_005B:;
// 1161 {?} put sym(flagsym(i)) %if d_flags>>i&1 # 0
if ((unsigned int)D.FLAGS >> I & 1 == 0) goto L_005C;
PUTSYM(FLAGSYM[I]);
L_005C:;
// 1162 {?} i = i+1
I = I + 1;
// 1163 {?} %repeat %until i > 15
if (I > 15) goto L_005D;
goto L_005B;
L_005D:;
// 1164 {?} mark at(30)
MARKAT(30);
// 1165 {?} put spnum(d_type); mark at(35)
PUTSPNUM(D.TYPE);
MARKAT(35);
// 1166 {?} put spnum(d_link); mark at(42)
PUTSPNUM(D.LINK);
MARKAT(42);
// 1167 {?} put spnum(d_reg); mark at(46)
PUTSPNUM(D.REG);
MARKAT(46);
// 1168 {?} put spnum(d_mode); mark at(51)
PUTSPNUM(D.MODE);
MARKAT(51);
// 1169 {?} put spnum(d_val); mark at(63)
PUTSPNUM(D.VAL);
MARKAT(63);
// 1170 {?} print line
PRINTLINE();
// 1171 {?} from = from+1
FROM = FROM + 1;
// 1172 {?} %repeat %until from = dlim
if (FROM == DLIM) goto L_005E;
goto L_0056;
L_005E:;
// 1173 {?} spaces(6)
SPACES(6);
// 1174 {?} put string("+-------------------------------------------------------+")
PUTSTRING(_imp_str_literal("+-------------------------------------------------------+"));
// 1175 {?} print line
PRINTLINE();
// 1176 !<<BOTH
// 1177 {?}%end
return;
} /* end of SHOWDICT */
// 1178 {?}%routine PUT MNEMONIC(%integer m)
void PUTMNEMONIC(int M) {
// 1179 {?} m = m<<2
M = M << 2;
// 1180 {?} %cycle
L_005F:;
// 1181 {?} put sym(m>>27+'A'-1)
PUTSYM(((unsigned int)M >> 27) + 65 - 1);
// 1182 {?} m = m<<5
M = M << 5;
// 1183 {?} %repeat %until m = 0
if (M == 0) goto L_0060;
goto L_005F;
L_0060:;
// 1184 {?}%end
return;
} /* end of PUTMNEMONIC */
auto void PUTOPCODE(int OP);
// 1185 {?}%routine%spec PUT OPCODE(%integer op)
// 1186 {?}%routine SHOW EXP(%integer startp)
void SHOWEXP(int STARTP) {
// 1187 {?}%integer p,q
int P;
int Q;
// 1188 {?}%record(identinfo)%name dp
struct IDENTINFO *DP;
// 1189 {?}
// 1190 %constinteger bopmax=51
// 1191 %constintegerarray EXTRA(32:bopmax) =
const int EXTRA[20] = {-736721293, -558838176, -1019632402, -756971917, -856095117, -414728192, -463841714,
-463989708, -892759040, -880488448, -383729664, -411844977, -669969024, -464402266,
-517820416, -414632912, -770618368, -871281664, -891158528, -655110494};
// 1192+ 'j'<<25+('a'&31)<<20+('m'&31)<<15+('a'&31)<<10+('s'&31)<<5+('s'&31),
// 1193+ 'o'<<25+('k'&31)<<20+('a'&31)<<15+('s'&31)<<10+('s'&31)<<5,
// 1194+ 'a'<<25+('s'&31)<<20+('s'&31)<<15+('i'&31)<<10+('g'&31)<<5+('n'&31),
// 1195+ 'i'<<25+('n'&31)<<20+('c'&31)<<15+('a'&31)<<10+('s'&31)<<5+('s'&31),
// 1196+ 'f'<<25+('o'&31)<<20+('r'&31)<<15+('a'&31)<<10+('s'&31)<<5+('s'&31),
// 1197+ 's'<<25+('t'&31)<<20+('o'&31)<<15+('p'&31)<<10,
// 1198+ 'r'<<25+('e'&31)<<20+('t'&31)<<15+('u'&31)<<10+('r'&31)<<5+('n'&31),
// 1199+ 'r'<<25+('e'&31)<<20+('p'&31)<<15+('e'&31)<<10+('a'&31)<<5+('t'&31),
// 1200+ 'e'<<25+('l'&31)<<20+('s'&31)<<15+('e'&31)<<10,
// 1201+ 'e'<<25+('x'&31)<<20+('i'&31)<<15+('t'&31)<<10,
// 1202+ 't'<<25+('r'&31)<<20+('a'&31)<<15+('p'&31)<<10,
// 1203+ 's'<<25+('w'&31)<<20+('g'&31)<<15+('o'&31)<<10+('t'&31)<<5+('o'&31),
// 1204+ 'l'<<25+('a'&31)<<20+('b'&31)<<15+('e'&31)<<10+('l'&31)<<5,
// 1205+ 'r'<<25+('e'&31)<<20+('c'&31)<<15+('r'&31)<<10+('e'&31)<<5+('f'&31),
// 1206+ 'p'<<25+('r'&31)<<20+('e'&31)<<15+('l'&31)<<10,
// 1207+ 's'<<25+('t'&31)<<20+('r'&31)<<15+('m'&31)<<10+('a'&31)<<5+('p'&31),
// 1208+ 'i'<<25+('a'&31)<<20+('b'&31)<<15+('s'&31)<<10,
// 1209+ 'f'<<25+('a'&31)<<20+('b'&31)<<15+('s'&31)<<10,
// 1210+ 'e'<<25+('n'&31)<<20+('d'&31)<<15,
// 1211+ 'l'<<25+('o'&31)<<20+('g'&31)<<15+('s'&31)<<10+('u'&31)<<5+('b'&31)
// 1212
// 1213 {?}%routine PUT OPRAND(%integer v)
void PUTOPRAND(int V) {
// 1214 {?} put sym('#') %and v = v-ad %if v >= explim
if (V < EXPLIM) goto L_0061;
PUTSYM(35);
V = V - 16384;
L_0061:;
// 1215 {?} %if v < np0 %then put operand(v) %else put num(v)
if (V >= NP0) goto L_0062;
PUTOPERAND(V);
goto L_0063;
L_0062:;
PUTNUM(V);
L_0063:;
// 1216 {?}%end
return;
} /* end of PUTOPRAND */
// 1217 {?} print line %if rep # ""
if (_imp_strcmp((_imp_string *)/*?*/ &REP, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) == 0) goto L_0064;
PRINTLINE();
L_0064:;
// 1218 {?} %return %unless np > np0
if (NP > NP0) goto L_0065;
return;
L_0065:;
// 1219 {?} put string(" ______action_______first_______second____")
PUTSTRING(_imp_str_literal(" ______action_______first_______second____"));
// 1220 {?} print line
PRINTLINE();
// 1221 {?} p = np0
P = NP0;
// 1222 {?} %cycle
L_0066:;
// 1223 {?} %if p = np %start
if (P != NP) goto L_0067;
// 1224 {?} p = explo
P = EXPLO;
// 1225 {?} %exit %if p >= oldexplo
if (P < OLDEXPLO) goto L_0068;
goto L_0069;
L_0068:;
// 1226 {?} put string(" |---------------------------------------|")
PUTSTRING(_imp_str_literal(" |---------------------------------------|"));
// 1227 {?} print line
PRINTLINE();
// 1228 {?} %finish
L_0067:;
// 1229 {?} %if p = startp %then put sym('>') %else put sym(' ')
if (P != STARTP) goto L_006A;
PUTSYM(62);
goto L_006B;
L_006A:;
PUTSYM(32);
L_006B:;
// 1230 {?} put num(p); mark at(6)
PUTNUM(P);
MARKAT(6);
// 1231 {?} dp == dict(p)
DP = (struct IDENTINFO *)/*?*/ &DICT[P];
// 1232 {?} put sym(' ')
PUTSYM(32);
// 1233 {?} q = dp_act
Q = DP->ACT;
// 1234 {?} %if q <= 31 %start
if (Q > 31) goto L_006C;
// 1235 {?} put opcode(q)
PUTOPCODE(Q);
// 1236 {?} %finish %else %if q <= bopmax %start
goto L_006D;
L_006C:;
if (Q > 51) goto L_006E;
// 1237 {?} put mnemonic(extra(q))
PUTMNEMONIC(EXTRA[Q - 32]);
// 1238 {?} %else
goto L_006D;
L_006E:;
// 1239 {?} put ident(q,0)
PUTIDENT(Q, 0);
// 1240 {?} %finish
L_006D:;
// 1241 {?} mark at(22)
MARKAT(22);
// 1242 {?} put sym(' '); put oprand(dp_x); mark at(34)
PUTSYM(32);
PUTOPRAND(DP->X);
MARKAT(34);
// 1243 {?} put sym(' '); put oprand(dp_y); mark at(46)
PUTSYM(32);
PUTOPRAND(DP->Y);
MARKAT(46);
// 1244 {?} %if p >= explo %start
if (P < EXPLO) goto L_006F;
// 1245 {?} put spnum(dp_type)
PUTSPNUM(DP->TYPE);
// 1246 {?} put sym('*') %if dp_flags < 0
if (DP->FLAGS >= 0) goto L_0070;
PUTSYM(42);
L_0070:;
// 1247 {?} %finish
L_006F:;
// 1248 {?} print line
PRINTLINE();
// 1249 {?} p = p+1
P = P + 1;
// 1250 {?} %repeat %until p >= oldexplo
if (P >= OLDEXPLO) goto L_0069;
goto L_0066;
L_0069:;
// 1251 {?} oldexplo = explo
OLDEXPLO = EXPLO;
// 1252 {?} put string(" +---------------------------------------+")
PUTSTRING(_imp_str_literal(" +---------------------------------------+"));
// 1253 {?} print line
PRINTLINE();
// 1254 {?}%end
return;
} /* end of SHOWEXP */
// 1255 {?}!
// 1256 !
// 1257 !!!!!!!!!!!!!!!!!!!!!!!!!!!! Fault reporting !!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1258 !
// 1259 %routine CROAK(%string(255) s)
void CROAK(_imp_string255 S) {
// 1260 select output(0)
_imp_SELECTOUTPUT(0);
// 1261 put string("** "); put string(s)
PUTSTRING(_imp_str_literal("** "));
PUTSTRING(
*({
__typeof__(_imp_string255) tmp = S /*q*/;
(_imp_string255 *)&tmp;
})
);
// 1262 put string(". Compilation abandoned at line "); put num(line)
PUTSTRING(_imp_str_literal(". Compilation abandoned at line "));
PUTNUM(LINE);
// 1263 print line
PRINTLINE();
// 1264 %signal abandon
_imp_signal(14, 0, 0, "");
// 1265 %end
return;
} /* end of CROAK */
// 1266
// 1267 !<<IMP
// 1268
// 1269 !! Fault numbers
// 1270 %constinteger INTERNERR=1, PLEXERR=2, CREACHERR=3, REACHERR=4
// 1271 %constinteger NORESULT=5, DREACHERR=6
// 1272 %constinteger FORMERR=7, ATOMERR=8, NAMERR=9, CLASSERR=10
// 1273 %constinteger SIZERR=11, TYPERR=12, BOUNDSERR=13, UNENDING=14
// 1274 %constinteger LOWLEVEL=15, ACCESSERR=16, NOTINLOOP=17, NOTINROUT=18
// 1275 %constinteger NOTINFUN=19, NOTINPRED=20, DUPERR=21
// 1276 %constinteger ORDERERR=22, MATCHERR=23, RANGERR=24, NONLITERAL=25
// 1277 %constinteger MOPERR=26, NOCYCLE=27
// 1278 %constinteger NOSTART=28, NOIF=29, ILLSTARRED=30, NONSTARTER=31
// 1279 %constinteger NONVAR=32, NONREF=33, TOOFEW=34, TOOMANY=35
// 1280 %constinteger NOBEGIN=36, DUBIOUS=37, NOTINBLOCK=38
// 1281 %constinteger NONSTAND=39, NOTIN=40, ASSERR=41
// 1282 %constinteger NOEND=42, NOFINISH=43, NOREPEAT=44
// 1283 %constinteger COUNTERR=45, SLABMISSING=46, IDMISSING=47
// 1284 %constinteger POINT=64, WARN=-128, NOW=128
// 1285 !
// 1286 %routine REPORT(%integer n,id,num)
void REPORT(int N, int ID, int NUM) {
// 1287 %owninteger lastchange=0
static int LASTCHANGE = 0;
// 1288 %integer mark,start,errline
int MARK;
int START;
int ERRLINE;
// 1289
// 1290 %routine PRINT TEXT(%integer stream)
void PRINTTEXT(int STREAM) {
// 1291 %constinteger esc=27
// 1292 %integer k,p
int K;
int P;
// 1293
// 1294 %conststring(15)%array MESSAGE(1:44) =
const _imp_string15 MESSAGE[44] = {
_imp_str_init("Internal error "), _imp_str_init("Reg not free"), _imp_str_init("Out of reach "),
_imp_str_init(" out of reach!"), _imp_str_init("RESULT missing"), _imp_str_init("Out of reach"),
_imp_str_init("Faulty form"), _imp_str_init("Unknown atom"), _imp_str_init("Unknown name"),
_imp_str_init("Wrong class"), _imp_str_init("Wrong size"), _imp_str_init("Wrong type"),
_imp_str_init("Inside out"), _imp_str_init("Endless loop"), _imp_str_init("Low level"),
_imp_str_init("Not accessible"), _imp_str_init("Not in loop"), _imp_str_init("Not in routine"),
_imp_str_init("Not in fn/map"), _imp_str_init("Not in pred"), _imp_str_init("Duplicate"),
_imp_str_init("Out of order"), _imp_str_init("Mismatch"), _imp_str_init("Out of range"),
_imp_str_init("Not literal"), _imp_str_init("Faulty operand"), _imp_str_init("%CYCLE missing"),
_imp_str_init("%START missing"), _imp_str_init("Extra %ELSE"), _imp_str_init("Ill-starred"),
_imp_str_init("Non-starter"), _imp_str_init("Not variable"), _imp_str_init("Not reference"),
_imp_str_init("Too few args"), _imp_str_init("Too many args"), _imp_str_init("%BEGIN missing"),
_imp_str_init("Dubious usage"), _imp_str_init("Not in block"), _imp_str_init("Nonstandard "),
_imp_str_init("Not supported"), _imp_str_init(" void"), _imp_str_init("%END missing"),
_imp_str_init("%FINISH missing"), _imp_str_init("%REPEAT missing")};
// 1295+ "Internal error ", "Reg not free",
// 1296+ "Out of reach ", " out of reach!",
// 1297+ "RESULT missing", "Out of reach",
// 1298+ "Faulty form", "Unknown atom",
// 1299+ "Unknown name", "Wrong class",
// 1300+ "Wrong size", "Wrong type",
// 1301+ "Inside out", "Endless loop",
// 1302+ "Low level", "Not accessible",
// 1303+ "Not in loop", "Not in routine",
// 1304+ "Not in fn/map", "Not in pred",
// 1305+ "Duplicate",
// 1306+ "Out of order", "Mismatch",
// 1307+ "Out of range", "Not literal",
// 1308+ "Faulty operand", "%CYCLE missing",
// 1309+ "%START missing", "Extra %ELSE",
// 1310+ "Ill-starred", "Non-starter",
// 1311+ "Not variable", "Not reference",
// 1312+ "Too few args", "Too many args",
// 1313+ "%BEGIN missing",
// 1314+ "Dubious usage", "Not in block",
// 1315+ "Nonstandard ", "Not supported",
// 1316+ " void",
// 1317+ "%END missing",
// 1318+ "%FINISH missing", "%REPEAT missing"
// 1319
// 1320 !<<BOTH
// 1321
// 1322 put sym(mark)
PUTSYM(MARK);
// 1323 put sym(' ') %if errline < 1000
if (ERRLINE >= 1000) goto L_0071;
PUTSYM(32);
L_0071:;
// 1324 put sym(' ') %if errline < 100
if (ERRLINE >= 100) goto L_0072;
PUTSYM(32);
L_0072:;
// 1325 put sym(' ') %if errline < 10
if (ERRLINE >= 10) goto L_0073;
PUTSYM(32);
L_0073:;
// 1326 put num(errline)
PUTNUM(ERRLINE);
// 1327 put sym(listflag); put sym(' ')
PUTSYM(LISTFLAG);
PUTSYM(32);
// 1328 k = n&63
K = N & 63;
// 1329 %if k >= counterr %start
if (K < 45) goto L_0074;
// 1330 %if k = counterr %start
if (K != 45) goto L_0075;
// 1331 %if num < 0 %start
if (NUM >= 0) goto L_0076;
// 1332 put num(-num); put string(" extra")
PUTNUM(-NUM);
PUTSTRING(_imp_str_literal(" extra"));
// 1333 %else
goto L_0077;
L_0076:;
// 1334 put num(num) %if num # 0; put string(" missing")
if (NUM == 0) goto L_0078;
PUTNUM(NUM);
L_0078:;
PUTSTRING(_imp_str_literal(" missing"));
// 1335 %finish
L_0077:;
// 1336 put string(" value(s) for ")
PUTSTRING(_imp_str_literal(" value(s) for "));
// 1337 put ident(id,0)
PUTIDENT(ID, 0);
// 1338 %return
return;
// 1339 %finish
L_0075:;
// 1340 %if k # slabmissing %start
if (K == 46) goto L_0079;
// 1341 put ident(id,1)
PUTIDENT(ID, 1);
// 1342 %else
goto L_007A;
L_0079:;
// 1343 put ident(id,0)
PUTIDENT(ID, 0);
// 1344 put sym('('); put num(num); put sym(')')
PUTSYM(40);
PUTNUM(NUM);
PUTSYM(41);
// 1345 %finish
L_007A:;
// 1346 put string(" missing")
PUTSTRING(_imp_str_literal(" missing"));
// 1347 mend:
U_1002:;
// 1348 %if c_dpid_text # 0 %start
if (C.DPID->TEXT == 0) goto L_007B;
// 1349 put string(" in ")
PUTSTRING(_imp_str_literal(" in "));
// 1350 put ident(c_pid,-1)
PUTIDENT(C.PID, -1);
// 1351 %finish
L_007B:;
// 1352 %return
return;
// 1353 %finish
L_0074:;
// 1354 put ident(id,0) %if id > 0
if (ID <= 0) goto L_007C;
PUTIDENT(ID, 0);
L_007C:;
// 1355 put string(message(k))
PUTSTRING(
*({
__typeof__(_imp_string15) tmp = MESSAGE[K - 1] /*q*/;
(_imp_string255 *)&tmp;
})
);
// 1356 put num(num) %if num > 0
if (NUM <= 0) goto L_007D;
PUTNUM(NUM);
L_007D:;
// 1357 -> mend %if creacherr <= k <= noresult
{
// Double-sided test on K (Part I)
int tmp;
if (3 > (tmp = K)) goto L_007E;
// Double-sided test on K (Part II)
if (tmp > 5) goto L_007E;
}
goto U_1002;
L_007E:;
// 1358 spaces(22-length(rep))
SPACES(22 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP));
// 1359 p = start
P = START;
// 1360 p = p+1 %while byteinteger(p) = ' '
L_007F:;
if (*_imp_BYTEINTEGER(P) != 32) goto L_0080;
P = P + 1;
goto L_007F;
L_0080:;
// 1361 %if p < faultp-50 %then p = faultp-47 %and put string("...") %c
if (P >= FAULTP - 50) goto L_0081;
P = FAULTP - 47;
PUTSTRING(_imp_str_literal("..."));
goto L_0082;
L_0081:;
PUTSYM(32);
L_0082:;
// 1362+ %else put sym(' ')
// 1363 %cycle
L_0083:;
// 1364 k = byteintegeR(p); p = p+1
K = *_imp_BYTEINTEGER(P);
P = P + 1;
// 1365 %if p = faultp %start
if (P != FAULTP) goto L_0084;
// 1366 ! %if stream # 0 %then put sym('|') %else %start
// 1367 ! !**V200**
// 1368 ! put sym(esc); put sym('F'); !graphics
// 1369 ! put sym('~')
// 1370 ! put sym(esc); put sym('G'); !normal
// 1371 ! %finish
// 1372 put sym('|')
PUTSYM(124);
// 1373 %finish
L_0084:;
// 1374 %exit %if k = nl
if (K != 10) goto L_0085;
goto L_0086;
L_0085:;
// 1375 put sym(k)
PUTSYM(K);
// 1376 ! %if ' ' <= k <= '~' %then put sym(k) %c
// 1377 ! %else put sym('[') %and put num(k) %and put sym(']')
// 1378 %repeat
goto L_0083;
L_0086:;
// 1379 %return
return;
// 1380 %end
} /* end of PRINTTEXT */
// ?ESC unused
// ?STREAM unused
// 1381
// 1382 !Warning or error
// 1383 mark = '?'
MARK = 63;
// 1384 %if n > 0 %start
if (N <= 0) goto L_0087;
// 1385 mark = '*'
MARK = 42;
// 1386 c_faults = c_faults+1; faults = faults+1
C.FAULTS = C.FAULTS + 1;
FAULTS = FAULTS + 1;
// 1387 %finish
L_0087:;
// 1388 faultnum = 0; c_access = -1
FAULTNUM = 0;
C.ACCESS = -1;
// 1389 !Ignore uncorrected earlier error
// 1390 %return %if file(main)_start1 <= fp < lastchange
{
// Double-sided test on FP (Part I)
int tmp;
if (FILE[0].START1 > (tmp = FP)) goto L_0088;
// Double-sided test on FP (Part II)
if (tmp >= LASTCHANGE) goto L_0088;
}
return;
L_0088:;
// 1391 !Establish what to print
// 1392 start = linestart; errline = line
START = LINESTART;
ERRLINE = LINE;
// 1393 %if n&point = 0 %start
if (N & 64 != 0) goto L_0089;
// 1394 faultp = 0; !no pointing
FAULTP = 0;
// 1395 %else
goto L_008A;
L_0089:;
// 1396 %while start >= faultp %cycle; !before current line
L_008B:;
if (START < FAULTP) goto L_008C;
// 1397 start = start-1
START = START - 1;
// 1398 errline = errline-1 %if byteintegeR(start) = nl
if (*_imp_BYTEINTEGER(START) != 10) goto L_008D;
ERRLINE = ERRLINE - 1;
L_008D:;
// 1399 %repeat
goto L_008B;
L_008C:;
// 1400 start = start-1 %while start # curstart %and byteintegeR(start-1) # nl
L_008E:;
if (START == CURSTART) goto L_008F;
if (*_imp_BYTEINTEGER(START - 1) == 10) goto L_008F;
START = START - 1;
goto L_008E;
L_008F:;
// 1401 %finish
L_008A:;
// 1402 time1 = time1-cputime
TIME1 = TIME1 - CPUTIME;
// 1403 %if listout # 0 %start; !listing file
if (LISTOUT == 0) goto L_0090;
// 1404 print text(listout); print line
PRINTTEXT(LISTOUT);
PRINTLINE();
// 1405 %finish
L_0090:;
// 1406 select output(0)
_imp_SELECTOUTPUT(0);
// 1407 %if curfile # lastfile %start
if (CURFILE == LASTFILE) goto L_0091;
// 1408 lastfile = curfile; put string(cur_name); print line
LASTFILE = CURFILE;
PUTSTRING(
*({
__typeof__(_imp_string255) tmp = CUR->NAME /*q*/;
(_imp_string255 *)&tmp;
})
);
PRINTLINE();
// 1409 %finish
L_0091:;
// 1410 print text(0)
PRINTTEXT(0);
// 1411 %if n > reacherr %and curfile = main %and control&editbit # 0 %start
if (N <= 4) goto L_0092;
if (CURFILE != 1) goto L_0092;
if (CONTROL & 8192 == 0) goto L_0092;
// 1412 start = faultp-1 %if faultp > start
if (FAULTP <= START) goto L_0093;
START = FAULTP - 1;
L_0093:;
// 1413 cur_fp = start; cur_line = line
CUR->FP = START;
CUR->LINE = LINE;
// 1414 cur_change = 16_7FFFFFFE %if lastchange # 0
if (LASTCHANGE == 0) goto L_0094;
CUR->CHANGE = 2147483646;
L_0094:;
// 1415 select input(0)
_imp_SELECTINPUT(0);
// 1416 file(main+1) = 0
FILE[1 + 1 - 1] = (struct EDFILE){0};
// 1417 !! edi(file(main),file(main+1),rep); !main+1 to keep editor happy
// 1418 rep = ""
_imp_strncpy(/*?*/ &REP, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 255);
// 1419 select output(listout)
_imp_SELECTOUTPUT(LISTOUT);
// 1420 time1 = time1+cputime
TIME1 = TIME1 + CPUTIME;
// 1421 %signal abandon %if cur_flag < 0 {abandoned}
if (CUR->FLAG >= 0) goto L_0095;
_imp_signal(14, 0, 0, "");
L_0095:;
// 1422 control = control&(\editbit) %if cur_flag = 'I'
if (CUR->FLAG != 73) goto L_0096;
CONTROL = CONTROL & (~8192);
L_0096:;
// 1423 lastchange = cur_change %and %signal redo %if cur_change < 16_7FFFFFFE
if (CUR->CHANGE >= 2147483646) goto L_0097;
LASTCHANGE = CUR->CHANGE;
_imp_signal(13, 0, 0, "");
L_0097:;
// 1424 %else
goto L_0098;
L_0092:;
// 1425 print line
PRINTLINE();
// 1426 select output(listout)
_imp_SELECTOUTPUT(LISTOUT);
// 1427 time1 = time1+cputime
TIME1 = TIME1 + CPUTIME;
// 1428 %finish
L_0098:;
// 1429 %end; !report
return;
} /* end of REPORT */
// 1430
// 1431 %routine FAULT(%integer n)
void FAULT(int N) {
// 1432 !Note fault number and position of (earliest) fault
// 1433 ! for subsequent reporting (warnings and weak errors)
// 1434 %if faultnum = 0 %or (n > 0 %and faultnum < 0) %start
if (FAULTNUM == 0) goto L_0011;
if (N <= 0) goto L_0099;
if (FAULTNUM >= 0) goto L_0099;
L_0011:;
// 1435 faultnum = n; faultp = atomp
FAULTNUM = N;
FAULTP = ATOMP;
// 1436 report(faultnum&127,0,0) %if faultnum >= now
if (FAULTNUM < 128) goto L_009A;
REPORT(FAULTNUM & 127, 0, 0);
L_009A:;
// 1437 %finish
L_0099:;
// 1438 %end
return;
} /* end of FAULT */
// 1439
// 1440 %routine INTERN(%integer n)
void INTERN(int N) {
// 1441 report(internerr,0,n)
REPORT(1, 0, N);
// 1442 %end
return;
} /* end of INTERN */
// 1443
// 1444 !!!!!!!!!!!!!!!!!!!! CELL CONSTRUCTORS !!!!!!!!!!!!!!!!!!!
// 1445 !
// 1446 %integer%fn LITREF(%integer v)
int LITREF(int V) {
// 1447 %integer i
int I;
// 1448 %result = v %if v = 0
if (V != 0) goto L_009B;
return V;
L_009B:;
// 1449 %if v > 0 %start
if (V <= 0) goto L_009C;
// 1450 %result = -(v<<1) %if v <= smallmax
if (V > 1023) goto L_009D;
return -(V << 1);
L_009D:;
// 1451 %else
goto L_009E;
L_009C:;
// 1452 %result = v<<1+1 %if v >= smallmin
if (V < -1024) goto L_009F;
return (V << 1) + 1;
L_009F:;
// 1453 %finish
L_009E:;
// 1454 litstore(litpos) = v
LITSTORE[LITPOS + 2247] = V;
// 1455 i = litmin-1
I = (-2247) - 1;
// 1456 i = i+1 %until litstore(i) = v
L_00A0:;
I = I + 1;
if (LITSTORE[I + 2247] == V) goto L_00A1;
goto L_00A0;
L_00A1:;
// 1457 %if i = litpos %start
if (I != LITPOS) goto L_00A2;
// 1458 litpos = litpos+1
LITPOS = LITPOS + 1;
// 1459 croak("Too many literals") %if litpos >= litmax
if (LITPOS < -2048) goto L_00A3;
CROAK(_imp_str_literal("Too many literals"));
L_00A3:;
// 1460 %finish
L_00A2:;
// 1461 %result = i
return I;
// 1462 %end
} /* end of LITREF */
// 1463 !
// 1464 %routine PUTEXP(%integer act,x,y,t)
void PUTEXP(int ACT, int X, int Y, int T) {
// 1465 type = t
TYPE = T;
// 1466 item = explim
ITEM = EXPLIM;
// 1467 item = x %if explo <= x < item
{
// Double-sided test on X (Part I)
int tmp;
if (EXPLO > (tmp = X)) goto L_00A4;
// Double-sided test on X (Part II)
if (tmp >= ITEM) goto L_00A4;
}
ITEM = X;
L_00A4:;
// 1468 item = y %if explo <= y < item
{
// Double-sided test on Y (Part I)
int tmp;
if (EXPLO > (tmp = Y)) goto L_00A5;
// Double-sided test on Y (Part II)
if (tmp >= ITEM) goto L_00A5;
}
ITEM = Y;
L_00A5:;
// 1469 %cycle
L_00A6:;
// 1470 item = item-1
ITEM = ITEM - 1;
// 1471 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM];
// 1472 %if item < explo %start
if (ITEM >= EXPLO) goto L_00A7;
// 1473 explo = item
EXPLO = ITEM;
// 1474 ditem_act = act; ditem_x = x; ditem_y = y
DITEM->ACT = ACT;
DITEM->X = X;
DITEM->Y = Y;
// 1475 ditem_flags = 0; ditem_type = t; ditem_mode = 0
DITEM->FLAGS = 0;
DITEM->TYPE = T;
DITEM->MODE = 0;
// 1476 %exit
goto L_00A8;
// 1477 %finish
L_00A7:;
// 1478 %repeat %until ditem_act = act %and ditem_x = x %and ditem_y = y
if (DITEM->ACT != ACT) goto L_00A9;
if (DITEM->X != X) goto L_00A9;
if (DITEM->Y == Y) goto L_00A8;
L_00A9:;
goto L_00A6;
L_00A8:;
// 1479 %end
return;
} /* end of PUTEXP */
// 1480
// 1481 !$IF VAX
// 1482 {%integer%fn IEEE(%integer v)
// 1483 { %result = 0 %if v = 0
// 1484 { %result = v<<16+v>>16-16_01000000
// 1485 {%end
// 1486 !$FINISH
// 1487
// 1488 %routine PUTEXP2(%integer op,first,t)
void PUTEXP2(int OP, int FIRST, int T) {
// 1489 %if item = 0 %start
if (ITEM != 0) goto L_00AA;
// 1490 !$IF VAX
// 1491 { value = ieee(value) %if type = realtype; !vax->ieee
// 1492 !$FINISH
// 1493 item = litref(value)
ITEM = LITREF(VALUE);
// 1494 %finish
L_00AA:;
// 1495 putexp(op,first,item,t)
PUTEXP(OP, FIRST, ITEM, T);
// 1496 %end
return;
} /* end of PUTEXP2 */
// 1497
// 1498 %integer%fn NORMITEM
int NORMITEM(void) {
// 1499 %result = item %if item # 0
if (ITEM == 0) goto L_00AB;
return ITEM;
L_00AB:;
// 1500 !$IF VAX
// 1501 { value = ieee(value) %if type = realtype; !vax->ieee
// 1502 !$FINISH
// 1503 %result = litref(value)
return LITREF(VALUE);
// 1504 %end
} /* end of NORMITEM */
// 1505
// 1506 %routine TOREAL
void TOREAL(void) {
// 1507 %if item # 0 %then putexp(float,item,0,realtype) %c
if (ITEM == 0) goto L_00AC;
PUTEXP(95, ITEM, 0, 69);
goto L_00AD;
L_00AC:;
*_imp_REAL(_imp_ADDR(/*?*/ &VALUE)) = VALUE;
TYPE = 69;
L_00AD:;
// 1508+ %else real(addr(value)) = value %and type = realtype
// 1509 %end
return;
} /* end of TOREAL */
// 1510
// 1511 %integer%fn TEMP(%integer m,v)
int TEMP(int M, int V) {
// 1512 dtemp_mode = m; dtemp_val = v
DTEMP->MODE = M;
DTEMP->VAL = V;
// 1513 %result = lablim
return LABLIM;
// 1514 %end
} /* end of TEMP */
// 1515 %integer%fn TEMPX(%integer r1,r2)
int TEMPX(int R1, int R2) {
// 1516 dtemp_mode = r1+(indexmode-a0); dtemp_val = (r2-d0)<<12+16_0800
DTEMP->MODE = R1 + (48 - 9);
DTEMP->VAL = (R2 - 1 << 12) + 2048;
// 1517 %result = lablim
return LABLIM;
// 1518 %end
} /* end of TEMPX */
// 1519 %integer%fn TEMPD(%integer a,disp)
int TEMPD(int A, int DISP) {
// 1520 dtemp_mode = a+(dispmode-a0); dtemp_val = disp
DTEMP->MODE = A + (40 - 9);
DTEMP->VAL = DISP;
// 1521 %result = lablim
return LABLIM;
// 1522 %end
} /* end of TEMPD */
// 1523 %integer%fn TEMPX2(%integer r1,r2)
int TEMPX2(int R1, int R2) {
// 1524 dtemp2_mode = r1+(indexmode-a0); dtemp2_val = (r2-d0)<<12+16_0800
DTEMP2->MODE = R1 + (48 - 9);
DTEMP2->VAL = (R2 - 1 << 12) + 2048;
// 1525 %result = lablim+1
return LABLIM + 1;
// 1526 %end
} /* end of TEMPX2 */
// 1527
// 1528 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1529 !!!!!!!!!!!!!!!!! CODE GENERATION !!!!!!!!!!!!!!!!!!!!!!!!
// 1530 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 1531 !
// 1532 ! The array DEF contains packed mnemonics for M68000 machine
// 1533 ! instructions and, for each mnemonic, the basic opcode and
// 1534 ! a type indicator.
// 1535 ! The type indicator contains flag bits for various special cases
// 1536 ! and two 6-bit fields defining the operand types
// 1537 ! [should be const record array]
// 1538 ! The mnemonics and variant distinctions broadly follow the
// 1539 ! manufacturer's Assembly Language conventions
// 1540 !
// 1541 ! Opcode index values needed globally:-
// 1542 %constinteger LEA=78, PEA=55, CLR=52, DBRA=81, JSR=56,
// 1543+ LINK=72, UNLK=73, RTS=68,
// 1544+ MOVEM=100, TRAPI=101, DC=102
// 1545
// 1546 !Machine-code operand types
// 1547 ![EA needs to be further distinguished]
// 1548 %constinteger SHIFT=32
// 1549 %constinteger REG=1, AREG=2, IREG=3, QUICK=4, MQUICK=5
// 1550 %constinteger EA=6, RWEA=7, WEA=8
// 1551 %constinteger IMM=9, TQUICK=10, REL=11, LONGREL=12
// 1552 %constinteger QREG=13, POSTAREG=14, QEA=15
// 1553 %constinteger REVEA=16, XIMM=17, DATA=18, PREAREG=19, QPRE=20
// 1554 %constinteger EXREG=21+shift
// 1555 %constinteger REG9=reg+shift, QREG9=qreg+shift, IREG9=ireg+shift,
// 1556+ POSTAREG9=postareg+shift,
// 1557+ QUICK9=quick+shift, AREG9=areg+shift
// 1558 %constinteger SIZED=1<<15, ASIZED=1<<14; !2 spare bits
// 1559 %constinteger REVERSIBLE=revea<<6+reg9+sized, MULTIPLE=ximm<<6+ea+asized
// 1560 %constinteger DEFMAX=129
// 1561 %constintegerarray DEF(0:defmax+defmax) =
const int DEF[259] = {
0, 33192, -621079552, -805272543, -1035862016, -1879014367, -414121984, -1342144095,
-958922752, -1073707999, -1025376256, -2147449823, -551550976, -1325365177, -889651200, 1174437895,
-587595776, 1140883463, -598507520, -519533759, -650772480, -536310975, -650575872, -1044381279,
-615101440, -2118123103, -929346560, -1061158495, -615099392, -2134900319, -929344512, 1610612747,
-987725824, 1627389963, -986120192, 1644167179, -997949440, 1660944395, -993427456, 1677721611,
-1003388928, 1694498827, -1002864640, 1711276043, -991789056, 1728053259, -1000833024, 1744830475,
-983465984, 1761607691, -982941696, 1778384907, -989462528, 1795162123, -992706560, 1811939339,
-999129088, 1828716555, -993394688, 1845493771, -998637568, 1862270987, -993886208, -520058047,
-1019871232, -536835263, -1019674624, -518485183, -453640192, -535262399, -453443584, 1879048545,
-621079008, 1342212359, -1035844608, 1358989575, -414104576, 809517474, -621079520, -792706654,
-1035860992, -1866448478, -414120960, -1329577566, -958921728, -1324874834, -958909440, 100696647,
-1035852800, 67142215, -414112768, 201359942, -958913536, 33587783, -1025367040, 33351,
-551256064, 167805511, -889641984, -519009471, -453234688, -535786687, -453228544, 1107329032,
-959905792, 1073774599, -598482944, 1207959559, -601780224, 1212153862, -531595264, 1317011462,
-717684736, 1321205766, -724041728, 1254096903, -400982016, 1241546758, -382074880, -1056963295,
-1037987840, -2130705119, -434008064, -788495071, -1035837440, -1862236895, -414097408, 1316028416,
-587726848, 1315962880, -463890816, 1316159488, -448626688, 1316421632, -448200704, 1316290560,
-448167936, 1316093961, -414728192, 1316356096, -383728960, 1312817162, -383729664, 1313866306,
-661181440, 1314390018, -354014208, 1212153857, -412041216, 1216348161, -880124928, 1220542465,
-880136192, -1052766911, -880574464, 1103102946, -665812992, 1098908065, -964329472, 1355284556,
-936615936, 1372061772, -936836096, 1388838988, -937155584, 1405616204, -937014272, 1422393420,
-937325568, 1439170636, -937309184, 1455947852, -936963072, 1472725068, -937245696, 1489502284,
-936702976, 1506279500, -936686592, 1523056716, -936890368, 1539833932, -936991744, 1556611148,
-937192448, 1573388364, -937013248, 1590165580, -937177088, 1606942796, -937028608, 20973767,
-1003217920, 25168072, -1003075584, 29362376, -986525696, 16779462, -985018368, 1216365638,
-621079136, 1312817738, -383729376, 18, -936378368, 1354760200, -415236096, 1371537416,
-429916160, 1388314632, -427524096, 1405091848, -423002112, 1421869064, -432963584, 1438646280,
-432439296, 1455423496, -421363712, 1472200712, -430407680, 1488977928, -413040640, 1505755144,
-412516352, 1522532360, -419037184, 1539309576, -422281216, 1556086792, -428703744, 1572864008,
-422969344, 1589641224, -428212224, 1606418440, -423460864, 1153433984, -616460736, 1186988416,
-615921664, 1086324744, -630601728, 1314914306, -615854592, 1315438594, -630534656, 37486601,
-1019113920, 41680905, -1018574848, 171704329, -884896192, 175898633, -884357120, 3932169,
-549351872, 8126473, -548812800};
// 1562+ 0,
// 1563+ {MOVE} 16_0000<<16+ ea<<6+wea+shift +sized,
// 1564+ 'm'<<25+('o'&31)<<20+('v'&31)<<15+('e'&31)<<10,
// 1565+ {ADD} 16_D000<<16+ reversible,
// 1566+ 'a'<<25+('d'&31)<<20+('d'&31)<<15,
// 1567+ {SUB} 16_9000<<16+ reversible,
// 1568+ 's'<<25+('u'&31)<<20+('b'&31)<<15,
// 1569+ {CMP} 16_B000<<16+ ea<<6+reg9 +sized,
// 1570+ 'c'<<25+('m'&31)<<20+('p'&31)<<15,
// 1571+ {AND} 16_C000<<16+ reversible,
// 1572+ 'a'<<25+('n'&31)<<20+('d'&31)<<15,
// 1573+ {OR} 16_8000<<16+ reversible,
// 1574+ 'o'<<25+('r'&31)<<20,
// 1575+ {EOR} 16_B100<<16+ reg9<<6+rwea +sized,
// 1576+ 'e'<<25+('o'&31)<<20+('r'&31)<<15,
// 1577+ {NOT} 16_4600<<16+ rwea +sized,
// 1578+ 'n'<<25+('o'&31)<<20+('t'&31)<<15,
// 1579+ {NEG} 16_4400<<16+ rwea +sized,
// 1580+ 'n'<<25+('e'&31)<<20+('g'&31)<<15,
// 1581+ {LSL} 16_E108<<16+ qreg9<<6+reg +sized,
// 1582+ 'l'<<25+('s'&31)<<20+('l'&31)<<15,
// 1583+ {LSR} 16_E008<<16+ qreg9<<6+reg +sized,
// 1584+ 'l'<<25+('s'&31)<<20+('r'&31)<<15,
// 1585+ {MULS} 16_C1C0<<16+ ea<<6+reg9,
// 1586+ 'm'<<25+('u'&31)<<20+('l'&31)<<15+('s'&31)<<10,
// 1587+ {DIVS} 16_81C0<<16+ ea<<6+reg9,
// 1588+ 'd'<<25+('i'&31)<<20+('v'&31)<<15+('s'&31)<<10,
// 1589+ {MULU} 16_C0C0<<16+ ea<<6+reg9,
// 1590+ 'm'<<25+('u'&31)<<20+('l'&31)<<15+('u'&31)<<10,
// 1591+ {DIVU} 16_80C0<<16+ ea<<6+reg9,
// 1592+ 'd'<<25+('i'&31)<<20+('v'&31)<<15+('u'&31)<<10,
// 1593+ {BRA} 16_6000<<16+ rel,
// 1594+ 'b'<<25+('r'&31)<<20+('a'&31)<<15,
// 1595+ {BSR} 16_6100<<16+ rel,
// 1596+ 'b'<<25+('s'&31)<<20+('r'&31)<<15,
// 1597+ {BHI} 16_6200<<16+ rel,
// 1598+ 'b'<<25+('h'&31)<<20+('i'&31)<<15,
// 1599+ {BLS} 16_6300<<16+ rel,
// 1600+ 'b'<<25+('l'&31)<<20+('s'&31)<<15,
// 1601+ {BCC} 16_6400<<16+ rel,
// 1602+ 'b'<<25+('c'&31)<<20+('c'&31)<<15,
// 1603+ {BCS} 16_6500<<16+ rel,
// 1604+ 'b'<<25+('c'&31)<<20+('s'&31)<<15,
// 1605+ {BNE} 16_6600<<16+ rel,
// 1606+ 'b'<<25+('n'&31)<<20+('e'&31)<<15,
// 1607+ {BEQ} 16_6700<<16+ rel,
// 1608+ 'b'<<25+('e'&31)<<20+('q'&31)<<15,
// 1609+ {BVC} 16_6800<<16+ rel,
// 1610+ 'b'<<25+('v'&31)<<20+('c'&31)<<15,
// 1611+ {BVS} 16_6900<<16+ rel,
// 1612+ 'b'<<25+('v'&31)<<20+('s'&31)<<15,
// 1613+ {BPL} 16_6A00<<16+ rel,
// 1614+ 'b'<<25+('p'&31)<<20+('l'&31)<<15,
// 1615+ {BMI} 16_6B00<<16+ rel,
// 1616+ 'b'<<25+('m'&31)<<20+('i'&31)<<15,
// 1617+ {BGE} 16_6C00<<16+ rel,
// 1618+ 'b'<<25+('g'&31)<<20+('e'&31)<<15,
// 1619+ {BLT} 16_6D00<<16+ rel,
// 1620+ 'b'<<25+('l'&31)<<20+('t'&31)<<15,
// 1621+ {BGT} 16_6E00<<16+ rel,
// 1622+ 'b'<<25+('g'&31)<<20+('t'&31)<<15,
// 1623+ {BLE} 16_6F00<<16+ rel,
// 1624+ 'b'<<25+('l'&31)<<20+('e'&31)<<15,
// 1625+ {ASL} 16_E100<<16+ qreg9<<6+reg +sized,
// 1626+ 'a'<<25+('s'&31)<<20+('l'&31)<<15,
// 1627+ {ASR} 16_E000<<16+ qreg9<<6+reg +sized,
// 1628+ 'a'<<25+('s'&31)<<20+('r'&31)<<15,
// 1629+ {ROL} 16_E118<<16+ qreg9<<6+reg +sized,
// 1630+ 'r'<<25+('o'&31)<<20+('l'&31)<<15,
// 1631+ {ROR} 16_E018<<16+ qreg9<<6+reg +sized,
// 1632+ 'r'<<25+('o'&31)<<20+('r'&31)<<15,
// 1633+ {MOVEQ} 16_7000<<16+ mquick<<6+reg9,
// 1634+ 'm'<<25+('o'&31)<<20+('v'&31)<<15+('e'&31)<<10+('q'&31)<<5,
// 1635+ {ADDQ} 16_5000<<16+ quick9<<6+rwea +sized,
// 1636+ 'a'<<25+('d'&31)<<20+('d'&31)<<15+('q'&31)<<10,
// 1637+ {SUBQ} 16_5100<<16+ quick9<<6+rwea +sized,
// 1638+ 's'<<25+('u'&31)<<20+('b'&31)<<15+('q'&31)<<10,
// 1639+ {MOVEA} 16_3040<<16+ ea<<6+areg9 +asized,
// 1640+ 'm'<<25+('o'&31)<<20+('v'&31)<<15+('e'&31)<<10+('a'&31)<<5,
// 1641+ {ADDA} 16_D0C0<<16+ ea<<6+areg9 +asized,
// 1642+ 'a'<<25+('d'&31)<<20+('d'&31)<<15+('a'&31)<<10,
// 1643+ {SUBA} 16_90C0<<16+ ea<<6+areg9 +asized,
// 1644+ 's'<<25+('u'&31)<<20+('b'&31)<<15+('a'&31)<<10,
// 1645+ {CMPA} 16_B0C0<<16+ ea<<6+areg9 +asized,
// 1646+ 'c'<<25+('m'&31)<<20+('p'&31)<<15+('a'&31)<<10,
// 1647+ {CMPM} 16_B108<<16+ postareg<<6+postareg9,
// 1648+ 'c'<<25+('m'&31)<<20+('p'&31)<<15+('m'&31)<<10,
// 1649+ {ADDI} 16_0600<<16+ imm<<6+rwea +sized,
// 1650+ 'a'<<25+('d'&31)<<20+('d'&31)<<15+('i'&31)<<10,
// 1651+ {SUBI} 16_0400<<16+ imm<<6+rwea +sized,
// 1652+ 's'<<25+('u'&31)<<20+('b'&31)<<15+('i'&31)<<10,
// 1653+ {CMPI} 16_0C00<<16+ imm<<6+ea +sized,
// 1654+ 'c'<<25+('m'&31)<<20+('p'&31)<<15+('i'&31)<<10,
// 1655+ {ANDI} 16_0200<<16+ imm<<6+rwea +sized,
// 1656+ 'a'<<25+('n'&31)<<20+('d'&31)<<15+('i'&31)<<10,
// 1657+ {ORI} 16_0000<<16+ imm<<6+rwea +sized,
// 1658+ 'o'<<25+('r'&31)<<20+('i'&31)<<15,
// 1659+ {EORI} 16_0A00<<16+ imm<<6+rwea +sized,
// 1660+ 'e'<<25+('o'&31)<<20+('r'&31)<<15+('i'&31)<<10,
// 1661+ {ROXL} 16_E110<<16+ qreg9<<6+reg +sized,
// 1662+ 'r'<<25+('o'&31)<<20+('x'&31)<<15+('l'&31)<<10,
// 1663+ {ROXR} 16_E010<<16+ qreg9<<6+reg +sized,
// 1664+ 'r'<<25+('o'&31)<<20+('x'&31)<<15+('r'&31)<<10,
// 1665+ {CLR} 16_4200<<16+ wea +sized,
// 1666+ 'c'<<25+('l'&31)<<20+('r'&31)<<15,
// 1667+ {NEGX} 16_4000<<16+ rwea +sized,
// 1668+ 'n'<<25+('e'&31)<<20+('g'&31)<<15+('x'&31)<<10,
// 1669+ {NBCD} 16_4800<<16+ rwea,
// 1670+ 'n'<<25+('b'&31)<<20+('c'&31)<<15+('d'&31)<<10,
// 1671+ {PEA} 16_4840<<16+ ea,
// 1672+ 'p'<<25+('e'&31)<<20+('a'&31)<<15,
// 1673+ {JSR} 16_4E80<<16+ ea,
// 1674+ 'j'<<25+('s'&31)<<20+('r'&31)<<15,
// 1675+ {JMP} 16_4EC0<<16+ ea,
// 1676+ 'j'<<25+('m'&31)<<20+('p'&31)<<15,
// 1677+ {TAS} 16_4AC0<<16+ rwea,
// 1678+ 't'<<25+('a'&31)<<20+('s'&31)<<15,
// 1679+ {TST} 16_4A00<<16+ ea +sized,
// 1680+ 't'<<25+('s'&31)<<20+('t'&31)<<15,
// 1681+ {ABCD} 16_C100<<16+ qpre<<6+reg9,
// 1682+ 'a'<<25+('b'&31)<<20+('c'&31)<<15+('d'&31)<<10,
// 1683+ {SBCD} 16_8100<<16+ qpre<<6+reg9,
// 1684+ 's'<<25+('b'&31)<<20+('c'&31)<<15+('d'&31)<<10,
// 1685+ {ADDX} 16_D100<<16+ qpre<<6+reg9 +sized,
// 1686+ 'a'<<25+('d'&31)<<20+('d'&31)<<15+('x'&31)<<10,
// 1687+ {SUBX} 16_9100<<16+ qpre<<6+reg9 +sized,
// 1688+ 's'<<25+('u'&31)<<20+('b'&31)<<15+('x'&31)<<10,
// 1689+ {NOP} 16_4E71<<16,
// 1690+ 'n'<<25+('o'&31)<<20+('p'&31)<<15,
// 1691+ {RESET} 16_4E70<<16,
// 1692+ 'r'<<25+('e'&31)<<20+('s'&31)<<15+('e'&31)<<10+('t'&31)<<5,
// 1693+ {RTE} 16_4E73<<16,
// 1694+ 'r'<<25+('t'&31)<<20+('e'&31)<<15,
// 1695+ {RTR} 16_4E77<<16,
// 1696+ 'r'<<25+('t'&31)<<20+('r'&31)<<15,
// 1697+ {RTS} 16_4E75<<16,
// 1698+ 'r'<<25+('t'&31)<<20+('s'&31)<<15,
// 1699+ {STOP} 16_4E72<<16 +imm,
// 1700+ 's'<<25+('t'&31)<<20+('o'&31)<<15+('p'&31)<<10,
// 1701+ {TRAPV} 16_4E76<<16,
// 1702+ 't'<<25+('r'&31)<<20+('a'&31)<<15+('p'&31)<<10+('v'&31)<<5,
// 1703+ {TRAP} 16_4E40<<16+ tquick,
// 1704+ 't'<<25+('r'&31)<<20+('a'&31)<<15+('p'&31)<<10,
// 1705+ {LINK} 16_4E50<<16+ imm<<6+areg,
// 1706+ 'l'<<25+('i'&31)<<20+('n'&31)<<15+('k'&31)<<10,
// 1707+ {UNLK} 16_4E58<<16+ areg,
// 1708+ 'u'<<25+('n'&31)<<20+('l'&31)<<15+('k'&31)<<10,
// 1709+ {SWAP} 16_4840<<16+ reg,
// 1710+ 's'<<25+('w'&31)<<20+('a'&31)<<15+('p'&31)<<10,
// 1711+ {EXTW} 16_4880<<16+ reg,
// 1712+ 'e'<<25+('x'&31)<<20+('t'&31)<<15+('w'&31)<<10,
// 1713+ {EXTL} 16_48C0<<16+ reg,
// 1714+ 'e'<<25+('x'&31)<<20+('t'&31)<<15+('l'&31)<<10,
// 1715+ {EXG} 16_C140<<16+ exreg<<6+reg,
// 1716+ 'e'<<25+('x'&31)<<20+('g'&31)<<15,
// 1717+ {LEA} 16_41C0<<16+ qea<<6+areg9,
// 1718+ 'l'<<25+('e'&31)<<20+('a'&31)<<15,
// 1719+ {CHK} 16_4180<<16+ ea<<6+reg9,
// 1720+ 'c'<<25+('h'&31)<<20+('k'&31)<<15,
// 1721+ {DBXX} 16_50C8<<16+ reg<<6+longrel,
// 1722+ 'd'<<25+('b'&31)<<20+('x'&31)<<15+('x'&31)<<10,
// 1723+ {DBRA} 16_51C8<<16+ reg<<6+longrel,
// 1724+ 'd'<<25+('b'&31)<<20+('r'&31)<<15+('a'&31)<<10,
// 1725+ {DBHI} 16_52C8<<16+ reg<<6+longrel,
// 1726+ 'd'<<25+('b'&31)<<20+('h'&31)<<15+('i'&31)<<10,
// 1727+ {DBLS} 16_53C8<<16+ reg<<6+longrel,
// 1728+ 'd'<<25+('b'&31)<<20+('l'&31)<<15+('s'&31)<<10,
// 1729+ {DBCC} 16_54C8<<16+ reg<<6+longrel,
// 1730+ 'd'<<25+('b'&31)<<20+('c'&31)<<15+('c'&31)<<10,
// 1731+ {DBCS} 16_55C8<<16+ reg<<6+longrel,
// 1732+ 'd'<<25+('b'&31)<<20+('c'&31)<<15+('s'&31)<<10,
// 1733+ {DBNE} 16_56C8<<16+ reg<<6+longrel,
// 1734+ 'd'<<25+('b'&31)<<20+('n'&31)<<15+('e'&31)<<10,
// 1735+ {DBEQ} 16_57C8<<16+ reg<<6+longrel,
// 1736+ 'd'<<25+('b'&31)<<20+('e'&31)<<15+('q'&31)<<10,
// 1737+ {DBVC} 16_58C8<<16+ reg<<6+longrel,
// 1738+ 'd'<<25+('b'&31)<<20+('v'&31)<<15+('c'&31)<<10,
// 1739+ {DBVS} 16_59C8<<16+ reg<<6+longrel,
// 1740+ 'd'<<25+('b'&31)<<20+('v'&31)<<15+('s'&31)<<10,
// 1741+ {DBPL} 16_5AC8<<16+ reg<<6+longrel,
// 1742+ 'd'<<25+('b'&31)<<20+('p'&31)<<15+('l'&31)<<10,
// 1743+ {DBMI} 16_5BC8<<16+ reg<<6+longrel,
// 1744+ 'd'<<25+('b'&31)<<20+('m'&31)<<15+('i'&31)<<10,
// 1745+ {DBGE} 16_5CC8<<16+ reg<<6+longrel,
// 1746+ 'd'<<25+('b'&31)<<20+('g'&31)<<15+('e'&31)<<10,
// 1747+ {DBLT} 16_5DC8<<16+ reg<<6+longrel,
// 1748+ 'd'<<25+('b'&31)<<20+('l'&31)<<15+('t'&31)<<10,
// 1749+ {DBGT} 16_5EC8<<16+ reg<<6+longrel,
// 1750+ 'd'<<25+('b'&31)<<20+('g'&31)<<15+('t'&31)<<10,
// 1751+ {DBLE} 16_5FC8<<16+ reg<<6+longrel,
// 1752+ 'd'<<25+('b'&31)<<20+('l'&31)<<15+('e'&31)<<10,
// 1753+ {BCHG} 16_0140<<16+ ireg9<<6+rwea,
// 1754+ 'b'<<25+('c'&31)<<20+('h'&31)<<15+('g'&31)<<10,
// 1755+ {BCLR} 16_0180<<16+ ireg9<<6+wea,
// 1756+ 'b'<<25+('c'&31)<<20+('l'&31)<<15+('r'&31)<<10,
// 1757+ {BSET} 16_01C0<<16+ ireg9<<6+wea,
// 1758+ 'b'<<25+('s'&31)<<20+('e'&31)<<15+('t'&31)<<10,
// 1759+ {BTST} 16_0100<<16+ ireg9<<6+ea,
// 1760+ 'b'<<25+('t'&31)<<20+('s'&31)<<15+('t'&31)<<10,
// 1761+ {MOVEM} 16_4880<<16+ multiple,
// 1762+ 'm'<<25+('o'&31)<<20+('v'&31)<<15+('e'&31)<<10+('m'&31)<<5,
// 1763+ {TRAPI} 16_4E40<<16+ imm<<6+tquick,
// 1764+ 't'<<25+('r'&31)<<20+('a'&31)<<15+('p'&31)<<10+('i'&31)<<5,
// 1765+ {DC} data,
// 1766+ 'd'<<25+('c'&31)<<20,
// 1767+ {ST} 16_50C0<<16+ wea,
// 1768+ 's'<<25+('t'&31)<<20,
// 1769+ {SF} 16_51C0<<16+ wea,
// 1770+ 's'<<25+('f'&31)<<20,
// 1771+ {SHI} 16_52C0<<16+ wea,
// 1772+ 's'<<25+('h'&31)<<20+('i'&31)<<15,
// 1773+ {SLS} 16_53C0<<16+ wea,
// 1774+ 's'<<25+('l'&31)<<20+('s'&31)<<15,
// 1775+ {SCC} 16_54C0<<16+ wea,
// 1776+ 's'<<25+('c'&31)<<20+('c'&31)<<15,
// 1777+ {SCS} 16_55C0<<16+ wea,
// 1778+ 's'<<25+('c'&31)<<20+('s'&31)<<15,
// 1779+ {SNE} 16_56C0<<16+ wea,
// 1780+ 's'<<25+('n'&31)<<20+('e'&31)<<15,
// 1781+ {SEQ} 16_57C0<<16+ wea,
// 1782+ 's'<<25+('e'&31)<<20+('q'&31)<<15,
// 1783+ {SVC} 16_58C0<<16+ wea,
// 1784+ 's'<<25+('v'&31)<<20+('c'&31)<<15,
// 1785+ {SVS} 16_59C0<<16+ wea,
// 1786+ 's'<<25+('v'&31)<<20+('s'&31)<<15,
// 1787+ {SPL} 16_5AC0<<16+ wea,
// 1788+ 's'<<25+('p'&31)<<20+('l'&31)<<15,
// 1789+ {SMI} 16_5BC0<<16+ wea,
// 1790+ 's'<<25+('m'&31)<<20+('i'&31)<<15,
// 1791+ {SGE} 16_5CC0<<16+ wea,
// 1792+ 's'<<25+('g'&31)<<20+('e'&31)<<15,
// 1793+ {SLT} 16_5DC0<<16+ wea,
// 1794+ 's'<<25+('l'&31)<<20+('t'&31)<<15,
// 1795+ {SGT} 16_5EC0<<16+ wea,
// 1796+ 's'<<25+('g'&31)<<20+('t'&31)<<15,
// 1797+ {SLE} 16_5FC0<<16+ wea,
// 1798+ 's'<<25+('l'&31)<<20+('e'&31)<<15,
// 1799+ {MTCCR} 16_44C0<<16+ ea<<6,
// 1800+ 'm'<<25+('t'&31)<<20+('c'&31)<<15+('c'&31)<<10+('r'&31)<<5,
// 1801+ {MTSR} 16_46C0<<16+ ea<<6,
// 1802+ 'm'<<25+('t'&31)<<20+('s'&31)<<15+('r'&31)<<10,
// 1803+ {MFSR} 16_40C0<<16+ wea,
// 1804+ 'm'<<25+('f'&31)<<20+('s'&31)<<15+('r'&31)<<10,
// 1805+ {MTUSP} 16_4E60<<16+ areg,
// 1806+ 'm'<<25+('t'&31)<<20+('u'&31)<<15+('s'&31)<<10+('p'&31)<<5,
// 1807+ {MFUSP} 16_4E68<<16+ areg,
// 1808+ 'm'<<25+('f'&31)<<20+('u'&31)<<15+('s'&31)<<10+('p'&31)<<5,
// 1809+ {ATCCR} 16_023C<<16+ imm,
// 1810+ 'a'<<25+('t'&31)<<20+('c'&31)<<15+('c'&31)<<10+('r'&31)<<5,
// 1811+ {ATSR} 16_027C<<16+ imm,
// 1812+ 'a'<<25+('t'&31)<<20+('s'&31)<<15+('r'&31)<<10,
// 1813+ {ETCCR} 16_0A3C<<16+ imm,
// 1814+ 'e'<<25+('t'&31)<<20+('c'&31)<<15+('c'&31)<<10+('r'&31)<<5,
// 1815+ {ETSR} 16_0A7C<<16+ imm,
// 1816+ 'e'<<25+('t'&31)<<20+('s'&31)<<15+('r'&31)<<10,
// 1817+ {OTCCR} 16_003C<<16+ imm,
// 1818+ 'o'<<25+('t'&31)<<20+('c'&31)<<15+('c'&31)<<10+('r'&31)<<5,
// 1819+ {OTSR} 16_007C<<16+ imm,
// 1820+ 'o'<<25+('t'&31)<<20+('s'&31)<<15+('r'&31)<<10
// 1821
// 1822 {?}%routine PUT OPCODE(%integer op)
void PUTOPCODE(int OP) {
// 1823 {?} put mnemonic(def(op+op))
PUTMNEMONIC(DEF[OP + OP]);
// 1824 {?}%end
return;
} /* end of PUTOPCODE */
// 1825
// 1826 %routine STORE(%integer v,f)
void STORE(int V, int F) {
// 1827 !$IF VAX
// 1828 { v = v&16_FFFF; v = v!sign16 %if v&sign16 # 0
// 1829 !$FINISH
// 1830 prog(pc) <- v; pflag(pc) = f; pc = pc+1
PROG[PC] = (short int)(V);
PFLAG[PC] = F;
PC = PC + 1;
// 1831 %end
return;
} /* end of STORE */
// 1832
// 1833 %routine MAKE ROOM(%integer size)
void MAKEROOM(int SIZE) {
// 1834 %integer newbase,newlim
int NEWBASE;
int NEWLIM;
// 1835 size = (size+127)&(\127)
SIZE = SIZE + 127 & (~127);
// 1836 ownbase = ownbase-size
OWNBASE = OWNBASE - SIZE;
// 1837 croak("Program too big") %if ownbase <= cad
if (OWNBASE > CAD) goto L_00AE;
CROAK(_imp_str_literal("Program too big"));
L_00AE:;
// 1838 newbase = ownbase; newlim = newbase+ownad
NEWBASE = OWNBASE;
NEWLIM = NEWBASE + OWNAD;
// 1839 %cycle
L_00AF:;
// 1840 final(newbase) = final(newbase+size)
FINAL[NEWBASE] = FINAL[NEWBASE + SIZE];
// 1841 newbase = newbase+1
NEWBASE = NEWBASE + 1;
// 1842 %repeat %until newbase >= newlim
if (NEWBASE >= NEWLIM) goto L_00B0;
goto L_00AF;
L_00B0:;
// 1843 %end
return;
} /* end of MAKEROOM */
// 1844
// 1845 %routine FILL CODE(%integer n)
void FILLCODE(int N) {
// 1846 %integer i
int I;
// 1847 i = cad; cad = cad+n
I = CAD;
CAD = CAD + N;
// 1848 %while n > 0 %cycle
L_00B1:;
if (N <= 0) goto L_00B2;
// 1849 final(i) = 16_80; i = i+1; n = n-1
FINAL[I] = 128;
I = I + 1;
N = N - 1;
// 1850 %repeat
goto L_00B1;
L_00B2:;
// 1851 %end
return;
} /* end of FILLCODE */
// 1852 %routine FILL OWN(%integer n)
void FILLOWN(int N) {
// 1853 %integer i
int I;
// 1854 make room(n)
MAKEROOM(N);
// 1855 i = ownbase+ownad; ownad = ownad+n
I = OWNBASE + OWNAD;
OWNAD = OWNAD + N;
// 1856 %while n > 0 %cycle
L_00B3:;
if (N <= 0) goto L_00B4;
// 1857 final(i) = 16_80; i = i+1; n = n-1
FINAL[I] = 128;
I = I + 1;
N = N - 1;
// 1858 %repeat
goto L_00B3;
L_00B4:;
// 1859 %end
return;
} /* end of FILLOWN */
// 1860
// 1861 %routine SET CODE WORD(%integer v)
void SETCODEWORD(int V) {
// 1862 !$IF VAX (works irrespective of host byte sex)
// 1863 { final(cad) <- v>>8; final(cad+1) <- v
// 1864 !$IF APM (for efficiency)
// 1865 shortinteger(final0+cad) <- v
*_imp_SHORTINTEGER(FINAL0 + CAD) = (short int)(V);
// 1866 !$FINISH
// 1867 cad = cad+2
CAD = CAD + 2;
// 1868 %end
return;
} /* end of SETCODEWORD */
// 1869
// 1870 %integer%fn CODE WORD(%integer cad)
int CODEWORD(int CAD) {
// 1871 !$IF VAX (works irrespective of host byte sex)
// 1872 { %result = final(cad)<<8+final(cad+1)
// 1873 !$IF APM (for efficiency)
// 1874 %result = shortinteger(final0+cad)
return *_imp_SHORTINTEGER(FINAL0 + CAD);
// 1875 !$FINISH
// 1876 %end
} /* end of CODEWORD */
// 1877
// 1878 %routine SET CODE LONGWORD(%integer v)
void SETCODELONGWORD(int V) {
// 1879 set code word(v>>16); set code word(v)
SETCODEWORD((unsigned int)V >> 16);
SETCODEWORD(V);
// 1880 %end
return;
} /* end of SETCODELONGWORD */
// 1881
// 1882 %routine SET OWN WORD(%integer v)
void SETOWNWORD(int V) {
// 1883 make room(2) %if ownbase+ownad > finalbound
if (OWNBASE + OWNAD <= FINALBOUND) goto L_00B5;
MAKEROOM(2);
L_00B5:;
// 1884 !$IF VAX
// 1885 { final(ownbase+ownad) <- v>>8; final(ownbase+ownad+1) <- v
// 1886 !$IF APM
// 1887 shortinteger(final0+ownbase+ownad) <- v
*_imp_SHORTINTEGER(FINAL0 + OWNBASE + OWNAD) = (short int)(V);
// 1888 !$FINISH
// 1889 ownad = ownad+2
OWNAD = OWNAD + 2;
// 1890 %end
return;
} /* end of SETOWNWORD */
// 1891
// 1892 %routine EXTEND STACK(%integer delta)
void EXTENDSTACK(int DELTA) {
// 1893 c_sp = c_sp-delta
C.SP = C.SP - DELTA;
// 1894 %if c_sp < c_stack %start
if (C.SP >= C.STACK) goto L_00B6;
// 1895 c_stack = c_sp
C.STACK = C.SP;
// 1896 c_totstack = c_stack %if c_stack < c_totstack
if (C.STACK >= C.TOTSTACK) goto L_00B7;
C.TOTSTACK = C.STACK;
L_00B7:;
// 1897 %finish
L_00B6:;
// 1898 %end
return;
} /* end of EXTENDSTACK */
// 1899
// 1900 %routine PLANT(%integer op,y,x)
void PLANT(int OP, int Y, int X) {
// 1901 !Basic code planting procedure
// 1902 ! OP is an index to the array defining op-codes
// 1903 ! (it can be flagged to force SIZE)
// 1904 ! For unary operations the operand is given by X (Y zero)
// 1905 ! For binary operations the operands are Y (source) and X (dest)
// 1906 %integer OPCODE,PC1,I,F,EXTWORD,INFO,KIND,MODE,MODEX,SIZE
int OPCODE;
int PC1;
int I;
int F;
int EXTWORD;
int INFO;
int KIND;
int MODE;
int MODEX;
int SIZE;
// 1907 %record(identinfo)%name DX,DY
struct IDENTINFO *DX;
struct IDENTINFO *DY;
// 1908 %switch S(0:21)
int S_index;
int S_line;
char *S_file;
static const void *S[22] = {
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing};
// 1909 %constbytearray SIZESYM(0:3) = 'L','B','W','?'
const unsigned char SIZESYM[4] = {76, 66, 87, 63};
// 1910
// 1911 %integer%fn NONLOCAL(%integer l)
int NONLOCAL(int L) {
// 1912 %integer r
int R;
// 1913 %result = mb %if l = outerlevel
if (L != 0) goto L_00B8;
return 13;
L_00B8:;
// 1914 hold(l)_status = hold(l)_status!globbed %if l # level
if (L == LEVEL) goto L_00B9;
HOLD[L].STATUS = HOLD[L].STATUS | 16;
L_00B9:;
// 1915 %result = f1 %if l = outerlevel+1
if (L != 0 + 1) goto L_00BA;
return 15;
L_00BA:;
// 1916 r = maxareg
R = 12;
// 1917 %cycle
L_00BB:;
// 1918 %result = r %if c_reg_content(r) = d7+l; ![unique]
if (C.REG.CONTENT[R - 1] != 8 + L) goto L_00BC;
return R;
L_00BC:;
// 1919 r = r-1
R = R - 1;
// 1920 %repeat %until r < a0
if (R < 9) goto L_00BD;
goto L_00BB;
L_00BD:;
// 1921 ![not good enough: 1. may need two
// 1922 ! 2. FREE updated elsewhere without regard to this]
// 1923 r = maxareg
R = 12;
// 1924 %while a0b<<(r-a0)&free = 0 %cycle
L_00BE:;
if (256 << R - 9 & FREE != 0) goto L_00BF;
// 1925 fault(plexerr) %and %exit %if r = a0
if (R != 9) goto L_00C0;
FAULT(2);
goto L_00BF;
L_00C0:;
// 1926 r = r-1
R = R - 1;
// 1927 %repeat
goto L_00BE;
L_00BF:;
// 1928 c_reg_content(r) = d7+l
C.REG.CONTENT[R - 1] = 8 + L;
// 1929 dtsprel_mode = globalmode; dtsprel_val = l<<2
DTSPREL->MODE = 45;
DTSPREL->VAL = L << 2;
// 1930 plant(move,lablim+2,r)
PLANT(1, LABLIM + 2, R);
// 1931 %result = r
return R;
// 1932 %end
} /* end of NONLOCAL */
// 1933
// 1934 %constinteger MOVEQ=36, ADDQ=37, MOVEA=39,
// 1935+ ADDA=40, ADDI=44
// 1936
// 1937 %if x > 0 %start
if (X <= 0) goto L_00C1;
// 1938 intern(1) %and %return %if x >= explim
if (X < EXPLIM) goto L_00C2;
INTERN(1);
return;
L_00C2:;
// 1939 dx == dict(x)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
// 1940 modex = dx_mode
MODEX = DX->MODE;
// 1941 %if modex >= framemode %and modex # c_mode %c
if (MODEX < 168) goto L_00C3;
if (MODEX == C.MODE) goto L_00C3;
if (MODEX & 56 == 56) goto L_00C3;
// 1942+ %and modex&2_111000 # 2_111000 %start
// 1943 modex = nonlocal(modex&7)-a0+(modex&(7<<3))
MODEX = NONLOCAL(MODEX & 7) - 9 + (MODEX & 7 << 3);
// 1944 %finish
L_00C3:;
// 1945 %finish %else modex = litmode %and dx == dint
goto L_00C4;
L_00C1:;
MODEX = 60;
DX = (struct IDENTINFO *)DINT;
L_00C4:;
// 1946 %if y > 0 %start
if (Y <= 0) goto L_00C5;
// 1947 intern(1) %and %return %if y >= explim
if (Y < EXPLIM) goto L_00C6;
INTERN(1);
return;
L_00C6:;
// 1948 dy == dict(y)
DY = (struct IDENTINFO *)/*?*/ &DICT[Y];
// 1949 mode = dy_mode
MODE = DY->MODE;
// 1950 %if mode >= framemode %and mode # c_mode %c
if (MODE < 168) goto L_00C7;
if (MODE == C.MODE) goto L_00C7;
if (MODE & 56 == 56) goto L_00C7;
// 1951+ %and mode&2_111000 # 2_111000 %start
// 1952 mode = nonlocal(mode&7)-a0+(mode&(7<<3))
MODE = NONLOCAL(MODE & 7) - 9 + (MODE & 7 << 3);
// 1953 %finish
L_00C7:;
// 1954 %finish %else mode = litmode %and dy == dint
goto L_00C8;
L_00C5:;
MODE = 60;
DY = (struct IDENTINFO *)DINT;
L_00C8:;
// 1955 size = op>>8; op = op&255
SIZE = (unsigned int)OP >> 8;
OP = OP & 255;
// 1956 %if op = move %start
if (OP != 1) goto L_00C9;
// 1957 %if modex&2_111000 = 0 %start; !D
if (MODEX & 56 != 0) goto L_00CA;
// 1958 op = moveq %if y <= 0 %and y >= litmite %and size&3 = 0
if (Y > 0) goto L_00CB;
if (Y < -255) goto L_00CB;
if (SIZE & 3 != 0) goto L_00CB;
OP = 36;
L_00CB:;
// 1959 %finish %else %if modex&2_110000 = 0 %start; !A
goto L_00CC;
L_00CA:;
if (MODEX & 48 != 0) goto L_00CD;
// 1960 op = movea
OP = 39;
// 1961 %finish
L_00CD:;
L_00CC:;
// 1962 %finish %else %if op <= cmp %start
goto L_00CE;
L_00C9:;
if (OP > 4) goto L_00CF;
// 1963 %if op < cmp %and y < 0 %and y >= litquick %and y&1 = 0 %c
if (OP >= 4) goto L_00D0;
if (Y >= 0) goto L_00D0;
if (Y < -16) goto L_00D0;
if (Y & 1 != 0) goto L_00D0;
OP = OP + (37 - 2);
goto L_00D1;
L_00D0:;
if (MODEX & 56 != 8) goto L_00D2;
OP = OP + (40 - 2);
goto L_00D1;
L_00D2:;
if (Y > 0) goto L_00D3;
OP = OP + (44 - 2);
L_00D3:;
L_00D1:;
// 1964+ %then op=op+(addq-add) {ADDQ,SUBQ} %c
// 1965+ %else %if modex&2_111000 = aregmode %c
// 1966+ %then op=op+(adda-add) {ADDA,SUBA,CMPA} %c
// 1967+ %else %if y <= 0 %c
// 1968+ %then op=op+(addi-add) {ADDI,SUBI,CMPI}
// 1969 %finish %else %if op <= eor %start
goto L_00CE;
L_00CF:;
if (OP > 7) goto L_00D4;
// 1970 op = op+(addi-add) %if y <= 0 {ANDI,ORI,EORI}
if (Y > 0) goto L_00D5;
OP = OP + (44 - 2);
L_00D5:;
// 1971 %finish
L_00D4:;
L_00CE:;
// 1972 info = def(op+op-1)
INFO = DEF[OP + OP - 1];
// 1973 opcode = info>>16
OPCODE = (unsigned int)INFO >> 16;
// 1974 %if info&sized # 0 %start; !data size required
if (INFO & 32768 == 0) goto L_00D6;
// 1975 size = 4 %if size = 0
if (SIZE != 0) goto L_00D7;
SIZE = 4;
L_00D7:;
// 1976 %if op = move %start
if (OP != 1) goto L_00D8;
// 1977 %if size = 4 %start
if (SIZE != 4) goto L_00D9;
// 1978 opcode = opcode+16_2000
OPCODE = OPCODE + 8192;
// 1979 %finish %else %if size = 2 %start
goto L_00DA;
L_00D9:;
if (SIZE != 2) goto L_00DB;
// 1980 opcode = opcode+16_3000
OPCODE = OPCODE + 12288;
// 1981 %else
goto L_00DA;
L_00DB:;
// 1982 opcode = opcode+16_1000
OPCODE = OPCODE + 4096;
// 1983 %finish
L_00DA:;
// 1984 %else
goto L_00DC;
L_00D8:;
// 1985 %if size = 4 %start
if (SIZE != 4) goto L_00DD;
// 1986 opcode = opcode+16_80
OPCODE = OPCODE + 128;
// 1987 %finish %else %if size = 2 %start
goto L_00DE;
L_00DD:;
if (SIZE != 2) goto L_00DF;
// 1988 opcode = opcode+16_40
OPCODE = OPCODE + 64;
// 1989 %finish
L_00DF:;
L_00DE:;
// 1990 %finish
L_00DC:;
// 1991 %finish %else %if info&asized # 0 %start; !areg size required
goto L_00E0;
L_00D6:;
if (INFO & 16384 == 0) goto L_00E1;
// 1992 fault(sizerr) %if size = 1
if (SIZE != 1) goto L_00E2;
FAULT(11);
L_00E2:;
// 1993 %if op # movem %start
if (OP == 100) goto L_00E3;
// 1994 %if size = 0 %start
if (SIZE != 0) goto L_00E4;
// 1995 size = 4 %unless y <= 0 %and is short(litval(y))=TRUE
if (Y > 0) goto L_00E5;
if (ISSHORT(LITVAL(Y)) == 1) goto L_00E6;
L_00E5:;
SIZE = 4;
L_00E6:;
// 1996 %finish
L_00E4:;
// 1997 %if size = 4 %start
if (SIZE != 4) goto L_00E7;
// 1998 %if op = movea %then opcode = opcode!!16_1000 %c
if (OP != 39) goto L_00E8;
OPCODE = OPCODE ^ 4096;
goto L_00E9;
L_00E8:;
OPCODE = OPCODE + 256;
L_00E9:;
// 1999+ %else opcode = opcode+16_0100
// 2000 %finish
L_00E7:;
// 2001 %else; !MOVEM
goto L_00EA;
L_00E3:;
// 2002 size = 4 %if size = 0
if (SIZE != 0) goto L_00EB;
SIZE = 4;
L_00EB:;
// 2003 opcode = opcode+16_0040 %if size = 4
if (SIZE != 4) goto L_00EC;
OPCODE = OPCODE + 64;
L_00EC:;
// 2004 %finish
L_00EA:;
// 2005 %finish
L_00E1:;
L_00E0:;
// 2006 {?} %if control&codelist # 0 %and control&list # 0 %start
if (CONTROL & 32 == 0) goto L_00ED;
if (CONTROL & 1 == 0) goto L_00ED;
// 2007 {?} print line %if length(rep) >= 4
if (*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP) < 4) goto L_00EE;
PRINTLINE();
L_00EE:;
// 2008 {?} put sym(codeflag); spaces(4-length(rep))
PUTSYM(CODEFLAG);
SPACES(4 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP));
// 2009 {?} put opcode(op)
PUTOPCODE(OP);
// 2010 {?} %if size # 0 %start
if (SIZE == 0) goto L_00EF;
// 2011 {?} put sym('.')
PUTSYM(46);
// 2012 {?} put sym(sizesym(size&3))
PUTSYM(SIZESYM[SIZE & 3]);
// 2013 {?} %finish
L_00EF:;
// 2014 {?} spaces(12-length(rep))
SPACES(12 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP));
// 2015 {?} %if info&(63<<6) # 0 %start
if (INFO & 63 << 6 == 0) goto L_00F0;
// 2016 {?} put operand(y)
PUTOPERAND(Y);
// 2017 {?} put sym(',') %if info&63 # 0
if (INFO & 63 == 0) goto L_00F1;
PUTSYM(44);
L_00F1:;
// 2018 {?} %finish
L_00F0:;
// 2019 {?} put operand(x) %if info&63 # 0
if (INFO & 63 == 0) goto L_00F2;
PUTOPERAND(X);
L_00F2:;
// 2020 {?} spaces(33-length(rep)); put sym(':')
SPACES(33 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &REP));
PUTSYM(58);
// 2021 {?} %finish
L_00ED:;
// 2022
// 2023 pc1 = pc; pflag(pc1) = c_shorts; !op-code word
PC1 = PC;
PFLAG[PC1] = C.SHORTS;
// 2024 pc = pc+1
PC = PC + 1;
// 2025 croak("Code space exhausted") %if pc >= swpc-8
if (PC < SWPC - 8) goto L_00F3;
CROAK(_imp_str_literal("Code space exhausted"));
L_00F3:;
// 2026 kind = info>>6
KIND = (unsigned int)INFO >> 6;
// 2027 again:
U_1003:;
// 2028 ->s(kind&31)
S_line = __LINE__;
S_file = __FILE__;
S_index = KIND & 31;
goto case_S_dispatch;
// 2029 s(0):
case_S_0:;
// 2030 next:
U_1004:;
// 2031 kind = info
KIND = INFO;
// 2032 %if kind # 0 %start
if (KIND == 0) goto L_00F5;
// 2033 dy == dx; y = x; mode = modex
DY = (struct IDENTINFO *)DX;
Y = X;
MODE = MODEX;
// 2034 info = 0
INFO = 0;
// 2035 ->again
goto U_1003;
// 2036 %finish
L_00F5:;
// 2037 !
// 2038 !$IF VAX
// 2039 { opcode = opcode!sign16 %if opcode&sign16 # 0
// 2040 !$FINISH
// 2041 prog(pc1) <- opcode
PROG[PC1] = (short int)(OPCODE);
// 2042 {?} %if control&codelist # 0 %and control&list # 0 %start
if (CONTROL & 32 == 0) goto L_00F6;
if (CONTROL & 1 == 0) goto L_00F6;
// 2043 {?} %cycle
L_00F7:;
// 2044 {?} put sym(' ')
PUTSYM(32);
// 2045 {?} put hex(prog(pc1))
PUTHEX(PROG[PC1]);
// 2046 {?} pc1 = pc1+1
PC1 = PC1 + 1;
// 2047 {?} %repeat %until pc1 >= pc
if (PC1 >= PC) goto L_00F8;
goto L_00F7;
L_00F8:;
// 2048 {?} print line
PRINTLINE();
// 2049 {?} %finish
L_00F6:;
// 2050 %return
return;
// 2051
// 2052 !Set flag value for PC-relative reference
// 2053 ! distinguishing GLOBAL (const access), INDIRECT GLOBAL (procedure),
// 2054 ! and LOCAL (label) -- the last further distinguished according to
// 2055 ! whether the instruction permits shortening
// 2056 %routine PCREL(%integer shorten)
void PCREL(int SHORTEN) {
// 2057 %if dy_mode = labmode %start
if (DY->MODE != 186) goto L_00F9;
// 2058 f = jump; f = longjump %if shorten = 0
F = 2;
if (SHORTEN != 0) goto L_00FA;
F = 3;
L_00FA:;
// 2059 %if extword > 0 %start; !label defined
if (EXTWORD <= 0) goto L_00FB;
// 2060 %if shorten # 0 %and (extword-pflag(extword)-pc+c_shorts)<<1 >= -128 %start
if (SHORTEN == 0) goto L_00FC;
if (EXTWORD - PFLAG[EXTWORD] - PC + C.SHORTS << 1 < -128) goto L_00FC;
// 2061 %if c_shorts = 255 %start
if (C.SHORTS != 255) goto L_00FD;
// 2062 zaps = zaps+100
ZAPS = ZAPS + 100;
// 2063 %else
goto L_00FE;
L_00FD:;
// 2064 shorts = shorts+1; c_shorts = c_shorts+1
SHORTS = SHORTS + 1;
C.SHORTS = C.SHORTS + 1;
// 2065 f = shortjump
F = 1;
// 2066 %finish
L_00FE:;
// 2067 %finish
L_00FC:;
// 2068 %else
goto L_00FF;
L_00FB:;
// 2069 extword = -extword
EXTWORD = -EXTWORD;
// 2070 dy_val = -pc
DY->VAL = -PC;
// 2071 %finish
L_00FF:;
// 2072 %finish %else %if dy_mode = procmode %start; !procedure
goto L_0100;
L_00F9:;
if (DY->MODE != 250) goto L_0101;
// 2073 f = indglobal; extword = y; !rather than DY_VAL
F = 7;
EXTWORD = Y;
// 2074 %finish %else %if dy_mode = constmode %start; !constant data ref
goto L_0100;
L_0101:;
if (DY->MODE != 122) goto L_0102;
// 2075 f = global
F = 4;
// 2076 f = f+1 %if extword < 0
if (EXTWORD >= 0) goto L_0103;
F = F + 1;
L_0103:;
// 2077 f = f+2 %if extword > 65535
if (EXTWORD <= 65535) goto L_0104;
F = F + 2;
L_0104:;
// 2078 %finish %else %if dy_mode # pcmode %start
goto L_0100;
L_0102:;
if (DY->MODE == 58) goto L_0105;
// 2079 fault(moperr)
FAULT(26);
// 2080 %finish
L_0105:;
L_0100:;
// 2081 %end
return;
} /* end of PCREL */
// 2082
// 2083 s(qea): !LEA
case_S_15:;
// 2084 -> ea0 %unless mode&63 = x-(a0-indexmode) %and dy_val&255 = 0
if (MODE & 63 != X - (9 - 48)) goto L_0106;
if (DY->VAL & 255 == 0) goto L_0107;
L_0106:;
goto U_1005;
L_0107:;
// 2085 ! LEA 0(Ax,Dy) => ADDA Dy,Ax
// 2086 opcode = 16_D1C0+dy_val>>12&15
OPCODE = 53696 + ((unsigned int)DY->VAL >> 12 & 15);
// 2087 -> next
goto U_1004;
// 2088
// 2089 s(wea):
case_S_8:;
// 2090 dy_flags = dy_flags!(mflag!wflag)
DY->FLAGS = DY->FLAGS | (128 | 16);
// 2091 -> wea1
goto U_1006;
// 2092 s(rwea): ![for our purposes, read&write counts as neither]
case_S_7:;
// 2093 dy_flags = dy_flags!mflag
DY->FLAGS = DY->FLAGS | 128;
// 2094 wea1:
U_1006:;
// 2095 -> err %if y <= 0 %or mode&63 >= pcmode
if (Y <= 0) goto L_0108;
if (MODE & 63 < 58) goto L_0109;
L_0108:;
goto U_1007;
L_0109:;
// 2096 -> ea1
goto U_1008;
// 2097 s(revea): !reversible cases (EA,REG or REG,EA)
case_S_16:;
// 2098 %if modex&2_111000 # 0 %start; !dest not D
if (MODEX & 56 == 0) goto L_010A;
// 2099 kind = shift; info = rwea
KIND = 32;
INFO = 7;
// 2100 opcode = opcode!!16_0100
OPCODE = OPCODE ^ 256;
// 2101 ->sreg
goto U_1009;
// 2102 %finish
L_010A:;
// 2103 s(ea): ea0:
case_S_6:;
U_1005:;
// 2104 %if y <= 0 %start
if (Y > 0) goto L_010B;
// 2105 opcode = opcode+litmode; !immediate
OPCODE = OPCODE + 60;
// 2106 ->simm
goto U_100A;
// 2107 %finish
L_010B:;
// 2108 %if dy_flags&(ext+spec+rflag+wflag) = ext+spec %c
if (DY->FLAGS & 16384 + 256 + 32 + 16 != 16384 + 256) goto L_010C;
if (DY->FLAGS & 12288 == 0) goto L_010C;
// 2109+ %and dy_flags&proc # 0 %start
// 2110 ! Create transfer vector for external procedure
// 2111 fill own(1) %if ownad&1 # 0
if (OWNAD & 1 == 0) goto L_010D;
FILLOWN(1);
L_010D:;
// 2112 dy_val = ownad
DY->VAL = OWNAD;
// 2113 set own word(16_207C+(mb-a0)<<9); !MOVE.L #xxxxxxxx,MB
SETOWNWORD(8316 + (13 - 9 << 9));
// 2114 set own word(0); set own word(0)
SETOWNWORD(0);
SETOWNWORD(0);
// 2115 set own word(16_4EF9); !JMP xxxxxxxx
SETOWNWORD(20217);
// 2116 set own word(0); set own word(0)
SETOWNWORD(0);
SETOWNWORD(0);
// 2117 %finish
L_010C:;
// 2118 %if (op = lea %or op = pea) %and mode&63 # pcmode %start
if (OP == 78) goto L_010E;
if (OP != 55) goto L_010F;
L_010E:;
if (MODE & 63 == 58) goto L_010F;
// 2119 !taking address: might read or write
// 2120 dy_flags = dy_flags!(mflag+rflag+wflag)
DY->FLAGS = DY->FLAGS | 128 + 32 + 16;
// 2121 ->err %if mode&2_111000 < aregmode+indir
if (MODE & 56 >= 8 + 8) goto L_0110;
goto U_1007;
L_0110:;
// 2122 %else
goto L_0111;
L_010F:;
// 2123 dy_flags = dy_flags!(mflag+rflag)
DY->FLAGS = DY->FLAGS | 128 + 32;
// 2124 %finish
L_0111:;
// 2125 ea1:
U_1008:;
// 2126 extword = dy_val
EXTWORD = DY->VAL;
// 2127 %if mode = c_mode %start; !local
if (MODE != C.MODE) goto L_0112;
// 2128 mode = dispmode+7; extword = extword-c_sp; !convert to use SP
MODE = 40 + 7;
EXTWORD = EXTWORD - C.SP;
// 2129 %if extword < 0 %start
if (EXTWORD >= 0) goto L_0113;
// 2130 intern(4) %if extword < -4
if (EXTWORD >= -4) goto L_0114;
INTERN(4);
L_0114:;
// 2131 mode = aregmode+pre+7
MODE = 8 + 24 + 7;
// 2132 extend stack(-extword)
EXTENDSTACK(-EXTWORD);
// 2133 extword = 0
EXTWORD = 0;
// 2134 %finish
L_0113:;
// 2135 %finish
L_0112:;
// 2136 mode = mode&63; !strip extra flags
MODE = MODE & 63;
// 2137 %if mode >= dispmode %start; !+extra
if (MODE < 40) goto L_0115;
// 2138 f = 0
F = 0;
// 2139 %if mode = pcmode %start
if (MODE != 58) goto L_0116;
// 2140 pcrel(0)
PCREL(0);
// 2141 %finish
L_0116:;
// 2142 %if mode <= dispmode+7 %start
if (MODE > 40 + 7) goto L_0117;
// 2143 %if extword = 0 %start
if (EXTWORD != 0) goto L_0118;
// 2144 ! Premode (just created) or Dispmode (=>Indmode)
// 2145 mode = mode+(aregmode+indir-dispmode) %if mode >= dispmode
if (MODE < 40) goto L_0119;
MODE = MODE + (8 + 8 - 40);
L_0119:;
// 2146 %else
goto L_011A;
L_0118:;
// 2147 fault(dreacherr) %unless -32768 <= extword <= 32767
{
// Double-sided test on EXTWORD (Part I)
int tmp;
if (-32768 > (tmp = EXTWORD)) goto L_011B;
// Double-sided test on EXTWORD (Part II)
if (tmp <= 32767) goto L_011C;
}
L_011B:;
FAULT(6);
L_011C:;
// 2148 store(extword,f)
STORE(EXTWORD, F);
// 2149 %finish
L_011A:;
// 2150 %else
goto L_011D;
L_0117:;
// 2151 mode = absmode+1 %if mode = absmode %and %not is short(extword)=TRUE
if (MODE != 56) goto L_011E;
if (ISSHORT(EXTWORD) == 1) goto L_011E;
MODE = 56 + 1;
L_011E:;
// 2152 store(extword>>16,0) %if mode = absmode+1
if (MODE != 56 + 1) goto L_011F;
STORE((unsigned int)EXTWORD >> 16, 0);
L_011F:;
// 2153 store(extword,f)
STORE(EXTWORD, F);
// 2154 %finish
L_011D:;
// 2155 %finish
L_0115:;
// 2156 mode = ((mode&7)<<3 + mode>>3)<<6 %if kind&shift # 0
if (KIND & 32 == 0) goto L_0120;
MODE = ((MODE & 7) << 3) + ((unsigned int)MODE >> 3) << 6;
L_0120:;
// 2157 opcode = opcode+mode
OPCODE = OPCODE + MODE;
// 2158 ->next
goto U_1004;
// 2159
// 2160 s(exreg&31): !EXG (D,D / A,A / D,A)
case_S_21:;
// 2161 %if mode&2_111000 = 0 %start; !D
if (MODE & 56 != 0) goto L_0121;
// 2162 %if modex&2_111000 # 0 %start; !not D
if (MODEX & 56 == 0) goto L_0122;
// 2163 opcode = opcode!!16_C8; info = areg
OPCODE = OPCODE ^ 200;
INFO = 2;
// 2164 %finish
L_0122:;
// 2165 -> sreg
goto U_1009;
// 2166 %finish
L_0121:;
// 2167 opcode = opcode+8; info = areg
OPCODE = OPCODE + 8;
INFO = 2;
// 2168 -> sareg
goto U_100B;
// 2169 s(qpre):
case_S_20:;
// 2170 -> sreg %if mode&2_111000 = 0; !D
if (MODE & 56 != 0) goto L_0123;
goto U_1009;
L_0123:;
// 2171 opcode = opcode+8; info = preareg+shift
OPCODE = OPCODE + 8;
INFO = 19 + 32;
// 2172 s(preareg):
case_S_19:;
// 2173 mode = mode+(post-pre)
MODE = MODE + (16 - 24);
// 2174 s(postareg):
case_S_14:;
// 2175 mode = mode-post
MODE = MODE - 16;
// 2176 s(areg): sareg:
case_S_2:;
U_100B:;
// 2177 mode = mode-8
MODE = MODE - 8;
// 2178 s(reg): sreg:
case_S_1:;
U_1009:;
// 2179 -> err %unless mode&2_111000 = 0
if (MODE & 56 == 0) goto L_0124;
goto U_1007;
L_0124:;
// 2180 mode = mode&7
MODE = MODE & 7;
// 2181 mode = mode<<9 %if kind&shift # 0
if (KIND & 32 == 0) goto L_0125;
MODE = MODE << 9;
L_0125:;
// 2182 opcode = opcode+mode
OPCODE = OPCODE + MODE;
// 2183 ->next
goto U_1004;
// 2184
// 2185 s(qreg): !Shift formats -- quick,Dx / Dy,Dx / 1,<ea> (W)
case_S_13:;
// 2186 opcode = opcode+16_20 %and ->sreg %if y > 0
if (Y <= 0) goto L_0126;
OPCODE = OPCODE + 32;
goto U_1009;
L_0126:;
// 2187 %if y = one %and size = 2 %and modex&2_111000 # 0 %start
if (Y != -2) goto L_0127;
if (SIZE != 2) goto L_0127;
if (MODEX & 56 == 0) goto L_0127;
// 2188 opcode = opcode!!16_290
OPCODE = OPCODE ^ 656;
// 2189 ->next
goto U_1004;
// 2190 %finish
L_0127:;
// 2191 s(quick):
case_S_4:;
// 2192 -> err %if y >= 0
if (Y < 0) goto L_0128;
goto U_1007;
L_0128:;
// 2193 y = litval(y)
Y = LITVAL(Y);
// 2194 ->err %unless y <= 8
if (Y <= 8) goto L_0129;
goto U_1007;
L_0129:;
// 2195 opcode = opcode+(y&7)<<9; !(always aligned to bit9)
OPCODE = OPCODE + ((Y & 7) << 9);
// 2196 ->next
goto U_1004;
// 2197
// 2198 s(tquick): !(TRAP)
case_S_10:;
// 2199 -> err %unless -30 <= y %and y&1 = 0; !{0<=}litval(y)<=15
if (-30 > Y) goto L_012A;
if (Y & 1 == 0) goto L_012B;
L_012A:;
goto U_1007;
L_012B:;
// 2200 s(mquick):
case_S_5:;
// 2201 ->err %unless y <= 0 %and y >= litmite
if (Y > 0) goto L_012C;
if (Y >= -255) goto L_012D;
L_012C:;
goto U_1007;
L_012D:;
// 2202 y = litval(y)
Y = LITVAL(Y);
// 2203 opcode = opcode+y&255
OPCODE = OPCODE + (Y & 255);
// 2204 ->next
goto U_1004;
// 2205 s(rel):
case_S_11:;
// 2206 ->s(mquick) %if y <= 0 %and y >= litmite
if (Y > 0) goto L_012E;
if (Y < -255) goto L_012E;
S_line = __LINE__;
S_file = __FILE__;
S_index = 5;
goto case_S_dispatch;
L_012E:;
// 2207 s(longrel):
case_S_12:;
// 2208 ->simm %if y <= 0
if (Y > 0) goto L_012F;
goto U_100A;
L_012F:;
// 2209 dy_flags = dy_flags!rflag
DY->FLAGS = DY->FLAGS | 32;
// 2210 extword = dy_val
EXTWORD = DY->VAL;
// 2211 f = 0
F = 0;
// 2212 pcrel(longrel-kind&31)
PCREL(12 - (KIND & 31));
// 2213 store(extword,f)
STORE(EXTWORD, F);
// 2214 ->next
goto U_1004;
// 2215
// 2216 s(ireg): !immediate or reg
case_S_3:;
// 2217 ->sreg %if y > 0
if (Y <= 0) goto L_0130;
goto U_1009;
L_0130:;
// 2218 opcode = opcode!!16_900
OPCODE = OPCODE ^ 2304;
// 2219 s(imm):
case_S_9:;
// 2220 ->err %if y > 0
if (Y <= 0) goto L_0131;
goto U_1007;
L_0131:;
// 2221 simm:
U_100A:;
// 2222 y = litval(y)
Y = LITVAL(Y);
// 2223 store(y>>16,0) %if size = 4
if (SIZE != 4) goto L_0132;
STORE((unsigned int)Y >> 16, 0);
L_0132:;
// 2224 put:
U_100C:;
// 2225 store(y,0)
STORE(Y, 0);
// 2226 ->next
goto U_1004;
// 2227 s(ximm): !MOVEM (IMM,EA or EA,IMM)
case_S_17:;
// 2228 %if y > 0 %start; !EA,IMM
if (Y <= 0) goto L_0133;
// 2229 opcode = opcode!!16_0400
OPCODE = OPCODE ^ 1024;
// 2230 i = x; x = y; y = i
I = X;
X = Y;
Y = I;
// 2231 dx == dy; modex = mode
DX = (struct IDENTINFO *)DY;
MODEX = MODE;
// 2232 %finish
L_0133:;
// 2233 y = litval(y)
Y = LITVAL(Y);
// 2234 %if prea0 <= x <= prea7 %start; !-(SP)
{
// Double-sided test on X (Part I)
int tmp;
if (33 > (tmp = X)) goto L_0134;
// Double-sided test on X (Part II)
if (tmp > 40) goto L_0134;
}
// 2235 i = 0; !Reverse bits
I = 0;
// 2236 i = i<<1+y&1 %and y = y>>1 %for extword = 1,1,16
// %for EXTWORD = 1, 1, 16 %cycle
{
EXTWORD = 0;
L_0135:
if (EXTWORD == 16) goto L_0136;
EXTWORD += 1;
I = (I << 1) + (Y & 1);
Y = (unsigned int)Y >> 1;
goto L_0135;
}
L_0136:;
// 2237 y = i
Y = I;
// 2238 %finish
L_0134:;
// 2239 ->put
goto U_100C;
// 2240 s(data):
case_S_18:;
// 2241 -> err %if y <= 0
if (Y > 0) goto L_0138;
goto U_1007;
L_0138:;
// 2242 -> err %if mode # absmode
if (MODE == 56) goto L_0139;
goto U_1007;
L_0139:;
// 2243 opcode = dy_val
OPCODE = DY->VAL;
// 2244 ->next
goto U_1004;
// 2245 err:
U_1007:;
// 2246 fault(moperr)
FAULT(26);
// 2247 ->next
goto U_1004;
// 2248 %end; !plant
case_S_dispatch:
if (S_index < 0 || S_index > 21)
_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 PLANT */
// 2249
// 2250 %routine PLANTLIT(%integer op,v,x)
void PLANTLIT(int OP, int V, int X) {
// 2251 %if v >= 0 %start
if (V < 0) goto L_013A;
// 2252 %if v > smallmax %then litstore(litmax) = v %and v = litmax %c
if (V <= 1023) goto L_013B;
LITSTORE[199] = V;
V = -2048;
goto L_013C;
L_013B:;
V = -(V << 1);
L_013C:;
// 2253+ %else v = -(v<<1)
// 2254 %else
goto L_013D;
L_013A:;
// 2255 %if v < smallmin %then litstore(litmax) = v %and v = litmax %c
if (V >= -1024) goto L_013E;
LITSTORE[199] = V;
V = -2048;
goto L_013F;
L_013E:;
V = (V << 1) + 1;
L_013F:;
// 2256+ %else v = v<<1+1
// 2257 %finish
L_013D:;
// 2258 plant(op,v,x)
PLANT(OP, V, X);
// 2259 %end
return;
} /* end of PLANTLIT */
// 2260
// 2261 %routine PLANTLIT2(%integer op,y,v)
void PLANTLIT2(int OP, int Y, int V) {
// 2262 %if v >= 0 %start
if (V < 0) goto L_0140;
// 2263 %if v > smallmax %then litstore(litmax) = v %and v = litmax %c
if (V <= 1023) goto L_0141;
LITSTORE[199] = V;
V = -2048;
goto L_0142;
L_0141:;
V = -(V << 1);
L_0142:;
// 2264+ %else v = -(v<<1)
// 2265 %else
goto L_0143;
L_0140:;
// 2266 %if v < smallmin %then litstore(litmax) = v %and v = litmax %c
if (V >= -1024) goto L_0144;
LITSTORE[199] = V;
V = -2048;
goto L_0145;
L_0144:;
V = (V << 1) + 1;
L_0145:;
// 2267+ %else v = v<<1+1
// 2268 %finish
L_0143:;
// 2269 plant(op,y,v)
PLANT(OP, Y, V);
// 2270 %end
return;
} /* end of PLANTLIT2 */
// 2271
// 2272 %routine ALIGN(%integername AD, %integer size)
void ALIGN(int *AD, int SIZE) {
// 2273 !Impose alignment requirements on address AD for
// 2274 ! operand of length SIZE
// 2275 !provisional basis for bit addressing
// 2276 ! -- multiples of 16 on Word boundary
// 2277 ! -- multiples of 8 on Byte boundary
// 2278 ! -- other < 32 within one Longword
// 2279 !%constinteger BITMASK=16_E0000000
// 2280 ! %if size&7 = 0 %start
// 2281 ! ad = (ad&(\bitmask))+1 %if ad&bitmask # 0; !ensure on byte boundary
// 2282 ! %return %if size&8 # 0
// 2283 ! %else
// 2284 ! %return %if size < 16
// 2285 ! %return %if ad>>29+(ad&1)<<3+size <= 32
// 2286 ! ad = (ad&(\bitmask))+1 %if ad&bitmask # 0
// 2287 ! %finish
// 2288 ad = ad+1 %if size # 1 %and ad&1 # 0
if (SIZE == 1) goto L_0146;
if (*AD & 1 == 0) goto L_0146;
*AD = *AD + 1;
L_0146:;
// 2289 %end
return;
} /* end of ALIGN */
// 2290
// 2291 %routine ADDIMM(%integer bytes,dest)
void ADDIMM(int BYTES, int DEST) {
// 2292 %if bytes <= 0 %start
if (BYTES > 0) goto L_0147;
// 2293 %return %if bytes = 0
if (BYTES != 0) goto L_0148;
return;
L_0148:;
// 2294 %if bytes >= -8 %start
if (BYTES < -8) goto L_0149;
// 2295 plantlit(sub,-bytes,dest)
PLANTLIT(3, -BYTES, DEST);
// 2296 %return
return;
// 2297 %finish
L_0149:;
// 2298 %finish %else %if bytes <= 8 %start
goto L_014A;
L_0147:;
if (BYTES > 8) goto L_014B;
// 2299 plantlit(add,bytes,dest)
PLANTLIT(2, BYTES, DEST);
// 2300 %return
return;
// 2301 %finish
L_014B:;
L_014A:;
// 2302 %if a0 <= dest <= a7 %and is short(bytes)=TRUE %start
{
// Double-sided test on DEST (Part I)
int tmp;
if (9 > (tmp = DEST)) goto L_014C;
// Double-sided test on DEST (Part II)
if (tmp > 16) goto L_014C;
}
if (ISSHORT(BYTES) != 1) goto L_014C;
// 2303 plant(lea,tempd(dest,bytes),dest)
PLANT(78, TEMPD(DEST, BYTES), DEST);
// 2304 %return
return;
// 2305 %finish
L_014C:;
// 2306 plantlit(add,bytes,dest)
PLANTLIT(2, BYTES, DEST);
// 2307 %end
return;
} /* end of ADDIMM */
// 2308
// 2309 %integer%fn FREE REG(%integer rset)
int FREEREG(int RSET) {
// 2310 %integer r,r1
int R;
int R1;
// 2311 r = d0; rset = rset&free
R = 1;
RSET = RSET & FREE;
// 2312 %if rset = 0 %then fault(plexerr) %else %start
if (RSET != 0) goto L_014D;
FAULT(2);
goto L_014E;
L_014D:;
// 2313 r = r+1 %and rset = rset>>1 %while rset&1 = 0
L_014F:;
if (RSET & 1 != 0) goto L_0150;
R = R + 1;
RSET = (unsigned int)RSET >> 1;
goto L_014F;
L_0150:;
// 2314 r1 = r
R1 = R;
// 2315 %while c_reg_content(r) # undef %cycle
L_0151:;
if (C.REG.CONTENT[R - 1] == 16) goto L_0152;
// 2316 r = r+1; rset = rset>>1
R = R + 1;
RSET = (unsigned int)RSET >> 1;
// 2317 r = r1 %and %exit %if rset = 0
if (RSET != 0) goto L_0153;
R = R1;
goto L_0152;
L_0153:;
// 2318 r = r+1 %and rset = rset>>1 %while rset&1 = 0
L_0154:;
if (RSET & 1 != 0) goto L_0155;
R = R + 1;
RSET = (unsigned int)RSET >> 1;
goto L_0154;
L_0155:;
// 2319 %repeat
goto L_0151;
L_0152:;
// 2320 free = free-d0b<<(r-d0)
FREE = FREE - (1 << R - 1);
// 2321 %finish
L_014E:;
// 2322 %result = r
return R;
// 2323 %end
} /* end of FREEREG */
// 2324
// 2325 %routine MOVE BLOCK(%integer source,dest,bytes)
void MOVEBLOCK(int SOURCE, int DEST, int BYTES) {
// 2326 !Generate code to move a fixed number of bytes
// 2327 ! from SOURCE (0,reg,pre,post) to DEST (pre,post)
// 2328 ! -- source & dest addresses both even if BYTES even
// 2329 %integer op,f,r,pc1
int OP;
int F;
int R;
int PC1;
// 2330 op = move; op = clr %if source = 0
OP = 1;
if (SOURCE != 0) goto L_0156;
OP = 52;
L_0156:;
// 2331 %if bytes <= 16 %and bytes&1 = 0 %start
if (BYTES > 16) goto L_0157;
if (BYTES & 1 != 0) goto L_0157;
// 2332 plant(op,source,dest) %and bytes = bytes-4 %while bytes >= 4
L_0158:;
if (BYTES < 4) goto L_0159;
PLANT(OP, SOURCE, DEST);
BYTES = BYTES - 4;
goto L_0158;
L_0159:;
// 2333 plant(op+2<<8,source,dest) %if bytes >= 2
if (BYTES < 2) goto L_015A;
PLANT(OP + (2 << 8), SOURCE, DEST);
L_015A:;
// 2334 %else; !use loop
goto L_015B;
L_0157:;
// 2335 op = op+1<<8
OP = OP + (1 << 8);
// 2336 %if bytes&1 = 0 %start
if (BYTES & 1 != 0) goto L_015C;
// 2337 bytes = bytes>>1; op = op+1<<8; !.B -> .W
BYTES = (unsigned int)BYTES >> 1;
OP = OP + (1 << 8);
// 2338 %if bytes&1 = 0 %start
if (BYTES & 1 != 0) goto L_015D;
// 2339 bytes = bytes>>1; op = op+2<<8; !.W -> .L
BYTES = (unsigned int)BYTES >> 1;
OP = OP + (2 << 8);
// 2340 %finish
L_015D:;
// 2341 %finish
L_015C:;
// 2342 f = free
F = FREE;
// 2343 %if bytes <= 32768 %and free&anydreg # 0 %start
if (BYTES > 32768) goto L_015E;
if (FREE & 239 == 0) goto L_015E;
// 2344 r = free reg(anydreg)
R = FREEREG(239);
// 2345 plantlit(move,bytes-1,r)
PLANTLIT(1, BYTES - 1, R);
// 2346 pc1 = pc
PC1 = PC;
// 2347 plant(op,source,dest)
PLANT(OP, SOURCE, DEST);
// 2348 plantlit2(dbra,r,(pc1-pc-1)<<1)
PLANTLIT2(81, R, PC1 - PC - 1 << 1);
// 2349 bytes = undef
BYTES = 16;
// 2350 %else
goto L_015F;
L_015E:;
// 2351 r = free reg(anydreg!bregb)
R = FREEREG(239 | 16);
// 2352 plantlit(move,bytes,r)
PLANTLIT(1, BYTES, R);
// 2353 pc1 = pc
PC1 = PC;
// 2354 plant(op,source,dest)
PLANT(OP, SOURCE, DEST);
// 2355 plant(sub,one,r)
PLANT(3, -2, R);
// 2356 plantlit2(bne,0,(pc1-pc-1)<<1)
PLANTLIT2(22, 0, PC1 - PC - 1 << 1);
// 2357 bytes = 0
BYTES = 0;
// 2358 %finish
L_015F:;
// 2359 c_reg_content(r) = bytes; free = f
C.REG.CONTENT[R - 1] = BYTES;
FREE = F;
// 2360 %finish
L_015B:;
// 2361 %end
return;
} /* end of MOVEBLOCK */
// 2362
// 2363 %routine UPDATE SP
void UPDATESP(void) {
// 2364 %return %if c_val = 0
if (C.VAL != 0) goto L_0160;
return;
L_0160:;
// 2365 %if c_val < 0 %start
if (C.VAL >= 0) goto L_0161;
// 2366 addimm(-c_val,a7); c_sp = c_sp-c_val
ADDIMM(-C.VAL, 16);
C.SP = C.SP - C.VAL;
// 2367 %else
goto L_0162;
L_0161:;
// 2368 %if control&assmask = 0 %then addimm(-c_val,a7) {no unass check} %c
if (CONTROL & 251658240 != 0) goto L_0163;
ADDIMM(-C.VAL, 16);
goto L_0164;
L_0163:;
MOVEBLOCK(8, 40, C.VAL);
L_0164:;
// 2369+ %else move block(d7,prea7,c_val)
// 2370 extend stack(c_val)
EXTENDSTACK(C.VAL);
// 2371 %finish
L_0162:;
// 2372 c_val = 0
C.VAL = 0;
// 2373 %end
return;
} /* end of UPDATESP */
// 2374
// 2375 %routine GET BOUNDS(%integer t,%integername lo,hi)
void GETBOUNDS(int T, int *LO, int *HI) {
// 2376 ![Note: sets HI after LO -- see dummy params in VALOK]
// 2377 %if dict(t)_type = t # inttype %start; !basetype
{
// Double-sided test on T (Part I)
int tmp;
if (DICT[T].TYPE != (tmp = T)) goto L_0165;
// Double-sided test on T (Part II)
if (tmp == 43) goto L_0165;
}
// 2378 lo = 0; hi = dict(t)_size
*LO = 0;
*HI = DICT[T].SIZE;
// 2379 %else
goto L_0166;
L_0165:;
// 2380 %if dict(t+1)_mode # litmode %then lo = minint %c
if (DICT[T + 1].MODE == 60) goto L_0167;
*LO = -2147483648;
goto L_0168;
L_0167:;
*LO = DICT[T + 1].VAL;
L_0168:;
// 2381+ %else lo = dict(t+1)_val
// 2382 %if dict(t+2)_mode # litmode %then hi = maxint %c
if (DICT[T + 2].MODE == 60) goto L_0169;
*HI = 2147483647;
goto L_016A;
L_0169:;
*HI = DICT[T + 2].VAL;
L_016A:;
// 2383+ %else hi = dict(t+2)_val
// 2384 %finish
L_0166:;
// 2385 %end
return;
} /* end of GETBOUNDS */
// 2386
// 2387 %integer%fn SIZE(%integer t)
int SIZE(int T) {
// 2388 !Storage size for given object type in bytes
// 2389 ! > 0 for operand passable in register
// 2390 ! < 0 otherwise
// 2391 %integer s,ss,lo,hi
int S;
int SS;
int LO;
int HI;
// 2392 %record(identinfo)%name tp
struct IDENTINFO *TP;
// 2393 tp == dict(t)
TP = (struct IDENTINFO *)/*?*/ &DICT[T];
// 2394 %if tp_flags&nonord = 0 %start
if (TP->FLAGS & 12 != 0) goto L_016B;
// 2395 %result = tp_size %if tp_type # t; !subrange
if (TP->TYPE == T) goto L_016C;
return TP->SIZE;
L_016C:;
// 2396 %result = 4 %if tp_type = inttype
if (TP->TYPE != 43) goto L_016D;
return 4;
L_016D:;
// 2397 %result = 1 %if tp_size <= 255
if (TP->SIZE > 255) goto L_016E;
return 1;
L_016E:;
// 2398 %result = 2
return 2;
// 2399 %finish
L_016B:;
// 2400 %result = tp_val %if tp_flags&cat = recy
if (TP->FLAGS & 15 != 12) goto L_016F;
return TP->VAL;
L_016F:;
// 2401 %result = tp_size %if tp_flags&cat # arry
if (TP->FLAGS & 15 == 9) goto L_0170;
return TP->SIZE;
L_0170:;
// 2402 %result = 0 %if tp_mode >= framemode; !dynamic bounds
if (TP->MODE < 168) goto L_0171;
return 0;
L_0171:;
// 2403 s = 4; s = size(tp_type) %if tp_flags >= 0
S = 4;
if (TP->FLAGS < 0) goto L_0172;
S = SIZE(TP->TYPE);
L_0172:;
// 2404 get bounds(tp_xtype,lo,hi)
GETBOUNDS(TP->XTYPE, /*?*/ &LO, /*?*/ &HI);
// 2405 %result = 0 %if lo = minint %or hi = maxint
if (LO == -2147483648) goto L_0173;
if (HI != 2147483647) goto L_0174;
L_0173:;
return 0;
L_0174:;
// 2406 ss = (hi-lo+1)*s
SS = (HI - LO + 1) * S;
// 2407 %result = ss %if ss <= 0
if (SS > 0) goto L_0175;
return SS;
L_0175:;
// 2408 %if s = 1 %start; !byte element size (not nec aligned)
if (S != 1) goto L_0176;
// 2409 %result = ss %if ss = 1
if (SS != 1) goto L_0177;
return SS;
L_0177:;
// 2410 %else; !word,long element size (aligned)
goto L_0178;
L_0176:;
// 2411 %result = ss %if ss <= 4
if (SS > 4) goto L_0179;
return SS;
L_0179:;
// 2412 %finish
L_0178:;
// 2413 %result = -ss
return -SS;
// 2414 %end
} /* end of SIZE */
// 2415
// 2416 %integer%fn NSIZE(%record(identinfo)%name dp)
int NSIZE(struct IDENTINFO * DP) {
// 2417 %result = 4 %if dp_flags&(name+indirect) # 0
if (DP->FLAGS & (-32768) + 2048 == 0) goto L_017A;
return 4;
L_017A:;
// 2418 %result = 0 %if dp_flags&proc # 0; ![??]
if (DP->FLAGS & 12288 == 0) goto L_017B;
return 0;
L_017B:;
// 2419 %result = size(dp_type)
return SIZE(DP->TYPE);
// 2420 %end
} /* end of NSIZE */
// 2421
// 2422 %integer%fn TSIZE(%integer t)
int TSIZE(int T) {
// 2423 %result = size(dict(t)_type)
return SIZE(DICT[T].TYPE);
// 2424 %end
} /* end of TSIZE */
// 2425
// 2426 %routine FORGET(%integer r)
void FORGET(int R) {
// 2427 c_reg_content(r) = undef
C.REG.CONTENT[R - 1] = 16;
// 2428 %end
return;
} /* end of FORGET */
// 2429 %routine FORGET CC
void FORGETCC(void) {
// 2430 c_reg_ccy = undef
C.REG.CCY = 16;
// 2431 %end
return;
} /* end of FORGETCC */
// 2432 %routine FORGET REGS
void FORGETREGS(void) {
// 2433 %shortname cc
short int *CC;
// 2434 %integer i
int I;
// 2435 i = maxareg
I = 12;
// 2436 cc==c_reg_content(i)
CC = (short int *)/*?*/ &C.REG.CONTENT[I - 1];
// 2437 %cycle
L_017C:;
// 2438 cc = undef
*CC = 16;
// 2439 %exit %if cc == c_reg_content(d0)
if (_imp_ADDR((void *)(CC)) != _imp_ADDR((void *)(/*?*/ &C.REG.CONTENT[0]))) goto L_017D;
goto L_017E;
L_017D:;
// 2440 i = i-1; cc==c_reg_content(i)
I = I - 1;
CC = (short int *)/*?*/ &C.REG.CONTENT[I - 1];
// 2441 %repeat
goto L_017C;
L_017E:;
// 2442 c_reg_ccy = undef; c_reg_line = -9
C.REG.CCY = 16;
C.REG.LINE = -9;
// 2443 %end
return;
} /* end of FORGETREGS */
// 2444 %routine FORGET TRIPLES
void FORGETTRIPLES(void) {
// 2445 litpos = litmin; explo = explim; oldexplo = explim
LITPOS = -2247;
EXPLO = EXPLIM;
OLDEXPLO = EXPLIM;
// 2446 %end
return;
} /* end of FORGETTRIPLES */
// 2447 %routine FORGET ALL
void FORGETALL(void) {
// 2448 %integer i,j
int I;
int J;
// 2449 %record(contentinfo)%name lr
struct CONTENTINFO *LR;
// 2450 forget regs
FORGETREGS();
// 2451 j = dictlim
J = DICTLIM;
// 2452 %cycle
L_017F:;
// 2453 j = j+1
J = J + 1;
// 2454 %exit %if j >= curlab
if (J < CURLAB) goto L_0180;
goto L_0181;
L_0180:;
// 2455 lr == lreg(j-dictlim)
LR = (struct CONTENTINFO *)/*?*/ &LREG[J - DICTLIM];
// 2456 lr_content(i) = undef %for i = d0,1,maxareg
// %for I = 1, 1, 12 %cycle
{
I = 0;
L_0182:
if (I == 12) goto L_0183;
I += 1;
LR->CONTENT[I - 1] = 16;
goto L_0182;
}
L_0183:;
// 2457 lr_ccx = undef
LR->CCX = 16;
// 2458 %repeat
goto L_017F;
L_0181:;
// 2459 forget triples
FORGETTRIPLES();
// 2460 %end
return;
} /* end of FORGETALL */
// 2461
// 2462 %routine DEFINE JUMPS(%integer chain)
void DEFINEJUMPS(int CHAIN) {
// 2463 %integer i,j,k
int I;
int J;
int K;
// 2464 chain = -chain
CHAIN = -CHAIN;
// 2465 %return %if chain <= 0; !no jumps to this label
if (CHAIN > 0) goto L_0184;
return;
L_0184:;
// 2466 c_forward = c_forward-1; c_access = 1
C.FORWARD = C.FORWARD - 1;
C.ACCESS = 1;
// 2467 %cycle
L_0185:;
// 2468 i = prog(chain)
I = PROG[CHAIN];
// 2469 %if pflag(chain) = jump %start; !shortenable
if (PFLAG[CHAIN] != 2) goto L_0186;
// 2470 j = chain-pflag(chain-1); !adjusted jump position
J = CHAIN - PFLAG[CHAIN - 1];
// 2471 k = (pc-c_shorts-j)<<1; !displacement
K = PC - C.SHORTS - J << 1;
// 2472 %if k > 2 %and k <= 127 %start
if (K <= 2) goto L_0187;
if (K > 127) goto L_0187;
// 2473 %if c_shorts = 255 %start
if (C.SHORTS != 255) goto L_0188;
// 2474 zaps = zaps+100
ZAPS = ZAPS + 100;
// 2475 %else
goto L_0189;
L_0188:;
// 2476 c_shorts = c_shorts+1; shorts = shorts+1
C.SHORTS = C.SHORTS + 1;
SHORTS = SHORTS + 1;
// 2477 pflag(chain) = shortjump
PFLAG[CHAIN] = 1;
// 2478 j = chain
J = CHAIN;
// 2479 %cycle
L_018A:;
// 2480 pflag(j) = pflag(j)+1 %if pflag(j) >= zeroshorts
if (PFLAG[J] < 8) goto L_018B;
PFLAG[J] = PFLAG[J] + 1;
L_018B:;
// 2481 j = j+1
J = J + 1;
// 2482 %repeat %until j = pc
if (J == PC) goto L_018C;
goto L_018A;
L_018C:;
// 2483 %finish
L_0189:;
// 2484 %finish
L_0187:;
// 2485 %finish
L_0186:;
// 2486 prog(chain) = pc
PROG[CHAIN] = PC;
// 2487 chain = i
CHAIN = I;
// 2488 %repeat %until chain <= 0
if (CHAIN <= 0) goto L_018D;
goto L_0185;
L_018D:;
// 2489 %end
return;
} /* end of DEFINEJUMPS */
// 2490
// 2491 %routine SAVE CONTEXT(%integer l)
void SAVECONTEXT(int L) {
// 2492 !Store register content associated with label L
// 2493 ! (prior to generating forward branch)
// 2494 %integer r
int R;
// 2495 %record(contentinfo)%name lr
struct CONTENTINFO *LR;
// 2496 %return %if l-dictlim < 0 {user label}
if (L - DICTLIM >= 0) goto L_018E;
return;
L_018E:;
// 2497 lr == lreg(l-dictlim)
LR = (struct CONTENTINFO *)/*?*/ &LREG[L - DICTLIM];
// 2498 %if dict(l)_val >= 0 %start; !first jump to this label
if (DICT[L].VAL < 0) goto L_018F;
// 2499 dict(l)_val = 0
DICT[L].VAL = 0;
// 2500 lr = c_reg
*LR = C.REG;
// 2501 c_forward = c_forward+1
C.FORWARD = C.FORWARD + 1;
// 2502 %else
goto L_0190;
L_018F:;
// 2503 %for r = d0,1,maxareg %cycle
// %for R = 1, 1, 12 %cycle
{
R = 0;
L_0191:
if (R == 12) goto L_0192;
R += 1;
// 2504 lr_content(r) = undef %if lr_content(r) # c_reg_content(r)
if (LR->CONTENT[R - 1] == C.REG.CONTENT[R - 1]) goto L_0193;
LR->CONTENT[R - 1] = 16;
L_0193:;
// 2505 %repeat
goto L_0191;
}
L_0192:;
// 2506 lr_ccy = undef %if lr_ccx # c_reg_ccx %or lr_ccy # c_reg_ccy
if (LR->CCX != C.REG.CCX) goto L_0137;
if (LR->CCY == C.REG.CCY) goto L_0194;
L_0137:;
LR->CCY = 16;
L_0194:;
// 2507 lr_line = -9 %if lr_line # c_reg_line
if (LR->LINE == C.REG.LINE) goto L_0195;
LR->LINE = -9;
L_0195:;
// 2508 %finish
L_0190:;
// 2509 %end
return;
} /* end of SAVECONTEXT */
// 2510
// 2511 %routine SRCALL(%integer x)
void SRCALL(int X) {
// 2512 %routine PUT PRIM(%record(identinfo)%name DX)
void PUTPRIM(struct IDENTINFO * DX) {
// 2513 !<<IMP
// 2514 !* PRIMGEN marker 3
// 2515 %own%short%array PRIMCODE(1:396) =
static short int PRIMCODE[396] = {
5441, 29298, 24953, 8290, 28533, 28260, 29472, 25976, 25445, 25956, 25956, 45208, 28166, 37016, 27664,
53408, 16890, 65502, 9216, 29186, 28790, 20216, 16122, 19032, 26124, 18496, 19008, 26128, 18496, 49368,
20085, 12033, 8704, 49896, 65534, 24584, 12033, 8704, 18496, 49872, 18497, 49368, 53377, 8735, 20085,
4949, 28257, 29555, 26983, 28261, 25632, 30305, 29289, 24930, 27749, 26124, 16890, 65512, 29185, 28760,
20216, 16122, 20085, 3913, 28278, 24940, 26980, 8289, 25700, 29285, 29555, 28172, 16890, 65516, 29185,
28760, 20216, 16122, 20085, 5459, 29793, 25451, 8307, 28769, 25445, 8293, 30824, 24949, 29556, 25956,
55439, 47238, 27662, 17028, 16890, 65504, 29187, 28757, 20216, 16122, 17028, 20085, 5953, 29298, 24953,
8290, 28533, 28260, 29472, 26990, 29545, 25701, 8303, 30068, 37506, 28428, 16890, 65506, 29187, 28757,
20216, 16122, 17537, 21121, 20216, 16116, 20085, 3667, 29810, 26990, 26400, 29807, 28448, 25193, 26496,
6161, 36868, 25860, 36880, 25612, 16890, 65508, 29187, 28753, 20216, 16122, 4120, 26380, 53521, 5016,
18433, 20996, 21248, 26358, 8265, 20085, 16128, 28673, 7808, 8271, 21647, 20085, 4686, 28448, 29552,
24931, 25888, 26223, 29216, 24946, 29281, 31104, 22144, 58496, 58760, 27912, 8271, 37312, 45510, 27662,
9216, 16890, 65496, 29185, 28786, 20216, 16122, 8287, 58504, 24580, 18496, 12039, 20936, 65532, 18496,
20936, 65524, 20176, 20085, 4425, 28278, 24940, 26980, 8229, 26223, 29216, 27759, 28528, 12032, 36994,
26400, 12033, 26376, 20152, 16110, 19072, 27918, 20623, 16890, 65496, 29185, 28757, 20216, 16122, 19073,
26350, 8735, 8223, 20085, 3151, 30068, 8303, 26144, 29281, 28263, 25984, 16890, 65520, 29185, 28758,
20216, 16122, 20085, 4949, 28257, 29555, 26983, 28261, 25632, 30305, 29289, 24930, 27749, 45308, 0,
28442, 45820, 0, 28436, 48656, 26118, 48680, 1, 26378, 48657, 26130, 48681, 1, 26124, 16890,
65482, 29186, 28756, 20216, 16122, 18663, 49344, 16960, 4120, 26416, 16961, 4633, 26402, 21376, 21377,
45121, 28178, 37440, 45321, 22216, 65532, 26114, 17473, 19679, 771, 20085, 45321, 22217, 65532, 26354,
29185, 19679, 771, 20085, 4113, 17472, 19679, 771, 20085, 3667, 29810, 26990, 26400, 29807, 28448,
25193, 26496, 45072, 25612, 16890, 65514, 29187, 28753, 20216, 16122, 17024, 4112, 4824, 20936, 65532,
20085, 3667, 29810, 26990, 26400, 29807, 28448, 25193, 26496, 45072, 25612, 16890, 65514, 29185, 28758,
20216, 16122, 576, 254, 9311, 40640, 21903, 8783, 49096, 28174, 4112, 4824, 20936, 65532, 8271,
8783, 20178, 4120, 21129, 53440, 53952, 4896, 20936, 65532, 8271, 8783, 20178, 20085, 17391, 65280,
9288, 54720, 8265, 37504, 27652, 16913, 20085, 4737, 21017, 4826, 20937, 65532, 20085, 28682, 20216,
15984, 20085, 28704, 20216, 15984, 20085};
// 2516+ 16_1541,16_7272,16_6179,16_2062,16_6F75,16_6E64,16_7320,16_6578,
// 2517+ 16_6365,16_6564,16_6564,16_B098,16_6E06,16_9098,16_6C10,16_D0A0,
// 2518+ 16_41FA,16_FFDE,16_2400,16_7202,16_7076,16_4EF8,16_3EFA,16_4A58,
// 2519+ 16_660C,16_4840,16_4A40,16_6610,16_4840,16_C0D8,16_4E75,
// 2520+ 16_2F01,16_2200,16_C2E8,16_FFFE,16_6008,16_2F01,16_2200,16_4840,
// 2521+ 16_C2D0,16_4841,16_C0D8,16_D081,16_221F,16_4E75,
// 2522+ 16_1355,16_6E61,16_7373,16_6967,16_6E65,16_6420,16_7661,16_7269,
// 2523+ 16_6162,16_6C65,16_660C,16_41FA,16_FFE8,16_7201,16_7058,16_4EF8,
// 2524+ 16_3EFA,16_4E75,
// 2525+ 16_0F49,16_6E76,16_616C,16_6964,16_2061,16_6464,16_7265,16_7373,
// 2526+ 16_6E0C,16_41FA,16_FFEC,16_7201,16_7058,16_4EF8,16_3EFA,16_4E75,
// 2527+ 16_1553,16_7461,16_636B,16_2073,16_7061,16_6365,16_2065,16_7868,
// 2528+ 16_6175,16_7374,16_6564,16_D88F,16_B886,16_6C0E,16_4284,16_41FA,
// 2529+ 16_FFE0,16_7203,16_7055,16_4EF8,16_3EFA,16_4284,16_4E75,
// 2530+ 16_1741,16_7272,16_6179,16_2062,16_6F75,16_6E64,16_7320,16_696E,
// 2531+ 16_7369,16_6465,16_206F,16_7574,16_9282,16_6F0C,16_41FA,16_FFE2,
// 2532+ 16_7203,16_7055,16_4EF8,16_3EFA,16_4481,16_5281,16_4EF8,16_3EF4,
// 2533+ 16_4E75,
// 2534+ 16_0E53,16_7472,16_696E,16_6720,16_746F,16_6F20,16_6269,16_6780,
// 2535+ 16_1811,16_9004,16_6504,16_9010,16_640C,16_41FA,16_FFE4,16_7203,
// 2536+ 16_7051,16_4EF8,16_3EFA,16_1018,16_670C,16_D111,16_1398,16_4801,
// 2537+ 16_5204,16_5300,16_66F6,16_2049,16_4E75,
// 2538+ 16_3F00,16_7001,16_1E80,16_204F,16_548F,16_4E75,
// 2539+ 16_124E,16_6F20,16_7370,16_6163,16_6520,16_666F,16_7220,16_6172,
// 2540+ 16_7261,16_7980,16_5680,16_E480,16_E588,16_6D08,16_204F,16_91C0,
// 2541+ 16_B1C6,16_6C0E,16_2400,16_41FA,16_FFD8,16_7201,16_7072,16_4EF8,
// 2542+ 16_3EFA,16_205F,16_E488,16_6004,16_4840,16_2F07,16_51C8,16_FFFC,
// 2543+ 16_4840,16_51C8,16_FFF4,16_4ED0,16_4E75,
// 2544+ 16_1149,16_6E76,16_616C,16_6964,16_2025,16_666F,16_7220,16_6C6F,
// 2545+ 16_6F70,16_2F00,16_9082,16_6720,16_2F01,16_6708,16_4EB8,16_3EEE,
// 2546+ 16_4A80,16_6D0E,16_508F,16_41FA,16_FFD8,16_7201,16_7055,16_4EF8,
// 2547+ 16_3EFA,16_4A81,16_66EE,16_221F,16_201F,16_4E75,
// 2548+ 16_0C4F,16_7574,16_206F,16_6620,16_7261,16_6E67,16_6580,16_41FA,
// 2549+ 16_FFF0,16_7201,16_7056,16_4EF8,16_3EFA,16_4E75,
// 2550+ 16_1355,16_6E61,16_7373,16_6967,16_6E65,16_6420,16_7661,16_7269,
// 2551+ 16_6162,16_6C65,16_B0FC,16_0000,16_6F1A,16_B2FC,16_0000,16_6F14,
// 2552+ 16_BE10,16_6606,16_BE28,16_0001,16_670A,16_BE11,16_6612,16_BE29,
// 2553+ 16_0001,16_660C,16_41FA,16_FFCA,16_7202,16_7054,16_4EF8,16_3EFA,
// 2554+ 16_48E7,16_C0C0,16_4240,16_1018,16_6730,16_4241,16_1219,16_6722,
// 2555+ 16_5380,16_5381,16_B041,16_6E12,16_9240,16_B109,16_56C8,16_FFFC,
// 2556+ 16_6602,16_4441,16_4CDF,16_0303,16_4E75,
// 2557+ 16_B109,16_56C9,16_FFFC,16_66F2,16_7201,16_4CDF,16_0303,16_4E75,
// 2558+ 16_1011,16_4440,16_4CDF,16_0303,16_4E75,
// 2559+ 16_0E53,16_7472,16_696E,16_6720,16_746F,16_6F20,16_6269,16_6780,
// 2560+ 16_B010,16_640C,16_41FA,16_FFEA,16_7203,16_7051,16_4EF8,16_3EFA,
// 2561+ 16_4280,16_1010,16_12D8,16_51C8,16_FFFC,16_4E75,
// 2562+ 16_0E53,16_7472,16_696E,16_6720,16_746F,16_6F20,16_6269,16_6780,
// 2563+ 16_B010,16_640C,16_41FA,16_FFEA,16_7201,16_7056,16_4EF8,16_3EFA,
// 2564+ 16_0240,16_00FE,16_245F,16_9EC0,16_558F,16_224F,16_BFC8,16_6E0E,
// 2565+ 16_1010,16_12D8,16_51C8,16_FFFC,16_204F,16_224F,16_4ED2,16_1018,
// 2566+ 16_5289,16_D0C0,16_D2C0,16_1320,16_51C8,16_FFFC,16_204F,16_224F,
// 2567+ 16_4ED2,16_4E75,
// 2568+ 16_43EF,16_FF00,16_2448,16_D5C0,16_2049,16_9280,16_6C04,16_4211,
// 2569+ 16_4E75,
// 2570+ 16_1281,16_5219,16_12DA,16_51C9,16_FFFC,16_4E75,
// 2571+ 16_700A,16_4EF8,16_3E70,16_4E75,
// 2572+ 16_7020,16_4EF8,16_3E70,16_4E75
// 2573
// 2574 !<<BOTH
// 2575 %integer start,limit
int START;
int LIMIT;
// 2576 %record(identinfo)%name DDX
struct IDENTINFO *DDX;
// 2577 fill code(1) %if cad&1 # 0
if (CAD & 1 == 0) goto L_0196;
FILLCODE(1);
L_0196:;
// 2578 start = dx_val>>16&511; limit = start+dx_val&255
START = (unsigned int)DX->VAL >> 16 & 511;
LIMIT = START + (DX->VAL & 255);
// 2579 dx_val = cad+dx_val>>7&(255<<1); !entry
DX->VAL = CAD + ((unsigned int)DX->VAL >> 7 & 255 << 1);
// 2580 dx_mode = procmode
DX->MODE = 250;
// 2581 %if start = limit %start; !range check
if (START != LIMIT) goto L_0197;
// 2582 ddx == dict(check)
DDX = (struct IDENTINFO *)/*?*/ &DICT[111];
// 2583 put prim(ddx) %and dx_val = cad %if ddx_mode = absmode
if (DDX->MODE != 56) goto L_0198;
PUTPRIM(DDX);
DX->VAL = CAD;
L_0198:;
// 2584 set code word(16_0C80); !CMPI.L #?,D0
SETCODEWORD(3200);
// 2585 set code longword(dict(x+1)_val); !lower
SETCODELONGWORD(DICT[X + 1].VAL);
// 2586 set code word(16_6D00); !BLT
SETCODEWORD(27904);
// 2587 set code word(ddx_val-cad)
SETCODEWORD(DDX->VAL - CAD);
// 2588 set code word(16_0C80); !CMPI.L #?,D0
SETCODEWORD(3200);
// 2589 set code longword(dict(x+2)_val); !upper
SETCODELONGWORD(DICT[X + 2].VAL);
// 2590 set code word(16_6E00); !BGT
SETCODEWORD(28160);
// 2591 set code word(ddx_val-cad)
SETCODEWORD(DDX->VAL - CAD);
// 2592 set code word(16_4E75); !RTS
SETCODEWORD(20085);
// 2593 %else
goto L_0199;
L_0197:;
// 2594 set code word(primcode(start)) %and start=start+1 %until start >= limit
L_019A:;
SETCODEWORD(PRIMCODE[START - 1]);
START = START + 1;
if (START >= LIMIT) goto L_019B;
goto L_019A;
L_019B:;
// 2595 %finish
L_0199:;
// 2596 %end
return;
} /* end of PUTPRIM */
// 2597
// 2598 %record(identinfo)%name dx,tp
struct IDENTINFO *DX;
struct IDENTINFO *TP;
// 2599 dx==dict(x); tp==typecell(dx_type)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
TP = (struct IDENTINFO *)TYPECELL(DX->TYPE);
// 2600 %if dx_mode = absmode %and dx_val < 0 %start; !prim routine
if (DX->MODE != 56) goto L_019C;
if (DX->VAL >= 0) goto L_019C;
// 2601 ![**for now**: the convention is inadequate because excludes abs neg]
// 2602 put prim(dx)
PUTPRIM(DX);
// 2603 %else
goto L_019D;
L_019C:;
// 2604 c_status = c_status!unknown %if tp_val <= 0
if (TP->VAL > 0) goto L_019E;
C.STATUS = C.STATUS | 2;
L_019E:;
// 2605 c_totstack = c_sp-imod(tp_val) %if c_sp-imod(tp_val) < c_totstack
if (C.SP - _imp_IMOD(TP->VAL) >= C.TOTSTACK) goto L_019F;
C.TOTSTACK = C.SP - _imp_IMOD(TP->VAL);
L_019F:;
// 2606 %finish
L_019D:;
// 2607 %if dx_mode&63 = pcmode %start; !internal
if (DX->MODE & 63 != 58) goto L_01A0;
// 2608 c_forward = c_forward+1 %if dx_flags&spec # 0 %and dx_flags&rflag = 0
if (DX->FLAGS & 256 == 0) goto L_01A1;
if (DX->FLAGS & 32 != 0) goto L_01A1;
C.FORWARD = C.FORWARD + 1;
L_01A1:;
// 2609 plant(bsr,0,x)
PLANT(17, 0, X);
// 2610 %finish %else %if dx_flags&(name+indirect) = 0 %or dx_flags&ext # 0 {temp} %start
goto L_01A2;
L_01A0:;
if (DX->FLAGS & (-32768) + 2048 == 0) goto L_01A3;
if (DX->FLAGS & 16384 == 0) goto L_01A4;
L_01A3:;
// 2611 plant(jsr,0,x)
PLANT(56, 0, X);
// 2612 %finish %else %if free&a0b<<3 # 0 %start
goto L_01A2;
L_01A4:;
if (FREE & 256 << 3 == 0) goto L_01A5;
// 2613 plant(move,x,a0+3)
PLANT(1, X, 9 + 3);
// 2614 plant(jsr,0,a0+3+indir)
PLANT(56, 0, 9 + 3 + 8);
// 2615 forget(a0+3)
FORGET(9 + 3);
// 2616 %else
goto L_01A2;
L_01A5:;
// 2617 plant(move,x,tempd(a7,-4))
PLANT(1, X, TEMPD(16, -4));
// 2618 plantlit(move,16_4EF9,tempd(a7,-6))
PLANTLIT(1, 20217, TEMPD(16, -6));
// 2619 plant(jsr,0,lablim)
PLANT(56, 0, LABLIM);
// 2620 %finish
L_01A2:;
// 2621 %end; !srcall
return;
} /* end of SRCALL */
// 2622 !
// 2623 %routine DEFINE LABEL(%integer lab)
void DEFINELABEL(int LAB) {
// 2624 %integer r,chain
int R;
int CHAIN;
// 2625 %record(contentinfo)%name lr
struct CONTENTINFO *LR;
// 2626 chain = dict(lab)_val
CHAIN = DICT[LAB].VAL;
// 2627 %if chain >= 0 %start; !label before jumps
if (CHAIN < 0) goto L_01A6;
// 2628 update sp
UPDATESP();
// 2629 forget regs
FORGETREGS();
// 2630 %else
goto L_01A7;
L_01A6:;
// 2631 lr == lreg(lab-dictlim)
LR = (struct CONTENTINFO *)/*?*/ &LREG[LAB - DICTLIM];
// 2632 %if c_access = 0 %start; !no fall-through
if (C.ACCESS != 0) goto L_01A8;
// 2633 c_reg = lr; !so just incoming context
C.REG = *LR;
// 2634 %else; !join
goto L_01A9;
L_01A8:;
// 2635 %for r = d0,1,maxareg %cycle
// %for R = 1, 1, 12 %cycle
{
R = 0;
L_01AA:
if (R == 12) goto L_01AB;
R += 1;
// 2636 forget(r) %if c_reg_content(r) # lr_content(r)
if (C.REG.CONTENT[R - 1] == LR->CONTENT[R - 1]) goto L_01AD;
FORGET(R);
L_01AD:;
// 2637 %repeat
goto L_01AA;
}
L_01AB:;
// 2638 forget cc %if c_reg_ccx # lr_ccx %or c_reg_ccy # lr_ccy
if (C.REG.CCX != LR->CCX) goto L_01AC;
if (C.REG.CCY == LR->CCY) goto L_01AE;
L_01AC:;
FORGETCC();
L_01AE:;
// 2639 c_reg_line = -9 %if lr_line # c_reg_line
if (LR->LINE == C.REG.LINE) goto L_01AF;
C.REG.LINE = -9;
L_01AF:;
// 2640 %finish
L_01A9:;
// 2641 %finish
L_01A7:;
// 2642 define jumps(chain)
DEFINEJUMPS(CHAIN);
// 2643 dict(lab)_val = pc
DICT[LAB].VAL = PC;
// 2644 {?} put operand(lab) %if control&codelist # 0 %and control&list # 0
if (CONTROL & 32 == 0) goto L_01B0;
if (CONTROL & 1 == 0) goto L_01B0;
PUTOPERAND(LAB);
L_01B0:;
// 2645 %end; !define label
return;
} /* end of DEFINELABEL */
// 2646
// 2647 %routine SET USER LABEL(%integername chain)
void SETUSERLABEL(int *CHAIN) {
// 2648 update sp
UPDATESP();
// 2649 addimm(c_temps,a7) %if c_temps # 0 %and c_access # 0 {remove temps}
if (C.TEMPS == 0) goto L_01B1;
if (C.ACCESS == 0) goto L_01B1;
ADDIMM(C.TEMPS, 16);
L_01B1:;
// 2650 define jumps(chain)
DEFINEJUMPS(*CHAIN);
// 2651 chain = pc
*CHAIN = PC;
// 2652 c_access = 1; !anyway
C.ACCESS = 1;
// 2653 addimm(-c_temps,a7) %if c_temps # 0 {restore temps}
if (C.TEMPS == 0) goto L_01B2;
ADDIMM(-C.TEMPS, 16);
L_01B2:;
// 2654 forget regs
FORGETREGS();
// 2655 forget triples %if curlab = c_lab1
if (CURLAB != C.LAB1) goto L_01B3;
FORGETTRIPLES();
L_01B3:;
// 2656 %end
return;
} /* end of SETUSERLABEL */
// 2657
// 2658 %routine FLUSH
void FLUSH(void) {
// 2659 %if pendcond < 0 %start; !indicator for line num update
if (PENDCOND >= 0) goto L_01B4;
// 2660 litstore(litpos) = line
LITSTORE[LITPOS + 2247] = LINE;
// 2661 %if control&tracebit # 0 %then plantlit2(trapi,litpos,15) %c
if (CONTROL & 2097152 == 0) goto L_01B5;
PLANTLIT2(101, LITPOS, 15);
goto L_01B6;
L_01B5:;
if (LINE - C.REG.LINE <= 8) goto L_01B7;
PLANT(1 + (2 << 8), LITPOS, 6);
goto L_01B6;
L_01B7:;
PLANTLIT(2 + (2 << 8), LINE - C.REG.LINE, 6);
L_01B6:;
// 2662+ %else %if line-c_reg_line > 8 %then plant(move+2<<8,litpos,lineloc) %c
// 2663+ %else plantlit(add+2<<8,line-c_reg_line,lineloc)
// 2664 forget cc; c_reg_line = line
FORGETCC();
C.REG.LINE = LINE;
// 2665 %else
goto L_01B8;
L_01B4:;
// 2666 %if pendout # 0 %start
if (PENDOUT == 0) goto L_01B9;
// 2667 pendcond = pendcond&15
PENDCOND = PENDCOND & 15;
// 2668 c_access = 0 %if pendcond = 0
if (PENDCOND != 0) goto L_01BA;
C.ACCESS = 0;
L_01BA:;
// 2669 %if pendcond # 1 %start
if (PENDCOND == 1) goto L_01BB;
// 2670 save context(pendout)
SAVECONTEXT(PENDOUT);
// 2671 plant(bra+pendcond,0,pendout)
PLANT(16 + PENDCOND, 0, PENDOUT);
// 2672 %finish
L_01BB:;
// 2673 %finish
L_01B9:;
// 2674 define label(pendin) %if pendin # 0
if (PENDIN == 0) goto L_01BC;
DEFINELABEL(PENDIN);
L_01BC:;
// 2675 %finish
L_01B8:;
// 2676 pendcond = 0
PENDCOND = 0;
// 2677 %end
return;
} /* end of FLUSH */
// 2678
// 2679 !!!!!!!!!!!!!!!! Main code generation procedure !!!!!!!!!!!!!!!!!!!!!
// 2680
// 2681 %constinteger INST=1<<30
// 2682
// 2683 %routine EVAL(%integername pp, %integer rset)
void EVAL(int *PP, int RSET) {
// 2684 !Evaluate the operand identified by PP as defined by RSET:
// 2685 ! RSET = boolean vector of acceptable registers
// 2686 ! + SIGN to indicate that stopping at EA is acceptable
// 2687 ! + 1<<16 to indicate byte value ok
// 2688 ! + 2<<16 to indicate short value ok
// 2689 ! + STACK if stack ok [not yet: too complex]
// 2690 %constinteger ASL=32,
// 2691+ CMPM=43,
// 2692+ TRAPV=70,
// 2693+ SWAP=74, EXTL=76,
// 2694+ JMP=57, TST=59, DBNE=86
// 2695
// 2696 %constinteger MOVEW=move+2<<8, ADDW=add+2<<8,
// 2697+ MOVEB=move+1<<8, ADDB=add+1<<8,
// 2698+ SUBB=sub+1<<8, CMPB=cmp+1<<8,
// 2699+ CMPMB=cmpm+1<<8
// 2700
// 2701 %constinteger VAL=sign+anyreg, REF=sign,
// 2702+ SIZESHIFT=16,
// 2703+ TOBYTE=1<<16, TOSHORT=1<<17, {1<<18 not sig}
// 2704+ TOSTACK=1<<19, ASAD=1<<20
// 2705
// 2706 %switch DO(0:opmax)
int DO_index;
int DO_line;
char *DO_file;
static const void *DO[118] = {
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing, &&case_DO_missing,
&&case_DO_missing, &&case_DO_missing, &&case_DO_missing};
// 2707 %owninteger STSIZ=0; !this variable is used to convey a
static int STSIZ = 0;
// 2708 !rarely required 3rd parameter to EVAL
// 2709 !Its value is captured into STSIZE on entry
// 2710 !A negative value indicates a string;
// 2711 ! a positive value a fixed length structure
// 2712 ! * CF normal use of negative/positive size *
// 2713 %integer I,J,P,ACT,X,Y,XX,YY,WX,WY,SX,SY,R,OLDFREE,FREED
int I;
int J;
int P;
int ACT;
int X;
int Y;
int XX;
int YY;
int WX;
int WY;
int SX;
int SY;
int R;
int OLDFREE;
int FREED;
// 2714 %integer M,V,SP,STSIZE,OP,CASE
int M;
int V;
int SP;
int STSIZE;
int OP;
int CASE;
// 2715 %record(identinfo)%name DP,DX,DY,TX
struct IDENTINFO *DP;
struct IDENTINFO *DX;
struct IDENTINFO *DY;
struct IDENTINFO *TX;
// 2716
// 2717 %integer%fn FREE DREG
int FREEDREG(void) {
// 2718 %result = free reg(anydreg)
return FREEREG(239);
// 2719 %end
} /* end of FREEDREG */
// 2720
// 2721 %integer%fn FREE AREG(%integer content)
int FREEAREG(int CONTENT) {
// 2722 %integer r
int R;
// 2723 r = free reg(anyareg)
R = FREEREG(65280);
// 2724 c_reg_content(r) = content
C.REG.CONTENT[R - 1] = CONTENT;
// 2725 %result = r
return R;
// 2726 %end
} /* end of FREEAREG */
// 2727
// 2728 %routine PUSH(%integer x)
void PUSH(int X) {
// 2729 plant(move,x,prea7); extend stack(4)
PLANT(1, X, 40);
EXTENDSTACK(4);
// 2730 %end
return;
} /* end of PUSH */
// 2731 %routine POP(%integer x)
void POP(int X) {
// 2732 plant(move,posta7,x); c_sp = c_sp+4
PLANT(1, 32, X);
C.SP = C.SP + 4;
// 2733 %end
return;
} /* end of POP */
// 2734 %routine PUSHS(%integer x,s)
void PUSHS(int X, int S) {
// 2735 plant(move+s<<8,x,prea7)
PLANT(1 + (S << 8), X, 40);
// 2736 %if s < 4 %then extend stack(2) %else extend stack(4)
if (S >= 4) goto L_01BD;
EXTENDSTACK(2);
goto L_01BE;
L_01BD:;
EXTENDSTACK(4);
L_01BE:;
// 2737 %end
return;
} /* end of PUSHS */
// 2738
// 2739 %routine PUSH BLOCK(%integer areg,bytes)
void PUSHBLOCK(int AREG, int BYTES) {
// 2740 %if bytes <= 4 %then move block(areg+indir,prea7,bytes) %c
if (BYTES > 4) goto L_01BF;
MOVEBLOCK(AREG + 8, 40, BYTES);
goto L_01C0;
L_01BF:;
ADDIMM(BYTES, AREG);
MOVEBLOCK(AREG + 24, 40, BYTES);
L_01C0:;
// 2741+ %else addimm(bytes,areg) %and move block(areg+pre,prea7,bytes)
// 2742 extend stack(bytes)
EXTENDSTACK(BYTES);
// 2743 %end
return;
} /* end of PUSHBLOCK */
// 2744
// 2745 %routine COMPILE UNCOND BRANCH(%integer l)
void COMPILEUNCONDBRANCH(int L) {
// 2746 %if pendcond # 0 %start
if (PENDCOND == 0) goto L_01C1;
// 2747 %if pendcond < 0 %start
if (PENDCOND >= 0) goto L_01C2;
// 2748 pendcond = 0; !ok?
PENDCOND = 0;
// 2749 %finish %else %if pendin # 0 %start
goto L_01C3;
L_01C2:;
if (PENDIN == 0) goto L_01C4;
// 2750 flush; ![safe - improvable?]
FLUSH();
// 2751 %else
goto L_01C3;
L_01C4:;
// 2752 pendcond = pendcond!!1
PENDCOND = PENDCOND ^ 1;
// 2753 c_access = -2 %if pp+1 < np %and dict(pp+1)_act = else
if (*PP + 1 >= NP) goto L_01C5;
if (DICT[*PP + 1].ACT != 40) goto L_01C5;
C.ACCESS = -2;
L_01C5:;
// 2754 %finish
L_01C3:;
// 2755 %finish
L_01C1:;
// 2756 pendcond = pendcond&15
PENDCOND = PENDCOND & 15;
// 2757 c_access = 0 %if pendcond = 0
if (PENDCOND != 0) goto L_01C6;
C.ACCESS = 0;
L_01C6:;
// 2758 plant(bra+pendcond,0,l) %if pendcond # 1
if (PENDCOND == 1) goto L_01C7;
PLANT(16 + PENDCOND, 0, L);
L_01C7:;
// 2759 pendcond = 0
PENDCOND = 0;
// 2760 %end
return;
} /* end of COMPILEUNCONDBRANCH */
// 2761
// 2762 %integer%fn CLEAN REG
int CLEANREG(void) {
// 2763 %integer r
int R;
// 2764 free = free-bregb %and %result = breg %if free&bregb # 0
if (FREE & 16 == 0) goto L_01C8;
FREE = FREE - 16;
return 5;
L_01C8:;
// 2765 r = free dreg
R = FREEDREG();
// 2766 plant(clr,0,r)
PLANT(52, 0, R);
// 2767 %result = r
return R;
// 2768 %end
} /* end of CLEANREG */
// 2769
// 2770 %integer%fn WEIGHT(%integer p)
int WEIGHT(int P) {
// 2771 !(Heuristic: can't anticipate all generation decisions)
// 2772 %integer a,wy
int A;
int WY;
// 2773 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 2774 p = p-ad %if p >= explim
if (P < EXPLIM) goto L_01C9;
P = P - 16384;
L_01C9:;
// 2775 %result = 1 %if p < np0
if (P >= NP0) goto L_01CA;
return 1;
L_01CA:;
// 2776 dp == dict(p)
DP = (struct IDENTINFO *)/*?*/ &DICT[P];
// 2777 a = dp_act
A = DP->ACT;
// 2778 %result = 999 %if a >= imul; !funcall,mapcall
if (A < 86) goto L_01CB;
return 999;
L_01CB:;
// 2779 wy = weight(dp_y)
WY = WEIGHT(DP->Y);
// 2780 %result = wy %if wy >= 999
if (WY < 999) goto L_01CC;
return WY;
L_01CC:;
// 2781 wy = wy-1 %if a = recref %and dict(dp_x)_flags >= 0
if (A != 45) goto L_01CD;
if (DICT[DP->X].FLAGS < 0) goto L_01CD;
WY = WY - 1;
L_01CD:;
// 2782 %result = wy+weight(dp_x)
return WY + WEIGHT(DP->X);
// 2783 %end
} /* end of WEIGHT */
// 2784
// 2785 %routine CHECK ADDRESS(%integer v)
void CHECKADDRESS(int V) {
// 2786 %if a0 <= v <= a7 %then plant(cmp+2<<8,0,v) %else plant(tst,0,v)
{
// Double-sided test on V (Part I)
int tmp;
if (9 > (tmp = V)) goto L_01CE;
// Double-sided test on V (Part II)
if (tmp > 16) goto L_01CE;
}
PLANT(4 + (2 << 8), 0, V);
goto L_01CF;
L_01CE:;
PLANT(59, 0, V);
L_01CF:;
// 2787 srcall(adok)
SRCALL(103);
// 2788 forget cc
FORGETCC();
// 2789 %end
return;
} /* end of CHECKADDRESS */
// 2790
// 2791 !!!!!!!!!!!!!!!!!!! Procedure call !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 2792 !
// 2793 ! _____ACT_________X__________Y____
// 2794 ! P -> | procident | param 1 | param 2 |
// 2795 ! | 0 | param 3 | param 4 |
// 2796 ! . . . .
// 2797 !
// 2798 %routine CALL
void CALL(void) {
// 2799 !Load parameters following P and call procedure ACT (DX)
// 2800 ! Update PP for RCALL
// 2801 %integer sp,stage,maxq,awkward
int SP;
int STAGE;
int MAXQ;
int AWKWARD;
// 2802
// 2803 %routine EVAL PARLIST(%integer arg,q)
void EVALPARLIST(int ARG, int Q) {
// 2804 %record(identinfo)%name darg,dv
struct IDENTINFO *DARG;
struct IDENTINFO *DV;
// 2805 %integer v,w,f,r,s
int V;
int W;
int F;
int R;
int S;
// 2806 !Stage 0 (forward):
// 2807 !Stage 0 (returning):
// 2808 !Stage 1 (forward):
// 2809 !Stage 1 (returning):
// 2810 %return %if arg = 0
if (ARG != 0) goto L_01D0;
return;
L_01D0:;
// 2811 darg == dict(arg)
DARG = (struct IDENTINFO *)/*?*/ &DICT[ARG];
// 2812 q = q+1; maxq = q %if q > maxq
Q = Q + 1;
if (Q <= MAXQ) goto L_01D1;
MAXQ = Q;
L_01D1:;
// 2813 %if q&1 = 0 %then v = dict(p+q>>1)_x %else v = dict(p+q>>1)_y
if (Q & 1 != 0) goto L_01D2;
V = DICT[P + ((unsigned int)Q >> 1)].X;
goto L_01D3;
L_01D2:;
V = DICT[P + ((unsigned int)Q >> 1)].Y;
L_01D3:;
// 2814 r = darg_reg&15
R = DARG->REG & 15;
// 2815 s = size(darg_type)
S = SIZE(DARG->TYPE);
// 2816 %if darg_flags&proc # 0 %start
if (DARG->FLAGS & 12288 == 0) goto L_01D4;
// 2817 s = 0
S = 0;
// 2818 %if awkward # 0 %start
if (AWKWARD == 0) goto L_01D5;
// 2819 f = v; f = f-ad %if f >= explim
F = V;
if (F < EXPLIM) goto L_01D6;
F = F - 16384;
L_01D6:;
// 2820 dv == dict(f)
DV = (struct IDENTINFO *)/*?*/ &DICT[F];
// 2821 %if dv_flags&(ext+spec) # ext+spec %start
if (DV->FLAGS & 16384 + 256 == 16384 + 256) goto L_01D7;
// 2822 !non-external to (maybe) external
// 2823 eval parlist(darg_link,q) %and %return %if stage # 0
if (STAGE == 0) goto L_01D8;
EVALPARLIST(DARG->LINK, Q);
return;
L_01D8:;
// 2824 %if dv_flags&(name+indirect) # 0 %then plant(move,f,prea7) %C
if (DV->FLAGS & (-32768) + 2048 == 0) goto L_01D9;
PLANT(1, F, 40);
goto L_01DA;
L_01D9:;
PLANT(55, 0, F);
L_01DA:;
// 2825+ %else plant(pea,0,f)
// 2826 plantlit(move+2<<8,16_4EF9,prea7) {JMP entry}
PLANTLIT(1 + (2 << 8), 20217, 40);
// 2827 plant(move,mb,prea7)
PLANT(1, 13, 40);
// 2828 plantlit(move+2<<8,16_287C,prea7) {MOVE #xxxx,mb}
PLANTLIT(1 + (2 << 8), 10364, 40);
// 2829 extend stack(12)
EXTENDSTACK(12);
// 2830 s = c_sp
S = C.SP;
// 2831 eval parlist(darg_link,q)
EVALPARLIST(DARG->LINK, Q);
// 2832 %if darg_val > 0 %start
if (DARG->VAL <= 0) goto L_01DB;
// 2833 plant(pea,0,temp(c_mode,s))
PLANT(55, 0, TEMP(C.MODE, S));
// 2834 %else
goto L_01DC;
L_01DB:;
// 2835 plant(lea,temp(c_mode,s),r+d0)
PLANT(78, TEMP(C.MODE, S), R + 1);
// 2836 free = free&(\(d0b<<r))
FREE = FREE & ~(1 << R);
// 2837 %finish
L_01DC:;
// 2838 %return
return;
// 2839 %finish
L_01D7:;
// 2840 %finish
L_01D5:;
// 2841 %finish
L_01D4:;
// 2842 %if darg_val > 0 %start; !passed on stack
if (DARG->VAL <= 0) goto L_01DD;
// 2843 eval parlist(darg_link,q)
EVALPARLIST(DARG->LINK, Q);
// 2844 %return %if stage # 0
if (STAGE == 0) goto L_01DE;
return;
L_01DE:;
// 2845 %if darg_flags < 0 %start; !name
if (DARG->FLAGS >= 0) goto L_01DF;
// 2846 f = free
F = FREE;
// 2847 ! eval(v,ref)
// 2848 ! plant(pea,0,v); extend stack(4)
// 2849 eval(v,anyareg)
EVAL(/*?*/ &V, 65280);
// 2850 push(v)
PUSH(V);
// 2851 free = f
FREE = F;
// 2852 %return
return;
// 2853 %finish
L_01DF:;
// 2854 %if s > 0 %start; !simple value
if (S <= 0) goto L_01E0;
// 2855 f = free; eval(v,val)
F = FREE;
EVAL(/*?*/ &V, -2147418113);
// 2856 pushs(v,s)
PUSHS(V, S);
// 2857 free = f
FREE = F;
// 2858 %else; !structure by value
goto L_01E1;
L_01E0:;
// 2859 stsiz = s
STSIZ = S;
// 2860 stsiz = -stsiz %if category(darg_type) # stringy
if (CATEGORY(DARG->TYPE) == 8) goto L_01E2;
STSIZ = -STSIZ;
L_01E2:;
// 2861 eval(v,tostack)
EVAL(/*?*/ &V, 524288);
// 2862 %finish
L_01E1:;
// 2863 %return
return;
// 2864 %finish
L_01DD:;
// 2865 %if s <= 0 %and darg_flags >= 0 %start
if (S > 0) goto L_01E3;
if (DARG->FLAGS < 0) goto L_01E3;
// 2866 !structure by value -- ad in reg
// 2867 v = v-ad %if v >= explim
if (V < EXPLIM) goto L_01E4;
V = V - 16384;
L_01E4:;
// 2868 %if v >= np0 %start
if (V < NP0) goto L_01E5;
// 2869 dv == dict(v)
DV = (struct IDENTINFO *)/*?*/ &DICT[V];
// 2870 %if dv_act >= concat %and dv_mode = 0 %start
if (DV->ACT < 106) goto L_01E6;
if (DV->MODE != 0) goto L_01E6;
// 2871 !string/record function
// 2872 %if stage = 0 %start
if (STAGE != 0) goto L_01E7;
// 2873 stsiz = s
STSIZ = S;
// 2874 stsiz = -stsiz %if category(darg_type) # stringy
if (CATEGORY(DARG->TYPE) == 8) goto L_01E8;
STSIZ = -STSIZ;
L_01E8:;
// 2875 r = v; eval(r,tostack); free = free!a0b; ![?here?]
R = V;
EVAL(/*?*/ &R, 524288);
FREE = FREE | 256;
// 2876 c_reg_content(a0) = v+ad
C.REG.CONTENT[8] = V + 16384;
// 2877 dv_val = c_sp
DV->VAL = C.SP;
// 2878 eval parlist(darg_link,q)
EVALPARLIST(DARG->LINK, Q);
// 2879 %else
goto L_01E9;
L_01E7:;
// 2880 eval parlist(darg_link,q)
EVALPARLIST(DARG->LINK, Q);
// 2881 %if c_reg_content(r+d0) # v+ad %start
if (C.REG.CONTENT[R + 1 - 1] == V + 16384) goto L_01EA;
// 2882 dv_mode = c_mode
DV->MODE = C.MODE;
// 2883 plant(lea,v,r+d0)
PLANT(78, V, R + 1);
// 2884 dv_mode = 0
DV->MODE = 0;
// 2885 %finish
L_01EA:;
// 2886 free = free&(\(d0b<<r))
FREE = FREE & ~(1 << R);
// 2887 %finish
L_01E9:;
// 2888 %return
return;
// 2889 %finish
L_01E6:;
// 2890 %finish
L_01E5:;
// 2891 v = v+ad
V = V + 16384;
// 2892 %finish
L_01E3:;
// 2893 w = weight(v)
W = WEIGHT(V);
// 2894 %if w >= 999 %start
if (W < 999) goto L_01EB;
// 2895 eval parlist(darg_link,q)
EVALPARLIST(DARG->LINK, Q);
// 2896 %return %if stage # 0
if (STAGE == 0) goto L_01EC;
return;
L_01EC:;
// 2897 %else
goto L_01ED;
L_01EB:;
// 2898 %if w >= 2 %and stage # 0 %start
if (W < 2) goto L_01EE;
if (STAGE == 0) goto L_01EE;
// 2899 eval(v,d0b<<r)
EVAL(/*?*/ &V, 1 << R);
// 2900 eval parlist(darg_link,q)
EVALPARLIST(DARG->LINK, Q);
// 2901 %return
return;
// 2902 %finish
L_01EE:;
// 2903 eval parlist(darg_link,q)
EVALPARLIST(DARG->LINK, Q);
// 2904 %return %if stage = 0
if (STAGE != 0) goto L_01EF;
return;
L_01EF:;
// 2905 %finish
L_01ED:;
// 2906 eval(v,d0b<<r)
EVAL(/*?*/ &V, 1 << R);
// 2907 %end
return;
} /* end of EVALPARLIST */
// 2908
// 2909 awkward = 0
AWKWARD = 0;
// 2910 awkward = 1 %and push(mb) %if dx_flags&proc2 # 0 %c
if (DX->FLAGS & 8192 == 0) goto L_01F0;
if (DX->FLAGS & 16384 == 0) goto L_01F1;
if (DX->FLAGS & 256 == 0) goto L_01F0;
L_01F1:;
AWKWARD = 1;
PUSH(13);
L_01F0:;
// 2911+ %and (dx_flags&ext = 0 %or dx_flags&spec # 0); !param or external
// 2912 sp = c_sp
SP = C.SP;
// 2913 maxq = 0
MAXQ = 0;
// 2914 stage = 0
STAGE = 0;
// 2915 eval parlist(dict(dx_type)_link,-1)
EVALPARLIST(DICT[DX->TYPE].LINK, -1);
// 2916 stage = 1
STAGE = 1;
// 2917 eval parlist(dict(dx_type)_link,-1)
EVALPARLIST(DICT[DX->TYPE].LINK, -1);
// 2918 srcall(act)
SRCALL(ACT);
// 2919 %if c_sp # sp %start
if (C.SP == SP) goto L_01F2;
// 2920 addimm(sp-c_sp,a7); c_sp = sp
ADDIMM(SP - C.SP, 16);
C.SP = SP;
// 2921 %finish
L_01F2:;
// 2922 pop(mb) %if awkward # 0
if (AWKWARD == 0) goto L_01F3;
POP(13);
L_01F3:;
// 2923 pp = p+maxq>>1 %if p < np; !update for RCALL + RESOL
if (P >= NP) goto L_01F4;
*PP = P + ((unsigned int)MAXQ >> 1);
L_01F4:;
// 2924 forget regs
FORGETREGS();
// 2925 c_reg_line = line %if dx_flags&(ext+proc) = ext+proc1; !%system
if (DX->FLAGS & 16384 + 12288 != 16384 + 4096) goto L_01F5;
C.REG.LINE = LINE;
L_01F5:;
// 2926 %end; !call
return;
} /* end of CALL */
// 2927 !
// 2928 %routine STRUCTCALL(%integer entry,size)
void STRUCTCALL(int ENTRY, int SIZE) {
// 2929 size = mite(-size-1) %and forget(breg) %if size <= 0; !string
if (SIZE > 0) goto L_01F6;
SIZE = MITE(-SIZE - 1);
FORGET(5);
L_01F6:;
// 2930 plantlit(move,size,d0)
PLANTLIT(1, SIZE, 1);
// 2931 srcall(entry)
SRCALL(ENTRY);
// 2932 forget(d0)
FORGET(1);
// 2933 %end
return;
} /* end of STRUCTCALL */
// 2934
// 2935 %routine PUSH STRUCTURE
void PUSHSTRUCTURE(void) {
// 2936 %if stsize <= 0 %start; !string
if (STSIZE > 0) goto L_01F7;
// 2937 structcall(strtostk,stsize)
STRUCTCALL(114, STSIZE);
// 2938 forget(a0); forget(a1); forget(a0+2)
FORGET(9);
FORGET(10);
FORGET(9 + 2);
// 2939 extend stack(256-(stsize&254))
EXTENDSTACK(256 - (STSIZE & 254));
// 2940 %else; !fixed size structure
goto L_01F8;
L_01F7:;
// 2941 push block(a0,(stsize+1)&(\1))
PUSHBLOCK(9, STSIZE + 1 & (~1));
// 2942 %finish
L_01F8:;
// 2943 %end
return;
} /* end of PUSHSTRUCTURE */
// 2944
// 2945 %routine OK REG(%integer got)
void OKREG(int GOT) {
// 2946 r = got
R = GOT;
// 2947 %if d0b<<(got-d0)&rset = 0 %start
if (1 << GOT - 1 & RSET != 0) goto L_01F9;
// 2948 c_reg_content(got) = pp
C.REG.CONTENT[GOT - 1] = *PP;
// 2949 %if rset&free = 0 %and rset&tostack # 0 %start
if (RSET & FREE != 0) goto L_01FA;
if (RSET & 524288 == 0) goto L_01FA;
// 2950 push structure; r = a7
PUSHSTRUCTURE();
R = 16;
// 2951 ! push(got); r = a7
// 2952 ! c_reg_ccx = pp; c_reg_ccy = 0
// 2953 %else
goto L_01FB;
L_01FA:;
// 2954 r = free reg(rset&(\bregb)); plant(move,got,r)
R = FREEREG(RSET & (~16));
PLANT(1, GOT, R);
// 2955 c_reg_ccx = pp %and c_reg_ccy = 0 %if r < a0
if (R >= 9) goto L_01FC;
C.REG.CCX = *PP;
C.REG.CCY = 0;
L_01FC:;
// 2956 %finish
L_01FB:;
// 2957 %finish
L_01F9:;
// 2958 %end
return;
} /* end of OKREG */
// 2959
// 2960 %routine OK AREG(%integer got,ok)
void OKAREG(int GOT, int OK) {
// 2961 r = got
R = GOT;
// 2962 %if a0b<<(got-a0)&ok = 0 %start
if (256 << GOT - 9 & OK != 0) goto L_01FD;
// 2963 r = free reg(ok); plant(move,got,r)
R = FREEREG(OK);
PLANT(1, GOT, R);
// 2964 %finish
L_01FD:;
// 2965 %end
return;
} /* end of OKAREG */
// 2966
// 2967 %routine LOAD ADDRESS(%integer p)
void LOADADDRESS(int P) {
// 2968 %integer i,f
int I;
int F;
// 2969 %if rset&anyareg&free # 0 %start
if (RSET & 65280 & FREE == 0) goto L_01FE;
// 2970 %if dp_mode&2_111000 = indexmode %and dp_val&255 = 0 %start
if (DP->MODE & 56 != 48) goto L_01FF;
if (DP->VAL & 255 != 0) goto L_01FF;
// 2971 i = a0b<<(dp_mode&7)
I = 256 << (DP->MODE & 7);
// 2972 rset = i %if rset&free&i # 0
if (RSET & FREE & I == 0) goto L_0200;
RSET = I;
L_0200:;
// 2973 %finish
L_01FF:;
// 2974 r = free reg(rset&anyareg)
R = FREEREG(RSET & 65280);
// 2975 plant(lea,p,r)
PLANT(78, P, R);
// 2976 %else
goto L_0201;
L_01FE:;
// 2977 f = free
F = FREE;
// 2978 i = free areg(p+ad); plant(lea,p,i)
I = FREEAREG(P + 16384);
PLANT(78, P, I);
// 2979 free = f
FREE = F;
// 2980 r = free reg(rset&(\bregb)); plant(move,i,r)
R = FREEREG(RSET & (~16));
PLANT(1, I, R);
// 2981 %finish
L_0201:;
// 2982 %end
return;
} /* end of LOADADDRESS */
// 2983
// 2984 %routine COMMANDEER(%integer regs)
void COMMANDEER(int REGS) {
// 2985 %integer r
int R;
// 2986 freed = \free®s
FREED = (~FREE) & REGS;
// 2987 %if freed # 0 %start
if (FREED == 0) goto L_0202;
// 2988 regs = freed; r = d0
REGS = FREED;
R = 1;
// 2989 %while regs # 0 %cycle
L_0203:;
if (REGS == 0) goto L_0204;
// 2990 push(r) %and forget cc %if regs&1 # 0
if (REGS & 1 == 0) goto L_0205;
PUSH(R);
FORGETCC();
L_0205:;
// 2991 regs = regs>>1; r = r+1
REGS = (unsigned int)REGS >> 1;
R = R + 1;
// 2992 %repeat
goto L_0203;
L_0204:;
// 2993 free = free!freed; rset = rset&(\freed)
FREE = FREE | FREED;
RSET = RSET & (~FREED);
// 2994 %finish
L_0202:;
// 2995 %end
return;
} /* end of COMMANDEER */
// 2996 %routine RESTORE(%integer regs)
void RESTORE(int REGS) {
// 2997 %integer r
int R;
// 2998 r = a7
R = 16;
// 2999 %while regs # 0 %cycle
L_0206:;
if (REGS == 0) goto L_0207;
// 3000 %if regs&16_8000 # 0 %start
if (REGS & 32768 == 0) goto L_0208;
// 3001 pop(r); forget(r); !*should have remembered it*
POP(R);
FORGET(R);
// 3002 forget cc
FORGETCC();
// 3003 %finish
L_0208:;
// 3004 regs = regs<<1&16_FFFF; r = r-1
REGS = REGS << 1 & 65535;
R = R - 1;
// 3005 %repeat
goto L_0206;
L_0207:;
// 3006 %end
return;
} /* end of RESTORE */
// 3007
// 3008 %routine PARTREG
void PARTREG(void) {
// 3009 ! Something smaller than integer has been loaded to R
// 3010 ! Determine what else to do (using SX,SY)
// 3011 sy = 4 %if r = breg %or r >= a0
if (R == 5) goto L_0209;
if (R < 9) goto L_020A;
L_0209:;
SY = 4;
L_020A:;
// 3012 %while imod(sy) < sx %cycle
L_020B:;
if (_imp_IMOD(SY) >= SX) goto L_020C;
// 3013 %if sy > 0 %start; !signed
if (SY <= 0) goto L_020D;
// 3014 plant(extl-2+sy,0,r); !ext.w,ext.l
PLANT(76 - 2 + SY, 0, R);
// 3015 sy = sy+sy
SY = SY + SY;
// 3016 %else
goto L_020E;
L_020D:;
// 3017 %if sy = -1 %start; !unsigned byte
if (SY != -1) goto L_020F;
// 3018 plantlit(and,255,r)
PLANTLIT(5, 255, R);
// 3019 %else; !unsigned word (half)
goto L_0210;
L_020F:;
// 3020 plantlit(and,16_FFFF,r)
PLANTLIT(5, 65535, R);
// 3021 %finish
L_0210:;
// 3022 sy = 4
SY = 4;
// 3023 %finish
L_020E:;
// 3024 %repeat
goto L_020B;
L_020C:;
// 3025 %end
return;
} /* end of PARTREG */
// 3026
// 3027 !!Start of EVAL
// 3028
// 3029 stsize = stsiz; !additional parameter (for TOSTACK cases)
STSIZE = STSIZ;
// 3030 rset = rset&(\anyareg) %if rset&tobyte # 0; ![1 bit]
if (RSET & 65536 == 0) goto L_0211;
RSET = RSET & (~65280);
L_0211:;
// 3031 p = pp; p = p-ad %if p >= explim
P = *PP;
if (P < EXPLIM) goto L_0212;
P = P - 16384;
L_0212:;
// 3032 rset = rset-asad %and pp = p+ad %if rset&asad # 0
if (RSET & 1048576 == 0) goto L_0213;
RSET = RSET - 1048576;
*PP = P + 16384;
L_0213:;
// 3033 %if p <= 0 %then dp == dint %else dp == dict(p)
if (P > 0) goto L_0214;
DP = (struct IDENTINFO *)DINT;
goto L_0215;
L_0214:;
DP = (struct IDENTINFO *)/*?*/ &DICT[P];
L_0215:;
// 3034 oldfree = free; freed = 0
OLDFREE = FREE;
FREED = 0;
// 3035
// 3036 %if rset # inst %start
if (RSET == 1073741824) goto L_0216;
// 3037 %unless dp_mode&2_110000 = 0 %and pp < np0 %start; !not already reg
if (DP->MODE & 48 != 0) goto L_0217;
if (*PP < NP0) goto L_0218;
L_0217:;
// 3038 j = pp
J = *PP;
// 3039 %if rset&(anydreg!bregb{+tostack}) # 0 %start; !data reg acceptable
if (RSET & (239 | 16) == 0) goto L_0219;
// 3040 i = d0
I = 1;
// 3041 %cycle; !See if available
L_021A:;
// 3042 j = i %and %exit %if c_reg_content(i) = j
if (C.REG.CONTENT[I - 1] != J) goto L_021B;
J = I;
goto L_021C;
L_021B:;
// 3043 i = i+1; i = a0 %if i = maxdreg+1
I = I + 1;
if (I != 4 + 1) goto L_021D;
I = 9;
L_021D:;
// 3044 %repeat %until i > maxareg
if (I > 12) goto L_021C;
goto L_021A;
L_021C:;
// 3045 %finish %else %if rset&anyareg # 0 %start; !try address regs first
goto L_021E;
L_0219:;
if (RSET & 65280 == 0) goto L_021F;
// 3046 i = maxareg
I = 12;
// 3047 %cycle
L_0220:;
// 3048 j = i %and %exit %if c_reg_content(i) = j
if (C.REG.CONTENT[I - 1] != J) goto L_0221;
J = I;
goto L_0222;
L_0221:;
// 3049 i = i-1; i = maxdreg %if i = a0-1
I = I - 1;
if (I != 9 - 1) goto L_0223;
I = 4;
L_0223:;
// 3050 %repeat %until i < d0
if (I < 1) goto L_0222;
goto L_0220;
L_0222:;
// 3051 %finish %else %if j < explim %and rset # tostack %start; !REF: try for address
goto L_021E;
L_021F:;
if (J >= EXPLIM) goto L_0224;
if (RSET == 524288) goto L_0224;
// 3052 i = a0
I = 9;
// 3053 %cycle
L_0225:;
// 3054 %if c_reg_content(i) = j+ad %start
if (C.REG.CONTENT[I - 1] != J + 16384) goto L_0226;
// 3055 free = free&(\(a0b<<(i-a0)))
FREE = FREE & ~(256 << I - 9);
// 3056 dp_flags = dp_flags!(rflag+wflag)
DP->FLAGS = DP->FLAGS | 32 + 16;
// 3057 pp = i+indir
*PP = I + 8;
// 3058 %return
return;
// 3059 %finish
L_0226:;
// 3060 i = i+1
I = I + 1;
// 3061 %repeat %until i > maxareg
if (I > 12) goto L_0227;
goto L_0225;
L_0227:;
// 3062 %finish
L_0224:;
L_021E:;
// 3063 %else; !already reg
goto L_0228;
L_0218:;
// 3064 j = dp_mode+d0; !in case reg alias
J = DP->MODE + 1;
// 3065 %if rset < 0 %start; !EA ok means any reg ok
if (RSET >= 0) goto L_0229;
// 3066 pp = j
*PP = J;
// 3067 %return
return;
// 3068 %finish
L_0229:;
// 3069 pp = c_reg_content(j); !fiddle for update
*PP = C.REG.CONTENT[J - 1];
// 3070 %finish
L_0228:;
// 3071
// 3072 %if 0 < j <= a7 %start; !operand (now) in reg
{
// Double-sided test on J (Part I)
int tmp;
if (0 >= (tmp = J)) goto L_022A;
// Double-sided test on J (Part II)
if (tmp > 16) goto L_022A;
}
// 3073 ok reg(j)
OKREG(J);
// 3074 dp_flags = dp_flags!rflag
DP->FLAGS = DP->FLAGS | 32;
// 3075 -> endload
goto U_100D;
// 3076 %finish
L_022A:;
// 3077
// 3078 %if p <= 0 %start; !literal
if (P > 0) goto L_022B;
// 3079 %return %if rset < 0
if (RSET >= 0) goto L_022C;
return;
L_022C:;
// 3080 %if rset = tostack %start
if (RSET != 524288) goto L_022D;
// 3081 i = constmode; i = pcmode %if p = 0; !null string [sneaky]
I = 122;
if (P != 0) goto L_022E;
I = 58;
L_022E:;
// 3082 plant(lea,temp(i,litval(p)),a0); !A0 must be free
PLANT(78, TEMP(I, LITVAL(P)), 9);
// 3083 forget(a0)
FORGET(9);
// 3084 push structure
PUSHSTRUCTURE();
// 3085 %return
return;
// 3086 %finish
L_022D:;
// 3087 %if pp < explim %start; !normal value
if (*PP >= EXPLIM) goto L_022F;
// 3088 rset = rset&(\bregb) %if p < -(255<<1) %or p&1 # 0; !0:255 ok
if (P < -(255 << 1)) goto L_0230;
if (P & 1 == 0) goto L_0231;
L_0230:;
RSET = RSET & (~16);
L_0231:;
// 3089 r = free reg(rset)
R = FREEREG(RSET);
// 3090 %if r < a0 %or p # 0 %then plant(move,p,r) %c
if (R < 9) goto L_0232;
if (P == 0) goto L_0233;
L_0232:;
PLANT(1, P, R);
goto L_0234;
L_0233:;
PLANT(3, R, R);
L_0234:;
// 3091+ %else plant(sub,r,r)
// 3092 %else; !address within FINAL
goto L_0235;
L_022F:;
// 3093 i = constmode; i = pcmode %if p = 0; !null string [sneaky]
I = 122;
if (P != 0) goto L_0236;
I = 58;
L_0236:;
// 3094 load address(temp(i,litval(p)))
LOADADDRESS(TEMP(I, LITVAL(P)));
// 3095 %finish
L_0235:;
// 3096 c_reg_ccx = pp %and c_reg_ccy = 0 %if r < a0
if (R >= 9) goto L_0237;
C.REG.CCX = *PP;
C.REG.CCY = 0;
L_0237:;
// 3097 ->endload
goto U_100D;
// 3098 %finish
L_022B:;
// 3099 %finish
L_0216:;
// 3100 %if p >= np0 %start; !complex
if (P < NP0) goto L_0238;
// 3101 more:
U_100E:;
// 3102 act = dp_act; x = dp_x; y = dp_y
ACT = DP->ACT;
X = DP->X;
Y = DP->Y;
// 3103 xx = x; yy = y
XX = X;
YY = Y;
// 3104 -> proccall %if act > opmax
if (ACT <= 117) goto L_0239;
goto U_100F;
L_0239:;
// 3105 -> do(act)
DO_line = __LINE__;
DO_file = __FILE__;
DO_index = ACT;
goto case_DO_dispatch;
// 3106 %finish
L_0238:;
// 3107
// 3108 do(move):
case_DO_1:;
// 3109 load:
U_1010:;
// 3110 i = 0
I = 0;
// 3111 i = i+1 %if dp_flags&indirect # 0
if (DP->FLAGS & 2048 == 0) goto L_023B;
I = I + 1;
L_023B:;
// 3112 i = i+2 %if dp_flags < 0
if (DP->FLAGS >= 0) goto L_023C;
I = I + 2;
L_023C:;
// 3113 %if pp >= explim %start {address wanted}
if (*PP < EXPLIM) goto L_023D;
// 3114 %if i = 0 %start
if (I != 0) goto L_023E;
// 3115 free = oldfree
FREE = OLDFREE;
// 3116 load address(p)
LOADADDRESS(P);
// 3117 %else
goto L_023F;
L_023E:;
// 3118 %if i = 3 %start; !indirect name
if (I != 3) goto L_0240;
// 3119 free = oldfree
FREE = OLDFREE;
// 3120 r = free areg(undef); plant(move,p,r)
R = FREEAREG(16);
PLANT(1, P, R);
// 3121 p = r+indir
P = R + 8;
// 3122 %finish
L_0240:;
// 3123 pp = p %and %return %if rset < 0
if (RSET >= 0) goto L_0241;
*PP = P;
return;
L_0241:;
// 3124 free = oldfree
FREE = OLDFREE;
// 3125 r = free reg(rset); plant(move,p,r)
R = FREEREG(RSET);
PLANT(1, P, R);
// 3126 %finish
L_023F:;
// 3127 c_reg_ccx = pp %and c_reg_ccy = 0 %if r < a0
if (R >= 9) goto L_0242;
C.REG.CCX = *PP;
C.REG.CCY = 0;
L_0242:;
// 3128 %else
goto L_0243;
L_023D:;
// 3129 %if i > 0 %start
if (I <= 0) goto L_0244;
// 3130 free = oldfree
FREE = OLDFREE;
// 3131 r = maxareg+1
R = 12 + 1;
// 3132 %cycle
L_0245:;
// 3133 r = r-1
R = R - 1;
// 3134 %if r < a0 %start
if (R >= 9) goto L_0246;
// 3135 r = free areg(p+ad); plant(move,p,r)
R = FREEAREG(P + 16384);
PLANT(1, P, R);
// 3136 plant(move,r+indir,r) %if i = 3
if (I != 3) goto L_0247;
PLANT(1, R + 8, R);
L_0247:;
// 3137 check address(r) %if i > 1 %and control&assbit # 0
if (I <= 1) goto L_0248;
if (CONTROL & 134217728 == 0) goto L_0248;
CHECKADDRESS(R);
L_0248:;
// 3138 %finish
L_0246:;
// 3139 %repeat %until c_reg_content(r) = p+ad
if (C.REG.CONTENT[R - 1] == P + 16384) goto L_0249;
goto L_0245;
L_0249:;
// 3140 free = free&(\(a0b<<(r-a0)))
FREE = FREE & ~(256 << R - 9);
// 3141 p = r+indir
P = R + 8;
// 3142 %finish
L_0244:;
// 3143 pp = p %and %return %if rset = ref
if (RSET != -2147483648) goto L_024A;
*PP = P;
return;
L_024A:;
// 3144 sx = rset>>sizeshift&3; sx = 4 %if sx = 0
SX = (unsigned int)RSET >> 16 & 3;
if (SX != 0) goto L_024B;
SX = 4;
L_024B:;
// 3145 i = dp_flags
I = DP->FLAGS;
// 3146 sy = size(dp_type)
SY = SIZE(DP->TYPE);
// 3147 %if c_localdpos <= p < dictlim %and i&okflag = 0 %and c_forward = 0 %start
{
// Double-sided test on P (Part I)
int tmp;
if (C.LOCALDPOS > (tmp = P)) goto L_024C;
// Double-sided test on P (Part II)
if (tmp >= DICTLIM) goto L_024C;
}
if (I & 64 != 0) goto L_024C;
if (C.FORWARD != 0) goto L_024C;
// 3148 !local, simple, always accessed
// 3149 %if i&wflag = 0 %start; !unassigned
if (I & 16 != 0) goto L_024D;
// 3150 report(asserr+warn,p,0) %if c_faults = 0
if (C.FAULTS != 0) goto L_024E;
REPORT(41 + (-128), P, 0);
L_024E:;
// 3151 %finish
L_024D:;
// 3152 dp_flags = dp_flags+okflag %if dp_flags >= 0 %and sy > 0
if (DP->FLAGS < 0) goto L_024F;
if (SY <= 0) goto L_024F;
DP->FLAGS = DP->FLAGS + 64;
L_024F:;
// 3153 %finish
L_024C:;
// 3154 %if rset = tostack %start
if (RSET != 524288) goto L_0250;
// 3155 free = oldfree
FREE = OLDFREE;
// 3156 plant(lea,p,a0); !A0 must be free
PLANT(78, P, 9);
// 3157 forget(a0)
FORGET(9);
// 3158 push structure
PUSHSTRUCTURE();
// 3159 %return
return;
// 3160 %finish
L_0250:;
// 3161 intern(5) %and %return %if sy <= 0
if (SY > 0) goto L_0251;
INTERN(5);
return;
L_0251:;
// 3162 i = i!okflag %if control&bassbit>>1<<sy = 0
if (CONTROL & (unsigned int)16777216 >> 1 << SY != 0) goto L_0252;
I = I | 64;
L_0252:;
// 3163 %if i&okflag # 0 %and rset < 0 %start; !not necessary to load?
if (I & 64 == 0) goto L_0253;
if (RSET >= 0) goto L_0253;
// 3164 %if sy = sx %start; !same size
if (SY != SX) goto L_0254;
// 3165 pp = p
*PP = P;
// 3166 %return
return;
// 3167 %finish
L_0254:;
// 3168 %finish
L_0253:;
// 3169 free = oldfree
FREE = OLDFREE;
// 3170 %if i&okflag # 0 %then i = -1 %else i = sy
if (I & 64 == 0) goto L_0255;
I = -1;
goto L_0256;
L_0255:;
I = SY;
L_0256:;
// 3171 sy = -sy %if sy # 4 %and (dict(dp_type)_flags&nonord # 0 %c
if (SY == 4) goto L_0257;
if (DICT[DP->TYPE].FLAGS & 12 != 0) goto L_0258;
if (DICT[DP->TYPE + 1].VAL != 0) goto L_0257;
L_0258:;
SY = -SY;
L_0257:;
// 3172+ %or dict(dp_type+1)_val = 0); !unsigned
// 3173 %if sy = -1 %start; !unsigned byte
if (SY != -1) goto L_0259;
// 3174 %if free&bregb # 0 %start
if (FREE & 16 == 0) goto L_025A;
// 3175 %if rset&bregb # 0 %start
if (RSET & 16 == 0) goto L_025B;
// 3176 rset = bregb
RSET = 16;
// 3177 %else
goto L_025C;
L_025B:;
// 3178 plant(moveb,p,breg)
PLANT(257, P, 5);
// 3179 forget(breg)
FORGET(5);
// 3180 p = breg; sy = 4
P = 5;
SY = 4;
// 3181 %finish
L_025C:;
// 3182 %finish
L_025A:;
// 3183 %finish %else rset = rset&(\bregb)
goto L_025D;
L_0259:;
RSET = RSET & (~16);
L_025D:;
// 3184 %if sy < 2 %or sx = 1 %start
if (SY < 2) goto L_025E;
if (SX != 1) goto L_025F;
L_025E:;
// 3185 %if rset&(anydreg!bregb) = 0 %start
if (RSET & (239 | 16) != 0) goto L_0260;
// 3186 !Can't load bytes,halfs to address regs
// 3187 ! or store bytes from them
// 3188 r = free dreg
R = FREEDREG();
// 3189 plant(move+imod(sy)<<8,p,r)
PLANT(1 + (_imp_IMOD(SY) << 8), P, R);
// 3190 partreg
PARTREG();
// 3191 p = r; free = oldfree
P = R;
FREE = OLDFREE;
// 3192 %finish %else rset = rset&(\anyareg)
goto L_0261;
L_0260:;
RSET = RSET & (~65280);
L_0261:;
// 3193 %finish
L_025F:;
// 3194 %if sy = 2 %and rset&anyareg&free # 0 %start
if (SY != 2) goto L_0262;
if (RSET & 65280 & FREE == 0) goto L_0262;
// 3195 rset = rset&(\anydreg); !prefer areg for word (auto-extend)
RSET = RSET & (~239);
// 3196 %finish
L_0262:;
// 3197 r = free reg(rset)
R = FREEREG(RSET);
// 3198 plant(move+imod(sy)<<8,p,r)
PLANT(1 + (_imp_IMOD(SY) << 8), P, R);
// 3199 c_reg_ccx = pp %and c_reg_ccy = 0 %if r < a0
if (R >= 9) goto L_0263;
C.REG.CCX = *PP;
C.REG.CCY = 0;
L_0263:;
// 3200 %if sy # 4 %start
if (SY == 4) goto L_0264;
// 3201 partreg
PARTREG();
// 3202 %finish
L_0264:;
// 3203 %if i >= 0 %start
if (I < 0) goto L_0265;
// 3204 plant(cmp+i<<8,r,d7); !check unassigned
PLANT(4 + (I << 8), R, 8);
// 3205 srcall(unass)
SRCALL(102);
// 3206 forget cc
FORGETCC();
// 3207 %finish
L_0265:;
// 3208 %if sy # 4 %and r # breg %start; !not full reg
if (SY == 4) goto L_0266;
if (R == 5) goto L_0266;
// 3209 forget(r)
FORGET(R);
// 3210 -> endload1
goto U_1011;
// 3211 %finish
L_0266:;
// 3212 %finish
L_0243:;
// 3213 endload:
U_100D:;
// 3214 c_reg_content(r) = pp
C.REG.CONTENT[R - 1] = *PP;
// 3215 endload1:
U_1011:;
// 3216 free = free&(\(d0b<<(r-d0)))
FREE = FREE & ~(1 << R - 1);
// 3217 r = r+indir %if rset = ref
if (RSET != -2147483648) goto L_0267;
R = R + 8;
L_0267:;
// 3218 pp = r
*PP = R;
// 3219 %return
return;
// 3220
// 3221 dataload:
U_1012:;
// 3222 eval(p,anydreg)
EVAL(/*?*/ &P, 239);
// 3223 ok reg(p)
OKREG(P);
// 3224 -> endload
goto U_100D;
// 3225
// 3226 !!!!!!!!!!!!!!!! Array / Record / Map !!!!!!!!!!!!!!!!!!
// 3227
// 3228 %integer%fn FREEISH AREG(%integer for)
int FREEISHAREG(int FOR) {
// 3229 !Use the register component of M if alterable
// 3230 ! to avoid excessive dissipation of address registers
// 3231 %integer i
int I;
// 3232 i = m&7
I = M & 7;
// 3233 %result = free areg(for) %if a0b<<i&oldfree = 0 %or m >= framemode
if (256 << I & OLDFREE == 0) goto L_0268;
if (M < 168) goto L_0269;
L_0268:;
return FREEAREG(FOR);
L_0269:;
// 3234 free = free&(\(a0b<<i))
FREE = FREE & ~(256 << I);
// 3235 i = i+a0; c_reg_content(i) = for
I = I + 9;
C.REG.CONTENT[I - 1] = FOR;
// 3236 %result = i
return I;
// 3237 %end
} /* end of FREEISHAREG */
// 3238 %routine ADEVAL(%integer x,y,q)
void ADEVAL(int X, int Y, int Q) {
// 3239 !Base X, scaled index Y, displacement Q
// 3240 %integer i,j
int I;
int J;
// 3241 %if x <= 0 %start; !%const
if (X > 0) goto L_026A;
// 3242 m = constmode; v = litval(x)
M = 122;
V = LITVAL(X);
// 3243 %else
goto L_026B;
L_026A:;
// 3244 eval(x,ref)
EVAL(/*?*/ &X, -2147483648);
// 3245 m = dict(x)_mode; v = dict(x)_val
M = DICT[X].MODE;
V = DICT[X].VAL;
// 3246 %if m = c_mode %and v < 0 %start
if (M != C.MODE) goto L_026C;
if (V >= 0) goto L_026C;
// 3247 !*Assertion: SP will have same value when address used
// 3248 m = dispmode+7; v = v-c_sp
M = 40 + 7;
V = V - C.SP;
// 3249 %finish %else %if m&2_111000 = aregmode+indir %start
goto L_026D;
L_026C:;
if (M & 56 != 8 + 8) goto L_026E;
// 3250 m = m+(dispmode-(aregmode+indir))
M = M + (40 - (8 + 8));
// 3251 %finish
L_026E:;
L_026D:;
// 3252 %finish
L_026B:;
// 3253 eval(y,anyreg) %if y # 0; !subscript
if (Y == 0) goto L_026F;
EVAL(/*?*/ &Y, 65535);
L_026F:;
// 3254 %if m&2_111000 = indexmode %start; !X already involves index
if (M & 56 != 48) goto L_0270;
// 3255 %if y = 0 %start
if (Y != 0) goto L_0271;
// 3256 !See if Q can be combined with existing disp
// 3257 j = mite(v)
J = MITE(V);
// 3258 i = j+q
I = J + Q;
// 3259 %if is mite(i)=TRUE %start
if (ISMITE(I) != 1) goto L_0272;
// 3260 v = v-j+i&255
V = V - J + (I & 255);
// 3261 %return
return;
// 3262 %finish
L_0272:;
// 3263 %finish
L_0271:;
// 3264 i = freeish areg(x+ad)
I = FREEISHAREG(X + 16384);
// 3265 plant(lea,x,i)
PLANT(78, X, I);
// 3266 m = i+(dispmode-a0); v = 0
M = I + (40 - 9);
V = 0;
// 3267 %finish
L_0270:;
// 3268 %if y # 0 %start
if (Y == 0) goto L_0273;
// 3269 %if m&63 = pcmode %start
if (M & 63 != 58) goto L_0274;
// 3270 i = free areg(undef); plant(lea,temp(m,v+q),i)
I = FREEAREG(16);
PLANT(78, TEMP(M, V + Q), I);
// 3271 m = i+(dispmode-a0); v = 0; q = 0
M = I + (40 - 9);
V = 0;
Q = 0;
// 3272 %finish %else %unless is mite(v+q)=TRUE %start; !indexmode out
goto L_0275;
L_0274:;
if (ISMITE(V + Q) == 1) goto L_0276;
// 3273 %unless is mite(q)=TRUE %start; !& out even if V absorbed
if (ISMITE(Q) == 1) goto L_0277;
// 3274 i = freeish areg(undef)
I = FREEISHAREG(16);
// 3275 %if is short(v+q)=TRUE %start
if (ISSHORT(V + Q) != 1) goto L_0278;
// 3276 plant(lea,temp(m,v+q),i)
PLANT(78, TEMP(M, V + Q), I);
// 3277 %else
goto L_0279;
L_0278:;
// 3278 plant(lea,x,i); addimm(q,i)
PLANT(78, X, I);
ADDIMM(Q, I);
// 3279 %finish
L_0279:;
// 3280 q = 0
Q = 0;
// 3281 %else
goto L_027A;
L_0277:;
// 3282 i = freeish areg(x+ad)
I = FREEISHAREG(X + 16384);
// 3283 plant(lea,x,i)
PLANT(78, X, I);
// 3284 %finish
L_027A:;
// 3285 m = i+(dispmode-a0); v = 0
M = I + (40 - 9);
V = 0;
// 3286 %finish
L_0276:;
L_0275:;
// 3287 %finish
L_0273:;
// 3288 v = v+q
V = V + Q;
// 3289 %if y # 0 %start
if (Y == 0) goto L_027B;
// 3290 m = m+(indexmode-dispmode)
M = M + (48 - 40);
// 3291 v = (y-d0)<<12+16_0800+v&255
V = (Y - 1 << 12) + 2048 + (V & 255);
// 3292 %finish
L_027B:;
// 3293 %end
return;
} /* end of ADEVAL */
// 3294
// 3295 do(index):
case_DO_78:;
// 3296 ! P => {index,ARRAY,SUBSCRIPT}
// 3297 ! ARRAY => ARRID
// 3298 ! or {index,ARRAY,SUBSCRIPT}
// 3299 ! or {recref,RECORD,ARRAY}
// 3300 ! TYPE INFO : TYPE = ELTYPE, XTYPE = INDEX-TYPE
// 3301 ! MODE,VAL = DOPE ADDRESS
// 3302 dx == dict(x)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
// 3303 i = dx_type; !array type cell
I = DX->TYPE;
// 3304 tx == dict(i)
TX = (struct IDENTINFO *)/*?*/ &DICT[I];
// 3305 get bounds(tx_xtype,sx,sy)
GETBOUNDS(TX->XTYPE, /*?*/ &SX, /*?*/ &SY);
// 3306 !establish multiplier (element size)
// 3307 m = imod(nsize(tx))
M = _imp_IMOD(NSIZE(TX));
// 3308 !ARRFLAG is set for either ABC requested or dynamic
// 3309 %if dx_flags&arrflag # 0 %and (y > 0 %or sx = minint %or m = 0) %start
if (DX->FLAGS & 8 == 0) goto L_027C;
if (Y > 0) goto L_027D;
if (SX == -2147483648) goto L_027D;
if (M != 0) goto L_027C;
L_027D:;
// 3310 commandeer(d0b+d1b+a0b); ![D1 ??]
COMMANDEER(1 + 2 + 256);
// 3311 ! subscript
// 3312 eval(y,d0b)
EVAL(/*?*/ &Y, 1);
// 3313 ! dope vector
// 3314 j = 0
J = 0;
// 3315 j = j+12 %and i = i+1 %and tx == dict(i) %while tx_mode = 0
L_027E:;
if (TX->MODE != 0) goto L_027F;
J = J + 12;
I = I + 1;
TX = (struct IDENTINFO *)/*?*/ &DICT[I];
goto L_027E;
L_027F:;
// 3316 %if tx_flags&indirect # 0 %start
if (TX->FLAGS & 2048 == 0) goto L_0280;
// 3317 plant(move,i,a0)
PLANT(1, I, 9);
// 3318 addimm(j,a0) %if j # 0
if (J == 0) goto L_0281;
ADDIMM(J, 9);
L_0281:;
// 3319 %else
goto L_0282;
L_0280:;
// 3320 %if tx_val = 0 %and tx_mode = constmode %start
if (TX->VAL != 0) goto L_0283;
if (TX->MODE != 122) goto L_0283;
// 3321 ! dope info not yet created
// 3322 fill code(1) %if cad&1 # 0
if (CAD & 1 == 0) goto L_0284;
FILLCODE(1);
L_0284:;
// 3323 tx_val = cad
TX->VAL = CAD;
// 3324 set code longword(sy)
SETCODELONGWORD(SY);
// 3325 set code longword(sx)
SETCODELONGWORD(SX);
// 3326 set code longword(m)
SETCODELONGWORD(M);
// 3327 %finish
L_0283:;
// 3328 plant(lea,i,a0)
PLANT(78, I, 9);
// 3329 %finish
L_0282:;
// 3330 srcall(index)
SRCALL(78);
// 3331 forget(d0); forget(a0)
FORGET(1);
FORGET(9);
// 3332 restore(freed&(\d0b))
RESTORE(FREED & (~1));
// 3333 free = oldfree&(\d0b)
FREE = OLDFREE & (~1);
// 3334 freed = freed&d0b
FREED = FREED & 1;
// 3335 i = x; eval(i,anyareg&free+asad)
I = X;
EVAL(/*?*/ &I, (65280 & FREE) + 1048576);
// 3336 plant(add,d0,i)
PLANT(2, 1, I);
// 3337 %if dp_flags < 0 %then forget(i) {ad of ad of P} %c
if (DP->FLAGS >= 0) goto L_0285;
FORGET(I);
goto L_0286;
L_0285:;
C.REG.CONTENT[I - 1] = P + 16384;
L_0286:;
// 3338+ %else c_reg_content(i) = p+ad
// 3339 free = free!d0b %if freed = 0
if (FREED != 0) goto L_0287;
FREE = FREE | 1;
L_0287:;
// 3340 restore(freed)
RESTORE(FREED);
// 3341 m = i+(dispmode-a0); v = 0
M = I + (40 - 9);
V = 0;
// 3342 -> setflags
goto U_1013;
// 3343 %finish
L_027C:;
// 3344 index1:
U_1014:;
// 3345 !deal with subscript
// 3346 j = 0
J = 0;
// 3347 %if y <= 0 %start; !literal subscript
if (Y > 0) goto L_0288;
// 3348 j = litval(y); y = 0
J = LITVAL(Y);
Y = 0;
// 3349 %finish
L_0288:;
// 3350 %if y >= np0 %and dict(y)_act = add %c
if (Y < NP0) goto L_0289;
if (DICT[Y].ACT != 2) goto L_0289;
if (DICT[Y].Y > 0) goto L_0289;
// 3351+ %and dict(y)_y <= 0 %start; !Y => {add,exp,lit}
// 3352 j = litval(dict(y)_y); y = dict(y)_x
J = LITVAL(DICT[Y].Y);
Y = DICT[Y].X;
// 3353 %finish
L_0289:;
// 3354 %if m > 1 %start
if (M <= 1) goto L_028A;
// 3355 %if y # 0 %start
if (Y == 0) goto L_028B;
// 3356 %if m&(m-1) # 0 %and m <= 32767 %and sy <= 32767 %and sx >= -32768 %start
if (M & M - 1 == 0) goto L_028C;
if (M > 32767) goto L_028C;
if (SY > 32767) goto L_028C;
if (SX < -32768) goto L_028C;
// 3357 putexp(muls,y,litref(m),inttype)
PUTEXP(12, Y, LITREF(M), 43);
// 3358 %else
goto L_028D;
L_028C:;
// 3359 putexp(imul,y,litref(m),inttype)
PUTEXP(86, Y, LITREF(M), 43);
// 3360 %finish
L_028D:;
// 3361 y = item
Y = ITEM;
// 3362 %finish
L_028B:;
// 3363 %finish
L_028A:;
// 3364 %if dx_flags&(name+ext+arrflag+indirect) = indirect %and sx # 0 %start
if (DX->FLAGS & (-32768) + 16384 + 8 + 2048 != 2048) goto L_028E;
if (SX == 0) goto L_028E;
// 3365 dx_val = dx_val+4; !0-based
DX->VAL = DX->VAL + 4;
// 3366 adeval(x,y,j*m)
ADEVAL(X, Y, J * M);
// 3367 dx_val = dx_val-4
DX->VAL = DX->VAL - 4;
// 3368 %else
goto L_028F;
L_028E:;
// 3369 j = j-sx; j = j*m %if m > 1
J = J - SX;
if (M <= 1) goto L_0290;
J = J * M;
L_0290:;
// 3370 adeval(x,y,j); !array,index,displacement
ADEVAL(X, Y, J);
// 3371 %finish
L_028F:;
// 3372 setflags:
U_1013:;
// 3373 dx_flags = dx_flags!(mflag+wflag+rflag); !don't know
DX->FLAGS = DX->FLAGS | 128 + 16 + 32;
// 3374 setmode:
U_1015:;
// 3375 ![what about FRAMEMODE?]
// 3376 %if dispmode <= m < indexmode %start
{
// Double-sided test on M (Part I)
int tmp;
if (40 > (tmp = M)) goto L_0291;
// Double-sided test on M (Part II)
if (tmp >= 48) goto L_0291;
}
// 3377 %unless is short(v)=TRUE %start
if (ISSHORT(V) == 1) goto L_0292;
// 3378 ok areg(m+(a0-dispmode),oldfree&anyareg)
OKAREG(M + (9 - 40), OLDFREE & 65280);
// 3379 addimm(v,r); forget(r)
ADDIMM(V, R);
FORGET(R);
// 3380 m = r-(a0-dispmode); v = 0
M = R - (9 - 40);
V = 0;
// 3381 %finish
L_0292:;
// 3382 %if pp >= explim %and v = 0 %and rset # ref %and dp_flags >= 0 %start
if (*PP < EXPLIM) goto L_0293;
if (V != 0) goto L_0293;
if (RSET == -2147483648) goto L_0293;
if (DP->FLAGS < 0) goto L_0293;
// 3383 !address wanted, disp zero, as value, not name
// 3384 ! so the address is simply in the register
// 3385 ok reg(m+(a0-dispmode))
OKREG(M + (9 - 40));
// 3386 free = oldfree
FREE = OLDFREE;
// 3387 -> endload
goto U_100D;
// 3388 %finish
L_0293:;
// 3389 %finish
L_0291:;
// 3390 dp_mode = m; dp_val = v
DP->MODE = M;
DP->VAL = V;
// 3391 ->load
goto U_1010;
// 3392
// 3393 do(recref):
case_DO_45:;
// 3394 ! P => {recref,RECORD,SUBEL}
// 3395 dx == dict(x)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
// 3396 adeval(x,0,dict(y)_val); !record,subscript,displacement
ADEVAL(X, 0, DICT[Y].VAL);
// 3397 ->setflags
goto U_1013;
// 3398
// 3399 do(storemap):
case_DO_47:;
// 3400 v = 0
V = 0;
// 3401 %if y >= explim %start
if (Y < EXPLIM) goto L_0294;
// 3402 y = y-ad; eval(y,ref)
Y = Y - 16384;
EVAL(/*?*/ &Y, -2147483648);
// 3403 m = dict(y)_mode; v = dict(y)_val
M = DICT[Y].MODE;
V = DICT[Y].VAL;
// 3404 %else
goto L_0295;
L_0294:;
// 3405 %if y >= np0 %start
if (Y < NP0) goto L_0296;
// 3406 %if dict(y)_act = add %start
if (DICT[Y].ACT != 2) goto L_0297;
// 3407 m = dict(y)_y
M = DICT[Y].Y;
// 3408 y = dict(y)_x %and v = litval(m) %if m <= 0
if (M > 0) goto L_0298;
Y = DICT[Y].X;
V = LITVAL(M);
L_0298:;
// 3409 ! eval(y,val) %if y >= dictlim
// 3410 %finish;! %else eval(y,val)
L_0297:;
// 3411 %finish
L_0296:;
// 3412 eval(y,anyareg)
EVAL(/*?*/ &Y, 65280);
// 3413 check address(y) %if control&assbit # 0 %and pp < explim
if (CONTROL & 134217728 == 0) goto L_0299;
if (*PP >= EXPLIM) goto L_0299;
CHECKADDRESS(Y);
L_0299:;
// 3414 m = y+(dispmode-a0)
M = Y + (40 - 9);
// 3415 %finish
L_0295:;
// 3416 -> setmode
goto U_1015;
// 3417
// 3418 do(lenref):
case_DO_79:;
// 3419 do(sindex):
case_DO_82:;
// 3420 x = x-ad %if x >= explim
if (X < EXPLIM) goto L_029A;
X = X - 16384;
L_029A:;
// 3421 dx == dict(x)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
// 3422 %if y <= 0 %then adeval(x,0,litval(y)) %c
if (Y > 0) goto L_029B;
ADEVAL(X, 0, LITVAL(Y));
goto L_029C;
L_029B:;
EVAL(/*?*/ &Y, 239);
ADEVAL(X, Y, 0);
L_029C:;
// 3423+ %else eval(y,anydreg) %and adeval(x,y,0)
// 3424 -> setflags
goto U_1013;
// 3425
// 3426 do(dnew):
case_DO_115:;
// 3427 commandeer(c_free)
COMMANDEER(C.FREE);
// 3428 plant(move,y,d0)
PLANT(1, Y, 1);
// 3429 srcall(act)
SRCALL(ACT);
// 3430 forget regs
FORGETREGS();
// 3431 c_reg_line = line
C.REG.LINE = LINE;
// 3432 -> endmap
goto U_1016;
// 3433
// 3434 do(dtostring):
case_DO_107:;
// 3435 proccall:
U_100F:;
// 3436 dx == dict(act)
DX = (struct IDENTINFO *)/*?*/ &DICT[ACT];
// 3437 -> rcall %if p < np
if (P >= NP) goto L_029D;
goto U_1017;
L_029D:;
// 3438 -> funcall %if dx_flags&writable = 0
if (DX->FLAGS & 1 != 0) goto L_029E;
goto U_1018;
L_029E:;
// 3439 !mapcall
// 3440 commandeer(c_free)
COMMANDEER(C.FREE);
// 3441 call
CALL();
// 3442 endmap:
U_1016:;
// 3443 free = oldfree
FREE = OLDFREE;
// 3444 r = a0
R = 9;
// 3445 ok areg(a0,\freed&anyareg) %if rset # ref
if (RSET == -2147483648) goto L_029F;
OKAREG(9, (~FREED) & 65280);
L_029F:;
// 3446 restore(freed)
RESTORE(FREED);
// 3447 free = free&(\(a0b<<(r-a0)))
FREE = FREE & ~(256 << R - 9);
// 3448 c_reg_content(r) = p+ad
C.REG.CONTENT[R - 1] = P + 16384;
// 3449 m = r+(dispmode-a0); v = 0; !0(A?)
M = R + (40 - 9);
V = 0;
// 3450 ->setmode
goto U_1015;
// 3451
// 3452 funcall:
U_1018:;
// 3453 commandeer(c_free)
COMMANDEER(C.FREE);
// 3454 call
CALL();
// 3455 r = typecell(dx_type)_reg&15+d0
R = (TYPECELL(DX->TYPE)->REG & 15) + 1;
// 3456 c_reg_ccx = pp %and c_reg_ccy = 0 %if dx_flags&okflag # 0
if (DX->FLAGS & 64 == 0) goto L_02A0;
C.REG.CCX = *PP;
C.REG.CCY = 0;
L_02A0:;
// 3457 endloadr:
U_1019:;
// 3458 free = oldfree
FREE = OLDFREE;
// 3459 %if rset # ref %then ok reg(r)
if (RSET == -2147483648) goto L_02A1;
OKREG(R);
L_02A1:;
// 3460 restore(freed)
RESTORE(FREED);
// 3461 ->endload
goto U_100D;
// 3462
// 3463 rcall:
U_1017:;
// 3464 flush %if pendcond # 0
if (PENDCOND == 0) goto L_02A2;
FLUSH();
L_02A2:;
// 3465 update sp
UPDATESP();
// 3466 !<<IMP
// 3467 %while act = dprintstr %and x >= np0 %and dict(x)_act = concat %cycle
L_02A3:;
if (ACT != 155) goto L_02A4;
if (X < NP0) goto L_02A4;
if (DICT[X].ACT != 106) goto L_02A4;
// 3468 dp_x = dict(x)_x; !first of pair
DP->X = DICT[X].X;
// 3469 call; free = c_free
CALL();
FREE = C.FREE;
// 3470 x = dict(x)_y; dp_x = x
X = DICT[X].Y;
DP->X = X;
// 3471 %repeat
goto L_02A3;
L_02A4:;
// 3472 !<<BOTH
// 3473 call
CALL();
// 3474 c_access = 0 %if dx_flags&noret # 0
if (DX->FLAGS & 64 == 0) goto L_02A5;
C.ACCESS = 0;
L_02A5:;
// 3475 forget triples %if pp+1 = np %and curlab = c_lab1 %c
if (*PP + 1 != NP) goto L_02A6;
if (CURLAB != C.LAB1) goto L_02A6;
if (DICT[CURLAB].VAL < 0) goto L_02A6;
if (DICT[CURLAB + 1].VAL < 0) goto L_02A6;
FORGETTRIPLES();
L_02A6:;
// 3476+ %and dict(curlab)_val >= 0 %and dict(curlab+1)_val >= 0
// 3477 %return
return;
// 3478
// 3479 !!!!!!!!!!!!!!!!!!!!!!!!! Operators !!!!!!!!!!!!!!!!!!!!!!!!!!!
// 3480
// 3481 %routine EVALXY
void EVALXY(void) {
// 3482 rset = rset&(\bregb)
RSET = RSET & (~16);
// 3483 commandeer(d0b+d1b)
COMMANDEER(1 + 2);
// 3484 %if 999 > weight(x) < weight(y) %start
{
// Double-sided test on WEIGHT(X) (Part I)
int tmp;
if (999 <= (tmp = WEIGHT(X))) goto L_02A7;
// Double-sided test on WEIGHT(X) (Part II)
if (tmp >= WEIGHT(Y)) goto L_02A7;
}
// 3485 eval(y,d1b); eval(x,d0b)
EVAL(/*?*/ &Y, 2);
EVAL(/*?*/ &X, 1);
// 3486 %else
goto L_02A8;
L_02A7:;
// 3487 eval(x,d0b); eval(y,d1b)
EVAL(/*?*/ &X, 1);
EVAL(/*?*/ &Y, 2);
// 3488 %finish
L_02A8:;
// 3489 %end
return;
} /* end of EVALXY */
// 3490
// 3491 %routine STACKOP(%integer s)
void STACKOP(int S) {
// 3492 stsiz = s
STSIZ = S;
// 3493 sp = c_sp
SP = C.SP;
// 3494 eval(x,tostack); free = free!a0b
EVAL(/*?*/ &X, 524288);
FREE = FREE | 256;
// 3495 eval(y,a0b+asad)
EVAL(/*?*/ &Y, 256 + 1048576);
// 3496 plant(move,a7,a1); !dest (stack)
PLANT(1, 16, 10);
// 3497 structcall(act,s)
STRUCTCALL(ACT, S);
// 3498 forget(a0); forget(a1); forget(a0+2)
FORGET(9);
FORGET(10);
FORGET(9 + 2);
// 3499 %end
return;
} /* end of STACKOP */
// 3500
// 3501 !<<IMP
// 3502 do(prel):
case_DO_46:;
// 3503 ! P => {prel,BASENAME,INDEX}
// 3504 dx == dict(x)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
// 3505 m = imod(size(dx_type))
M = _imp_IMOD(SIZE(DX->TYPE));
// 3506 sx = 0; sy = 999999
SX = 0;
SY = 999999;
// 3507 -> index1
goto U_1014;
// 3508
// 3509 !<<BOTH
// 3510
// 3511 do(check): !CHECK rangetype,value
case_DO_111:;
// 3512 commandeer(d0b)
COMMANDEER(1);
// 3513 eval(y,d0b)
EVAL(/*?*/ &Y, 1);
// 3514 srcall(x)
SRCALL(X);
// 3515 r = d0
R = 1;
// 3516 -> endloadr
goto U_1019;
// 3517
// 3518 ![Note that all literal subtraction comes through as ADD]
// 3519 do(add):
case_DO_2:;
// 3520 %if control&overbit # 0 %start
if (CONTROL & 268435456 == 0) goto L_02A9;
// 3521 -> dataload %if rset&(\anyareg) = 0
if (RSET & (~65280) != 0) goto L_02AA;
goto U_1012;
L_02AA:;
// 3522 rset = rset&(\anyareg)
RSET = RSET & (~65280);
// 3523 %finish
L_02A9:;
// 3524 -> dataload %if rset&(\bregb) = 0
if (RSET & (~16) != 0) goto L_02AB;
goto U_1012;
L_02AB:;
// 3525 rset = rset&(\bregb)
RSET = RSET & (~16);
// 3526 %if y < 0 %start
if (Y >= 0) goto L_02AC;
// 3527 %if y >= litquick %start; !(ADDQ,SUBQ)
if (Y < -16) goto L_02AD;
// 3528 y = y-1 %and act = sub %if y&1 # 0; !'negate' if 'negative'
if (Y & 1 == 0) goto L_02AE;
Y = Y - 1;
ACT = 3;
L_02AE:;
// 3529 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3530 ->fin1
goto U_101A;
// 3531 %finish
L_02AD:;
// 3532 %if y = -(128<<1) %start; !+128
if (Y != -(128 << 1)) goto L_02AF;
// 3533 act = sub; y = y+1; !- -128 (MOVEQ)
ACT = 3;
Y = Y + 1;
// 3534 -> op2
goto U_101B;
// 3535 %finish
L_02AF:;
// 3536 %finish
L_02AC:;
// 3537 -> op1
goto U_101C;
// 3538 do(eor):
case_DO_7:;
// 3539 -> dataload %if rset&(\bregb) = 0
if (RSET & (~16) != 0) goto L_02B0;
goto U_1012;
L_02B0:;
// 3540 rset = rset&(\bregb)
RSET = RSET & (~16);
// 3541 do(or):
case_DO_6:;
// 3542 do(and):
case_DO_5:;
// 3543 -> dataload %if rset&(\anyareg) = 0
if (RSET & (~65280) != 0) goto L_02B1;
goto U_1012;
L_02B1:;
// 3544 rset = rset&(\anyareg)
RSET = RSET & (~65280);
// 3545 op1:
U_101C:;
// 3546 wx = weight(x)
WX = WEIGHT(X);
// 3547 %if wx <= 1 %and y <= 0 %and y >= litmite %and rset&(\anyareg) # 0 %start
if (WX > 1) goto L_02B2;
if (Y > 0) goto L_02B2;
if (Y < -255) goto L_02B2;
if (RSET & (~65280) == 0) goto L_02B2;
// 3548 rset = rset&(\anyareg)
RSET = RSET & (~65280);
// 3549 i = x; x = y; y = i
I = X;
X = Y;
Y = I;
// 3550 %finish %else %if 999 > wx < weight(y) %start
goto L_02B3;
L_02B2:;
{
// Double-sided test on WX (Part I)
int tmp;
if (999 <= (tmp = WX)) goto L_02B4;
// Double-sided test on WX (Part II)
if (tmp >= WEIGHT(Y)) goto L_02B4;
}
// 3551 i = x; x = y; y = i
I = X;
X = Y;
Y = I;
// 3552 %finish
L_02B4:;
L_02B3:;
// 3553 -> op2
goto U_101B;
// 3554 do(sub):
case_DO_3:;
// 3555 %if control&overbit # 0 %start
if (CONTROL & 268435456 == 0) goto L_02B5;
// 3556 -> dataload %if rset&(\anyareg) = 0
if (RSET & (~65280) != 0) goto L_02B6;
goto U_1012;
L_02B6:;
// 3557 rset = rset&(\anyareg)
RSET = RSET & (~65280);
// 3558 %finish
L_02B5:;
// 3559 rset = rset&(\bregb)
RSET = RSET & (~16);
// 3560 op2:
U_101B:;
// 3561 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3562 op3:
U_101D:;
// 3563 oldfree = free
OLDFREE = FREE;
// 3564 %if y <= 0 %and y >= litmite %and free&(anydreg!bregb) # 0 %start
if (Y > 0) goto L_02B7;
if (Y < -255) goto L_02B7;
if (FREE & (239 | 16) == 0) goto L_02B7;
// 3565 eval(y,anydreg!bregb); !bring Y to reg
EVAL(/*?*/ &Y, 239 | 16);
// 3566 %finish %else %if act = eor %and y > 0 %start
goto L_02B8;
L_02B7:;
if (ACT != 7) goto L_02B9;
if (Y <= 0) goto L_02B9;
// 3567 eval(y,anydreg)
EVAL(/*?*/ &Y, 239);
// 3568 %finish %else %if act > sub %start
goto L_02B8;
L_02B9:;
if (ACT <= 3) goto L_02BA;
// 3569 %if x = breg %and y > 0 %start
if (X != 5) goto L_02BB;
if (Y <= 0) goto L_02BB;
// 3570 sy = tsize(y)
SY = TSIZE(Y);
// 3571 %if sy = 1 %or (sy = 2 %and act = and) %start
if (SY == 1) goto L_02BC;
if (SY != 2) goto L_02BD;
if (ACT != 5) goto L_02BD;
L_02BC:;
// 3572 eval(y,val&(\anyareg)+sy<<sizeshift)
EVAL(/*?*/ &Y, ((-2147418113) & (~65280)) + (SY << 16));
// 3573 act = act+sy<<8 %if y > d7
if (Y <= 8) goto L_02BE;
ACT = ACT + (SY << 8);
L_02BE:;
// 3574 %finish %else eval(y,val&(\anyareg))
goto L_02BF;
L_02BD:;
EVAL(/*?*/ &Y, (-2147418113) & (~65280));
L_02BF:;
// 3575 %finish %else eval(y,val&(\anyareg))
goto L_02C0;
L_02BB:;
EVAL(/*?*/ &Y, (-2147418113) & (~65280));
L_02C0:;
// 3576 %else
goto L_02B8;
L_02BA:;
// 3577 eval(y,val)
EVAL(/*?*/ &Y, -2147418113);
// 3578 %finish
L_02B8:;
// 3579 free = oldfree
FREE = OLDFREE;
// 3580 fin1:
U_101A:;
// 3581 plant(act,y,x)
PLANT(ACT, Y, X);
// 3582 -> fin3 %if act > sub
if (ACT <= 3) goto L_02C1;
goto U_101E;
L_02C1:;
// 3583 fin2:
U_101F:;
// 3584 plant(trapv,0,0) %if control&overbit # 0
if (CONTROL & 268435456 == 0) goto L_02C2;
PLANT(70, 0, 0);
L_02C2:;
// 3585 fin3:
U_101E:;
// 3586 pp = x; c_reg_content(x) = p
*PP = X;
C.REG.CONTENT[X - 1] = P;
// 3587 %if act <= opmax %then c_reg_ccx = p %and c_reg_ccy = 0 %c
if (ACT > 117) goto L_02C3;
C.REG.CCX = P;
C.REG.CCY = 0;
goto L_02C4;
L_02C3:;
FORGETCC();
L_02C4:;
// 3588+ %else forget cc
// 3589 %return
return;
// 3590
// 3591 do(muls): do(mulu):
case_DO_12:;
case_DO_14:;
// 3592 -> dataload %if rset&(\(anyareg!bregb)) = 0
if (RSET & ~(65280 | 16) != 0) goto L_02C5;
goto U_1012;
L_02C5:;
// 3593 rset = rset&(\(anyareg!bregb))
RSET = RSET & ~(65280 | 16);
// 3594 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3595 oldfree = free
OLDFREE = FREE;
// 3596 eval(y,anydreg) %if y > 0; ![could do better for short]
if (Y <= 0) goto L_02C6;
EVAL(/*?*/ &Y, 239);
L_02C6:;
// 3597 free = oldfree
FREE = OLDFREE;
// 3598 plant(act,y,x)
PLANT(ACT, Y, X);
// 3599 -> fin2
goto U_101F;
// 3600
// 3601 do(lsl): do(lsr):
case_DO_10:;
case_DO_11:;
// 3602 -> dataload %if rset&(\(anyareg!bregb)) = 0
if (RSET & ~(65280 | 16) != 0) goto L_02C7;
goto U_1012;
L_02C7:;
// 3603 rset = rset&(\(anyareg!bregb))
RSET = RSET & ~(65280 | 16);
// 3604 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3605 %if y < 0 %and y >= litquick %start
if (Y >= 0) goto L_02C8;
if (Y < -16) goto L_02C8;
// 3606 act = act!!(lsl!!lsr) %and y = y-1 %if y&1 # 0; !negate if neg
if (Y & 1 == 0) goto L_02C9;
ACT = ACT ^ (10 ^ 11);
Y = Y - 1;
L_02C9:;
// 3607 %else
goto L_02CA;
L_02C8:;
// 3608 oldfree = free; eval(y,anydreg); free = oldfree
OLDFREE = FREE;
EVAL(/*?*/ &Y, 239);
FREE = OLDFREE;
// 3609 %finish
L_02CA:;
// 3610 ->fin1
goto U_101A;
// 3611 do(neg):
case_DO_9:;
// 3612 %if y # 0 %start
if (Y == 0) goto L_02CB;
// 3613 r = y; y = x; x = r
R = Y;
Y = X;
X = R;
// 3614 act = sub
ACT = 3;
// 3615 -> do(sub)
DO_line = __LINE__;
DO_file = __FILE__;
DO_index = 3;
goto case_DO_dispatch;
// 3616 %finish
L_02CB:;
// 3617 do(not):
case_DO_8:;
// 3618 -> dataload %if rset&(\(anyareg!bregb)) = 0
if (RSET & ~(65280 | 16) != 0) goto L_02CC;
goto U_1012;
L_02CC:;
// 3619 rset = rset&(\(anyareg!bregb))
RSET = RSET & ~(65280 | 16);
// 3620 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3621 plant(act,0,x)
PLANT(ACT, 0, X);
// 3622 -> fin3
goto U_101E;
// 3623 do(iabs):
case_DO_48:;
// 3624 -> dataload %if rset&(\(anyareg!bregb)) = 0
if (RSET & ~(65280 | 16) != 0) goto L_02CD;
goto U_1012;
L_02CD:;
// 3625 rset = rset&(\(anyareg!bregb))
RSET = RSET & ~(65280 | 16);
// 3626 x = y
X = Y;
// 3627 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3628 plant(move,x,x) %if c_reg_ccx # y %or c_reg_ccy # 0
if (C.REG.CCX != Y) goto L_02CE;
if (C.REG.CCY == 0) goto L_02CF;
L_02CE:;
PLANT(1, X, X);
L_02CF:;
// 3629 plantlit2(bge,0,2)
PLANTLIT2(28, 0, 2);
// 3630 plant(neg,0,x)
PLANT(9, 0, X);
// 3631 ->fin2
goto U_101F;
// 3632 do(fabs):
case_DO_49:;
// 3633 -> dataload %if rset&(\(anyareg!bregb)) = 0
if (RSET & ~(65280 | 16) != 0) goto L_02D0;
goto U_1012;
L_02D0:;
// 3634 rset = rset&(\(anyareg!bregb))
RSET = RSET & ~(65280 | 16);
// 3635 x = y
X = Y;
// 3636 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3637 plantlit(and,16_7FFFFFFF,x)
PLANTLIT(5, 2147483647, X);
// 3638 ->fin3
goto U_101E;
// 3639
// 3640 %routine DO SHIFT
void DOSHIFT(void) {
// 3641 %integer i;
int I;
// 3642 i=0
I = 0;
// 3643 i = i+1 %and j = j>>1 %until j&1 # 0
L_02D1:;
I = I + 1;
J = (unsigned int)J >> 1;
if (J & 1 != 0) goto L_02D2;
goto L_02D1;
L_02D2:;
// 3644 %if i = 1 %then plant(add,x,x) %else %start
if (I != 1) goto L_02D3;
PLANT(2, X, X);
goto L_02D4;
L_02D3:;
// 3645 i = litref(i)
I = LITREF(I);
// 3646 %if i < litquick %start
if (I >= -16) goto L_02D5;
// 3647 oldfree = free; eval(i,anydreg); free = oldfree
OLDFREE = FREE;
EVAL(/*?*/ &I, 239);
FREE = OLDFREE;
// 3648 %finish
L_02D5:;
// 3649 plant(asl,i,x)
PLANT(32, I, X);
// 3650 %finish
L_02D4:;
// 3651 %end
return;
} /* end of DOSHIFT */
// 3652
// 3653 do(imul):
case_DO_86:;
// 3654 -> dataload %if rset&(\(anyareg!bregb)) = 0
if (RSET & ~(65280 | 16) != 0) goto L_02D6;
goto U_1012;
L_02D6:;
// 3655 rset = rset&(\(anyareg!bregb))
RSET = RSET & ~(65280 | 16);
// 3656 !Test for power of 2 or pair of powers of 2
// 3657 %if y < 0 %start
if (Y >= 0) goto L_02D7;
// 3658 j = litval(y)
J = LITVAL(Y);
// 3659 i = j&(j-1)
I = J & J - 1;
// 3660 %if i = 0 %or i&(i-1) = 0 %start
if (I == 0) goto L_02D8;
if (I & I - 1 != 0) goto L_02D9;
L_02D8:;
// 3661 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3662 do shift %if j&1 = 0
if (J & 1 != 0) goto L_02DA;
DOSHIFT();
L_02DA:;
// 3663 %if j # 1 %start
if (J == 1) goto L_02DB;
// 3664 plant(move,x,prea7)
PLANT(1, X, 40);
// 3665 do shift
DOSHIFT();
// 3666 plant(add,posta7,x)
PLANT(2, 32, X);
// 3667 %finish
L_02DB:;
// 3668 ->fin2
goto U_101F;
// 3669 %finish
L_02D9:;
// 3670 %finish
L_02D7:;
// 3671 do(fsub): do(fdiv):
case_DO_91:;
case_DO_93:;
// 3672 do(ipow): do(fpow):
case_DO_88:;
case_DO_94:;
// 3673 do(fadd): do(fmul):
case_DO_90:;
case_DO_92:;
// 3674 evalxy
EVALXY();
// 3675 srcall(act)
SRCALL(ACT);
// 3676 plant(trapv,0,0) %if act = imul %and control&overbit # 0
if (ACT != 86) goto L_02DC;
if (CONTROL & 268435456 == 0) goto L_02DC;
PLANT(70, 0, 0);
L_02DC:;
// 3677 forget(d1); r = d0
FORGET(2);
R = 1;
// 3678 forget cc
FORGETCC();
// 3679 -> endloadr
goto U_1019;
// 3680
// 3681 do(idiv): do(drem):
case_DO_87:;
case_DO_98:;
// 3682 %if control&halfbit # 0 %start
if (CONTROL & 32768 == 0) goto L_02DD;
// 3683 act = divs %if act = idiv
if (ACT != 87) goto L_02DE;
ACT = 13;
L_02DE:;
// 3684 do(divs): do(divu):
case_DO_13:;
case_DO_15:;
// 3685 -> dataload %if rset&(\(anyareg!bregb)) = 0
if (RSET & ~(65280 | 16) != 0) goto L_02DF;
goto U_1012;
L_02DF:;
// 3686 rset = rset&(\(anyareg!bregb))
RSET = RSET & ~(65280 | 16);
// 3687 eval(x,rset&free)
EVAL(/*?*/ &X, RSET & FREE);
// 3688 oldfree = free
OLDFREE = FREE;
// 3689 eval(y,anydreg)
EVAL(/*?*/ &Y, 239);
// 3690 free = oldfree
FREE = OLDFREE;
// 3691 %if act = drem %then plant(divs,y,x) %and plant(swap,0,x) %c
if (ACT != 98) goto L_02E0;
PLANT(13, Y, X);
PLANT(74, 0, X);
goto L_02E1;
L_02E0:;
PLANT(ACT, Y, X);
L_02E1:;
// 3692+ %else plant(act,y,x)
// 3693 plant(extl,0,x)
PLANT(76, 0, X);
// 3694 -> fin3
goto U_101E;
// 3695 %finish
L_02DD:;
// 3696 evalxy
EVALXY();
// 3697 srcall(idiv)
SRCALL(87);
// 3698 putexp(act!!(idiv!!drem),xx,yy,inttype)
PUTEXP(ACT ^ (87 ^ 98), XX, YY, 43);
// 3699 %if act = idiv %start
if (ACT != 87) goto L_02E2;
// 3700 c_reg_content(d1) = item; r = d0
C.REG.CONTENT[1] = ITEM;
R = 1;
// 3701 %else
goto L_02E3;
L_02E2:;
// 3702 c_reg_content(d0) = item; r = d1
C.REG.CONTENT[0] = ITEM;
R = 2;
// 3703 %finish
L_02E3:;
// 3704 forget cc
FORGETCC();
// 3705 ->endloadr
goto U_1019;
// 3706
// 3707 do(float):
case_DO_95:;
// 3708 do(fneg):
case_DO_89:;
// 3709 commandeer(d0b)
COMMANDEER(1);
// 3710 eval(x,d0b)
EVAL(/*?*/ &X, 1);
// 3711 srcall(act)
SRCALL(ACT);
// 3712 forget cc
FORGETCC();
// 3713 r = d0
R = 1;
// 3714 ->endloadr
goto U_1019;
// 3715
// 3716 do(concat): !not special case
case_DO_106:;
// 3717 ![they have to be free] commandeer(d0b+bregb+a0b+a1b+a2b)
// 3718 fault(plexerr) %if free&(a0b+a1b+a2b+d0b+bregb) # a0b+a1b+a2b+d0b+bregb
if (FREE & 256 + 512 + 1024 + 1 + 16 == 256 + 512 + 1024 + 1 + 16) goto L_02E4;
FAULT(2);
L_02E4:;
// 3719 stackop(-256)
STACKOP(-256);
// 3720 endconc:
U_1020:;
// 3721 %if rset&tostack = 0 %start
if (RSET & 524288 != 0) goto L_02E5;
// 3722 %if c_sp # sp %start
if (C.SP == SP) goto L_02E6;
// 3723 addimm(sp-c_sp,a7); c_sp = sp
ADDIMM(SP - C.SP, 16);
C.SP = SP;
// 3724 %finish
L_02E6:;
// 3725 %finish %else rset = a0b
goto L_02E7;
L_02E5:;
RSET = 256;
L_02E7:;
// 3726 r = a0
R = 9;
// 3727 ->endloadr
goto U_1019;
// 3728
// 3729 !!!!!!!!!!!!!!!!!!!!! Conditions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 3730
// 3731 %routine CONDSWOP
void CONDSWOP(void) {
// 3732 !Swop condition operands, adjusting operator accordingly
// 3733 %integer temp
int TEMP;
// 3734 temp = x; x = y; y = temp
TEMP = X;
X = Y;
Y = TEMP;
// 3735 temp = xx; xx = yy; yy = temp
TEMP = XX;
XX = YY;
YY = TEMP;
// 3736 temp = sx; sx = sy; sy = temp
TEMP = SX;
SX = SY;
SY = TEMP;
// 3737 temp = wx; wx = wy; wy = temp
TEMP = WX;
WX = WY;
WY = TEMP;
// 3738 case = case!!3 %if case&8 # 0; !no change for '=','#'
if (CASE & 8 == 0) goto L_02E8;
CASE = CASE ^ 3;
L_02E8:;
// 3739 %end
return;
} /* end of CONDSWOP */
// 3740
// 3741 %routine UNSIGNED
void UNSIGNED(void) {
// 3742 %if case&8 # 0 %start; !no change for '=','#'
if (CASE & 8 == 0) goto L_02E9;
// 3743 case = case!!8
CASE = CASE ^ 8;
// 3744 case = case!!4 %if case&2 # 0
if (CASE & 2 == 0) goto L_02EA;
CASE = CASE ^ 4;
L_02EA:;
// 3745 %finish
L_02E9:;
// 3746 %end
return;
} /* end of UNSIGNED */
// 3747
// 3748 ![Some confusion here of which operand (weightier) to evaluate first
// 3749 ![ and which to bring to register
// 3750 ![EVAL improvements make possible greater finesse:
// 3751 ![ 1. Decide which to evaluate first (weightier)
// 3752 ![ 2. EVAL both 'val'
// 3753 ![ 3. If either in register, OK
// 3754 ![ 4. Load one
// 3755 ![*for IMP, conditions cannot be embedded in other expressions;
// 3756 ![*for Pascal, they can. This needs improvement to cover that.
// 3757 do(compare):
case_DO_4:;
// 3758 flush %if pendcond # 0
if (PENDCOND == 0) goto L_02EB;
FLUSH();
L_02EB:;
// 3759 update sp
UPDATESP();
// 3760 sp = c_sp
SP = C.SP;
// 3761 pp = pp+1; dp == dict(pp)
*PP = *PP + 1;
DP = (struct IDENTINFO *)/*?*/ &DICT[*PP];
// 3762 case = dp_act
CASE = DP->ACT;
// 3763 %if x <= 0 %start; ![1st literal: only for true,false]
if (X > 0) goto L_02EC;
// 3764 case = case!!1 %if x = 0; !invert for false
if (X != 0) goto L_02ED;
CASE = CASE ^ 1;
L_02ED:;
// 3765 pendcond = case&1+bra
PENDCOND = (CASE & 1) + 16;
// 3766 -> endcomp
goto U_1021;
// 3767 %finish
L_02EC:;
// 3768 %if x >= explim %start; !address
if (X < EXPLIM) goto L_02EE;
// 3769 dx == dict(x-ad); sx = 4
DX = (struct IDENTINFO *)/*?*/ &DICT[X - 16384];
SX = 4;
// 3770 %else
goto L_02EF;
L_02EE:;
// 3771 dx == dict(x)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
// 3772 tx == dict(dx_type); sx = size(dx_type)
TX = (struct IDENTINFO *)/*?*/ &DICT[DX->TYPE];
SX = SIZE(DX->TYPE);
// 3773 %finish
L_02EF:;
// 3774 dx_flags = dx_flags!rflag
DX->FLAGS = DX->FLAGS | 32;
// 3775 %if y >= explim %or y <= 0 %then sy = 4 %else sy = tsize(y)
if (Y >= EXPLIM) goto L_02F0;
if (Y > 0) goto L_02F1;
L_02F0:;
SY = 4;
goto L_02F2;
L_02F1:;
SY = TSIZE(Y);
L_02F2:;
// 3776 wx = 0 %and wy = 0 %and condswop %if c_reg_ccx = y %and c_reg_ccy = x
if (C.REG.CCX != Y) goto L_02F3;
if (C.REG.CCY != X) goto L_02F3;
WX = 0;
WY = 0;
CONDSWOP();
L_02F3:;
// 3777 %if c_reg_ccx # x %or c_reg_ccy # y %start; ![???unsigned???]
if (C.REG.CCX != X) goto L_02F4;
if (C.REG.CCY == Y) goto L_02F5;
L_02F4:;
// 3778 %if y # 0 %start; !not comparison with zero
if (Y == 0) goto L_02F6;
// 3779 wx = weight(x); wy = weight(y)
WX = WEIGHT(X);
WY = WEIGHT(Y);
// 3780 condswop %if wx < 999 %and wy > wx+1
if (WX >= 999) goto L_02F7;
if (WY <= WX + 1) goto L_02F7;
CONDSWOP();
L_02F7:;
// 3781 %if x >= explim %or y >= explim %start; !one or other is address
if (X >= EXPLIM) goto L_02F8;
if (Y < EXPLIM) goto L_02F9;
L_02F8:;
// 3782 !swop if Y is not name (to use LEA)
// 3783 condswop %if 0 <= y-ad < dictlim %and dict(y-ad)_flags >= 0
{
// Double-sided test on Y - 16384 (Part I)
int tmp;
if (0 > (tmp = Y - 16384)) goto L_02FA;
// Double-sided test on Y - 16384 (Part II)
if (tmp >= DICTLIM) goto L_02FA;
}
if (DICT[Y - 16384].FLAGS < 0) goto L_02FA;
CONDSWOP();
L_02FA:;
// 3784 eval(x,anyareg)
EVAL(/*?*/ &X, 65280);
// 3785 eval(y,sign+anyareg)
EVAL(/*?*/ &Y, (-2147483648) + 65280);
// 3786 plant(cmp,y,x)
PLANT(4, Y, X);
// 3787 c_reg_ccx = xx; c_reg_ccy = yy
C.REG.CCX = XX;
C.REG.CCY = YY;
// 3788 %finish %else %if sx > 0 %start; !simple operand
goto L_02FB;
L_02F9:;
if (SX <= 0) goto L_02FC;
// 3789 %if tx_flags&cat = realy %start
if (TX->FLAGS & 15 != 5) goto L_02FD;
// 3790 eval(x,d0b); eval(y,d1b)
EVAL(/*?*/ &X, 1);
EVAL(/*?*/ &Y, 2);
// 3791 srcall(fsub)
SRCALL(91);
// 3792 forget(x)
FORGET(X);
// 3793 c_reg_ccx = xx; c_reg_ccy = yy
C.REG.CCX = XX;
C.REG.CCY = YY;
// 3794 %finish %else %if y < 0 %start; !comparison with literal
goto L_02FE;
L_02FD:;
if (Y >= 0) goto L_02FF;
// 3795 %if y >= litmite %start
if (Y < -255) goto L_0300;
// 3796 eval(x,val+sx<<sizeshift)
EVAL(/*?*/ &X, (-2147418113) + (SX << 16));
// 3797 %if (sx = 4 %and free&anydreg # 0) %c
if (SX != 4) goto L_0301;
if (FREE & 239 != 0) goto L_0302;
L_0301:;
if (X <= 16) goto L_0303;
if (DICT[X].MODE & 63 != 58) goto L_0303;
L_0302:;
// 3798+ %or (x > a7 %and dict(x)_mode&63 = pcmode) %start
// 3799 eval(y,anydreg)
EVAL(/*?*/ &Y, 239);
// 3800 condswop %and sx = sy %unless x <= d7
if (X <= 8) goto L_0304;
CONDSWOP();
SX = SY;
L_0304:;
// 3801 %finish
L_0303:;
// 3802 %else
goto L_0305;
L_0300:;
// 3803 sx = 0 %if sx = 1; ![to ensure comparison fails?]
if (SX != 1) goto L_0306;
SX = 0;
L_0306:;
// 3804 eval(x,val+sx<<sizeshift)
EVAL(/*?*/ &X, (-2147418113) + (SX << 16));
// 3805 sx = 2 %if a0 <= x <= a7 %and is short(litval(y))=TRUE
{
// Double-sided test on X (Part I)
int tmp;
if (9 > (tmp = X)) goto L_0307;
// Double-sided test on X (Part II)
if (tmp > 16) goto L_0307;
}
if (ISSHORT(LITVAL(Y)) != 1) goto L_0307;
SX = 2;
L_0307:;
// 3806 %finish
L_0305:;
// 3807 plant(cmp+sx<<8,y,x)
PLANT(4 + (SX << 8), Y, X);
// 3808 unsigned %if sx = 1
if (SX != 1) goto L_0308;
UNSIGNED();
L_0308:;
// 3809 c_reg_ccx = xx; c_reg_ccy = yy
C.REG.CCX = XX;
C.REG.CCY = YY;
// 3810 %else; !Y not literal
goto L_02FE;
L_02FF:;
// 3811 condswop %if sy < sx
if (SY >= SX) goto L_0309;
CONDSWOP();
L_0309:;
// 3812 eval(x,anyreg)
EVAL(/*?*/ &X, 65535);
// 3813 %if sy <= 2 %and sy = sx %and (sy=1 %or x < a0) %start
if (SY > 2) goto L_030A;
if (SY != SX) goto L_030A;
if (SY == 1) goto L_030B;
if (X >= 9) goto L_030A;
L_030B:;
// 3814 eval(y,val+sy<<sizeshift)
EVAL(/*?*/ &Y, (-2147418113) + (SY << 16));
// 3815 plant(cmp+sy<<8,y,x)
PLANT(4 + (SY << 8), Y, X);
// 3816 unsigned %if sy = 1
if (SY != 1) goto L_030C;
UNSIGNED();
L_030C:;
// 3817 forget cc
FORGETCC();
// 3818 %else
goto L_030D;
L_030A:;
// 3819 eval(y,val)
EVAL(/*?*/ &Y, -2147418113);
// 3820 plant(cmp,y,x)
PLANT(4, Y, X);
// 3821 c_reg_ccx = xx; c_reg_ccy = yy
C.REG.CCX = XX;
C.REG.CCY = YY;
// 3822 %finish
L_030D:;
// 3823 %finish
L_02FE:;
// 3824 %else; !structure
goto L_02FB;
L_02FC:;
// 3825 stsiz = sx; stsiz = -stsiz %if tx_flags&cat # stringy
STSIZ = SX;
if (TX->FLAGS & 15 == 8) goto L_030E;
STSIZ = -STSIZ;
L_030E:;
// 3826 %if (case&8 = 0 %and control&strassbit = 0) %C
if (CASE & 8 != 0) goto L_030F;
if (CONTROL & 67108864 == 0) goto L_0310;
L_030F:;
{
// Double-sided test on TX->FLAGS & 15 (Part I)
int tmp;
if (8 == (tmp = TX->FLAGS & 15)) goto L_0311;
// Double-sided test on TX->FLAGS & 15 (Part II)
if (tmp == 10) goto L_0311;
}
L_0310:;
// 3827+ %or stringy # tx_flags&cat # sety %start
// 3828 !equals,notequals or rec,array
// 3829 ! [No routine call required to implement]
// 3830 %if wy >= 999 %start; !both complex
if (WY < 999) goto L_0312;
// 3831 eval(x,tostack); free = free!a0b
EVAL(/*?*/ &X, 524288);
FREE = FREE | 256;
// 3832 eval(y,anyareg&free+asad)
EVAL(/*?*/ &Y, (65280 & FREE) + 1048576);
// 3833 x = freeareg(undef)
X = FREEAREG(16);
// 3834 plant(move,a7,x)
PLANT(1, 16, X);
// 3835 %else
goto L_0313;
L_0312:;
// 3836 eval(x,anyareg&free+asad)
EVAL(/*?*/ &X, (65280 & FREE) + 1048576);
// 3837 forget(x)
FORGET(X);
// 3838 eval(y,anyareg&free+asad)
EVAL(/*?*/ &Y, (65280 & FREE) + 1048576);
// 3839 %finish
L_0313:;
// 3840 i = free dreg
I = FREEDREG();
// 3841 %if tx_flags&cat = stringy %start; !string comparison
if (TX->FLAGS & 15 != 8) goto L_0314;
// 3842 plant(clr,0,i)
PLANT(52, 0, I);
// 3843 plant(moveb,x+indir,i)
PLANT(257, X + 8, I);
// 3844 %else
goto L_0315;
L_0314:;
// 3845 plantlit(move,-sx-1,i)
PLANTLIT(1, -SX - 1, I);
// 3846 %finish
L_0315:;
// 3847 plant(cmpmb,x+post,y+post)
PLANT(299, X + 16, Y + 16);
// 3848 plantlit2(dbne,i,-4)
PLANTLIT2(86, I, -4);
// 3849 forget(i); forget(y)
FORGET(I);
FORGET(Y);
// 3850 %else
goto L_0316;
L_0311:;
// 3851 ! [Routine call required: must bring complex to stack]
// 3852 %if wx >= 999 %start
if (WX < 999) goto L_0317;
// 3853 eval(x,tostack); free = free!a0b
EVAL(/*?*/ &X, 524288);
FREE = FREE | 256;
// 3854 %if wy >= 999 %start
if (WY < 999) goto L_0318;
// 3855 stsiz = sy; stsiz = -stsiz %if tx_flags&cat # stringy
STSIZ = SY;
if (TX->FLAGS & 15 == 8) goto L_0319;
STSIZ = -STSIZ;
L_0319:;
// 3856 eval(y,tostack)
EVAL(/*?*/ &Y, 524288);
// 3857 y = a1; plant(move,a7,y)
Y = 10;
PLANT(1, 16, Y);
// 3858 sy = (imod(sy)+1)&(\1); sy = 256 %if sy = 0
SY = _imp_IMOD(SY) + 1 & (~1);
if (SY != 0) goto L_031A;
SY = 256;
L_031A:;
// 3859 x = a0; plant(lea,tempd(a7,sy),x)
X = 9;
PLANT(78, TEMPD(16, SY), X);
// 3860 %else
goto L_031B;
L_0318:;
// 3861 eval(y,a1b+asad)
EVAL(/*?*/ &Y, 512 + 1048576);
// 3862 x = a0; plant(move,a7,x)
X = 9;
PLANT(1, 16, X);
// 3863 %finish
L_031B:;
// 3864 %else
goto L_031C;
L_0317:;
// 3865 eval(x,a0b+asad); eval(y,a1b+asad)
EVAL(/*?*/ &X, 256 + 1048576);
EVAL(/*?*/ &Y, 512 + 1048576);
// 3866 %finish
L_031C:;
// 3867 !<<IMP
// 3868 srcall(scomp)
SRCALL(112);
// 3869 unsigned
UNSIGNED();
// 3870 !<<BOTH
// 3871 %finish
L_0316:;
// 3872 forget cc
FORGETCC();
// 3873 %finish
L_02FB:;
// 3874 %else; !comparison with zero
goto L_031D;
L_02F6:;
// 3875 %if sx <= 0 %or (sx = 1 %and dx_mode >= dispmode) %start
if (SX <= 0) goto L_031E;
if (SX != 1) goto L_031F;
if (DX->MODE < 40) goto L_031F;
L_031E:;
// 3876 %if tx_flags&cat = stringy %or sx = 1 %start
if (TX->FLAGS & 15 == 8) goto L_0320;
if (SX != 1) goto L_0321;
L_0320:;
// 3877 eval(x,ref)
EVAL(/*?*/ &X, -2147483648);
// 3878 plant(tst+1<<8,0,x)
PLANT(59 + (1 << 8), 0, X);
// 3879 forget cc; !*for now*
FORGETCC();
// 3880 unsigned
UNSIGNED();
// 3881 %else
goto L_0322;
L_0321:;
// 3882 eval(x,anyareg&free+asad)
EVAL(/*?*/ &X, (65280 & FREE) + 1048576);
// 3883 i = free dreg
I = FREEDREG();
// 3884 plantlit(move,-sx-1,i)
PLANTLIT(1, -SX - 1, I);
// 3885 plant(tst+1<<8,0,x+post)
PLANT(59 + (1 << 8), 0, X + 16);
// 3886 plantlit2(dbne,i,-4)
PLANTLIT2(86, I, -4);
// 3887 forget(i); forget(x)
FORGET(I);
FORGET(X);
// 3888 %finish
L_0322:;
// 3889 %else
goto L_0323;
L_031F:;
// 3890 eval(x,anydreg)
EVAL(/*?*/ &X, 239);
// 3891 %if c_reg_ccx # xx %or c_reg_ccy # 0 %start
if (C.REG.CCX != XX) goto L_0324;
if (C.REG.CCY == 0) goto L_0325;
L_0324:;
// 3892 plant(move,x,x); c_reg_ccx = xx; c_reg_ccy = 0
PLANT(1, X, X);
C.REG.CCX = XX;
C.REG.CCY = 0;
// 3893 %finish
L_0325:;
// 3894 %finish
L_0323:;
// 3895 %finish
L_031D:;
// 3896 %finish
L_02F5:;
// 3897 pendcond = case
PENDCOND = CASE;
// 3898 endcomp:
U_1021:;
// 3899 pendin = dp_x; pendout = dp_y
PENDIN = DP->X;
PENDOUT = DP->Y;
// 3900 checksp:
U_1022:;
// 3901 %if c_sp # sp %start
if (C.SP == SP) goto L_0326;
// 3902 addimm(sp-c_sp,a7); c_sp = sp
ADDIMM(SP - C.SP, 16);
C.SP = SP;
// 3903 %finish
L_0326:;
// 3904 !<<IMP
// 3905 %return
return;
// 3906
// 3907 do(resolves):
case_DO_117:;
// 3908 flush %if pendcond # 0
if (PENDCOND == 0) goto L_0327;
FLUSH();
L_0327:;
// 3909 update sp
UPDATESP();
// 3910 sp = c_sp
SP = C.SP;
// 3911 ! push(mb)
// 3912 ! eval(x,a0b+asad); !string to be resolved
// 3913 ! act = dict(y)_act; x = dict(y)_x; y = dict(y)_y
// 3914 ! eval(x,a1b); eval(act,a0b<<2); eval(y,a0b<<3); !match, fore, aft
// 3915 ! srcall(resolves)
// 3916 ! pop(mb)
// 3917 ! forget regs
// 3918 dx == dict(act)
DX = (struct IDENTINFO *)/*?*/ &DICT[ACT];
// 3919 call
CALL();
// 3920 pp = pp+2; dp == dict(pp)
*PP = *PP + 2;
DP = (struct IDENTINFO *)/*?*/ &DICT[*PP];
// 3921 pendcond = dp_act
PENDCOND = DP->ACT;
// 3922 -> endcomp
goto U_1021;
// 3923
// 3924 !<<BOTH
// 3925 !!!!!!!!!!!!!!!!!!!!!!!! Assignment !!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 3926 !
// 3927 %integerfn EASY(%integer y)
int EASY(int Y) {
// 3928 ! Determine if structure assignment (string, set)
// 3929 ! can be done by store-to-store op(s) and if so, do it.
// 3930 %integer r1,f
int R1;
int F;
// 3931 %record(identinfo)%name dy
struct IDENTINFO *DY;
// 3932 %owninteger s=0
static int S = 0;
// 3933 %result = FALSE %if y < np0
if (Y >= NP0) goto L_0328;
return 0;
L_0328:;
// 3934 dy == dict(y)
DY = (struct IDENTINFO *)/*?*/ &DICT[Y];
// 3935 %result = FALSE %if dy_act > concat %or dy_act = prel
if (DY->ACT > 106) goto L_0329;
if (DY->ACT != 46) goto L_032A;
L_0329:;
return 0;
L_032A:;
// 3936 f = free
F = FREE;
// 3937 %if dy_x = x %start; !recursion ends, successfully
if (DY->X != X) goto L_032B;
// 3938 s = tsize(x); s = -s %if dy_act # concat; !+ve unless string
S = TSIZE(X);
if (DY->ACT == 106) goto L_032C;
S = -S;
L_032C:;
// 3939 eval(x,a1b+asad)
EVAL(/*?*/ &X, 512 + 1048576);
// 3940 %else
goto L_032D;
L_032B:;
// 3941 %result = FALSE %if dy_y >= np0 %or dy_y = x %c
if (DY->Y >= NP0) goto L_032E;
if (DY->Y == X) goto L_032E;
if (EASY(DY->X) == 1) goto L_032F;
L_032E:;
return 0;
L_032F:;
// 3942+ %or %not easy(dy_x)=TRUE
// 3943 %finish
L_032D:;
// 3944 y = dy_y
Y = DY->Y;
// 3945 %if y >= np0 %and dict(y)_act = dtostring %start
if (Y < NP0) goto L_0330;
if (DICT[Y].ACT != 107) goto L_0330;
// 3946 y = dict(y)_x; eval(y,tobyte+val); !character value
Y = DICT[Y].X;
EVAL(/*?*/ &Y, 65536 + (-2147418113));
// 3947 r1 = clean reg
R1 = CLEANREG();
// 3948 plant(addb,one,x+indir); !inc length(dest)
PLANT(258, -2, X + 8);
// 3949 plant(moveb,x+indir,r1)
PLANT(257, X + 8, R1);
// 3950 plant(moveb,y,tempx(x,r1)); !append char
PLANT(257, Y, TEMPX(X, R1));
// 3951 forget(r1)
FORGET(R1);
// 3952 %else
goto L_0331;
L_0330:;
// 3953 eval(y,a0b+asad)
EVAL(/*?*/ &Y, 256 + 1048576);
// 3954 structcall(dy_act,s)
STRUCTCALL(DY->ACT, S);
// 3955 forget(a0); forget(a1)
FORGET(9);
FORGET(10);
// 3956 forget(d1); forget(d2)
FORGET(2);
FORGET(3);
// 3957 %finish
L_0331:;
// 3958 free = f&(\a1b)
FREE = F & (~512);
// 3959 %result = TRUE
return 1;
// 3960 %end
} /* end of EASY */
// 3961
// 3962 %routine BEWARE(%integer dest)
void BEWARE(int DEST) {
// 3963 ![not foolproof: ?too expensive to do properly
// 3964 ! too inefficient to fail safe]
// 3965 %integer r,d
int R;
int D;
// 3966 %integerfn UNSAFE(%integer p)
int UNSAFE(int P) {
// 3967 ![a bit cavalier]
// 3968 %cycle
L_0332:;
// 3969 %result = FALSE %if p <= undef; !literal, basereg or undef
if (P > 16) goto L_0333;
return 0;
L_0333:;
// 3970 %result = TRUE %if p = dest %or p = d {%or d >= np0
if (P == DEST) goto L_0334;
if (P != D) goto L_0335;
L_0334:;
return 1;
L_0335:;
// 3971 p = p-ad %if p >= explim
if (P < EXPLIM) goto L_0336;
P = P - 16384;
L_0336:;
// 3972 %result = FALSE %if p < np0
if (P >= NP0) goto L_0337;
return 0;
L_0337:;
// 3973 %result = TRUE %if dict(p)_act > opmax; !funcall,mapcall
if (DICT[P].ACT <= 117) goto L_0338;
return 1;
L_0338:;
// 3974 %result = TRUE %unless dest # dict(p)_y < np0
{
// Double-sided test on DICT[P].Y (Part I)
int tmp;
if (DEST == (tmp = DICT[P].Y)) goto L_0339;
// Double-sided test on DICT[P].Y (Part II)
if (tmp < NP0) goto L_033A;
}
L_0339:;
return 1;
L_033A:;
// 3975 p = dict(p)_x
P = DICT[P].X;
// 3976 %repeat
goto L_0332;
// 3977 %end
} /* end of UNSAFE */
// 3978 forget(dest) %and %return %if dest <= a7
if (DEST > 16) goto L_033B;
FORGET(DEST);
return;
L_033B:;
// 3979 d = dest; d = d-ad %if d >= explim
D = DEST;
if (D < EXPLIM) goto L_033C;
D = D - 16384;
L_033C:;
// 3980 %for r = d0,1,maxareg %cycle
// %for R = 1, 1, 12 %cycle
{
R = 0;
L_033D:
if (R == 12) goto L_033E;
R += 1;
// 3981 forget(r) %if unsafe(c_reg_content(r))=TRUE
if (UNSAFE(C.REG.CONTENT[R - 1]) != 1) goto L_0340;
FORGET(R);
L_0340:;
// 3982 %repeat
goto L_033D;
}
L_033E:;
// 3983 forget cc %if unsafe(c_reg_ccx)=TRUE %or unsafe(c_reg_ccy)=TRUE
if (UNSAFE(C.REG.CCX) == 1) goto L_033F;
if (UNSAFE(C.REG.CCY) != 1) goto L_0341;
L_033F:;
FORGETCC();
L_0341:;
// 3984 %end
return;
} /* end of BEWARE */
// 3985
// 3986 %integerfn XFREE(%integer v,strong)
int XFREE(int V, int STRONG) {
// 3987 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 3988 %cycle
L_0342:;
// 3989 v = v-ad %if v >= explim
if (V < EXPLIM) goto L_0343;
V = V - 16384;
L_0343:;
// 3990 %exit %if v < dictlim
if (V >= DICTLIM) goto L_0344;
goto L_0345;
L_0344:;
// 3991 dp == dict(v)
DP = (struct IDENTINFO *)/*?*/ &DICT[V];
// 3992 %result = FALSE %unless xfree(dp_y,1)=TRUE
if (XFREE(DP->Y, 1) == 1) goto L_0346;
return 0;
L_0346:;
// 3993 strong = 1 %if dp_y >= dictlim
if (DP->Y < DICTLIM) goto L_0347;
STRONG = 1;
L_0347:;
// 3994 v = dp_x
V = DP->X;
// 3995 %repeat
goto L_0342;
L_0345:;
// 3996 %result = TRUE %if v # x %or strong = 0
if (V != X) goto L_0348;
if (STRONG != 0) goto L_0349;
L_0348:;
return 1;
L_0349:;
// 3997 %result = FALSE
return 0;
// 3998 %end
} /* end of XFREE */
// 3999
// 4000 !<<IMP
// 4001 do(forass): !FORASS:loopvar:start'
case_DO_36:;
// 4002 ! -- :inc :end
// 4003 eval(y,d0b)
EVAL(/*?*/ &Y, 1);
// 4004 pp = pp+1; dp == dict(pp)
*PP = *PP + 1;
DP = (struct IDENTINFO *)/*?*/ &DICT[*PP];
// 4005 i = dp_x; eval(i,d1b); i = dp_y; eval(i,d2b)
I = DP->X;
EVAL(/*?*/ &I, 2);
I = DP->Y;
EVAL(/*?*/ &I, 4);
// 4006 srcall(forok)
SRCALL(110);
// 4007 !<<BOTH
// 4008 do(jamass):
case_DO_32:;
// 4009 do(assign):
case_DO_34:;
// 4010 do(okass):
case_DO_33:;
// 4011 flush %if pendcond # 0
if (PENDCOND == 0) goto L_034A;
FLUSH();
L_034A:;
// 4012 %if xx >= explim %start; !ad of ...
if (XX < EXPLIM) goto L_034B;
// 4013 wx = weight(xx-ad)
WX = WEIGHT(XX - 16384);
// 4014 dx == dict(xx-ad)
DX = (struct IDENTINFO *)/*?*/ &DICT[XX - 16384];
// 4015 sx = 4
SX = 4;
// 4016 %else
goto L_034C;
L_034B:;
// 4017 wx = weight(xx)
WX = WEIGHT(XX);
// 4018 dx == dict(xx)
DX = (struct IDENTINFO *)/*?*/ &DICT[XX];
// 4019 sx = size(dx_type)
SX = SIZE(DX->TYPE);
// 4020 %finish
L_034C:;
// 4021 tx == dict(dx_type)
TX = (struct IDENTINFO *)/*?*/ &DICT[DX->TYPE];
// 4022 sp = c_sp-c_val
SP = C.SP - C.VAL;
// 4023 %if sx <= 0 %start; !structure assignment
if (SX > 0) goto L_034D;
// 4024 !Structure
// 4025 ![for rec/string assignment beware corruption of stacked
// 4026 ! structure in computing DEST]
// 4027 update sp
UPDATESP();
// 4028 %if tx_flags&cat = stringy %start
if (TX->FLAGS & 15 != 8) goto L_034E;
// 4029 sx = -256 %if sx = 0; !string(*)
if (SX != 0) goto L_034F;
SX = -256;
L_034F:;
// 4030 op = -1; op = dict(y)_act %if y >= np0
OP = -1;
if (Y < NP0) goto L_0350;
OP = DICT[Y].ACT;
L_0350:;
// 4031 %if y = 0 %start; !""
if (Y != 0) goto L_0351;
// 4032 eval(x,ref)
EVAL(/*?*/ &X, -2147483648);
// 4033 plant(clr+1<<8,0,x)
PLANT(52 + (1 << 8), 0, X);
// 4034 %finish %else %if op = dtostring %start
goto L_0352;
L_0351:;
if (OP != 107) goto L_0353;
// 4035 y = dict(y)_x
Y = DICT[Y].X;
// 4036 eval(y,tobyte+val); !character value
EVAL(/*?*/ &Y, 65536 + (-2147418113));
// 4037 eval(x,anyareg&free+asad)
EVAL(/*?*/ &X, (65280 & FREE) + 1048576);
// 4038 plant(moveb,one,x+post)
PLANT(257, -2, X + 16);
// 4039 plant(moveb,y,x+indir)
PLANT(257, Y, X + 8);
// 4040 forget(x)
FORGET(X);
// 4041 forget cc
FORGETCC();
// 4042 %finish %else %if act = jamass %or %not easy(y)=TRUE %start
goto L_0352;
L_0353:;
if (ACT == 32) goto L_0354;
if (EASY(Y) == 1) goto L_0355;
L_0354:;
// 4043 %if op >= concat %and wx > 1 %start
if (OP < 106) goto L_0356;
if (WX <= 1) goto L_0356;
// 4044 ! Danger of corruption of RHS
// 4045 stsiz = sx
STSIZ = SX;
// 4046 eval(y,tostack); free = free!a0b
EVAL(/*?*/ &Y, 524288);
FREE = FREE | 256;
// 4047 eval(x,a1b+asad)
EVAL(/*?*/ &X, 512 + 1048576);
// 4048 plant(move,a7,a0); y = a0
PLANT(1, 16, 9);
Y = 9;
// 4049 structcall(strcopy,sx)
STRUCTCALL(113, SX);
// 4050 %finish %else %if act # assign %or sx = -256 %or control&capbit = 0 %start
goto L_0357;
L_0356:;
if (ACT != 34) goto L_0358;
if (SX == -256) goto L_0358;
if (CONTROL & 536870912 != 0) goto L_0359;
L_0358:;
// 4051 ! No check needed
// 4052 %if wx > 1 %then eval(x,anyareg&free+asad) %and eval(y,anyareg&free+asad) %c
if (WX <= 1) goto L_035A;
EVAL(/*?*/ &X, (65280 & FREE) + 1048576);
EVAL(/*?*/ &Y, (65280 & FREE) + 1048576);
goto L_035B;
L_035A:;
EVAL(/*?*/ &Y, (65280 & FREE) + 1048576);
EVAL(/*?*/ &X, (65280 & FREE) + 1048576);
L_035B:;
// 4053+ %else eval(y,anyareg&free+asad) %and eval(x,anyareg&free+asad)
// 4054 !not worth %if act # jamass %and sx >= -4 %start
// 4055 ! %cycle
// 4056 ! plant(moveb,y+post,x+post)
// 4057 ! sx = sx+1
// 4058 ! %repeat %until sx >= 0
// 4059 ! %else
// 4060 i = free reg(anydreg!bregb)
I = FREEREG(239 | 16);
// 4061 %if act = jamass %start
if (ACT != 32) goto L_035C;
// 4062 plantlit(move,mite(-sx-1),i)
PLANTLIT(1, MITE(-SX - 1), I);
// 4063 plant(moveb,i,x+post)
PLANT(257, I, X + 16);
// 4064 plant(cmpb,y+post,i)
PLANT(260, Y + 16, I);
// 4065 plantlit2(bcs,0,6); ! 3 2-byte instructions **
PLANTLIT2(21, 0, 6);
// 4066 plant(sub,one,x)
PLANT(3, -2, X);
// 4067 plant(moveb,y+pre,i)
PLANT(257, Y + 24, I);
// 4068 %else
goto L_035D;
L_035C:;
// 4069 plant(moveb,y+indir,i); !length (dirty OK)
PLANT(257, Y + 8, I);
// 4070 %finish
L_035D:;
// 4071 plant(moveb,y+post,x+post)
PLANT(257, Y + 16, X + 16);
// 4072 plant(subb,one,i)
PLANT(259, -2, I);
// 4073 plantlit2(bcc,0,-6)
PLANTLIT2(20, 0, -6);
// 4074 forget(i)
FORGET(I);
// 4075 ! %finish
// 4076 %else
goto L_0357;
L_0359:;
// 4077 %if wx > 1 %then eval(x,a1b+asad) %and eval(y,a0b+asad) %c
if (WX <= 1) goto L_035E;
EVAL(/*?*/ &X, 512 + 1048576);
EVAL(/*?*/ &Y, 256 + 1048576);
goto L_035F;
L_035E:;
EVAL(/*?*/ &Y, 256 + 1048576);
EVAL(/*?*/ &X, 512 + 1048576);
L_035F:;
// 4078+ %else eval(y,a0b+asad) %and eval(x,a1b+asad)
// 4079 structcall(strcopy,sx)
STRUCTCALL(113, SX);
// 4080 %finish
L_0357:;
// 4081 forget(x); forget(y)
FORGET(X);
FORGET(Y);
// 4082 forget cc
FORGETCC();
// 4083 %finish
L_0355:;
L_0352:;
// 4084 %finish %else %unless easy(y)=TRUE %start
goto L_0360;
L_034E:;
if (EASY(Y) == 1) goto L_0361;
// 4085 eval(x,anyareg&free+asad) %if y = 0 %or wx > 1
if (Y == 0) goto L_0362;
if (WX <= 1) goto L_0363;
L_0362:;
EVAL(/*?*/ &X, (65280 & FREE) + 1048576);
L_0363:;
// 4086 %if y # 0 %start
if (Y == 0) goto L_0364;
// 4087 sx = tsize(y) %if sx = 0
if (SX != 0) goto L_0365;
SX = TSIZE(Y);
L_0365:;
// 4088 eval(y,anyareg&free+asad)
EVAL(/*?*/ &Y, (65280 & FREE) + 1048576);
// 4089 forget(y)
FORGET(Y);
// 4090 y = y+post
Y = Y + 16;
// 4091 eval(x,anyareg&free+asad) %if wx <= 1
if (WX > 1) goto L_0366;
EVAL(/*?*/ &X, (65280 & FREE) + 1048576);
L_0366:;
// 4092 %finish
L_0364:;
// 4093 forget(x)
FORGET(X);
// 4094 %if sx = 0 %then fault(sizerr) %else move block(y,x+post,-sx)
if (SX != 0) goto L_0367;
FAULT(11);
goto L_0368;
L_0367:;
MOVEBLOCK(Y, X + 16, -SX);
L_0368:;
// 4095 %finish
L_0361:;
L_0360:;
// 4096 beware(xx)
BEWARE(XX);
// 4097 -> checksp
goto U_1022;
// 4098 %finish
L_034D:;
// 4099 !Simple operand
// 4100 %if c_val # 0 %start
if (C.VAL == 0) goto L_0369;
// 4101 %if dx_val = sp %and dx_mode = c_mode %start
if (DX->VAL != SP) goto L_036A;
if (DX->MODE != C.MODE) goto L_036A;
// 4102 %if sx = 4 %or x >= explim %then c_val = c_val-4 %c
if (SX == 4) goto L_036B;
if (X < EXPLIM) goto L_036C;
L_036B:;
C.VAL = C.VAL - 4;
goto L_036D;
L_036C:;
C.VAL = C.VAL - 2;
L_036D:;
// 4103+ %else c_val = c_val-2
// 4104 %finish
L_036A:;
// 4105 update sp
UPDATESP();
// 4106 %finish
L_0369:;
// 4107 op = move
OP = 1;
// 4108 case = val; case = case+sx<<sizeshift %if sx # 4
CASE = -2147418113;
if (SX == 4) goto L_036E;
CASE = CASE + (SX << 16);
L_036E:;
// 4109 %if x <= a7 %start; !explicit assignment to reg
if (X > 16) goto L_036F;
// 4110 %if xfree(y,0)=TRUE %start
if (XFREE(Y, 0) != 1) goto L_0370;
// 4111 case = 1<<(x-d0); free = free!case
CASE = 1 << X - 1;
FREE = FREE | CASE;
// 4112 %else
goto L_0371;
L_0370:;
// 4113 free = free&(\(1<<(x-d0)))
FREE = FREE & ~(1 << X - 1);
// 4114 %finish
L_0371:;
// 4115 %finish
L_036F:;
// 4116 %if sx # 4 %and act = assign %and control&capbit # 0 %start
if (SX == 4) goto L_0372;
if (ACT != 34) goto L_0372;
if (CONTROL & 536870912 == 0) goto L_0372;
// 4117 eval(y,d0b)
EVAL(/*?*/ &Y, 1);
// 4118 srcall(dx_type); !range check
SRCALL(DX->TYPE);
// 4119 %finish
L_0372:;
// 4120 i = y; i = i-ad %if i >= explim
I = Y;
if (I < EXPLIM) goto L_0373;
I = I - 16384;
L_0373:;
// 4121 %if i >= np0 %start; !SOURCE complex
if (I < NP0) goto L_0374;
// 4122 %if dx_flags&okflag # 0 %or control&bassbit>>1<<sx = 0 %start
if (DX->FLAGS & 64 != 0) goto L_0375;
if (CONTROL & (unsigned int)16777216 >> 1 << SX != 0) goto L_0376;
L_0375:;
// 4123 dy == dict(i)
DY = (struct IDENTINFO *)/*?*/ &DICT[I];
// 4124 %if y >= explim %start
if (Y < EXPLIM) goto L_0377;
// 4125 %if dy_act = prel %and dy_x = x-ad %c
if (DY->ACT != 46) goto L_0378;
if (DY->X != X - 16384) goto L_0378;
if (DY->Y < 0) goto L_0379;
if (DY->TYPE != 52) goto L_0378;
L_0379:;
// 4126+ %and (dy_y < 0 %or dy_type = bytetype) %start
// 4127 y = dy_y
Y = DY->Y;
// 4128 y = litref(litval(y)*imod(size(dy_type))) %if dy_type # bytetype
if (DY->TYPE == 52) goto L_037A;
Y = LITREF(LITVAL(Y) * _imp_IMOD(SIZE(DY->TYPE)));
L_037A:;
// 4129 act = add
ACT = 2;
// 4130 -> tostore
goto U_1023;
// 4131 %finish
L_0378:;
// 4132 %else
goto L_037B;
L_0377:;
// 4133 %if dy_x = x %c
if (DY->X != X) goto L_037C;
if (DY->ACT < 9) goto L_037D;
if (DY->ACT != 9) goto L_037C;
if (DY->Y != 0) goto L_037C;
L_037D:;
// 4134+ %and (dy_act < neg %or (dy_act = neg %and dy_y = 0)) %start
// 4135 act = dy_act; y = dy_y
ACT = DY->ACT;
Y = DY->Y;
// 4136 -> tostore
goto U_1023;
// 4137 %finish
L_037C:;
// 4138 %finish
L_037B:;
// 4139 %finish
L_0376:;
// 4140 %if wx < 999 %then eval(y,case) %and eval(x,ref) %c
if (WX >= 999) goto L_037E;
EVAL(/*?*/ &Y, CASE);
EVAL(/*?*/ &X, -2147483648);
goto L_037F;
L_037E:;
EVAL(/*?*/ &X, -2147483648);
EVAL(/*?*/ &Y, CASE);
L_037F:;
// 4141+ %else eval(x,ref) %and eval(y,case)
// 4142 %else
goto L_0380;
L_0374:;
// 4143 eval(x,ref)
EVAL(/*?*/ &X, -2147483648);
// 4144 %if y <= 0 %start
if (Y > 0) goto L_0381;
// 4145 %if y = 0 %and dx_flags&readable # 0 %then op = clr %c
if (Y != 0) goto L_0382;
if (DX->FLAGS & 2 == 0) goto L_0382;
OP = 52;
goto L_0383;
L_0382:;
if (Y < -255) goto L_0384;
if (SX != 4) goto L_0384;
EVAL(/*?*/ &Y, 239);
L_0384:;
L_0383:;
// 4146+ %else %if y >= litmite %and sx = 4 %then eval(y,anydreg)
// 4147 %else
goto L_0385;
L_0381:;
// 4148 eval(y,case) %unless y <= a7
if (Y <= 16) goto L_0386;
EVAL(/*?*/ &Y, CASE);
L_0386:;
// 4149 %finish
L_0385:;
// 4150 %finish
L_0380:;
// 4151 %if y # x %start
if (Y == X) goto L_0387;
// 4152 %if 0 < y <= maxareg %and 0 < yy = c_reg_content(y) %start
{
// Double-sided test on Y (Part I)
int tmp;
if (0 >= (tmp = Y)) goto L_0388;
// Double-sided test on Y (Part II)
if (tmp > 12) goto L_0388;
}
{
// Double-sided test on YY (Part I)
int tmp;
if (0 >= (tmp = YY)) goto L_0388;
// Double-sided test on YY (Part II)
if (tmp != C.REG.CONTENT[Y - 1]) goto L_0388;
}
// 4153 beware(xx)
BEWARE(XX);
// 4154 c_reg_content(y) = xx
C.REG.CONTENT[Y - 1] = XX;
// 4155 %finish %else beware(xx)
goto L_0389;
L_0388:;
BEWARE(XX);
L_0389:;
// 4156 plant(op+(sx&3)<<8,y,x)
PLANT(OP + ((SX & 3) << 8), Y, X);
// 4157 c_reg_ccx = xx; c_reg_ccy = 0
C.REG.CCX = XX;
C.REG.CCY = 0;
// 4158 %finish %else beware(xx)
goto L_038A;
L_0387:;
BEWARE(XX);
L_038A:;
// 4159 endass:
U_1024:;
// 4160 dx_flags = dx_flags!okflag %if c_localdpos <= xx < dictlim %c
{
// Double-sided test on XX (Part I)
int tmp;
if (C.LOCALDPOS > (tmp = XX)) goto L_038B;
// Double-sided test on XX (Part II)
if (tmp >= DICTLIM) goto L_038B;
}
if (C.FORWARD != 0) goto L_038B;
DX->FLAGS = DX->FLAGS | 64;
L_038B:;
// 4161+ %and c_forward = 0
// 4162 %return
return;
// 4163
// 4164 do(incass): !(for %for loop)
case_DO_35:;
// 4165 flush %if pendcond # 0
if (PENDCOND == 0) goto L_038C;
FLUSH();
L_038C:;
// 4166 dx == dict(xx)
DX = (struct IDENTINFO *)/*?*/ &DICT[XX];
// 4167 sx = size(dx_type)
SX = SIZE(DX->TYPE);
// 4168 wx = weight(x)
WX = WEIGHT(X);
// 4169 act = add
ACT = 2;
// 4170 tostore:
U_1023:;
// 4171 %if y = 0 %start; ![only for NOT,NEG]
if (Y != 0) goto L_038D;
// 4172 eval(x,ref)
EVAL(/*?*/ &X, -2147483648);
// 4173 %finish %else %if y < 0 %start
goto L_038E;
L_038D:;
if (Y >= 0) goto L_038F;
// 4174 %if act = add %start; ![+- literal]
if (ACT != 2) goto L_0390;
// 4175 %if y >= litquick %start; !-8:-1 or 1:8
if (Y < -16) goto L_0391;
// 4176 act = sub %and y = y-1 %if y&1 # 0; !negate if neg
if (Y & 1 == 0) goto L_0392;
ACT = 3;
Y = Y - 1;
L_0392:;
// 4177 eval(x,ref)
EVAL(/*?*/ &X, -2147483648);
// 4178 -> past
goto U_1025;
// 4179 %finish
L_0391:;
// 4180 act = sub %and y = y+1 %if y = -(128<<1); !128=>-128
if (Y != -(128 << 1)) goto L_0393;
ACT = 3;
Y = Y + 1;
L_0393:;
// 4181 %finish
L_0390:;
// 4182 eval(x,ref)
EVAL(/*?*/ &X, -2147483648);
// 4183 eval(y,anydreg) %if y >= litmite %and anydreg&free # 0
if (Y < -255) goto L_0394;
if (239 & FREE == 0) goto L_0394;
EVAL(/*?*/ &Y, 239);
L_0394:;
// 4184 %finish %else %if x <= a7 %start
goto L_038E;
L_038F:;
if (X > 16) goto L_0395;
// 4185 eval(y,val)
EVAL(/*?*/ &Y, -2147418113);
// 4186 %else
goto L_038E;
L_0395:;
// 4187 %if 999 > wx < weight(y) %then eval(y,anydreg) %and eval(x,ref) %c
{
// Double-sided test on WX (Part I)
int tmp;
if (999 <= (tmp = WX)) goto L_0396;
// Double-sided test on WX (Part II)
if (tmp >= WEIGHT(Y)) goto L_0396;
}
EVAL(/*?*/ &Y, 239);
EVAL(/*?*/ &X, -2147483648);
goto L_0397;
L_0396:;
EVAL(/*?*/ &X, -2147483648);
EVAL(/*?*/ &Y, 239);
L_0397:;
// 4188+ %else eval(x,ref) %and eval(y,anydreg)
// 4189 %finish
L_038E:;
// 4190 past:
U_1025:;
// 4191 plant(act+sx<<8,y,x)
PLANT(ACT + (SX << 8), Y, X);
// 4192 plant(trapv,0,0) %if control&overbit # 0 %and act <= sub
if (CONTROL & 268435456 == 0) goto L_0398;
if (ACT > 3) goto L_0398;
PLANT(70, 0, 0);
L_0398:;
// 4193 beware(xx)
BEWARE(XX);
// 4194 c_reg_ccx = xx; c_reg_ccy = 0
C.REG.CCX = XX;
C.REG.CCY = 0;
// 4195 ->endass
goto U_1024;
// 4196
// 4197
// 4198 !!!!!!!!!!!!!!!!!!!!!! Returns and jumps !!!!!!!!!!!!!!!!!!!!!!!!
// 4199 !
// 4200 do(return): !terminate procedure
case_DO_38:;
// 4201 update sp
UPDATESP();
// 4202 %if c_type # 0 %start; !function,map
if (C.TYPE == 0) goto L_0399;
// 4203 r = typecell(c_dpid_type)_reg&15
R = TYPECELL(C.DPID->TYPE)->REG & 15;
// 4204 %if c_type > 0 %and size(c_type) > 0 %start; !simple fn
if (C.TYPE <= 0) goto L_039A;
if (SIZE(C.TYPE) <= 0) goto L_039A;
// 4205 flush %if pendcond # 0 %and pendin # 0
if (PENDCOND == 0) goto L_039B;
if (PENDIN == 0) goto L_039B;
FLUSH();
L_039B:;
// 4206 i = y
I = Y;
// 4207 %if c_reg_content(r+d0) # y %start
if (C.REG.CONTENT[R + 1 - 1] == Y) goto L_039C;
// 4208 flush %if pendcond # 0
if (PENDCOND == 0) goto L_039D;
FLUSH();
L_039D:;
// 4209 eval(y,d0b<<r)
EVAL(/*?*/ &Y, 1 << R);
// 4210 %finish
L_039C:;
// 4211 c_status = c_status!wrongcc %unless c_reg_ccx = i %and c_reg_ccy = 0
if (C.REG.CCX != I) goto L_039E;
if (C.REG.CCY == 0) goto L_039F;
L_039E:;
C.STATUS = C.STATUS | 4;
L_039F:;
// 4212 %else; !struct fn or map
goto L_03A0;
L_039A:;
// 4213 c_status = c_status!wrongcc
C.STATUS = C.STATUS | 4;
// 4214 flush %if pendcond # 0
if (PENDCOND == 0) goto L_03A1;
FLUSH();
L_03A1:;
// 4215 y = y+ad %if c_type > 0; !ie struct fn
if (C.TYPE <= 0) goto L_03A2;
Y = Y + 16384;
L_03A2:;
// 4216 sp = c_sp
SP = C.SP;
// 4217 eval(y,d0b<<r)
EVAL(/*?*/ &Y, 1 << R);
// 4218 %if c_sp # sp %start
if (C.SP == SP) goto L_03A3;
// 4219 addimm(sp-c_sp,a7); c_sp = sp
ADDIMM(SP - C.SP, 16);
C.SP = SP;
// 4220 %finish
L_03A3:;
// 4221 %finish
L_03A0:;
// 4222 %finish
L_0399:;
// 4223 %if c_temps # 0 %start
if (C.TEMPS == 0) goto L_03A4;
// 4224 flush %if pendcond # 0
if (PENDCOND == 0) goto L_03A5;
FLUSH();
L_03A5:;
// 4225 addimm(c_temps,a7)
ADDIMM(C.TEMPS, 16);
// 4226 %finish
L_03A4:;
// 4227 dict(dictlim)_val = c_return
DICT[DICTLIM].VAL = C.RETURN;
// 4228 compile uncond branch(dictlim)
COMPILEUNCONDBRANCH(DICTLIM);
// 4229 c_return = -(pc-1)
C.RETURN = -(PC - 1);
// 4230 %return
return;
// 4231
// 4232 do(jumpout):
case_DO_41:;
// 4233 update sp
UPDATESP();
// 4234 flush %if pendcond > 0 %and pendin # 0
if (PENDCOND <= 0) goto L_03A6;
if (PENDIN == 0) goto L_03A6;
FLUSH();
L_03A6:;
// 4235 save context(y) %if y # x; !exit not continue
if (Y == X) goto L_03A7;
SAVECONTEXT(Y);
L_03A7:;
// 4236 compile uncond branch(y)
COMPILEUNCONDBRANCH(Y);
// 4237 %return
return;
// 4238
// 4239 do(repeat):
case_DO_39:;
// 4240 update sp
UPDATESP();
// 4241 compile uncond branch(x)
COMPILEUNCONDBRANCH(X);
// 4242 define label(x+1) %if dict(x+1)_val < 0
if (DICT[X + 1].VAL >= 0) goto L_03A8;
DEFINELABEL(X + 1);
L_03A8:;
// 4243 %if y < 0 %start; !temp(s) declared
if (Y >= 0) goto L_03A9;
// 4244 c_val = y; c_temps = c_temps+y; !decrement temps
C.VAL = Y;
C.TEMPS = C.TEMPS + Y;
// 4245 update sp
UPDATESP();
// 4246 %finish
L_03A9:;
// 4247 %return
return;
// 4248
// 4249 do(else):
case_DO_40:;
// 4250 %if c_access # 0 %and c_access # -2 %start
if (C.ACCESS == 0) goto L_03AA;
if (C.ACCESS == -2) goto L_03AA;
// 4251 save context(y)
SAVECONTEXT(Y);
// 4252 compile uncond branch(y); !outward branch for %else
COMPILEUNCONDBRANCH(Y);
// 4253 %finish
L_03AA:;
// 4254 define label(x) %if x # 0 %and dict(x)_val < 0; !inward from false cond
if (X == 0) goto L_03AB;
if (DICT[X].VAL >= 0) goto L_03AB;
DEFINELABEL(X);
L_03AB:;
// 4255 %return
return;
// 4256
// 4257 do(goto): !user jump
case_DO_16:;
// 4258 update sp
UPDATESP();
// 4259 c_forward = c_forward+1 %if dict(y)_val = 0
if (DICT[Y].VAL != 0) goto L_03AC;
C.FORWARD = C.FORWARD + 1;
L_03AC:;
// 4260 addimm(c_temps,a7) %if c_temps # 0
if (C.TEMPS == 0) goto L_03AD;
ADDIMM(C.TEMPS, 16);
L_03AD:;
// 4261 i = pendcond
I = PENDCOND;
// 4262 compile uncond branch(y)
COMPILEUNCONDBRANCH(Y);
// 4263 addimm(-c_temps,a7) %if i # 0 %and c_temps # 0
if (I == 0) goto L_03AE;
if (C.TEMPS == 0) goto L_03AE;
ADDIMM(-C.TEMPS, 16);
L_03AE:;
// 4264 %return
return;
// 4265
// 4266 do(label):
case_DO_44:;
// 4267 update sp
UPDATESP();
// 4268 define label(x)
DEFINELABEL(X);
// 4269 %return
return;
// 4270
// 4271 do(stop):
case_DO_37:;
// 4272 update sp
UPDATESP();
// 4273 flush %if pendcond # 0
if (PENDCOND == 0) goto L_03AF;
FLUSH();
L_03AF:;
// 4274 plant(clr,0,d0)
PLANT(52, 0, 1);
// 4275 srcall(signal)
SRCALL(73);
// 4276 c_access = 0
C.ACCESS = 0;
// 4277 %return
return;
// 4278
// 4279 do(signal):
case_DO_73:;
// 4280 update sp
UPDATESP();
// 4281 flush %if pendcond # 0
if (PENDCOND == 0) goto L_03B0;
FLUSH();
L_03B0:;
// 4282 sp = c_sp
SP = C.SP;
// 4283 pp = pp+1; dp == dict(pp)
*PP = *PP + 1;
DP = (struct IDENTINFO *)/*?*/ &DICT[*PP];
// 4284 xx = dp_x; yy = dp_y
XX = DP->X;
YY = DP->Y;
// 4285 x = litval(x)
X = LITVAL(X);
// 4286 %if yy # undef %start
if (YY == 16) goto L_03B1;
// 4287 eval(yy,a0b+asad); x = x+64
EVAL(/*?*/ &YY, 256 + 1048576);
X = X + 64;
// 4288 %finish
L_03B1:;
// 4289 %if xx # undef %start
if (XX == 16) goto L_03B2;
// 4290 eval(xx,d2b); x = x+32
EVAL(/*?*/ &XX, 4);
X = X + 32;
// 4291 %finish
L_03B2:;
// 4292 %if y # undef %start
if (Y == 16) goto L_03B3;
// 4293 eval(y,d1b); x = x+16
EVAL(/*?*/ &Y, 2);
X = X + 16;
// 4294 %finish
L_03B3:;
// 4295 x = litref(x)
X = LITREF(X);
// 4296 eval(x,d0b)
EVAL(/*?*/ &X, 1);
// 4297 %if control&sysbit # 0 %then plant(jmp,0,signal) %else plant(jsr,0,signal)
if (CONTROL & 262144 == 0) goto L_03B4;
PLANT(57, 0, 73);
goto L_03B5;
L_03B4:;
PLANT(56, 0, 73);
L_03B5:;
// 4298 %if c_sp # sp %start; ![earlier?]
if (C.SP == SP) goto L_03B6;
// 4299 addimm(sp-c_sp,a7); c_sp = sp
ADDIMM(SP - C.SP, 16);
C.SP = SP;
// 4300 %finish
L_03B6:;
// 4301 c_access = 0
C.ACCESS = 0;
// 4302 %return
return;
// 4303
// 4304 do(settrap):
case_DO_42:;
// 4305 update sp
UPDATESP();
// 4306 push(d0+6); ![historical]
PUSH(1 + 6);
// 4307 push(mb)
PUSH(13);
// 4308 plant(pea,0,temp(pcmode,10)); !address of mask [2+2+2+4]
PLANT(55, 0, TEMP(58, 10));
// 4309 c_sp = c_sp-4
C.SP = C.SP - 4;
// 4310 push(gb+indir); ![2 bytes]
PUSH(14 + 8);
// 4311 plant(move,a7,gb+indir); ![2 bytes]
PLANT(1, 16, 14 + 8);
// 4312 c_eventsp = c_sp
C.EVENTSP = C.SP;
// 4313 c_forward = c_forward+1
C.FORWARD = C.FORWARD + 1;
// 4314 lreg(c_lab1-dictlim) = c_reg
LREG[C.LAB1 - DICTLIM] = C.REG;
// 4315 plant(bra,0,c_lab1); ![4 bytes]
PLANT(16, 0, C.LAB1);
// 4316 pflag(pc-1) = longjump; !**not to be shortened
PFLAG[PC - 1] = 3;
// 4317 forget regs
FORGETREGS();
// 4318 plant(dc,0,temp(absmode,litval(y))); !event mask
PLANT(102, 0, TEMP(56, LITVAL(Y)));
// 4319 ! store(litval(y),0); !event mask
// 4320 %return
return;
// 4321
// 4322 do(swgoto): !switch jump
case_DO_43:;
// 4323 flush %if pendcond # 0
if (PENDCOND == 0) goto L_03B7;
FLUSH();
L_03B7:;
// 4324 update sp
UPDATESP();
// 4325 dx == dict(x)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
// 4326 dx_flags = dx_flags!rflag
DX->FLAGS = DX->FLAGS | 32;
// 4327 i = dx_val; !start of table
I = DX->VAL;
// 4328 dy == typecell(dx_type)
DY = (struct IDENTINFO *)TYPECELL(DX->TYPE);
// 4329 get bounds(dy_xtype,sx,sy)
GETBOUNDS(DY->XTYPE, /*?*/ &SX, /*?*/ &SY);
// 4330 %if y <= 0 %start; !literal subscript
if (Y > 0) goto L_03B8;
// 4331 y = litval(y)
Y = LITVAL(Y);
// 4332 i = i+y-sx
I = I + Y - SX;
// 4333 addimm(c_temps,a7) %if c_temps # 0
if (C.TEMPS == 0) goto L_03B9;
ADDIMM(C.TEMPS, 16);
L_03B9:;
// 4334 plant(bra,0,temp(labmode,prog(i)))
PLANT(16, 0, TEMP(186, PROG[I]));
// 4335 prog(i) = dtemp_val; !updated by PCREL
PROG[I] = DTEMP->VAL;
// 4336 %else
goto L_03BA;
L_03B8:;
// 4337 eval(y,d0b)
EVAL(/*?*/ &Y, 1);
// 4338 %if i > pc %start; !first jump (I >= SWPC)
if (I <= PC) goto L_03BB;
// 4339 c_forward = c_forward+(sy-sx+1)
C.FORWARD = C.FORWARD + (SY - SX + 1);
// 4340 %if dx_flags&arrflag = 0 %start; !no check
if (DX->FLAGS & 8 != 0) goto L_03BC;
// 4341 addimm(c_temps,a7) %if c_temps # 0
if (C.TEMPS == 0) goto L_03BD;
ADDIMM(C.TEMPS, 16);
L_03BD:;
// 4342 plant(lea,temp(pcmode,10-sx-sx),a0); !LEA ?(PC),A0
PLANT(78, TEMP(58, 10 - SX - SX), 9);
// 4343 plant(add,d0,d0); !ADD D0,D0
PLANT(2, 1, 1);
// 4344 %else
goto L_03BE;
L_03BC:;
// 4345 wx = 12
WX = 12;
// 4346 %if c_temps # 0 %start
if (C.TEMPS == 0) goto L_03BF;
// 4347 wx = wx+2; wx = wx+2 %if c_temps > 8
WX = WX + 2;
if (C.TEMPS <= 8) goto L_03C0;
WX = WX + 2;
L_03C0:;
// 4348 %finish
L_03BF:;
// 4349 plant(lea,temp(pcmode,wx),a0)
PLANT(78, TEMP(58, WX), 9);
// 4350 srcall(index)
SRCALL(78);
// 4351 addimm(c_temps,a7) %if c_temps # 0
if (C.TEMPS == 0) goto L_03C1;
ADDIMM(C.TEMPS, 16);
L_03C1:;
// 4352 %finish
L_03BE:;
// 4353 plant(add+2<<8,tempx(a0,d0),a0); !ADD.W 0(A0,D0),A0
PLANT(2 + (2 << 8), TEMPX(9, 1), 9);
// 4354 plant(jmp,0,a0+indir); !JUMP (A0)
PLANT(57, 0, 9 + 8);
// 4355 %if dx_flags&arrflag # 0 %start
if (DX->FLAGS & 8 == 0) goto L_03C2;
// 4356 store(sy>>16,0); store(sy,0)
STORE((unsigned int)SY >> 16, 0);
STORE(SY, 0);
// 4357 store(sx>>16,0); store(sx,0)
STORE((unsigned int)SX >> 16, 0);
STORE(SX, 0);
// 4358 store(0,0); store(2,0)
STORE(0, 0);
STORE(2, 0);
// 4359 %finish
L_03C2:;
// 4360 dx_val = pc
DX->VAL = PC;
// 4361 %cycle
L_03C3:;
// 4362 store(prog(i),0)
STORE(PROG[I], 0);
// 4363 swpc = swpc+1 %if i = swpc; i = i+1
if (I != SWPC) goto L_03C4;
SWPC = SWPC + 1;
L_03C4:;
I = I + 1;
// 4364 sx = sx+1
SX = SX + 1;
// 4365 %repeat %until sx > sy
if (SX > SY) goto L_03C5;
goto L_03C3;
L_03C5:;
// 4366 %else; !just branch to earlier sequence
goto L_03C6;
L_03BB:;
// 4367 ![gives wrong line number for error]
// 4368 ![wrong if temps]
// 4369 i = i-7 %if dx_flags&arrflag # 0
if (DX->FLAGS & 8 == 0) goto L_03C7;
I = I - 7;
L_03C7:;
// 4370 plant(bra,0,temp(labmode,i-6))
PLANT(16, 0, TEMP(186, I - 6));
// 4371 %finish
L_03C6:;
// 4372 %finish
L_03BA:;
// 4373 c_access = 0
C.ACCESS = 0;
// 4374 %return
return;
// 4375
// 4376 do(asize):
case_DO_105:;
// 4377 %if y # 0 %start; !first: prime D0
if (Y == 0) goto L_03C8;
// 4378 update sp
UPDATESP();
// 4379 eval(y,d0b); !basic itemsize
EVAL(/*?*/ &Y, 1);
// 4380 %else
goto L_03C9;
L_03C8:;
// 4381 srcall(asize)
SRCALL(105);
// 4382 %finish
L_03C9:;
// 4383 pp = pp+1; dp == dict(pp)
*PP = *PP + 1;
DP = (struct IDENTINFO *)/*?*/ &DICT[*PP];
// 4384 xx = dp_x; yy = dp_y
XX = DP->X;
YY = DP->Y;
// 4385 free = c_free-d0b; !not d0
FREE = C.FREE - 1;
// 4386 eval(xx,d1b); !lower
EVAL(/*?*/ &XX, 2);
// 4387 eval(yy,d2b); !upper
EVAL(/*?*/ &YY, 4);
// 4388 push(d0); !size
PUSH(1);
// 4389 push(d1); push(d2)
PUSH(2);
PUSH(3);
// 4390 forget regs
FORGETREGS();
// 4391 free = free!(d1b+d2b)
FREE = FREE | 2 + 4;
// 4392 dict(x)_val = c_sp
DICT[X].VAL = C.SP;
// 4393 %return
return;
// 4394 !
// 4395 do(adok): ![spare code]
case_DO_103:;
// 4396 !Push size of dynamic array (& 0-base value) for AGET
// 4397 update sp
UPDATESP();
// 4398 %if x # 0 %start
if (X == 0) goto L_03CA;
// 4399 %if x # d0 %then eval(x,d0b) %else srcall(asize)
if (X == 1) goto L_03CB;
EVAL(/*?*/ &X, 1);
goto L_03CC;
L_03CB:;
SRCALL(105);
L_03CC:;
// 4400 %finish
L_03CA:;
// 4401 push(y) %if y # 0
if (Y == 0) goto L_03CD;
PUSH(Y);
L_03CD:;
// 4402 push(d0)
PUSH(1);
// 4403 %return
return;
// 4404
// 4405 do(aget):
case_DO_109:;
// 4406 plant(move,x,d0)
PLANT(1, X, 1);
// 4407 srcall(aget)
SRCALL(109);
// 4408 plant(move,a7,x)
PLANT(1, 16, X);
// 4409 %if y # 0 %start
if (Y == 0) goto L_03CE;
// 4410 dx == dict(x)
DX = (struct IDENTINFO *)/*?*/ &DICT[X];
// 4411 dx_val = dx_val+4
DX->VAL = DX->VAL + 4;
// 4412 plant(move,a7,d0)
PLANT(1, 16, 1);
// 4413 plant(add,d0,x)
PLANT(2, 1, X);
// 4414 dx_val = dx_val-4
DX->VAL = DX->VAL - 4;
// 4415 %finish
L_03CE:;
// 4416 forget(d0); forget(a0)
FORGET(1);
FORGET(9);
// 4417 %return
return;
// 4418
// 4419 %routine COMPILE ENTRY(%integer linked,arg)
void COMPILEENTRY(int LINKED, int ARG) {
// 4420 !Entry sequence generated at end
// 4421 %integer i,r,vsp,lastvsp,holdsp
int I;
int R;
int VSP;
int LASTVSP;
int HOLDSP;
// 4422 %record(identinfo)%name darg,tp
struct IDENTINFO *DARG;
struct IDENTINFO *TP;
// 4423 holdsp = c_sp
HOLDSP = C.SP;
// 4424 c_sp = 0; lastvsp = 0
C.SP = 0;
LASTVSP = 0;
// 4425 c_stack = c_stack-4 %if linked > 0; !allow for link
if (LINKED <= 0) goto L_03CF;
C.STACK = C.STACK - 4;
L_03CF:;
// 4426 %if linked = 0 %and c_status&onstack # 0 %start
if (LINKED != 0) goto L_03D0;
if (C.STATUS & 8 == 0) goto L_03D0;
// 4427 !justify addressing assumed for onstack parameters
// 4428 c_sp = 4; holdsp = holdsp-4; c_stack = c_stack-4
C.SP = 4;
HOLDSP = HOLDSP - 4;
C.STACK = C.STACK - 4;
// 4429 %finish
L_03D0:;
// 4430 c_stack = c_stack-4; !and return address
C.STACK = C.STACK - 4;
// 4431 c_totstack = c_stack %if c_stack < c_totstack
if (C.STACK >= C.TOTSTACK) goto L_03D1;
C.TOTSTACK = C.STACK;
L_03D1:;
// 4432 %if control&stackbit # 0 %c
if (CONTROL & 1048576 == 0) goto L_03D2;
if (C.STATUS & 2 != 0) goto L_03D3;
if (C.TOTSTACK >= -128) goto L_03D2;
L_03D3:;
// 4433+ %and (c_status&unknown # 0 %or c_totstack < -128) %start
// 4434 plantlit(move,c_stack,breg); !*ok - gets cleared*
PLANTLIT(1, C.STACK, 5);
// 4435 srcall(stackok)
SRCALL(104);
// 4436 %finish
L_03D2:;
// 4437 %if level > outerlevel %and linked > 0 %start; !link required
if (LEVEL <= 0) goto L_03D4;
if (LINKED <= 0) goto L_03D4;
// 4438 %if level > 1 %start
if (LEVEL <= 1) goto L_03D5;
// 4439 plant(move,tempd(gb,level<<2),prea7); !MOVE ?(GB),-(SP)
PLANT(1, TEMPD(14, LEVEL << 2), 40);
// 4440 plant(move,a7,tempd(gb,level<<2)); !MOVE SP,?(GB)
PLANT(1, 16, TEMPD(14, LEVEL << 2));
// 4441 %else
goto L_03D6;
L_03D5:;
// 4442 plant(link,0,f1); !LINK #0,Ax
PLANT(72, 0, 15);
// 4443 %finish
L_03D6:;
// 4444 %finish
L_03D4:;
// 4445 darg == dict(arg)
DARG = (struct IDENTINFO *)/*?*/ &DICT[ARG];
// 4446 %cycle
L_03D7:;
// 4447 arg = darg_link
ARG = DARG->LINK;
// 4448 %exit %if arg = 0
if (ARG != 0) goto L_03D8;
goto L_03D9;
L_03D8:;
// 4449 darg == dict(arg)
DARG = (struct IDENTINFO *)/*?*/ &DICT[ARG];
// 4450 %if darg_val <= 0 %start; !passed in reg, not on stack
if (DARG->VAL > 0) goto L_03DA;
// 4451 vsp = darg_val
VSP = DARG->VAL;
// 4452 r = darg_reg&15+d0
R = (DARG->REG & 15) + 1;
// 4453 %if darg_flags&mflag # 0 %or linked > 0 %start
if (DARG->FLAGS & 128 != 0) goto L_03DB;
if (LINKED <= 0) goto L_03DC;
L_03DB:;
// 4454 addimm(lastvsp-c_sp,a7); c_sp = lastvsp
ADDIMM(LASTVSP - C.SP, 16);
C.SP = LASTVSP;
// 4455 i = nsize(darg)
I = NSIZE(DARG);
// 4456 %if i > 0 %start
if (I <= 0) goto L_03DD;
// 4457 ! name or simple operand by value
// 4458 !NB MOVE.B transfers to hi byte
// 4459 plant(move+i<<8,r,prea7)
PLANT(1 + (I << 8), R, 40);
// 4460 %finish %else %if darg_flags&proc # 0 %start; !proc as param
goto L_03DE;
L_03DD:;
if (DARG->FLAGS & 12288 == 0) goto L_03DF;
// 4461 plant(move,r,prea7)
PLANT(1, R, 40);
// 4462 plantlit(movew,16_4EF9,prea7)
PLANTLIT(513, 20217, 40);
// 4463 %else; !structure by value
goto L_03DE;
L_03DF:;
// 4464 tp == typecell(darg_type)
TP = (struct IDENTINFO *)TYPECELL(DARG->TYPE);
// 4465 %if tp_flags&cat = stringy %start
if (TP->FLAGS & 15 != 8) goto L_03E0;
// 4466 %if control&capbit # 0 %and tp_size > -256 %start
if (CONTROL & 536870912 == 0) goto L_03E1;
if (TP->SIZE <= -256) goto L_03E1;
// 4467 plantlit(cmp+1<<8,-tp_size,r+indir)
PLANTLIT(4 + (1 << 8), -TP->SIZE, R + 8);
// 4468 plantlit2(bcs,0,4)
PLANTLIT2(21, 0, 4);
// 4469 srcall(check)
SRCALL(111);
// 4470 %finish
L_03E1:;
// 4471 i = c_sp-vsp
I = C.SP - VSP;
// 4472 addimm(-i,a7); !SP = SP-bytes
ADDIMM(-I, 16);
// 4473 extend stack(i)
EXTENDSTACK(I);
// 4474 !MOVE.B length,Dx
// 4475 plant(moveb,r+indir,breg)
PLANT(257, R + 8, 5);
// 4476 !MOVE.B 0(Ay,Dx),0(SP,Dx)
// 4477 plant(moveb,tempx(r,breg),tempx2(a7,breg))
PLANT(257, TEMPX(R, 5), TEMPX2(16, 5));
// 4478 plant(subb,one,breg)
PLANT(259, -2, 5);
// 4479 plantlit2(bcc,0,-10)
PLANTLIT2(20, 0, -10);
// 4480 %else; !fixed length structure
goto L_03E2;
L_03E0:;
// 4481 free = bregb
FREE = 16;
// 4482 push block(r,c_sp-vsp)
PUSHBLOCK(R, C.SP - VSP);
// 4483 %finish
L_03E2:;
// 4484 %finish
L_03DE:;
// 4485 c_sp = vsp
C.SP = VSP;
// 4486 %finish
L_03DC:;
// 4487 lastvsp = vsp
LASTVSP = VSP;
// 4488 %finish
L_03DA:;
// 4489 %repeat
goto L_03D7;
L_03D9:;
// 4490 %if c_sp # 0 %start; !there are accesses to params
if (C.SP == 0) goto L_03E3;
// 4491 addimm(lastvsp-c_sp,a7)
ADDIMM(LASTVSP - C.SP, 16);
// 4492 c_sp = holdsp
C.SP = HOLDSP;
// 4493 %finish %else c_sp = holdsp-lastvsp; !reduce
goto L_03E4;
L_03E3:;
C.SP = HOLDSP - LASTVSP;
L_03E4:;
// 4494 %end
return;
} /* end of COMPILEENTRY */
// 4495
// 4496 do(end):
case_DO_50:;
// 4497 compile entry(c_status&globbed,c_dpid_type)
COMPILEENTRY(C.STATUS & 16, C.DPID->TYPE);
// 4498 %return
return;
// 4499
// 4500 do(*): intern(8)
case_DO_default:;
INTERN(8);
// 4501 do(0): !null action
case_DO_0:;
// 4502 %end;
return;
case_DO_dispatch:
if (DO_index < 0 || DO_index > 117)
_imp_signalf(6, 3, DO_index, "->DO(%d) out of bounds at %s line %d", DO_index, DO_file, DO_line);
goto *DO[DO_index - 0];
case_DO_missing:
_imp_signalf(8, 2, DO_index, "switch jump to undefined label DO(%d): at %s line %d", DO_index, DO_file, DO_line);
} /* end of EVAL */
// ?ENDCONC unused
// ?OP3 unused
// ?MORE unused
// ?TOSHORT unused
// ?ADDW unused
// 4503 ; !eval
// 4503
// 4504 %routine COMPILE(%integer startp)
void COMPILE(int STARTP) {
// 4505 %integer p
int P;
// 4506 {?} show exp(startp) %if control&explist # 0 %and control&list # 0
if (CONTROL & 8 == 0) goto L_03E5;
if (CONTROL & 1 == 0) goto L_03E5;
SHOWEXP(STARTP);
L_03E5:;
// 4507 np = np0 %and %return %if faultnum > 0
if (FAULTNUM <= 0) goto L_03E6;
NP = NP0;
return;
L_03E6:;
// 4508 pendcond = 0
PENDCOND = 0;
// 4509 p = startp-1
P = STARTP - 1;
// 4510 %cycle
L_03E7:;
// 4511 free = c_free
FREE = C.FREE;
// 4512 p = p+1
P = P + 1;
// 4513 %if p >= np %start
if (P < NP) goto L_03E8;
// 4514 %if startp = np0 %start
if (STARTP != NP0) goto L_03E9;
// 4515 np = np0
NP = NP0;
// 4516 flush %if pendcond > 0
if (PENDCOND <= 0) goto L_03EA;
FLUSH();
L_03EA:;
// 4517 %return
return;
// 4518 %finish
L_03E9:;
// 4519 np = startp; startp = np0; p = startp
NP = STARTP;
STARTP = NP0;
P = STARTP;
// 4520 %finish
L_03E8:;
// 4521 %if c_reg_line # line %and control&(tracebit!diagbit!linebit) # 0 %start
if (C.REG.LINE == LINE) goto L_03EB;
if (CONTROL & (2097152 | 4194304 | 8388608) == 0) goto L_03EB;
// 4522 flush %if pendcond > 0
if (PENDCOND <= 0) goto L_03EC;
FLUSH();
L_03EC:;
// 4523 pendcond = -1
PENDCOND = -1;
// 4524 %finish
L_03EB:;
// 4525 eval(p,inst)
EVAL(/*?*/ &P, 1073741824);
// 4526 %repeat
goto L_03E7;
// 4527 %end; !compile
} /* end of COMPILE */
// 4528
// 4529 %routine SET FIRST ENTRY
void SETFIRSTENTRY(void) {
// 4530 %integer j,k,p
int J;
int K;
int P;
// 4531 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 4532 firstpos = dictlim; firstentry = finalbound
FIRSTPOS = DICTLIM;
FIRSTENTRY = FINALBOUND;
// 4533 p = 0
P = 0;
// 4534 %cycle
L_03ED:;
// 4535 p = p+1
P = P + 1;
// 4536 %exit %if p >= dlim
if (P < DLIM) goto L_03EE;
goto L_03EF;
L_03EE:;
// 4537 dp == dict(p)
DP = (struct IDENTINFO *)/*?*/ &DICT[P];
// 4538 %continue %if dp_mode # procmode
if (DP->MODE == 250) goto L_03F0;
goto L_03F1;
L_03F0:;
// 4539 %continue %if dp_val >= firstentry
if (DP->VAL < FIRSTENTRY) goto L_03F2;
goto L_03F1;
L_03F2:;
// 4540 j = dp_val
J = DP->VAL;
// 4541 %if j <= 0 %start
if (J > 0) goto L_03F3;
// 4542 %continue %if j = 0
if (J != 0) goto L_03F4;
goto L_03F1;
L_03F4:;
// 4543 k = -j
K = -J;
// 4544 %cycle
L_03F5:;
// 4545 j = k<<1
J = K << 1;
// 4546 k = code word(j)&16_FFFF
K = CODEWORD(J) & 65535;
// 4547 %repeat %until k = 0
if (K == 0) goto L_03F6;
goto L_03F5;
L_03F6:;
// 4548 %continue %if j >= firstentry
if (J < FIRSTENTRY) goto L_03F7;
goto L_03F1;
L_03F7:;
// 4549 %finish
L_03F3:;
// 4550 firstentry = j; firstpos = p
FIRSTENTRY = J;
FIRSTPOS = P;
// 4551 %repeat
L_03F1:;
goto L_03ED;
L_03EF:;
// 4552 %end
return;
} /* end of SETFIRSTENTRY */
// 4553
// 4554 %routine DEFINE ENTRY(%integer chain,entry,pid)
void DEFINEENTRY(int CHAIN, int ENTRY, int PID) {
// 4555 %integer j
int J;
// 4556 %cycle
L_03F8:;
// 4557 chain = chain<<1
CHAIN = CHAIN << 1;
// 4558 report(reacherr,pid,0) %unless is short(entry-chain)=TRUE
if (ISSHORT(ENTRY - CHAIN) == 1) goto L_03F9;
REPORT(4, PID, 0);
L_03F9:;
// 4559 j = code word(chain)&16_FFFF
J = CODEWORD(CHAIN) & 65535;
// 4560 !$IF VAX
// 4561 { final(chain) <- (entry-chain)>>8; final(chain+1) <- entry-chain
// 4562 !$IF APM
// 4563 shortinteger(final0+chain) <- entry-chain
*_imp_SHORTINTEGER(FINAL0 + CHAIN) = (short int)(ENTRY - CHAIN);
// 4564 !$FINISH
// 4565 chain = j
CHAIN = J;
// 4566 %repeat %until chain = 0
if (CHAIN == 0) goto L_03FA;
goto L_03F8;
L_03FA:;
// 4567 %end
return;
} /* end of DEFINEENTRY */
// 4568
// 4569 %routine CHECK REACH(%integer blocksize)
void CHECKREACH(int BLOCKSIZE) {
// 4570 !Add stepping stones if necessary
// 4571 %integer i
int I;
// 4572 %cycle
L_03FB:;
// 4573 i = blocksize+cad
I = BLOCKSIZE + CAD;
// 4574 croak("Program too big") %if i >= ownbase
if (I < OWNBASE) goto L_03FC;
CROAK(_imp_str_literal("Program too big"));
L_03FC:;
// 4575 %return %if i-firstentry < 31000; !enough leeway
if (I - FIRSTENTRY >= 31000) goto L_03FD;
return;
L_03FD:;
// 4576 %return %if blocksize >= 32000 %or cad-firstentry >= 32760; !hopeless
if (BLOCKSIZE >= 32000) goto L_03FE;
if (CAD - FIRSTENTRY < 32760) goto L_03FF;
L_03FE:;
return;
L_03FF:;
// 4577 %if dict(firstpos)_val < 0 %start
if (DICT[FIRSTPOS].VAL >= 0) goto L_0400;
// 4578 define entry(-dict(firstpos)_val,cad,firstpos)
DEFINEENTRY(-DICT[FIRSTPOS].VAL, CAD, FIRSTPOS);
// 4579 set code word(16_6000); !BRA
SETCODEWORD(24576);
// 4580 dict(firstpos)_val = -cad>>1
DICT[FIRSTPOS].VAL = -((unsigned int)CAD >> 1);
// 4581 set code word(0)
SETCODEWORD(0);
// 4582 %else
goto L_0401;
L_0400:;
// 4583 dict(firstpos)_val = cad
DICT[FIRSTPOS].VAL = CAD;
// 4584 set code word(16_6000); !BRA
SETCODEWORD(24576);
// 4585 set code word(firstentry-cad)
SETCODEWORD(FIRSTENTRY - CAD);
// 4586 %finish
L_0401:;
// 4587 steps = steps+2
STEPS = STEPS + 2;
// 4588 set first entry
SETFIRSTENTRY();
// 4589 %repeat
goto L_03FB;
// 4590 %end
} /* end of CHECKREACH */
// 4591
// 4592 %routine PUT WORD(%integer v)
void PUTWORD(int V) {
// 4593 printsymbol(v>>8&255); printsymbol(v&255)
_imp_PRINTSYMBOL((unsigned int)V >> 8 & 255);
_imp_PRINTSYMBOL(V & 255);
// 4594 %end
return;
} /* end of PUTWORD */
// 4595
// 4596 %routine DO EXTERNALS(%integer chain,specs)
void DOEXTERNALS(int CHAIN, int SPECS) {
// 4597 %integer k,a,b
int K;
int A;
int B;
// 4598 %record(identinfo)%name dp,tp
struct IDENTINFO *DP;
struct IDENTINFO *TP;
// 4599
// 4600 byteinteger(charlim) = 0; ![see test for %alias]
*_imp_BYTEINTEGER(CHARLIM) = 0;
// 4601 value = 2
VALUE = 2;
// 4602 %cycle
L_0402:;
// 4603 dp == dict(chain)
DP = (struct IDENTINFO *)/*?*/ &DICT[CHAIN];
// 4604 a = dp_text+char0; b = byteinteger(a)
A = DP->TEXT + CHAR0;
B = *_imp_BYTEINTEGER(A);
// 4605 %if byteinteger(a+b+1)&128 # 0 %start; !aliased
if (*_imp_BYTEINTEGER(A + B + 1) & 128 == 0) goto L_0403;
// 4606 a = a+b+1; b = byteinteger(a)-128
A = A + B + 1;
B = *_imp_BYTEINTEGER(A) - 128;
// 4607 %finish
L_0403:;
// 4608 value = value+(b+14)&(\1)
VALUE = VALUE + (B + 14 & (~1));
// 4609 %if specs >= 0 %start; !for real
if (SPECS < 0) goto L_0404;
// 4610 put word(dp_flags&(ext+proc)!sign16)
PUTWORD(DP->FLAGS & 16384 + 12288 | (-32768));
// 4611 put word(dp_mode)
PUTWORD(DP->MODE);
// 4612 k = 0
K = 0;
// 4613 %if dp_flags&proc # 0 %start
if (DP->FLAGS & 12288 == 0) goto L_0405;
// 4614 !create type word
// 4615 tp == dict(dp_type)
TP = (struct IDENTINFO *)/*?*/ &DICT[DP->TYPE];
// 4616 k = 4; k = 6 %if tp_type # 0; !100:R 11x:F,M
K = 4;
if (TP->TYPE == 0) goto L_0406;
K = 6;
L_0406:;
// 4617 %cycle
L_0407:;
// 4618 k = k+1 %if tp_reg&8 # 0; !0:dreg, 1:areg
if (TP->REG & 8 == 0) goto L_0408;
K = K + 1;
L_0408:;
// 4619 %exit %if tp_link <= 0
if (TP->LINK > 0) goto L_0409;
goto L_040A;
L_0409:;
// 4620 tp == dict(tp_link); k = k<<1
TP = (struct IDENTINFO *)/*?*/ &DICT[TP->LINK];
K = K << 1;
// 4621 %repeat
goto L_0407;
L_040A:;
// 4622 !special code (11) for %routine ...(%string(255) parm)
// 4623 k = k+2 %if k = 9 %and tp_type = stringtype %and tp_flags >= 0
if (K != 9) goto L_040B;
if (TP->TYPE != 64) goto L_040B;
if (TP->FLAGS < 0) goto L_040B;
K = K + 2;
L_040B:;
// 4624 %finish
L_0405:;
// 4625 put word(k>>16); put word(k)
PUTWORD((unsigned int)K >> 16);
PUTWORD(K);
// 4626 put word(dp_val>>16); put word(dp_val)
PUTWORD((unsigned int)DP->VAL >> 16);
PUTWORD(DP->VAL);
// 4627 put word(b<<8+byteinteger(a+1))
PUTWORD((B << 8) + *_imp_BYTEINTEGER(A + 1));
// 4628 %cycle
L_040C:;
// 4629 a = a+2; b = b-2
A = A + 2;
B = B - 2;
// 4630 %exit %if b < 0
if (B >= 0) goto L_040D;
goto L_040E;
L_040D:;
// 4631 k = byteinteger(a)<<8
K = *_imp_BYTEINTEGER(A) << 8;
// 4632 k = k+byteinteger(a+1) %if b > 0
if (B <= 0) goto L_040F;
K = K + *_imp_BYTEINTEGER(A + 1);
L_040F:;
// 4633 put word(k)
PUTWORD(K);
// 4634 %repeat
goto L_040C;
L_040E:;
// 4635 %finish
L_0404:;
// 4636 chain = dp_link
CHAIN = DP->LINK;
// 4637 %repeat %until chain = 0
if (CHAIN == 0) goto L_0410;
goto L_0402;
L_0410:;
// 4638 %if specs >= 0 %start
if (SPECS < 0) goto L_0411;
// 4639 put word(0)
PUTWORD(0);
// 4640 put word(0) %if value&3 # 0
if (VALUE & 3 == 0) goto L_0412;
PUTWORD(0);
L_0412:;
// 4641 %finish
L_0411:;
// 4642 value = (value+3)&(\3)
VALUE = VALUE + 3 & (~3);
// 4643 %end
return;
} /* end of DOEXTERNALS */
// 4644 !
// 4645 %routine PUTACT(%integer act,x,y)
void PUTACT(int ACT, int X, int Y) {
// 4646 dict(np)_act = act; dict(np)_x = x; dict(np)_y = y
DICT[NP].ACT = ACT;
DICT[NP].X = X;
DICT[NP].Y = Y;
// 4647 np = np+1
NP = NP + 1;
// 4648 %end
return;
} /* end of PUTACT */
// 4649
// 4650 %routine COMPILE END
void COMPILEEND(void) {
// 4651 %integer i,j,x,y,entry,lim
int I;
int J;
int X;
int Y;
int ENTRY;
int LIM;
// 4652 %if c_reg_line # line %and control&(diagbit!linebit!tracebit) # 0 %c
if (C.REG.LINE == LINE) goto L_0413;
if (CONTROL & (4194304 | 8388608 | 2097152) == 0) goto L_0413;
if (LEVEL <= 0) goto L_0413;
if (C.ACCESS == 0) goto L_0413;
// 4653+ %and level > outerlevel %and c_access # 0 %start
// 4654 pendcond = -1
PENDCOND = -1;
// 4655 flush
FLUSH();
// 4656 %finish
L_0413:;
// 4657 !Pop event block
// 4658 %if c_eventsp # 0 %start
if (C.EVENTSP == 0) goto L_0414;
// 4659 plant(move,temp(c_mode,c_eventsp),gb+indir)
PLANT(1, TEMP(C.MODE, C.EVENTSP), 14 + 8);
// 4660 forget cc
FORGETCC();
// 4661 %finish
L_0414:;
// 4662 !Put pre-amble
// 4663 codeflag = '^'; x = pc; !preserve
CODEFLAG = 94;
X = PC;
// 4664 putact(end,0,0)
PUTACT(50, 0, 0);
// 4665 compile(np0)
COMPILE(NP0);
// 4666 fill code(1) %if cad&1 # 0
if (CAD & 1 == 0) goto L_0415;
FILLCODE(1);
L_0415:;
// 4667 check reach((pc-c_localpc)<<1)
CHECKREACH(PC - C.LOCALPC << 1);
// 4668 entry = cad
ENTRY = CAD;
// 4669 y = x
Y = X;
// 4670 %while y < pc %cycle
L_0416:;
if (Y >= PC) goto L_0417;
// 4671 %if pflag(y) = indglobal %then set code word(dict(prog(y))_val-cad) %c
if (PFLAG[Y] != 7) goto L_0418;
SETCODEWORD(DICT[PROG[Y]].VAL - CAD);
goto L_0419;
L_0418:;
SETCODEWORD(PROG[Y]);
L_0419:;
// 4672+ %else set code word(prog(y))
// 4673 y = y+1
Y = Y + 1;
// 4674 %repeat
goto L_0416;
L_0417:;
// 4675 codeflag = ' '; pc = x; !restore
CODEFLAG = 32;
PC = X;
// 4676 !Generate final sequence
// 4677 %if c_access # 0 %start
if (C.ACCESS == 0) goto L_041A;
// 4678 %if level > outerlevel %and c_status&globbed # 0 %start
if (LEVEL <= 0) goto L_041B;
if (C.STATUS & 16 == 0) goto L_041B;
// 4679 %if level > 1 %start; !display in store
if (LEVEL <= 1) goto L_041C;
// 4680 plant(move,tempd(gb,level<<2),a7); !MOVE ?(GB),SP
PLANT(1, TEMPD(14, LEVEL << 2), 16);
// 4681 plant(move,posta7,tempd(gb,level<<2)); !MOVE (SP)+,?(GB)
PLANT(1, 32, TEMPD(14, LEVEL << 2));
// 4682 forget cc
FORGETCC();
// 4683 %else
goto L_041D;
L_041C:;
// 4684 plant(unlk,0,f1)
PLANT(73, 0, 15);
// 4685 %finish
L_041D:;
// 4686 %finish %else %if c_sp < 0 %start; !some stack extension
goto L_041E;
L_041B:;
if (C.SP >= 0) goto L_041F;
// 4687 addimm(-c_sp,a7)
ADDIMM(-C.SP, 16);
// 4688 %finish
L_041F:;
L_041E:;
// 4689 %if level > outerlevel %start
if (LEVEL <= 0) goto L_0420;
// 4690 c_dpid_flags = c_dpid_flags!okflag %if c_type > 0 %c
if (C.TYPE <= 0) goto L_0421;
if (C.STATUS & 4 | C.REG.CCX | C.REG.CCY != 0) goto L_0421;
C.DPID->FLAGS = C.DPID->FLAGS | 64;
L_0421:;
// 4691+ %and c_status&wrongcc!c_reg_ccx!c_reg_ccy = 0
// 4692 plant(rts,0,0)
PLANT(68, 0, 0);
// 4693 %else
goto L_0422;
L_0420:;
// 4694 plant(move,0,d0); srcall(signal); !%stop
PLANT(1, 0, 1);
SRCALL(73);
// 4695 %finish
L_0422:;
// 4696 %else; !no return from procedure
goto L_0423;
L_041A:;
// 4697 c_dpid_flags = c_dpid_flags!noret
C.DPID->FLAGS = C.DPID->FLAGS | 64;
// 4698 %finish
L_0423:;
// 4699 !Set start address
// 4700 x = c_dpid_val
X = C.DPID->VAL;
// 4701 define entry(-x,entry,c_pid) %if x < 0; !forward refs in FINAL
if (X >= 0) goto L_0424;
DEFINEENTRY(-X, ENTRY, C.PID);
L_0424:;
// 4702 c_dpid_val = entry
C.DPID->VAL = ENTRY;
// 4703 !
// 4704 lim = cad+(pc-c_localpc-c_shorts+zeroshorts)<<1
LIM = CAD + (PC - C.LOCALPC - C.SHORTS + 8 << 1);
// 4705 x = c_localpc; c_shorts = zeroshorts; !reset
X = C.LOCALPC;
C.SHORTS = 8;
// 4706 %while x < pc %cycle
L_0425:;
if (X >= PC) goto L_0426;
// 4707 y = prog(x); j = pflag(x)
Y = PROG[X];
J = PFLAG[X];
// 4708 %if j # 0 %start
if (J == 0) goto L_0427;
// 4709 %if j < zeroshorts %start
if (J >= 8) goto L_0428;
// 4710 %if j <= longjump %start; !shortjump/jump/longjump
if (J > 3) goto L_0429;
// 4711 jumps = jumps+1
JUMPS = JUMPS + 1;
// 4712 y = (y-pflag(y)-x+c_shorts)<<1
Y = Y - PFLAG[Y] - X + C.SHORTS << 1;
// 4713 %if j = shortjump %start
if (J != 1) goto L_042A;
// 4714 cad = cad-2
CAD = CAD - 2;
// 4715 y = prog(x-1)+y&255
Y = PROG[X - 1] + (Y & 255);
// 4716 c_shorts = c_shorts+1
C.SHORTS = C.SHORTS + 1;
// 4717 %finish
L_042A:;
// 4718 %finish %else %if j = indglobal %start; !procedure
goto L_042B;
L_0429:;
if (J != 7) goto L_042C;
// 4719 i = dict(y)_val
I = DICT[Y].VAL;
// 4720 %if i <= 0 %start; !not yet encountered
if (I > 0) goto L_042D;
// 4721 dict(y)_val = -(cad>>1); y = -i
DICT[Y].VAL = -((unsigned int)CAD >> 1);
Y = -I;
// 4722 %else
goto L_042E;
L_042D:;
// 4723 i = i-cad
I = I - CAD;
// 4724 report(reacherr,y,0) %unless is short(i)=TRUE
if (ISSHORT(I) == 1) goto L_042F;
REPORT(4, Y, 0);
L_042F:;
// 4725 y = i
Y = I;
// 4726 %finish
L_042E:;
// 4727 %else {global,negglobal,bigglobal}
goto L_042B;
L_042C:;
// 4728 %if j # global+1 %start
if (J == 4 + 1) goto L_0430;
// 4729 y = y&16_FFFF
Y = Y & 65535;
// 4730 y = y+65536 %if j # global; !bigglobal
if (J == 4) goto L_0431;
Y = Y + 65536;
L_0431:;
// 4731 %finish
L_0430:;
// 4732 y = y-cad
Y = Y - CAD;
// 4733 %unless is short(y)=TRUE %start
if (ISSHORT(Y) == 1) goto L_0432;
// 4734 %if prog(x-1)&16_F1FF # 16_41FA %start; !LEA (PC),Ax
if (PROG[X - 1] & 61951 == 16890) goto L_0433;
// 4735 report(creacherr,0,cad)
REPORT(3, 0, CAD);
// 4736 %else
goto L_0434;
L_0433:;
// 4737 i = cad; cad = lim
I = CAD;
CAD = LIM;
// 4738 set code word(prog(x-1)!!(16_41FA!!16_207C)); !MOVEI #,Ax
SETCODEWORD(PROG[X - 1] ^ (16890 ^ 8316));
// 4739 set code longword(y-2)
SETCODELONGWORD(Y - 2);
// 4740 set code word(prog(x-1)!!(16_41FA!!16_D1D7)); !ADD (SP),Ax
SETCODEWORD(PROG[X - 1] ^ (16890 ^ 53719));
// 4741 set code word(16_4E75); !RTS
SETCODEWORD(20085);
// 4742 lim = cad; cad = i-2
LIM = CAD;
CAD = I - 2;
// 4743 set code word(16_6100); !BSR
SETCODEWORD(24832);
// 4744 y = lim-10-cad
Y = LIM - 10 - CAD;
// 4745 steps = steps+5
STEPS = STEPS + 5;
// 4746 %finish
L_0434:;
// 4747 %finish
L_0432:;
// 4748 %finish
L_042B:;
// 4749 %finish
L_0428:;
// 4750 %finish
L_0427:;
// 4751 !$IF VAX
// 4752 { final(cad) <- y>>8; final(cad+1) <- y
// 4753 !$IF APM
// 4754 shortinteger(final0+cad) <- y
*_imp_SHORTINTEGER(FINAL0 + CAD) = (short int)(Y);
// 4755 !$FINISH
// 4756 cad = cad+2
CAD = CAD + 2;
// 4757 x = x+1
X = X + 1;
// 4758 %repeat
goto L_0425;
L_0426:;
// 4759 cad = lim
CAD = LIM;
// 4760 forget all
FORGETALL();
// 4761 %end; !compile end
return;
} /* end of COMPILEEND */
// 4762
// 4763 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 4764 !!!!!!!!!!!!!!! end of Code Generation !!!!!!!!!!!!!!!!!!!!!!!
// 4765 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 4766 !
// 4767 !<<IMP
// 4768 %routine TOPRED
void TOPRED(void) {
// 4769 item = litref(value) %if item = 0
if (ITEM != 0) goto L_0435;
ITEM = LITREF(VALUE);
L_0435:;
// 4770 putact(compare,item,0)
PUTACT(4, ITEM, 0);
// 4771 condop = bne!!polarity
CONDOP = 22 ^ POLARITY;
// 4772 item = np-1
ITEM = NP - 1;
// 4773 %end
return;
} /* end of TOPRED */
// 4774 !<<BOTH
// 4775 !
// 4776 %routine RESET CONTEXT(%integer pid,free)
void RESETCONTEXT(int PID, int FREE) {
// 4777 starts = 0; cycles = 0
STARTS = 0;
CYCLES = 0;
// 4778 c = 0
C = (struct BLOCKINF){0};
// 4779 forget all
FORGETALL();
// 4780 c_localdpos = dlim; c_parlim = dlim; c_localtext = charlim
C.LOCALDPOS = DLIM;
C.PARLIM = DLIM;
C.LOCALTEXT = CHARLIM;
// 4781 c_localpc = pc; c_localswpc = swpc; c_lab1 = curlab
C.LOCALPC = PC;
C.LOCALSWPC = SWPC;
C.LAB1 = CURLAB;
// 4782 c_shorts = zeroshorts; c_free = free
C.SHORTS = 8;
C.FREE = FREE;
// 4783 c_mode = framemode+level; c_vintage = vintage
C.MODE = 168 + LEVEL;
C.VINTAGE = VINTAGE;
// 4784 c_pid = pid; c_dpid == dict(c_pid)
C.PID = PID;
C.DPID = (struct BLOCKINF *)/*?*/ &DICT[C.PID];
// 4785 %end
return;
} /* end of RESETCONTEXT */
// 4786
// 4787 %routine OPEN BLOCK(%integer pid)
void OPENBLOCK(int PID) {
// 4788 forget regs; !a bit extreme, but don't want to let LIT/EXP
FORGETREGS();
// 4789 ! get out of hand so RESET CONTEXT forgets triples
// 4790 croak("Too many levels") %if level = maxlevel
if (LEVEL != 7) goto L_0436;
CROAK(_imp_str_literal("Too many levels"));
L_0436:;
// 4791 c_oldcontrol = control
C.OLDCONTROL = CONTROL;
// 4792 hold(level) = c; level = level+1; vintage = vintage+1
HOLD[LEVEL] = C;
LEVEL = LEVEL + 1;
VINTAGE = VINTAGE + 1;
// 4793 reset context(pid,c_free)
RESETCONTEXT(PID, C.FREE);
// 4794 c_access = 1; c_localad = cad-accounted
C.ACCESS = 1;
C.LOCALAD = CAD - ACCOUNTED;
// 4795 %end; !OPEN BLOCK
return;
} /* end of OPENBLOCK */
// 4796
// 4797 %integerfn PARMATCH(%integer apos,bpos)
int PARMATCH(int APOS, int BPOS) {
// 4798 %record(identinfo)%name ap,bp,atp,btp
struct IDENTINFO *AP;
struct IDENTINFO *BP;
struct IDENTINFO *ATP;
struct IDENTINFO *BTP;
// 4799 %cycle
L_0437:;
// 4800 ap == dict(apos); bp == dict(bpos)
AP = (struct IDENTINFO *)/*?*/ &DICT[APOS];
BP = (struct IDENTINFO *)/*?*/ &DICT[BPOS];
// 4801 %result = FALSE %if ap_flags!!bp_flags < 0
if (AP->FLAGS ^ BP->FLAGS >= 0) goto L_0438;
return 0;
L_0438:;
// 4802 {%result = FALSE %if ap_mode # bp_mode}
// 4803 %if ap_type # bp_type %start
if (AP->TYPE == BP->TYPE) goto L_0439;
// 4804 ![for now -- nominal]
// 4805 atp == typecell(ap_type); btp == typecell(bp_type)
ATP = (struct IDENTINFO *)TYPECELL(AP->TYPE);
BTP = (struct IDENTINFO *)TYPECELL(BP->TYPE);
// 4806 %result = FALSE %unless atp_flags&cat = arry = btp_flags&cat
{
// Double-sided test on 9 (Part I)
int tmp;
if (ATP->FLAGS & 15 != (tmp = 9)) goto L_043A;
// Double-sided test on 9 (Part II)
if (tmp == BTP->FLAGS & 15) goto L_043B;
}
L_043A:;
return 0;
L_043B:;
// 4807 %finish
L_0439:;
// 4808 apos = ap_link; bpos = bp_link
APOS = AP->LINK;
BPOS = BP->LINK;
// 4809 %if apos = 0 %start
if (APOS != 0) goto L_043C;
// 4810 %result = FALSE %if bpos # 0
if (BPOS == 0) goto L_043D;
return 0;
L_043D:;
// 4811 %result = TRUE
return 1;
// 4812 %finish %else %if bpos = 0 %start
L_043C:;
if (BPOS != 0) goto L_043E;
// 4813 %result = FALSE
return 0;
// 4814 %finish
L_043E:;
// 4815 %repeat
goto L_0437;
// 4816 %end
} /* end of PARMATCH */
// 4817
// 4818 %integer%fn CRUNCHED(%integer p)
int CRUNCHED(int P) {
// 4819 %record(identinfo)%name dq,dp
struct IDENTINFO *DQ;
struct IDENTINFO *DP;
// 4820 %owninteger q=0,l=0
static int Q = 0;
static int L = 0;
// 4821 dp==dict(p)
DP = (struct IDENTINFO *)/*?*/ &DICT[P];
// 4822 dp_text = 0; q = 0
DP->TEXT = 0;
Q = 0;
// 4823 l = dp_link
L = DP->LINK;
// 4824 %if l # 0 %start
if (L == 0) goto L_043F;
// 4825 l = crunched(l) %if dp_type < p
if (DP->TYPE >= P) goto L_0440;
L = CRUNCHED(L);
L_0440:;
// 4826 %result = p %if p <= l
if (P > L) goto L_0441;
return P;
L_0441:;
// 4827 dp_link = l
DP->LINK = L;
// 4828 q = l-1
Q = L - 1;
// 4829 %finish
L_043F:;
// 4830 dq == dict(q)
DQ = (struct IDENTINFO *)/*?*/ &DICT[Q];
// 4831 %while q < p %cycle
L_0442:;
if (Q >= P) goto L_0443;
// 4832 %if dq_type = dp_type %c
if (DQ->TYPE != DP->TYPE) goto L_0444;
if (DQ->LINK != L) goto L_0444;
if (DQ->REG != DP->REG) goto L_0444;
if (DQ->VAL != DP->VAL) goto L_0444;
// 4833+ %and dq_link = l %and dq_reg = dp_reg %and dq_val = dp_val %start
// 4834 dlim = p
DLIM = P;
// 4835 %result = q
return Q;
// 4836 %finish
L_0444:;
// 4837 q = q+1; dq == dict(q)
Q = Q + 1;
DQ = (struct IDENTINFO *)/*?*/ &DICT[Q];
// 4838 %repeat
goto L_0442;
L_0443:;
// 4839 %result = p
return P;
// 4840 %end
} /* end of CRUNCHED */
// 4841
// 4842 %routine POP CONTEXT
void POPCONTEXT(void) {
// 4843 pc = c_localpc; swpc = c_localswpc; curlab = c_lab1
PC = C.LOCALPC;
SWPC = C.LOCALSWPC;
CURLAB = C.LAB1;
// 4844 dlim = c_parlim
DLIM = C.PARLIM;
// 4845 ! %for i = 0,1,255 %cycle
// 4846 ! hashindex(i) = dict(hashindex(i))_hlink %while hashindex(i) >= c_localdpos
// 4847 ! %repeat
// 4848 %if level > outerlevel %start
if (LEVEL <= 0) goto L_0445;
// 4849 charlim = c_localtext
CHARLIM = C.LOCALTEXT;
// 4850 ranges = dict(ranges)_hlink %while ranges >= c_parlim
L_0446:;
if (RANGES < C.PARLIM) goto L_0447;
RANGES = DICT[RANGES].HLINK;
goto L_0446;
L_0447:;
// 4851 c_dpid_type = crunched(c_dpid_type)
C.DPID->TYPE = CRUNCHED(C.DPID->TYPE);
// 4852 level = level-1; c = hold(level)
LEVEL = LEVEL - 1;
C = HOLD[LEVEL];
// 4853 control = control&editbit ! c_oldcontrol&(\editbit)
CONTROL = CONTROL & 8192 | C.OLDCONTROL & (~8192);
// 4854 %finish
L_0445:;
// 4855 dictshown = dlim %if dictshown > dlim
if (DICTSHOWN <= DLIM) goto L_0448;
DICTSHOWN = DLIM;
L_0448:;
// 4856 starts = 0; cycles = 0
STARTS = 0;
CYCLES = 0;
// 4857 %end
return;
} /* end of POPCONTEXT */
// 4858
// 4859 %routine FIXUP SWITCH VECTOR(%integer pos,%record(identinfo)%name dp)
void FIXUPSWITCHVECTOR(int POS, struct IDENTINFO *DP) {
// 4860 %integer x,y,j,default,temp,lo,hi
int X;
int Y;
int J;
int DEFAULT;
int TEMP;
int LO;
int HI;
// 4861 %record(identinfo)%name tp
struct IDENTINFO *TP;
// 4862 tp==typecell(dp_type)
TP = (struct IDENTINFO *)TYPECELL(DP->TYPE);
// 4863 x = dp_val
X = DP->VAL;
// 4864 default = dp_link; default = pc %if default = 0
DEFAULT = DP->LINK;
if (DEFAULT != 0) goto L_0449;
DEFAULT = PC;
L_0449:;
// 4865 get bounds(tp_xtype,lo,hi)
GETBOUNDS(TP->XTYPE, /*?*/ &LO, /*?*/ &HI);
// 4866 %if dp_flags&arrflag = 0 %then j = pflag(x-1)+lo %c
if (DP->FLAGS & 8 != 0) goto L_044A;
J = PFLAG[X - 1] + LO;
goto L_044B;
L_044A:;
J = PFLAG[X - 7];
L_044B:;
// 4867+ %else j = pflag(x-7); !allow for dope info
// 4868 j = x-j; !base position
J = X - J;
// 4869 %while lo <= hi %cycle; !For each element
L_044C:;
if (LO > HI) goto L_044D;
// 4870 y = prog(x)
Y = PROG[X];
// 4871 %if y <= 0 %start; !not set
if (Y > 0) goto L_044E;
// 4872 %if dp_link = 0 %start; !no default
if (DP->LINK != 0) goto L_044F;
// 4873 report(slabmissing+warn,pos,lo)
REPORT(46 + (-128), POS, LO);
// 4874 c_access = 1
C.ACCESS = 1;
// 4875 %finish
L_044F:;
// 4876 %if y < 0 %start; !explicit jump(s) to this one
if (Y >= 0) goto L_0450;
// 4877 y = -y
Y = -Y;
// 4878 %cycle; !define jumps to default
L_0451:;
// 4879 temp = y; y = prog(temp); prog(temp) = default
TEMP = Y;
Y = PROG[TEMP];
PROG[TEMP] = DEFAULT;
// 4880 %repeat %until y = 0
if (Y == 0) goto L_0452;
goto L_0451;
L_0452:;
// 4881 %finish
L_0450:;
// 4882 y = default
Y = DEFAULT;
// 4883 %finish
L_044E:;
// 4884 prog(x) = (y-pflag(y)-j)<<1
PROG[X] = Y - PFLAG[Y] - J << 1;
// 4885 x = x+1; lo = lo+1
X = X + 1;
LO = LO + 1;
// 4886 %repeat
goto L_044C;
L_044D:;
// 4887 %end
return;
} /* end of FIXUPSWITCHVECTOR */
// 4888
// 4889 %routine CLOSE BLOCK
void CLOSEBLOCK(void) {
// 4890 %integer miss,under,pos,base
int MISS;
int UNDER;
int POS;
int BASE;
// 4891 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 4892 ! WRONGCC is clear if all %result statements leave correct CC
// 4893 %if c_type > 0 %and c_status&wrongcc = 0 %start
if (C.TYPE <= 0) goto L_0453;
if (C.STATUS & 4 != 0) goto L_0453;
// 4894 ! set special values and see if they survive exit sequence
// 4895 c_reg_ccx = 0; c_reg_ccy = 0
C.REG.CCX = 0;
C.REG.CCY = 0;
// 4896 %finish
L_0453:;
// 4897 %if c_return # 0 %start
if (C.RETURN == 0) goto L_0454;
// 4898 %if c_return = -(pc-1) %and c_access = 0 %start
if (C.RETURN != -(PC - 1)) goto L_0455;
if (C.ACCESS != 0) goto L_0455;
// 4899 c_return = -prog(pc-1); pc = pc-2
C.RETURN = -PROG[PC - 1];
PC = PC - 2;
// 4900 %finish
L_0455:;
// 4901 define jumps(c_return); !must precede switch fixup
DEFINEJUMPS(C.RETURN);
// 4902 c_access = -1
C.ACCESS = -1;
// 4903 %finish
L_0454:;
// 4904 pflag(pc) = c_shorts; !in case of terminal switch labels
PFLAG[PC] = C.SHORTS;
// 4905 %if c_status&hadswitch # 0 %start
if (C.STATUS & 128 == 0) goto L_0456;
// 4906 pos = c_localdpos
POS = C.LOCALDPOS;
// 4907 %while pos < dlim %cycle
L_0457:;
if (POS >= DLIM) goto L_0458;
// 4908 dp == dict(pos)
DP = (struct IDENTINFO *)/*?*/ &DICT[POS];
// 4909 fixup switch vector(pos,dp) %if dp_mode = labmode %and dp_type # 0
if (DP->MODE != 186) goto L_0459;
if (DP->TYPE == 0) goto L_0459;
FIXUPSWITCHVECTOR(POS, DP);
L_0459:;
// 4910 pos = pos+1
POS = POS + 1;
// 4911 %repeat
goto L_0457;
L_0458:;
// 4912 %finish
L_0456:;
// 4913 compile end
COMPILEEND();
// 4914 c_totstack = c_totstack-c_extra
C.TOTSTACK = C.TOTSTACK - C.EXTRA;
// 4915 c_totstack = -c_totstack %if c_status&unknown = 0; !positive if firm
if (C.STATUS & 2 != 0) goto L_045A;
C.TOTSTACK = -C.TOTSTACK;
L_045A:;
// 4916 typecell(c_dpid_type)_val = c_totstack
TYPECELL(C.DPID->TYPE)->VAL = C.TOTSTACK;
// 4917 {?} %if control&maplist # 0 %start
if (CONTROL & 4 == 0) goto L_045B;
// 4918 {?} put ident(c_pid,0)
PUTIDENT(C.PID, 0);
// 4919 {?} mark at(20)
MARKAT(20);
// 4920 {?} put string(" code:")
PUTSTRING(_imp_str_literal(" code:"));
// 4921 {?} put num(cad-c_localad-accounted)
PUTNUM(CAD - C.LOCALAD - ACCOUNTED);
// 4922 {?} put string(" entry:")
PUTSTRING(_imp_str_literal(" entry:"));
// 4923 {?} put num(c_dpid_val-c_localad-accounted)
PUTNUM(C.DPID->VAL - C.LOCALAD - ACCOUNTED);
// 4924 {?} put string(" stack:"); put num(-c_stack)
PUTSTRING(_imp_str_literal(" stack:"));
PUTNUM(-C.STACK);
// 4925 {?} putsym('/'); put num(imod(c_totstack))
PUTSYM(47);
PUTNUM(_imp_IMOD(C.TOTSTACK));
// 4926 {?} put sym('+') %if c_totstack < 0
if (C.TOTSTACK >= 0) goto L_045C;
PUTSYM(43);
L_045C:;
// 4927 {?} accounted = cad-c_localad
ACCOUNTED = CAD - C.LOCALAD;
// 4928 {?} print line
PRINTLINE();
// 4929 {?} %finish
L_045B:;
// 4930 !Check identifier usage
// 4931 miss = 0; under = 0
MISS = 0;
UNDER = 0;
// 4932 base = c_localdpos; base = 0 %if level = outerlevel
BASE = C.LOCALDPOS;
if (LEVEL != 0) goto L_045D;
BASE = 0;
L_045D:;
// 4933 pos = dlim; dp == dict(pos)
POS = DLIM;
DP = (struct IDENTINFO *)/*?*/ &DICT[POS];
// 4934 %while pos > base %cycle
L_045E:;
if (POS <= BASE) goto L_045F;
// 4935 pos = pos-1; dp == dict(pos)
POS = POS - 1;
DP = (struct IDENTINFO *)/*?*/ &DICT[POS];
// 4936 %if dp_flags&ext = 0 %start
if (DP->FLAGS & 16384 != 0) goto L_0460;
// 4937 !<<IMP
// 4938 !<<BOTH
// 4939 %if dp_text > 0 %start; !user id
if (DP->TEXT <= 0) goto L_0461;
// 4940 set hashhead(string(dp_text+char0))
SETHASHHEAD((_imp_string255 *)/*p*/ _imp_STRING(DP->TEXT + CHAR0));
// 4941 %if head = pos %start; !still active
if (*HEAD != POS) goto L_0462;
// 4942 head = dp_hlink; !remove from hash list
*HEAD = DP->HLINK;
// 4943 check: %if dp_flags&spec # 0 %start
U_1026:;
if (DP->FLAGS & 256 == 0) goto L_0463;
// 4944 dp_hlink = miss; miss = pos
DP->HLINK = MISS;
MISS = POS;
// 4945 %finish %else %if ((dp_flags&(readable+rflag) = readable %and dp_mode # litmode) %c
goto L_0464;
L_0463:;
if (DP->FLAGS & 2 + 32 != 2) goto L_0465;
if (DP->MODE != 60) goto L_0466;
L_0465:;
if (DP->FLAGS & 1 + 64 + 16 + 256 != 1) goto L_0467;
L_0466:;
if (POS < C.LOCALDPOS) goto L_0467;
if (DP->MODE == 0) goto L_0467;
if (DP->FLAGS & 512 != 0) goto L_0467;
if (CONTROL & (1 | 4) == 0) goto L_0467;
// 4946+ %or (dp_flags&(writable+okflag+wflag+spec) = writable)) %c
// 4947+ %and pos >= c_localdpos %and dp_mode # 0 %and dp_flags&typeid = 0 %c
// 4948+ %and control&(list!maplist) # 0 %start
// 4949 dp_hlink = under; under = pos
DP->HLINK = UNDER;
UNDER = POS;
// 4950 %finish
L_0467:;
L_0464:;
// 4951 %finish
L_0462:;
// 4952 %finish
L_0461:;
// 4953 %finish %else %if level = outerlevel %start; !external, external spec
goto L_0468;
L_0460:;
if (LEVEL != 0) goto L_0469;
// 4954 %if dp_flags&spec = 0 %start; !external object
if (DP->FLAGS & 256 != 0) goto L_046A;
// 4955 dp_link = externs; externs = pos
DP->LINK = EXTERNS;
EXTERNS = POS;
// 4956 %finish %else %if dp_flags&(rflag+wflag) # 0 %start
goto L_046B;
L_046A:;
if (DP->FLAGS & 32 + 16 == 0) goto L_046C;
// 4957 !external spec (used)
// 4958 dp_link = extspecs; extspecs = pos
DP->LINK = EXTSPECS;
EXTSPECS = POS;
// 4959 %finish
L_046C:;
L_046B:;
// 4960 %finish
L_0469:;
L_0468:;
// 4961 %repeat
goto L_045E;
L_045F:;
// 4962 report(idmissing,miss,0) %if miss # 0
if (MISS == 0) goto L_046D;
REPORT(47, MISS, 0);
L_046D:;
// 4963 %if under # 0 %and c_faults = 0 %start
if (UNDER == 0) goto L_046E;
if (C.FAULTS != 0) goto L_046E;
// 4964 put ident(under,1)
PUTIDENT(UNDER, 1);
// 4965 put string(" underused")
PUTSTRING(_imp_str_literal(" underused"));
// 4966 print line
PRINTLINE();
// 4967 %finish
L_046E:;
// 4968 pop context
POPCONTEXT();
// 4969 set first entry %if firstpos >= dlim
if (FIRSTPOS < DLIM) goto L_046F;
SETFIRSTENTRY();
L_046F:;
// 4970 %end;
return;
} /* end of CLOSEBLOCK */
// ?CHECK unused
// 4971 ; !CLOSE BLOCK
// 4971
// 4972 %routine ERROR(%integer case)
void ERROR(int CASE) {
// 4973 faultp = atomp
FAULTP = ATOMP;
// 4974 report(case,0,0)
REPORT(CASE, 0, 0);
// 4975 %signal fail
_imp_signal(11, 0, 0, "");
// 4976 %end
return;
} /* end of ERROR */
// 4977
// 4978 %constinteger DUD=63
// 4979 %routine SYNTAX ERROR
void SYNTAXERROR(void) {
// 4980 %if atom = dud %then error(atomerr+point) %else error(formerr+point)
if (ATOM != 63) goto L_0470;
ERROR(8 + 64);
L_0470:;
ERROR(7 + 64);
// 4981 %end
return;
} /* end of SYNTAXERROR */
// 4982
// 4983 %routine EXPFAULT(%integer case)
void EXPFAULT(int CASE) {
// 4984 %if faultnum = 0 %or expp < faultp %start
if (FAULTNUM == 0) goto L_0471;
if (EXPP >= FAULTP) goto L_0472;
L_0471:;
// 4985 faultnum = case!point; faultp = expp
FAULTNUM = CASE | 64;
FAULTP = EXPP;
// 4986 %finish
L_0472:;
// 4987 %end
return;
} /* end of EXPFAULT */
// 4988
// 4989 %routine NONSTANDARD(%integer case)
void NONSTANDARD(int CASE) {
// 4990 %integer b
int B;
// 4991 %owninteger hadit=0
static int HADIT = 0;
// 4992 b = 1<<case
B = 1 << CASE;
// 4993 %if b&hadit = 0 %and control&nonsbit = 0 %and faultnum = 0 %start
if (B & HADIT != 0) goto L_0473;
if (CONTROL & 256 != 0) goto L_0473;
if (FAULTNUM != 0) goto L_0473;
// 4994 hadit = hadit+b; faultp = atomp
HADIT = HADIT + B;
FAULTP = ATOMP;
// 4995 %if control&strictbit # 0 %then report(nonstand+point,0,case) %c
if (CONTROL & 131072 == 0) goto L_0474;
REPORT(39 + 64, 0, CASE);
goto L_0475;
L_0474:;
REPORT(39 + 64 + (-128), 0, CASE);
L_0475:;
// 4996+ %else report(nonstand+point+warn,0,case)
// 4997 %finish
L_0473:;
// 4998 %end
return;
} /* end of NONSTANDARD */
// 4999
// 5000 %routine NAME ERROR
void NAMEERROR(void) {
// 5001 !check if the culprit has occurred before
// 5002 !and, if not, add it to the pool of unknowns stored at the
// 5003 !far end of the dictionary.
// 5004 %if item >= 0 %start; !first time
if (ITEM < 0) goto L_0476;
// 5005 fault(namerr+point+now)
FAULT(9 + 64 + 128);
// 5006 %if charmin-newlen-80 >= charlim %start
if (CHARMIN - NEWLEN - 80 < CHARLIM) goto L_0477;
// 5007 dmin = dmin-1; dmin0 = dmin
DMIN = DMIN - 1;
DMIN0 = DMIN;
// 5008 charmin = charmin-newlen-1
CHARMIN = CHARMIN - NEWLEN - 1;
// 5009 string(charmin) = string(charlim)
*_imp_STRING(CHARMIN) = *_imp_STRING(CHARLIM);
// 5010 dict(dmin)_text = charmin-char0
DICT[DMIN].TEXT = CHARMIN - CHAR0;
// 5011 head == dict(head)_hlink %while head > 0; !find last link
L_0478:;
if (*HEAD <= 0) goto L_0479;
HEAD = (short int *)/*?*/ &DICT[*HEAD].HLINK;
goto L_0478;
L_0479:;
// 5012 dict(dmin)_hlink = head; head = -dmin
DICT[DMIN].HLINK = *HEAD;
*HEAD = -DMIN;
// 5013 %finish
L_0477:;
// 5014 %finish %else others = others+1
goto L_047A;
L_0476:;
OTHERS = OTHERS + 1;
L_047A:;
// 5015 %signal fail
_imp_signal(11, 0, 0, "");
// 5016 %end
return;
} /* end of NAMEERROR */
// 5017
// 5018 %routine FIND OP(%integer mnemonic,%integername op,types)
void FINDOP(int MNEMONIC, int *OP, int *TYPES) {
// 5019 %integer i
int I;
// 5020 i = 0
I = 0;
// 5021 %cycle
L_047B:;
// 5022 i = i+2
I = I + 2;
// 5023 error(namerr) %if i > defmax+defmax
if (I <= 129 + 129) goto L_047C;
ERROR(9);
L_047C:;
// 5024 %repeat %until def(i) = mnemonic
if (DEF[I] == MNEMONIC) goto L_047D;
goto L_047B;
L_047D:;
// 5025 types = def(i-1); op = i>>1
*TYPES = DEF[I - 1];
*OP = (unsigned int)I >> 1;
// 5026 %end
return;
} /* end of FINDOP */
// 5027
// 5028 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5029 !!!!!!!!!!!!!!!!!!!! Source input !!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5030 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5031
// 5032 %routine READ LINE(%integer flag)
void READLINE(int FLAG) {
// 5033 ! Read (or otherwise make available) the next source line
// 5034 ! Output any pending error report; *NB*
// 5035 ! Skip remnant of previous line if SYM # NL *NB*
// 5036 ! Set LINESTART to point to start of new line
// 5037 ! Print new line on list output stream if listing requested
// 5038 ! (Direct output routines CF diagnostics)
// 5039 report(faultnum,0,0) %if faultnum # 0
if (FAULTNUM == 0) goto L_047E;
REPORT(FAULTNUM, 0, 0);
L_047E:;
// 5040 %while sym > nl %cycle; !Skip remnant
L_047F:;
if (SYM <= 10) goto L_0480;
// 5041 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5042 %repeat
goto L_047F;
L_0480:;
// 5043 line = line+1
LINE = LINE + 1;
// 5044 %while fp = curlim %cycle
L_0481:;
if (FP != CURLIM) goto L_0482;
// 5045 %if curlim # cur_lim2 %start; !in part1 of file
if (CURLIM == CUR->LIM2) goto L_0483;
// 5046 fp = cur_start2
FP = CUR->START2;
// 5047 %finish %else %if curfile = main %start; !on main
goto L_0484;
L_0483:;
if (CURFILE != 1) goto L_0485;
// 5048 %signal done
_imp_signal(12, 0, 0, "");
// 5049 %else
L_0485:;
// 5050 cur_flag = -1
CUR->FLAG = -1;
// 5051 !! disconnect edfile(cur)
// 5052 curfile = curfile-1
CURFILE = CURFILE - 1;
// 5053 cur == file(curfile)
CUR = (struct EDFILE *)/*?*/ &FILE[CURFILE - 1];
// 5054 fp = cur_fp; line = cur_line
FP = CUR->FP;
LINE = CUR->LINE;
// 5055 control = fcontrol(curfile)
CONTROL = FCONTROL[CURFILE - 1];
// 5056 inclim = dlim %if level = outerlevel %and c_status < hadon
if (LEVEL != 0) goto L_0486;
if (C.STATUS >= 4096) goto L_0486;
INCLIM = DLIM;
L_0486:;
// 5057 %finish
L_0484:;
// 5058 curstart = cur_start2; curlim = cur_lim2
CURSTART = CUR->START2;
CURLIM = CUR->LIM2;
// 5059 %if fp < curstart %or fp > curlim %start
if (FP < CURSTART) goto L_0487;
if (FP <= CURLIM) goto L_0488;
L_0487:;
// 5060 curstart = cur_start1; curlim = cur_lim1
CURSTART = CUR->START1;
CURLIM = CUR->LIM1;
// 5061 %finish
L_0488:;
// 5062 %repeat
goto L_0481;
L_0482:;
// 5063 linestart = fp
LINESTART = FP;
// 5064 %if flag = 0 %start
if (FLAG != 0) goto L_0489;
// 5065 flag = ' '; flag = '&' %if curfile # main
FLAG = 32;
if (CURFILE == 1) goto L_048A;
FLAG = 38;
L_048A:;
// 5066 %finish
L_0489:;
// 5067 listflag = flag
LISTFLAG = FLAG;
// 5068 %if control&list # 0 %start
if (CONTROL & 1 == 0) goto L_048B;
// 5069 time1 = time1-cputime
TIME1 = TIME1 - CPUTIME;
// 5070 print line %if rep # ""
if (_imp_strcmp((_imp_string *)/*?*/ &REP, (_imp_string *)/*?*/ _imp_str_literal_ptr("")) == 0) goto L_048C;
PRINTLINE();
L_048C:;
// 5071 show dict(dictshown) %if control&dictlist # 0
if (CONTROL & 16 == 0) goto L_048D;
SHOWDICT(DICTSHOWN);
L_048D:;
// 5072 dictshown = dlim
DICTSHOWN = DLIM;
// 5073 write(line,4); print symbol(listflag)
_imp_WRITE(LINE, 4);
_imp_PRINTSYMBOL(LISTFLAG);
// 5074 print symbol(' ')
_imp_PRINTSYMBOL(32);
// 5075 %cycle
L_048E:;
// 5076 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5077 print symbol(sym)
_imp_PRINTSYMBOL(SYM);
// 5078 %repeat %until sym <= nl
if (SYM <= 10) goto L_048F;
goto L_048E;
L_048F:;
// 5079 fp = linestart
FP = LINESTART;
// 5080 time1 = time1+cputime
TIME1 = TIME1 + CPUTIME;
// 5081 %finish
L_048B:;
// 5082 sym = 0
SYM = 0;
// 5083 %end; !READ LINE
return;
} /* end of READLINE */
// 5084
// 5085 !<<IMP
// 5086
// 5087 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5088 !!!!!!!!!!!!!!!!!!!! Lexical processing !!!!!!!!!!!!!!!!!!!!!!
// 5089 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5090
// 5091 %constinteger CASEBIT=32
// 5092 %owninteger PERCENT=0, SUBATOM=0
static int PERCENT = 0;
static int SUBATOM = 0;
// 5093 !
// 5094 !~!!!!!!! Keyword codes -- used by KEYGEN to produce tables !!
// 5095 %constinteger %c
// 5096+ KEYEND=1 {end},
// 5097+ KEYREPEAT=2 {repeat},
// 5098+ KEYFINISH=3 {finish},
// 5099+ KEYELSE=4 {else},
// 5100+ KEYBEGIN=5 {begin},
// 5101+ EXIT=6 {exit_1,continue_0}
// 5102 %constinteger %c
// 5103+ KEYRETURN=7 {return},
// 5104+ TF=8 {true_1,false_0},
// 5105+ KEYRESULT=9 {result},
// 5106+ KEYSTOP=10 {stop},
// 5107+ KEYGOTO=11 {goto},
// 5108+ KEYSIGNAL=12 {signal}
// 5109 %constinteger %c
// 5110+ KEYMONITOR=13 {monitor},
// 5111+ KEYON=14 {on},
// 5112+ IU=15 {if_0,unless_1},
// 5113+ KEYWHILE=16 {while},
// 5114+ KEYUNTIL=17 {until_1},
// 5115+ KEYFOR=18 {for},
// 5116+ KEYTHEN=19 {then}
// 5117 %constinteger %c
// 5118+ KEYSTART=20 {start},
// 5119+ KEYCYCLE=21 {cycle},
// 5120+ KEYLABEL=22 {label},
// 5121+ KEYCONST=23 {const,constant},
// 5122+ KEYOWN=24 {own},
// 5123+ KEYEXT=25 {external_6,system_5,dynamic_7}
// 5124 %constinteger %c
// 5125+ KATTRIB=26 {readonly_0,writeonly_1,volatile_2},
// 5126+ KTYPE=27 {short_3,half_6,byte_9,mite_12,boolean_15,char_18,text_25},
// 5127+ KEYINTEGER=28 {integer},
// 5128+ KEYLONG=29 {long},
// 5129+ KEYREAL=30 {real},
// 5130+ KEYSTRING=31 {string_0,cstring_1}
// 5131 %constinteger %c
// 5132+ KEYRECORD=32 {record},
// 5133+ KEYNAME=33 {name},
// 5134+ KEYFORMAT=34 {format},
// 5135+ FNMAP=35 {fn_0,function_0,map_1},
// 5136+ RPRED=36 {routine_0,predicate_1},
// 5137+ KEYSPEC=37 {spec}
// 5138 %constinteger %c
// 5139+ KEYARRAY=38 {array},
// 5140+ KEYSWITCH=39 {switch},
// 5141+ KEYOF=40 {of},
// 5142+ KEYFILE=41 {file},
// 5143+ KEYPROGRAM=42 {program},
// 5144+ KEYLIST=43 {list}
// 5145 %constinteger %c
// 5146+ KEYCONTROL=44 {control},
// 5147+ KEYCOMMENT=45 {comment},
// 5148+ KEYEVENT=46 {event},
// 5149+ KEYINCLUDE=47 {include},
// 5150+ KEYOPTION=48 {option},
// 5151+ KEYALIAS=49 {alias}
// 5152 %constinteger %c
// 5153+ KEYNOT=50 {not},
// 5154+ KEYAND=72 {and},
// 5155+ KEYOR=73 {or}
// 5156 !! end of keyword codes
// 5157 !
// 5158 !Symbol lexical codes other than operators:
// 5159 %constinteger TERMINATOR=51, CONST=52, IDENT=53, MODSIGN=54,
// 5160+ COLON=59, COMMA=60, RIGHT=61, RIGHTB=62
// 5161 {DUD=63}
// 5162 %constinteger LEFT=55, LEFTB=56, ATSIGN=57, UNDERLINE=58
// 5163
// 5164 %constinteger ARROW=74, EQEQ=75, NOTEQEQ=76,
// 5165+ EQUALS=77, NOTEQ=78, LESSEQ=79,
// 5166+ LESS=80, GREATEQ=81, GREATER=82
// 5167 %constinteger PLUS=83, MINUS=84, EXCLAM=85, EXCLAM2=86, DOT=87
// 5168 %constinteger STAR=88, SLASH2=89, SLASH=90, AMPERSAND=91
// 5169 %constinteger STAR2=92, BACKSLASH=93, UPARROW=94,
// 5170+ BACKSLASH2=95, UPARROW2=96,
// 5171+ TILDE=97,
// 5172+ LSHIFT=98, RSHIFT=99
// 5173 %constinteger ATOMMAX=99
// 5174 %constinteger ALEFT=left, ARIGHT=right, RECSUB=underline,
// 5175+ OVER=slash2, SCONC=dot
// 5176
// 5177 %constinteger SIMPLE=atommax+1, VSIMPLE=simple+1,
// 5178+ MAJOR=plus, SCOND=arrow, COND=keyand, CONDQ=71
// 5179 !
// 5180 %integer%fn NEXT ATOM
int NEXTATOM(void) {
// 5181 !Encode next atom from source file
// 5182 ![Time-critical]
// 5183 %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};
// 5184 %constinteger TAB=9,
// 5185+ MAX10=maxint//10, MAXDIG=maxint-max10*10
// 5186 %integer i,j,p,radix,hash
int I;
int J;
int P;
int RADIX;
int HASH;
// 5187 %real rval
float RVAL;
// 5188 %constbytearray 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};
// 5189+ 0 ('0'),
// 5190+ '0','1','2','3','4','5','6','7','8','9',
// 5191+ 0, 0, 0, 0, 0, 0, 0,
// 5192+ 'a','b','c','d','e','f','g','h','i','j','k','l','m',
// 5193+ 'n','o','p','q','r','s','t','u','v','w','x','y','z',
// 5194+ 0, 0, 0, 0, 0, 0,
// 5195+ 'a','b','c','d','e','f','g','h','i','j','k','l','m',
// 5196+ 'n','o','p','q','r','s','t','u','v','w','x','y','z',
// 5197+ 0, 0, 0, 0, 0
// 5198
// 5199 !~!!!!!!!!!!!!!!! Ex KEYGEN !!!!!!!!!!!!!!!!!!!!
// 5200 %CONSTSHORTINTEGERARRAY SYMINIT(97:122) = %C
const short int SYMINIT[26] = {2, 15, 31, 72, 79, 102, 133, 137, 141, 1, 1, 156, 169,
183, 190, 205, 1, 220, 257, 297, 309, 319, 327, 1, 1, 1};
// 5201+ 2,15,31,72,79,102,133,137,141,1,1,156,169,183,190,205,
// 5202+ 1,220,257,297,309,319,327,1,1,1
// 5203
// 5204 %CONSTBYTEINTEGERARRAY SYMBOL(1:340) = %C
const unsigned char SYMBOL[340] = {
128, 114, 114, 97, 121, 166, 108, 105, 97, 115, 177, 110, 100, 200, 101, 103, 105, 110, 133, 121, 116, 101,
155, 111, 111, 108, 101, 97, 110, 155, 111, 110, 116, 105, 110, 117, 101, 134, 121, 99, 108, 101, 149, 104,
97, 114, 155, 115, 116, 114, 105, 110, 103, 159, 109, 109, 101, 110, 116, 173, 115, 116, 97, 110, 116, 151,
151, 114, 111, 108, 172, 121, 110, 97, 109, 105, 99, 153, 110, 100, 129, 108, 115, 101, 132, 120, 105, 116,
134, 118, 101, 110, 116, 174, 116, 101, 114, 110, 97, 108, 153, 105, 110, 105, 115, 104, 131, 97, 108, 115,
101, 136, 111, 114, 109, 97, 116, 162, 110, 163, 117, 110, 99, 116, 105, 111, 110, 163, 146, 108, 101, 169,
111, 116, 111, 139, 97, 108, 102, 155, 102, 143, 110, 116, 101, 103, 101, 114, 156, 99, 108, 117, 100, 101,
175, 97, 98, 101, 108, 150, 111, 110, 103, 157, 105, 115, 116, 171, 111, 110, 105, 116, 111, 114, 141, 105,
116, 101, 155, 97, 112, 163, 97, 109, 101, 161, 111, 116, 178, 110, 142, 119, 110, 152, 102, 168, 112, 116,
105, 111, 110, 176, 114, 201, 114, 101, 100, 105, 99, 97, 116, 101, 164, 111, 103, 114, 97, 109, 170, 101,
112, 101, 97, 116, 130, 111, 117, 116, 105, 110, 101, 164, 116, 117, 114, 110, 135, 115, 117, 108, 116, 137,
97, 100, 111, 110, 108, 121, 154, 99, 111, 114, 100, 160, 108, 158, 116, 111, 112, 138, 105, 103, 110, 97,
108, 140, 121, 115, 116, 101, 109, 153, 104, 111, 114, 116, 155, 112, 101, 99, 165, 119, 105, 116, 99, 104,
167, 97, 114, 116, 148, 114, 105, 110, 103, 159, 114, 117, 101, 136, 104, 101, 110, 147, 101, 120, 116, 155,
110, 108, 101, 115, 115, 143, 116, 105, 108, 145, 111, 108, 97, 116, 105, 108, 101, 154, 104, 105, 108, 101,
144, 114, 105, 116, 101, 111, 110, 108, 121, 154};
// 5205+ 128,114,114,97,121,166,108,105,97,115,177,110,100,200,101,103,
// 5206+ 105,110,133,121,116,101,155,111,111,108,101,97,110,155,111,110,
// 5207+ 116,105,110,117,101,134,121,99,108,101,149,104,97,114,155,115,
// 5208+ 116,114,105,110,103,159,109,109,101,110,116,173,115,116,97,110,
// 5209+ 116,151,151,114,111,108,172,121,110,97,109,105,99,153,110,100,
// 5210+ 129,108,115,101,132,120,105,116,134,118,101,110,116,174,116,101,
// 5211+ 114,110,97,108,153,105,110,105,115,104,131,97,108,115,101,136,
// 5212+ 111,114,109,97,116,162,110,163,117,110,99,116,105,111,110,163,
// 5213+ 146,108,101,169,111,116,111,139,97,108,102,155,102,143,110,116,
// 5214+ 101,103,101,114,156,99,108,117,100,101,175,97,98,101,108,150,
// 5215+ 111,110,103,157,105,115,116,171,111,110,105,116,111,114,141,105,
// 5216+ 116,101,155,97,112,163,97,109,101,161,111,116,178,110,142,119,
// 5217+ 110,152,102,168,112,116,105,111,110,176,114,201,114,101,100,105,
// 5218+ 99,97,116,101,164,111,103,114,97,109,170,101,112,101,97,116,
// 5219+ 130,111,117,116,105,110,101,164,116,117,114,110,135,115,117,108,
// 5220+ 116,137,97,100,111,110,108,121,154,99,111,114,100,160,108,158,
// 5221+ 116,111,112,138,105,103,110,97,108,140,121,115,116,101,109,153,
// 5222+ 104,111,114,116,155,112,101,99,165,119,105,116,99,104,167,97,
// 5223+ 114,116,148,114,105,110,103,159,114,117,101,136,104,101,110,147,
// 5224+ 101,120,116,155,110,108,101,115,115,143,116,105,108,145,111,108,
// 5225+ 97,116,105,108,101,154,104,105,108,101,144,114,105,116,101,111,
// 5226+ 110,108,121,154
// 5227
// 5228 %CONSTBYTEINTEGERARRAY ALTDISP(1:340) = %C
const unsigned char ALTDISP[340] = {
0, 5, 0, 0, 0, 0, 5, 0, 0, 0, 0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 0, 0, 9, 0, 0, 0, 0, 0, 0, 15, 8, 23, 28, 34,
0, 0, 0, 0, 5, 0, 0, 0, 0, 4, 0, 0, 18, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 3, 0, 0, 4, 0, 0, 0, 4, 8, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 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, 6, 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, 12, 0, 0, 1, 4, 0, 0, 0, 0, 0, 0, 2, 0, 3, 0, 0, 2, 0, 6, 0, 0, 0, 0, 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, 7, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 30, 0, 0, 6, 0, 0, 0, 0, 0, 6, 0, 0, 0, 0, 5,
5, 0, 0, 0, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 1, 4, 0, 0, 0, 0, 0,
0, 25, 0, 5, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1};
// 5229+ 0,5,0,0,0,0,5,0,0,0,0,0,0,0,5,0,
// 5230+ 0,0,0,4,0,0,9,0,0,0,0,0,0,15,8,23,
// 5231+ 28,34,0,0,0,0,5,0,0,0,0,4,0,0,18,0,
// 5232+ 0,0,0,0,0,1,0,0,0,0,0,0,0,0,4,0,
// 5233+ 0,0,0,0,0,0,0,0,0,0,0,0,0,7,3,0,
// 5234+ 0,4,0,0,0,4,8,0,1,0,0,0,0,0,0,0,
// 5235+ 0,0,0,0,6,6,27,0,0,0,0,5,0,0,0,0,
// 5236+ 6,0,14,0,0,0,2,0,0,0,0,0,0,0,0,0,
// 5237+ 0,0,0,0,0,0,0,0,0,0,0,6,2,0,0,6,
// 5238+ 0,0,0,0,0,0,0,0,0,0,0,5,0,0,0,0,
// 5239+ 4,0,0,0,0,0,0,0,7,0,0,0,0,0,0,4,
// 5240+ 0,0,12,0,0,1,4,0,0,0,0,0,0,2,0,3,
// 5241+ 0,0,2,0,6,0,0,0,0,0,0,0,0,8,0,0,
// 5242+ 0,0,0,0,1,0,0,0,0,0,0,6,12,0,0,0,
// 5243+ 0,0,0,0,0,0,0,0,5,0,0,0,0,5,0,0,
// 5244+ 0,0,7,11,0,0,0,0,0,0,0,0,0,0,0,0,
// 5245+ 4,30,0,0,6,0,0,0,0,0,6,0,0,0,0,5,
// 5246+ 5,0,0,0,3,4,0,0,0,0,0,0,0,0,0,4,
// 5247+ 0,0,0,0,0,0,0,0,4,0,0,1,4,0,0,0,
// 5248+ 0,0,0,25,0,5,0,0,0,1,0,0,0,1,0,0,
// 5249+ 0,0,0,0,0,2,5,0,0,0,0,0,0,0,0,0,
// 5250+ 0,0,0,1
// 5251
// 5252
// 5253 !! end of generated tables
// 5254
// 5255 %routine GET SYM
void GETSYM(void) {
// 5256 %cycle
L_0490:;
// 5257 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5258 %repeat %until sym # ' '
if (SYM != 32) goto L_0491;
goto L_0490;
L_0491:;
// 5259 i = sym-'0'
I = SYM - 48;
// 5260 %if i >= 10 %start
if (I < 10) goto L_0492;
// 5261 i = sym!casebit-'a'; i = i+10 %if i >= 0
I = (SYM | 32) - 97;
if (I < 0) goto L_0493;
I = I + 10;
L_0493:;
// 5262 %finish
L_0492:;
// 5263 %end
return;
} /* end of GETSYM */
// 5264
// 5265 matched = 0
MATCHED = 0;
// 5266 again: s(tab):
U_1027:;
case_S_9:;
// 5267 read line(0) %if sym = nl
if (SYM != 10) goto L_0495;
READLINE(0);
L_0495:;
// 5268 again1:
U_1028:;
// 5269 %cycle
L_0496:;
// 5270 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5271 %repeat %until sym # ' '
if (SYM != 32) goto L_0497;
goto L_0496;
L_0497:;
// 5272 atomp = fp; !(actually one after)
ATOMP = FP;
// 5273 atoms = atoms+1
ATOMS = ATOMS + 1;
// 5274 -> s(sym)
S_line = __LINE__;
S_file = __FILE__;
S_index = SYM;
goto case_S_dispatch;
// 5275 linebreak: s(nl):
U_1029:;
case_S_10:;
// 5276 %result = terminator %if atom # comma
if (ATOM == 60) goto L_0498;
return 51;
L_0498:;
// 5277 continuation:
U_102A:;
// 5278 read line('+')
READLINE(43);
// 5279 -> again1
goto U_1028;
// 5280
// 5281 s('{'):
case_S_123:;
// 5282 comments = comments+1
COMMENTS = COMMENTS + 1;
// 5283 %cycle
L_0499:;
// 5284 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5285 -> linebreak %if sym = nl
if (SYM != 10) goto L_049A;
goto U_1029;
L_049A:;
// 5286 %repeat %until sym = '}'
if (SYM == 125) goto L_049B;
goto L_0499;
L_049B:;
// 5287 -> again
goto U_1027;
// 5288
// 5289 s('+'): %result = plus
case_S_43:;
return 83;
// 5290 s('-'): fp = fp+1 %and %result = arrow %if byteintegeR(fp) = '>'
case_S_45:;
if (*_imp_BYTEINTEGER(FP) != 62) goto L_049C;
FP = FP + 1;
return 74;
L_049C:;
// 5291 -> continuation %if byteintegeR(fp) = nl
if (*_imp_BYTEINTEGER(FP) != 10) goto L_049D;
goto U_102A;
L_049D:;
// 5292 %result = minus
return 84;
// 5293 s('*'): %result = star
case_S_42:;
return 88;
// 5294 s('/'): fp = fp+1 %and %result = slash2 %if byteintegeR(fp) = '/'
case_S_47:;
if (*_imp_BYTEINTEGER(FP) != 47) goto L_049E;
FP = FP + 1;
return 89;
L_049E:;
// 5295 %result = slash
return 90;
// 5296 s('\'): fp = fp+1 %and %result = backslash2 %if byteintegeR(fp) = '\'
case_S_92:;
if (*_imp_BYTEINTEGER(FP) != 92) goto L_049F;
FP = FP + 1;
return 95;
L_049F:;
// 5297 fp = fp+1 %and %result = noteq %if byteinteger(fp) = '='
if (*_imp_BYTEINTEGER(FP) != 61) goto L_04A0;
FP = FP + 1;
return 78;
L_04A0:;
// 5298 %result = backslash
return 93;
// 5299 s('^'): fp = fp+1 %and %result = uparrow2 %if byteintegeR(fp) = '^'
case_S_94:;
if (*_imp_BYTEINTEGER(FP) != 94) goto L_04A1;
FP = FP + 1;
return 96;
L_04A1:;
// 5300 %result = uparrow
return 94;
// 5301 s('~'): %result = tilde
case_S_126:;
return 97;
// 5302 s('!'): fp = fp+1 %and %result = exclam2 %if byteintegeR(fp) = '!'
case_S_33:;
if (*_imp_BYTEINTEGER(FP) != 33) goto L_04A2;
FP = FP + 1;
return 86;
L_04A2:;
// 5303 %result = exclam
return 85;
// 5304 s('&'): %result = ampersand
case_S_38:;
return 91;
// 5305 s('.'): rval = 0 %and -> fraction %if '0' <= byteinteger(fp) <= '9'
case_S_46:;
{
// Double-sided test on _imp_BYTEINTEGER(FP) (Part I)
unsigned char tmp;
if (48 > (tmp = *_imp_BYTEINTEGER(FP))) goto L_04A3;
// Double-sided test on _imp_BYTEINTEGER(FP) (Part II)
if (tmp > 57) goto L_04A3;
}
RVAL = 0;
goto U_102B;
L_04A3:;
// 5306 %result = dot
return 87;
// 5307 s('='): fp = fp+1 %and %result = eqeq %if byteintegeR(fp) = '='
case_S_61:;
if (*_imp_BYTEINTEGER(FP) != 61) goto L_04A4;
FP = FP + 1;
return 75;
L_04A4:;
// 5308 %result = equals
return 77;
// 5309 s('#'): fp = fp+1 %and %result = noteqeq %if byteintegeR(fp) = '#'
case_S_35:;
if (*_imp_BYTEINTEGER(FP) != 35) goto L_04A5;
FP = FP + 1;
return 76;
L_04A5:;
// 5310 %result = noteq
return 78;
// 5311 s('<'): fp = fp+1 %and %result = lesseq %if byteintegeR(fp) = '='
case_S_60:;
if (*_imp_BYTEINTEGER(FP) != 61) goto L_04A6;
FP = FP + 1;
return 79;
L_04A6:;
// 5312 fp = fp+1 %and %result = noteq %if byteintegeR(fp) = '>'
if (*_imp_BYTEINTEGER(FP) != 62) goto L_04A7;
FP = FP + 1;
return 78;
L_04A7:;
// 5313 fp = fp+1 %and %result = lshift %if byteintegeR(fp) = '<'
if (*_imp_BYTEINTEGER(FP) != 60) goto L_04A8;
FP = FP + 1;
return 98;
L_04A8:;
// 5314 %result = less
return 80;
// 5315 s('>'): fp = fp+1 %and %result = greateq %if byteintegeR(fp) = '='
case_S_62:;
if (*_imp_BYTEINTEGER(FP) != 61) goto L_04A9;
FP = FP + 1;
return 81;
L_04A9:;
// 5316 fp = fp+1 %and %result = rshift %if byteintegeR(fp) = '>'
if (*_imp_BYTEINTEGER(FP) != 62) goto L_04AA;
FP = FP + 1;
return 99;
L_04AA:;
// 5317 %result = greater
return 82;
// 5318 s('_'): %result = underline
case_S_95:;
return 58;
// 5319 s(':'): %result = colon
case_S_58:;
return 59;
// 5320 s(','): %result = comma
case_S_44:;
return 60;
// 5321 s(';'): %result = terminator
case_S_59:;
return 51;
// 5322 s('('): %result = left
case_S_40:;
return 55;
// 5323 s('['): %result = leftb
case_S_91:;
return 56;
// 5324 s(')'): %result = right
case_S_41:;
return 61;
// 5325 s(']'): %result = rightb
case_S_93:;
return 62;
// 5326 s('|'): %result = modsign
case_S_124:;
return 54;
// 5327 s('@'): %result = atsign
case_S_64:;
return 57;
// 5328
// 5329 s('M'): s('m'):
case_S_77:;
case_S_109:;
// 5330 fp = fp+1 %and -> charconst %if byteintegeR(fp) = ''''
if (*_imp_BYTEINTEGER(FP) != 39) goto L_04AB;
FP = FP + 1;
goto U_102C;
L_04AB:;
// 5331 s('A'):s('B'):s('C'):s('D'):s('E'):s('F'):s('G'):s('H'):
case_S_65:;
case_S_66:;
case_S_67:;
case_S_68:;
case_S_69:;
case_S_70:;
case_S_71:;
case_S_72:;
// 5332 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:;
// 5333 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:;
// 5334 s('Y'):s('Z'):s('a'):s('b'):s('c'):s('d'):s('e'):s('f'):
case_S_89:;
case_S_90:;
case_S_97:;
case_S_98:;
case_S_99:;
case_S_100:;
case_S_101:;
case_S_102:;
// 5335 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:;
// 5336 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:;
// 5337 s('w'):s('x'):s('y'):s('z'):
case_S_119:;
case_S_120:;
case_S_121:;
case_S_122:;
// 5338 -> keyword %if percent # 0
if (PERCENT == 0) goto L_04AC;
goto U_102D;
L_04AC:;
// 5339 newlen = charlim+1; hash = sym!casebit; !lower-case (if letter)
NEWLEN = CHARLIM + 1;
HASH = SYM | 32;
// 5340 byteinteger(newlen) = hash
*_imp_BYTEINTEGER(NEWLEN) = HASH;
// 5341 %cycle
L_04AD:;
// 5342 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5343 %repeat %until sym # ' '
if (SYM != 32) goto L_04AE;
goto L_04AD;
L_04AE:;
// 5344 %if sym = '''' %start; !damned IBM-style literals
if (SYM != 39) goto L_04AF;
// 5345 radix = 16 %and ->ibm %if hash = 'x'
if (HASH != 120) goto L_04B0;
RADIX = 16;
goto U_102E;
L_04B0:;
// 5346 radix = 8 %and ->ibm %if hash = 'k'
if (HASH != 107) goto L_04B1;
RADIX = 8;
goto U_102E;
L_04B1:;
// 5347 radix = 2 %and ->ibm %if hash = 'b'
if (HASH != 98) goto L_04B2;
RADIX = 2;
goto U_102E;
L_04B2:;
// 5348 %finish
L_04AF:;
// 5349 sym = map(sym)
SYM = MAP[SYM];
// 5350 %if sym # 0 %start
if (SYM == 0) goto L_04B3;
// 5351 %cycle
L_04B4:;
// 5352 newlen = newlen+1; byteinteger(newlen) = sym
NEWLEN = NEWLEN + 1;
*_imp_BYTEINTEGER(NEWLEN) = SYM;
// 5353 hash = hash<<1!!sym
HASH = HASH << 1 ^ SYM;
// 5354 %cycle
L_04B5:;
// 5355 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5356 %repeat %until sym # ' '
if (SYM != 32) goto L_04B6;
goto L_04B5;
L_04B6:;
// 5357 sym = map(sym)
SYM = MAP[SYM];
// 5358 %repeat %until sym = 0
if (SYM == 0) goto L_04B7;
goto L_04B4;
L_04B7:;
// 5359 %finish
L_04B3:;
// 5360 fp = fp-1
FP = FP - 1;
// 5361 newlen = newlen-charlim; byteinteger(charlim) = newlen
NEWLEN = NEWLEN - CHARLIM;
*_imp_BYTEINTEGER(CHARLIM) = NEWLEN;
// 5362 %if subbed # 0 %then head == dformat_link %c
if (SUBBED == 0) goto L_04B8;
HEAD = (short int *)/*?*/ &DFORMAT->LINK;
goto L_04B9;
L_04B8:;
HEAD = (short int *)/*?*/ &HASHINDEX[HASH & 255];
L_04B9:;
// 5363+ %else head == hashindex(hash&255)
// 5364 item = head
ITEM = *HEAD;
// 5365 %if item # 0 %start
if (ITEM == 0) goto L_04BA;
// 5366 %cycle
L_04BB:;
// 5367 ditem == dict(imod(item))
DITEM = (struct IDENTINFO *)/*?*/ &DICT[_imp_IMOD(ITEM)];
// 5368 %exit %if string(ditem_text+char0) = string(charlim) %c
if (_imp_strcmp((_imp_string *)_imp_STRING(DITEM->TEXT + CHAR0), (_imp_string *)_imp_STRING(CHARLIM)) != 0)
goto L_04BC;
if (ITEM > 16) goto L_04BD;
if (ITEM < 0) goto L_04BD;
if (CONTROL & 16384 == 0) goto L_04BC;
L_04BD:;
goto L_04BE;
L_04BC:;
// 5369+ %and (item > a7 %or item < 0 %or control&lowbit # 0)
// 5370 item = ditem_hlink
ITEM = DITEM->HLINK;
// 5371 %repeat %until item = 0
if (ITEM == 0) goto L_04BE;
goto L_04BB;
L_04BE:;
// 5372 %finish
L_04BA:;
// 5373 identatoms = identatoms+1
IDENTATOMS = IDENTATOMS + 1;
// 5374 %result = ident
return 53;
// 5375
// 5376 s('%'):
case_S_37:;
// 5377 sym = byteintegeR(fp)
SYM = *_imp_BYTEINTEGER(FP);
// 5378 -> again %unless 'a' <= sym!casebit <= 'z'
{
// Double-sided test on SYM | 32 (Part I)
int tmp;
if (97 > (tmp = SYM | 32)) goto L_04BF;
// Double-sided test on SYM | 32 (Part II)
if (tmp <= 122) goto L_04C0;
}
L_04BF:;
goto U_1027;
L_04C0:;
// 5379 fp = fp+1
FP = FP + 1;
// 5380 keyword:
U_102D:;
// 5381 percent = 0
PERCENT = 0;
// 5382 p = syminit(sym!casebit)
P = SYMINIT[(SYM | 32) - 97];
// 5383 %cycle
L_04C1:;
// 5384 ! %cycle
// 5385 ! sym = byteintegeR(fp)!casebit
// 5386 ! %exit %if symbol(p) # sym
// 5387 %while symbol(p) = byteintegeR(fp)!casebit %cycle
L_04C2:;
if (SYMBOL[P - 1] != *_imp_BYTEINTEGER(FP) | 32) goto L_04C3;
// 5388 p = p+1; fp = fp+1
P = P + 1;
FP = FP + 1;
// 5389 %repeat
goto L_04C2;
L_04C3:;
// 5390 %exit %if symbol(p) > 127
if (SYMBOL[P - 1] <= 127) goto L_04C4;
goto L_04C5;
L_04C4:;
// 5391 atom = altdisp(p)
ATOM = ALTDISP[P - 1];
// 5392 %if atom = 0 %start
if (ATOM != 0) goto L_04C6;
// 5393 %result = dud %unless sym!casebit = 'c' %and byteintegeR(fp) = nl
if (SYM | 32 != 99) goto L_04C7;
if (*_imp_BYTEINTEGER(FP) == 10) goto L_04C8;
L_04C7:;
return 63;
L_04C8:;
// 5394 ->continuation
goto U_102A;
// 5395 %finish
L_04C6:;
// 5396 p = p+atom
P = P + ATOM;
// 5397 %repeat
goto L_04C1;
L_04C5:;
// 5398 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_04C9;
// Double-sided test on *_imp_BYTEINTEGER(FP) | 32 (Part II)
if (tmp > 122) goto L_04C9;
}
PERCENT = 1;
L_04C9:;
// 5399 subatom = altdisp(p)
SUBATOM = ALTDISP[P - 1];
// 5400 atom = symbol(p)-128
ATOM = SYMBOL[P - 1] - 128;
// 5401 %result = dud %if atom = 0
if (ATOM != 0) goto L_04CA;
return 63;
L_04CA:;
// 5402 %result = atom
return ATOM;
// 5403
// 5404 ibm:
U_102E:;
// 5405 nonstandard(20)
NONSTANDARD(20);
// 5406 item = -1; value = 0
ITEM = -1;
VALUE = 0;
// 5407 -> ibm1
goto U_102F;
// 5408 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:;
// 5409 item = 0; type = inttype
ITEM = 0;
TYPE = 43;
// 5410 radix = 10; value = sym-'0'
RADIX = 10;
VALUE = SYM - 48;
// 5411 ibm1:
U_102F:;
// 5412 %cycle
L_04CB:;
// 5413 %cycle
L_04CC:;
// 5414 %cycle
L_04CD:;
// 5415 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5416 %repeat %until sym # ' '
if (SYM != 32) goto L_04CE;
goto L_04CD;
L_04CE:;
// 5417 i = sym-'0'
I = SYM - 48;
// 5418 %if radix = 10 %start
if (RADIX != 10) goto L_04CF;
// 5419 %exit %if i < 0 %or i >= 10
if (I < 0) goto L_04D0;
if (I < 10) goto L_04D1;
L_04D0:;
goto L_04D2;
L_04D1:;
// 5420 fault(rangerr+point+warn) %if value > max10 %or (value=max10 %and i > maxdig)
if (VALUE > 214748364) goto L_04D3;
if (VALUE != 214748364) goto L_04D4;
if (I <= 7) goto L_04D4;
L_04D3:;
FAULT(24 + 64 + (-128));
L_04D4:;
// 5421 value = (value<<2+value)<<1+i
VALUE = ((VALUE << 2) + VALUE << 1) + I;
// 5422 %else
goto L_04D5;
L_04CF:;
// 5423 i = sym!casebit-'a'+10 %if i >= 10
if (I < 10) goto L_04D6;
I = (SYM | 32) - 97 + 10;
L_04D6:;
// 5424 %exit %if i < 0 %or i >= radix
if (I < 0) goto L_04D7;
if (I < RADIX) goto L_04D8;
L_04D7:;
goto L_04D2;
L_04D8:;
// 5425 j = radix
J = RADIX;
// 5426 %cycle
L_04D9:;
// 5427 i = i+value %if j&1 # 0
if (J & 1 == 0) goto L_04DA;
I = I + VALUE;
L_04DA:;
// 5428 value = value<<1; j = j>>1
VALUE = VALUE << 1;
J = (unsigned int)J >> 1;
// 5429 %repeat %until j = 0
if (J == 0) goto L_04DB;
goto L_04D9;
L_04DB:;
// 5430 value = i
VALUE = I;
// 5431 %finish
L_04D5:;
// 5432 %repeat
goto L_04CC;
L_04D2:;
// 5433 %exit %unless sym = '_'
if (SYM == 95) goto L_04DC;
goto L_04DD;
L_04DC:;
// 5434 radix = value
RADIX = VALUE;
// 5435 %result = dud %if radix = 0
if (RADIX != 0) goto L_04DE;
return 63;
L_04DE:;
// 5436 value = 0
VALUE = 0;
// 5437 %repeat
goto L_04CB;
L_04DD:;
// 5438 %if item < 0 %start; !IBM-style
if (ITEM >= 0) goto L_04DF;
// 5439 %result = dud %if sym # ''''
if (SYM == 39) goto L_04E0;
return 63;
L_04E0:;
// 5440 item = 0
ITEM = 0;
// 5441 %else
goto L_04E1;
L_04DF:;
// 5442 j = 0
J = 0;
// 5443 %if sym = '.' %start
if (SYM != 46) goto L_04E2;
// 5444 rval = value %if type = inttype
if (TYPE != 43) goto L_04E3;
RVAL = VALUE;
L_04E3:;
// 5445 fraction:
U_102B:;
// 5446 j = 0
J = 0;
// 5447 type = realtype
TYPE = 69;
// 5448 %cycle
L_04E4:;
// 5449 get sym
GETSYM();
// 5450 %exit %unless 0 <= i < radix
{
// Double-sided test on I (Part I)
int tmp;
if (0 > (tmp = I)) goto L_04E5;
// Double-sided test on I (Part II)
if (tmp < RADIX) goto L_04E6;
}
L_04E5:;
goto L_04E7;
L_04E6:;
// 5451 rval = rval*radix+i; j = j-1
RVAL = RVAL * RADIX + I;
J = J - 1;
// 5452 %repeat
goto L_04E4;
L_04E7:;
// 5453 %result = dud %if j = 0
if (J != 0) goto L_04E8;
return 63;
L_04E8:;
// 5454 %finish
L_04E2:;
// 5455 %if sym = '@' %start
if (SYM != 64) goto L_04E9;
// 5456 type = realtype %and rval = value %if type = inttype
if (TYPE != 43) goto L_04EA;
TYPE = 69;
RVAL = VALUE;
L_04EA:;
// 5457 get sym
GETSYM();
// 5458 value = 0
VALUE = 0;
// 5459 %if sym = '+' %then get sym %c
if (SYM != 43) goto L_04EB;
GETSYM();
goto L_04EC;
L_04EB:;
if (SYM != 45) goto L_04ED;
VALUE = 1;
GETSYM();
L_04ED:;
L_04EC:;
// 5460+ %else %if sym = '-' %then value = 1 %and get sym
// 5461 %result = dud %unless 0 <= i < radix
{
// Double-sided test on I (Part I)
int tmp;
if (0 > (tmp = I)) goto L_04EE;
// Double-sided test on I (Part II)
if (tmp < RADIX) goto L_04EF;
}
L_04EE:;
return 63;
L_04EF:;
// 5462 p = 0
P = 0;
// 5463 %cycle
L_04F0:;
// 5464 p = p*radix+i
P = P * RADIX + I;
// 5465 get sym
GETSYM();
// 5466 %repeat %until %not 0 <= i < radix
{
// Double-sided test on I (Part I)
int tmp;
if (0 > (tmp = I)) goto L_04F1;
// Double-sided test on I (Part II)
if (tmp >= RADIX) goto L_04F1;
}
goto L_04F0;
L_04F1:;
// 5467 p = -p %if value # 0
if (VALUE == 0) goto L_04F2;
P = -P;
L_04F2:;
// 5468 j = j+p
J = J + P;
// 5469 %finish
L_04E9:;
// 5470 %if type = realtype %start
if (TYPE != 69) goto L_04F3;
// 5471 rval = rval*radix^^j %if j # 0
if (J == 0) goto L_04F4;
RVAL = RVAL * (_imp_IEXP(RADIX, J));
L_04F4:;
// 5472 value = integer(addr(rval)) %if type = realtype
if (TYPE != 69) goto L_04F5;
VALUE = *_imp_INTEGER(_imp_ADDR(/*?*/ &RVAL));
L_04F5:;
// 5473 %finish
L_04F3:;
// 5474 fp = fp-1; sym = 0
FP = FP - 1;
SYM = 0;
// 5475 %finish
L_04E1:;
// 5476 litatoms = litatoms+1
LITATOMS = LITATOMS + 1;
// 5477 %result = const
return 52;
// 5478
// 5479 s(''''):
case_S_39:;
// 5480 charconst:
U_102C:;
// 5481 item = 0; type = inttype
ITEM = 0;
TYPE = 43;
// 5482 value = 0
VALUE = 0;
// 5483 %cycle
L_04F6:;
// 5484 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5485 %result = dud %if sym = nl; !?allow
if (SYM != 10) goto L_04F7;
return 63;
L_04F7:;
// 5486 %if sym = '''' %start
if (SYM != 39) goto L_04F8;
// 5487 %exit %unless byteintegeR(fp) = ''''
if (*_imp_BYTEINTEGER(FP) == 39) goto L_04F9;
goto L_04FA;
L_04F9:;
// 5488 fp = fp+1
FP = FP + 1;
// 5489 %finish
L_04F8:;
// 5490 value = value<<8+sym
VALUE = (VALUE << 8) + SYM;
// 5491 %repeat
goto L_04F6;
L_04FA:;
// 5492 %result = const %if value # 0
if (VALUE == 0) goto L_04FB;
return 52;
L_04FB:;
// 5493 %result = dud
return 63;
// 5494
// 5495 s('"'):
case_S_34:;
// 5496 item = 0
ITEM = 0;
// 5497 value = cad; type = stringtype
VALUE = CAD;
TYPE = 64;
// 5498 i = line; j = linestart; p = 0
I = LINE;
J = LINESTART;
P = 0;
// 5499 %cycle
L_04FC:;
// 5500 sym = byteintegeR(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5501 %if sym = '"' %start
if (SYM != 34) goto L_04FD;
// 5502 %exit %if byteintegeR(fp) # '"'
if (*_imp_BYTEINTEGER(FP) == 34) goto L_04FE;
goto L_04FF;
L_04FE:;
// 5503 fp = fp+1
FP = FP + 1;
// 5504 %finish
L_04FD:;
// 5505 p = p+1
P = P + 1;
// 5506 %if p > 255 %start
if (P <= 255) goto L_0500;
// 5507 sym = 0
SYM = 0;
// 5508 fp = atomp; linestart = j
FP = ATOMP;
LINESTART = J;
// 5509 %result = dud
return 63;
// 5510 %finish
L_0500:;
// 5511 final(value+p) = sym
FINAL[VALUE + P] = SYM;
// 5512 read line('"') %if sym = nl
if (SYM != 10) goto L_0501;
READLINE(34);
L_0501:;
// 5513 %repeat
goto L_04FC;
L_04FF:;
// 5514 %if p # 0 %start; !not empty string
if (P == 0) goto L_0502;
// 5515 final(value) = p
FINAL[VALUE] = P;
// 5516 cad = cad+(p+1)
CAD = CAD + (P + 1);
// 5517 %finish %else value = 0
goto L_0503;
L_0502:;
VALUE = 0;
L_0503:;
// 5518 litatoms = litatoms+1
LITATOMS = LITATOMS + 1;
// 5519 %result = const
return 52;
// 5520
// 5521 s(*):
case_S_default:;
// 5522 %result = dud
return 63;
// 5523 %end; !NEXT ATOM
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 */
// 5524
// 5525 !<<BOTH
// 5526
// 5527 %integerfn A (%integer k)
int A(int K) {
// 5528 !Basic atom-testing predicate
// 5529 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_0504;
ATOM = NEXTATOM();
L_0504:;
// 5530 %result = FALSE %if k # atom
if (K == ATOM) goto L_0505;
return 0;
L_0505:;
// 5531 matched = 1
MATCHED = 1;
// 5532 %result = TRUE
return 1;
// 5533 %end
} /* end of A */
// 5534
// 5535 %routine GET(%integer k)
void GET(int K) {
// 5536 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_0506;
ATOM = NEXTATOM();
L_0506:;
// 5537 matched = 1
MATCHED = 1;
// 5538 %return %if atom = k
if (ATOM != K) goto L_0507;
return;
L_0507:;
// 5539 syntax error { %if atom = dud
SYNTAXERROR();
// 5540 ! faultp = atomp
// 5541 ! report(formerr+point,-k,0)
// 5542 ! %signal fail
// 5543 %end
return;
} /* end of GET */
// 5544
// 5545 !<<IMP
// 5546
// 5547 %routine ALLOW(%integer k)
void ALLOW(int K) {
// 5548 %if a(k)=TRUE %start
if (A(K) != 1) goto L_0508;
// 5549 %finish
L_0508:;
// 5550 %end
return;
} /* end of ALLOW */
// 5551
// 5552 %routine GET LITSTRING
void GETLITSTRING(void) {
// 5553 %integer holditem
int HOLDITEM;
// 5554 !Must be quoted string (for %alias and %include)
// 5555 holditem = item; !preserve
HOLDITEM = ITEM;
// 5556 get(const)
GET(52);
// 5557 error(typerr+point) %unless type = stringtype
if (TYPE == 64) goto L_0509;
ERROR(12 + 64);
L_0509:;
// 5558 cad = value; !reset
CAD = VALUE;
// 5559 item = holditem; !restore
ITEM = HOLDITEM;
// 5560 %end
return;
} /* end of GETLITSTRING */
// 5561
// 5562 !<<BOTH
// 5563
// 5564 %integer%fn IDTEXT(%integer f)
int IDTEXT(int F) {
// 5565 %integer k
int K;
// 5566 %result = ditem_text %if item > 0 %and f&ext = 0; !already exists
if (ITEM <= 0) goto L_050A;
if (F & 16384 != 0) goto L_050A;
return DITEM->TEXT;
L_050A:;
// 5567 charlim = charlim+newlen+1
CHARLIM = CHARLIM + NEWLEN + 1;
// 5568 croak("Identifier space exhausted") %if charlim+80 >= charmin
if (CHARLIM + 80 < CHARMIN) goto L_050B;
CROAK(_imp_str_literal("Identifier space exhausted"));
L_050B:;
// 5569 k = charlim-newlen-1-char0
K = CHARLIM - NEWLEN - 1 - CHAR0;
// 5570 %if f&ext # 0 %and a(keyalias)=TRUE %start
if (F & 16384 == 0) goto L_050C;
if (A(49) != 1) goto L_050C;
// 5571 get LITSTRING
GETLITSTRING();
// 5572 string(charlim) = string(final0+value)
*_imp_STRING(CHARLIM) = *_imp_STRING(FINAL0 + VALUE);
// 5573 byteinteger(charlim) = byteinteger(charlim)+128
*_imp_BYTEINTEGER(CHARLIM) = *_imp_BYTEINTEGER(CHARLIM) + 128;
// 5574 charlim = charlim+byteinteger(charlim)-127
CHARLIM = CHARLIM + *_imp_BYTEINTEGER(CHARLIM) - 127;
// 5575 %finish
L_050C:;
// 5576 %result = k
return K;
// 5577 %end
} /* end of IDTEXT */
// 5578
// 5579 %record(objinfo)%map DETAILS(%integer f,t,m,v)
struct OBJINFO *DETAILS(int F, int T, int M, int V)
{
// 5580 %ownrecord(objinfo) D=0
static struct OBJINFO D = {0};
// 5581 d_flags = f; d_type = t
D.FLAGS = F;
D.TYPE = T;
// 5582 d_mode = m; d_val = v
D.MODE = M;
D.VAL = V;
// 5583 %result == d
return /*?*/ &D;
// 5584 %end
} /* end of DETAILS */
// 5585
// 5586 %routine DECLARE(%record(objinfo)%name d)
void DECLARE(struct OBJINFO * D) {
// 5587 %integer i
int I;
// 5588 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 5589 dp == dict(dlim)
DP = (struct IDENTINFO *)/*?*/ &DICT[DLIM];
// 5590 %if speccing = 0 %start; !not within spec params
if (SPECCING != 0) goto L_050D;
// 5591 %if item >= c_localdpos %start; !there already
if (ITEM < C.LOCALDPOS) goto L_050E;
// 5592 %if d_flags&spec = 0 %and ditem_flags&spec # 0 %start
if (D->FLAGS & 256 != 0) goto L_050F;
if (DITEM->FLAGS & 256 == 0) goto L_050F;
// 5593 !body after spec (proc,label,typeid)
// 5594 %if d_flags&(ext+proc+typeid) = ditem_flags&(ext+proc+typeid) %start
if (D->FLAGS & 16384 + 12288 + 512 != DITEM->FLAGS & 16384 + 12288 + 512) goto L_0510;
// 5595 i = item
I = ITEM;
// 5596 %if d_flags&ext # 0 %start
if (D->FLAGS & 16384 == 0) goto L_0511;
// 5597 ![can't allow %ext%spec, then use, then %ext object]
// 5598 ->ok %if ditem_flags&rflag # 0; ![so create new entry]
if (DITEM->FLAGS & 32 == 0) goto L_0512;
goto U_1030;
L_0512:;
// 5599 ditem_mode = d_mode; ditem_val = d_val
DITEM->MODE = D->MODE;
DITEM->VAL = D->VAL;
// 5600 %if a(keyalias)=TRUE %start
if (A(49) != 1) goto L_0513;
// 5601 get LITSTRING; !ignore [should be identical]
GETLITSTRING();
// 5602 item = i
ITEM = I;
// 5603 %finish
L_0513:;
// 5604 %finish
L_0511:;
// 5605 %if d_flags&proc = 0 %start
if (D->FLAGS & 12288 != 0) goto L_0514;
// 5606 ditem_flags = ditem_flags&(\(spec+indirect))
DITEM->FLAGS = DITEM->FLAGS & ~(256 + 2048);
// 5607 %finish
L_0514:;
// 5608 %return
return;
// 5609 %finish
L_0510:;
// 5610 %if ditem_flags&(ext+proc) = proc1 %and d_flags&ext # 0 %c
if (DITEM->FLAGS & 16384 + 12288 != 4096) goto L_0515;
if (D->FLAGS & 16384 == 0) goto L_0515;
if (D->FLAGS & 12288 == 0) goto L_0515;
// 5611+ %and d_flags&proc # 0 %start; !(internal) %spec then %ext
// 5612 ditem_flags = ditem_flags-proc1+(d_flags&(ext+proc))
DITEM->FLAGS = DITEM->FLAGS - 4096 + (D->FLAGS & 16384 + 12288);
// 5613 ditem_text = idtext(ext); !in case alias
DITEM->TEXT = IDTEXT(16384);
// 5614 %return
return;
// 5615 %finish
L_0515:;
// 5616 %finish
L_050F:;
// 5617 !<<IMP
// 5618 %if item < inclim %and ditem_flags&(rflag+wflag) = 0 %c
if (ITEM >= INCLIM) goto L_0516;
if (DITEM->FLAGS & 32 + 16 != 0) goto L_0516;
FAULT(21 + (-128) + 64);
goto L_0517;
L_0516:;
FAULT(21 + 64);
L_0517:;
// 5619+ %then fault(duperr+warn+point) %else fault(duperr+point)
// 5620 !<<BOTH
// 5621 %finish
L_050E:;
// 5622 ok: dp_hlink = head; head = dlim; !insert in list
U_1030:;
DP->HLINK = *HEAD;
*HEAD = DLIM;
// 5623 dp_text = idtext(d_flags)
DP->TEXT = IDTEXT(D->FLAGS);
// 5624 %finish %else dp_hlink = 0 %and dp_text = 0
goto L_0518;
L_050D:;
DP->HLINK = 0;
DP->TEXT = 0;
L_0518:;
// 5625 item = dlim; ditem == dp
ITEM = DLIM;
DITEM = (struct IDENTINFO *)DP;
// 5626 ditem_details = d
DITEM->DETAILS = *D;
// 5627 dlim = dlim+1
DLIM = DLIM + 1;
// 5628 %if dlim >= dmin %start
if (DLIM < DMIN) goto L_0519;
// 5629 {?} show dict(0) %if control&logbit # 0
if (CONTROL & 1024 == 0) goto L_051A;
SHOWDICT(0);
L_051A:;
// 5630 croak("Too many identifiers")
CROAK(_imp_str_literal("Too many identifiers"));
// 5631 %finish
L_0519:;
// 5632 %end; !DECLARE
return;
} /* end of DECLARE */
// 5633
// 5634 %routine DECLARE ANON(%record(objinfo)%name d)
void DECLAREANON(struct OBJINFO * D) {
// 5635 speccing = speccing+1
SPECCING = SPECCING + 1;
// 5636 item = 0
ITEM = 0;
// 5637 declare(d)
DECLARE(D);
// 5638 speccing = speccing-1
SPECCING = SPECCING - 1;
// 5639 %end
return;
} /* end of DECLAREANON */
// 5640 !
// 5641 %routine DECLARE TEMP(%integer t)
void DECLARETEMP(int T) {
// 5642 c_val = c_val+4; c_temps = c_temps+4
C.VAL = C.VAL + 4;
C.TEMPS = C.TEMPS + 4;
// 5643 declare anon(details(okflag+writable+readable,t,c_mode,c_sp-c_val))
DECLAREANON(DETAILS(64 + 1 + 2, T, C.MODE, C.SP - C.VAL));
// 5644 %end
return;
} /* end of DECLARETEMP */
// 5645 !
// 5646 %routine DECLARE RANGE(%integer type,lower,upper)
void DECLARERANGE(int TYPE, int LOWER, int UPPER) {
// 5647 !Type ident just declared
// 5648 %integer s
int S;
// 5649 %integerfn OK(%integer l,u)
int OK(int L, int U) {
// 5650 %result = TRUE %if (l <= lower %and upper <= u) {signed} %c
if (L > LOWER) goto L_051B;
if (UPPER <= U) goto L_051C;
L_051B:;
if (0 > LOWER) goto L_051D;
if (UPPER > U - L) goto L_051D;
L_051C:;
return 1;
L_051D:;
// 5651+ %or (0 <= lower %and upper <= u-l) {unsigned}
// 5652 %result = FALSE
return 0;
// 5653 %end
} /* end of OK */
// 5654 s = 4
S = 4;
// 5655 %if ok(-32768,32767)=TRUE %start
if (OK(-32768, 32767) != 1) goto L_051E;
// 5656 s = 2; s = 1 %if ok(-128,127)=TRUE
S = 2;
if (OK(-128, 127) != 1) goto L_051F;
S = 1;
L_051F:;
// 5657 %finish
L_051E:;
// 5658 ditem_details = details(typeid,type,absmode,sign)
DITEM->DETAILS = *DETAILS(512, TYPE, 56, -2147483648);
// 5659 ditem_size = s
DITEM->SIZE = S;
// 5660 declare anon(details(okflag,type,litmode,lower))
DECLAREANON(DETAILS(64, TYPE, 60, LOWER));
// 5661 declare anon(details(okflag,type,litmode,upper))
DECLAREANON(DETAILS(64, TYPE, 60, UPPER));
// 5662 ditem_hlink = ranges; ranges = item
DITEM->HLINK = RANGES;
RANGES = ITEM;
// 5663 item = item-2
ITEM = ITEM - 2;
// 5664 %end
return;
} /* end of DECLARERANGE */
// 5665
// 5666 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5667 !!!!!!!!!!!!!!!!!!!! Expressions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5668 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5669
// 5670 %owninteger LITERAL=0, JAMMY=0
static int LITERAL = 0;
static int JAMMY = 0;
auto void GETEXPRESSION(int RANK, int ETYPE);
// 5671
// 5672 %routine%spec GET EXPRESSION(%integer rank,etype)
// 5673 !
// 5674 %integerfn VALOK(%integer wanted,t)
int VALOK(int WANTED, int T) {
// 5675 %integer lo,hi,l,h,wc,tc
int LO;
int HI;
int L;
int H;
int WC;
int TC;
// 5676 %record(identinfo)%name wp,tp
struct IDENTINFO *WP;
struct IDENTINFO *TP;
// 5677 %result = TRUE %if wanted = t # recstar
{
// Double-sided test on T (Part I)
int tmp;
if (WANTED != (tmp = T)) goto L_0520;
// Double-sided test on T (Part II)
if (tmp == 67) goto L_0520;
}
return 1;
L_0520:;
// 5678 wp == typecell(wanted); tp == typecell(t)
WP = (struct IDENTINFO *)TYPECELL(WANTED);
TP = (struct IDENTINFO *)TYPECELL(T);
// 5679 wc = wp_flags&(packed+cat); tc = tp_flags&(packed+cat)
WC = WP->FLAGS & 1024 + 15;
TC = TP->FLAGS & 1024 + 15;
// 5680 %if wc = tc %start; !same class
if (WC != TC) goto L_0521;
// 5681 %if wc&nonord = 0 %start; !ordinal wanted
if (WC & 12 != 0) goto L_0522;
// 5682 %if wp_type = tp_type %start; !same base-type
if (WP->TYPE != TP->TYPE) goto L_0523;
// 5683 %result = TRUE %if wp_type = wanted; !base-type (rather than subrange)
if (WP->TYPE != WANTED) goto L_0524;
return 1;
L_0524:;
// 5684 %if dict(wanted+1)_mode # litmode %then get bounds(dict(wanted+1)_type,lo,hi) %c
if (DICT[WANTED + 1].MODE == 60) goto L_0525;
GETBOUNDS(DICT[WANTED + 1].TYPE, /*?*/ &LO, /*?*/ &HI);
goto L_0526;
L_0525:;
LO = DICT[WANTED + 1].VAL;
L_0526:;
// 5685+ %else lo = dict(wanted+1)_val
// 5686 %if dict(wanted+2)_mode # litmode %then get bounds(dict(wanted+2)_type,hi,hi) %c
if (DICT[WANTED + 2].MODE == 60) goto L_0527;
GETBOUNDS(DICT[WANTED + 2].TYPE, /*?*/ &HI, /*?*/ &HI);
goto L_0528;
L_0527:;
HI = DICT[WANTED + 2].VAL;
L_0528:;
// 5687+ %else hi = dict(wanted+2)_val
// 5688 %if item = 0 %start; !literal
if (ITEM != 0) goto L_0529;
// 5689 %result = TRUE %if lo <= value <= hi
{
// Double-sided test on VALUE (Part I)
int tmp;
if (LO > (tmp = VALUE)) goto L_052A;
// Double-sided test on VALUE (Part II)
if (tmp > HI) goto L_052A;
}
return 1;
L_052A:;
// 5690 jammy = jammy!!1
JAMMY = JAMMY ^ 1;
// 5691 %else
goto L_052B;
L_0529:;
// 5692 jammy = jammy!!1 %and %result = TRUE %if tp_type = t
if (TP->TYPE != T) goto L_052C;
JAMMY = JAMMY ^ 1;
return 1;
L_052C:;
// 5693 %if dict(t+1)_mode # litmode %then get bounds(dict(t+1)_type,l,h) %c
if (DICT[T + 1].MODE == 60) goto L_052D;
GETBOUNDS(DICT[T + 1].TYPE, /*?*/ &L, /*?*/ &H);
goto L_052E;
L_052D:;
L = DICT[T + 1].VAL;
L_052E:;
// 5694+ %else l = dict(t+1)_val
// 5695 %if dict(t+2)_mode # litmode %then get bounds(dict(t+2)_type,h,h) %c
if (DICT[T + 2].MODE == 60) goto L_052F;
GETBOUNDS(DICT[T + 2].TYPE, /*?*/ &H, /*?*/ &H);
goto L_0530;
L_052F:;
H = DICT[T + 2].VAL;
L_0530:;
// 5696+ %else h = dict(t+2)_val
// 5697 %if l >= lo %start
if (L < LO) goto L_0531;
// 5698 %result = TRUE %if h <= hi
if (H > HI) goto L_0532;
return 1;
L_0532:;
// 5699 jammy = jammy!!1
JAMMY = JAMMY ^ 1;
// 5700 %result = TRUE %if l <= hi
if (L > HI) goto L_0533;
return 1;
L_0533:;
// 5701 %else
goto L_0534;
L_0531:;
// 5702 jammy = jammy!!1
JAMMY = JAMMY ^ 1;
// 5703 %result = TRUE %if h >= lo
if (H < LO) goto L_0535;
return 1;
L_0535:;
// 5704 %finish
L_0534:;
// 5705 %finish
L_052B:;
// 5706 expfault(rangerr) %if jammy # 0
if (JAMMY == 0) goto L_0536;
EXPFAULT(24);
L_0536:;
// 5707 %result = TRUE
return 1;
// 5708 %finish
L_0523:;
// 5709 %finish %else %if wc = realy %start
goto L_0537;
L_0522:;
if (WC != 5) goto L_0538;
// 5710 %result = TRUE
return 1;
// 5711 %finish %else %if wc = stringy %start; !string wanted
L_0538:;
if (WC != 8) goto L_0539;
// 5712 %result = TRUE %if wanted = stringstar
if (WANTED != 62) goto L_053A;
return 1;
L_053A:;
// 5713 %if item = 0 %start
if (ITEM != 0) goto L_053B;
// 5714 %result = TRUE %if value = 0; !empty string
if (VALUE != 0) goto L_053C;
return 1;
L_053C:;
// 5715 l = final(value)+1
L = FINAL[VALUE] + 1;
// 5716 %else
goto L_053D;
L_053B:;
// 5717 l = imod(tp_size)
L = _imp_IMOD(TP->SIZE);
// 5718 l = 256 %if l = 0
if (L != 0) goto L_053E;
L = 256;
L_053E:;
// 5719 %finish
L_053D:;
// 5720 %if l > imod(wp_size) # 0 %start
{
// Double-sided test on _imp_IMOD(WP->SIZE) (Part I)
int tmp;
if (L <= (tmp = _imp_IMOD(WP->SIZE))) goto L_053F;
// Double-sided test on _imp_IMOD(WP->SIZE) (Part II)
if (tmp == 0) goto L_053F;
}
// 5721 jammy = jammy!!1
JAMMY = JAMMY ^ 1;
// 5722 expfault(rangerr) %if item = 0 %and jammy # 0
if (ITEM != 0) goto L_0540;
if (JAMMY == 0) goto L_0540;
EXPFAULT(24);
L_0540:;
// 5723 %finish
L_053F:;
// 5724 %result = TRUE
return 1;
// 5725 !<<IMP
// 5726 %finish %else %if wc&cat = arry %start
L_0539:;
if (WC & 15 != 9) goto L_0541;
// 5727 %result = TRUE %if wp_type = tp_type %and valok(wp_xtype,tp_xtype)=TRUE
if (WP->TYPE != TP->TYPE) goto L_0542;
if (VALOK(WP->XTYPE, TP->XTYPE) != 1) goto L_0542;
return 1;
L_0542:;
// 5728 !<<BOTH
// 5729 %else; !record etc
goto L_0537;
L_0541:;
// 5730 %if wanted = recstar %start
if (WANTED != 67) goto L_0543;
// 5731 %result = TRUE %if t # recstar
if (T == 67) goto L_0544;
return 1;
L_0544:;
// 5732 %else
goto L_0545;
L_0543:;
// 5733 %result = TRUE %if t = recstar %or item!value = 0
if (T == 67) goto L_0546;
if (ITEM | VALUE != 0) goto L_0547;
L_0546:;
return 1;
L_0547:;
// 5734 %finish
L_0545:;
// 5735 %finish
L_0537:;
// 5736 %else; !category difference
goto L_0548;
L_0521:;
// 5737 %if tc = inty %start
if (TC != 0) goto L_0549;
// 5738 %result = TRUE %if wc = recy %and item!value = 0; !RECORD = 0
if (WC != 12) goto L_054A;
if (ITEM | VALUE != 0) goto L_054A;
return 1;
L_054A:;
// 5739 toreal %and %result = TRUE %if wc = realy; !REAL = INT
if (WC != 5) goto L_054B;
TOREAL();
return 1;
L_054B:;
// 5740 %finish %else %if wc = stringy %and t = chartype %start; !STRING = CHAR
goto L_054C;
L_0549:;
if (WC != 8) goto L_054D;
if (T != 61) goto L_054D;
// 5741 %if item = 0 %start; !null string
if (ITEM != 0) goto L_054E;
// 5742 final(cad) = 1; final(cad+1) = value
FINAL[CAD] = 1;
FINAL[CAD + 1] = VALUE;
// 5743 value = cad; cad = cad+2
VALUE = CAD;
CAD = CAD + 2;
// 5744 type = stringtype
TYPE = 64;
// 5745 %finish %else putexp(dtostring,normitem,0,string1)
goto L_054F;
L_054E:;
PUTEXP(107, NORMITEM(), 0, 63);
L_054F:;
// 5746 %result = TRUE
return 1;
// 5747 !<<IMP
// 5748 ! sets again
// 5749 !<<BOTH
// 5750 %finish
L_054D:;
L_054C:;
// 5751 %finish
L_0548:;
// 5752 %result = FALSE
return 0;
// 5753 %end
} /* end of VALOK */
// 5754 !
// 5755 %routine GET VALUE(%integer valtype)
void GETVALUE(int VALTYPE) {
// 5756 get EXPRESSION(major,valtype)
GETEXPRESSION(83, VALTYPE);
// 5757 %end; !GET VALUE
return;
} /* end of GETVALUE */
// 5758 !
// 5759 %routine GET LITERAL(%integer t)
void GETLITERAL(int T) {
// 5760 literal = literal+1
LITERAL = LITERAL + 1;
// 5761 get EXPRESSION(major,t)
GETEXPRESSION(83, T);
// 5762 literal = literal-1
LITERAL = LITERAL - 1;
// 5763 %end
return;
} /* end of GETLITERAL */
// 5764 !
// 5765 !!!!!!!!!!!!!!!!!!!!!! Machine-code !!!!!!!!!!!!!!!!!!!!!!!!!!
// 5766 !
// 5767 %routine GET MIDENT(%integer min,max)
void GETMIDENT(int MIN, int MAX) {
// 5768 get(ident)
GET(53);
// 5769 %if item <= 0 %start
if (ITEM > 0) goto L_0550;
// 5770 name error %if string(charlim) # "sp"
if (_imp_strcmp((_imp_string *)_imp_STRING(CHARLIM), (_imp_string *)/*?*/ _imp_str_literal_ptr("sp")) == 0)
goto L_0551;
NAMEERROR();
L_0551:;
// 5771 item = a7
ITEM = 16;
// 5772 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM];
// 5773 %finish
L_0550:;
// 5774 %if ditem_mode = litmode %start
if (DITEM->MODE != 60) goto L_0552;
// 5775 value = ditem_val; item = 0
VALUE = DITEM->VAL;
ITEM = 0;
// 5776 %finish
L_0552:;
// 5777 syntax error %unless min <= item <= max
{
// Double-sided test on ITEM (Part I)
int tmp;
if (MIN > (tmp = ITEM)) goto L_0553;
// Double-sided test on ITEM (Part II)
if (tmp <= MAX) goto L_0554;
}
L_0553:;
SYNTAXERROR();
L_0554:;
// 5778 %end
return;
} /* end of GETMIDENT */
// 5779
// 5780 %routine GET REGSET
void GETREGSET(void) {
// 5781 %integer hold,set
int HOLD;
int SET;
// 5782 set=0
SET = 0;
// 5783 %cycle
L_0555:;
// 5784 get mident(d0,a7)
GETMIDENT(1, 16);
// 5785 hold = item
HOLD = ITEM;
// 5786 get mident(hold,a7) %if a(minus)=TRUE
if (A(84) != 1) goto L_0556;
GETMIDENT(HOLD, 16);
L_0556:;
// 5787 %cycle
L_0557:;
// 5788 set = set!1<<(hold-d0)
SET = SET | 1 << HOLD - 1;
// 5789 hold = hold+1
HOLD = HOLD + 1;
// 5790 %repeat %until hold > item
if (HOLD > ITEM) goto L_0558;
goto L_0557;
L_0558:;
// 5791 %repeat %until %not a(slash)=TRUE
if (A(90) != 1) goto L_0559;
goto L_0555;
L_0559:;
// 5792 item = 0; value = set
ITEM = 0;
VALUE = SET;
// 5793 %end
return;
} /* end of GETREGSET */
// 5794
// 5795 %routine get MCODE
void GETMCODE(void) {
// 5796 %integer op,x,y,types
int OP;
int X;
int Y;
int TYPES;
// 5797
// 5798 %integer%fn OPSIZE(%integer okbyte)
int OPSIZE(int OKBYTE) {
// 5799 %result = 0 %unless a(dot)=TRUE
if (A(87) == 1) goto L_055A;
return 0;
L_055A:;
// 5800 sym = byteinteger(fp)&(\casebit); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP) & (~32);
FP = FP + 1;
// 5801 %result = 4 %if sym = 'L'
if (SYM != 76) goto L_055B;
return 4;
L_055B:;
// 5802 %result = 2 %if sym = 'W'
if (SYM != 87) goto L_055C;
return 2;
L_055C:;
// 5803 %result = 1 %if sym = okbyte
if (SYM != OKBYTE) goto L_055D;
return 1;
L_055D:;
// 5804 syntax error
SYNTAXERROR();
// 5805 %end
_imp_signal(8, 4, 0, "result missing");
} /* end of OPSIZE */
// 5806
// 5807 %routine get MOP(%integer t,dummy,%record(identinfo)%name dp)
void GETMOP(int T, int DUMMY, struct IDENTINFO *DP) {
// 5808 !Get Mcode operand
// 5809 %constinteger HASHSIGN=noteq
// 5810 %integer sign,hold,holdval,m
int SIGN;
int HOLD;
int HOLDVAL;
int M;
// 5811 %if a(hashsign)=TRUE %start
if (A(78) != 1) goto L_055E;
// 5812 get LITERAL(inttype)
GETLITERAL(43);
// 5813 %return
return;
// 5814 %finish
L_055E:;
// 5815 sign = 0; hold = -1; holdval = 0
SIGN = 0;
HOLD = -1;
HOLDVAL = 0;
// 5816 sign = 1 %if a(minus)=TRUE
if (A(84) != 1) goto L_055F;
SIGN = 1;
L_055F:;
// 5817 %if a(ident)=TRUE %start
if (A(53) != 1) goto L_0560;
// 5818 matched = 0
MATCHED = 0;
// 5819 get mident(0,dlim)
GETMIDENT(0, DLIM);
// 5820 hold = item
HOLD = ITEM;
// 5821 %if hold # 0 %start
if (HOLD == 0) goto L_0561;
// 5822 syntax error %if sign # 0
if (SIGN == 0) goto L_0562;
SYNTAXERROR();
L_0562:;
// 5823 %if item > a7 %start
if (ITEM <= 16) goto L_0563;
// 5824 dp_flags = ditem_flags
DP->FLAGS = DITEM->FLAGS;
// 5825 dp_mode = ditem_mode; dp_val = ditem_val
DP->MODE = DITEM->MODE;
DP->VAL = DITEM->VAL;
// 5826 %while a(recsub)=TRUE %cycle
L_0564:;
if (A(58) != 1) goto L_0565;
// 5827 dformat == typecell(ditem_type)
DFORMAT = (struct IDENTINFO *)TYPECELL(DITEM->TYPE);
// 5828 syntax error %unless dformat_flags&cat = recy %c
if (DFORMAT->FLAGS & 15 != 12) goto L_0566;
if (DITEM->FLAGS & (-32768) + 2048 == 0) goto L_0567;
L_0566:;
SYNTAXERROR();
L_0567:;
// 5829+ %and ditem_flags&(name+indirect) = 0
// 5830 subbed = 1; get(ident); subbed = 0
SUBBED = 1;
GET(53);
SUBBED = 0;
// 5831 error(namerr+point) %if item <= 0
if (ITEM > 0) goto L_0568;
ERROR(9 + 64);
L_0568:;
// 5832 dp_flags = ditem_flags; dp_type = ditem_type
DP->FLAGS = DITEM->FLAGS;
DP->TYPE = DITEM->TYPE;
// 5833 dp_val = dp_val+ditem_val
DP->VAL = DP->VAL + DITEM->VAL;
// 5834 item = dummy; ditem == dp
ITEM = DUMMY;
DITEM = (struct IDENTINFO *)DP;
// 5835 %repeat
goto L_0564;
L_0565:;
// 5836 %return
return;
// 5837 %finish
L_0563:;
// 5838 %if op&255 = movem %and item > 0 %start
if (OP & 255 != 100) goto L_0569;
if (ITEM <= 0) goto L_0569;
// 5839 matched = 0
MATCHED = 0;
// 5840 get regset
GETREGSET();
// 5841 %finish
L_0569:;
// 5842 %return
return;
// 5843 %finish
L_0561:;
// 5844 holdval = value
HOLDVAL = VALUE;
// 5845 %finish %else %if a(const)=TRUE %start
goto L_056A;
L_0560:;
if (A(52) != 1) goto L_056B;
// 5846 hold = 0; holdval = value
HOLD = 0;
HOLDVAL = VALUE;
// 5847 %finish
L_056B:;
L_056A:;
// 5848 holdval = -holdval %if sign # 0
if (SIGN == 0) goto L_056C;
HOLDVAL = -HOLDVAL;
L_056C:;
// 5849 %if a(left)=TRUE %start
if (A(55) != 1) goto L_056D;
// 5850 get mident(a0,a7)
GETMIDENT(9, 16);
// 5851 %if hold < 0 %start
if (HOLD >= 0) goto L_056E;
// 5852 get(right)
GET(61);
// 5853 %if sign # 0 %then item = item+pre %c
if (SIGN == 0) goto L_056F;
ITEM = ITEM + 24;
goto L_0570;
L_056F:;
if (A(83) == 1) goto L_0571;
ITEM = ITEM + 8;
goto L_0570;
L_0571:;
ITEM = ITEM + 16;
L_0570:;
// 5854+ %else %unless a(plus)=TRUE %then item = item+indir %c
// 5855+ %else item = item+post
// 5856 %return
return;
// 5857 %finish
L_056E:;
// 5858 m = item+(dispmode-a0)
M = ITEM + (40 - 9);
// 5859 %if a(comma)=TRUE %start
if (A(60) != 1) goto L_0572;
// 5860 get mident(d0,a7)
GETMIDENT(1, 16);
// 5861 fault(rangerr) %unless is mite(holdval)=TRUE
if (ISMITE(HOLDVAL) == 1) goto L_0573;
FAULT(24);
L_0573:;
// 5862 m = m+(indexmode-dispmode)
M = M + (48 - 40);
// 5863 holdval = (item-d0)<<12+holdval&255
HOLDVAL = (ITEM - 1 << 12) + (HOLDVAL & 255);
// 5864 holdval = holdval+16_0800 %if opsize(0) # 2
if (OPSIZE(0) == 2) goto L_0574;
HOLDVAL = HOLDVAL + 2048;
L_0574:;
// 5865 %finish
L_0572:;
// 5866 get(right)
GET(61);
// 5867 %else
goto L_0575;
L_056D:;
// 5868 syntax error %if hold < 0
if (HOLD >= 0) goto L_0576;
SYNTAXERROR();
L_0576:;
// 5869 m = absmode
M = 56;
// 5870 %finish
L_0575:;
// 5871 dp_mode = m; dp_val = holdval
DP->MODE = M;
DP->VAL = HOLDVAL;
// 5872 item = dummy
ITEM = DUMMY;
// 5873 %end
return;
} /* end of GETMOP */
// ?T unused
// 5874
// 5875 %constinteger temp=((('t'&31)<<5+('e'&31))<<5+('m'&31))<<5+('p'&31)
// 5876 update sp
UPDATESP();
// 5877 !Pack mnemonic
// 5878 atomp = fp+1
ATOMP = FP + 1;
// 5879 x = 0
X = 0;
// 5880 %cycle
L_0577:;
// 5881 sym = byteinteger(fp); fp = fp+1
SYM = *_imp_BYTEINTEGER(FP);
FP = FP + 1;
// 5882 %exit %unless 'A' <= sym&(\casebit) <= 'Z'
{
// Double-sided test on SYM & (~32) (Part I)
int tmp;
if (65 > (tmp = SYM & (~32))) goto L_0578;
// Double-sided test on SYM & (~32) (Part II)
if (tmp <= 90) goto L_0579;
}
L_0578:;
goto L_057A;
L_0579:;
// 5883 sym = sym&31
SYM = SYM & 31;
// 5884 x = x<<5+sym
X = (X << 5) + SYM;
// 5885 %repeat
goto L_0577;
L_057A:;
// 5886 fp = fp-1; sym = 0
FP = FP - 1;
SYM = 0;
// 5887 syntax error %if x = 0
if (X != 0) goto L_057B;
SYNTAXERROR();
L_057B:;
// 5888 %if x = temp %start; !*TEMP ...
if (X != 660912) goto L_057C;
// 5889 value = 0
VALUE = 0;
// 5890 matched = 0 %and get regset %if a(ident)=TRUE
if (A(53) != 1) goto L_057D;
MATCHED = 0;
GETREGSET();
L_057D:;
// 5891 c_free = value
C.FREE = VALUE;
// 5892 %return
return;
// 5893 %finish
L_057C:;
// 5894 x = x<<5 %until x&(31<<25) # 0
L_057E:;
X = X << 5;
if (X & 31 << 25 != 0) goto L_057F;
goto L_057E;
L_057F:;
// 5895 x = x!16_C0000000
X = X | (-1073741824);
// 5896 find op(x,op,types)
FINDOP(X, /*?*/ &OP, /*?*/ &TYPES);
// 5897 op = op+opsize('B')<<8 %if types&(sized!asized) # 0
if (TYPES & (32768 | 16384) == 0) goto L_0580;
OP = OP + (OPSIZE(66) << 8);
L_0580:;
// 5898 x = 0; y = 0
X = 0;
Y = 0;
// 5899 %if types>>6&63 # 0 %start
if ((unsigned int)TYPES >> 6 & 63 == 0) goto L_0581;
// 5900 get MOP(types>>6&63,lablim,dtemp)
GETMOP((unsigned int)TYPES >> 6 & 63, LABLIM, DTEMP);
// 5901 x = normitem
X = NORMITEM();
// 5902 get(comma) %if types&63 # 0
if (TYPES & 63 == 0) goto L_0582;
GET(60);
L_0582:;
// 5903 %finish
L_0581:;
// 5904 %if types&63 # 0 %start
if (TYPES & 63 == 0) goto L_0583;
// 5905 get MOP(types&63,lablim+1,dtemp2)
GETMOP(TYPES & 63, LABLIM + 1, DTEMP2);
// 5906 y = normitem
Y = NORMITEM();
// 5907 %finish
L_0583:;
// 5908 plant(op,x,y)
PLANT(OP, X, Y);
// 5909 forget regs; c_access = -1
FORGETREGS();
C.ACCESS = -1;
// 5910 %end; !get MCODE
return;
} /* end of GETMCODE */
// 5911
// 5912 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 5913
// 5914 %integerfn REFOK(%integer wanted,t)
int REFOK(int WANTED, int T) {
// 5915 %record(identinfo)%name wp,tp
struct IDENTINFO *WP;
struct IDENTINFO *TP;
// 5916 %result = TRUE %if t = wanted %or wanted = 0 %or t = 0 %or item!value = 0
if (T == WANTED) goto L_0584;
if (WANTED == 0) goto L_0584;
if (T == 0) goto L_0584;
if (ITEM | VALUE != 0) goto L_0585;
L_0584:;
return 1;
L_0585:;
// 5917 wp == typecell(wanted); tp == typecell(t)
WP = (struct IDENTINFO *)TYPECELL(WANTED);
TP = (struct IDENTINFO *)TYPECELL(T);
// 5918 %if (wp_flags!!tp_flags)&(name+packed+cat) = 0 %start
if ((WP->FLAGS ^ TP->FLAGS) & (-32768) + 1024 + 15 != 0) goto L_0586;
// 5919 %if wp_flags&cat = arry %start
if (WP->FLAGS & 15 != 9) goto L_0587;
// 5920 !**check index compatible
// 5921 %result = TRUE %if refok(wp_type,tp_type)=TRUE
if (REFOK(WP->TYPE, TP->TYPE) != 1) goto L_0588;
return 1;
L_0588:;
// 5922 %finish %else %if wp_flags&cat = stringy %start
goto L_0589;
L_0587:;
if (WP->FLAGS & 15 != 8) goto L_058A;
// 5923 %result = TRUE %if tp_size = 0 %or wp_size = 0
if (TP->SIZE == 0) goto L_058B;
if (WP->SIZE != 0) goto L_058C;
L_058B:;
return 1;
L_058C:;
// 5924 !<<IMP
// 5925 !<<BOTH
// 5926 %else
goto L_0589;
L_058A:;
// 5927 %result = TRUE %if t = recstar %or wanted = recstar
if (T == 67) goto L_058D;
if (WANTED != 67) goto L_058E;
L_058D:;
return 1;
L_058E:;
// 5928 %finish
L_0589:;
// 5929 %finish
L_0586:;
// 5930 %result = FALSE
return 0;
// 5931 %end
} /* end of REFOK */
// 5932
// 5933 %routine TOREF
void TOREF(void) {
// 5934 atomp=expp %and error(nonref+point) %if item <= 0 %or ditem_mode < dispmode
if (ITEM <= 0) goto L_058F;
if (DITEM->MODE >= 40) goto L_0590;
L_058F:;
ATOMP = EXPP;
ERROR(33 + 64);
L_0590:;
// 5935 %if item >= dictlim %start
if (ITEM < DICTLIM) goto L_0591;
// 5936 ! %if ditem_act = prel %and (ditem_y < 0 %or ditem_type = bytetype) %start
// 5937 ! value = ditem_y
// 5938 ! value = litref(litval(value)*imod(size(ditem_type))) %if ditem_type # bytetype
// 5939 ! putexp(add,ditem_x+ad,value,ditem_type)
// 5940 ! %return
// 5941 ! %finish
// 5942 %else
goto L_0592;
L_0591:;
// 5943 %if ditem_mode = absmode %and ditem_flags >= 0 %start
if (DITEM->MODE != 56) goto L_0593;
if (DITEM->FLAGS < 0) goto L_0593;
// 5944 item = 0; value = ditem_val
ITEM = 0;
VALUE = DITEM->VAL;
// 5945 %return
return;
// 5946 %finish
L_0593:;
// 5947 %finish
L_0592:;
// 5948 item = item+ad
ITEM = ITEM + 16384;
// 5949 %end
return;
} /* end of TOREF */
// 5950 !
// 5951 %routine COPY DOWN(%integer np1)
void COPYDOWN(int NP1) {
// 5952 %while np > np1 %cycle
L_0594:;
if (NP <= NP1) goto L_0595;
// 5953 np = np-1; explo = explo-1
NP = NP - 1;
EXPLO = EXPLO - 1;
// 5954 dict(explo) = dict(np)
DICT[EXPLO] = DICT[NP];
// 5955 %repeat
goto L_0594;
L_0595:;
// 5956 %end
return;
} /* end of COPYDOWN */
// 5957
// 5958 %routine GET REFERENCE(%integer reftype)
void GETREFERENCE(int REFTYPE) {
// 5959 get EXPRESSION(simple,reftype!sign16)
GETEXPRESSION(100, REFTYPE | (-32768));
// 5960 %end
return;
} /* end of GETREFERENCE */
// 5961 !
// 5962 %routine GET PARLIST(%integer special)
void GETPARLIST(int SPECIAL) {
// 5963 %integer procnp,pact,hold,count,headitem,arg,p,q,restype
int PROCNP;
int PACT;
int HOLD;
int COUNT;
int HEADITEM;
int ARG;
int P;
int Q;
int RESTYPE;
// 5964 %record(identinfo)%name hp,tp
struct IDENTINFO *HP;
struct IDENTINFO *TP;
// 5965 %record(identinfo)%name darg
struct IDENTINFO *DARG;
// 5966
// 5967 %routine PUT ACTUAL
void PUTACTUAL(void) {
// 5968 item = litref(value) %if item = 0
if (ITEM != 0) goto L_0596;
ITEM = LITREF(VALUE);
L_0596:;
// 5969 %if count&1 = 0 %then hold = item %c
if (COUNT & 1 != 0) goto L_0597;
HOLD = ITEM;
goto L_0598;
L_0597:;
PUTACT(PACT, HOLD, ITEM);
PACT = 0;
L_0598:;
// 5970+ %else putact(pact,hold,item) %and pact = 0
// 5971 count = count+1
COUNT = COUNT + 1;
// 5972 %end
return;
} /* end of PUTACTUAL */
// 5973
// 5974 %integerfn NO ALT
int NOALT(void) {
// 5975 %if hp_flags&alt = 0 %start; !no alternative
if (HP->FLAGS & 8 != 0) goto L_0599;
// 5976 expfault(typerr)
EXPFAULT(12);
// 5977 %result = TRUE
return 1;
// 5978 %finish
L_0599:;
// 5979 item = hp_hlink
ITEM = HP->HLINK;
// 5980 %cycle
L_059A:;
// 5981 report(internerr,0,6) %and %signal fail %if item <= 0
if (ITEM > 0) goto L_059B;
REPORT(1, 0, 6);
_imp_signal(11, 0, 0, "");
L_059B:;
// 5982 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM];
// 5983 %exit %if string(ditem_text+char0) = string(hp_text+char0)
if (_imp_strcmp((_imp_string *)_imp_STRING(DITEM->TEXT + CHAR0), (_imp_string *)_imp_STRING(HP->TEXT + CHAR0)) !=
0)
goto L_059C;
goto L_059D;
L_059C:;
// 5984 item = ditem_hlink
ITEM = DITEM->HLINK;
// 5985 %repeat
goto L_059A;
L_059D:;
// 5986 headitem = item; pact = headitem; hp == ditem
HEADITEM = ITEM;
PACT = HEADITEM;
HP = (struct IDENTINFO *)DITEM;
// 5987 arg = hp_type; darg == dict(arg); restype = darg_type
ARG = HP->TYPE;
DARG = (struct IDENTINFO *)/*?*/ &DICT[ARG];
RESTYPE = DARG->TYPE;
// 5988 %result = FALSE
return 0;
// 5989 %end
} /* end of NOALT */
// 5990
// 5991 %routine PUT BOUNDS(%integer ft,at)
void PUTBOUNDS(int FT, int AT) {
// 5992 ! FT is TYPE of formal, AT of actual array
// 5993 %integer maxarg
int MAXARG;
// 5994 %record(identinfo)%name ftp,atp,fxp,axp
struct IDENTINFO *FTP;
struct IDENTINFO *ATP;
struct IDENTINFO *FXP;
struct IDENTINFO *AXP;
// 5995 maxarg=arg
MAXARG = ARG;
// 5996 %cycle
L_059E:;
// 5997 ftp == typecell(ft); atp == typecell(at)
FTP = (struct IDENTINFO *)TYPECELL(FT);
ATP = (struct IDENTINFO *)TYPECELL(AT);
// 5998 ! %if ftp_flags&indirect # 0 %start; !complete dope vector
// 5999 ! ![now only for %string(*)%array%name]
// 6000 ! intern(11) %unless ftp_type = stringstar
// 6001 ! item = at
// 6002 ! put actual
// 6003 ! maxarg = ft %if ft > maxarg
// 6004 ! %exit
// 6005 ! %finish
// 6006 %if ftp_flags&cat = stringy %start
if (FTP->FLAGS & 15 != 8) goto L_059F;
// 6007 %exit %if ftp_size # 0
if (FTP->SIZE == 0) goto L_05A0;
goto L_05A1;
L_05A0:;
// 6008 %if atp_size # 0 %then item = litref(imod(atp_size)) %C
if (ATP->SIZE == 0) goto L_05A2;
ITEM = LITREF(_imp_IMOD(ATP->SIZE));
goto L_05A3;
L_05A2:;
ITEM = AT - 1;
L_05A3:;
// 6009+ %else item = at-1
// 6010 put actual
PUTACTUAL();
// 6011 maxarg = ft-1 %if ft-1 > maxarg
if (FT - 1 <= MAXARG) goto L_05A4;
MAXARG = FT - 1;
L_05A4:;
// 6012 %exit
goto L_05A1;
// 6013 %finish
L_059F:;
// 6014 %if ftp_xtype >= arg %start; !index type
if (FTP->XTYPE < ARG) goto L_05A5;
// 6015 fxp == typecell(ftp_xtype); axp == typecell(atp_xtype)
FXP = (struct IDENTINFO *)TYPECELL(FTP->XTYPE);
AXP = (struct IDENTINFO *)TYPECELL(ATP->XTYPE);
// 6016 %if dict(ftp_xtype+1)_mode # litmode %start; !non-literal lower
if (DICT[FTP->XTYPE + 1].MODE == 60) goto L_05A6;
// 6017 item = atp_xtype+1
ITEM = ATP->XTYPE + 1;
// 6018 item = 0 %and value = dict(atp_xtype+1)_val %if dict(atp_xtype+1)_mode = litmode
if (DICT[ATP->XTYPE + 1].MODE != 60) goto L_05A7;
ITEM = 0;
VALUE = DICT[ATP->XTYPE + 1].VAL;
L_05A7:;
// 6019 put actual
PUTACTUAL();
// 6020 maxarg = ftp_xtype+1 %if ftp_xtype >= maxarg
if (FTP->XTYPE < MAXARG) goto L_05A8;
MAXARG = FTP->XTYPE + 1;
L_05A8:;
// 6021 %finish
L_05A6:;
// 6022 %if dict(ftp_xtype+2)_mode # litmode %start; !non-literal upper
if (DICT[FTP->XTYPE + 2].MODE == 60) goto L_05A9;
// 6023 item = atp_xtype+2
ITEM = ATP->XTYPE + 2;
// 6024 item = 0 %and value = dict(atp_xtype+2)_val %if dict(atp_xtype+2)_mode = litmode
if (DICT[ATP->XTYPE + 2].MODE != 60) goto L_05AA;
ITEM = 0;
VALUE = DICT[ATP->XTYPE + 2].VAL;
L_05AA:;
// 6025 put actual
PUTACTUAL();
// 6026 maxarg = ftp_xtype+2 %if ftp_xtype+1 >= maxarg
if (FTP->XTYPE + 1 < MAXARG) goto L_05AB;
MAXARG = FTP->XTYPE + 2;
L_05AB:;
// 6027 %finish
L_05A9:;
// 6028 %finish
L_05A5:;
// 6029 ft = ftp_type; at = atp_type; !element types
FT = FTP->TYPE;
AT = ATP->TYPE;
// 6030 %repeat %until ft <= arg
if (FT <= ARG) goto L_05A1;
goto L_059E;
L_05A1:;
// 6031 arg = maxarg; darg == dict(arg)
ARG = MAXARG;
DARG = (struct IDENTINFO *)/*?*/ &DICT[ARG];
// 6032 %end
return;
} /* end of PUTBOUNDS */
// 6033
// 6034 count = 0; hold = 0
COUNT = 0;
HOLD = 0;
// 6035 procnp = np
PROCNP = NP;
// 6036 headitem = item; pact = headitem; hp == ditem
HEADITEM = ITEM;
PACT = HEADITEM;
HP = (struct IDENTINFO *)DITEM;
// 6037 arg = hp_type; darg == dict(arg); restype = darg_type
ARG = HP->TYPE;
DARG = (struct IDENTINFO *)/*?*/ &DICT[ARG];
RESTYPE = DARG->TYPE;
// 6038 %if a(left)=TRUE %start
if (A(55) != 1) goto L_05AC;
// 6039 %cycle
L_05AD:;
// 6040 arg = darg_link
ARG = DARG->LINK;
// 6041 %if arg = 0 %start
if (ARG != 0) goto L_05AE;
// 6042 error(toomany+point) %if special = 0
if (SPECIAL != 0) goto L_05AF;
ERROR(35 + 64);
L_05AF:;
// 6043 get REFERENCE(0)
GETREFERENCE(0);
// 6044 value = item-ad; !save extra item
VALUE = ITEM - 16384;
// 6045 %cycle
L_05B0:;
// 6046 %if type = realtype %start
if (TYPE != 69) goto L_05B1;
// 6047 %exit %if restype = realtype; !no coercion
if (RESTYPE != 69) goto L_05B2;
goto L_05B3;
L_05B2:;
// 6048 %else
goto L_05B4;
L_05B1:;
// 6049 %exit %if valok(type,restype)=TRUE
if (VALOK(TYPE, RESTYPE) != 1) goto L_05B5;
goto L_05B3;
L_05B5:;
// 6050 %finish
L_05B4:;
// 6051 %repeat %until no alt=TRUE
if (NOALT() == 1) goto L_05B3;
goto L_05B0;
L_05B3:;
// 6052 special = 0
SPECIAL = 0;
// 6053 %else
goto L_05B6;
L_05AE:;
// 6054 darg == dict(arg)
DARG = (struct IDENTINFO *)/*?*/ &DICT[ARG];
// 6055 %if darg_flags&proc # 0 %start
if (DARG->FLAGS & 12288 == 0) goto L_05B7;
// 6056 get(ident)
GET(53);
// 6057 name error %if item <= 0
if (ITEM > 0) goto L_05B8;
NAMEERROR();
L_05B8:;
// 6058 fault(typerr+point) %if ditem_flags&proc = 0 %c
if (DITEM->FLAGS & 12288 == 0) goto L_05B9;
if (PARMATCH(DARG->TYPE, DITEM->TYPE) == 1) goto L_05BA;
L_05B9:;
FAULT(12 + 64);
L_05BA:;
// 6059+ %or %not parmatch(darg_type,ditem_type)=TRUE
// 6060 fault(classerr+point) %if item > headitem %C
if (ITEM <= HEADITEM) goto L_05BB;
if (DITEM->MODE != 250) goto L_05BB;
FAULT(10 + 64);
L_05BB:;
// 6061+ %and ditem_mode = procmode {OK if param?}
// 6062 item = item+ad
ITEM = ITEM + 16384;
// 6063 put actual
PUTACTUAL();
// 6064 %finish %else %if darg_flags >= 0 %start
goto L_05BC;
L_05B7:;
if (DARG->FLAGS < 0) goto L_05BD;
// 6065 jammy = 0
JAMMY = 0;
// 6066 get EXPRESSION(major,0)
GETEXPRESSION(83, 0);
// 6067 %cycle
L_05BE:;
// 6068 %exit %if valok(darg_type,type)=TRUE
if (VALOK(DARG->TYPE, TYPE) != 1) goto L_05BF;
goto L_05C0;
L_05BF:;
// 6069 %repeat %until no alt=TRUE
if (NOALT() == 1) goto L_05C0;
goto L_05BE;
L_05C0:;
// 6070 putexp(check,darg_type,item,darg_type) %if jammy # 0 %c
if (JAMMY == 0) goto L_05C1;
if (CONTROL & 536870912 == 0) goto L_05C1;
if (CATEGORY(DARG->TYPE) >= 5) goto L_05C1;
PUTEXP(111, DARG->TYPE, ITEM, DARG->TYPE);
L_05C1:;
// 6071+ %and control&capbit # 0 %c
// 6072+ %and category(darg_type) < realy
// 6073 put actual
PUTACTUAL();
// 6074 %else; !name
goto L_05BC;
L_05BD:;
// 6075 get REFERENCE(0)
GETREFERENCE(0);
// 6076 %cycle
L_05C2:;
// 6077 %exit %if refok(darg_type,type)=TRUE
if (REFOK(DARG->TYPE, TYPE) != 1) goto L_05C3;
goto L_05C4;
L_05C3:;
// 6078 %repeat %until no alt=TRUE
if (NOALT() == 1) goto L_05C4;
goto L_05C2;
L_05C4:;
// 6079 put actual
PUTACTUAL();
// 6080 tp == typecell(darg_type)
TP = (struct IDENTINFO *)TYPECELL(DARG->TYPE);
// 6081 %if tp_flags&cat = arry %c
if (TP->FLAGS & 15 != 9) goto L_05C5;
if (DICT[ARG + 1].TYPE == DARG->TYPE) goto L_05C5;
if (TP->MODE < 168) goto L_05C5;
// 6082+ %and dict(arg+1)_type # darg_type %c
// 6083+ %and tp_mode >= framemode %start
// 6084 !array name (last in group) with non-literal dope vector
// 6085 put bounds(darg_type,type)
PUTBOUNDS(DARG->TYPE, TYPE);
// 6086 %finish
L_05C5:;
// 6087 %finish
L_05BC:;
// 6088 %finish
L_05B6:;
// 6089 %repeat %until %not a(comma)=TRUE
if (A(60) != 1) goto L_05C6;
goto L_05AD;
L_05C6:;
// 6090 error(toofew+point) %if darg_link # 0 %or special # 0
if (DARG->LINK != 0) goto L_05C7;
if (SPECIAL == 0) goto L_05C8;
L_05C7:;
ERROR(34 + 64);
L_05C8:;
// 6091 get(right)
GET(61);
// 6092 %else; !no LEFT
goto L_05C9;
L_05AC:;
// 6093 error(toofew+point) %if darg_link # 0
if (DARG->LINK == 0) goto L_05CA;
ERROR(34 + 64);
L_05CA:;
// 6094 %finish
L_05C9:;
// 6095 put act(pact,hold,0) %if count&1 # 0 %or count = 0
if (COUNT & 1 != 0) goto L_05CB;
if (COUNT != 0) goto L_05CC;
L_05CB:;
PUTACT(PACT, HOLD, 0);
L_05CC:;
// 6096 type = restype
TYPE = RESTYPE;
// 6097 %if type # 0 %start; !not routine
if (TYPE == 0) goto L_05CD;
// 6098 %if hp_flags&volatile = 0 %start
if (HP->FLAGS & 4 != 0) goto L_05CE;
// 6099 p = explo
P = EXPLO;
// 6100 %while p < explim %cycle
L_05CF:;
if (P >= EXPLIM) goto L_05D0;
// 6101 %if dict(p)_act = headitem %start; ![enough?]
if (DICT[P].ACT != HEADITEM) goto L_05D1;
// 6102 item = p; q = procnp
ITEM = P;
Q = PROCNP;
// 6103 %cycle
L_05D2:;
// 6104 %exit %if dict(p)_x # dict(q)_x %or dict(p)_y # dict(q)_y
if (DICT[P].X != DICT[Q].X) goto L_05D3;
if (DICT[P].Y == DICT[Q].Y) goto L_05D4;
L_05D3:;
goto L_05D5;
L_05D4:;
// 6105 p = p+1; q = q+1
P = P + 1;
Q = Q + 1;
// 6106 ->okf %if q >= np
if (Q < NP) goto L_05D6;
goto U_101B;
L_05D6:;
// 6107 %repeat
goto L_05D2;
L_05D5:;
// 6108 %finish
L_05D1:;
// 6109 p = p+1
P = P + 1;
// 6110 %repeat
goto L_05CF;
L_05D0:;
// 6111 %finish
L_05CE:;
// 6112 copy down(procnp)
COPYDOWN(PROCNP);
// 6113 item = explo
ITEM = EXPLO;
// 6114 okf:ditem == dict(item)
U_101B:;
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM];
// 6115 ditem_flags = hp_flags&heritable
DITEM->FLAGS = HP->FLAGS & 127;
// 6116 ditem_mode = 0
DITEM->MODE = 0;
// 6117 %if hp_flags&writable # 0 %start; !map
if (HP->FLAGS & 1 == 0) goto L_05D7;
// 6118 ditem_mode = dispmode
DITEM->MODE = 40;
// 6119 %finish
L_05D7:;
// 6120 ditem_type = type
DITEM->TYPE = TYPE;
// 6121 np = procnp
NP = PROCNP;
// 6122 %finish
L_05CD:;
// 6123 %end; !get PARLIST
return;
} /* end of GETPARLIST */
// 6124
// 6125 !<<IMP
// 6126
// 6127 %routine get RESOLUTION(%integer t,item1)
void GETRESOLUTION(int T, int ITEM1) {
// 6128 %integer fore,ftype,s
int FORE;
int FTYPE;
int S;
// 6129 ! type check needed
// 6130 s = size(t)
S = SIZE(T);
// 6131 s = -256 %if s = 0
if (S != 0) goto L_05D8;
S = -256;
L_05D8:;
// 6132 fore = 0
FORE = 0;
// 6133 %unless a(left)=TRUE %start
if (A(55) == 1) goto L_05D9;
// 6134 get REFERENCE(stringstar)
GETREFERENCE(62);
// 6135 fore = item; ftype = type
FORE = ITEM;
FTYPE = TYPE;
// 6136 get(dot); get(left)
GET(87);
GET(55);
// 6137 %finish
L_05D9:;
// 6138 get VALUE(stringtype); get(right)
GETVALUE(64);
GET(61);
// 6139 %if item = 0 %start
if (ITEM != 0) goto L_05DA;
// 6140 item = litref(value); s = s+final(value)
ITEM = LITREF(VALUE);
S = S + FINAL[VALUE];
// 6141 %finish
L_05DA:;
// 6142 fault(rangerr+warn) %if fore # 0 %and s < size(ftype) # 0
if (FORE == 0) goto L_05DB;
{
// Double-sided test on SIZE(FTYPE) (Part I)
int tmp;
if (S >= (tmp = SIZE(FTYPE))) goto L_05DB;
// Double-sided test on SIZE(FTYPE) (Part II)
if (tmp == 0) goto L_05DB;
}
FAULT(24 + (-128));
L_05DB:;
// 6143 putact(resolves,item1+ad,item+ad)
PUTACT(117, ITEM1 + 16384, ITEM + 16384);
// 6144 item = 0
ITEM = 0;
// 6145 %if a(dot)=TRUE %start
if (A(87) != 1) goto L_05DC;
// 6146 get REFERENCE(stringstar)
GETREFERENCE(62);
// 6147 fault(rangerr+warn) %if s < size(type) # 0
{
// Double-sided test on SIZE(TYPE) (Part I)
int tmp;
if (S >= (tmp = SIZE(TYPE))) goto L_05DD;
// Double-sided test on SIZE(TYPE) (Part II)
if (tmp == 0) goto L_05DD;
}
FAULT(24 + (-128));
L_05DD:;
// 6148 %finish
L_05DC:;
// 6149 putact(0,fore,item)
PUTACT(0, FORE, ITEM);
// 6150 putact(0,0,0); !preserve 'parity'
PUTACT(0, 0, 0);
// 6151 %end
return;
} /* end of GETRESOLUTION */
// 6152
// 6153 %integer%fn ANON(%record(objinfo)%name d)
int ANON(struct OBJINFO * D) {
// 6154 dict(lablim+3)_details = d
DICT[LABLIM + 3].DETAILS = *D;
// 6155 %result = lablim+3
return LABLIM + 3;
// 6156 %end
} /* end of ANON */
// 6157
// 6158 %integerfn A ASSOP(%integer t)
int AASSOP(int T) {
// 6159 %if t <= 0 %start
if (T > 0) goto L_05DE;
// 6160 %result = FALSE %unless a(eqeq)=TRUE
if (A(75) == 1) goto L_05DF;
return 0;
L_05DF:;
// 6161 %else
goto L_05E0;
L_05DE:;
// 6162 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_05E1;
ATOM = NEXTATOM();
L_05E1:;
// 6163 %if atom # equals %start
if (ATOM == 77) goto L_05E2;
// 6164 %result = FALSE %unless atom = less %and byteintegeR(fp) = '-'
if (ATOM != 80) goto L_05E3;
if (*_imp_BYTEINTEGER(FP) == 45) goto L_05E4;
L_05E3:;
return 0;
L_05E4:;
// 6165 jammy = 1; fp = fp+1
JAMMY = 1;
FP = FP + 1;
// 6166 %finish %else jammy = 0
goto L_05E5;
L_05E2:;
JAMMY = 0;
L_05E5:;
// 6167 matched = 1
MATCHED = 1;
// 6168 %finish
L_05E0:;
// 6169 %result = TRUE
return 1;
// 6170 %end
} /* end of AASSOP */
// 6171
// 6172 !<<BOTH
// 6173
// 6174 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 6175 !
// 6176 %routine GET EXPRESSION(%integer rank,etype)
void GETEXPRESSION(int RANK, int ETYPE) {
// 6177 !Main expression recognition routine
// 6178 !To bring together the treatment of all binary operators
// 6179 ! and ensure fast recognition of simple expressions,
// 6180 ! expressions of different levels are handled by
// 6181 ! precedence techniques rather than syntactically
// 6182 %integer atomp0,item1,type1,cat1,val1,double,op
int ATOMP0;
int ITEM1;
int TYPE1;
int CAT1;
int VAL1;
int DOUBLE;
int OP;
// 6183 %record(identinfo)%name ditem1,tp
struct IDENTINFO *DITEM1;
struct IDENTINFO *TP;
// 6184 %constinteger nop=0; !to distinguish from numeric zero in OPVAL
// 6185
// 6186 %routine GET RECORD
void GETRECORD(void) {
// 6187 ![literal only at this stage]
// 6188 %integer fid,ad,arg,hold,count,max,s
int FID;
int AD;
int ARG;
int HOLD;
int COUNT;
int MAX;
int S;
// 6189 %record(identinfo)%name darg,fidp
struct IDENTINFO *DARG;
struct IDENTINFO *FIDP;
// 6190 literal = literal+1
LITERAL = LITERAL + 1;
// 6191 fill code(1) %if cad&1 # 0
if (CAD & 1 == 0) goto L_05E6;
FILLCODE(1);
L_05E6:;
// 6192 ad = cad
AD = CAD;
// 6193 fid = item; fidp == ditem
FID = ITEM;
FIDP = (struct IDENTINFO *)DITEM;
// 6194 arg = fidp_link
ARG = FIDP->LINK;
// 6195 count = 0; max = -1
COUNT = 0;
MAX = -1;
// 6196 get(left)
GET(55);
// 6197 %cycle
L_05E7:;
// 6198 ![*beware premature lexical coding: may alter CAD*]
// 6199 %cycle
L_05E8:;
// 6200 error(toomany+point) %if arg <= 0
if (ARG > 0) goto L_05E9;
ERROR(35 + 64);
L_05E9:;
// 6201 darg == dict(arg)
DARG = (struct IDENTINFO *)/*?*/ &DICT[ARG];
// 6202 %exit %if ad+darg_val-cad >= 0
if (AD + DARG->VAL - CAD < 0) goto L_05EA;
goto L_05EB;
L_05EA:;
// 6203 arg = darg_hlink
ARG = DARG->HLINK;
// 6204 %repeat
goto L_05E8;
L_05EB:;
// 6205 fill code(ad+darg_val-cad)
FILLCODE(AD + DARG->VAL - CAD);
// 6206 ! [*now OK to code atom*]
// 6207 %if a(recsub)=TRUE %start
if (A(58) != 1) goto L_05EC;
// 6208 subbed = 1; dformat == fidp
SUBBED = 1;
DFORMAT = (struct IDENTINFO *)FIDP;
// 6209 get(ident)
GET(53);
// 6210 subbed = 0
SUBBED = 0;
// 6211 name error %if item < arg
if (ITEM >= ARG) goto L_05ED;
NAMEERROR();
L_05ED:;
// 6212 fill code(ditem_val-darg_val)
FILLCODE(DITEM->VAL - DARG->VAL);
// 6213 arg = item; darg == ditem
ARG = ITEM;
DARG = (struct IDENTINFO *)DITEM;
// 6214 syntax error %unless a assop(darg_flags&name+darg_type)=TRUE
if (AASSOP((DARG->FLAGS & (-32768)) + DARG->TYPE) == 1) goto L_05EE;
SYNTAXERROR();
L_05EE:;
// 6215 %finish
L_05EC:;
// 6216 s = nsize(darg)
S = NSIZE(DARG);
// 6217 %unless a(comma)=TRUE %start
if (A(60) == 1) goto L_05EF;
// 6218 get VALUE(darg_flags&name+darg_type)
GETVALUE((DARG->FLAGS & (-32768)) + DARG->TYPE);
// 6219 %if s > 0 %start
if (S <= 0) goto L_05F0;
// 6220 %if s = 4 %start
if (S != 4) goto L_05F1;
// 6221 !$IF VAX
// 6222 { value = ieee(value) %if darg_type = realtype %and darg_flags >= 0
// 6223 !$FINISH
// 6224 set code longword(value)
SETCODELONGWORD(VALUE);
// 6225 %finish %else %if s = 2 %start
goto L_05F2;
L_05F1:;
if (S != 2) goto L_05F3;
// 6226 set code word(value)
SETCODEWORD(VALUE);
// 6227 %else
goto L_05F2;
L_05F3:;
// 6228 final(cad) <- value; cad = cad+1
FINAL[CAD] = (unsigned char)(VALUE);
CAD = CAD + 1;
// 6229 %finish
L_05F2:;
// 6230 %finish
L_05F0:;
// 6231 %exit %if a(right)=TRUE
if (A(61) != 1) goto L_05F4;
goto L_05F5;
L_05F4:;
// 6232 get(comma)
GET(60);
// 6233 %finish %else %if s > 0 %start
goto L_05F6;
L_05EF:;
if (S <= 0) goto L_05F7;
// 6234 fill code(s)
FILLCODE(S);
// 6235 %finish
L_05F7:;
L_05F6:;
// 6236 arg = darg_hlink
ARG = DARG->HLINK;
// 6237 %repeat
goto L_05E7;
L_05F5:;
// 6238 fill code(ad+imod(fidp_val)-cad)
FILLCODE(AD + _imp_IMOD(FIDP->VAL) - CAD);
// 6239 item = 0; value = ad
ITEM = 0;
VALUE = AD;
// 6240 literal = literal-1
LITERAL = LITERAL - 1;
// 6241 %end
return;
} /* end of GETRECORD */
// ?HOLD unused
// 6242
// 6243 %routine SWOP
void SWOP(void) {
// 6244 %integer temp
int TEMP;
// 6245 temp = item1; item1 = item; item = temp
TEMP = ITEM1;
ITEM1 = ITEM;
ITEM = TEMP;
// 6246 temp = val1; val1 = value; value = temp
TEMP = VAL1;
VAL1 = VALUE;
VALUE = TEMP;
// 6247 temp = type1; type1 = type; type = temp
TEMP = TYPE1;
TYPE1 = TYPE;
TYPE = TEMP;
// 6248 %end
return;
} /* end of SWOP */
// 6249
// 6250 %constinteger INTOK=1<<inty, CHAROK=1<<chary,
// 6251+ BOOLOK=1<<booly, ENUMOK=1<<enumy,
// 6252+ REALOK=1<<realy, STRINGOK=1<<stringy,
// 6253+ ARROK=1<<arry, SETOK=1<<sety,
// 6254+ RECOK=1<<recy, POINTOK=1<<pointy,
// 6255+ NUMOK=intok!realok,
// 6256+ ORDOK=intok!charok!boolok!enumok,
// 6257+ RELOK=ordok!realok!stringok
// 6258 %routine CHECK1(%integer ok)
void CHECK1(int OK) {
// 6259 cat1 = category(type)
CAT1 = CATEGORY(TYPE);
// 6260 %if ok>>(cat1&cat)&1 = 0 %start
if ((unsigned int)OK >> (CAT1 & 15) & 1 != 0) goto L_05F8;
// 6261 %if cat1 = inty %and ok&realok # 0 %start
if (CAT1 != 0) goto L_05F9;
if (OK & 32 == 0) goto L_05F9;
// 6262 toreal; cat1 = realy
TOREAL();
CAT1 = 5;
// 6263 %finish %else %if ok&stringok # 0 %and valok(stringtype,type)=TRUE %start
goto L_05FA;
L_05F9:;
if (OK & 256 == 0) goto L_05FB;
if (VALOK(64, TYPE) != 1) goto L_05FB;
// 6264 cat1 = stringy
CAT1 = 8;
// 6265 %else
goto L_05FA;
L_05FB:;
// 6266 fault(typerr+point)
FAULT(12 + 64);
// 6267 %finish
L_05FA:;
// 6268 %finish
L_05F8:;
// 6269 type1 = type; item1 = item; val1 = value
TYPE1 = TYPE;
ITEM1 = ITEM;
VAL1 = VALUE;
// 6270 %end
return;
} /* end of CHECK1 */
// 6271
// 6272 %integer%fn FROZEN LIT(%integer t,v)
int FROZENLIT(int T, int V) {
// 6273 ! Used when the type of a literal will not be recoverable from context
// 6274 %integer hold,res
int HOLD;
int RES;
// 6275 hold = item
HOLD = ITEM;
// 6276 putexp(move,0,litref(v),t); !NO-OP (distinctive Y)
PUTEXP(1, 0, LITREF(V), T);
// 6277 ditem_flags = okflag+wflag
DITEM->FLAGS = 64 + 16;
// 6278 ditem_mode = constmode; ditem_val = v
DITEM->MODE = 122;
DITEM->VAL = V;
// 6279 res = item; item = hold
RES = ITEM;
ITEM = HOLD;
// 6280 %result = res
return RES;
// 6281 %end
} /* end of FROZENLIT */
// 6282
// 6283 %routine COERCE(%integer c)
void COERCE(int C) {
// 6284 %if c = inty %and cat1 = realy %start
if (C != 0) goto L_05FC;
if (CAT1 != 5) goto L_05FC;
// 6285 toreal
TOREAL();
// 6286 %finish %else %if cat1 = inty %and c = realy %start
goto L_05FD;
L_05FC:;
if (CAT1 != 0) goto L_05FE;
if (C != 5) goto L_05FE;
// 6287 ![rather sloppy]
// 6288 %if item1 # 0 %start
if (ITEM1 == 0) goto L_05FF;
// 6289 val1 = item; item = item1
VAL1 = ITEM;
ITEM = ITEM1;
// 6290 toreal
TOREAL();
// 6291 item1 = item; item = val1
ITEM1 = ITEM;
ITEM = VAL1;
// 6292 %finish %else real(addr(val1)) = val1
goto L_0600;
L_05FF:;
*_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) = VAL1;
L_0600:;
// 6293 type1 = realtype; cat1 = realy
TYPE1 = 69;
CAT1 = 5;
// 6294 %else
goto L_05FD;
L_05FE:;
// 6295 expfault(typerr)
EXPFAULT(12);
// 6296 %finish
L_05FD:;
// 6297 %end
return;
} /* end of COERCE */
// 6298
// 6299 %routine GET ARITH(%integer rank)
void GETARITH(int RANK) {
// 6300 get EXPRESSION(rank,0)
GETEXPRESSION(RANK, 0);
// 6301 rank = category(type)
RANK = CATEGORY(TYPE);
// 6302 coerce(rank) %if rank # cat1
if (RANK == CAT1) goto L_0601;
COERCE(RANK);
L_0601:;
// 6303 %end
return;
} /* end of GETARITH */
// 6304
// 6305 %integer%fn RCOND(%integer op)
int RCOND(int OP) {
// 6306 %constinteger EQUAL=2_1001000010,
// 6307+ LESS =2_1010000001,
// 6308+ GREATER=2_0101000001
// 6309 %integer which,c
int WHICH;
int C;
// 6310 !<<IMP
// 6311 check1(relok)
CHECK1(303);
// 6312 get EXPRESSION(major,0)
GETEXPRESSION(83, 0);
// 6313 c = category(type)
C = CATEGORY(TYPE);
// 6314 coerce(c) %if c # cat1
if (C == CAT1) goto L_0602;
COERCE(C);
L_0602:;
// 6315 %if equals <= atom <= greater %start; ![ATOM always primed]
{
// Double-sided test on ATOM (Part I)
int tmp;
if (77 > (tmp = ATOM)) goto L_0603;
// Double-sided test on ATOM (Part II)
if (tmp > 321) goto L_0603;
}
// 6316 syntax error %if double >= 0
if (DOUBLE < 0) goto L_0604;
SYNTAXERROR();
L_0604:;
// 6317 double = item
DOUBLE = ITEM;
// 6318 %finish %else %if double < 0 %start
goto L_0605;
L_0603:;
if (DOUBLE >= 0) goto L_0606;
// 6319 double = -2
DOUBLE = -2;
// 6320 %finish
L_0606:;
L_0605:;
// 6321 !<<BOTH
// 6322 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0607;
// 6323 %if item = 0 %start
if (ITEM != 0) goto L_0608;
// 6324 %if size(type1) > 0 %or item1!val1 = 0 %or item!value = 0 %start
if (SIZE(TYPE1) > 0) goto L_0609;
if (ITEM1 | VAL1 == 0) goto L_0609;
if (ITEM | VALUE != 0) goto L_060A;
L_0609:;
// 6325 !non-structure (compile-time)
// 6326 ![integer tests ok for real?]
// 6327 %if val1 < value %then which = less %c
if (VAL1 >= VALUE) goto L_060B;
WHICH = 641;
goto L_060C;
L_060B:;
if (VAL1 != VALUE) goto L_060D;
WHICH = 578;
goto L_060C;
L_060D:;
WHICH = 321;
L_060C:;
// 6328+ %else %if val1 = value %then which = equal %c
// 6329+ %else which = greater
// 6330 %result = which>>(op-bne)&1
return (unsigned int)WHICH >> OP - 22 & 1;
// 6331 %finish
L_060A:;
// 6332 item1 = frozen lit(type1,val1)
ITEM1 = FROZENLIT(TYPE1, VAL1);
// 6333 %else
goto L_060E;
L_0608:;
// 6334 swop
SWOP();
// 6335 op = op!!3 %if op&8 # 0; !no change for '=','#'
if (OP & 8 == 0) goto L_060F;
OP = OP ^ 3;
L_060F:;
// 6336 %finish
L_060E:;
// 6337 %finish
L_0607:;
// 6338 %result = op
return OP;
// 6339 %end; !RCOND
} /* end of RCOND */
// 6340 !<<IMP
// 6341
// 6342 %integer%fn OPVAL
int OPVAL(void) {
// 6343 ! Returns result value for literal (ITEM=ITEM1=0)
// 6344 ! 0 for no-op (result is ITEM1,TYPE1)
// 6345 ! operator otherwise (result type is TYPE)
// 6346 ! NB literal INTY type is always INTTYPE (not subrange)
// 6347 %switch op(keyand:rshift)
int OP_index;
int OP_line;
char *OP_file;
static const void *OP[28] = {&&case_OP_missing, &&case_OP_missing, &&case_OP_missing, &&case_OP_missing,
&&case_OP_missing, &&case_OP_missing, &&case_OP_missing, &&case_OP_missing,
&&case_OP_missing, &&case_OP_missing, &&case_OP_missing, &&case_OP_missing,
&&case_OP_missing, &&case_OP_missing, &&case_OP_missing, &&case_OP_missing,
&&case_OP_missing, &&case_OP_missing, &&case_OP_missing, &&case_OP_missing,
&&case_OP_missing, &&case_OP_missing, &&case_OP_missing, &&case_OP_missing,
&&case_OP_missing, &&case_OP_missing, &&case_OP_missing, &&case_OP_missing};
// 6348 -> op(atom)
OP_line = __LINE__;
OP_file = __FILE__;
OP_index = ATOM;
goto case_OP_dispatch;
// 6349 op(plus):
case_OP_83:;
// 6350 check1(numok+setok)
CHECK1(33 + 1024);
// 6351 get ARITH(star)
GETARITH(88);
// 6352 %if cat1 = inty %start
if (CAT1 != 0) goto L_0611;
// 6353 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0612;
// 6354 %result = val1+value %if item = 0
if (ITEM != 0) goto L_0613;
return VAL1 + VALUE;
L_0613:;
// 6355 swop
SWOP();
// 6356 %finish
L_0612:;
// 6357 %result = nop %if item!value = 0
if (ITEM | VALUE != 0) goto L_0614;
return 0;
L_0614:;
// 6358 type = inttype
TYPE = 43;
// 6359 %result = add
return 2;
// 6360 %else
L_0611:;
// 6361 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0615;
// 6362 %if item = 0 %start
if (ITEM != 0) goto L_0616;
// 6363 real(addr(val1)) = real(addr(val1))+real(addr(value))
*_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) = *_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) + *_imp_REAL(_imp_ADDR(/*?*/ &VALUE));
// 6364 %result = val1
return VAL1;
// 6365 %finish
L_0616:;
// 6366 swop
SWOP();
// 6367 %finish
L_0615:;
// 6368 %result = nop %if item!value = 0
if (ITEM | VALUE != 0) goto L_0617;
return 0;
L_0617:;
// 6369 %result = fadd
return 90;
// 6370 %finish
// 6371 op(minus):
case_OP_84:;
// 6372 check1(numok+setok)
CHECK1(33 + 1024);
// 6373 get ARITH(star)
GETARITH(88);
// 6374 %if cat1 = inty %start
if (CAT1 != 0) goto L_0618;
// 6375 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0619;
// 6376 %result = val1-value %if item = 0
if (ITEM != 0) goto L_061A;
return VAL1 - VALUE;
L_061A:;
// 6377 swop %and %result = neg %if val1 = 0
if (VAL1 != 0) goto L_061B;
SWOP();
return 9;
L_061B:;
// 6378 %finish
L_0619:;
// 6379 type = inttype
TYPE = 43;
// 6380 %if item = 0 %start
if (ITEM != 0) goto L_061C;
// 6381 %result = nop %if value = 0
if (VALUE != 0) goto L_061D;
return 0;
L_061D:;
// 6382 value = -value %if value # minint
if (VALUE == -2147483648) goto L_061E;
VALUE = -VALUE;
L_061E:;
// 6383 %result = add
return 2;
// 6384 %finish
L_061C:;
// 6385 %result = sub
return 3;
// 6386 %else
L_0618:;
// 6387 %if item = 0 %start
if (ITEM != 0) goto L_061F;
// 6388 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0620;
// 6389 real(addr(val1)) = real(addr(val1))-real(addr(value))
*_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) = *_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) - *_imp_REAL(_imp_ADDR(/*?*/ &VALUE));
// 6390 %result = val1
return VAL1;
// 6391 %finish
L_0620:;
// 6392 %result = nop %if value = 0
if (VALUE != 0) goto L_0621;
return 0;
L_0621:;
// 6393 %finish
L_061F:;
// 6394 %result = fsub
return 91;
// 6395 %finish
// 6396 op(exclam):
case_OP_85:;
// 6397 check1(intok); get EXPRESSION(star,inttype)
CHECK1(1);
GETEXPRESSION(88, 43);
// 6398 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0622;
// 6399 %result = val1!value %if item = 0
if (ITEM != 0) goto L_0623;
return VAL1 | VALUE;
L_0623:;
// 6400 swop
SWOP();
// 6401 %finish
L_0622:;
// 6402 %result = nop %if item!value = 0
if (ITEM | VALUE != 0) goto L_0624;
return 0;
L_0624:;
// 6403 type = inttype
TYPE = 43;
// 6404 %result = or
return 6;
// 6405 op(exclam2):
case_OP_86:;
// 6406 check1(intok); get EXPRESSION(star,inttype)
CHECK1(1);
GETEXPRESSION(88, 43);
// 6407 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0625;
// 6408 %result = val1!!value %if item = 0
if (ITEM != 0) goto L_0626;
return VAL1 ^ VALUE;
L_0626:;
// 6409 swop
SWOP();
// 6410 %finish
L_0625:;
// 6411 %result = nop %if item!value = 0
if (ITEM | VALUE != 0) goto L_0627;
return 0;
L_0627:;
// 6412 type = inttype
TYPE = 43;
// 6413 %result = eor
return 7;
// 6414 op(ampersand):
case_OP_91:;
// 6415 check1(intok); get EXPRESSION(star2,inttype)
CHECK1(1);
GETEXPRESSION(92, 43);
// 6416 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0628;
// 6417 %result = val1&value %if item = 0
if (ITEM != 0) goto L_0629;
return VAL1 & VALUE;
L_0629:;
// 6418 swop
SWOP();
// 6419 %finish
L_0628:;
// 6420 item1 = 0 %and %result = 0 %if item!value = 0
if (ITEM | VALUE != 0) goto L_062A;
ITEM1 = 0;
return 0;
L_062A:;
// 6421 type = inttype
TYPE = 43;
// 6422 %result = and
return 5;
// 6423 op(star):
case_OP_88:;
// 6424 check1(numok+setok)
CHECK1(33 + 1024);
// 6425 get ARITH(star2)
GETARITH(92);
// 6426 item1 = 0 %and %result = 0 %if item!value = 0
if (ITEM | VALUE != 0) goto L_062B;
ITEM1 = 0;
return 0;
L_062B:;
// 6427 %if cat1 = inty %start
if (CAT1 != 0) goto L_062C;
// 6428 %if item1 = 0 %start
if (ITEM1 != 0) goto L_062D;
// 6429 %result = val1*value %if item = 0
if (ITEM != 0) goto L_062E;
return VAL1 * VALUE;
L_062E:;
// 6430 swop
SWOP();
// 6431 %finish
L_062D:;
// 6432 type = inttype
TYPE = 43;
// 6433 %result = imul %if control&halfbit = 0
if (CONTROL & 32768 != 0) goto L_062F;
return 86;
L_062F:;
// 6434 %result = muls
return 12;
// 6435 %else
L_062C:;
// 6436 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0630;
// 6437 %if item = 0 %start
if (ITEM != 0) goto L_0631;
// 6438 real(addr(val1)) = real(addr(val1))*real(addr(value))
*_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) = *_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) * *_imp_REAL(_imp_ADDR(/*?*/ &VALUE));
// 6439 %result = val1
return VAL1;
// 6440 %finish
L_0631:;
// 6441 swop
SWOP();
// 6442 %finish
L_0630:;
// 6443 %result = fmul
return 92;
// 6444 %finish
// 6445 op(over):
case_OP_89:;
// 6446 check1(intok); get EXPRESSION(star2,inttype)
CHECK1(1);
GETEXPRESSION(92, 43);
// 6447 %if item = 0 %start
if (ITEM != 0) goto L_0632;
// 6448 fault(rangerr) %and %result = nop %if value = 0
if (VALUE != 0) goto L_0633;
FAULT(24);
return 0;
L_0633:;
// 6449 %result = val1//value %if item1 = 0
if (ITEM1 != 0) goto L_0634;
return ((long)VAL1 / (long)VALUE);
L_0634:;
// 6450 %finish
L_0632:;
// 6451 type = inttype
TYPE = 43;
// 6452 %result = idiv
return 87;
// 6453 op(slash):
case_OP_90:;
// 6454 check1(realok)
CHECK1(32);
// 6455 get EXPRESSION(star2,realtype)
GETEXPRESSION(92, 69);
// 6456 %if item = 0 %start
if (ITEM != 0) goto L_0635;
// 6457 fault(rangerr) %and %result = nop %if value = 0
if (VALUE != 0) goto L_0636;
FAULT(24);
return 0;
L_0636:;
// 6458 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0637;
// 6459 real(addr(val1)) = real(addr(val1))/real(addr(value))
*_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) =
(double)(*_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) / *_imp_REAL(_imp_ADDR(/*?*/ &VALUE)));
// 6460 %result = val1
return VAL1;
// 6461 %finish
L_0637:;
// 6462 %finish
L_0635:;
// 6463 %result = fdiv
return 93;
// 6464 op(backslash2): op(uparrow2):
case_OP_95:;
case_OP_96:;
// 6465 check1(intok); get EXPRESSION(simple,inttype)
CHECK1(1);
GETEXPRESSION(100, 43);
// 6466 %if item = 0 %start
if (ITEM != 0) goto L_0638;
// 6467 %result = val1\\value %if item1 = 0
if (ITEM1 != 0) goto L_0639;
return _imp_IEXP(VAL1, VALUE);
L_0639:;
// 6468 item1 = 0 %and %result = 1 %if value = 0
if (VALUE != 0) goto L_063A;
ITEM1 = 0;
return 1;
L_063A:;
// 6469 %result = nop %if value = 1
if (VALUE != 1) goto L_063B;
return 0;
L_063B:;
// 6470 item = item1 %and %result = imul %if value = 2
if (VALUE != 2) goto L_063C;
ITEM = ITEM1;
return 86;
L_063C:;
// 6471 %finish
L_0638:;
// 6472 type = inttype
TYPE = 43;
// 6473 %result = ipow
return 88;
// 6474 op(backslash): op(uparrow): op(star2):
case_OP_93:;
case_OP_94:;
case_OP_92:;
// 6475 check1(realok)
CHECK1(32);
// 6476 get EXPRESSION(simple,inttype)
GETEXPRESSION(100, 43);
// 6477 type = realtype
TYPE = 69;
// 6478 %if item!item1 = 0 %start
if (ITEM | ITEM1 != 0) goto L_063D;
// 6479 real(addr(val1)) = real(addr(val1))\value
*_imp_REAL(_imp_ADDR(/*?*/ &VAL1)) = _imp_REXP(*_imp_REAL(_imp_ADDR(/*?*/ &VAL1)), VALUE);
// 6480 %result = val1
return VAL1;
// 6481 %finish
L_063D:;
// 6482 %result = fpow
return 94;
// 6483 op(lshift):
case_OP_98:;
// 6484 check1(intok); get EXPRESSION(simple,inttype)
CHECK1(1);
GETEXPRESSION(100, 43);
// 6485 %if item = 0 %start
if (ITEM != 0) goto L_063E;
// 6486 %result = val1<<value %if item1 = 0
if (ITEM1 != 0) goto L_063F;
return VAL1 << VALUE;
L_063F:;
// 6487 %result = nop %if value = 0
if (VALUE != 0) goto L_0640;
return 0;
L_0640:;
// 6488 %finish
L_063E:;
// 6489 type = inttype
TYPE = 43;
// 6490 %result = lsl
return 10;
// 6491 op(rshift):
case_OP_99:;
// 6492 check1(intok); get EXPRESSION(simple,inttype)
CHECK1(1);
GETEXPRESSION(100, 43);
// 6493 %if item = 0 %start
if (ITEM != 0) goto L_0641;
// 6494 %result = val1>>value %if item1 = 0
if (ITEM1 != 0) goto L_0642;
return (unsigned int)VAL1 >> VALUE;
L_0642:;
// 6495 %result = nop %if value = 0
if (VALUE != 0) goto L_0643;
return 0;
L_0643:;
// 6496 %finish
L_0641:;
// 6497 type = inttype
TYPE = 43;
// 6498 %result = lsr
return 11;
// 6499 op(tilde):
case_OP_97:;
// 6500 check1(intok)
CHECK1(1);
// 6501 get EXPRESSION(simple,inttype)
GETEXPRESSION(100, 43);
// 6502 %result = \value %if item = 0
if (ITEM != 0) goto L_0644;
return (~VALUE);
L_0644:;
// 6503 swop
SWOP();
// 6504 type = inttype
TYPE = 43;
// 6505 %result = not
return 8;
// 6506 op(sconc):
case_OP_87:;
// 6507 check1(stringok); get EXPRESSION(dot+1,stringtype)
CHECK1(256);
GETEXPRESSION(87 + 1, 64);
// 6508 %if item = 0 %start
if (ITEM != 0) goto L_0645;
// 6509 %if item1 = 0 %start
if (ITEM1 != 0) goto L_0646;
// 6510 %result = val1 %if value = 0
if (VALUE != 0) goto L_0647;
return VAL1;
L_0647:;
// 6511 %result = value %if val1 = 0
if (VAL1 != 0) goto L_0648;
return VALUE;
L_0648:;
// 6512 %if final(val1)+final(value) <= 255 %start
if (FINAL[VAL1] + FINAL[VALUE] > 255) goto L_0649;
// 6513 string(final0+val1) = string(final0+val1) %c
*_imp_STRING(FINAL0 + VAL1) = *
*({
_imp_string255 tmp = _imp_join(({
__typeof__(_imp_string255) tmp; /*D*/
tmp = *_imp_STRING(FINAL0 + VAL1);
(void *)&tmp;
}),
({
__typeof__(_imp_string255) tmp; /*E*/
tmp = *_imp_STRING(FINAL0 + VALUE);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
})
;
// 6514+ . string(final0+value)
// 6515 cad = cad-1
CAD = CAD - 1;
// 6516 %finish %else fault(rangerr)
goto L_064A;
L_0649:;
FAULT(24);
L_064A:;
// 6517 %result = val1
return VAL1;
// 6518 %finish
L_0646:;
// 6519 %result = nop %if value = 0
if (VALUE != 0) goto L_064B;
return 0;
L_064B:;
// 6520 %finish %else %if item1!val1 = 0 %start
goto L_064C;
L_0645:;
if (ITEM1 | VAL1 != 0) goto L_064D;
// 6521 item1 = item; val1 = value; type1 = type
ITEM1 = ITEM;
VAL1 = VALUE;
TYPE1 = TYPE;
// 6522 %result = nop
return 0;
// 6523 %finish
L_064D:;
L_064C:;
// 6524 type = stringtype
TYPE = 64;
// 6525 %result = concat
return 106;
// 6526 op(equals):
case_OP_77:;
// 6527 %result = RCOND(beq)
return RCOND(23);
// 6528 op(noteq):
case_OP_78:;
// 6529 %result = RCOND(bne)
return RCOND(22);
// 6530 op(lesseq):
case_OP_79:;
// 6531 %result = RCOND(ble)
return RCOND(31);
// 6532 op(less):
case_OP_80:;
// 6533 %result = RCOND(blt)
return RCOND(29);
// 6534 op(greateq):
case_OP_81:;
// 6535 %result = RCOND(bge)
return RCOND(28);
// 6536 op(greater):
case_OP_82:;
// 6537 %result = RCOND(bgt)
return RCOND(30);
// 6538 %integer%fn RACOND(%integer op)
int RACOND(int OP) {
// 6539 toref
TOREF();
// 6540 item1 = normitem; type1 = type
ITEM1 = NORMITEM();
TYPE1 = TYPE;
// 6541 get REFERENCE(type1)
GETREFERENCE(TYPE1);
// 6542 val1 = 0 %and swop %if item1 = 0
if (ITEM1 != 0) goto L_064E;
VAL1 = 0;
SWOP();
L_064E:;
// 6543 syntax error %if arrow <= atom <= greater; ![ATOM always primed]
{
// Double-sided test on ATOM (Part I)
int tmp;
if (74 > (tmp = ATOM)) goto L_064F;
// Double-sided test on ATOM (Part II)
if (tmp > 82) goto L_064F;
}
SYNTAXERROR();
L_064F:;
// 6544 double = -2
DOUBLE = -2;
// 6545 %result = op
return OP;
// 6546 %end
} /* end of RACOND */
// 6547 op(eqeq):
case_OP_75:;
// 6548 %result = RACOND(beq)
return RACOND(23);
// 6549 op(noteqeq):
case_OP_76:;
// 6550 %result = RACOND(bne)
return RACOND(22);
// 6551 op(arrow):
case_OP_74:;
// 6552 check1(stringok)
CHECK1(256);
// 6553 item1 = litref(val1) %if item1 = 0
if (ITEM1 != 0) goto L_0650;
ITEM1 = LITREF(VAL1);
L_0650:;
// 6554 get RESOLUTION(type,item1)
GETRESOLUTION(TYPE, ITEM1);
// 6555 item1 = np-3
ITEM1 = NP - 3;
// 6556 condop = bne!!polarity
CONDOP = 22 ^ POLARITY;
// 6557 type1 = booltype
TYPE1 = 58;
// 6558 %result = nop
return 0;
// 6559 op(keyand):
case_OP_72:;
// 6560 topred %if condop = 0
if (CONDOP != 0) goto L_0651;
TOPRED();
L_0651:;
// 6561 item1 = np; type1 = booltype
ITEM1 = NP;
TYPE1 = 58;
// 6562 putact(condop!!polarity!!1+polarity<<7,item,0)
PUTACT((CONDOP ^ POLARITY ^ 1) + (POLARITY << 7), ITEM, 0);
// 6563 condop = 0
CONDOP = 0;
// 6564 get EXPRESSION(scond,booltype)
GETEXPRESSION(74, 58);
// 6565 dict(item1)_y = item
DICT[ITEM1].Y = ITEM;
// 6566 syntax error %if a(keyor)=TRUE
if (A(73) != 1) goto L_0652;
SYNTAXERROR();
L_0652:;
// 6567 %result = nop
return 0;
// 6568 op(keyor):
case_OP_73:;
// 6569 topred %if condop = 0
if (CONDOP != 0) goto L_0653;
TOPRED();
L_0653:;
// 6570 item1 = np; type1 = booltype
ITEM1 = NP;
TYPE1 = 58;
// 6571 putact(condop!!polarity+(polarity!!1)<<7,item,0)
PUTACT((CONDOP ^ POLARITY) + ((POLARITY ^ 1) << 7), ITEM, 0);
// 6572 condop = 0
CONDOP = 0;
// 6573 get EXPRESSION(scond,booltype)
GETEXPRESSION(74, 58);
// 6574 dict(item1)_y = item
DICT[ITEM1].Y = ITEM;
// 6575 syntax error %if a(keyand)=TRUE
if (A(72) != 1) goto L_0654;
SYNTAXERROR();
L_0654:;
// 6576 %result = nop
return 0;
// 6577 %end
case_OP_dispatch:
if (OP_index < 72 || OP_index > 99)
_imp_signalf(6, 3, OP_index, "->OP(%d) out of bounds at %s line %d", OP_index, OP_file, OP_line);
goto *OP[OP_index - 72];
case_OP_missing:
_imp_signalf(8, 2, OP_index, "switch jump to undefined label OP(%d): at %s line %d", OP_index, OP_file, OP_line);
} /* end of OPVAL */
// 6578
// 6579 !Get leading operand
// 6580 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_0655;
ATOM = NEXTATOM();
L_0655:;
// 6581 atomp0 = atomp; jammy = jammy<<1; !preserve
ATOMP0 = ATOMP;
JAMMY = JAMMY << 1;
// 6582 %if atom = ident %start
if (ATOM != 53) goto L_0656;
// 6583 matched = 1
MATCHED = 1;
// 6584 name error %if item <= 0 %or (ditem_mode = labmode %and item < c_localdpos)
if (ITEM <= 0) goto L_0657;
if (DITEM->MODE != 186) goto L_0658;
if (ITEM >= C.LOCALDPOS) goto L_0658;
L_0657:;
NAMEERROR();
L_0658:;
// 6585 fault(namerr+point) %if item >= dlim0
if (ITEM < DLIM0) goto L_0659;
FAULT(9 + 64);
L_0659:;
// 6586 type = ditem_type
TYPE = DITEM->TYPE;
// 6587 %if ditem_flags&typeid # 0 %start
if (DITEM->FLAGS & 512 == 0) goto L_065A;
// 6588 %if ditem_flags&cat = recy %and item > dnil %start
if (DITEM->FLAGS & 15 != 12) goto L_065B;
if (ITEM <= 137) goto L_065B;
// 6589 get RECORD
GETRECORD();
// 6590 %return
return;
// 6591 %else
L_065B:;
// 6592 item1 = item; ditem1 == ditem
ITEM1 = ITEM;
DITEM1 = (struct IDENTINFO *)DITEM;
// 6593 %if a(less)=TRUE %start; !type coercion
if (A(80) != 1) goto L_065C;
// 6594 get VALUE(0); get(greater)
GETVALUE(0);
GET(82);
// 6595 type = item1
TYPE = ITEM1;
// 6596 %else
goto L_065D;
L_065C:;
// 6597 get(left); !store mapping
GET(55);
// 6598 get VALUE(inttype)
GETVALUE(43);
// 6599 get(right)
GET(61);
// 6600 putexp2(storemap,item1,item1)
PUTEXP2(47, ITEM1, ITEM1);
// 6601 ditem_flags = writable!readable
DITEM->FLAGS = 1 | 2;
// 6602 ditem_mode = dispmode
DITEM->MODE = 40;
// 6603 %finish
L_065D:;
// 6604 %finish
// 6605 %finish %else %if ditem_mode = litmode %start
goto L_065E;
L_065A:;
if (DITEM->MODE != 60) goto L_065F;
// 6606 item = 0; value = ditem_val
ITEM = 0;
VALUE = DITEM->VAL;
// 6607 %else; !non-literal ident
goto L_065E;
L_065F:;
// 6608 %cycle
L_0660:;
// 6609 %if ditem_flags&proc # 0 %start
if (DITEM->FLAGS & 12288 == 0) goto L_0661;
// 6610 %if item = daddr %or item = dsizeof %or item = dnew %start
if (ITEM == 74) goto L_0662;
if (ITEM == 77) goto L_0662;
if (ITEM != 115) goto L_0663;
L_0662:;
// 6611 get(left)
GET(55);
// 6612 %if item = daddr %start
if (ITEM != 74) goto L_0664;
// 6613 get REFERENCE(0)
GETREFERENCE(0);
// 6614 type = inttype
TYPE = 43;
// 6615 %else
goto L_0665;
L_0664:;
// 6616 item1 = item
ITEM1 = ITEM;
// 6617 get REFERENCE(0)
GETREFERENCE(0);
// 6618 value = imod(size(type))
VALUE = _imp_IMOD(SIZE(TYPE));
// 6619 expfault(sizerr) %if value = 0
if (VALUE != 0) goto L_0666;
EXPFAULT(11);
L_0666:;
// 6620 %if item1 = dsizeof %start
if (ITEM1 != 77) goto L_0667;
// 6621 item = 0; type = inttype
ITEM = 0;
TYPE = 43;
// 6622 %else
goto L_0668;
L_0667:;
// 6623 putexp(dnew,0,litref(value),0)
PUTEXP(115, 0, LITREF(VALUE), 0);
// 6624 ditem_mode = dispmode
DITEM->MODE = 40;
// 6625 %finish
L_0668:;
// 6626 %finish
L_0665:;
// 6627 get(right)
GET(61);
// 6628 ! %finish %else %if item = dsnl %start
// 6629 ! putexp(dtostring,nl,0,string1)
// 6630 %else
goto L_0669;
L_0663:;
// 6631 get PARLIST(0)
GETPARLIST(0);
// 6632 atomp=atomp0 %and error(classerr+point) %if type = 0; !routine
if (TYPE != 0) goto L_066A;
ATOMP = ATOMP0;
ERROR(10 + 64);
L_066A:;
// 6633 %finish
L_0669:;
// 6634 %else; !not procedure
goto L_066B;
L_0661:;
// 6635 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_066C;
ATOM = NEXTATOM();
L_066C:;
// 6636 %exit %unless aleft <= atom <= recsub %and rank <= simple
{
// Double-sided test on ATOM (Part I)
int tmp;
if (55 > (tmp = ATOM)) goto L_066D;
// Double-sided test on ATOM (Part II)
if (tmp > 58) goto L_066D;
}
if (RANK <= 100) goto L_066E;
L_066D:;
goto L_066F;
L_066E:;
// 6637 %if atom = aleft %start; !array subscript
if (ATOM != 55) goto L_0670;
// 6638 %cycle
L_0671:;
// 6639 item1 = item; ditem1 == ditem
ITEM1 = ITEM;
DITEM1 = (struct IDENTINFO *)DITEM;
// 6640 tp == typecell(type)
TP = (struct IDENTINFO *)TYPECELL(TYPE);
// 6641 %if tp_flags&cat = stringy %start
if (TP->FLAGS & 15 != 8) goto L_0672;
// 6642 matched = 1
MATCHED = 1;
// 6643 nonstandard(2)
NONSTANDARD(2);
// 6644 get VALUE(bytetype)
GETVALUE(52);
// 6645 putexp2(sindex,item1,chartype)
PUTEXP2(82, ITEM1, 61);
// 6646 %else
goto L_0673;
L_0672:;
// 6647 -> out %unless tp_flags&cat = arry
if (TP->FLAGS & 15 == 9) goto L_0674;
goto U_1020;
L_0674:;
// 6648 matched = 1
MATCHED = 1;
// 6649 get VALUE(tp_xtype); !get index
GETVALUE(TP->XTYPE);
// 6650 putexp2(index,item1,tp_type)
PUTEXP2(78, ITEM1, TP->TYPE);
// 6651 %finish
L_0673:;
// 6652 ditem_flags = ditem1_flags&heritable
DITEM->FLAGS = DITEM1->FLAGS & 127;
// 6653 ditem_mode = ditem1_mode
DITEM->MODE = DITEM1->MODE;
// 6654 %repeat %until %not a(comma)=TRUE
if (A(60) != 1) goto L_0675;
goto L_0671;
L_0675:;
// 6655 ditem_flags = ditem_flags+(tp_flags&name)
DITEM->FLAGS = DITEM->FLAGS + (TP->FLAGS & (-32768));
// 6656 get(right)
GET(61);
// 6657 %finish %else %if atom = recsub %start; !record subfield
goto L_0676;
L_0670:;
if (ATOM != 58) goto L_0677;
// 6658 item1 = item; ditem1 == ditem
ITEM1 = ITEM;
DITEM1 = (struct IDENTINFO *)DITEM;
// 6659 dformat == typecell(ditem_type)
DFORMAT = (struct IDENTINFO *)TYPECELL(DITEM->TYPE);
// 6660 syntax error %unless dformat_flags&cat = recy
if (DFORMAT->FLAGS & 15 == 12) goto L_0678;
SYNTAXERROR();
L_0678:;
// 6661 matched = 1
MATCHED = 1;
// 6662 subbed = 1; get(ident); subbed = 0
SUBBED = 1;
GET(53);
SUBBED = 0;
// 6663 error(namerr+point) %if item <= 0
if (ITEM > 0) goto L_0679;
ERROR(9 + 64);
L_0679:;
// 6664 val1 = ditem1_flags&heritable!ditem_flags
VAL1 = DITEM1->FLAGS & 127 | DITEM->FLAGS;
// 6665 putexp2(recref,item1,ditem_type)
PUTEXP2(45, ITEM1, DITEM->TYPE);
// 6666 ditem_flags = val1
DITEM->FLAGS = VAL1;
// 6667 ditem_mode = ditem1_mode
DITEM->MODE = DITEM1->MODE;
// 6668 %finish %else %if atom = atsign %start
goto L_0676;
L_0677:;
if (ATOM != 57) goto L_067A;
// 6669 nonstandard(4)
NONSTANDARD(4);
// 6670 syntax error %if ditem_flags&typeid = 0
if (DITEM->FLAGS & 512 != 0) goto L_067B;
SYNTAXERROR();
L_067B:;
// 6671 matched = 1
MATCHED = 1;
// 6672 ditem1 == ditem; item1 = item
DITEM1 = (struct IDENTINFO *)DITEM;
ITEM1 = ITEM;
// 6673 get EXPRESSION(vsimple,inttype)
GETEXPRESSION(101, 43);
// 6674 putexp2(storemap,item1,item1)
PUTEXP2(47, ITEM1, ITEM1);
// 6675 ditem_flags = writable!readable
DITEM->FLAGS = 1 | 2;
// 6676 ditem_mode = dispmode
DITEM->MODE = 40;
// 6677 %else; !pointer relative
goto L_0676;
L_067A:;
// 6678 error(nonref+point) %if ditem_mode < dispmode
if (DITEM->MODE >= 40) goto L_067C;
ERROR(33 + 64);
L_067C:;
// 6679 fault(sizerr) %if size(ditem_type) = 0
if (SIZE(DITEM->TYPE) != 0) goto L_067D;
FAULT(11);
L_067D:;
// 6680 matched = 1
MATCHED = 1;
// 6681 ditem1 == ditem; item1 = item
DITEM1 = (struct IDENTINFO *)DITEM;
ITEM1 = ITEM;
// 6682 get VALUE(inttype); get(rightb)
GETVALUE(43);
GET(62);
// 6683 putexp2(prel,item1,ditem1_type)
PUTEXP2(46, ITEM1, DITEM1->TYPE);
// 6684 ditem_flags = writable!readable
DITEM->FLAGS = 1 | 2;
// 6685 ditem_mode = ditem1_mode
DITEM->MODE = DITEM1->MODE;
// 6686 %finish
L_0676:;
// 6687 %finish
L_066B:;
// 6688 %repeat
goto L_0660;
L_066F:;
// 6689 %finish
L_065E:;
// 6690 %else
goto L_067E;
L_0656:;
// 6691 %if atom = const %start
if (ATOM != 52) goto L_067F;
// 6692 matched = 1
MATCHED = 1;
// 6693 %finish %else %if atom = minus %start; !leave unmatched
goto L_0680;
L_067F:;
if (ATOM != 84) goto L_0681;
// 6694 item = 0; value = 0; type = inttype
ITEM = 0;
VALUE = 0;
TYPE = 43;
// 6695 %finish %else %if atom = left %start
goto L_0680;
L_0681:;
if (ATOM != 55) goto L_0682;
// 6696 matched = 1
MATCHED = 1;
// 6697 %if rank < major %start; !condition
if (RANK >= 83) goto L_0683;
// 6698 get EXPRESSION(condq,0)
GETEXPRESSION(71, 0);
// 6699 %else
goto L_0684;
L_0683:;
// 6700 get EXPRESSION(major,0)
GETEXPRESSION(83, 0);
// 6701 %finish
L_0684:;
// 6702 get(right)
GET(61);
// 6703 %finish %else %if a(keynot)=TRUE %start
goto L_0680;
L_0682:;
if (A(50) != 1) goto L_0685;
// 6704 syntax error %if rank >= major
if (RANK < 83) goto L_0686;
SYNTAXERROR();
L_0686:;
// 6705 polarity = polarity!!1
POLARITY = POLARITY ^ 1;
// 6706 get EXPRESSION(scond,booltype)
GETEXPRESSION(74, 58);
// 6707 %if item = 0 %then value = value!!1
if (ITEM != 0) goto L_0687;
VALUE = VALUE ^ 1;
L_0687:;
// 6708 polarity = polarity!!1
POLARITY = POLARITY ^ 1;
// 6709 %finish %else %if atom = backslash %start
goto L_0680;
L_0685:;
if (ATOM != 93) goto L_0688;
// 6710 item = 0; value = 0; type = inttype
ITEM = 0;
VALUE = 0;
TYPE = 43;
// 6711 atom = tilde
ATOM = 97;
// 6712 %finish %else %if a(modsign)=TRUE %start
goto L_0680;
L_0688:;
if (A(54) != 1) goto L_0689;
// 6713 get EXPRESSION(major,0)
GETEXPRESSION(83, 0);
// 6714 %if valok(inttype,type)=TRUE %start
if (VALOK(43, TYPE) != 1) goto L_068A;
// 6715 %if item = 0 %start
if (ITEM != 0) goto L_068B;
// 6716 %if value < 0 %start
if (VALUE >= 0) goto L_068C;
// 6717 %if value # minint %then value = -value %else expfault(rangerr)
if (VALUE == -2147483648) goto L_068D;
VALUE = -VALUE;
goto L_068E;
L_068D:;
EXPFAULT(24);
L_068E:;
// 6718 %finish
L_068C:;
// 6719 %else
goto L_068F;
L_068B:;
// 6720 putexp2(iabs,0,inttype)
PUTEXP2(48, 0, 43);
// 6721 %finish
L_068F:;
// 6722 %finish %else %if valok(realtype,type)=TRUE %start
goto L_0690;
L_068A:;
if (VALOK(69, TYPE) != 1) goto L_0691;
// 6723 putexp2(fabs,0,realtype)
PUTEXP2(49, 0, 69);
// 6724 %else
goto L_0690;
L_0691:;
// 6725 error(typerr+point)
ERROR(12 + 64);
// 6726 %finish
L_0690:;
// 6727 get(modsign)
GET(54);
// 6728 %else
goto L_0680;
L_0689:;
// 6729 syntax error
SYNTAXERROR();
// 6730 %finish
L_0680:;
// 6731 %finish
L_067E:;
// 6732 out:
U_1020:;
// 6733 atom = next atom %if matched # 0; ![always primed on return]
if (MATCHED == 0) goto L_0692;
ATOM = NEXTATOM();
L_0692:;
// 6734
// 6735 %if etype < 0 %start; !reference required
if (ETYPE >= 0) goto L_0693;
// 6736 expp = atomp0; jammy = jammy>>1; !restore
EXPP = ATOMP0;
JAMMY = (unsigned int)JAMMY >> 1;
// 6737 %unless item!value = 0 %start; !*temp*
if (ITEM | VALUE == 0) goto L_0694;
// 6738 toref
TOREF();
// 6739 expfault(typerr) %unless refok(etype-sign16,type)=TRUE
if (REFOK(ETYPE + 32768, TYPE) == 1) goto L_0695;
EXPFAULT(12);
L_0695:;
// 6740 %finish %else atomp = atomp0 %and nonstandard(21)
goto L_0696;
L_0694:;
ATOMP = ATOMP0;
NONSTANDARD(21);
L_0696:;
// 6741 %else
goto L_0697;
L_0693:;
// 6742 %while atom >= rank %cycle
L_0698:;
if (ATOM < RANK) goto L_0699;
// 6743 matched = 1
MATCHED = 1;
// 6744 double = -1
DOUBLE = -1;
// 6745 op = opval
OP = OPVAL();
// 6746 %if item1!item = 0 %start; !both literal
if (ITEM1 | ITEM != 0) goto L_069A;
// 6747 %if double # -1 %start
if (DOUBLE == -1) goto L_069B;
// 6748 %if double >= 0 %start
if (DOUBLE < 0) goto L_069C;
// 6749 literal = literal+1; !enforce all literal
LITERAL = LITERAL + 1;
// 6750 op = op&opval
OP = OP & OPVAL();
// 6751 literal = literal-1
LITERAL = LITERAL - 1;
// 6752 %finish
L_069C:;
// 6753 type = booltype
TYPE = 58;
// 6754 %finish
L_069B:;
// 6755 value = op
VALUE = OP;
// 6756 %finish %else %if double = -1 %start; !not relop
goto L_069D;
L_069A:;
if (DOUBLE != -1) goto L_069E;
// 6757 %if op # 0 %start
if (OP == 0) goto L_069F;
// 6758 item1 = litref(val1) %if item1 = 0
if (ITEM1 != 0) goto L_06A0;
ITEM1 = LITREF(VAL1);
L_06A0:;
// 6759 putexp(op,item1,normitem,type)
PUTEXP(OP, ITEM1, NORMITEM(), TYPE);
// 6760 %else; !nop
goto L_06A1;
L_069F:;
// 6761 item = item1; type = type1
ITEM = ITEM1;
TYPE = TYPE1;
// 6762 %finish
L_06A1:;
// 6763 %else; !conditional operation
goto L_069D;
L_069E:;
// 6764 condop = op!!polarity
CONDOP = OP ^ POLARITY;
// 6765 putact(compare,item1,normitem)
PUTACT(4, ITEM1, NORMITEM());
// 6766 item = np-1
ITEM = NP - 1;
// 6767 %if double >= 0 %start
if (DOUBLE < 0) goto L_06A2;
// 6768 putact(condop!!polarity!!1+polarity<<7,np-1,np+1); !implicit %and
PUTACT((CONDOP ^ POLARITY ^ 1) + (POLARITY << 7), NP - 1, NP + 1);
// 6769 item = double; ![TYPE,VALUE unchanged]
ITEM = DOUBLE;
// 6770 matched = 1
MATCHED = 1;
// 6771 op = opval
OP = OPVAL();
// 6772 error(nonliteral) %if item1!item = 0; !mixed non-lit, lit
if (ITEM1 | ITEM != 0) goto L_06A3;
ERROR(25);
L_06A3:;
// 6773 condop = op!!polarity
CONDOP = OP ^ POLARITY;
// 6774 putact(compare,item1,normitem)
PUTACT(4, ITEM1, NORMITEM());
// 6775 item = np-2
ITEM = NP - 2;
// 6776 %finish
L_06A2:;
// 6777 type = booltype
TYPE = 58;
// 6778 %finish
L_069D:;
// 6779 %repeat
goto L_0698;
L_0699:;
// 6780 expp = atomp0; jammy = jammy>>1
EXPP = ATOMP0;
JAMMY = (unsigned int)JAMMY >> 1;
// 6781 %if etype # 0 %start
if (ETYPE == 0) goto L_06A4;
// 6782 %if type = booltype %start
if (TYPE != 58) goto L_06A5;
// 6783 topred %if (rank = cond %or rank = scond) %and condop = 0
if (RANK == 72) goto L_06A6;
if (RANK != 74) goto L_06A7;
L_06A6:;
if (CONDOP != 0) goto L_06A7;
TOPRED();
L_06A7:;
// 6784 %finish
L_06A5:;
// 6785 expfault(typerr) %unless valok(etype,type)=TRUE
if (VALOK(ETYPE, TYPE) == 1) goto L_06A8;
EXPFAULT(12);
L_06A8:;
// 6786 %finish
L_06A4:;
// 6787 %finish
L_0697:;
// 6788 atomp=expp %and error(nonliteral+point) %if literal # 0 %and item # 0
if (LITERAL == 0) goto L_06A9;
if (ITEM == 0) goto L_06A9;
ATOMP = EXPP;
ERROR(25 + 64);
L_06A9:;
// 6789 %end;
return;
} /* end of GETEXPRESSION */
// ?POINTOK unused
// ?RECOK unused
// ?ARROK unused
// 6790 ; !get EXPRESSION
// 6790
// 6791 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 6792 !!!!!!!!!!!!!!!!!!!! Conditions and loops !!!!!!!!!!!!!!!!!!!!
// 6793 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 6794 !
// 6795 %routine GET CONDITION
void GETCONDITION(void) {
// 6796 %integer maxlab,condnp
int MAXLAB;
int CONDNP;
// 6797
// 6798 %routine ASSIGN LABELS(%integer p,lab,pol)
void ASSIGNLABELS(int P, int LAB, int POL) {
// 6799 %integer base
int BASE;
// 6800 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 6801 base=maxlab
BASE = MAXLAB;
// 6802 %while (p-condnp)&1 # 0 %cycle; !compound
L_06AA:;
if (P - CONDNP & 1 == 0) goto L_06AB;
// 6803 dp == dict(p); p = dp_y
DP = (struct IDENTINFO *)/*?*/ &DICT[P];
P = DP->Y;
// 6804 %if dp_act&1<<7 = pol %then assign labels(dp_x,lab,pol) %c
if (DP->ACT & 1 << 7 != POL) goto L_06AC;
ASSIGNLABELS(DP->X, LAB, POL);
goto L_06AD;
L_06AC:;
MAXLAB = BASE + 1;
ASSIGNLABELS(DP->X, MAXLAB, POL ^ 1 << 7);
L_06AD:;
// 6805+ %else maxlab = base+1 %and assign labels(dp_x,maxlab,pol!!1<<7)
// 6806 %repeat
goto L_06AA;
L_06AB:;
// 6807 dp == dict(p+1); dp == dict(p+3) %if dp_act = 0; !resolution
DP = (struct IDENTINFO *)/*?*/ &DICT[P + 1];
if (DP->ACT != 0) goto L_06AE;
DP = (struct IDENTINFO *)/*?*/ &DICT[P + 3];
L_06AE:;
// 6808 %if maxlab > base %then dp_x = maxlab %and maxlab = base %c
if (MAXLAB <= BASE) goto L_06AF;
DP->X = MAXLAB;
MAXLAB = BASE;
goto L_06B0;
L_06AF:;
DP->X = 0;
L_06B0:;
// 6809+ %else dp_x = 0
// 6810 dp_y = lab
DP->Y = LAB;
// 6811 dp_act = dp_act&127
DP->ACT = DP->ACT & 127;
// 6812 %end
return;
} /* end of ASSIGNLABELS */
// 6813
// 6814 condnp = np
CONDNP = NP;
// 6815 polarity = subatom; condop = 0
POLARITY = SUBATOM;
CONDOP = 0;
// 6816 get EXPRESSION(cond,booltype)
GETEXPRESSION(72, 58);
// 6817 putact(condop!!1,item,0)
PUTACT(CONDOP ^ 1, ITEM, 0);
// 6818 %return %if faultnum > 0
if (FAULTNUM <= 0) goto L_06B1;
return;
L_06B1:;
// 6819 maxlab = curlab+1
MAXLAB = CURLAB + 1;
// 6820 assign labels(item,maxlab,0)
ASSIGNLABELS(ITEM, MAXLAB, 0);
// 6821 %end; !get CONDITION
return;
} /* end of GETCONDITION */
// 6822
// 6823 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 6824
// 6825 %routine DO DYNAMIC ARRAYS
void DODYNAMICARRAYS(void) {
// 6826 update sp
UPDATESP();
// 6827 c_mode = c_mode!2_01000000; !bar to SP rel addressing
C.MODE = C.MODE | 64;
// 6828 c_status = c_status!globbed; !needs link
C.STATUS = C.STATUS | 16;
// 6829 %while c_dynarray # 0 %cycle
L_06B2:;
if (C.DYNARRAY == 0) goto L_06B3;
// 6830 %if c_dynarray < 0 %then putact(aget,-c_dynarray,one) %c
if (C.DYNARRAY >= 0) goto L_06B4;
PUTACT(109, -C.DYNARRAY, -2);
goto L_06B5;
L_06B4:;
PUTACT(109, C.DYNARRAY, 0);
L_06B5:;
// 6831+ %else putact(aget,c_dynarray,0)
// 6832 c_dynarray = dict(imod(c_dynarray))_link
C.DYNARRAY = DICT[_imp_IMOD(C.DYNARRAY)].LINK;
// 6833 %repeat
goto L_06B2;
L_06B3:;
// 6834 compile(np0)
COMPILE(NP0);
// 6835 %end
return;
} /* end of DODYNAMICARRAYS */
// 6836
// 6837 %routine GET STATEMENTS(%integer stopper)
void GETSTATEMENTS(int STOPPER) {
// 6838 ! STOPPER = 0 -- initial call
// 6839 ! 1 (END) -- for procedure or block body
// 6840 ! 2 (REPEAT) -- for loop body
// 6841 ! 3 (FINISH) -- for condition body (ELSE not valid)
// 6842 ! 4 (ELSE) -- " (ELSE valid)
// 6843 %switch initial(0:atommax)
int INITIAL_index;
int INITIAL_line;
char *INITIAL_file;
static const void *INITIAL[100] = {
&&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};
// 6844 %integer forinf,endval,loopstart
int FORINF;
int ENDVAL;
int LOOPSTART;
// 6845
// 6846 %routine THIS IS INST
void THISISINST(void) {
// 6847 %if c_status < hadinst %start; !first in block
if (C.STATUS >= 16384) goto L_06B6;
// 6848 c_status = c_status+hadinst
C.STATUS = C.STATUS + 16384;
// 6849 fault(ordererr) %if stopper = 0
if (STOPPER != 0) goto L_06B7;
FAULT(22);
L_06B7:;
// 6850 %finish
L_06B6:;
// 6851 fault(accesserr+warn) %if c_access = 0 %and np = np0
if (C.ACCESS != 0) goto L_06B8;
if (NP != NP0) goto L_06B8;
FAULT(16 + (-128));
L_06B8:;
// 6852 do dynamic arrays %if c_dynarray # 0
if (C.DYNARRAY == 0) goto L_06B9;
DODYNAMICARRAYS();
L_06B9:;
// 6853 %end
return;
} /* end of THISISINST */
// 6854
// 6855 %routine PUTACT2(%integer act,item1)
void PUTACT2(int ACT, int ITEM1) {
// 6856 putact(act,item1,normitem)
PUTACT(ACT, ITEM1, NORMITEM());
// 6857 %end
return;
} /* end of PUTACT2 */
// 6858
// 6859 %routine GET RESULT
void GETRESULT(void) {
// 6860 get VALUE(c_type)
GETVALUE(C.TYPE);
// 6861 ! fault(rangerr+warn) %if c_type > 0 %and item # 0 %c
// 6862 ! %and imod(size(type)) > imod(size(c_type))
// 6863 %end
return;
} /* end of GETRESULT */
// 6864
// 6865 %routine GET INSTRUCTION
void GETINSTRUCTION(void) {
// 6866 %integer item1
int ITEM1;
// 6867 %record(identinfo)%name tp
struct IDENTINFO *TP;
// 6868 this is inst
THISISINST();
// 6869 %cycle
L_06BA:;
// 6870 %if a(ident)=TRUE %start
if (A(53) != 1) goto L_06BB;
// 6871 name error %if item <= 0
if (ITEM > 0) goto L_06BC;
NAMEERROR();
L_06BC:;
// 6872 %if ditem_flags&(writable!typeid) # 0 %start
if (DITEM->FLAGS & (1 | 512) == 0) goto L_06BD;
// 6873 matched = 0
MATCHED = 0;
// 6874 get EXPRESSION(simple,0)
GETEXPRESSION(100, 0);
// 6875 item1 = item
ITEM1 = ITEM;
// 6876 %if a(equals)=TRUE %start
if (A(77) != 1) goto L_06BE;
// 6877 jammy = 0
JAMMY = 0;
// 6878 get VALUE(type)
GETVALUE(TYPE);
// 6879 putact2(okass+jammy,item1); !okass,assign
PUTACT2(33 + JAMMY, ITEM1);
// 6880 %finish %else %if a(eqeq)=TRUE %start
goto L_06BF;
L_06BE:;
if (A(75) != 1) goto L_06C0;
// 6881 syntax error %if ditem_flags >= 0
if (DITEM->FLAGS < 0) goto L_06C1;
SYNTAXERROR();
L_06C1:;
// 6882 get REFERENCE(type)
GETREFERENCE(TYPE);
// 6883 putact2(assign,item1+ad)
PUTACT2(34, ITEM1 + 16384);
// 6884 %finish %else %if atom = less %and byteintegeR(fp) = '-' %start
goto L_06BF;
L_06C0:;
if (ATOM != 80) goto L_06C2;
if (*_imp_BYTEINTEGER(FP) != 45) goto L_06C2;
// 6885 fp = fp+1; matched = 1
FP = FP + 1;
MATCHED = 1;
// 6886 jammy = 1
JAMMY = 1;
// 6887 get VALUE(type)
GETVALUE(TYPE);
// 6888 putact2(jamass+jammy,item1); !jamass,okass
PUTACT2(32 + JAMMY, ITEM1);
// 6889 %else
goto L_06BF;
L_06C2:;
// 6890 syntax error %unless a(arrow)=TRUE
if (A(74) == 1) goto L_06C3;
SYNTAXERROR();
L_06C3:;
// 6891 get RESOLUTION(type,item1)
GETRESOLUTION(TYPE, ITEM1);
// 6892 putact(bne,0,curlab)
PUTACT(22, 0, CURLAB);
// 6893 putact(signal,litref(7),undef)
PUTACT(73, LITREF(7), 16);
// 6894 putact(0,undef,undef)
PUTACT(0, 16, 16);
// 6895 %finish
L_06BF:;
// 6896 %else
goto L_06C4;
L_06BD:;
// 6897 error(classerr+point) %if ditem_flags&proc = 0
if (DITEM->FLAGS & 12288 != 0) goto L_06C5;
ERROR(10 + 64);
L_06C5:;
// 6898 tp == typecell(ditem_type)
TP = (struct IDENTINFO *)TYPECELL(DITEM->TYPE);
// 6899 %if tp_type # 0 %start; !function as routine
if (TP->TYPE == 0) goto L_06C6;
// 6900 get PARLIST(tp_type)
GETPARLIST(TP->TYPE);
// 6901 putact2(assign,value)
PUTACT2(34, VALUE);
// 6902 %else
goto L_06C7;
L_06C6:;
// 6903 get PARLIST(0)
GETPARLIST(0);
// 6904 %finish
L_06C7:;
// 6905 %finish
L_06C4:;
// 6906 %else
goto L_06C8;
L_06BB:;
// 6907 c_access = 0 %if np = np0; !unconditional
if (NP != NP0) goto L_06C9;
C.ACCESS = 0;
L_06C9:;
// 6908 %if a(keymonitor)=TRUE %start
if (A(13) != 1) goto L_06CA;
// 6909 c_access = 1
C.ACCESS = 1;
// 6910 ! fault(monitor<<8)
// 6911 %finish %else %if a(exit)=TRUE %start; !%exit, %continue
goto L_06CB;
L_06CA:;
if (A(6) != 1) goto L_06CC;
// 6912 %if c_looplab = 0 %then fault(notinloop+point) %c
if (C.LOOPLAB != 0) goto L_06CD;
FAULT(17 + 64);
goto L_06CE;
L_06CD:;
PUTACT(41, C.LOOPLAB, C.LOOPLAB + SUBATOM);
L_06CE:;
// 6913+ %else putact(jumpout,c_looplab,c_looplab+subatom)
// 6914 %exit
goto L_06CF;
// 6915 %finish %else %if a(keyreturn)=TRUE %start
L_06CC:;
if (A(7) != 1) goto L_06D0;
// 6916 item = 0; value = 0
ITEM = 0;
VALUE = 0;
// 6917 get RESULT %if c_type # 0
if (C.TYPE == 0) goto L_06D1;
GETRESULT();
L_06D1:;
// 6918 putact2(return,0)
PUTACT2(38, 0);
// 6919 %exit
goto L_06CF;
// 6920 %finish %else %if a(keyresult)=TRUE %start
L_06D0:;
if (A(9) != 1) goto L_06D2;
// 6921 error(notinfun+point) %if c_type = 0
if (C.TYPE != 0) goto L_06D3;
ERROR(19 + 64);
L_06D3:;
// 6922 syntax error %unless a assop(c_type)=TRUE
if (AASSOP(C.TYPE) == 1) goto L_06D4;
SYNTAXERROR();
L_06D4:;
// 6923 get RESULT
GETRESULT();
// 6924 putact2(return,0)
PUTACT2(38, 0);
// 6925 %exit
goto L_06CF;
// 6926 %finish %else %if a(tf)=TRUE %start; !%true, %false
L_06D2:;
if (A(8) != 1) goto L_06D5;
// 6927 %if c_type # booltype %then fault(notinpred+point) %c
if (C.TYPE == 58) goto L_06D6;
FAULT(20 + 64);
goto L_06D7;
L_06D6:;
PUTACT(38, 0, LITREF(SUBATOM));
L_06D7:;
// 6928+ %else putact(return,0,litref(subatom))
// 6929 %exit
goto L_06CF;
// 6930 %finish %else %if a(arrow)=TRUE %or a(keygoto)=TRUE %start
L_06D5:;
if (A(74) == 1) goto L_06D8;
if (A(11) != 1) goto L_06D9;
L_06D8:;
// 6931 nonstandard(5) %if atom = keygoto
if (ATOM != 11) goto L_06DA;
NONSTANDARD(5);
L_06DA:;
// 6932 get(ident)
GET(53);
// 6933 %if byteinteger(fp) # '(' %start
if (*_imp_BYTEINTEGER(FP) == 40) goto L_06DB;
// 6934 declare(forwardlabel) %if item < c_localdpos {new} %c
if (ITEM < C.LOCALDPOS) goto L_06DC;
if (DITEM->TYPE == 0) goto L_06DD;
L_06DC:;
DECLARE(/*?*/ &FORWARDLABEL);
L_06DD:;
// 6935+ %or ditem_type # 0 {error}
// 6936 putact2(goto,0)
PUTACT2(16, 0);
// 6937 %else
goto L_06DE;
L_06DB:;
// 6938 name error %if item < c_localdpos
if (ITEM >= C.LOCALDPOS) goto L_06DF;
NAMEERROR();
L_06DF:;
// 6939 error(classerr+point) %unless ditem_mode = labmode %c
if (DITEM->MODE != 186) goto L_06E0;
if (DITEM->TYPE != 0) goto L_06E1;
L_06E0:;
ERROR(10 + 64);
L_06E1:;
// 6940+ %and ditem_type # 0
// 6941 item1 = item
ITEM1 = ITEM;
// 6942 get(left)
GET(55);
// 6943 get VALUE(typecell(ditem_type)_xtype); !index
GETVALUE(TYPECELL(DITEM->TYPE)->XTYPE);
// 6944 get(right)
GET(61);
// 6945 putact2(swgoto,item1)
PUTACT2(43, ITEM1);
// 6946 %finish
L_06DE:;
// 6947 %exit
goto L_06CF;
// 6948 %finish %else %if a(keystop)=TRUE %start
L_06D9:;
if (A(10) != 1) goto L_06E2;
// 6949 putact(stop,0,0)
PUTACT(37, 0, 0);
// 6950 %exit
goto L_06CF;
// 6951 %finish %else %if a(keysignal)=TRUE %start
L_06E2:;
if (A(12) != 1) goto L_06E3;
// 6952 c_access = 1
C.ACCESS = 1;
// 6953 allow(keyevent)
ALLOW(46);
// 6954 get LITERAL(inttype)
GETLITERAL(43);
// 6955 expfault(rangerr) %unless 0 <= value <= 15
{
// Double-sided test on VALUE (Part I)
int tmp;
if (0 > (tmp = VALUE)) goto L_06E4;
// Double-sided test on VALUE (Part II)
if (tmp <= 15) goto L_06E5;
}
L_06E4:;
EXPFAULT(24);
L_06E5:;
// 6956 item1 = litref(value); item = undef
ITEM1 = LITREF(VALUE);
ITEM = 16;
// 6957 %if a(comma)=TRUE %start
if (A(60) != 1) goto L_06E6;
// 6958 l1: %if a(comma)=TRUE %then matched = 0 %else get VALUE(bytetype)
U_101C:;
if (A(60) != 1) goto L_06E7;
MATCHED = 0;
goto L_06E8;
L_06E7:;
GETVALUE(52);
L_06E8:;
// 6959 %finish
L_06E6:;
// 6960 putact2(signal,item1)
PUTACT2(73, ITEM1);
// 6961 item = undef
ITEM = 16;
// 6962 %if a(comma)=TRUE %start
if (A(60) != 1) goto L_06E9;
// 6963 l2: %if a(comma)=TRUE %then matched = 0 %else get VALUE(inttype)
U_101D:;
if (A(60) != 1) goto L_06EA;
MATCHED = 0;
goto L_06EB;
L_06EA:;
GETVALUE(43);
L_06EB:;
// 6964 %finish
L_06E9:;
// 6965 item1 = normitem; item = undef
ITEM1 = NORMITEM();
ITEM = 16;
// 6966 get VALUE(stringtype) %if a(comma)=TRUE
if (A(60) != 1) goto L_06EC;
GETVALUE(64);
L_06EC:;
// 6967 putact2(0,item1)
PUTACT2(0, ITEM1);
// 6968 %exit
goto L_06CF;
// 6969 %else
L_06E3:;
// 6970 syntax error
SYNTAXERROR();
// 6971 %finish
L_06CB:;
// 6972 %finish
L_06C8:;
// 6973 %repeat %until %not a(keyand)=TRUE
if (A(72) != 1) goto L_06CF;
goto L_06BA;
L_06CF:;
// 6974 %end;
return;
} /* end of GETINSTRUCTION */
// ?L2 unused
// ?L1 unused
// 6975 ; !GET INSTRUCTION
// 6975
// 6976 %routine GET FOR CLAUSE
void GETFORCLAUSE(void) {
// 6977 !Global: FORINF,ENDVAL
// 6978 %integer loopvar,lvtype,k,s,start,sval,i,inc,ival,e,n
int LOOPVAR;
int LVTYPE;
int K;
int S;
int START;
int SVAL;
int I;
int INC;
int IVAL;
int E;
int N;
// 6979 %integer end
int END;
// 6980 %record(identinfo)%name tp
struct IDENTINFO *TP;
// 6981 forinf = 0
FORINF = 0;
// 6982 get(ident)
GET(53);
// 6983 name error %if item <= 0
if (ITEM > 0) goto L_06ED;
NAMEERROR();
L_06ED:;
// 6984 lvtype = ditem_type; tp == typecell(lvtype)
LVTYPE = DITEM->TYPE;
TP = (struct IDENTINFO *)TYPECELL(LVTYPE);
// 6985 fault(typerr+point) %if tp_flags&nonord # 0
if (TP->FLAGS & 12 == 0) goto L_06EE;
FAULT(12 + 64);
L_06EE:;
// 6986 loopvar = item
LOOPVAR = ITEM;
// 6987 get(equals)
GET(77);
// 6988 get VALUE(lvtype)
GETVALUE(LVTYPE);
// 6989 start = item; sval = value
START = ITEM;
SVAL = VALUE;
// 6990 get(comma)
GET(60);
// 6991 get VALUE(lvtype)
GETVALUE(LVTYPE);
// 6992 inc = item; ival = value
INC = ITEM;
IVAL = VALUE;
// 6993 expfault(rangerr) %and ival = 1 %if inc = 0 = ival
{
// Double-sided test on 0 (Part I)
int tmp;
if (INC != (tmp = 0)) goto L_06EF;
// Double-sided test on 0 (Part II)
if (tmp != IVAL) goto L_06EF;
}
EXPFAULT(24);
IVAL = 1;
L_06EF:;
// 6994 !Deal with INC and replace START by START-INC
// 6995 k = undef
K = 16;
// 6996 k = dict(start)_y %if start >= np0 %and dict(start)_act = add
if (START < NP0) goto L_06F0;
if (DICT[START].ACT != 2) goto L_06F0;
K = DICT[START].Y;
L_06F0:;
// 6997 %if inc = 0 %start; !literal increment
if (INC != 0) goto L_06F1;
// 6998 i = litref(ival)
I = LITREF(IVAL);
// 6999 %if start = 0 %start; !START and INC both literal
if (START != 0) goto L_06F2;
// 7000 sval = sval-ival; item = litref(sval)
SVAL = SVAL - IVAL;
ITEM = LITREF(SVAL);
// 7001 %finish %else %if k <= 0 %start; !START is x+lit
goto L_06F3;
L_06F2:;
if (K > 0) goto L_06F4;
// 7002 k = litval(k)-ival
K = LITVAL(K) - IVAL;
// 7003 item = dict(start)_x
ITEM = DICT[START].X;
// 7004 putexp(add,item,litref(k),inttype) %if k # 0
if (K == 0) goto L_06F5;
PUTEXP(2, ITEM, LITREF(K), 43);
L_06F5:;
// 7005 %else
goto L_06F3;
L_06F4:;
// 7006 putexp(add,start,litref(-ival),inttype)
PUTEXP(2, START, LITREF(-IVAL), 43);
// 7007 %finish
L_06F3:;
// 7008 %else; !variable
goto L_06F6;
L_06F1:;
// 7009 i = inc
I = INC;
// 7010 %if control&volbit # 0 %start
if (CONTROL & 65536 == 0) goto L_06F7;
// 7011 declare temp(inttype); i = item
DECLARETEMP(43);
I = ITEM;
// 7012 putact(assign,i,inc); forinf = forinf-4
PUTACT(34, I, INC);
FORINF = FORINF - 4;
// 7013 %finish
L_06F7:;
// 7014 %if start = inc %start; !identical
if (START != INC) goto L_06F8;
// 7015 item = 0; sval = 0
ITEM = 0;
SVAL = 0;
// 7016 %finish %else %if k = inc %start; !START is x+INC
goto L_06F9;
L_06F8:;
if (K != INC) goto L_06FA;
// 7017 item = dict(start)_x
ITEM = DICT[START].X;
// 7018 %else
goto L_06F9;
L_06FA:;
// 7019 item = start; item = litref(sval) %if item = 0
ITEM = START;
if (ITEM != 0) goto L_06FB;
ITEM = LITREF(SVAL);
L_06FB:;
// 7020 putexp(sub,item,i,inttype)
PUTEXP(3, ITEM, I, 43);
// 7021 %finish
L_06F9:;
// 7022 %finish
L_06F6:;
// 7023 s = item
S = ITEM;
// 7024 !Get end-value
// 7025 get(comma)
GET(60);
// 7026 get VALUE(lvtype)
GETVALUE(LVTYPE);
// 7027 end = item
END = ITEM;
// 7028 %if end = 0 %start; !literal end-value
if (END != 0) goto L_06FC;
// 7029 e = litref(value); endval = value
E = LITREF(VALUE);
ENDVAL = VALUE;
// 7030 %else
goto L_06FD;
L_06FC:;
// 7031 e = item
E = ITEM;
// 7032 %if control&volbit # 0 %start
if (CONTROL & 65536 == 0) goto L_06FE;
// 7033 declare temp(inttype); e = item
DECLARETEMP(43);
E = ITEM;
// 7034 putact(assign,e,end); forinf = forinf-4
PUTACT(34, E, END);
FORINF = FORINF - 4;
// 7035 %finish
L_06FE:;
// 7036 %finish
L_06FD:;
// 7037 %if start!inc!end # 0 %and control&loopbit # 0 %start
if (START | INC | END == 0) goto L_06FF;
if (CONTROL & 1073741824 == 0) goto L_06FF;
// 7038 putact(forass,loopvar,s)
PUTACT(36, LOOPVAR, S);
// 7039 putact(forass,i,e)
PUTACT(36, I, E);
// 7040 %else
goto L_0700;
L_06FF:;
// 7041 putact(assign,loopvar,s)
PUTACT(34, LOOPVAR, S);
// 7042 %finish
L_0700:;
// 7043 putact(label,curlab,0)
PUTACT(44, CURLAB, 0);
// 7044 %if start!inc!end = 0 %start; !all literal
if (START | INC | END != 0) goto L_0701;
// 7045 k = endval-sval; n = k//ival
K = ENDVAL - SVAL;
N = ((long)K / (long)IVAL);
// 7046 %if n = 0 %start
if (N != 0) goto L_0702;
// 7047 fault(dubious+warn)
FAULT(37 + (-128));
// 7048 putact(else,0,curlab+1); !ie unconditional branch
PUTACT(40, 0, CURLAB + 1);
// 7049 %return
return;
// 7050 %finish
L_0702:;
// 7051 fault(boundserr) %if n < 0
if (N >= 0) goto L_0703;
FAULT(13);
L_0703:;
// 7052 fault(unending) %if n*ival # k
if (N * IVAL == K) goto L_0704;
FAULT(14);
L_0704:;
// 7053 forinf = loopvar
FORINF = LOOPVAR;
// 7054 %else
goto L_0705;
L_0701:;
// 7055 putact(compare,loopvar,e)
PUTACT(4, LOOPVAR, E);
// 7056 putact(beq,0,curlab+1)
PUTACT(23, 0, CURLAB + 1);
// 7057 %finish
L_0705:;
// 7058 putact(incass,loopvar,i)
PUTACT(35, LOOPVAR, I);
// 7059 %end; !get FORCLAUSE
return;
} /* end of GETFORCLAUSE */
// 7060
// 7061 %routine GET LOOP BODY
void GETLOOPBODY(void) {
// 7062 %integer hold
int HOLD;
// 7063 hold=c_looplab
HOLD = C.LOOPLAB;
// 7064 c_looplab = curlab; curlab = curlab+2
C.LOOPLAB = CURLAB;
CURLAB = CURLAB + 2;
// 7065 get STATEMENTS(keyrepeat)
GETSTATEMENTS(2);
// 7066 curlab = curlab-2; c_looplab = hold
CURLAB = CURLAB - 2;
C.LOOPLAB = HOLD;
// 7067 %end
return;
} /* end of GETLOOPBODY */
// 7068
// 7069 %routine GET SWITCH INDEX
void GETSWITCHINDEX(void) {
// 7070 %integer i,lo,hi
int I;
int LO;
int HI;
// 7071 %record(identinfo)%name dp,tp
struct IDENTINFO *DP;
struct IDENTINFO *TP;
// 7072 %routine SET LABEL(%shortname p)
void SETLABEL(short int *P) {
// 7073 value = p
VALUE = *P;
// 7074 expfault(duperr) %if value > 0
if (VALUE <= 0) goto L_0706;
EXPFAULT(21);
L_0706:;
// 7075 set user label(value)
SETUSERLABEL(/*?*/ &VALUE);
// 7076 p = value
*P = VALUE;
// 7077 %end
return;
} /* end of SETLABEL */
// 7078 dp == ditem; tp == typecell(ditem_type)
DP = (struct IDENTINFO *)DITEM;
TP = (struct IDENTINFO *)TYPECELL(DITEM->TYPE);
// 7079 get(left)
GET(55);
// 7080 %if a(star)=TRUE %start
if (A(88) != 1) goto L_0707;
// 7081 set label(dp_link)
SETLABEL(/*?*/ &DP->LINK);
// 7082 %else
goto L_0708;
L_0707:;
// 7083 get VALUE(tp_xtype)
GETVALUE(TP->XTYPE);
// 7084 !beware faulty declaration or index
// 7085 %if tp_xtype > inttype %and faultnum = 0 %start
if (TP->XTYPE <= 43) goto L_0709;
if (FAULTNUM != 0) goto L_0709;
// 7086 get bounds(tp_xtype,lo,hi)
GETBOUNDS(TP->XTYPE, /*?*/ &LO, /*?*/ &HI);
// 7087 i = value-lo+dp_val
I = VALUE - LO + DP->VAL;
// 7088 c_forward = c_forward-1 %if i < pc; !(had goto)
if (I >= PC) goto L_070A;
C.FORWARD = C.FORWARD - 1;
L_070A:;
// 7089 set label(prog(i))
SETLABEL(/*?*/ &PROG[I]);
// 7090 %finish
L_0709:;
// 7091 %finish
L_0708:;
// 7092 get(right)
GET(61);
// 7093 %end
return;
} /* end of GETSWITCHINDEX */
// 7094
// 7095 ![unsure of efficiency implications of trapping overflow lower down]
// 7096 %on %event oflow,fail,done %start
if (!_imp_on_event(1, 11, 12)) goto L_070B;
// 7097 %if event_event = 0 %start; !failure in %option,%include or ^Y
if (_imp_EVENT().EVENT != 0) goto L_070C;
// 7098 %stop %if event_sub # 0
if (_imp_EVENT().SUB == 0) goto L_070D;
_imp_stop(0);
L_070D:;
// 7099 %signal abandon
_imp_signal(14, 0, 0, "");
// 7100 %finish
L_070C:;
// 7101 %if event_event = done %start
if (_imp_EVENT().EVENT != 12) goto L_070E;
// 7102 croak("Premature end of input") %if stopper # 0
if (STOPPER == 0) goto L_070F;
CROAK(_imp_str_literal("Premature end of input"));
L_070F:;
// 7103 close block
CLOSEBLOCK();
// 7104 c_dpid_val = 0; !zero entry-point
C.DPID->VAL = 0;
// 7105 %return
return;
// 7106 %finish
L_070E:;
// 7107 fault(rangerr+now) %if event_event = oflow
if (_imp_EVENT().EVENT != 1) goto L_0710;
FAULT(24 + 128);
L_0710:;
// 7108 -> ignore
goto U_101D;
// 7109 %finish
L_070B:;
// 7110 !!!!!!!!!!!!!!!!!!! Start of new statement !!!!!!!!!!!!!!!!!!!
// 7111 next:
U_101E:;
// 7112 statements = statements+1
STATEMENTS = STATEMENTS + 1;
// 7113 compile(startnp) %if np > np0
if (NP <= NP0) goto L_0711;
COMPILE(STARTNP);
L_0711:;
// 7114 define label(curlab) %if dict(curlab)_val < 0
if (DICT[CURLAB].VAL >= 0) goto L_0712;
DEFINELABEL(CURLAB);
L_0712:;
// 7115 define label(curlab+1) %if dict(curlab+1)_val < 0
if (DICT[CURLAB + 1].VAL >= 0) goto L_0713;
DEFINELABEL(CURLAB + 1);
L_0713:;
// 7116 next1:
U_101F:;
// 7117 report(faultnum,0,0) %if faultnum # 0
if (FAULTNUM == 0) goto L_0714;
REPORT(FAULTNUM, 0, 0);
L_0714:;
// 7118 dlim0 = dlim
DLIM0 = DLIM;
// 7119 speccing = 0; subbed = 0
SPECCING = 0;
SUBBED = 0;
// 7120 literal = 0; jammy = 0; condop = 0
LITERAL = 0;
JAMMY = 0;
CONDOP = 0;
// 7121 dict(curlab)_val = 0; dict(curlab+1)_val = 0
DICT[CURLAB].VAL = 0;
DICT[CURLAB + 1].VAL = 0;
// 7122 np = np0; startnp = np0
NP = NP0;
STARTNP = NP0;
// 7123 maxcalldreg = maxdreg; maxcallareg = maxareg
MAXCALLDREG = 4;
MAXCALLAREG = 12;
// 7124 zaps = zaps+1 %and forget all %if explo < np0+50
if (EXPLO >= NP0 + 50) goto L_0715;
ZAPS = ZAPS + 1;
FORGETALL();
L_0715:;
// 7125 zaps = zaps+1000 %and forget all %if litpos > litmax-40
if (LITPOS <= (-2048) - 40) goto L_0716;
ZAPS = ZAPS + 1000;
FORGETALL();
L_0716:;
// 7126 value = 0
VALUE = 0;
// 7127 !
// 7128 initial(terminator):
case_INITIAL_51:;
// 7129 atom = next atom; matched = 1
ATOM = NEXTATOM();
MATCHED = 1;
// 7130 -> initial(atom)
INITIAL_line = __LINE__;
INITIAL_file = __FILE__;
INITIAL_index = ATOM;
goto case_INITIAL_dispatch;
// 7131
// 7132 initial(keycomment): initial(exclam): initial(exclam2):
case_INITIAL_45:;
case_INITIAL_85:;
case_INITIAL_86:;
// 7133 comments = comments+1
COMMENTS = COMMENTS + 1;
// 7134 read line(0)
READLINE(0);
// 7135 -> next1
goto U_101F;
// 7136 term:
U_1031:;
// 7137 get(terminator)
GET(51);
// 7138 -> next
goto U_101E;
// 7139
// 7140 ignore:
U_101D:;
// 7141 c_access = -1
C.ACCESS = -1;
// 7142 %if atom # terminator %start
if (ATOM == 51) goto L_0718;
// 7143 %cycle
L_0719:;
// 7144 subatom = atom; atom = next atom
SUBATOM = ATOM;
ATOM = NEXTATOM();
// 7145 %repeat %until atom = terminator
if (ATOM == 51) goto L_071A;
goto L_0719;
L_071A:;
// 7146 starts = starts+1 %if subatom = keystart
if (SUBATOM != 20) goto L_071B;
STARTS = STARTS + 1;
L_071B:;
// 7147 cycles = cycles+1 %if subatom = keycycle
if (SUBATOM != 21) goto L_071C;
CYCLES = CYCLES + 1;
L_071C:;
// 7148 %finish
L_0718:;
// 7149 -> next1
goto U_101F;
// 7150
// 7151 initial(dud):
case_INITIAL_63:;
// 7152 syntax error; !ie atom error
SYNTAXERROR();
// 7153
// 7154 initial(*):
case_INITIAL_default:;
// 7155 error(nonstarter+point)
ERROR(31 + 64);
// 7156
// 7157 initial(ident):
case_INITIAL_53:;
// 7158 %if byteintegeR(fp) = ':' %start; !simple label
if (*_imp_BYTEINTEGER(FP) != 58) goto L_071D;
// 7159 fp = fp+1
FP = FP + 1;
// 7160 declare(definedlabel)
DECLARE(/*?*/ &DEFINEDLABEL);
// 7161 set user label(ditem_val)
SETUSERLABEL(/*?*/ &DITEM->VAL);
// 7162 ->next
goto U_101E;
// 7163 %finish
L_071D:;
// 7164 name error %if item <= 0
if (ITEM > 0) goto L_071E;
NAMEERROR();
L_071E:;
// 7165 %if ditem_mode = labmode %and ditem_type # 0 %start
if (DITEM->MODE != 186) goto L_071F;
if (DITEM->TYPE == 0) goto L_071F;
// 7166 literal = 1
LITERAL = 1;
// 7167 get SWITCH INDEX
GETSWITCHINDEX();
// 7168 get(colon)
GET(59);
// 7169 ->next
goto U_101E;
// 7170 %finish
L_071F:;
// 7171 initial(keyreturn): initial(keyresult): initial(tf):
case_INITIAL_7:;
case_INITIAL_9:;
case_INITIAL_8:;
// 7172 initial(keystop): initial(keysignal): initial(keymonitor):
case_INITIAL_10:;
case_INITIAL_12:;
case_INITIAL_13:;
// 7173 initial(exit): initial(keygoto): initial(arrow):
case_INITIAL_6:;
case_INITIAL_11:;
case_INITIAL_74:;
// 7174 matched = 0
MATCHED = 0;
// 7175 get INSTRUCTION
GETINSTRUCTION();
// 7176 -> next %if a(terminator)=TRUE
if (A(51) != 1) goto L_0720;
goto U_101E;
L_0720:;
// 7177 c_access = 1
C.ACCESS = 1;
// 7178 %if a(iu)=TRUE %start
if (A(15) != 1) goto L_0721;
// 7179 startnp = np
STARTNP = NP;
// 7180 get CONDITION
GETCONDITION();
// 7181 %finish %else %if a(keywhile)=TRUE %start
goto L_0722;
L_0721:;
if (A(16) != 1) goto L_0723;
// 7182 putact(repeat,curlab,0); !append repeat
PUTACT(39, CURLAB, 0);
// 7183 startnp = np
STARTNP = NP;
// 7184 define label(curlab)
DEFINELABEL(CURLAB);
// 7185 get CONDITION
GETCONDITION();
// 7186 %finish %else %if a(keyfor)=TRUE %start
goto L_0722;
L_0723:;
if (A(18) != 1) goto L_0724;
// 7187 putact(0,0,0)
PUTACT(0, 0, 0);
// 7188 putact(0,0,0)
PUTACT(0, 0, 0);
// 7189 putact(repeat,curlab,0); !append repeat
PUTACT(39, CURLAB, 0);
// 7190 startnp = np
STARTNP = NP;
// 7191 get FOR CLAUSE
GETFORCLAUSE();
// 7192 value = np; np = startnp-3
VALUE = NP;
NP = STARTNP - 3;
// 7193 %if forinf > 0 %start
if (FORINF <= 0) goto L_0725;
// 7194 putact(compare,forinf,litref(endval))
PUTACT(4, FORINF, LITREF(ENDVAL));
// 7195 putact(beq,0,curlab)
PUTACT(23, 0, CURLAB);
// 7196 %finish %else np = np+2
goto L_0726;
L_0725:;
NP = NP + 2;
L_0726:;
// 7197 putact(repeat,curlab,forinf)
PUTACT(39, CURLAB, FORINF);
// 7198 np = value
NP = VALUE;
// 7199 %else
goto L_0722;
L_0724:;
// 7200 syntax error %unless a(keyuntil)=TRUE
if (A(17) == 1) goto L_0727;
SYNTAXERROR();
L_0727:;
// 7201 get CONDITION
GETCONDITION();
// 7202 putact(repeat,curlab,0)
PUTACT(39, CURLAB, 0);
// 7203 define label(curlab)
DEFINELABEL(CURLAB);
// 7204 %finish
L_0722:;
// 7205 -> term
goto U_1031;
// 7206
// 7207 initial(iu): !%if, %unless
case_INITIAL_15:;
// 7208 this is inst
THISISINST();
// 7209 %cycle
L_0728:;
// 7210 get CONDITION
GETCONDITION();
// 7211 %if a(keythen)=TRUE %and %not a(keystart)=TRUE %start
if (A(19) != 1) goto L_0729;
if (A(20) == 1) goto L_0729;
// 7212 get INSTRUCTION
GETINSTRUCTION();
// 7213 %else
goto L_072A;
L_0729:;
// 7214 matched = 0; ![unsee %start]
MATCHED = 0;
// 7215 get(keystart)
GET(20);
// 7216 %cycle
L_072B:;
// 7217 get(terminator)
GET(51);
// 7218 curlab = curlab+2
CURLAB = CURLAB + 2;
// 7219 get STATEMENTS(keyelse)
GETSTATEMENTS(4);
// 7220 curlab = curlab-2
CURLAB = CURLAB - 2;
// 7221 %exit %if atom # keyelse; !%finish ->
if (ATOM == 4) goto L_072C;
goto L_072D;
L_072C:;
// 7222 putact(else,curlab+1,curlab)
PUTACT(40, CURLAB + 1, CURLAB);
// 7223 -> exit2 %unless a(iu)=TRUE
if (A(15) == 1) goto L_072E;
goto U_1020;
L_072E:;
// 7224 get CONDITION
GETCONDITION();
// 7225 %repeat
goto L_072B;
L_072D:;
// 7226 -> initial(keyend) %if atom = keyend
if (ATOM != 1) goto L_072F;
INITIAL_line = __LINE__;
INITIAL_file = __FILE__;
INITIAL_index = 1;
goto case_INITIAL_dispatch;
L_072F:;
// 7227 %finish
L_072A:;
// 7228 -> term %unless a(keyelse)=TRUE
if (A(4) == 1) goto L_0730;
goto U_1031;
L_0730:;
// 7229 putact(else,curlab+1,curlab)
PUTACT(40, CURLAB + 1, CURLAB);
// 7230 %repeat %until %not a(iu)=TRUE
if (A(15) != 1) goto L_0731;
goto L_0728;
L_0731:;
// 7231 %unless a(keystart)=TRUE %start
if (A(20) == 1) goto L_0732;
// 7232 get INSTRUCTION
GETINSTRUCTION();
// 7233 %else
goto L_0733;
L_0732:;
// 7234 exit2:
U_1020:;
// 7235 get(terminator)
GET(51);
// 7236 curlab = curlab+2
CURLAB = CURLAB + 2;
// 7237 get STATEMENTS(keyfinish)
GETSTATEMENTS(3);
// 7238 curlab = curlab-2
CURLAB = CURLAB - 2;
// 7239 -> initial(keyend) %if atom = keyend
if (ATOM != 1) goto L_0734;
INITIAL_line = __LINE__;
INITIAL_file = __FILE__;
INITIAL_index = 1;
goto case_INITIAL_dispatch;
L_0734:;
// 7240 %finish
L_0733:;
// 7241 -> term
goto U_1031;
// 7242
// 7243 initial(keycycle):
case_INITIAL_21:;
// 7244 this is inst
THISISINST();
// 7245 %if a(terminator)=TRUE %start
if (A(51) != 1) goto L_0735;
// 7246 define label(curlab)
DEFINELABEL(CURLAB);
// 7247 get LOOP BODY
GETLOOPBODY();
// 7248 -> initial(keyend) %if atom = keyend
if (ATOM != 1) goto L_0736;
INITIAL_line = __LINE__;
INITIAL_file = __FILE__;
INITIAL_index = 1;
goto case_INITIAL_dispatch;
L_0736:;
// 7249 get CONDITION %if a(keyuntil)=TRUE
if (A(17) != 1) goto L_0737;
GETCONDITION();
L_0737:;
// 7250 putact(repeat,curlab,0)
PUTACT(39, CURLAB, 0);
// 7251 -> term
goto U_1031;
// 7252 %finish
L_0735:;
// 7253 nonstandard(22)
NONSTANDARD(22);
// 7254 get FOR CLAUSE
GETFORCLAUSE();
// 7255 -> for1
goto U_1032;
// 7256 initial(keywhile):
case_INITIAL_16:;
// 7257 this is inst
THISISINST();
// 7258 define label(curlab)
DEFINELABEL(CURLAB);
// 7259 get CONDITION
GETCONDITION();
// 7260 get(keycycle)
GET(21);
// 7261 get(terminator)
GET(51);
// 7262 compile(np0)
COMPILE(NP0);
// 7263 get LOOP BODY
GETLOOPBODY();
// 7264 -> initial(keyend) %if atom = keyend
if (ATOM != 1) goto L_0738;
INITIAL_line = __LINE__;
INITIAL_file = __FILE__;
INITIAL_index = 1;
goto case_INITIAL_dispatch;
L_0738:;
// 7265 nonstandard(6) %and get CONDITION %if a(keyuntil)=TRUE
if (A(17) != 1) goto L_0739;
NONSTANDARD(6);
GETCONDITION();
L_0739:;
// 7266 putact(repeat,curlab,0)
PUTACT(39, CURLAB, 0);
// 7267 ->term
goto U_1031;
// 7268 initial(keyfor):
case_INITIAL_18:;
// 7269 this is inst
THISISINST();
// 7270 get FOR CLAUSE
GETFORCLAUSE();
// 7271 get(keycycle)
GET(21);
// 7272 for1:
U_1032:;
// 7273 get(terminator)
GET(51);
// 7274 compile(np0)
COMPILE(NP0);
// 7275 %if forinf > 0 %start; !Literal for loop
if (FORINF <= 0) goto L_073A;
// 7276 !%continue must come to end for increment
// 7277 loopstart = dict(curlab)_val; !save start position
LOOPSTART = DICT[CURLAB].VAL;
// 7278 dict(curlab)_val = 0
DICT[CURLAB].VAL = 0;
// 7279 %finish
L_073A:;
// 7280 get LOOP BODY
GETLOOPBODY();
// 7281 -> initial(keyend) %if atom = keyend
if (ATOM != 1) goto L_073B;
INITIAL_line = __LINE__;
INITIAL_file = __FILE__;
INITIAL_index = 1;
goto case_INITIAL_dispatch;
L_073B:;
// 7282 %if forinf > 0 %start; !literal FOR loop
if (FORINF <= 0) goto L_073C;
// 7283 define label(curlab)
DEFINELABEL(CURLAB);
// 7284 dict(curlab)_val = loopstart; !restore
DICT[CURLAB].VAL = LOOPSTART;
// 7285 putact(compare,forinf,litref(endval))
PUTACT(4, FORINF, LITREF(ENDVAL));
// 7286 putact(beq,0,curlab)
PUTACT(23, 0, CURLAB);
// 7287 %finish
L_073C:;
// 7288 putact(repeat,curlab,forinf)
PUTACT(39, CURLAB, FORINF);
// 7289 -> term
goto U_1031;
// 7290
// 7291 initial(keyon):
case_INITIAL_14:;
// 7292 fault(ordererr+point) %if c_status >= hadon %or stopper = 0
if (C.STATUS >= 4096) goto L_073D;
if (STOPPER != 0) goto L_073E;
L_073D:;
FAULT(22 + 64);
L_073E:;
// 7293 do dynamic arrays %if c_dynarray # 0
if (C.DYNARRAY == 0) goto L_073F;
DODYNAMICARRAYS();
L_073F:;
// 7294 c_status = c_status!hadon
C.STATUS = C.STATUS | 4096;
// 7295 matched = 1
MATCHED = 1;
// 7296 allow(keyevent)
ALLOW(46);
// 7297 dump = 0
DUMP = 0;
// 7298 %cycle
L_0740:;
// 7299 get LITERAL(inttype)
GETLITERAL(43);
// 7300 expfault(rangerr) %unless 0 <= value <= 15
{
// Double-sided test on VALUE (Part I)
int tmp;
if (0 > (tmp = VALUE)) goto L_0741;
// Double-sided test on VALUE (Part II)
if (tmp <= 15) goto L_0742;
}
L_0741:;
EXPFAULT(24);
L_0742:;
// 7301 dump = dump!1<<value
DUMP = DUMP | 1 << VALUE;
// 7302 %repeat %until %not a(comma)=TRUE
if (A(60) != 1) goto L_0743;
goto L_0740;
L_0743:;
// 7303 get(keystart)
GET(20);
// 7304 putact(settrap,0,litref(dump))
PUTACT(42, 0, LITREF(DUMP));
// 7305 curlab = curlab+2
CURLAB = CURLAB + 2;
// 7306 get STATEMENTS(keyfinish)
GETSTATEMENTS(3);
// 7307 curlab = curlab-2
CURLAB = CURLAB - 2;
// 7308 -> initial(keyend) %if atom = keyend
if (ATOM != 1) goto L_0744;
INITIAL_line = __LINE__;
INITIAL_file = __FILE__;
INITIAL_index = 1;
goto case_INITIAL_dispatch;
L_0744:;
// 7309 -> term
goto U_1031;
// 7310 !
// 7311 initial(keyelse):
case_INITIAL_4:;
// 7312 -> ignore %if starts # 0
if (STARTS == 0) goto L_0745;
goto U_101D;
L_0745:;
// 7313 %return %if stopper = keyelse
if (STOPPER != 4) goto L_0746;
return;
L_0746:;
// 7314 error(noif) %if stopper = keyfinish
if (STOPPER != 3) goto L_0747;
ERROR(29);
L_0747:;
// 7315 initial(keyfinish):
case_INITIAL_3:;
// 7316 starts = starts-1 %and -> ignore %if starts # 0
if (STARTS == 0) goto L_0748;
STARTS = STARTS - 1;
goto U_101D;
L_0748:;
// 7317 %return %if stopper = keyfinish %or stopper = keyelse
if (STOPPER == 3) goto L_0749;
if (STOPPER != 4) goto L_074A;
L_0749:;
return;
L_074A:;
// 7318 error(nostart)
ERROR(28);
// 7319 initial(keyrepeat):
case_INITIAL_2:;
// 7320 cycles = cycles-1 %and -> ignore %if cycles # 0
if (CYCLES == 0) goto L_074B;
CYCLES = CYCLES - 1;
goto U_101D;
L_074B:;
// 7321 %return %if stopper = keyrepeat
if (STOPPER != 2) goto L_074C;
return;
L_074C:;
// 7322 error(nocycle)
ERROR(27);
// 7323
// 7324 initial(star):
case_INITIAL_88:;
// 7325 fault(lowlevel+warn+point) %and control = control!lowbit %if control&lowbit = 0
if (CONTROL & 16384 != 0) goto L_074D;
FAULT(15 + (-128) + 64);
CONTROL = CONTROL | 16384;
L_074D:;
// 7326 matched = 1
MATCHED = 1;
// 7327 %if byteinteger(fp) = '=' %start
if (*_imp_BYTEINTEGER(FP) != 61) goto L_074E;
// 7328 fp = fp+1
FP = FP + 1;
// 7329 get LITERAL(inttype)
GETLITERAL(43);
// 7330 plant(dc,0,temp(absmode,value))
PLANT(102, 0, TEMP(56, VALUE));
// 7331 %else
goto L_074F;
L_074E:;
// 7332 get MCODE
GETMCODE();
// 7333 %finish
L_074F:;
// 7334 ->term
goto U_1031;
// 7335
// 7336 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 7337 !!!!!!!!!!!!!!!!!!!! Declarations !!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 7338 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 7339 !
// 7340 %routine DECLARE LIT RANGE(%integer basetype,lo,hi)
void DECLARELITRANGE(int BASETYPE, int LO, int HI) {
// 7341 %own%record(objinfo) D=0
static struct OBJINFO D = {0};
// 7342 fault(boundserr) %and hi = lo %if lo > hi
if (LO <= HI) goto L_0750;
FAULT(13);
HI = LO;
L_0750:;
// 7343 item = ranges
ITEM = RANGES;
// 7344 %cycle
L_0751:;
// 7345 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM];
// 7346 item = item-2 %and %return %if ditem_val = hi %and ditem_type = basetype %c
if (DITEM->VAL != HI) goto L_0752;
if (DITEM->TYPE != BASETYPE) goto L_0752;
if (DICT[ITEM - 1].VAL != LO) goto L_0752;
ITEM = ITEM - 2;
return;
L_0752:;
// 7347+ %and dict(item-1)_val = lo
// 7348 item = ditem_hlink
ITEM = DITEM->HLINK;
// 7349 %repeat %until item = 0
if (ITEM == 0) goto L_0753;
goto L_0751;
L_0753:;
// 7350 declare anon(d); !blank (for updating)
DECLAREANON(/*?*/ &D);
// 7351 declare range(basetype,lo,hi)
DECLARERANGE(BASETYPE, LO, HI);
// 7352 %end
return;
} /* end of DECLARELITRANGE */
// 7353
// 7354 %routine DECLARE STRING TYPE(%integer size)
void DECLARESTRINGTYPE(int SIZE) {
// 7355 item = stringtype %and %return %if size = -256
if (SIZE != -256) goto L_0754;
ITEM = 64;
return;
L_0754:;
// 7356 item = string1 %and %return %if size = -2
if (SIZE != -2) goto L_0755;
ITEM = 63;
return;
L_0755:;
// 7357 item = ranges
ITEM = RANGES;
// 7358 %cycle
L_0756:;
// 7359 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM];
// 7360 %return %if ditem_size = size %and ditem_type = chartype
if (DITEM->SIZE != SIZE) goto L_0757;
if (DITEM->TYPE != 61) goto L_0757;
return;
L_0757:;
// 7361 item = ditem_hlink
ITEM = DITEM->HLINK;
// 7362 %repeat %until item = 0
if (ITEM == 0) goto L_0758;
goto L_0756;
L_0758:;
// 7363 declare anon(details(typeid+stringy,chartype,0,0))
DECLAREANON(DETAILS(512 + 8, 61, 0, 0));
// 7364 ditem_size = size
DITEM->SIZE = SIZE;
// 7365 ditem_hlink = ranges; ranges = item
DITEM->HLINK = RANGES;
RANGES = ITEM;
// 7366 %end
return;
} /* end of DECLARESTRINGTYPE */
// 7367
// 7368 %routine GET LIT RANGE(%integer basetype)
void GETLITRANGE(int BASETYPE) {
// 7369 %integer holdval
int HOLDVAL;
// 7370 get LITERAL(basetype); holdval = value
GETLITERAL(BASETYPE);
HOLDVAL = VALUE;
// 7371 get(colon)
GET(59);
// 7372 get LITERAL(basetype)
GETLITERAL(BASETYPE);
// 7373 declare lit range(basetype,holdval,value)
DECLARELITRANGE(BASETYPE, HOLDVAL, VALUE);
// 7374 %end
return;
} /* end of GETLITRANGE */
// 7375
// 7376 %routine GET IDENTLIST(%record(objinfo)%name d)
void GETIDENTLIST(struct OBJINFO * D) {
// 7377 dlim0 = dlim
DLIM0 = DLIM;
// 7378 get(ident) %and declare(d) %until %not a(comma)=TRUE
L_0759:;
GET(53);
DECLARE(D);
if (A(60) != 1) goto L_075A;
goto L_0759;
L_075A:;
// 7379 %end
return;
} /* end of GETIDENTLIST */
// 7380
// 7381 %routine RECALIGN(%integername val)
void RECALIGN(int *VAL) {
// 7382 align(val,2)
ALIGN(VAL, 2);
// 7383 val = -val %if val > 4
if (*VAL <= 4) goto L_075B;
*VAL = -*VAL;
L_075B:;
// 7384 %end
return;
} /* end of RECALIGN */
// 7385
// 7386 %routine GET DECLARATION(%integer FLAGS,MODE,%integer%name DISP,%integer DEPTH)
void GETDECLARATION(int FLAGS, int MODE, int *DISP, int DEPTH) {
// 7387 %record(objinfo) DECL
struct OBJINFO DECL;
// 7388 %record(identinfo)%name DFHOLD
struct IDENTINFO *DFHOLD;
// 7389 %owninteger ITEMTYPE=0,ITEMSIZE=0,ADIM=0
static int ITEMTYPE = 0;
static int ITEMSIZE = 0;
static int ADIM = 0;
// 7390 %integer BASE,HOLD,MAX,STMAX,DREG,AREG
int BASE;
int HOLD;
int MAX;
int STMAX;
int DREG;
int AREG;
auto void GETVARBOUND(void);
// 7391
// 7392 %routine%spec GET VAR BOUND
// 7393
// 7394 %routine GET DATA TYPE
void GETDATATYPE(void) {
// 7395 %switch s(ktype:keyname)
int S_index;
int S_line;
char *S_file;
static const void *S[7] = {&&case_S_missing, &&case_S_missing, &&case_S_missing, &&case_S_missing,
&&case_S_missing, &&case_S_missing, &&case_S_missing};
// 7396 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_075C;
ATOM = NEXTATOM();
L_075C:;
// 7397 syntax error %unless kattrib <= atom <= keyname
{
// Double-sided test on ATOM (Part I)
int tmp;
if (26 > (tmp = ATOM)) goto L_075D;
// Double-sided test on ATOM (Part II)
if (tmp <= 33) goto L_075E;
}
L_075D:;
SYNTAXERROR();
L_075E:;
// 7398 matched = 1
MATCHED = 1;
// 7399 -> s(atom)
S_line = __LINE__;
S_file = __FILE__;
S_index = ATOM;
goto case_S_dispatch;
// 7400 s(ktype):
case_S_27:;
// 7401 itemtype = inttype+subatom
ITEMTYPE = 43 + SUBATOM;
// 7402 itemsize = size(itemtype)
ITEMSIZE = SIZE(ITEMTYPE);
// 7403 nonstandard(7) %if itemtype >= mitetype
if (ITEMTYPE < 55) goto L_0760;
NONSTANDARD(7);
L_0760:;
// 7404 allow(keyinteger)
ALLOW(28);
// 7405 %return
return;
// 7406 s(keyinteger): !%integer
case_S_28:;
// 7407 itemtype = inttype; itemsize = 4
ITEMTYPE = 43;
ITEMSIZE = 4;
// 7408 %if a(left)=TRUE %start
if (A(55) != 1) goto L_0761;
// 7409 nonstandard(8)
NONSTANDARD(8);
// 7410 get LIT RANGE(inttype)
GETLITRANGE(43);
// 7411 get(right)
GET(61);
// 7412 itemtype = item
ITEMTYPE = ITEM;
// 7413 itemsize = typecell(itemtype)_size
ITEMSIZE = TYPECELL(ITEMTYPE)->SIZE;
// 7414 %finish
L_0761:;
// 7415 %return
return;
// 7416 s(keylong): !%long
case_S_29:;
// 7417 itemtype = inttype; itemsize = 4; !**for now**
ITEMTYPE = 43;
ITEMSIZE = 4;
// 7418 %if a(keyinteger)=TRUE %then fault(notin+point+warn) %c
if (A(28) != 1) goto L_0762;
FAULT(40 + 64 + (-128));
goto L_0763;
L_0762:;
ITEMTYPE = 69;
GET(30);
L_0763:;
// 7419+ %else itemtype = realtype %and get(keyreal)
// 7420 %return
return;
// 7421 s(keyreal): !%real
case_S_30:;
// 7422 itemtype = realtype; itemsize = 4
ITEMTYPE = 69;
ITEMSIZE = 4;
// 7423 %return
return;
// 7424 s(keystring): !%string
case_S_31:;
// 7425 itemsize = 0
ITEMSIZE = 0;
// 7426 %if a(left)=TRUE %start
if (A(55) != 1) goto L_0764;
// 7427 atom = next atom
ATOM = NEXTATOM();
// 7428 ! %if depth # 0 %and ktype <= atom <= keyinteger %start
// 7429 ! get VAR BOUND
// 7430 ! itemtype = stringstar
// 7431 ! %finish %else %if a(star)=TRUE %start
// 7432 %if a(star)=TRUE %start
if (A(88) != 1) goto L_0765;
// 7433 itemtype = stringstar
ITEMTYPE = 62;
// 7434 %else
goto L_0766;
L_0765:;
// 7435 get LITERAL(bytetype)
GETLITERAL(52);
// 7436 itemsize = -(value+1)
ITEMSIZE = -(VALUE + 1);
// 7437 declare string type(itemsize)
DECLARESTRINGTYPE(ITEMSIZE);
// 7438 itemtype = item
ITEMTYPE = ITEM;
// 7439 %finish
L_0766:;
// 7440 get(right)
GET(61);
// 7441 %else
goto L_0767;
L_0764:;
// 7442 syntax error %if mode # constmode
if (MODE == 122) goto L_0768;
SYNTAXERROR();
L_0768:;
// 7443 itemtype = stringtype
ITEMTYPE = 64;
// 7444 %finish
L_0767:;
// 7445 %return
return;
// 7446 s(keyrecord): !%record
case_S_32:;
// 7447 get(left)
GET(55);
// 7448 %unless a(star)=TRUE %start
if (A(88) == 1) goto L_0769;
// 7449 %unless a(ident)=TRUE %start
if (A(53) == 1) goto L_076A;
// 7450 declare anon(typeident)
DECLAREANON(/*?*/ &TYPEIDENT);
// 7451 hold = item; dfhold == dformat
HOLD = ITEM;
DFHOLD = (struct IDENTINFO *)DFORMAT;
// 7452 dformat == ditem
DFORMAT = (struct IDENTINFO *)DITEM;
// 7453 get DECLARATION(writable+readable,0,dformat_val,0)
GETDECLARATION(1 + 2, 0, /*?*/ &DFORMAT->VAL, 0);
// 7454 recalign(dformat_val)
RECALIGN(/*?*/ &DFORMAT->VAL);
// 7455 ditem == dformat
DITEM = (struct IDENTINFO *)DFORMAT;
// 7456 dformat == dfhold; item = hold
DFORMAT = (struct IDENTINFO *)DFHOLD;
ITEM = HOLD;
// 7457 %finish
L_076A:;
// 7458 name error %if item <= 0
if (ITEM > 0) goto L_076B;
NAMEERROR();
L_076B:;
// 7459 error(classerr+point) %if ditem_flags&(\spec) # typeid+recy
if (DITEM->FLAGS & (~256) == 512 + 12) goto L_076C;
ERROR(10 + 64);
L_076C:;
// 7460 itemtype = item; itemsize = ditem_val
ITEMTYPE = ITEM;
ITEMSIZE = DITEM->VAL;
// 7461 %else
goto L_076D;
L_0769:;
// 7462 itemtype = recstar; itemsize = 0
ITEMTYPE = 67;
ITEMSIZE = 0;
// 7463 %finish
L_076D:;
// 7464 get(right)
GET(61);
// 7465 %return
return;
// 7466 s(keyname): !untyped %name - leave unmatched
case_S_33:;
// 7467 itemtype = 0; matched = 0
ITEMTYPE = 0;
MATCHED = 0;
// 7468 %end
return;
case_S_dispatch:
if (S_index < 27 || S_index > 33)
_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 - 27];
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 GETDATATYPE */
// 7469
// 7470 %routine ASSIGN ADDRESS(%integer size)
void ASSIGNADDRESS(int SIZE) {
// 7471
// 7472 %routine ASSIGN STACK ADDRESS
void ASSIGNSTACKADDRESS(void) {
// 7473 align(stmax,2); ditem_val = stmax
ALIGN(/*?*/ &STMAX, 2);
DITEM->VAL = STMAX;
// 7474 stmax = stmax+imod(size)
STMAX = STMAX + _imp_IMOD(SIZE);
// 7475 c_status = c_status!onstack %if depth = 1 %and speccing = 0
if (DEPTH != 1) goto L_076E;
if (SPECCING != 0) goto L_076E;
C.STATUS = C.STATUS | 8;
L_076E:;
// 7476 %end
return;
} /* end of ASSIGNSTACKADDRESS */
// 7477
// 7478 size = -4 %if ditem_flags&(name+indirect) # 0
if (DITEM->FLAGS & (-32768) + 2048 == 0) goto L_076F;
SIZE = -4;
L_076F:;
// 7479 %if depth # 0 %start
if (DEPTH == 0) goto L_0770;
// 7480 dlink_link = item; dlink == ditem
DLINK->LINK = ITEM;
DLINK = (struct IDENTINFO *)DITEM;
// 7481 %if size > 0 %start
if (SIZE <= 0) goto L_0771;
// 7482 !simple value
// 7483 %if dreg > maxcalldreg %start
if (DREG <= MAXCALLDREG) goto L_0772;
// 7484 assign stack address
ASSIGNSTACKADDRESS();
// 7485 %return
return;
// 7486 %finish
L_0772:;
// 7487 c_reg_content(dreg) = item %if speccing = 0
if (SPECCING != 0) goto L_0773;
C.REG.CONTENT[DREG - 1] = ITEM;
L_0773:;
// 7488 ditem_reg = dreg-d0; dreg = dreg+1
DITEM->REG = DREG - 1;
DREG = DREG + 1;
// 7489 %else
goto L_0774;
L_0771:;
// 7490 %if areg > maxcallareg %start
if (AREG <= MAXCALLAREG) goto L_0775;
// 7491 assign stack address
ASSIGNSTACKADDRESS();
// 7492 ditem_reg = 8 {would have been in AREG}
DITEM->REG = 8;
// 7493 %return
return;
// 7494 %finish
L_0775:;
// 7495 c_reg_content(areg) = item+ad %if speccing = 0 %and ditem_flags < 0
if (SPECCING != 0) goto L_0776;
if (DITEM->FLAGS >= 0) goto L_0776;
C.REG.CONTENT[AREG - 1] = ITEM + 16384;
L_0776:;
// 7496 ditem_reg = areg-d0; areg = areg+1
DITEM->REG = AREG - 1;
AREG = AREG + 1;
// 7497 %finish
L_0774:;
// 7498 %finish
L_0770:;
// 7499 size = imod(size)
SIZE = _imp_IMOD(SIZE);
// 7500 align(disp,size)
ALIGN(DISP, SIZE);
// 7501 ditem_val = disp
DITEM->VAL = *DISP;
// 7502 %if constmode # ditem_mode # ownmode %start
{
// Double-sided test on DITEM->MODE (Part I)
int tmp;
if (122 == (tmp = DITEM->MODE)) goto L_0777;
// Double-sided test on DITEM->MODE (Part II)
if (tmp == 108) goto L_0777;
}
// 7503 disp = disp+size
*DISP = *DISP + SIZE;
// 7504 %if ditem_mode >= framemode %start
if (DITEM->MODE < 168) goto L_0778;
// 7505 align(disp,2)
ALIGN(DISP, 2);
// 7506 ditem_val = c_sp-disp; !neg stack disp.
DITEM->VAL = C.SP - *DISP;
// 7507 %finish
L_0778:;
// 7508 %finish
L_0777:;
// 7509 %end
return;
} /* end of ASSIGNADDRESS */
// 7510 !
// 7511 %routine GET QIDENT
void GETQIDENT(void) {
// 7512 get(ident)
GET(53);
// 7513 %if mode = 0 %start; !within record format
if (MODE != 0) goto L_0779;
// 7514 head == dformat_link; item = head
HEAD = (short int *)/*?*/ &DFORMAT->LINK;
ITEM = *HEAD;
// 7515 %if item > 0 %start
if (ITEM <= 0) goto L_077A;
// 7516 %cycle
L_077B:;
// 7517 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM];
// 7518 fault(duperr+point) %if string(ditem_text+char0) = string(charlim)
if (_imp_strcmp((_imp_string *)_imp_STRING(DITEM->TEXT + CHAR0), (_imp_string *)_imp_STRING(CHARLIM)) != 0)
goto L_077C;
FAULT(21 + 64);
L_077C:;
// 7519 head == ditem_hlink; item = head
HEAD = (short int *)/*?*/ &DITEM->HLINK;
ITEM = *HEAD;
// 7520 %repeat %until item <= 0
if (ITEM <= 0) goto L_077D;
goto L_077B;
L_077D:;
// 7521 %finish
L_077A:;
// 7522 %finish
L_0779:;
// 7523 declare(decl)
DECLARE(/*?*/ &DECL);
// 7524 %end
return;
} /* end of GETQIDENT */
// 7525
// 7526 !<<BOTH
// 7527 %routine DUMP CONST(%integer v,n)
void DUMPCONST(int V, int N) {
// 7528 ! Plant N replications of value V (of type ITEMTYPE and size ITEMSIZE)
// 7529 ! For simple operand V is value, otherwise V is address in FINAL
// 7530 ! Alignment requirement has been enforced (since it depends on context)
// 7531 %integer i,j,k,kk,vv
int I;
int J;
int K;
int KK;
int VV;
// 7532 k = itemsize
K = ITEMSIZE;
// 7533 %if k <= 0 %start; !structure
if (K > 0) goto L_077E;
// 7534 k = -k
K = -K;
// 7535 k = final(v)+1 %if k = 0; ![string]
if (K != 0) goto L_077F;
K = FINAL[V] + 1;
L_077F:;
// 7536 cad = v %if v # 0; !reset cad
if (V == 0) goto L_0780;
CAD = V;
L_0780:;
// 7537 %finish
L_077E:;
// 7538 kk = k
KK = K;
// 7539 %return %if n < 1
if (N >= 1) goto L_0781;
return;
L_0781:;
// 7540 kk = kk*n %if n > 1
if (N <= 1) goto L_0782;
KK = KK * N;
L_0782:;
// 7541 %if mode = constmode %start
if (MODE != 122) goto L_0783;
// 7542 i = cad; cad = cad+kk
I = CAD;
CAD = CAD + KK;
// 7543 croak("Program too big") %if cad >= ownbase
if (CAD < OWNBASE) goto L_0784;
CROAK(_imp_str_literal("Program too big"));
L_0784:;
// 7544 %else
goto L_0785;
L_0783:;
// 7545 %if ownbase+ownad+kk-finalbound > 0 %start
if (OWNBASE + OWNAD + KK - FINALBOUND <= 0) goto L_0786;
// 7546 make room(ownbase+ownad+kk-finalbound)
MAKEROOM(OWNBASE + OWNAD + KK - FINALBOUND);
// 7547 %finish
L_0786:;
// 7548 i = ownbase+ownad; ownad = ownad+kk
I = OWNBASE + OWNAD;
OWNAD = OWNAD + KK;
// 7549 %finish
L_0785:;
// 7550 %if itemsize <= 0 %start
if (ITEMSIZE > 0) goto L_0787;
// 7551 %while n > 0 %cycle
L_0788:;
if (N <= 0) goto L_0789;
// 7552 n = n-1; j = i+k
N = N - 1;
J = I + K;
// 7553 %if v # 0 %start
if (V == 0) goto L_078A;
// 7554 vv = v
VV = V;
// 7555 %cycle
L_078B:;
// 7556 final(i) = final(vv)
FINAL[I] = FINAL[VV];
// 7557 i = i+1; vv = vv+1
I = I + 1;
VV = VV + 1;
// 7558 %repeat %until i =j
if (I == J) goto L_078C;
goto L_078B;
L_078C:;
// 7559 %else
goto L_078D;
L_078A:;
// 7560 final(i) = 0 %and i = i+1 %while i < j
L_078E:;
if (I >= J) goto L_078F;
FINAL[I] = 0;
I = I + 1;
goto L_078E;
L_078F:;
// 7561 %finish
L_078D:;
// 7562 %repeat
goto L_0788;
L_0789:;
// 7563 %else
goto L_0790;
L_0787:;
// 7564 !$IF VAX
// 7565 { v = ieee(v) %if itemtype = realtype; !vax->ieee
// 7566 !$FINISH
// 7567 %while n > 0 %cycle
L_0791:;
if (N <= 0) goto L_0792;
// 7568 n = n-1
N = N - 1;
// 7569 %if itemsize >= 2 %start
if (ITEMSIZE < 2) goto L_0793;
// 7570 %if itemsize > 2 %start; !longword
if (ITEMSIZE <= 2) goto L_0794;
// 7571 final(i) <- v>>24
FINAL[I] = (unsigned char)((unsigned int)V >> 24);
// 7572 final(i+1) <- v>>16
FINAL[I + 1] = (unsigned char)((unsigned int)V >> 16);
// 7573 i = i+2
I = I + 2;
// 7574 %finish
L_0794:;
// 7575 final(i) <- v>>8
FINAL[I] = (unsigned char)((unsigned int)V >> 8);
// 7576 i = i+1
I = I + 1;
// 7577 %finish
L_0793:;
// 7578 final(i) <- v
FINAL[I] = (unsigned char)(V);
// 7579 i = i+1
I = I + 1;
// 7580 %repeat
goto L_0791;
L_0792:;
// 7581 %finish
L_0790:;
// 7582 %end; !dump const
return;
} /* end of DUMPCONST */
// 7583 !<<IMP
// 7584
// 7585 %routine GET VAR BOUND
void GETVARBOUND(void) {
// 7586 %integer f
int F;
// 7587 f = decl_flags
F = DECL.FLAGS;
// 7588 get DATA TYPE
GETDATATYPE();
// 7589 decl_flags = okflag+mflag; decl_type = itemtype
DECL.FLAGS = 64 + 128;
DECL.TYPE = ITEMTYPE;
// 7590 get(ident); declare(decl)
GET(53);
DECLARE(/*?*/ &DECL);
// 7591 decl_flags = f
DECL.FLAGS = F;
// 7592 assign address(itemsize)
ASSIGNADDRESS(ITEMSIZE);
// 7593 %end
return;
} /* end of GETVARBOUND */
// 7594
// 7595 %routine DECLARE BOUND(%integer mode,val)
void DECLAREBOUND(int MODE, int VAL) {
// 7596 declare anon(details(okflag,inttype,mode,val))
DECLAREANON(DETAILS(64, 43, MODE, VAL));
// 7597 %if depth # 0 %and mode >= framemode %start
if (DEPTH == 0) goto L_0795;
if (MODE < 168) goto L_0795;
// 7598 ditem_flags = ditem_flags!mflag
DITEM->FLAGS = DITEM->FLAGS | 128;
// 7599 assign address(4)
ASSIGNADDRESS(4);
// 7600 %finish
L_0795:;
// 7601 %end
return;
} /* end of DECLAREBOUND */
// 7602
// 7603 %routine GET ARRAY DECLARATION(%integer dim)
void GETARRAYDECLARATION(int DIM) {
// 7604 %integer pos,dlim1,holdval,holdz,jam,elements,tot,totsize,lo1,size1
int POS;
int DLIM1;
int HOLDVAL;
int HOLDZ;
int JAM;
int ELEMENTS;
int TOT;
int TOTSIZE;
int LO1;
int SIZE1;
// 7605 %record(identinfo)%name dp
struct IDENTINFO *DP;
// 7606 %ownrecord(objinfo) ATYPE=0
static struct OBJINFO ATYPE = {0};
// 7607
// 7608 %integer%fn XTYPE
int XTYPE(void) {
// 7609 declare anon(details(typeid,inttype,0,0))
DECLAREANON(DETAILS(512, 43, 0, 0));
// 7610 %result = item
return ITEM;
// 7611 %end
} /* end of XTYPE */
// 7612
// 7613 %routine STRING STAR ARRAY
void STRINGSTARARRAY(void) {
// 7614 fault(notin+point) %if depth = 0
if (DEPTH != 0) goto L_0796;
FAULT(40 + 64);
L_0796:;
// 7615 ! VAR for size
// 7616 declare anon(details(okflag+mflag+inty,inttype,mode,0))
DECLAREANON(DETAILS(64 + 128 + 0, 43, MODE, 0));
// 7617 tot = item
TOT = ITEM;
// 7618 assign address(4)
ASSIGNADDRESS(4);
// 7619 ! TYPEID for string(*)
// 7620 declare anon(details(typeid+stringy,inttype,0,0))
DECLAREANON(DETAILS(512 + 8, 43, 0, 0));
// 7621 atype_type = item
ATYPE.TYPE = ITEM;
// 7622 elements = maxint
ELEMENTS = 2147483647;
// 7623 %end
return;
} /* end of STRINGSTARARRAY */
// 7624
// 7625 %routine GET REST
void GETREST(void) {
// 7626 %integer e,r,lo,loval,hi,hival
int E;
int R;
int LO;
int LOVAL;
int HI;
int HIVAL;
// 7627 r = 0
R = 0;
// 7628 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_0797;
ATOM = NEXTATOM();
L_0797:;
// 7629 %if decl_flags < 0 %start; !%array%name
if (DECL.FLAGS >= 0) goto L_0798;
// 7630 %if depth > 0 %and ktype <= atom <= keyinteger %start; !variable
if (DEPTH <= 0) goto L_0799;
{
// Double-sided test on ATOM (Part I)
int tmp;
if (27 > (tmp = ATOM)) goto L_0799;
// Double-sided test on ATOM (Part II)
if (tmp > 28) goto L_0799;
}
// 7631 r = xtype; get VAR BOUND
R = XTYPE();
GETVARBOUND();
// 7632 %else
goto L_079A;
L_0799:;
// 7633 get LITERAL(inttype)
GETLITERAL(43);
// 7634 %finish
L_079A:;
// 7635 %else; !%array
goto L_079B;
L_0798:;
// 7636 get VALUE(inttype)
GETVALUE(43);
// 7637 %finish
L_079B:;
// 7638 loval = value; lo = item
LOVAL = VALUE;
LO = ITEM;
// 7639 loval = minint %if lo # 0
if (LO == 0) goto L_079C;
LOVAL = -2147483648;
L_079C:;
// 7640 get(colon)
GET(59);
// 7641 atom = next atom %if matched # 0
if (MATCHED == 0) goto L_079D;
ATOM = NEXTATOM();
L_079D:;
// 7642 %if decl_flags < 0 %start
if (DECL.FLAGS >= 0) goto L_079E;
// 7643 %if depth > 0 %and ktype <= atom <= keyinteger %start; !variable
if (DEPTH <= 0) goto L_079F;
{
// Double-sided test on ATOM (Part I)
int tmp;
if (27 > (tmp = ATOM)) goto L_079F;
// Double-sided test on ATOM (Part II)
if (tmp > 28) goto L_079F;
}
// 7644 %if r = 0 %start
if (R != 0) goto L_07A0;
// 7645 r = xtype; declare bound(litmode,loval)
R = XTYPE();
DECLAREBOUND(60, LOVAL);
// 7646 %finish
L_07A0:;
// 7647 get VAR BOUND
GETVARBOUND();
// 7648 %else
goto L_07A1;
L_079F:;
// 7649 %if dim!r = 0 %and a(star)=TRUE %start
if (DIM | R != 0) goto L_07A2;
if (A(88) != 1) goto L_07A2;
// 7650 item = 0; value = maxint
ITEM = 0;
VALUE = 2147483647;
// 7651 %else
goto L_07A3;
L_07A2:;
// 7652 get LITERAL(inttype)
GETLITERAL(43);
// 7653 declare bound(litmode,value) %if r # 0
if (R == 0) goto L_07A4;
DECLAREBOUND(60, VALUE);
L_07A4:;
// 7654 %finish
L_07A3:;
// 7655 %finish
L_07A1:;
// 7656 %else
goto L_07A5;
L_079E:;
// 7657 get VALUE(inttype)
GETVALUE(43);
// 7658 %finish
L_07A5:;
// 7659 hival = value; hi = item
HIVAL = VALUE;
HI = ITEM;
// 7660 hival = maxint %if hi # 0
if (HI == 0) goto L_07A6;
HIVAL = 2147483647;
L_07A6:;
// 7661 e = maxint
E = 2147483647;
// 7662 %if r = 0 %start; !no range yet declared
if (R != 0) goto L_07A7;
// 7663 %if lo!hi = 0 %start
if (LO | HI != 0) goto L_07A8;
// 7664 e = hival-loval %if hival!!loval >= 0 %or minint+hival-loval < 0
if (HIVAL ^ LOVAL >= 0) goto L_07A9;
if ((-2147483648) + HIVAL - LOVAL >= 0) goto L_07AA;
L_07A9:;
E = HIVAL - LOVAL;
L_07AA:;
// 7665 e = e+1 %if e # maxint
if (E == 2147483647) goto L_07AB;
E = E + 1;
L_07AB:;
// 7666 e = 0 %if hival = maxint
if (HIVAL != 2147483647) goto L_07AC;
E = 0;
L_07AC:;
// 7667 declare lit range(inttype,loval,hival)
DECLARELITRANGE(43, LOVAL, HIVAL);
// 7668 %else
goto L_07AD;
L_07A8:;
// 7669 declare anon(typeident); !blank (for updating)
DECLAREANON(/*?*/ &TYPEIDENT);
// 7670 declare range(inttype,loval,hival)
DECLARERANGE(43, LOVAL, HIVAL);
// 7671 %finish
L_07AD:;
// 7672 r = item
R = ITEM;
// 7673 %finish
L_07A7:;
// 7674 elements = e
ELEMENTS = E;
// 7675 %if a(comma)=TRUE %start
if (A(60) != 1) goto L_07AE;
// 7676 dim = dim+1
DIM = DIM + 1;
// 7677 get REST
GETREST();
// 7678 %if elements # maxint %and e # maxint %start
if (ELEMENTS == 2147483647) goto L_07AF;
if (E == 2147483647) goto L_07AF;
// 7679 elements = elements*e
ELEMENTS = ELEMENTS * E;
// 7680 %else
goto L_07B0;
L_07AF:;
// 7681 elements = maxint
ELEMENTS = 2147483647;
// 7682 %finish
L_07B0:;
// 7683 %finish
L_07AE:;
// 7684 atype_xtype = r
ATYPE.XTYPE = R;
// 7685 size1 = totsize; lo1 = loval; !for outer dimension
SIZE1 = TOTSIZE;
LO1 = LOVAL;
// 7686 string star array %if atype_type = stringstar
if (ATYPE.TYPE != 62) goto L_07B1;
STRINGSTARARRAY();
L_07B1:;
// 7687 %if elements = maxint %start; !non-literal bounds
if (ELEMENTS != 2147483647) goto L_07B2;
// 7688 atype_mode = mode
ATYPE.MODE = MODE;
// 7689 declare anon(atype)
DECLAREANON(/*?*/ &ATYPE);
// 7690 atype_type = item; !save type id
ATYPE.TYPE = ITEM;
// 7691 %if decl_flags >= 0 %or (depth = 1 %and speccing = 0) %start
if (DECL.FLAGS >= 0) goto L_07B3;
if (DEPTH != 1) goto L_07B4;
if (SPECCING != 0) goto L_07B4;
L_07B3:;
// 7692 lo = litref(loval) %if lo = 0
if (LO != 0) goto L_07B5;
LO = LITREF(LOVAL);
L_07B5:;
// 7693 hi = litref(hival) %if hi = 0
if (HI != 0) goto L_07B6;
HI = LITREF(HIVAL);
L_07B6:;
// 7694 tot = litref(totsize) %if tot = 0
if (TOT != 0) goto L_07B7;
TOT = LITREF(TOTSIZE);
L_07B7:;
// 7695 putact(asize,item,tot)
PUTACT(105, ITEM, TOT);
// 7696 putact(0,lo,hi)
PUTACT(0, LO, HI);
// 7697 %if decl_flags >= 0 %start
if (DECL.FLAGS < 0) goto L_07B8;
// 7698 compile(np0)
COMPILE(NP0);
// 7699 dict(r+1)_mode = c_mode %and dict(r+1)_val = c_sp+4 %if lo > 0
if (LO <= 0) goto L_07B9;
DICT[R + 1].MODE = C.MODE;
DICT[R + 1].VAL = C.SP + 4;
L_07B9:;
// 7700 dict(r+2)_mode = c_mode %and dict(r+2)_val = c_sp %if hi > 0
if (HI <= 0) goto L_07BA;
DICT[R + 2].MODE = C.MODE;
DICT[R + 2].VAL = C.SP;
L_07BA:;
// 7701 %finish
L_07B8:;
// 7702 %finish
L_07B4:;
// 7703 tot = 0; totsize = 0
TOT = 0;
TOTSIZE = 0;
// 7704 %else; !literal bounds
goto L_07BB;
L_07B2:;
// 7705 item = 0
ITEM = 0;
// 7706 %cycle
L_07BC:;
// 7707 ditem == dict(item)
DITEM = (struct IDENTINFO *)/*?*/ &DICT[ITEM];
// 7708 %exit %if ditem_type = atype_type %and ditem_xtype = atype_xtype %c
if (DITEM->TYPE != ATYPE.TYPE) goto L_07BD;
if (DITEM->XTYPE != ATYPE.XTYPE) goto L_07BD;
if (DITEM->FLAGS != ATYPE.FLAGS) goto L_07BD;
goto L_07BE;
L_07BD:;
// 7709+ %and ditem_flags = atype_flags
// 7710 item = item+1
ITEM = ITEM + 1;
// 7711 %if item = dlim %start
if (ITEM != DLIM) goto L_07BF;
// 7712 declare anon(atype)
DECLAREANON(/*?*/ &ATYPE);
// 7713 %exit
goto L_07BE;
// 7714 %finish
L_07BF:;
// 7715 %repeat
goto L_07BC;
L_07BE:;
// 7716 atype_type = item
ATYPE.TYPE = ITEM;
// 7717 totsize = totsize*e
TOTSIZE = TOTSIZE * E;
// 7718 %finish
L_07BB:;
// 7719 %end; !get REST
return;
} /* end of GETREST */
// 7720
// 7721 %routine PUT BOUNDS
void PUTBOUNDS(void) {
// 7722 %integer i
int I;
// 7723 i = xtype; !index type
I = XTYPE();
// 7724 declare bound(mode,0); !lower
DECLAREBOUND(MODE, 0);
// 7725 declare bound(mode,0); !upper
DECLAREBOUND(MODE, 0);
// 7726 dim = dim-1
DIM = DIM - 1;
// 7727 put bounds %if dim > 0
if (DIM <= 0) goto L_07C0;
PUTBOUNDS();
L_07C0:;
// 7728 string star array %if atype_type = stringstar
if (ATYPE.TYPE != 62) goto L_07C1;
STRINGSTARARRAY();
L_07C1:;
// 7729 atype_xtype = i
ATYPE.XTYPE = I;
// 7730 declare anon(atype); !array type
DECLAREANON(/*?*/ &ATYPE);
// 7731 %if speccing = 0 %start
if (SPECCING != 0) goto L_07C2;
// 7732 tot = litref(totsize) %if tot = 0
if (TOT != 0) goto L_07C3;
TOT = LITREF(TOTSIZE);
L_07C3:;
// 7733 putact(asize,item,tot)
PUTACT(105, ITEM, TOT);
// 7734 putact(0,i+1,i+2)
PUTACT(0, I + 1, I + 2);
// 7735 %finish
L_07C2:;
// 7736 tot = 0; totsize = 0; lo1 = minint
TOT = 0;
TOTSIZE = 0;
LO1 = -2147483648;
// 7737 atype_type = item
ATYPE.TYPE = ITEM;
// 7738 %end
return;
} /* end of PUTBOUNDS */
// 7739
// 7740 pos = dlim0; dlim1 = dlim; dp == ditem
POS = DLIM0;
DLIM1 = DLIM;
DP = (struct IDENTINFO *)DITEM;
// 7741 atype_flags = typeid+arry+okflag; atype_type = itemtype
ATYPE.FLAGS = 512 + 9 + 64;
ATYPE.TYPE = ITEMTYPE;
// 7742 %if atype_type < 0 %start; !element %name
if (ATYPE.TYPE >= 0) goto L_07C4;
// 7743 atype_flags = atype_flags+name; atype_type = atype_type-name
ATYPE.FLAGS = ATYPE.FLAGS + (-32768);
ATYPE.TYPE = ATYPE.TYPE + 32768;
// 7744 %finish
L_07C4:;
// 7745 atype_mode = constmode; !by default (literal bounds)
ATYPE.MODE = 122;
// 7746 tot = 0; totsize = imod(itemsize)
TOT = 0;
TOTSIZE = _imp_IMOD(ITEMSIZE);
// 7747 %if dim > 0 %start; !%array(n)%name
if (DIM <= 0) goto L_07C5;
// 7748 atype_mode = mode
ATYPE.MODE = MODE;
// 7749 put bounds
PUTBOUNDS();
// 7750 elements = maxint
ELEMENTS = 2147483647;
// 7751 %else; !left parenthesis recognised
goto L_07C6;
L_07C5:;
// 7752 get REST
GETREST();
// 7753 get(right)
GET(61);
// 7754 %finish
L_07C6:;
// 7755 dp_type = atype_type
DP->TYPE = ATYPE.TYPE;
// 7756 %if mode # constmode %and mode # ownmode %start
if (MODE == 122) goto L_07C7;
if (MODE == 108) goto L_07C7;
// 7757 holdval = d0
HOLDVAL = 1;
// 7758 %while pos # dlim1 %cycle
L_07C8:;
if (POS == DLIM1) goto L_07C9;
// 7759 dp == dict(pos)
DP = (struct IDENTINFO *)/*?*/ &DICT[POS];
// 7760 dp_type = atype_type
DP->TYPE = ATYPE.TYPE;
// 7761 %if mode >= framemode %start
if (MODE < 168) goto L_07CA;
// 7762 dp_flags = dp_flags!arrflag %if lo1 = minint %or size1 = 0
if (LO1 == -2147483648) goto L_07CB;
if (SIZE1 != 0) goto L_07CC;
L_07CB:;
DP->FLAGS = DP->FLAGS | 8;
L_07CC:;
// 7763 %if decl_flags >= 0 %start; !%array not %array%name
if (DECL.FLAGS < 0) goto L_07CD;
// 7764 %if totsize # 0 {all literal bounds} %c
if (TOTSIZE == 0) goto L_07CE;
if ((TOTSIZE << 1) - C.SP + *DISP > 32000) goto L_07CE;
// 7765+ %and totsize<<1-c_sp+disp <= 32000 %start
// 7766 !if array will occupy less than half remaining reach
// 7767 !then allocate directly on stack
// 7768 disp = disp+totsize
*DISP = *DISP + TOTSIZE;
// 7769 align(disp,2)
ALIGN(DISP, 2);
// 7770 %else
goto L_07CF;
L_07CE:;
// 7771 fault(ordererr) %if c_mode&2_01000000 # 0; !hard order error
if (C.MODE & 64 == 0) goto L_07D0;
FAULT(22);
L_07D0:;
// 7772 %if totsize # 0 %start; !known bounds but too big
if (TOTSIZE == 0) goto L_07D1;
// 7773 c_extra = c_extra+totsize
C.EXTRA = C.EXTRA + TOTSIZE;
// 7774 holdval = litref(totsize)
HOLDVAL = LITREF(TOTSIZE);
// 7775 %finish
L_07D1:;
// 7776 ![ADOK updates C_SP]
// 7777 holdz = 0; holdz = litref(-lo1*size1) %if dp_flags&arrflag = 0
HOLDZ = 0;
if (DP->FLAGS & 8 != 0) goto L_07D2;
HOLDZ = LITREF(-(LO1 * SIZE1));
L_07D2:;
// 7778 putact(adok,holdval,holdz); !compute & store space needed
PUTACT(103, HOLDVAL, HOLDZ);
// 7779 compile(np0)
COMPILE(NP0);
// 7780 dp_flags = dp_flags+indirect
DP->FLAGS = DP->FLAGS + 2048;
// 7781 dp_link = c_dynarray
DP->LINK = C.DYNARRAY;
// 7782 c_dynarray = pos; c_dynarray = -c_dynarray %if holdz # 0
C.DYNARRAY = POS;
if (HOLDZ == 0) goto L_07D3;
C.DYNARRAY = -C.DYNARRAY;
L_07D3:;
// 7783 c_status = c_status!unknown
C.STATUS = C.STATUS | 2;
// 7784 holdval = 0
HOLDVAL = 0;
// 7785 %finish
L_07CF:;
// 7786 dp_val = c_sp-disp
DP->VAL = C.SP - *DISP;
// 7787 %finish
L_07CD:;
// 7788 %else { %if decl_flags >= 0}; !record field or absolute
goto L_07D4;
L_07CA:;
// 7789 !** to be corrected **
// 7790 !name already allocated
// 7791 { dp_val = disp; disp = disp+totsize}
// 7792 dp_val = disp
DP->VAL = *DISP;
// 7793 %if decl_flags < 0 %then disp = disp+4 %else disp = disp+totsize
if (DECL.FLAGS >= 0) goto L_07D5;
*DISP = *DISP + 4;
goto L_07D6;
L_07D5:;
*DISP = *DISP + TOTSIZE;
L_07D6:;
// 7794 %finish
L_07D4:;
// 7795 pos = pos+1
POS = POS + 1;
// 7796 %repeat
goto L_07C8;
L_07C9:;
// 7797 %else; !const,own
goto L_07D7;
L_07C7:;
// 7798 %if decl_flags&(name+indirect) # 0 %start
if (DECL.FLAGS & (-32768) + 2048 == 0) goto L_07D8;
// 7799 %if mode = constmode %then fill code(4) %else fill own(4)
if (MODE != 122) goto L_07D9;
FILLCODE(4);
goto L_07DA;
L_07D9:;
FILLOWN(4);
L_07DA:;
// 7800 %else
goto L_07DB;
L_07D8:;
// 7801 %if a assop(itemtype)=TRUE %start
if (AASSOP(ITEMTYPE) != 1) goto L_07DC;
// 7802 jam = jammy
JAM = JAMMY;
// 7803 dp_flags = dp_flags!okflag; ![hum]
DP->FLAGS = DP->FLAGS | 64;
// 7804 allow(terminator)
ALLOW(51);
// 7805 %cycle
L_07DD:;
// 7806 jammy = jam
JAMMY = JAM;
// 7807 get VALUE(itemtype)
GETVALUE(ITEMTYPE);
// 7808 faultnum = rangerr+point+warn %if faultnum = rangerr+point
if (FAULTNUM != 24 + 64) goto L_07DE;
FAULTNUM = 24 + 64 + (-128);
L_07DE:;
// 7809 holdval = value
HOLDVAL = VALUE;
// 7810 value = 1
VALUE = 1;
// 7811 %if a(left)=TRUE %start
if (A(55) != 1) goto L_07DF;
// 7812 value = elements
VALUE = ELEMENTS;
// 7813 get LITERAL(halftype) %unless a(star)=TRUE
if (A(88) == 1) goto L_07E0;
GETLITERAL(49);
L_07E0:;
// 7814 get(right)
GET(61);
// 7815 %finish
L_07DF:;
// 7816 elements = elements-value
ELEMENTS = ELEMENTS - VALUE;
// 7817 value = value+elements %if elements < 0
if (ELEMENTS >= 0) goto L_07E1;
VALUE = VALUE + ELEMENTS;
L_07E1:;
// 7818 dump const(holdval,value)
DUMPCONST(HOLDVAL, VALUE);
// 7819 %repeat %until %not a(comma)=TRUE
if (A(60) != 1) goto L_07E2;
goto L_07DD;
L_07E2:;
// 7820 %if faultnum = 0 %and elements # 0 %start
if (FAULTNUM != 0) goto L_07E3;
if (ELEMENTS == 0) goto L_07E3;
// 7821 %if elements < 0 %then report(counterr,pos,elements) %c
if (ELEMENTS >= 0) goto L_07E4;
REPORT(45, POS, ELEMENTS);
goto L_07E5;
L_07E4:;
REPORT(45 + (-128), POS, ELEMENTS);
L_07E5:;
// 7822+ %else report(counterr+warn,pos,elements)
// 7823 %finish
L_07E3:;
// 7824 %finish
L_07DC:;
// 7825 dump const(0,elements) %if elements > 0
if (ELEMENTS <= 0) goto L_07E6;
DUMPCONST(0, ELEMENTS);
L_07E6:;
// 7826 %finish
L_07DB:;
// 7827 %finish
L_07D7:;
// 7828 %end; !get ARRAY DECLARATION
return;
} /* end of GETARRAYDECLARATION */
// 7829 !
// 7830 %routine GET PROCEDURE DECLARATION
void GETPROCEDUREDECLARATION(void) {
// 7831 %integer pos,dlim1,argmode,argad,restype,stack
int POS;
int DLIM1;
int ARGMODE;
int ARGAD;
int RESTYPE;
int STACK;
// 7832 %record(identinfo)%name headditem,dhold
struct IDENTINFO *HEADDITEM;
struct IDENTINFO *DHOLD;
// 7833
// 7834 %integerfn DUPOK
int DUPOK(void) {
// 7835 !Check that the proc being declared can reasonably alias existing id
// 7836 %record(identinfo)%name tp
struct IDENTINFO *TP;
// 7837 %result = FALSE %if ditem_flags&proc = 0
if (DITEM->FLAGS & 12288 != 0) goto L_07E7;
return 0;
L_07E7:;
// 7838 tp == typecell(ditem_type)
TP = (struct IDENTINFO *)TYPECELL(DITEM->TYPE);
// 7839 %if restype = 0 %start; !routine
if (RESTYPE != 0) goto L_07E8;
// 7840 %result = FALSE %if tp_type # 0 %or tp_link = 0; !not routine, or no pars
if (TP->TYPE != 0) goto L_07E9;
if (TP->LINK != 0) goto L_07EA;
L_07E9:;
return 0;
L_07EA:;
// 7841 %else
goto L_07EB;
L_07E8:;
// 7842 %result = FALSE %if restype = tp_type; !function of same type
if (RESTYPE != TP->TYPE) goto L_07EC;
return 0;
L_07EC:;
// 7843 %finish
L_07EB:;
// 7844 %result = TRUE
return 1;
// 7845 %end
} /* end of DUPOK */
// 7846
// 7847 restype = itemtype
RESTYPE = ITEMTYPE;
// 7848 stack = 0; !unknown
STACK = 0;
// 7849 decl_flags = decl_flags&(\okflag)
DECL.FLAGS = DECL.FLAGS & (~64);
// 7850 decl_type = procstar; !by default
DECL.TYPE = 42;
// 7851 %if depth # 0 %start; !procedure as param
if (DEPTH == 0) goto L_07ED;
// 7852 decl_flags = decl_flags!proc2; ![must push MB in case external]
DECL.FLAGS = DECL.FLAGS | 8192;
// 7853 %finish %else %if mode >= framemode %start
goto L_07EE;
L_07ED:;
if (MODE < 168) goto L_07EF;
// 7854 decl_mode = procmode; decl_val = 0
DECL.MODE = 250;
DECL.VAL = 0;
// 7855 decl_flags = decl_flags!proc1
DECL.FLAGS = DECL.FLAGS | 4096;
// 7856 decl_flags = decl_flags!spec %if a(keyspec)=TRUE
if (A(37) != 1) goto L_07F0;
DECL.FLAGS = DECL.FLAGS | 256;
L_07F0:;
// 7857 %finish %else %if mode = ownmode %start; !external (not @)
goto L_07EE;
L_07EF:;
if (MODE != 108) goto L_07F1;
// 7858 decl_mode = procmode; decl_val = 0
DECL.MODE = 250;
DECL.VAL = 0;
// 7859 %if a(keyspec)=TRUE %start
if (A(37) != 1) goto L_07F2;
// 7860 decl_mode = ownmode; decl_flags = decl_flags!spec
DECL.MODE = 108;
DECL.FLAGS = DECL.FLAGS | 256;
// 7861 %finish
L_07F2:;
// 7862 %else; !@...
goto L_07EE;
L_07F1:;
// 7863 decl_flags = decl_flags!proc1
DECL.FLAGS = DECL.FLAGS | 4096;
// 7864 decl_val = disp
DECL.VAL = *DISP;
// 7865 stack = 4
STACK = 4;
// 7866 %finish
L_07EE:;
// 7867 %if decl_flags&ext # 0 %and a(keyalias)=TRUE %start
if (DECL.FLAGS & 16384 == 0) goto L_07F3;
if (A(49) != 1) goto L_07F3;
// 7868 nonstandard(9)
NONSTANDARD(9);
// 7869 get(ident)
GET(53);
// 7870 %if item <= 0 %start
if (ITEM > 0) goto L_07F4;
// 7871 fault(namerr+point)
FAULT(9 + 64);
// 7872 %else
goto L_07F5;
L_07F4:;
// 7873 item = 0 %and decl_flags = decl_flags!alt %if dupok=TRUE
if (DUPOK() != 1) goto L_07F6;
ITEM = 0;
DECL.FLAGS = DECL.FLAGS | 8;
L_07F6:;
// 7874 %finish
L_07F5:;
// 7875 %else
goto L_07F7;
L_07F3:;
// 7876 get(ident)
GET(53);
// 7877 %finish
L_07F7:;
// 7878 declare(decl)
DECLARE(/*?*/ &DECL);
// 7879 headditem == ditem
HEADDITEM = (struct IDENTINFO *)DITEM;
// 7880 assign address(-6) %if depth # 0
if (DEPTH == 0) goto L_07F8;
ASSIGNADDRESS(-6);
L_07F8:;
// 7881 argmode = c_mode&(\2_01000000)+1
ARGMODE = (C.MODE & (~64)) + 1;
// 7882 %if decl_flags&spec # 0 %or decl_mode # procmode %start
if (DECL.FLAGS & 256 != 0) goto L_07F9;
if (DECL.MODE == 250) goto L_07FA;
L_07F9:;
// 7883 speccing = speccing+1
SPECCING = SPECCING + 1;
// 7884 %else
goto L_07FB;
L_07FA:;
// 7885 c_forward = c_forward-1 %if ditem_flags&rflag # 0
if (DITEM->FLAGS & 32 == 0) goto L_07FC;
C.FORWARD = C.FORWARD - 1;
L_07FC:;
// 7886 open block(item)
OPENBLOCK(ITEM);
// 7887 c_type = restype
C.TYPE = RESTYPE;
// 7888 c_type = c_type!sign16 %if decl_flags&writable # 0 {%map}
if (DECL.FLAGS & 1 == 0) goto L_07FD;
C.TYPE = C.TYPE | (-32768);
L_07FD:;
// 7889 %finish
L_07FB:;
// 7890 dlim1 = dlim
DLIM1 = DLIM;
// 7891 declare anon(details(0,restype,0,stack))
DECLAREANON(DETAILS(0, RESTYPE, 0, STACK));
// 7892 ! Result in A0 for %map or structure %fn
// 7893 ditem_reg = 8 %if decl_flags&writable # 0 {%map} %C
if (DECL.FLAGS & 1 != 0) goto L_07FE;
if (SIZE(RESTYPE) > 0) goto L_07FF;
L_07FE:;
DITEM->REG = 8;
L_07FF:;
// 7894+ %or size(restype) <= 0 {structure %fn}
// 7895 !Declare parameters
// 7896 argad = c_sp; !ok for both spec and body
ARGAD = C.SP;
// 7897 %if a(left)=TRUE %start
if (A(55) != 1) goto L_0800;
// 7898 dhold == dlink; dlink == ditem
DHOLD = (struct IDENTINFO *)DLINK;
DLINK = (struct IDENTINFO *)DITEM;
// 7899 get DECLARATION(okflag+writable+readable,argmode,argad,1)
GETDECLARATION(64 + 1 + 2, ARGMODE, /*?*/ &ARGAD, 1);
// 7900 dlink == dhold
DLINK = (struct IDENTINFO *)DHOLD;
// 7901 get(right)
GET(61);
// 7902 %finish
L_0800:;
// 7903 %if speccing # 0 %start
if (SPECCING == 0) goto L_0801;
// 7904 speccing = speccing-1
SPECCING = SPECCING - 1;
// 7905 pos = crunched(dlim1)
POS = CRUNCHED(DLIM1);
// 7906 %if pos < dlim1 %or speccing = 0 %start
if (POS < DLIM1) goto L_0802;
if (SPECCING != 0) goto L_0803;
L_0802:;
// 7907 headditem_type = pos
HEADDITEM->TYPE = POS;
// 7908 %else; !proc as param
goto L_0804;
L_0803:;
// 7909 fault(classerr); dlim = dlim1
FAULT(10);
DLIM = DLIM1;
// 7910 %finish
L_0804:;
// 7911 %else; !procedure body
goto L_0805;
L_0801:;
// 7912 %if c_dpid_flags&spec # 0 %start
if (C.DPID->FLAGS & 256 == 0) goto L_0806;
// 7913 c_dpid_flags = c_dpid_flags-spec
C.DPID->FLAGS = C.DPID->FLAGS - 256;
// 7914 %unless parmatch(c_dpid_type,dlim1)=TRUE %start
if (PARMATCH(C.DPID->TYPE, DLIM1) == 1) goto L_0807;
// 7915 %if c_pid = dlim1-2 %then fault(matcherr+warn) %c
if (C.PID != DLIM1 - 2) goto L_0808;
FAULT(23 + (-128));
goto L_0809;
L_0808:;
FAULT(23);
L_0809:;
// 7916+ %else fault(matcherr)
// 7917 %finish
L_0807:;
// 7918 %finish
L_0806:;
// 7919 headditem_type = dlim1
HEADDITEM->TYPE = DLIM1;
// 7920 c_parlim = dlim
C.PARLIM = DLIM;
// 7921 c_sp = -argad
C.SP = -ARGAD;
// 7922 compile(np0)
COMPILE(NP0);
// 7923 get(terminator)
GET(51);
// 7924 get STATEMENTS(keyend)
GETSTATEMENTS(1);
// 7925 %finish
L_0805:;
// 7926 %end; !get procedure declaration
return;
} /* end of GETPROCEDUREDECLARATION */
// 7927
// 7928 %routine GET INITIAL VALUE(%record(identinfo)%name dp)
void GETINITIALVALUE(struct IDENTINFO * DP) {
// 7929 %integer present
int PRESENT;
// 7930 present=0
PRESENT = 0;
// 7931 jammy = 0
JAMMY = 0;
// 7932 %if a assop(itemtype)=TRUE %start
if (AASSOP(ITEMTYPE) != 1) goto L_080A;
// 7933 get VALUE(itemtype)
GETVALUE(ITEMTYPE);
// 7934 dp_flags = dp_flags!okflag
DP->FLAGS = DP->FLAGS | 64;
// 7935 present = 1
PRESENT = 1;
// 7936 %finish
L_080A:;
// 7937 %if mode >= framemode %start; !dynamic
if (MODE < 168) goto L_080B;
// 7938 %if present # 0 %start
if (PRESENT == 0) goto L_080C;
// 7939 atomp = expp %and nonstandard(1) %if item # 0
if (ITEM == 0) goto L_080D;
ATOMP = EXPP;
NONSTANDARD(1);
L_080D:;
// 7940 %if itemtype < 0 %start
if (ITEMTYPE >= 0) goto L_080E;
// 7941 putact(okass,dlim0+ad,normitem)
PUTACT(33, DLIM0 + 16384, NORMITEM());
// 7942 %else
goto L_080F;
L_080E:;
// 7943 putact(okass+jammy,dlim0,normitem)
PUTACT(33 + JAMMY, DLIM0, NORMITEM());
// 7944 %finish
L_080F:;
// 7945 compile(np0)
COMPILE(NP0);
// 7946 %finish
L_080C:;
// 7947 %finish %else %if mode = constmode %start
goto L_0810;
L_080B:;
if (MODE != 122) goto L_0811;
// 7948 syntax error %if present = 0
if (PRESENT != 0) goto L_0812;
SYNTAXERROR();
L_0812:;
// 7949 %if itemtype < 0 %start; !name
if (ITEMTYPE >= 0) goto L_0813;
// 7950 dp_flags = writable+readable
DP->FLAGS = 1 + 2;
// 7951 dp_mode = absmode; dp_val = value
DP->MODE = 56;
DP->VAL = VALUE;
// 7952 %else
goto L_0814;
L_0813:;
// 7953 faultnum = rangerr+point+warn %if faultnum = rangerr+point
if (FAULTNUM != 24 + 64) goto L_0815;
FAULTNUM = 24 + 64 + (-128);
L_0815:;
// 7954 %if itemsize <= 0 %then dump const(value,1) %c
if (ITEMSIZE > 0) goto L_0816;
DUMPCONST(VALUE, 1);
goto L_0817;
L_0816:;
DP->MODE = 60;
DP->VAL = VALUE;
L_0817:;
// 7955+ %else dp_mode = litmode %and dp_val = value
// 7956 %finish
L_0814:;
// 7957 %else; !own
goto L_0810;
L_0811:;
// 7958 %if present # 0 %start
if (PRESENT == 0) goto L_0818;
// 7959 faultnum = rangerr+point+warn %if faultnum = rangerr+point
if (FAULTNUM != 24 + 64) goto L_0819;
FAULTNUM = 24 + 64 + (-128);
L_0819:;
// 7960 dump const(value,1)
DUMPCONST(VALUE, 1);
// 7961 %else
goto L_081A;
L_0818:;
// 7962 %if itemtype < 0 %then fill own(4) %else fill own(imod(itemsize))
if (ITEMTYPE >= 0) goto L_081B;
FILLOWN(4);
goto L_081C;
L_081B:;
FILLOWN(_imp_IMOD(ITEMSIZE));
L_081C:;
// 7963 %finish
L_081A:;
// 7964 %finish
L_0810:;
// 7965 %end; !get initial value
return;
} /* end of GETINITIALVALUE */
// 7966
// 7967 dreg = d0; areg = a0; stmax = 8; !allow for RETAD & LINK
DREG = 1;
AREG = 9;
STMAX = 8;
// 7968 max = 0; base = disp
MAX = 0;
BASE = *DISP;
// 7969 %cycle
L_081D:;
// 7970 disp = base
*DISP = BASE;
// 7971 %cycle
L_081E:;
// 7972 decl = 0
DECL = (struct OBJINFO){0};
// 7973 decl_flags = flags; decl_mode = mode
DECL.FLAGS = FLAGS;
DECL.MODE = MODE;
// 7974 adim = -1
ADIM = -1;
// 7975 %while a(kattrib)=TRUE %cycle
L_081F:;
if (A(26) != 1) goto L_0820;
// 7976 decl_flags = decl_flags!!(1<<subatom)
DECL.FLAGS = DECL.FLAGS ^ 1 << SUBATOM;
// 7977 %repeat
goto L_081F;
L_0820:;
// 7978 %if depth = 0 %and a(left)=TRUE %start; !start of sub-group
if (DEPTH != 0) goto L_0821;
if (A(55) != 1) goto L_0821;
// 7979 align(disp,2)
ALIGN(DISP, 2);
// 7980 ! ad_cat = ad_cat+1 %if mode = 0
// 7981 get DECLARATION(flags,mode,disp,0); get(right)
GETDECLARATION(FLAGS, MODE, DISP, 0);
GET(61);
// 7982 ! ad_cat = ad_cat-1 %if mode = 0
// 7983 %finish %else %if a(rpred)=TRUE %start; !%routine,(%predicate)
goto L_0822;
L_0821:;
if (A(36) != 1) goto L_0823;
// 7984 %if subatom # 0 %start; !pred
if (SUBATOM == 0) goto L_0824;
// 7985 decl_flags = decl_flags&(\(writable))
DECL.FLAGS = DECL.FLAGS & (~1);
// 7986 decl_flags = decl_flags!volatile %if control&volbit # 0
if (CONTROL & 65536 == 0) goto L_0825;
DECL.FLAGS = DECL.FLAGS | 4;
L_0825:;
// 7987 itemtype = booltype
ITEMTYPE = 58;
// 7988 %else
goto L_0826;
L_0824:;
// 7989 decl_flags = decl_flags&(\(writable+readable))
DECL.FLAGS = DECL.FLAGS & ~(1 + 2);
// 7990 itemtype = 0
ITEMTYPE = 0;
// 7991 %finish
L_0826:;
// 7992 get PROCEDURE DECLARATION
GETPROCEDUREDECLARATION();
// 7993 %return %if depth = 0
if (DEPTH != 0) goto L_0827;
return;
L_0827:;
// 7994 %else
goto L_0822;
L_0823:;
// 7995 get DATA TYPE
GETDATATYPE();
// 7996 !Appendages
// 7997 %if a(fnmap)=TRUE %start; !%fn, %map
if (A(35) != 1) goto L_0828;
// 7998 decl_flags = decl_flags!volatile %if control&volbit # 0
if (CONTROL & 65536 == 0) goto L_0829;
DECL.FLAGS = DECL.FLAGS | 4;
L_0829:;
// 7999 %if subatom = 0 %start
if (SUBATOM != 0) goto L_082A;
// 8000 decl_flags = decl_flags&(\writable)
DECL.FLAGS = DECL.FLAGS & (~1);
// 8001 fault(illstarred) %if itemsize = 0
if (ITEMSIZE != 0) goto L_082B;
FAULT(30);
L_082B:;
// 8002 %finish
L_082A:;
// 8003 get PROCEDURE DECLARATION
GETPROCEDUREDECLARATION();
// 8004 %return %if depth = 0
if (DEPTH != 0) goto L_082C;
return;
L_082C:;
// 8005 %else
goto L_082D;
L_0828:;
// 8006 decl_flags = decl_flags&(\proc)
DECL.FLAGS = DECL.FLAGS & (~12288);
// 8007 decl_type = itemtype
DECL.TYPE = ITEMTYPE;
// 8008 %if a(keyname)=TRUE %start
if (A(33) != 1) goto L_082E;
// 8009 decl_flags = decl_flags+name; itemtype = itemtype+name
DECL.FLAGS = DECL.FLAGS + (-32768);
ITEMTYPE = ITEMTYPE + (-32768);
// 8010 itemsize = 4
ITEMSIZE = 4;
// 8011 %finish
L_082E:;
// 8012 %if a(keyarray)=TRUE %start
if (A(38) != 1) goto L_082F;
// 8013 fault(illstarred) %if itemtype = recstar; !%record(*)%array
if (ITEMTYPE != 67) goto L_0830;
FAULT(30);
L_0830:;
// 8014 adim = 0
ADIM = 0;
// 8015 ! ITEMTYPE now reflects element type (+name)
// 8016 ! DECL is for the array itself
// 8017 decl_flags = decl_flags&(\name)
DECL.FLAGS = DECL.FLAGS & (~-32768);
// 8018 decl_type = arrstar
DECL.TYPE = 65;
// 8019 decl_flags = decl_flags!arrflag %if control&arrbit # 0
if (CONTROL & (-2147483648) == 0) goto L_0831;
DECL.FLAGS = DECL.FLAGS | 8;
L_0831:;
// 8020 %if a(left)=TRUE %start
if (A(55) != 1) goto L_0832;
// 8021 fault(notin+point) %if depth = 0
if (DEPTH != 0) goto L_0833;
FAULT(40 + 64);
L_0833:;
// 8022 get LITERAL(inttype)
GETLITERAL(43);
// 8023 %if value&(\7) # 0 %then expfault(rangerr) %else adim = value
if (VALUE & (~7) == 0) goto L_0834;
EXPFAULT(24);
goto L_0835;
L_0834:;
ADIM = VALUE;
L_0835:;
// 8024 get(right)
GET(61);
// 8025 get(keyname); matched = 0
GET(33);
MATCHED = 0;
// 8026 %finish
L_0832:;
// 8027 ! %array%name versus %array
// 8028 decl_flags = decl_flags+name %if a(keyname)=TRUE
if (A(33) != 1) goto L_0836;
DECL.FLAGS = DECL.FLAGS + (-32768);
L_0836:;
// 8029 %finish
L_082F:;
// 8030 ! %record(*) or %string(*) needs %name (or @)
// 8031 ! %string alone allowed only for %const%string
// 8032 fault(illstarred) %if itemsize = 0 %c
if (ITEMSIZE != 0) goto L_0837;
if (DECL.FLAGS < 0) goto L_0837;
if (_imp_ADDR((void *)(DISP)) == _imp_ADDR((void *)(/*?*/ &JOKERAD))) goto L_0837;
if (DECL.TYPE == 64) goto L_0837;
FAULT(30);
L_0837:;
// 8033+ %and decl_flags >= 0 %and disp ## jokerad %c
// 8034+ %and decl_type # stringtype {const}
// 8035 %if disp == c_val %start; !main declaration
if (_imp_ADDR((void *)(DISP)) != _imp_ADDR((void *)(/*?*/ &C.VAL))) goto L_0838;
// 8036 fault(notinblock) %if stopper = 0
if (STOPPER != 0) goto L_0839;
FAULT(38);
L_0839:;
// 8037 %if c_status >= hadon %start
if (C.STATUS < 4096) goto L_083A;
// 8038 %if c_forward!c_return # 0 %or curlab # c_lab1 %start
if (C.FORWARD | C.RETURN != 0) goto L_083B;
if (CURLAB == C.LAB1) goto L_083C;
L_083B:;
// 8039 fault(ordererr)
FAULT(22);
// 8040 %finish %else %if c_status&hadordererr = 0 %start
goto L_083D;
L_083C:;
if (C.STATUS & 8192 != 0) goto L_083E;
// 8041 fault(ordererr+warn); c_status = c_status+hadordererr
FAULT(22 + (-128));
C.STATUS = C.STATUS + 8192;
// 8042 %finish
L_083E:;
L_083D:;
// 8043 %finish
L_083A:;
// 8044 %finish %else %if decl_flags&ext # 0 %and a(keyspec)=TRUE %start
goto L_083F;
L_0838:;
if (DECL.FLAGS & 16384 == 0) goto L_0840;
if (A(37) != 1) goto L_0840;
// 8045 decl_flags = decl_flags!(spec+indirect)
DECL.FLAGS = DECL.FLAGS | 256 + 2048;
// 8046 %finish
L_0840:;
L_083F:;
// 8047 !Read identifier list
// 8048 %cycle
L_0841:;
// 8049 dlim0 = dlim
DLIM0 = DLIM;
// 8050 %unless decl_type = arrstar %start; !not array
if (DECL.TYPE == 65) goto L_0842;
// 8051 get QIDENT
GETQIDENT();
// 8052 assign address(itemsize)
ASSIGNADDRESS(ITEMSIZE);
// 8053 %if mode >= ownmode %and depth = 0 %start
if (MODE < 108) goto L_0843;
if (DEPTH != 0) goto L_0843;
// 8054 %if decl_flags&spec = 0 %then get INITIAL VALUE(ditem) %c
if (DECL.FLAGS & 256 != 0) goto L_0844;
GETINITIALVALUE(DITEM);
goto L_0845;
L_0844:;
SETOWNWORD(0);
SETOWNWORD(0);
L_0845:;
// 8055+ %else set own word(0) %and set own word(0)
// 8056 %finish
L_0843:;
// 8057 %else
goto L_0846;
L_0842:;
// 8058 %cycle
L_0847:;
// 8059 get QIDENT
GETQIDENT();
// 8060 assign address(0); !(4 if name)
ASSIGNADDRESS(0);
// 8061 %exit %unless a(comma)=TRUE
if (A(60) == 1) goto L_0848;
goto L_0849;
L_0848:;
// 8062 atom = next atom
ATOM = NEXTATOM();
// 8063 %if atom # ident %start; !ie new type
if (ATOM == 53) goto L_084A;
// 8064 %if adim = 0 %start; !treat %array%name as %array(1)%name
if (ADIM != 0) goto L_084B;
// 8065 syntax error %if decl_flags >= 0
if (DECL.FLAGS < 0) goto L_084C;
SYNTAXERROR();
L_084C:;
// 8066 adim = 1
ADIM = 1;
// 8067 %finish
L_084B:;
// 8068 get ARRAY DECLARATION(adim)
GETARRAYDECLARATION(ADIM);
// 8069 -> exit22
goto U_1033;
// 8070 %finish
L_084A:;
// 8071 %repeat
goto L_0847;
L_0849:;
// 8072 %if adim # 0 %or %not a(left)=TRUE %start
if (ADIM != 0) goto L_084D;
if (A(55) == 1) goto L_084E;
L_084D:;
// 8073 %if adim = 0 %start
if (ADIM != 0) goto L_084F;
// 8074 syntax error %if decl_flags >= 0
if (DECL.FLAGS < 0) goto L_0850;
SYNTAXERROR();
L_0850:;
// 8075 adim = 1
ADIM = 1;
// 8076 %finish
L_084F:;
// 8077 get ARRAY DECLARATION(adim)
GETARRAYDECLARATION(ADIM);
// 8078 -> exit2
goto U_1034;
// 8079 %finish
L_084E:;
// 8080 get ARRAY DECLARATION(adim)
GETARRAYDECLARATION(ADIM);
// 8081 %finish
L_0846:;
// 8082 -> exit2 %unless a(comma)=TRUE
if (A(60) == 1) goto L_0851;
goto U_1034;
L_0851:;
// 8083 atom = next atom
ATOM = NEXTATOM();
// 8084 %repeat %until atom # ident
if (ATOM != 53) goto L_0852;
goto L_0841;
L_0852:;
// 8085 exit22:
U_1033:;
// 8086 %continue
goto L_0853;
// 8087 %finish
L_082D:;
// 8088 %finish
L_0822:;
// 8089 %exit %unless a(comma)=TRUE; ![NB %continue above]
if (A(60) == 1) goto L_0854;
goto L_0855;
L_0854:;
// 8090 %repeat
L_0853:;
goto L_081E;
L_0855:;
// 8091 exit2:
U_1034:;
// 8092 max = disp %if disp > max
if (*DISP <= MAX) goto L_0856;
MAX = *DISP;
L_0856:;
// 8093 %repeat %until %not a(keyor)=TRUE
if (A(73) != 1) goto L_0857;
goto L_081D;
L_0857:;
// 8094 disp = max
*DISP = MAX;
// 8095 %end; !get declaration
return;
} /* end of GETDECLARATION */
// 8096
// 8097 initial(keyconst):
case_INITIAL_23:;
// 8098 literal = 1
LITERAL = 1;
// 8099 get DECLARATION(okflag+readable,constmode,cad,0)
GETDECLARATION(64 + 2, 122, /*?*/ &CAD, 0);
// 8100 -> term
goto U_1031;
// 8101
// 8102 initial(atsign):
case_INITIAL_57:;
// 8103 dump = 0
DUMP = 0;
// 8104 atted:
U_1023:;
// 8105 fault(lowlevel+warn+point) %and control = control!lowbit %if control&lowbit = 0
if (CONTROL & 16384 != 0) goto L_0858;
FAULT(15 + (-128) + 64);
CONTROL = CONTROL | 16384;
L_0858:;
// 8106 get LITERAL(inttype)
GETLITERAL(43);
// 8107 jokerad = value
JOKERAD = VALUE;
// 8108 %if a(left)=TRUE %start
if (A(55) != 1) goto L_0859;
// 8109 get MIDENT(a0,a7)
GETMIDENT(9, 16);
// 8110 get(right)
GET(61);
// 8111 value = item+(dispmode-a0)
VALUE = ITEM + (40 - 9);
// 8112 %finish %else value = absmode
goto L_085A;
L_0859:;
VALUE = 56;
L_085A:;
// 8113 literal = 1
LITERAL = 1;
// 8114 get DECLARATION(dump!(okflag+writable+readable),value,jokerad,0)
GETDECLARATION(DUMP | 64 + 1 + 2, VALUE, /*?*/ &JOKERAD, 0);
// 8115 -> term
goto U_1031;
// 8116
// 8117 initial(keyown):
case_INITIAL_24:;
// 8118 literal = 1
LITERAL = 1;
// 8119 get DECLARATION(writable+readable,ownmode,ownad,0)
GETDECLARATION(1 + 2, 108, /*?*/ &OWNAD, 0);
// 8120 -> term
goto U_1031;
// 8121
// 8122 initial(keyext):
case_INITIAL_25:;
// 8123 fault(ordererr) %if level # outerlevel
if (LEVEL == 0) goto L_085B;
FAULT(22);
L_085B:;
// 8124 literal = 1
LITERAL = 1;
// 8125 dump = subatom<<12
DUMP = SUBATOM << 12;
// 8126 -> atted %if a(atsign)=TRUE
if (A(57) != 1) goto L_085C;
goto U_1023;
L_085C:;
// 8127 %if a(left)=TRUE %start
if (A(55) != 1) goto L_085D;
// 8128 get LITERAL(inttype); get(right)
GETLITERAL(43);
GET(61);
// 8129 maxcalldreg = (d0-1)+value&15
MAXCALLDREG = 1 - 1 + (VALUE & 15);
// 8130 maxcallareg = (a0-1)+value>>4&15
MAXCALLAREG = 9 - 1 + ((unsigned int)VALUE >> 4 & 15);
// 8131 dump = dump!!(value&(\255))
DUMP = DUMP ^ VALUE & (~255);
// 8132 %finish
L_085D:;
// 8133 get DECLARATION(dump!(writable+readable),ownmode,ownad,0)
GETDECLARATION(DUMP | 1 + 2, 108, /*?*/ &OWNAD, 0);
// 8134 -> term
goto U_1031;
// 8135
// 8136 initial(keyrecord):
case_INITIAL_32:;
// 8137 %unless a(left)=TRUE %start
if (A(55) == 1) goto L_085E;
// 8138 get(keyformat)
GET(34);
// 8139 %if a(keyspec)=TRUE %start
if (A(37) != 1) goto L_085F;
// 8140 typeident_flags = typeid+spec+recy
TYPEIDENT.FLAGS = 512 + 256 + 12;
// 8141 get(ident); declare(typeident)
GET(53);
DECLARE(/*?*/ &TYPEIDENT);
// 8142 %else
goto L_0860;
L_085F:;
// 8143 typeident_flags = typeid+recy
TYPEIDENT.FLAGS = 512 + 12;
// 8144 get(ident); declare(typeident)
GET(53);
DECLARE(/*?*/ &TYPEIDENT);
// 8145 get(left)
GET(55);
// 8146 dformat == ditem
DFORMAT = (struct IDENTINFO *)DITEM;
// 8147 get DECLARATION(writable+readable,0,dformat_val,0)
GETDECLARATION(1 + 2, 0, /*?*/ &DFORMAT->VAL, 0);
// 8148 recalign(dformat_val)
RECALIGN(/*?*/ &DFORMAT->VAL);
// 8149 get(right)
GET(61);
// 8150 %finish
L_0860:;
// 8151 -> term
goto U_1031;
// 8152 %finish
L_085E:;
// 8153 fp = fp-1; atom = keyrecord; !back-up
FP = FP - 1;
ATOM = 32;
// 8154 initial(ktype): initial(keylong):
case_INITIAL_27:;
case_INITIAL_29:;
// 8155 initial(keyinteger): initial(keyreal):
case_INITIAL_28:;
case_INITIAL_30:;
// 8156 initial(kattrib): initial(keystring):
case_INITIAL_26:;
case_INITIAL_31:;
// 8157 initial(rpred):
case_INITIAL_36:;
// 8158 matched = 0
MATCHED = 0;
// 8159 get DECLARATION(writable+readable,c_mode,c_val,0)
GETDECLARATION(1 + 2, C.MODE, /*?*/ &C.VAL, 0);
// 8160 -> term
goto U_1031;
// 8161
// 8162 initial(keylabel):
case_INITIAL_22:;
// 8163 get IDENTLIST(forwardlabel)
GETIDENTLIST(/*?*/ &FORWARDLABEL);
// 8164 -> term
goto U_1031;
// 8165
// 8166 %routine GET SWITCH DECLARATION
void GETSWITCHDECLARATION(void) {
// 8167 %integer i,lo,hi,dlim1
int I;
int LO;
int HI;
int DLIM1;
// 8168 %ownrecord(objinfo) d=0
static struct OBJINFO D = {0};
// 8169 matched = 1
MATCHED = 1;
// 8170 %cycle
L_0861:;
// 8171 d_type = arrstar; !(in case of error)
D.TYPE = 65;
// 8172 d_flags = d_flags+arrflag %if control&arrbit # 0
if (CONTROL & (-2147483648) == 0) goto L_0862;
D.FLAGS = D.FLAGS + 8;
L_0862:;
// 8173 d_mode = labmode
D.MODE = 186;
// 8174 get IDENTLIST(d)
GETIDENTLIST(/*?*/ &D);
// 8175 dlim1 = dlim
DLIM1 = DLIM;
// 8176 declare anon(details(typeid+arry,0,0,0))
DECLAREANON(DETAILS(512 + 9, 0, 0, 0));
// 8177 get(left); get LIT RANGE(inttype); get(right)
GET(55);
GETLITRANGE(43);
GET(61);
// 8178 dict(dlim1)_xtype = item
DICT[DLIM1].XTYPE = ITEM;
// 8179 get bounds(item,lo,hi)
GETBOUNDS(ITEM, /*?*/ &LO, /*?*/ &HI);
// 8180 %cycle; !For each ident in group
L_0863:;
// 8181 %for i = lo,1,hi %cycle
// %for I = LO, 1, HI %cycle
{
int _initial = LO, _final = HI;
if (invalid_for_loop(_initial, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle I = LO, 1, HI");
I = _initial - (1);
L_0864:
if (I == _final) goto L_0865;
I += 1;
// 8182 swpc = swpc-1; prog(swpc) = 0
SWPC = SWPC - 1;
PROG[SWPC] = 0;
// 8183 croak("Code space exhausted") %if swpc <= pc
if (SWPC > PC) goto L_0867;
CROAK(_imp_str_literal("Code space exhausted"));
L_0867:;
// 8184 %repeat
goto L_0864;
}
L_0865:;
// 8185 dict(dlim0)_val = swpc
DICT[DLIM0].VAL = SWPC;
// 8186 dict(dlim0)_type = dlim1
DICT[DLIM0].TYPE = DLIM1;
// 8187 dlim0 = dlim0+1
DLIM0 = DLIM0 + 1;
// 8188 %repeat %until dlim0 = dlim1
if (DLIM0 == DLIM1) goto L_0868;
goto L_0863;
L_0868:;
// 8189 %repeat %until %not a(comma)=TRUE
if (A(60) != 1) goto L_0869;
goto L_0861;
L_0869:;
// 8190 %end
return;
} /* end of GETSWITCHDECLARATION */
// 8191 initial(keyswitch):
case_INITIAL_39:;
// 8192 literal = 1
LITERAL = 1;
// 8193 get SWITCH DECLARATION
GETSWITCHDECLARATION();
// 8194 c_status = c_status!hadswitch
C.STATUS = C.STATUS | 128;
// 8195 ->term
goto U_1031;
// 8196
// 8197 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 8198 !!!!!!!!!!!!!!! Control statements !!!!!!!!!!!!!!!!!!!!!!!!!!!
// 8199 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
// 8200 !
// 8201 %routine OPT
void OPT(void) {
// 8202 %integer c
int C;
// 8203 c=control
C = CONTROL;
// 8204 set options(string(final0+value))
SETOPTIONS(
*({
__typeof__(_imp_string255) tmp = *_imp_STRING(FINAL0 + VALUE) /*q*/;
(_imp_string255 *)&tmp;
})
);
// 8205 select output(listout); !**for now - PAM may alter**
_imp_SELECTOUTPUT(LISTOUT);
// 8206 control = control&(\list) %if initcon&list = 0
if (INITCON & 1 != 0) goto L_086A;
CONTROL = CONTROL & (~1);
L_086A:;
// 8207 control = control!list %if control&(\c)&(ttlist+codelist+explist+dictlist) # 0
if (CONTROL & (~C) & 2 + 32 + 8 + 16 == 0) goto L_086B;
CONTROL = CONTROL | 1;
L_086B:;
// 8208 %end
return;
} /* end of OPT */
// 8209
// 8210 initial(keyoption):
case_INITIAL_48:;
// 8211 get LITSTRING
GETLITSTRING();
// 8212 get(terminator)
GET(51);
// 8213 opt %if faultnum = 0
if (FAULTNUM != 0) goto L_086C;
OPT();
L_086C:;
// 8214 -> next
goto U_101E;
// 8215
// 8216 initial(keyinclude):
case_INITIAL_47:;
// 8217 get LITSTRING
GETLITSTRING();
// 8218 get(terminator)
GET(51);
// 8219 %if faultnum = 0 %start
if (FAULTNUM != 0) goto L_086D;
// 8220 croak("Too many nested includes") %if curfile = 3
if (CURFILE != 3) goto L_086E;
CROAK(_imp_str_literal("Too many nested includes"));
L_086E:;
// 8221 line = line+1 %if sym = nl
if (SYM != 10) goto L_086F;
LINE = LINE + 1;
L_086F:;
// 8222 cur_fp = fp; cur_line = line
CUR->FP = FP;
CUR->LINE = LINE;
// 8223 fcontrol(curfile) = control
FCONTROL[CURFILE - 1] = CONTROL;
// 8224 control = control&(\list) %if control&(codelist+explist+dictlist) = 0
if (CONTROL & 32 + 8 + 16 != 0) goto L_0870;
CONTROL = CONTROL & (~1);
L_0870:;
// 8225 curfile = curfile+1
CURFILE = CURFILE + 1;
// 8226 lastfile = -1 %if curfile = lastfile
if (CURFILE != LASTFILE) goto L_0871;
LASTFILE = -1;
L_0871:;
// 8227 cur == file(curfile); cur = 0
CUR = (struct EDFILE *)/*?*/ &FILE[CURFILE - 1];
*CUR = (struct EDFILE){0};
// 8228 time1 = time1-cputime
TIME1 = TIME1 - CPUTIME;
// 8229 !! define param("INC",cur_name,nodefault)
// 8230 opt
OPT();
// 8231 !! connect edfile(cur)
// 8232 time1 = time1+cputime
TIME1 = TIME1 + CPUTIME;
// 8233 %signal abandon %if cur_flag # 0
if (CUR->FLAG == 0) goto L_0872;
_imp_signal(14, 0, 0, "");
L_0872:;
// 8234 line = 0; sym = nl
LINE = 0;
SYM = 10;
// 8235 curstart = cur_start2; curlim = cur_lim2
CURSTART = CUR->START2;
CURLIM = CUR->LIM2;
// 8236 fp = cur_start2
FP = CUR->START2;
// 8237 %finish
L_086D:;
// 8238 ->next
goto U_101E;
// 8239
// 8240 initial(keycontrol):
case_INITIAL_44:;
// 8241 get LITERAL(inttype)
GETLITERAL(43);
// 8242 control = 0 %if value = 0
if (VALUE != 0) goto L_0873;
CONTROL = 0;
L_0873:;
// 8243 control = control!!value
CONTROL = CONTROL ^ VALUE;
// 8244 show dict(0) %if control&dictlist # 0
if (CONTROL & 16 == 0) goto L_0874;
SHOWDICT(0);
L_0874:;
// 8245 ->term
goto U_1031;
// 8246
// 8247 initial(keylist):
case_INITIAL_43:;
// 8248 control = control!list
CONTROL = CONTROL | 1;
// 8249 ->term
goto U_1031;
// 8250
// 8251 initial(keybegin):
case_INITIAL_5:;
// 8252 get(terminator)
GET(51);
// 8253 %if stopper = 0 %start; !first %begin
if (STOPPER != 0) goto L_0875;
// 8254 c_localdpos = dlim; c_parlim = dlim
C.LOCALDPOS = DLIM;
C.PARLIM = DLIM;
// 8255 c_access = 1
C.ACCESS = 1;
// 8256 get STATEMENTS(keyend)
GETSTATEMENTS(1);
// 8257 %return
return;
// 8258 %finish
L_0875:;
// 8259 declare anon(beginblock)
DECLAREANON(/*?*/ &BEGINBLOCK);
// 8260 open block(dlim0)
OPENBLOCK(DLIM0);
// 8261 get STATEMENTS(keyend)
GETSTATEMENTS(1);
// 8262 update sp
UPDATESP();
// 8263 this is inst
THISISINST();
// 8264 srcall(dlim-1)
SRCALL(DLIM - 1);
// 8265 -> term
goto U_1031;
// 8266
// 8267 initial(keyend):
case_INITIAL_1:;
// 8268 %if stopper > keyend %start
if (STOPPER <= 1) goto L_0876;
// 8269 %if stopper = keyrepeat %then fault(norepeat+now) %C
if (STOPPER != 2) goto L_0877;
FAULT(44 + 128);
goto L_0878;
L_0877:;
FAULT(43 + 128);
L_0878:;
// 8270+ %else fault(nofinish+now)
// 8271 %else
goto L_0879;
L_0876:;
// 8272 %if a(keyof)=TRUE %start
if (A(40) != 1) goto L_087A;
// 8273 %if a(keylist)=TRUE %start
if (A(43) != 1) goto L_087B;
// 8274 control = control&(\list)
CONTROL = CONTROL & (~1);
// 8275 ->term
goto U_1031;
// 8276 %finish
L_087B:;
// 8277 %if a(keyfile)=TRUE %start
if (A(41) != 1) goto L_087C;
// 8278 fp = curlim; sym = nl
FP = CURLIM;
SYM = 10;
// 8279 ->next
goto U_101E;
// 8280 %finish
L_087C:;
// 8281 get(keyprogram)
GET(42);
// 8282 fault(noend+now) %if level # outerlevel
if (LEVEL == 0) goto L_087D;
FAULT(42 + 128);
L_087D:;
// 8283 %finish
L_087A:;
// 8284 fault(nobegin+now) %if stopper = 0
if (STOPPER != 0) goto L_087E;
FAULT(36 + 128);
L_087E:;
// 8285 %if c_access > 0 %start
if (C.ACCESS <= 0) goto L_087F;
// 8286 fault(noresult+now) %if c_type # 0; !fn/map/pred
if (C.TYPE == 0) goto L_0880;
FAULT(5 + 128);
L_0880:;
// 8287 %finish
L_087F:;
// 8288 close block
CLOSEBLOCK();
// 8289 %finish
L_0879:;
// 8290 %end; !GET STATEMENTS
return;
case_INITIAL_dispatch:
if (INITIAL_index < 0 || INITIAL_index > 99)
_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 */
// 8291
// 8292 !<<BOTH
// 8293
// 8294 %routine ANNOUNCE(%integer value,%string(255) message)
void ANNOUNCE(int VALUE, _imp_string255 MESSAGE) {
// 8295 write(value,1); space; printstring(message)
_imp_WRITE(VALUE, 1);
_imp_SPACE();
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = MESSAGE /*q*/;
(_imp_string255 *)&tmp;
})
);
// 8296 printsymbol('s') %if value # 1
if (VALUE == 1) goto L_0881;
_imp_PRINTSYMBOL(115);
L_0881:;
// 8297 %end
return;
} /* end of ANNOUNCE */
// 8298
// 8299 %routine OUTPUT OBJECT FILE
void OUTPUTOBJECTFILE(void) {
// 8300 %constinteger OBJOUT=1
// 8301 %constinteger INITSIZE=18
// 8302 !%constinteger INITSIZE=30
// 8303 %integer i,reset,totsize,ownsize
int I;
int RESET;
int TOTSIZE;
int OWNSIZE;
// 8304 ! INIT SEQUENCE
// 8305 ! code to copy own values from end of code area to data area
// 8306 !
// 8307 ! Program area Data area
// 8308 ! ________________ __________________
// 8309 ! | | | |
// 8310 ! | | | STACK SPACE |
// 8311 ! | CODE | | |
// 8312 ! | | SP->|~~~~~~~~~~~~~~~~|
// 8313 ! |______________| | |
// 8314 ! | init | | |
// 8315 ! |~~~~~~~~~~~~~~| |GLOBAL DYNAMICS |
// 8316 ! | | | |
// 8317 ! | OWN VALUES | MB->|~~~~~~~~~~~~~~~~|
// 8318 ! | | | |
// 8319 ! | | | OWNS |
// 8320 ! |______________| | |
// 8321 ! orig| |
// 8322 ! SP->|~~~~~~~~~~~~~~~~|
// 8323 !
// 8324
// 8325 reset = 0; totsize = cad
RESET = 0;
TOTSIZE = CAD;
// 8326 ownsize = ownad
OWNSIZE = OWNAD;
// 8327 %if ownsize # 0 %start
if (OWNSIZE == 0) goto L_0882;
// 8328 fill own(4-ownad&3) %if ownad&3 # 0
if (OWNAD & 3 == 0) goto L_0883;
FILLOWN(4 - (OWNAD & 3));
L_0883:;
// 8329 ownsize = ownad
OWNSIZE = OWNAD;
// 8330 reset = cad; !entry-point for RESET
RESET = CAD;
// 8331 totsize = totsize+(initsize+ownad); !total code size
TOTSIZE = TOTSIZE + (18 + OWNAD);
// 8332 %finish
L_0882:;
// 8333 set extension(objfile,".mob")
SETEXTENSION((_imp_string127 *)/*p*/ /*?*/ &OBJFILE, _imp_str_literal_size(4, ".mob"));
// 8334 time1 = time1-cputime
TIME1 = TIME1 - CPUTIME;
// 8335 open output(objout,objfile)
_imp_OPENOUTPUT(1,
*({
__typeof__(_imp_string127) tmp = OBJFILE /*q*/;
(_imp_string255 *)&tmp;
})
);
// 8336 select output(objout)
_imp_SELECTOUTPUT(1);
// 8337 put word(16_FE02); !object module flag, version
PUTWORD(65026);
// 8338 put word(control>>20<<4); !checking options
PUTWORD((unsigned int)CONTROL >> 20 << 4);
// 8339 value = 0
VALUE = 0;
// 8340 do externals(externs,-1) %if externs # 0; !find size
if (EXTERNS == 0) goto L_0884;
DOEXTERNALS(EXTERNS, -1);
L_0884:;
// 8341 put word(value); !length of exports
PUTWORD(VALUE);
// 8342 value = 0
VALUE = 0;
// 8343 do externals(extspecs,-1) %if extspecs # 0; !find size
if (EXTSPECS == 0) goto L_0885;
DOEXTERNALS(EXTSPECS, -1);
L_0885:;
// 8344 put word(value); !length of imports
PUTWORD(VALUE);
// 8345 put word(totsize>>16); !length of code + init pattern
PUTWORD((unsigned int)TOTSIZE >> 16);
// 8346 put word(totsize)
PUTWORD(TOTSIZE);
// 8347 put word(reset>>1); !reset entry-point
PUTWORD((unsigned int)RESET >> 1);
// 8348 put word(c_dpid_val>>1); !main entry-point
PUTWORD((unsigned int)C.DPID->VAL >> 1);
// 8349 put word(ownsize>>16); !static data requirement
PUTWORD((unsigned int)OWNSIZE >> 16);
// 8350 put word(ownsize)
PUTWORD(OWNSIZE);
// 8351 put word(c_totstack>>16); !stack requirement
PUTWORD((unsigned int)C.TOTSTACK >> 16);
// 8352 put word(c_totstack)
PUTWORD(C.TOTSTACK);
// 8353 put word(0); !spare for diag
PUTWORD(0);
// 8354 put word(0)
PUTWORD(0);
// 8355 put word(0)
PUTWORD(0);
// 8356 put word(0)
PUTWORD(0);
// 8357 do externals(externs,0) %if externs # 0
if (EXTERNS == 0) goto L_0886;
DOEXTERNALS(EXTERNS, 0);
L_0886:;
// 8358 do externals(extspecs,1) %if extspecs # 0
if (EXTSPECS == 0) goto L_0887;
DOEXTERNALS(EXTSPECS, 1);
L_0887:;
// 8359 final(0) = 16_4E; final(1) =16_75; !RTS (as null reset,main?)
FINAL[0] = 78;
FINAL[1] = 117;
// 8360 i = 0
I = 0;
// 8361 %cycle
L_0888:;
// 8362 print symbol(final(i)); i = i+1
_imp_PRINTSYMBOL(FINAL[I]);
I = I + 1;
// 8363 %repeat %until i = cad
if (I == CAD) goto L_0889;
goto L_0888;
L_0889:;
// 8364 %if ownsize # 0 %start
if (OWNSIZE == 0) goto L_088A;
// 8365 put word(16_2248+mb-a0); ! move.l mb,a1
PUTWORD(8776 + 13 - 9);
// 8366 put word(16_41FA); ! lea initpatt,a0
PUTWORD(16890);
// 8367 put word(16_000E)
PUTWORD(14);
// 8368 put word(16_303C); ! move.w #????,d0
PUTWORD(12348);
// 8369 put word(ownad>>1-1); ![individual owns in shortwords - 1]
PUTWORD(((unsigned int)OWNAD >> 1) - 1);
// 8370 put word(16_32D8); !l1 move.w (a0)+,(a1)+
PUTWORD(13016);
// 8371 put word(16_51C8); ! dbra d0,l1
PUTWORD(20936);
// 8372 put word(-4)
PUTWORD(-4);
// 8373 put word(16_4E75); ! rts
PUTWORD(20085);
// 8374 i = 0
I = 0;
// 8375 %cycle
L_088B:;
// 8376 print symbol(final(i+ownbase)); i = i+1
_imp_PRINTSYMBOL(FINAL[I + OWNBASE]);
I = I + 1;
// 8377 %repeat %until i = ownad
if (I == OWNAD) goto L_088C;
goto L_088B;
L_088C:;
// 8378 %finish
L_088A:;
// 8379 time1 = time1+cputime
TIME1 = TIME1 + CPUTIME;
// 8380 %end
return;
} /* end of OUTPUTOBJECTFILE */
// 8381
// 8382 %routine CLOSE EDIT
void CLOSEEDIT(void) {
// 8383 !_FLAG is negative if edit abandoned
// 8384 !_CHANGE is untouched (inf) if no changes
// 8385 %if file(main)_flag >= 0 %and 0 < file(main)_change # 16_7FFFFFFF %start
if (FILE[0].FLAG < 0) goto L_088D;
{
// Double-sided test on FILE[0].CHANGE (Part I)
int tmp;
if (0 >= (tmp = FILE[0].CHANGE)) goto L_088D;
// Double-sided test on FILE[0].CHANGE (Part II)
if (tmp == 2147483647) goto L_088D;
}
// 8386 file(main)_name = mainfile; ![in case modified by OPEN IN]
_imp_strncpy(/*?*/ &FILE[0].NAME, ({
__typeof__(_imp_string127) tmp; /*B*/
tmp = MAINFILE;
(void *)&tmp;
}),
/*max:*/ 255);
// 8387 time1 = time1-cputime
TIME1 = TIME1 - CPUTIME;
// 8388 !! disconnect edfile(file(main))
// 8389 printstring(file(main)_name." updated"); newline
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp =
_imp_join((_imp_string *)/*?*/ &FILE[0].NAME, (_imp_string *)/*?*/ _imp_str_literal_ptr(" updated"));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_NEWLINE();
// 8390 time1 = time1+cputime
TIME1 = TIME1 + CPUTIME;
// 8391 %finish
L_088D:;
// 8392 %end
return;
} /* end of CLOSEEDIT */
// 8393
// 8394 %begin
{ /*%begin*/
// 8395 %on %event redo,abandon %start
if (!_imp_on_event(13, 14)) goto L_088E;
// 8396 close edit %and %stop %if event_event = abandon
if (_imp_EVENT().EVENT != 14) goto L_088F;
CLOSEEDIT();
_imp_stop(0);
L_088F:;
// 8397 %finish
L_088E:;
// 8398 time2 = cputime-time1
TIME2 = CPUTIME - TIME1;
// 8399 statements = 1; comments = 0; atoms = 0
STATEMENTS = 1;
COMMENTS = 0;
ATOMS = 0;
// 8400 identatoms = 0; litatoms = 0
IDENTATOMS = 0;
LITATOMS = 0;
// 8401 faults = 0; others = 0; faultnum = 0
FAULTS = 0;
OTHERS = 0;
FAULTNUM = 0;
// 8402 zaps = 0; steps = 0; jumps = 0; shorts = 0
ZAPS = 0;
STEPS = 0;
JUMPS = 0;
SHORTS = 0;
// 8403 rep = ""
_imp_strncpy(/*?*/ &REP, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("");
(void *)&tmp;
}),
/*max:*/ 255);
// 8404 forget triples; !reset LITPOS,EXPLO,OLDEXPLO
FORGETTRIPLES();
// 8405 char0 = addr(char(0)); final0 = addr(final(0))
CHAR0 = _imp_ADDR(/*?*/ &CHAR[0]);
FINAL0 = _imp_ADDR(/*?*/ &FINAL[0]);
// 8406 preset
PRESET();
// 8407 dint == dict(inttype)
DINT = (struct IDENTINFO *)/*?*/ &DICT[43];
// 8408 dtemp == dict(lablim); dtemp2 == dict(lablim+1)
DTEMP = (struct IDENTINFO *)/*?*/ &DICT[LABLIM];
DTEMP2 = (struct IDENTINFO *)/*?*/ &DICT[LABLIM + 1];
// 8409 dtsprel == dict(lablim+2) ;! GT: file corruption???? lablim turned into lablib since the last compile! WTF???
DTSPREL = (struct IDENTINFO *)/*?*/ &DICT[LABLIM + 2];
// 8410 dmin = dictlim; dmin0 = dmin
DMIN = DICTLIM;
DMIN0 = DMIN;
// 8411 inclim = 0
INCLIM = 0;
// 8412 accounted = 0
ACCOUNTED = 0;
// 8413 firstentry = finalbound; firstpos = dictlim
FIRSTENTRY = FINALBOUND;
FIRSTPOS = DICTLIM;
// 8414 pc = 1; swpc = progbound+1
PC = 1;
SWPC = 16383 + 1;
// 8415 cad = 2
CAD = 2;
// 8416 final(0) = 0; !for empty string (compile-time only)
FINAL[0] = 0;
// 8417 ownbase = finalbound-4095; ownad = 0
OWNBASE = FINALBOUND - 4095;
OWNAD = 0;
// 8418 level = outerlevel; vintage = 1
LEVEL = 0;
VINTAGE = 1;
// 8419 pendout = 0; pendin = 0; polarity = 0
PENDOUT = 0;
PENDIN = 0;
POLARITY = 0;
// 8420 curlab = dictlim+1
CURLAB = DICTLIM + 1;
// 8421 reset context(procstar,defaultfree)
RESETCONTEXT(42, 3871);
// 8422 c_sp = -4; !allow for BSR
C.SP = -4;
// 8423
// 8424 control = initcon
CONTROL = INITCON;
// 8425 lastfile = main
LASTFILE = 1;
// 8426 curfile = main; cur == file(main)
CURFILE = 1;
CUR = (struct EDFILE *)/*?*/ &FILE[0];
// 8427 curstart = file(main)_start1; curlim = file(main)_lim1
CURSTART = FILE[0].START1;
CURLIM = FILE[0].LIM1;
// 8428 fp = file(main)_start1
FP = FILE[0].START1;
// 8429 line = 0; sym = nl
LINE = 0;
SYM = 10;
// 8430 np = np0
NP = NP0;
// 8431 !<<IMP
// 8432 get STATEMENTS(0)
GETSTATEMENTS(0);
// 8433 !<<BOTH
// 8434 %end
goto end_1000;
end_1000:;
}
// 8435
// 8436 time2 = cputime-time2-time1
TIME2 = CPUTIME - TIME2 - TIME1;
// 8437 close edit
CLOSEEDIT();
// 8438 output object file %if faults = 0 %or control&forcebit # 0
if (FAULTS == 0) goto L_0890;
if (CONTROL & 2048 == 0) goto L_0891;
L_0890:;
OUTPUTOBJECTFILE();
L_0891:;
// 8439 %cycle
L_0892:;
// 8440 select output(listout)
_imp_SELECTOUTPUT(LISTOUT);
// 8441 printstring(file(main)_name)
_imp_PRINTSTRING(
*({
__typeof__(_imp_string255) tmp = FILE[0].NAME /*q*/;
(_imp_string255 *)&tmp;
})
);
// 8442 %if faults = 0 %or control&forcebit # 0 %start
if (FAULTS == 0) goto L_0893;
if (CONTROL & 2048 == 0) goto L_0894;
L_0893:;
// 8443 printstring(" compiled:")
_imp_PRINTSTRING(_imp_str_literal(" compiled:"));
// 8444 announce(statements,"statement")
ANNOUNCE(STATEMENTS, _imp_str_literal("statement"));
// 8445 print string(" (+")
_imp_PRINTSTRING(_imp_str_literal(" (+"));
// 8446 announce(comments,"comment")
ANNOUNCE(COMMENTS, _imp_str_literal("comment"));
// 8447 printstring(") to")
_imp_PRINTSTRING(_imp_str_literal(") to"));
// 8448 announce(cad,"byte")
ANNOUNCE(CAD, _imp_str_literal("byte"));
// 8449 printstring(" (+"); write(ownad,1)
_imp_PRINTSTRING(_imp_str_literal(" (+"));
_imp_WRITE(OWNAD, 1);
// 8450 printsymbol(')')
_imp_PRINTSYMBOL(41);
// 8451 newline
_imp_NEWLINE();
// 8452 %finish
L_0894:;
// 8453 %if faults # 0 %start
if (FAULTS == 0) goto L_0895;
// 8454 printsymbol(':')
_imp_PRINTSYMBOL(58);
// 8455 announce(faults,"fault")
ANNOUNCE(FAULTS, _imp_str_literal("fault"));
// 8456 printstring(" reported")
_imp_PRINTSTRING(_imp_str_literal(" reported"));
// 8457 %if others # 0 %start
if (OTHERS == 0) goto L_0896;
// 8458 printstring(" (+"); announce(others,"other")
_imp_PRINTSTRING(_imp_str_literal(" (+"));
ANNOUNCE(OTHERS, _imp_str_literal("other"));
// 8459 printsymbol(')')
_imp_PRINTSYMBOL(41);
// 8460 %finish
L_0896:;
// 8461 newline
_imp_NEWLINE();
// 8462 %finish
L_0895:;
// 8463 %if control&logbit # 0 %start
if (CONTROL & 1024 == 0) goto L_0897;
// 8464 printstring(%c
_imp_PRINTSTRING(_imp_str_literal(" CODE OWNS JUMPS SHORT STEPS ZAPS | ATOMS LITS IDS TIME"));
// 8465+ " CODE OWNS JUMPS SHORT STEPS ZAPS | ATOMS LITS IDS TIME")
// 8466 newline
_imp_NEWLINE();
// 8467 write(cad,5)
_imp_WRITE(CAD, 5);
// 8468 write(ownad,5)
_imp_WRITE(OWNAD, 5);
// 8469 write(jumps,6); write(shorts,5)
_imp_WRITE(JUMPS, 6);
_imp_WRITE(SHORTS, 5);
// 8470 write(steps,5); write(zaps,5)
_imp_WRITE(STEPS, 5);
_imp_WRITE(ZAPS, 5);
// 8471 print(atoms/statements,5,1)
_imp_PRINT((double)(ATOMS / STATEMENTS), 5, 1);
// 8472 print(litatoms/statements,2,1)
_imp_PRINT((double)(LITATOMS / STATEMENTS), 2, 1);
// 8473 print(identatoms/statements,1,1)
_imp_PRINT((double)(IDENTATOMS / STATEMENTS), 1, 1);
// 8474 print(time2/statements,2,3)
_imp_PRINT((double)(TIME2 / STATEMENTS), 2, 3);
// 8475 printsymbol('+')
_imp_PRINTSYMBOL(43);
// 8476 print(time1/statements,0,3)
_imp_PRINT((double)(TIME1 / STATEMENTS), 0, 3);
// 8477 newline
_imp_NEWLINE();
// 8478 %finish
L_0897:;
// 8479 %exit %if listout = 0
if (LISTOUT != 0) goto L_0898;
goto L_0899;
L_0898:;
// 8480 listout = 0
LISTOUT = 0;
// 8481 %repeat
goto L_0892;
L_0899:;
// 8482 !<<IMP
// 8483 %endofprogram
_imp_stop(0);
return 0;
end_0:;
}