#include <perms.h>
// Edinburgh IMP77 Compiler - Version 8.4
//
// 1 %externalstring(255)%fnspec date
extern _imp_string255 DATE(void);
// 2 %externalstring(255)%fnspec time
extern _imp_string255 TIME(void);
// 3 %systemroutinespec exit %alias "exit" (%integer rc)
extern void EXIT(int RC) __asm__("exit");
// 4
// 5 %externalintegerfnspec cputime
extern int CPUTIME(void);
// 6 %externalroutinespec getblock %alias "GETBLOCK_JSB" (%integer len, %bytename base)
extern void GETBLOCK(int LEN, unsigned char *BASE) __asm__("GETBLOCK_JSB");
// 7 %externalintegerfunctionspec getlong %alias "GETLONG_JSB"
extern int GETLONG(void) __asm__("GETLONG_JSB");
// 8 %externalintegerfunctionspec getword %alias "GETWORD_JSB"
extern int GETWORD(void) __asm__("GETWORD_JSB");
// 9 %externalroutinespec get(%integername n)
extern void GET(int *N);
// 10 %externalroutinespec put(%integer n)
extern void PUT(int N);
// 11 %externalroutinespec putword(%integer n)
extern void PUTWORD(int N);
// 12 %externalroutinespec putlong(%integer n)
extern void PUTLONG(int N);
// 13 %externalroutinespec putblock(%integer len, %bytename b)
extern void PUTBLOCK(int LEN, unsigned char *B);
// 14 ! Computer Science IMP77 Compiler - Version 8 Third pass
// 15 ! 23rd March 1981
// 16 ! Mods by MT October/November 1981
// 17 !
// 18 ! Uses common include file defining constants,
// 19 ! spec'ing common externals etc.
// 20 !
// 21 !!%include "control.imp"
// 22
// 23 {%systemroutinespec exit %alias "exit" (%integer s)
// 24 !%external %routine %spec PUT (%integer n)
// 25 !%external %routine %spec PUT WORD (%integer n)
// 26 !%external %routine %spec PUT LONG (%integer n)
// 27 !%external %routine %spec PUT BLOCK (%integer n, %bytename b)
// 28 %external %routine %spec SELECT INPUT TANK (%integer n)
extern void SELECTINPUTTANK(int N);
// 29 %external %routine %spec SELECT OUTPUT TANK (%integer n)
extern void SELECTOUTPUTTANK(int N);
// 30 !%external %routine %spec GET (%integer %name ch)
// 31 !%external %routine %spec GET BLOCK (%integer len, %byte %name b)
// 32 %external %routine %spec PRINT RECORD (%integer len, %byte %name buff)
extern void PRINTRECORD(int LEN, unsigned char *BUFF);
// 33 %external %integer %function %spec LOOK
extern int LOOK(void);
// 34 !%external %integer %function %spec GETWORD
// 35 !%external %integer %function %spec GETLONG
// 36 %external %integer %function %spec TAG %alias "GETLONG"; ! For pass 2
extern int TAG(void) __asm__("GETLONG");
// 37 %external %string(63) %function %spec ITOS (%integer n, p)
extern _imp_string63 ITOS(int N, int P);
// 38
// 39 ! streams
// 40 %const %integer report = 0
// 41 %const %integer object file = 1
// 42 %const %integer listing = 2
// 43 %const %integer diag stream = listing
// 44
// 45 ! miscellaneous
// 46 %const %integer max ident = 31; ! Length for external linkage
// 47 %const %integer fatal = 16_1000002C; ! Error exit code to VMS
// 48
// 49
// 50 ! external data (defined in driver)
// 51 %external %string(6) %spec version; ! Compiler version string
extern _imp_string6 VERSION;
// 52 %external %integer %spec command
extern int COMMAND;
// 53 %external %integer %spec control
extern int CONTROL;
// 54
// 55 ! command bit meanings (set by command line)
// 56 %const %integer diag bit = 8_00004
// 57 %const %integer line bit = 8_00010
// 58 %const %integer log bit = 8_00020
// 59 %const %integer time bit = 8_01000
// 60 %const %integer entry bit = 8_02000
// 61 %const %integer init bit = 8_04000
// 62 %const %integer pic bit = 8_10000
// 63
// 64 ! control bit meanings (%control n, or set by driver (/check= etc))
// 65 ! bit set => check on
// 66
// 67 %const %integer ass check = 1; ! unassigned checking
// 68 %const %integer str check = 2; ! string capacity checking
// 69 %const %integer for check = 4; ! %for checking
// 70 %const %integer arr check = 8; ! array bound checking
// 71 %const %integer ovf check = 16; ! integer overflow checking
// 72 %const %integer rec round = 128; ! rounding in records (turns it on)
// 73 %const %integer profiling = 256; ! call TRACE (line no) at bounds
// 74
// 75 ! object file commands Pass2 => Pass3
// 76
// 77 %const %integer obj extern = 1; ! insert external entry
// 78 %const %integer obj code = 2; ! code block
// 79 %const %integer obj gla = 3; ! gla block
// 80 %const %integer obj pdef = 4; ! external proc definition
// 81 %const %integer obj pspec = 5; ! external proc specification
// 82 %const %integer obj ddef = 6; ! external data definition
// 83 %const %integer obj dspec = 7; ! external data specification
// 84 %const %integer obj reloc = 8; ! relocate gla
// 85 %const %integer obj set = 9; ! set gla to tag address
// 86 %const %integer obj header = 10; ! start of procedure
// 87 %const %integer obj call = 11; ! procedure call
// 88 %const %integer obj jump = 12; ! jump
// 89 %const %integer obj prim spec = 13; ! prim definition
// 90 %const %integer obj end = 14; ! end of object file
// 91 %const %integer obj line = 15; ! line number
// 92 %const %integer obj term = 16; ! end of block
// 93 %const %integer obj diag p = 17; ! diags for proc header
// 94 %const %integer obj diag v = 18; ! diags for variable
// 95 %const %integer obj weak = 19
// 96 %const %integer obj b lab = 20; ! bxxb in m/code
// 97 %const %integer obj w lab = 21; ! bxxw in m/code
// 98 %const %integer obj glam = 22; ! initialise n items in GLA
// 99 %const %integer obj modd = 23; ! modify displacement
// 100 %const %integer obj prim ref = 24; ! call to prim
// 101 %const %integer obj ext ref = 25; ! call to external procedure
// 102 %const %integer last obj code = 25
// 103
// 104 ! directive file commands Pass2 => Pass3
// 105
// 106 %const %integer dir used = 1; ! external used
// 107 %const %integer dir ldef = 2; ! label definition
// 108 %const %integer dir pref = 3; ! procedure reference
// 109 %const %integer dir cref = 4; ! conditional label reference
// 110 %const %integer dir uref = 5; ! unconditional label reference
// 111 %const %integer dir end = 6; ! end of procedure
// 112 %const %integer dir sizes = 7; ! end of directives+sizes
// 113 %const %integer dir x end = 8; ! end of external entry
// 114 %const %integer dir header = 9; ! start of procedure
// 115 %const %integer dir entry = 10; ! define entry label
// 116 %const %integer last dir code = 10
// 117
// 118 !!%end %of %file
// 119
// 120 ! Size constants
// 121 %const %integer max tag = 4000; ! total tags in use
// 122 %const %integer max ref = 6000; ! references to tags
// 123 %const %integer max procs = 600; ! procedures in module
// 124 %const %integer max externals = 400; ! external defs/refs
// 125 %const %integer max rec = 512; ! object record size
// 126
// 127 %external %routine PASS3 (%string(63) module, %integer object, directives)
void PASS3(_imp_string63 MODULE, int OBJECT, int DIRECTIVES) {
// 128 %integer check ass = control&ass check; ! unassigned checking on
int CHECKASS;
CHECKASS = CONTROL & 1;
// 129 %integer diags = command&diag bit; ! dump diag psect
int DIAGS;
DIAGS = COMMAND & 4;
// 130 %integer ldump = command&line bit; ! dump lines (trace) psect
int LDUMP;
LDUMP = COMMAND & 8;
// 131 %integer pic = command&pic bit; ! PIC for gla
int PIC;
PIC = COMMAND & 4096;
// 132 %integer init = command&init bit; ! initialisation needed
int INIT;
INIT = COMMAND & 2048;
// 133 %integer timing = command&time bit; ! full timing report
int TIMING;
TIMING = COMMAND & 512;
// 134 %integer clog = command&log bit; ! summary to console
int CLOG;
CLOG = COMMAND & 16;
// 135
// 136 %const %integer proc enter prim = 13; ! = "$_M"
// 137
// 138 %const %integer non zero = 1; ! boolean
// 139
// 140 ! Op-codes
// 141 %const %integer brb = 16_11; ! +127/-128
// 142 %const %integer brw = 16_31; ! +32767/-32768
// 143 %const %integer jmp = 16_17; ! anywhere...
// 144 %const %integer bneq = 16_12, bnequ = 16_12
// 145 %const %integer beql = 16_13, beqlu = 16_13
// 146 %const %integer bgtr = 16_14
// 147 %const %integer bleq = 16_15
// 148 %const %integer bgeq = 16_18
// 149 %const %integer blss = 16_19
// 150 %const %integer bgtru = 16_1A
// 151 %const %integer blequ = 16_1B
// 152 %const %integer bgequ = 16_1E
// 153 %const %integer blssu = 16_1F
// 154 %const %integer jsb = 16_16
// 155 %const %integer calls = 16_FB
// 156 %const %integer movl = 16_D0
// 157 %const %integer moval = 16_DE
// 158 %const %integer movab = 16_9E
// 159 %const %integer subl2 = 16_C2
// 160 %const %integer movc5 = 16_2C
// 161
// 162 ! Branch table - invert (branch (b)) = branch(b!!7)
// 163 %const %byte %array branch (0 : 15) =
const unsigned char BRANCH[16] = {17, 19, 25, 21, 20, 24, 18, 0, 17, 19, 31, 27, 26, 30, 18, 0};
// 164+ brb, beql, blss, bleq, bgtr, bgeq, bneq, 0, {signed}
// 165+ { u/c = < <= > >= # never }
// 166+ brb, beqlu, blssu, blequ, bgtru, bgequ, bnequ, 0 {unsigned}
// 167
// 168
// 169 %const %integer margin = 800; ! stretch margin for jumps
// 170 %const %integer safe low = 16_ffff8001+margin
// 171 %const %integer safe high= 16_00008000-margin
// 172
// 173 %const %integer middling = 16_1000; ! word disp ref
// 174
// 175 ! Object record constants
// 176
// 177 %const %integer obj hdr = 0
// 178 %const %integer hdr mhd = 0; ! module header
// 179 %const %integer hdr lng = 1; ! language sub-header
// 180
// 181 %const %integer obj gsd = 1
// 182 %const %integer gsd psc = 0; ! P-sect def
// 183 %const %integer gsd sym = 1; ! Symbol (def/ref)
// 184 %const %integer gsd epm = 2; ! Ext def + mask
// 185
// 186 %const %integer obj tir = 2
// 187 %const %integer tir stag = 0; ! Stack global symbol
// 188 %const %integer tir stasb = 1; ! Stack signed byte
// 189 %const %integer tir stasw = 2
// 190 %const %integer tir stal = 3
// 191 %const %integer tir stpbb = 4
// 192 %const %integer tir stpbw = 5
// 193 %const %integer tir stpbl = 6
// 194 %const %integer tir staub = 7; ! Stack unsigned byte
// 195 %const %integer tir stob = 20; ! Store signed byte
// 196 %const %integer tir stow = 21; ! Store signed word
// 197 %const %integer tir stol = 22; ! Store longword
// 198 %const %integer tir stold = 25; ! Store longword
// 199 %const %integer tir stopidr = 27; ! Store PIC data reference
// 200 %const %integer tir stopicr = 28; ! Store PIC reference
// 201 %const %integer tir sto rl = 31; ! Store repeated long
// 202 %const %integer tir stoub = 33; ! Store unsigned byte
// 203 %const %integer tir stogb = 37; ! Store general byte
// 204 %const %integer tir sto rb = 39; ! Store repeated byte
// 205 %const %integer tir sto rw = 40; ! Store repeated word
// 206 %const %integer tir add = 51
// 207 %const %integer tir setrb = 80
// 208 %const %integer tir augrb = 81
// 209
// 210 %const %integer obj eom = 3
// 211 %const %integer obj dbg = 4
// 212
// 213 !P-sect info
// 214
// 215 %const %integer quad = 3; ! 8(=2**3)-byte alignment
// 216
// 217 %const %integer ps pic = 1<<0
// 218 %const %integer ps rel = 1<<3
// 219 %const %integer ps shr = 1<<5
// 220 %const %integer ps exe = 1<<6
// 221 %const %integer ps rd = 1<<7
// 222 %const %integer ps wrt = 1<<8
// 223
// 224 %own %integer %name ca
static int *CA;
// 225 %own %integer %name ga
static int *GA;
// 226 %own %integer base = 0
static int BASE = 0;
// 227 %own %short ref head = 0
static short int REFHEAD = 0;
// 228 %own %short %name ref chain; ref chain == ref head
static short int *REFCHAIN;
REFCHAIN = (short int *)/*?*/ &REFHEAD;
// 229 %own %short def list = 0; !ordered list of labels
static short int DEFLIST = 0;
// 230 %own %integer this line = 0
static int THISLINE = 0;
// 231 %own %integer entry tag = -1
static int ENTRYTAG = -1;
// 232
// 233 %const %integer code flags = ps pic ! ps rel ! ps rd ! ps exe ! ps shr
// 234 %own %integer glap flags = ps rd ! ps wrt ! ps rel ! ps pic
static int GLAPFLAGS = 393;
// 235 ! glap flags = glap flags ! ps pic %if pic # 0
// 236 %const %integer diag flags = ps pic ! ps rel ! ps rd ! ps shr
// 237 %const %integer line flags = ps pic ! ps rel ! ps rd ! ps shr
// 238
// 239 %const %string(10) code name = "$_CODEAREA"
const _imp_string10 CODENAME = _imp_str_init("$_CODEAREA");
// 240 %own %string(10) glap name = "$_GLAPAREA"
static _imp_string10 GLAPNAME = _imp_str_init("$_GLAPAREA");
// 241 ! glap name = "$_GLAPPIC"
// 242 %const %string(10) diag name = "$_DIAGAREA"
const _imp_string10 DIAGNAME = _imp_str_init("$_DIAGAREA");
// 243 %const %string(10) line name = "$_CODELINE"
const _imp_string10 LINENAME = _imp_str_init("$_CODELINE");
// 244 %const %string(10) init proc = "IMP$_INIT"
const _imp_string10 INITPROC = _imp_str_init("IMP$_INIT");
// 245
// 246 %integer refs, last tag
int REFS;
int LASTTAG;
// 247 %integer code size, glap size, diag size, line size
int CODESIZE;
int GLAPSIZE;
int DIAGSIZE;
int LINESIZE;
// 248 %integer procs, events, event base, evp, specs
int PROCS;
int EVENTS;
int EVENTBASE;
int EVP;
int SPECS;
// 249 %own %string(max ident) text
static _imp_string31 TEXT;
// 250
// 251 %record %format psect fm (%integer bp, pa, dump, bs, lr, lrp,
struct PSECTFM {
union {
struct {
int BP;
int PA;
int DUMP;
int BS;
int LR;
int LRP;
int INDEX;
int LBS;
int BB;
int BE;
int MAX;
union {
struct {
unsigned char TYPE;
};
struct {
unsigned char B[512];
};
};
};
};
};
// 252+ %integer index, lbs, bb, be, max,
// 253+ (%byte type %or
// 254+ %byte %array b (1 : maxrec)))
// 255 %own %record(psect fm) codep, glapp, workp, diagp, linep
static struct PSECTFM CODEP;
static struct PSECTFM GLAPP;
static struct PSECTFM WORKP;
static struct PSECTFM DIAGP;
static struct PSECTFM LINEP;
// 256 %own %record(psect fm) %name buff; ! Points at one of above
static struct PSECTFM *BUFF;
// 257
// 258 %record %format ref fm (%integer ca, tag, %short flag, link)
struct REFFM {
union {
struct {
int CA;
int TAG;
short int FLAG;
short int LINK;
};
};
};
// 259 %record %format def fm (%integer ca, %short uses, link)
struct DEFFM {
union {
struct {
int CA;
short int USES;
short int LINK;
};
};
};
// 260 %record(def fm) %array def (0 : max tag)
struct DEFFM DEF[4001];
// 261 %record(ref fm) %array ref (1 : max ref)
struct REFFM REF[6000];
// 262
// 263 %record %format proc fm (%integer frame,
struct PROCFM {
union {
struct {
int FRAME;
short int TYPE;
short int MASK;
short int DIAG;
short int DIAGEP;
short int LINEEP;
};
};
};
// 264+ %short type, mask, diag, diag ep, line ep)
// 265 %record(proc fm) %array proc tab (1 : max procs)
struct PROCFM PROCTAB[600];
// 266
// 267 %byte %array ext used (1 : max externals)
unsigned char EXTUSED[400];
// 268 %string(max ident) %array ext text (1 : max externals)
_imp_string31 EXTTEXT[400];
// 269
// 270
// 271 %routine ERROR (%string(31) text, %integer extra)
void ERROR(_imp_string31 TEXT, int EXTRA) {
// 272 select output (report)
_imp_SELECTOUTPUT(0);
// 273 newline
_imp_NEWLINE();
// 274 print string ("***Pass3 fails """); print string (text)
_imp_PRINTSTRING(_imp_str_literal("***Pass3 fails \""));
_imp_PRINTSTRING(
*({
__typeof__(_imp_string31) tmp = TEXT /*q*/;
(_imp_string255 *)&tmp;
})
);
// 275 print string (""" ("); write (extra, 0); print symbol (')')
_imp_PRINTSTRING(_imp_str_literal("\" ("));
_imp_WRITE(EXTRA, 0);
_imp_PRINTSYMBOL(41);
// 276 newline
_imp_NEWLINE();
// 277 %monitor
/*_imp_monitor(__LINE__, __FILE__, PRETTY_FUNCTION);*/
// 278 exit (16_1000002c) {1000002c is SS$_ABORT with the inhibit message bit set - could just use EXIT_FAILURE}
EXIT(268435500);
// 279 %end
return;
} /* end of ERROR */
// 280
// 281 %routine GET STRING (%string(*) %name t)
void GETSTRING(_imp_string * T) {
// 282 %integer len, file len
int LEN;
int FILELEN;
// 283 get (len)
GET(/*?*/ &LEN);
// 284 file len = len
FILELEN = LEN;
// 285 error ("external size?", len) %unless 0 < len <= max ident
{
// Double-sided test on LEN (Part I)
int tmp;
if (0 >= (tmp = LEN)) goto L_0001;
// Double-sided test on LEN (Part II)
if (tmp <= 31) goto L_0002;
}
L_0001:;
ERROR(_imp_str_literal_size(31, "external size?"), LEN);
L_0002:;
// 286 len = len - 1 %if len = max ident {make room for '_' in Gla name}
if (LEN != 31) goto L_0003;
LEN = LEN - 1;
L_0003:;
// 287 length(t) = len
*_imp_LENGTH((_imp_string255 *)/*p*/ T) = LEN;
// 288 getblock (file len, charno(t,1))
GETBLOCK(FILELEN, _imp_CHARNO((_imp_string255 *)/*p*/ T, 1));
// 289 %end
return;
} /* end of GETSTRING */
auto void STPB(struct PSECTFM * P, int OFFSET);
auto void ADD(int B);
// 290
// 291 %routine %spec STPB (%record(psect fm) %name p, %integer d)
// 292 %routine %spec ADD (%integer b)
// 293 %routine FLUSH BUFF
void FLUSHBUFF(void) {
// 294 %integer %name bp
int *BP;
// 295 bp == buff_bp
BP = (int *)/*?*/ &BUFF->BP;
// 296 %if bp > max rec %start
if (*BP <= 512) goto L_0004;
// 297 ! over the limits!
// 298 error ("buffer error - seek help!!", bp-maxrec)
ERROR(_imp_str_literal_size(31, "buffer error - seek help!!"), *BP - 512);
// 299 %finish
L_0004:;
// 300 %if buff_dump # 0 %start
if (BUFF->DUMP == 0) goto L_0005;
// 301 error ("buffer error", 1) %if buff_bs > 0; ! Still in IMMED mode
if (BUFF->BS <= 0) goto L_0006;
ERROR(_imp_str_literal_size(31, "buffer error"), 1);
L_0006:;
// 302 %if bp > 1 %start
if (*BP <= 1) goto L_0007;
// 303 print record (bp, buff_b(1))
PRINTRECORD(*BP, /*?*/ &BUFF->B[0]);
// 304 %finish
L_0007:;
// 305 %finish
L_0005:;
// 306 buff_bs = 0; buff_be = 0; buff_lbs = 0; buff_lr = 0
BUFF->BS = 0;
BUFF->BE = 0;
BUFF->LBS = 0;
BUFF->LR = 0;
// 307 bp = 1; ! leave type field
*BP = 1;
// 308 %if buff_type = obj tir %and buff_dump # 0 %start
if (BUFF->TYPE != 2) goto L_0008;
if (BUFF->DUMP == 0) goto L_0008;
// 309 ! fill in reloc command
// 310 stpb (buff, buff_pa); add (tir setrb)
STPB(BUFF, BUFF->PA);
ADD(80);
// 311 buff_lr = buff_bp; buff_lrp = 1
BUFF->LR = BUFF->BP;
BUFF->LRP = 1;
// 312 %finish
L_0008:;
// 313 %end
return;
} /* end of FLUSHBUFF */
// 314
// 315 %routine NEED (%integer b)
void NEED(int B) {
// 316 ! ensure there are at least b bytes free in current buffer
// 317 flush buff %if buff_bp + b > max rec
if (BUFF->BP + B <= 512) goto L_0009;
FLUSHBUFF();
L_0009:;
// 318 %end
return;
} /* end of NEED */
// 319
// 320 %routine SET WORK (%integer type)
void SETWORK(int TYPE) {
// 321 buff == workp; flush buff
BUFF = (struct PSECTFM *)/*?*/ &WORKP;
FLUSHBUFF();
// 322 workp = 0; workp_dump = 1
WORKP = (struct PSECTFM){0};
WORKP.DUMP = 1;
// 323 workp_type = type; workp_bp = 1
WORKP.TYPE = TYPE;
WORKP.BP = 1;
// 324 %end
return;
} /* end of SETWORK */
// 325
// 326 %routine ADD (%integer b)
void ADD(int B) {
// 327 %return %if buff_dump = 0
if (BUFF->DUMP != 0) goto L_000A;
return;
L_000A:;
// 328 buff_bp = buff_bp + 1; buff_b(buff_bp) = b&255
BUFF->BP = BUFF->BP + 1;
BUFF->B[BUFF->BP - 1] = B & 255;
// 329 %end
return;
} /* end of ADD */
// 330
// 331 %routine ADDW (%integer n)
void ADDW(int N) {
// 332 %return %if buff_dump = 0
if (BUFF->DUMP != 0) goto L_000B;
return;
L_000B:;
// 333 shortinteger(addr(buff_b(buff_bp+1))) = n
*_imp_SHORTINTEGER(_imp_ADDR(/*?*/ &BUFF->B[BUFF->BP + 1 - 1])) = N;
// 334 buff_bp = buff_bp + 2
BUFF->BP = BUFF->BP + 2;
// 335 %end
return;
} /* end of ADDW */
// 336
// 337 %routine ADDL (%integer n)
void ADDL(int N) {
// 338 %return %if buff_dump = 0
if (BUFF->DUMP != 0) goto L_000C;
return;
L_000C:;
// 339 integer(addr(buff_b(buff_bp+1))) = n
*_imp_INTEGER(_imp_ADDR(/*?*/ &BUFF->B[BUFF->BP + 1 - 1])) = N;
// 340 buff_bp = buff_bp + 4
BUFF->BP = BUFF->BP + 4;
// 341 %end
return;
} /* end of ADDL */
// 342
// 343 %routine ADD STRING (%integer from, %string(63) s)
void ADDSTRING(int FROM, _imp_string63 S) {
// 344 %integer b, l
int B;
int L;
// 345 %return %if buff_dump = 0
if (BUFF->DUMP != 0) goto L_000D;
return;
L_000D:;
// 346 l = length(s)
L = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S);
// 347 %if from = 0 %start
if (FROM != 0) goto L_000E;
// 348 string(addr(buff_b(buff_bp+1))) = s
*_imp_STRING(_imp_ADDR(/*?*/ &BUFF->B[BUFF->BP + 1 - 1])) = S;
// 349 buff_bp = buff_bp + 1
BUFF->BP = BUFF->BP + 1;
// 350 %else
goto L_000F;
L_000E:;
// 351 b = buff_b(buff_bp)
B = BUFF->B[BUFF->BP - 1];
// 352 string(addr(buff_b(buff_bp))) = s
*_imp_STRING(_imp_ADDR(/*?*/ &BUFF->B[BUFF->BP - 1])) = S;
// 353 buff_b(buff_bp) = b
BUFF->B[BUFF->BP - 1] = B;
// 354 %finish
L_000F:;
// 355 buff_bp = buff_bp + l
BUFF->BP = BUFF->BP + L;
// 356 %end
return;
} /* end of ADDSTRING */
// 357
// 358 %routine ADD TEXT (%integer data)
void ADDTEXT(int DATA) {
// 359 %string(max ident) t = text
_imp_string31 T;
_imp_strncpy(/*?*/ &T, ({
__typeof__(_imp_string31) tmp; /*B*/
tmp = TEXT;
(void *)&tmp;
}),
/*max:*/ 31);
// 360 %return %if buff_dump = 0
if (BUFF->DUMP != 0) goto L_0010;
return;
L_0010:;
// 361 t = t . "_" %if data # 0
if (DATA == 0) goto L_0011;
_imp_strncpy(/*?*/ &T, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp =
_imp_join((_imp_string *)/*?*/ &T, (_imp_string *)/*?*/ _imp_str_literal_ptr("_"));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 31);
L_0011:;
// 362 add string (0, t)
ADDSTRING(0,
*({
__typeof__(_imp_string31) tmp = T /*q*/;
(_imp_string63 *)&tmp;
})
);
// 363 %end
return;
} /* end of ADDTEXT */
// 364
// 365 %integer %function RANGE (%integer disp, extra)
int RANGE(int DISP, int EXTRA) {
// 366 %result = 1 %if -128 <= disp <= 127
{
// Double-sided test on DISP (Part I)
int tmp;
if (-128 > (tmp = DISP)) goto L_0012;
// Double-sided test on DISP (Part II)
if (tmp > 127) goto L_0012;
}
return 1;
L_0012:;
// 367 %result = 2 %if 16_FFFF8000 <= disp-extra <= 16_7FFF
{
// Double-sided test on DISP - EXTRA (Part I)
int tmp;
if (-32768 > (tmp = DISP - EXTRA)) goto L_0013;
// Double-sided test on DISP - EXTRA (Part II)
if (tmp > 32767) goto L_0013;
}
return 2;
L_0013:;
// 368 %result = 4
return 4;
// 369 %end
} /* end of RANGE */
// 370
// 371 %routine STAG (%string(max ident+3) S)
void STAG(_imp_string34 S) {
// 372 need (1+1+length(S))
NEED(1 + 1 + *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &S));
// 373 add (tir stag); add string (0, S)
ADD(0);
ADDSTRING(0,
*({
__typeof__(_imp_string34) tmp = S /*q*/;
(_imp_string63 *)&tmp;
})
);
// 374 %end
return;
} /* end of STAG */
// 375
// 376 %routine TIR COMMAND (%integername value, %integer param,
void TIRCOMMAND(int *VALUE, int PARAM, unsigned char *CLIST) {
// 377+ %byte %array %name clist)
// 378 %integer size
int SIZE;
// 379 size = range (value, 0)
SIZE = RANGE(*VALUE, 0);
// 380 need (2+size)
NEED(2 + SIZE);
// 381 add (clist(size))
ADD([/*BUG*/ 0]);
// 382 add (param) %if param >= 0
if (PARAM < 0) goto L_0014;
ADD(PARAM);
L_0014:;
// 383 %if size = 1 %start
if (SIZE != 1) goto L_0015;
// 384 add (value)
ADD(*VALUE);
// 385 %else %if size = 2
goto L_0016;
L_0015:;
if (SIZE != 2) goto L_0017;
// 386 addw (value)
ADDW(*VALUE);
// 387 %else
goto L_0016;
L_0017:;
// 388 addl (value)
ADDL(*VALUE);
// 389 %finish
L_0016:;
// 390 value = size
*VALUE = SIZE;
// 391 %end
return;
} /* end of TIRCOMMAND */
// 392
// 393 %routine STPB (%record(psect fm) %name p, %integer offset)
void STPB(struct PSECTFM * P, int OFFSET) {
// 394 %own %byte %array stpbc (1 : 4) =
static unsigned char STPBC[4] = {4, 5, 0, 6};
// 395+ tir stpbb, tir stpbw, 0, tir stpbl
// 396 tir command (offset, p_index, stpbc)
TIRCOMMAND(/*?*/ &OFFSET, P->INDEX, STPBC);
// 397 %end
return;
} /* end of STPB */
// 398
// 399 %routine STAK (%integer value)
void STAK(int VALUE) {
// 400 %own %byte %array stac (1 : 4) =
static unsigned char STAC[4] = {1, 2, 0, 3};
// 401+ tir stasb, tir stasw, 0, tir stal
// 402 tir command (value, -1, stac)
TIRCOMMAND(/*?*/ &VALUE, -1, STAC);
// 403 %end
return;
} /* end of STAK */
// 404
// 405 %routine SELECT (%integer disp)
void SELECT(int DISP) {
// 406 %return %if buff_dump = 0
if (BUFF->DUMP != 0) goto L_0018;
return;
L_0018:;
// 407 need (7); ! Sequence must be in one record!
NEED(7);
// 408 error ("psect overflow", disp) %if disp > buff_max
if (DISP <= BUFF->MAX) goto L_0019;
ERROR(_imp_str_literal_size(31, "psect overflow"), DISP);
L_0019:;
// 409 %if buff_lr = buff_bp %start
if (BUFF->LR != BUFF->BP) goto L_001A;
// 410 ! Have not planted anything since last 'select'
// 411 buff_bp = buff_lrp; ! Forget last select
BUFF->BP = BUFF->LRP;
// 412 buff_pa = -20; ! Ensure this one planted!
BUFF->PA = -20;
// 413 %finish
L_001A:;
// 414 %if buff_pa # disp %start
if (BUFF->PA == DISP) goto L_001B;
// 415 buff_lrp = buff_bp
BUFF->LRP = BUFF->BP;
// 416 stpb (buff, disp)
STPB(BUFF, DISP);
// 417 add (tir setrb)
ADD(80);
// 418 buff_lr = buff_bp
BUFF->LR = BUFF->BP;
// 419 buff_pa = disp
BUFF->PA = DISP;
// 420 %finish
L_001B:;
// 421 %end
return;
} /* end of SELECT */
// 422
// 423 %routine START IMMED (%integer max)
void STARTIMMED(int MAX) {
// 424 %return %if buff_dump = 0
if (BUFF->DUMP != 0) goto L_001C;
return;
L_001C:;
// 425 error ("buffer in use", 0) %if buff_bs # 0
if (BUFF->BS == 0) goto L_001D;
ERROR(_imp_str_literal_size(31, "buffer in use"), 0);
L_001D:;
// 426 error ("immediate size error", max) %if max > 128
if (MAX <= 128) goto L_001E;
ERROR(_imp_str_literal_size(31, "immediate size error"), MAX);
L_001E:;
// 427 need (max+1)
NEED(MAX + 1);
// 428 %if buff_be = buff_bp %and
if (BUFF->BE != BUFF->BP) goto L_001F;
if (MAX + (BUFF->BP - BUFF->LBS) > 128) goto L_001F;
// 429+ max + (buff_bp - buff_lbs) <= 128 %start
// 430 ! Can concatenate buffers
// 431 buff_bs = buff_lbs
BUFF->BS = BUFF->LBS;
// 432 %else
goto L_0020;
L_001F:;
// 433 add (0); ! Length byte
ADD(0);
// 434 buff_bs = buff_bp
BUFF->BS = BUFF->BP;
// 435 %finish
L_0020:;
// 436 buff_bb = buff_bp; ! Where this block started
BUFF->BB = BUFF->BP;
// 437 %end
return;
} /* end of STARTIMMED */
// 438
// 439 %routine END IMMED
void ENDIMMED(void) {
// 440 %integer size
int SIZE;
// 441 %return %if buff_dump = 0
if (BUFF->DUMP != 0) goto L_0021;
return;
L_0021:;
// 442 error ("buffer not in use", 0) %if buff_bs = 0
if (BUFF->BS != 0) goto L_0022;
ERROR(_imp_str_literal_size(31, "buffer not in use"), 0);
L_0022:;
// 443 size = buff_bp - buff_bs
SIZE = BUFF->BP - BUFF->BS;
// 444 %if size # 0 %start
if (SIZE == 0) goto L_0023;
// 445 error ("buffer overflow", size) %if size > 128
if (SIZE <= 128) goto L_0024;
ERROR(_imp_str_literal_size(31, "buffer overflow"), SIZE);
L_0024:;
// 446 buff_b(buff_bs) = -size
BUFF->B[BUFF->BS - 1] = -SIZE;
// 447 buff_lbs = buff_bs
BUFF->LBS = BUFF->BS;
// 448 buff_be = buff_bp
BUFF->BE = BUFF->BP;
// 449 %else
goto L_0025;
L_0023:;
// 450 buff_bp = buff_bp - 1
BUFF->BP = BUFF->BP - 1;
// 451 %finish
L_0025:;
// 452 buff_pa = buff_pa + buff_bp - buff_bb; ! Update psect disp.
BUFF->PA = BUFF->PA + BUFF->BP - BUFF->BB;
// 453 error ("Psect immediate overflow", 0) %if buff_pa > buff_max
if (BUFF->PA <= BUFF->MAX) goto L_0026;
ERROR(_imp_str_literal_size(31, "Psect immediate overflow"), 0);
L_0026:;
// 454 buff_bs = 0; ! Not buffering now
BUFF->BS = 0;
// 455 %end
return;
} /* end of ENDIMMED */
// 456
// 457 %routine SPEC (%integer flags, data, value, mask)
void SPEC(int FLAGS, int DATA, int VALUE, int MASK) {
// 458 %integer def, len, psect
int DEF;
int LEN;
int PSECT;
// 459 psect = |data|
PSECT = _imp_IMOD(DATA);
// 460 data = 0 %if data < 0; ! no '_' for ext data def
if (DATA >= 0) goto L_0027;
DATA = 0;
L_0027:;
// 461 def = flags&2
DEF = FLAGS & 2;
// 462 len = (1+1)+(data+length(text))
LEN = 1 + 1 + (DATA + *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &TEXT));
// 463 len = len + 7 %if def # 0
if (DEF == 0) goto L_0028;
LEN = LEN + 7;
L_0028:;
// 464 set work (obj gsd)
SETWORK(1);
// 465 %if def = 0 %start
if (DEF != 0) goto L_0029;
// 466 add (gsd sym)
ADD(1);
// 467 %else
goto L_002A;
L_0029:;
// 468 add (gsd epm)
ADD(2);
// 469 %finish
L_002A:;
// 470 add (0); ! data type - unknown
ADD(0);
// 471 addw (flags); ! symbol flags
ADDW(FLAGS);
// 472 %if def # 0 %start; ! definition
if (DEF == 0) goto L_002B;
// 473 add (psect)
ADD(PSECT);
// 474 addl (value)
ADDL(VALUE);
// 475 addw (mask)
ADDW(MASK);
// 476 %finish
L_002B:;
// 477 add text (data)
ADDTEXT(DATA);
// 478 %end
return;
} /* end of SPEC */
// 479
// 480 %routine INPUT DIRECTIVES
void INPUTDIRECTIVES(void) {
// 481 %switch d (1 : last dir code)
int D_index;
int D_line;
char *D_file;
static const void *D[10] = {&&case_D_missing, &&case_D_missing, &&case_D_missing, &&case_D_missing,
&&case_D_missing, &&case_D_missing, &&case_D_missing, &&case_D_missing,
&&case_D_missing, &&case_D_missing};
// 482 %short first = 0, list = 0
short int FIRST;
FIRST = 0;
short int LIST;
LIST = 0;
// 483 %short %name ref list == first, end
short int *REFLIST;
REFLIST = (short int *)/*?*/ &FIRST;
short int *END;
// 484 %record(proc fm) %name proc
struct PROCFM *PROC;
// 485 %record(ref fm) %name r
struct REFFM *R;
// 486 %record(def fm) %name t
struct DEFFM *T;
// 487 %integer %name q
int *Q;
// 488 %integer proc head, n, frame, ldiag
int PROCHEAD;
int N;
int FRAME;
int LDIAG;
// 489 %integer ecode, unass code, size
int ECODE;
int UNASSCODE;
int SIZE;
// 490 %integer rp, tag, block tag, dcode
int RP;
int TAG;
int BLOCKTAG;
int DCODE;
// 491 %own %integer dap = 0, lap = 2
static int DAP = 0;
static int LAP = 2;
// 492
// 493 procs = procs + 1
PROCS = PROCS + 1;
// 494 proc == proc tab(procs)
PROC = (struct PROCFM *)/*?*/ &PROCTAB[PROCS - 1];
// 495 proc_diag ep = 0
PROC->DIAGEP = 0;
// 496 proc_line ep = 0
PROC->LINEEP = 0;
// 497
// 498 %cycle
L_002C:;
// 499 get (dcode)
GET(/*?*/ &DCODE);
// 500 -> d(dcode) %if 1 <= dcode <= last dir code
{
// Double-sided test on DCODE (Part I)
int tmp;
if (1 > (tmp = DCODE)) goto L_002D;
// Double-sided test on DCODE (Part II)
if (tmp > 10) goto L_002D;
}
D_line = __LINE__;
D_file = __FILE__;
D_index = DCODE;
goto case_D_dispatch;
L_002D:;
// 501 error ("spurious directive", dcode)
ERROR(_imp_str_literal_size(31, "spurious directive"), DCODE);
// 502
// 503 d(dir used):
case_D_1:;
// 504 ext used(getword) = non zero
EXTUSED[GETWORD() - 1] = 1;
// 505 %continue
goto L_002F;
// 506
// 507 d(dir ldef):
case_D_2:;
// 508 tag = getword
TAG = GETWORD();
// 509 error ("too many labels", tag) %unless 0 < tag <= max tag
{
// Double-sided test on TAG (Part I)
int tmp;
if (0 >= (tmp = TAG)) goto L_0030;
// Double-sided test on TAG (Part II)
if (tmp <= 4000) goto L_0031;
}
L_0030:;
ERROR(_imp_str_literal_size(31, "too many labels"), TAG);
L_0031:;
// 510 t == def(tag)
T = (struct DEFFM *)/*?*/ &DEF[TAG];
// 511 t_ca = getlong; ! ca
T->CA = GETLONG();
// 512 end == t_link %if list = 0
if (LIST != 0) goto L_0032;
END = (short int *)/*?*/ &T->LINK;
L_0032:;
// 513 t_link = list; list = tag
T->LINK = LIST;
LIST = TAG;
// 514 %continue
goto L_002F;
// 515
// 516 d(dir pref):
case_D_3:;
// 517 d(dir cref):
case_D_4:;
// 518 d(dir uref):
case_D_5:;
// 519 tag = getword
TAG = GETWORD();
// 520 error ("too many labels", n) %unless 0 < tag <= max tag
{
// Double-sided test on TAG (Part I)
int tmp;
if (0 >= (tmp = TAG)) goto L_0033;
// Double-sided test on TAG (Part II)
if (tmp <= 4000) goto L_0034;
}
L_0033:;
ERROR(_imp_str_literal_size(31, "too many labels"), N);
L_0034:;
// 521 error ("too many references", refs) %if refs = max ref
if (REFS != 6000) goto L_0035;
ERROR(_imp_str_literal_size(31, "too many references"), REFS);
L_0035:;
// 522 refs = refs + 1; r == ref(refs)
REFS = REFS + 1;
R = (struct REFFM *)/*?*/ &REF[REFS - 1];
// 523 r_tag = tag
R->TAG = TAG;
// 524 r_ca = getlong; ! ca
R->CA = GETLONG();
// 525 r_flag = dcode - 3
R->FLAG = DCODE - 3;
// 526 ref list = refs
*REFLIST = REFS;
// 527 ref list == r_link
REFLIST = (short int *)/*?*/ &R->LINK;
// 528 %continue
goto L_002F;
// 529
// 530 d(dir entry): ! define ep
case_D_10:;
// 531 entry tag = getword
ENTRYTAG = GETWORD();
// 532 %continue
goto L_002F;
// 533
// 534 d(dir header):
case_D_9:;
// 535 input directives
INPUTDIRECTIVES();
// 536 %repeat
L_002F:;
goto L_002C;
// 537
// 538 d(dir end):
case_D_6:;
// 539 proc_type = getlong
PROC->TYPE = GETLONG();
// 540 proc_mask = getword&16_CFFC
PROC->MASK = GETWORD() & 53244;
// 541 frame = -getlong
FRAME = -GETLONG();
// 542 proc_frame = frame; ! frame size
PROC->FRAME = FRAME;
// 543 ldiag = getword
LDIAG = GETWORD();
// 544 proc_diag = ldiag
PROC->DIAG = LDIAG;
// 545 error ("corrupt diags", diags) %if ldiag = 0 %and diags # 0
if (LDIAG != 0) goto L_0036;
if (DIAGS == 0) goto L_0036;
ERROR(_imp_str_literal_size(31, "corrupt diags"), DIAGS);
L_0036:;
// 546 proc_diag ep = dap; dap = dap + ldiag
PROC->DIAGEP = DAP;
DAP = DAP + LDIAG;
// 547 proc_line ep = lap; lap = lap + getword
PROC->LINEEP = LAP;
LAP = LAP + GETWORD();
// 548 block tag = getword
BLOCKTAG = GETWORD();
// 549 ! compute length of entry code sequence
// 550 ecode = 2; ! for entry mask
ECODE = 2;
// 551 %if block tag = entry tag %and init # 0 %start
if (BLOCKTAG != ENTRYTAG) goto L_0037;
if (INIT == 0) goto L_0037;
// 552 ecode = ecode + 7; ! calls #0,l^init proc
ECODE = ECODE + 7;
// 553 %finish
L_0037:;
// 554 %if proc_type # 0 %start
if (PROC->TYPE == 0) goto L_0038;
// 555 ecode = ecode + 7; ! moval l^ep_,gla
ECODE = ECODE + 7;
// 556 %finish
L_0038:;
// 557 ecode = ecode + 3; ! movl fp, base
ECODE = ECODE + 3;
// 558 %if frame # 0 %start
if (FRAME == 0) goto L_0039;
// 559 ! locals - needs frame + unass code
// 560 unass code = 8; ! movc5 #0,(fp),(gla),s^#f,(sp)
UNASSCODE = 8;
// 561 %if frame <= 63 %start
if (FRAME > 63) goto L_003A;
// 562 !short lit - byte's worth
// 563 ecode = ecode + 3; ! subl2 i^#f, sp
ECODE = ECODE + 3;
// 564 unass code = 6; ! movc5 #0,(fp),(gla),i^#f,(sp)
UNASSCODE = 6;
// 565 %else %if frame <= 16_7fff
goto L_003B;
L_003A:;
if (FRAME > 32767) goto L_003C;
// 566 !word's worth (sheer poetry)
// 567 ecode = ecode + 5; ! moval w^-f(sp), sp
ECODE = ECODE + 5;
// 568 %else
goto L_003B;
L_003C:;
// 569 ecode = ecode + 7; ! subl2 s^#f, sp
ECODE = ECODE + 7;
// 570 %finish
L_003B:;
// 571 %if check ass # 0 %start
if (CHECKASS == 0) goto L_003D;
// 572 ecode = ecode + unass code
ECODE = ECODE + UNASSCODE;
// 573 proc_mask = proc_mask ! 16_003C; ! r0-r5 corrupted by MOVC5!!!
PROC->MASK = PROC->MASK | 60;
// 574 %finish
L_003D:;
// 575 %finish
L_0039:;
// 576 t == def(block tag)
T = (struct DEFFM *)/*?*/ &DEF[BLOCKTAG];
// 577 t_ca = t_ca - ecode
T->CA = T->CA - ECODE;
// 578 base = base + ecode
BASE = BASE + ECODE;
// 579
// 580 d(dir xend): ! end of external proc
case_D_8:;
// 581
// 582 tag = list
TAG = LIST;
// 583 %while tag # 0 %cycle
L_003E:;
if (TAG == 0) goto L_003F;
// 584 t == def(tag)
T = (struct DEFFM *)/*?*/ &DEF[TAG];
// 585 t_ca = t_ca + base
T->CA = T->CA + BASE;
// 586 tag = t_link
TAG = T->LINK;
// 587 %repeat
goto L_003E;
L_003F:;
// 588 %if list # 0 %start; ! add labels to def list
if (LIST == 0) goto L_0040;
// 589 end = def list
*END = DEFLIST;
// 590 def list = list
DEFLIST = LIST;
// 591 %finish
L_0040:;
// 592 ref list = 0; ! mark the end
*REFLIST = 0;
// 593 rp = first
RP = FIRST;
// 594 %while rp # 0 %cycle
L_0041:;
if (RP == 0) goto L_0042;
// 595 r == ref(rp)
R = (struct REFFM *)/*?*/ &REF[RP - 1];
// 596 r_ca = r_ca + base
R->CA = R->CA + BASE;
// 597 rp = r_link
RP = R->LINK;
// 598 %repeat
goto L_0041;
L_0042:;
// 599 size = getlong; ! total size
SIZE = GETLONG();
// 600 base = base + size
BASE = BASE + SIZE;
// 601 %if first # 0 %start
if (FIRST == 0) goto L_0043;
// 602 ref chain = first
*REFCHAIN = FIRST;
// 603 ref chain == ref list
REFCHAIN = (short int *)REFLIST;
// 604 ref chain = 0
*REFCHAIN = 0;
// 605 %finish
L_0043:;
// 606 %return
return;
// 607
// 608 d(dir sizes): ! end of directives, totals follow
case_D_7:;
// 609 glap size = getlong
GLAPSIZE = GETLONG();
// 610 last tag = getword
LASTTAG = GETWORD();
// 611 specs = getword
SPECS = GETWORD();
// 612 diag size = getword
DIAGSIZE = GETWORD();
// 613 events = getword
EVENTS = GETWORD();
// 614 proc tab(1)_diag ep = dap
PROCTAB[0].DIAGEP = DAP;
// 615 line size = lap
LINESIZE = LAP;
// 616 %end
return;
case_D_dispatch:
if (D_index < 1 || D_index > 10)
_imp_signalf(6, 3, D_index, "->D(%d) out of bounds at %s line %d", D_index, D_file, D_line);
goto *D[D_index - 1];
case_D_missing:
_imp_signalf(8, 2, D_index, "switch jump to undefined label D(%d): at %s line %d", D_index, D_file, D_line);
} /* end of INPUTDIRECTIVES */
// ?PROCHEAD unused
// ?Q unused
// 617
// 618 %routine STRETCH JUMPS
void STRETCHJUMPS(void) {
// 619 %integer extra, here, there, disp, mod, tag
int EXTRA;
int HERE;
int THERE;
int DISP;
int MOD;
int TAG;
// 620 %integer %name pt
int *PT;
// 621 %short %name last, next
short int *LAST;
short int *NEXT;
// 622 %record(ref fm) %name r
struct REFFM *R;
// 623 %record(def fm) %name t
struct DEFFM *T;
// 624 %cycle
L_0044:;
// 625 extra = 0
EXTRA = 0;
// 626 last == ref head
LAST = (short int *)/*?*/ &REFHEAD;
// 627 %while last # 0 %cycle
L_0045:;
if (*LAST == 0) goto L_0046;
// 628 r == ref(last)
R = (struct REFFM *)/*?*/ &REF[*LAST - 1];
// 629 next == r_link
NEXT = (short int *)/*?*/ &R->LINK;
// 630 r_ca = r_ca + extra
R->CA = R->CA + EXTRA;
// 631 here = r_ca + 2
HERE = R->CA + 2;
// 632 there = def(r_tag)_ca
THERE = DEF[R->TAG].CA;
// 633 disp = there - here
DISP = THERE - HERE;
// 634 mod = 0
MOD = 0;
// 635 %if r_flag&middling = 0 %and
if (R->FLAG & 4096 != 0) goto L_0047;
{
// Double-sided test on DISP (Part I)
int tmp;
if (-128 > (tmp = DISP)) goto L_0048;
// Double-sided test on DISP (Part II)
if (tmp <= 127) goto L_0047;
}
L_0048:;
// 636+ %not -128 <= disp <= 127 %start
// 637 r_flag = r_flag!middling
R->FLAG = R->FLAG | 4096;
// 638 !******** %if safelow <= disp <= safe high %start
// 639 !******** ! will not stretch again
// 640 !******** last = next
// 641 !******** next == last
// 642 !******** %finish
// 643 mod = 1; ! 1-byte -> 2-byte disp
MOD = 1;
// 644 mod = 3 %if r_flag&1 # 0; ! conditional -> skip+brw
if (R->FLAG & 1 == 0) goto L_0049;
MOD = 3;
L_0049:;
// 645 %else %unless 16_FFFF8001 <= disp <= 16_8000
goto L_004A;
L_0047:;
{
// Double-sided test on DISP (Part I)
int tmp;
if (-32767 > (tmp = DISP)) goto L_004B;
// Double-sided test on DISP (Part II)
if (tmp <= 32768) goto L_004C;
}
L_004B:;
// 646 ! cannot get bigger
// 647 last = next
*LAST = *NEXT;
// 648 next == last
NEXT = (short int *)LAST;
// 649 mod = 2; ! word disp -> longword disp
MOD = 2;
// 650 mod = 3 %if r_flag&3 # 0; ! brw -> jmp
if (R->FLAG & 3 == 0) goto L_004D;
MOD = 3;
L_004D:;
// 651 %finish
L_004C:;
L_004A:;
// 652 %if mod # 0 %start
if (MOD == 0) goto L_004E;
// 653 tag = def list
TAG = DEFLIST;
// 654 %while tag # 0 %cycle
L_004F:;
if (TAG == 0) goto L_0050;
// 655 t == def(tag)
T = (struct DEFFM *)/*?*/ &DEF[TAG];
// 656 pt == t_ca
PT = (int *)/*?*/ &T->CA;
// 657 %exit %if pt < here
if (*PT >= HERE) goto L_0051;
goto L_0050;
L_0051:;
// 658 pt = pt + mod
*PT = *PT + MOD;
// 659 tag = t_link
TAG = T->LINK;
// 660 %repeat
goto L_004F;
L_0050:;
// 661 extra = extra + mod
EXTRA = EXTRA + MOD;
// 662 %finish
L_004E:;
// 663 last == next
LAST = (short int *)NEXT;
// 664 %repeat
goto L_0045;
L_0046:;
// 665 base = base + extra
BASE = BASE + EXTRA;
// 666 %repeat %until extra = 0
if (EXTRA == 0) goto L_0052;
goto L_0044;
L_0052:;
// 667 event base = (base+7)&(\7)
EVENTBASE = BASE + 7 & (~7);
// 668 evp = event base
EVP = EVENTBASE;
// 669 code size = event base + events*16 + 4
CODESIZE = EVENTBASE + EVENTS * 16 + 4;
// 670 %end
return;
} /* end of STRETCHJUMPS */
// 671
// 672 %routine DUMP CODE (%integer base, btag, limit)
void DUMPCODE(int BASE, int BTAG, int LIMIT) {
// 673 %switch c (1 : last obj code)
int C_index;
int C_line;
char *C_file;
static const void *C[25] = {
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing,
&&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing, &&case_C_missing};
// 674 %own %byte %array base mod (5 : 15)
static unsigned char BASEMOD[11];
// 675 ! Code type enables pre-selection of the appropriate
// 676 ! output buffer for each command code byte from Pass 2.
// 677 %const %byte %array code type (1 : last obj code) =
const unsigned char CODETYPE[25] = {0, 0, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 3, 0, 2, 2, 0, 0, 0, 1, 0, 0, 0};
// 678+ 0, 0, 1, 0, 0,
// 679+ 1, 1, 1, 1, 0,
// 680+ 0, 0, 0, 0, 3,
// 681+ 0, 2, 2, 0, 0,
// 682+ 0, 1, 0, 0, 0
// 683 %own %record(psect fm) %name %array buff for (0 : 3)
static struct PSECTFM *BUFFFOR[4];
// 684 %own %integer called = 0
static int CALLED = 0;
// 685
// 686 %integer disp, cond
int DISP;
int COND;
// 687 %integer ldiag, value
int LDIAG;
int VALUE;
// 688 %integer ocode, type
int OCODE;
int TYPE;
// 689 %integer gb, gx, cx, xno, pno
int GB;
int GX;
int CX;
int XNO;
int PNO;
// 690 %integer old ca, old la, old da
int OLDCA;
int OLDLA;
int OLDDA;
// 691 %integer count, size, n, save
int COUNT;
int SIZE;
int N;
int SAVE;
// 692 %integer reg, specifier, mode
int REG;
int SPECIFIER;
int MODE;
// 693 %integer evlow, evep, evword
int EVLOW;
int EVEP;
int EVWORD;
// 694 %integer tag, lim, nbase
int TAG;
int LIM;
int NBASE;
// 695 %record(proc fm) %name proc
struct PROCFM *PROC;
// 696
// 697 %routine DUMP LINE
void DUMPLINE(void) {
// 698 buff == linep
BUFF = (struct PSECTFM *)/*?*/ &LINEP;
// 699 start immed (6)
STARTIMMED(6);
// 700 addl (ca); addw (this line)
ADDL(*CA);
ADDW(THISLINE);
// 701 end immed
ENDIMMED();
// 702 %end
return;
} /* end of DUMPLINE */
// 703
// 704 %routine LOAD BLOCK
void LOADBLOCK(void) {
// 705 %integer n
int N;
// 706 get (n); start immed (n)
GET(/*?*/ &N);
STARTIMMED(N);
// 707 get block (n, buff_b(buff_bp+1))
GETBLOCK(N, /*?*/ &BUFF->B[BUFF->BP + 1 - 1]);
// 708 buff_bp = buff_bp + n
BUFF->BP = BUFF->BP + N;
// 709 end immed
ENDIMMED();
// 710 %end
return;
} /* end of LOADBLOCK */
// 711
// 712 %routine SET PRIM TEXT (%integer pno)
void SETPRIMTEXT(int PNO) {
// 713 text = "$_"
_imp_strncpy(/*?*/ &TEXT, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = _imp_str_literal("$_");
(void *)&tmp;
}),
/*max:*/ 31);
// 714 text = text . "_" %and pno = pno - 26 %while pno > 26
L_0053:;
if (PNO <= 26) goto L_0054;
_imp_strncpy(/*?*/ &TEXT, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp =
_imp_join((_imp_string *)/*?*/ &TEXT, (_imp_string *)/*?*/ _imp_str_literal_ptr("_"));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 31);
PNO = PNO - 26;
goto L_0053;
L_0054:;
// 715 text = text . tostring ('A'-1+pno)
_imp_strncpy(/*?*/ &TEXT, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &TEXT, ({
__typeof__(_imp_string1) tmp; /*E*/
tmp = _imp_TOSTRING(65 - 1 + PNO);
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 31);
// 716 %end
return;
} /* end of SETPRIMTEXT */
// 717
// 718 %routine PLUG GLAP (%record(psect fm) %name with,
void PLUGGLAP(struct PSECTFM * WITH, int WITHDISP, int WHERE, int INST) {
// 719+ %integer with disp, where, inst)
// 720 %integer old ga = ga
int OLDGA;
OLDGA = *GA;
// 721 %unless 0 < where < glap size %start
{
// Double-sided test on WHERE (Part I)
int tmp;
if (0 >= (tmp = WHERE)) goto L_0055;
// Double-sided test on WHERE (Part II)
if (tmp < GLAPSIZE) goto L_0056;
}
L_0055:;
// 722 error ("faulty glap relocation", where)
ERROR(_imp_str_literal_size(31, "faulty glap relocation"), WHERE);
// 723 %finish
L_0056:;
// 724 buff == glapp; select (where)
BUFF = (struct PSECTFM *)/*?*/ &GLAPP;
SELECT(WHERE);
// 725 need (7); ! Must have following in one record..
NEED(7);
// 726 stpb (with, with disp)
STPB(WITH, WITHDISP);
// 727 add (inst)
ADD(INST);
// 728 select (old ga)
SELECT(OLDGA);
// 729 %end
return;
} /* end of PLUGGLAP */
// 730
// 731 %routine BSEL (%integername old, %record(psect fm) %name p,
void BSEL(int *OLD, struct PSECTFM *P, int NEW) {
// 732+ %integer new)
// 733 buff == p
BUFF = (struct PSECTFM *)P;
// 734 old = p_pa
*OLD = P->PA;
// 735 select (new)
SELECT(NEW);
// 736 %end
return;
} /* end of BSEL */
// 737
// 738 %routine INITIALISE BUFFERS
void INITIALISEBUFFERS(void) {
// 739 buff for(0) == codep
BUFFFOR[0] = (struct PSECTFM *)/*?*/ &CODEP;
// 740 buff for(1) == glapp
BUFFFOR[1] = (struct PSECTFM *)/*?*/ &GLAPP;
// 741 buff for(2) == diagp
BUFFFOR[2] = (struct PSECTFM *)/*?*/ &DIAGP;
// 742 buff for(3) == linep
BUFFFOR[3] = (struct PSECTFM *)/*?*/ &LINEP;
// 743 called = non zero
CALLED = 1;
// 744 %end
return;
} /* end of INITIALISEBUFFERS */
// 745
// 746 %routine HANDLE BLOCK ENTRY
void HANDLEBLOCKENTRY(void) {
// 747 %integer mask, unsaved, reg
int MASK;
int UNSAVED;
int REG;
// 748 %integer frame
int FRAME;
// 749 base = 13 %if base = 12; ! bottom 2 levels
if (BASE != 12) goto L_0057;
BASE = 13;
L_0057:;
// 750 dump line %if ldump # 0
if (LDUMP == 0) goto L_0058;
DUMPLINE();
L_0058:;
// 751 buff == codep
BUFF = (struct PSECTFM *)/*?*/ &CODEP;
// 752 ! Calculate true offset from FP of args to this proc
// 753 ! for benefit of inner procs referencing them. This
// 754 ! is affected by the number of regs saved on the stack
// 755 ! on proc call. Pass 2 assumes all regs saved, we now
// 756 ! calculate how many aren't, and subtract this*4 from
// 757 ! displacement used by pass 2.
// 758 mask = proc_mask; unsaved = 0
MASK = PROC->MASK;
UNSAVED = 0;
// 759 %for reg = 2, 1, 11 %cycle
// %for REG = 2, 1, 11 %cycle
{
REG = 1;
L_0059:
if (REG == 11) goto L_005A;
REG += 1;
// 760 unsaved = unsaved + 1 %if mask & (1<<reg) = 0
if (MASK & 1 << REG != 0) goto L_005C;
UNSAVED = UNSAVED + 1;
L_005C:;
// 761 %repeat
goto L_0059;
}
L_005A:;
// 762 base mod(base) = unsaved*4; ! to subtract off
BASEMOD[BASE - 5] = UNSAVED * 4;
// 763 frame = proc_frame; ! frame size
FRAME = PROC->FRAME;
// 764 start immed (50); ! For entry sequence
STARTIMMED(50);
// 765 addw (mask); ! entry mask
ADDW(MASK);
// 766 %if proc_type # 0 %start
if (PROC->TYPE == 0) goto L_005D;
// 767 ! %external entry
// 768 get string (text); ! name
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &TEXT);
// 769 %if entry tag = btag %and init # 0 %start
if (ENTRYTAG != BTAG) goto L_005E;
if (INIT == 0) goto L_005E;
// 770 add (calls); add (0); ! calls #0,init proc
ADD(251);
ADD(0);
// 771 end immed
ENDIMMED();
// 772 stag (init proc); ! spec reference
STAG(
*({
__typeof__(_imp_string10) tmp = INITPROC /*q*/;
(_imp_string34 *)&tmp;
})
);
// 773 add (tir stopicr); ! store it
ADD(28);
// 774 ca = ca + 5
*CA = *CA + 5;
// 775 start immed (1)
STARTIMMED(1);
// 776 %finish
L_005E:;
// 777 add (moval); end immed; ! moval
ADD(222);
ENDIMMED();
// 778 need (1+1+length(text)+1+1);
NEED(1 + 1 + *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &TEXT) + 1 + 1);
// 779 stag (text."_");
STAG(
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp =
_imp_join((_imp_string *)/*?*/ &TEXT, (_imp_string *)/*?*/ _imp_str_literal_ptr("_"));
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string34 *)&tmp;
})
);
// 780 add (tir stopicr); ! ep_,
ADD(28);
// 781 ca = ca + 5
*CA = *CA + 5;
// 782 start immed (50); add (16_5B); ! gla
STARTIMMED(50);
ADD(91);
// 783 %finish
L_005D:;
// 784 add (movl); ! movl
ADD(208);
// 785 add (16_5D); add (16_50+base); ! fp, base
ADD(93);
ADD(80 + BASE);
// 786 %if frame # 0 %start
if (FRAME == 0) goto L_005F;
// 787 %if frame <= 63 %start
if (FRAME > 63) goto L_0060;
// 788 add (subl2); ! subl2
ADD(194);
// 789 add (frame); ! S^#frame
ADD(FRAME);
// 790 %else %if frame <= 16_7fff
goto L_0061;
L_0060:;
if (FRAME > 32767) goto L_0062;
// 791 add (movab); ! movab
ADD(158);
// 792 add (16_CE); addw (-frame); ! W^-frame(sp)
ADD(206);
ADDW(-FRAME);
// 793 %else
goto L_0061;
L_0062:;
// 794 add (subl2); ! subl2
ADD(194);
// 795 add (16_8F); addl (frame); ! I^#frame
ADD(143);
ADDL(FRAME);
// 796 %finish
L_0061:;
// 797 add (16_5E); ! , SP
ADD(94);
// 798 %if check ass # 0 %start
if (CHECKASS == 0) goto L_0063;
// 799 add (movc5); add (0); add (16_6D); add (16_6B)
ADD(44);
ADD(0);
ADD(109);
ADD(107);
// 800 %if frame <= 63 %start
if (FRAME > 63) goto L_0064;
// 801 add (frame)
ADD(FRAME);
// 802 %else
goto L_0065;
L_0064:;
// 803 add (16_8F); addw (frame&16_7FFF)
ADD(143);
ADDW(FRAME & 32767);
// 804 %finish
L_0065:;
// 805 add (16_6E)
ADD(110);
// 806 !movc5_#0,(fp),(gla), #N, (sp)
// 807 %finish
L_0063:;
// 808 %finish
L_005F:;
// 809 end immed
ENDIMMED();
// 810 %end
return;
} /* end of HANDLEBLOCKENTRY */
// 811
// 812 initialise buffers %if called = 0
if (CALLED != 0) goto L_0066;
INITIALISEBUFFERS();
L_0066:;
// 813 procs = procs + 1
PROCS = PROCS + 1;
// 814 proc == proc tab(procs)
PROC = (struct PROCFM *)/*?*/ &PROCTAB[PROCS - 1];
// 815 bsel (old da, diagp, proc_diag ep)
BSEL(/*?*/ &OLDDA, /*?*/ &DIAGP, PROC->DIAGEP);
// 816 bsel (old la, linep, proc_line ep)
BSEL(/*?*/ &OLDLA, /*?*/ &LINEP, PROC->LINEEP);
// 817 bsel (old ca, codep, def(btag)_ca)
BSEL(/*?*/ &OLDCA, /*?*/ &CODEP, DEF[BTAG].CA);
// 818 handle block entry %if base # 0
if (BASE == 0) goto L_0067;
HANDLEBLOCKENTRY();
L_0067:;
// 819
// 820 %cycle
L_0068:;
// 821 get (ocode)
GET(/*?*/ &OCODE);
// 822 buff == buff for(code type(ocode))
BUFF = (struct PSECTFM *)BUFFFOR[CODETYPE[OCODE - 1]];
// 823 -> c(ocode) %if 0 < ocode <= 25
{
// Double-sided test on OCODE (Part I)
int tmp;
if (0 >= (tmp = OCODE)) goto L_0069;
// Double-sided test on OCODE (Part II)
if (tmp > 25) goto L_0069;
}
C_line = __LINE__;
C_file = __FILE__;
C_index = OCODE;
goto case_C_dispatch;
L_0069:;
// 824 c(*): error ("spurious object", ocode)
case_C_default:;
ERROR(_imp_str_literal_size(31, "spurious object"), OCODE);
// 825
// 826 c(obj diag p):
case_C_17:;
// 827 n = getword
N = GETWORD();
// 828 get string (text)
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &TEXT);
// 829 ldiag = proc_diag
LDIAG = PROC->DIAG;
// 830 error ("corrupt diags", 0) %if ldiag = 0
if (LDIAG != 0) goto L_006B;
ERROR(_imp_str_literal_size(31, "corrupt diags"), 0);
L_006B:;
// 831 start immed (50)
STARTIMMED(50);
// 832 addw (ldiag); addw (n); addl (limit); add text (0)
ADDW(LDIAG);
ADDW(N);
ADDL(LIMIT);
ADDTEXT(0);
// 833 end immed
ENDIMMED();
// 834 %continue
goto L_005B;
// 835 c(obj diag v):
case_C_18:;
// 836 start immed (50)
STARTIMMED(50);
// 837 addw (getword); addl (getlong)
ADDW(GETWORD());
ADDL(GETLONG());
// 838 get string (text); add text (0)
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &TEXT);
ADDTEXT(0);
// 839 end immed
ENDIMMED();
// 840 %continue
goto L_005B;
// 841 c(obj code):
case_C_2:;
// 842 load block
LOADBLOCK();
// 843 %continue
goto L_005B;
// 844 c(obj modd):
case_C_23:;
// 845 get (ocode); error ("faulty mod", ocode) %if ocode # 2
GET(/*?*/ &OCODE);
if (OCODE == 2) goto L_006C;
ERROR(_imp_str_literal_size(31, "faulty mod"), OCODE);
L_006C:;
// 846 get (n); ! # bytes following
GET(/*?*/ &N);
// 847 start immed (n)
STARTIMMED(N);
// 848 get (specifier); n = n - 1
GET(/*?*/ &SPECIFIER);
N = N - 1;
// 849 reg = specifier & 15
REG = SPECIFIER & 15;
// 850 add (specifier)
ADD(SPECIFIER);
// 851 %if n = 1 %start
if (N != 1) goto L_006D;
// 852 get (disp)
GET(/*?*/ &DISP);
// 853 %else %if n = 2
goto L_006E;
L_006D:;
if (N != 2) goto L_006F;
// 854 disp = getword
DISP = GETWORD();
// 855 %else %if n = 4
goto L_006E;
L_006F:;
if (N != 4) goto L_0070;
// 856 disp = getlong
DISP = GETLONG();
// 857 %else
goto L_006E;
L_0070:;
// 858 error ("faulty disp in mod", n)
ERROR(_imp_str_literal_size(31, "faulty disp in mod"), N);
// 859 %finish
L_006E:;
// 860 disp = disp - base mod(reg)
DISP = DISP - BASEMOD[REG - 5];
// 861 add (disp)
ADD(DISP);
// 862 add (disp>>8) %if n > 1
if (N <= 1) goto L_0071;
ADD((unsigned int)DISP >> 8);
L_0071:;
// 863 addw (disp>>16) %if n = 4
if (N != 4) goto L_0072;
ADDW((unsigned int)DISP >> 16);
L_0072:;
// 864 end immed
ENDIMMED();
// 865 %continue
goto L_005B;
// 866 c(obj gla):
case_C_3:;
// 867 gb = getlong
GB = GETLONG();
// 868 error ("gla pos error", gb-ga) %if gb # ga
if (GB == *GA) goto L_0073;
ERROR(_imp_str_literal_size(31, "gla pos error"), GB - *GA);
L_0073:;
// 869 load block
LOADBLOCK();
// 870 %continue
goto L_005B;
// 871 c(obj glam):
case_C_22:;
// 872 gb = getlong
GB = GETLONG();
// 873 error ("glam pos error", gb-ga) %if gb # ga
if (GB == *GA) goto L_0074;
ERROR(_imp_str_literal_size(31, "glam pos error"), GB - *GA);
L_0074:;
// 874 value = getlong; ! value
VALUE = GETLONG();
// 875 count = getlong; ! repeat count
COUNT = GETLONG();
// 876 size = getlong; ! bytes in object
SIZE = GETLONG();
// 877 %if count*size > 15 %start
if (COUNT * SIZE <= 15) goto L_0075;
// 878 ! Worth doing as 'store repeated' type
// 879 stak (value)
STAK(VALUE);
// 880 stak (count)
STAK(COUNT);
// 881 need (1)
NEED(1);
// 882 %if size = 1 %start
if (SIZE != 1) goto L_0076;
// 883 add (tir sto rb)
ADD(39);
// 884 %else %if size = 2
goto L_0077;
L_0076:;
if (SIZE != 2) goto L_0078;
// 885 add (tir sto rw)
ADD(40);
// 886 %else %if size = 4
goto L_0077;
L_0078:;
if (SIZE != 4) goto L_0079;
// 887 add (tir sto rl)
ADD(31);
// 888 %else
goto L_0077;
L_0079:;
// 889 error ("Faulty glam size", size)
ERROR(_imp_str_literal_size(31, "Faulty glam size"), SIZE);
// 890 %finish
L_0077:;
// 891 ga = ga + count*size
*GA = *GA + COUNT * SIZE;
// 892 %else
goto L_007A;
L_0075:;
// 893 start immed (count*size)
STARTIMMED(COUNT * SIZE);
// 894 %for n = 1, 1, count %cycle
// %for N = 1, 1, COUNT %cycle
{
int _final = COUNT;
if (invalid_for_loop(1, 1, _final)) _imp_signal(5, 1, 0, "Illegal cycle N = 1, 1, COUNT");
N = 0;
L_007B:
if (N == _final) goto L_007C;
N += 1;
// 895 %if size = 1 %start
if (SIZE != 1) goto L_007E;
// 896 add (value)
ADD(VALUE);
// 897 %else %if size = 2
goto L_007F;
L_007E:;
if (SIZE != 2) goto L_0080;
// 898 addw (value)
ADDW(VALUE);
// 899 %else %if size = 4
goto L_007F;
L_0080:;
if (SIZE != 4) goto L_0081;
// 900 addl (value)
ADDL(VALUE);
// 901 %else
goto L_007F;
L_0081:;
// 902 error ("Faulty glam size", size)
ERROR(_imp_str_literal_size(31, "Faulty glam size"), SIZE);
// 903 %finish
L_007F:;
// 904 %repeat
goto L_007B;
}
L_007C:;
// 905 end immed
ENDIMMED();
// 906 %finish
L_007A:;
// 907 %continue
goto L_005B;
// 908 c(obj pdef): ! proc def
case_C_4:;
// 909 tag = getlong
TAG = GETLONG();
// 910 get string (text)
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &TEXT);
// 911 spec (2_1010, 0,
SPEC(10, 0, DEF[TAG].CA, PROC->MASK);
// 912+ def(tag)_ca, proc_mask); ! ep
// 913 spec (2_1010, 1, 0, 0); ! gla (ep_)
SPEC(10, 1, 0, 0);
// 914 %continue
goto L_005B;
// 915 c(obj pspec): ! proc spec
case_C_5:;
// 916 xno = getword
XNO = GETWORD();
// 917 get string (text)
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &TEXT);
// 918 %if ext used(xno) # 0 %start; ! strong code
if (EXTUSED[XNO - 1] == 0) goto L_0082;
// 919 spec (2_1000, 0, 0, 0)
SPEC(8, 0, 0, 0);
// 920 ext text(xno) = text
_imp_strncpy(/*?*/ &EXTTEXT[XNO - 1], ({
__typeof__(_imp_string31) tmp; /*B*/
tmp = TEXT;
(void *)&tmp;
}),
/*max:*/ 31);
// 921 %finish
L_0082:;
// 922 %continue
goto L_005B;
// 923 c(obj ddef): ! data def
case_C_6:;
// 924 gx = getlong
GX = GETLONG();
// 925 get string (text)
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &TEXT);
// 926 spec (2_1010, -1, gx, 0); ! Note -1 => special
SPEC(10, -1, GX, 0);
// 927 %continue
goto L_005B;
// 928 c(obj weak): ! weak ref
case_C_19:;
// 929 c(obj dspec): ! data ref
case_C_7:;
// 930 xno = getword
XNO = GETWORD();
// 931 get string (text)
GETSTRING((_imp_string255 *)/*p*/ /*?*/ &TEXT);
// 932 ext text(xno) = text
_imp_strncpy(/*?*/ &EXTTEXT[XNO - 1], ({
__typeof__(_imp_string31) tmp; /*B*/
tmp = TEXT;
(void *)&tmp;
}),
/*max:*/ 31);
// 933 mode = 2_1000; mode = 2_1001 %if ocode = obj weak
MODE = 8;
if (OCODE != 19) goto L_0083;
MODE = 9;
L_0083:;
// 934 spec (mode, 0, 0, 0)
SPEC(MODE, 0, 0, 0);
// 935 %continue
goto L_005B;
// 936 c(obj ext ref):
case_C_25:;
// 937 xno = getword; ! External number
XNO = GETWORD();
// 938 disp = getlong; ! Offset
DISP = GETLONG();
// 939 get (reg); ! Base reg (+ indirect bit)?
GET(/*?*/ ®);
// 940 stag (ext text(xno)); ! External address
STAG(
*({
__typeof__(_imp_string31) tmp = EXTTEXT[XNO - 1] /*q*/;
(_imp_string34 *)&tmp;
})
);
// 941 %if disp # 0 %start
if (DISP == 0) goto L_0084;
// 942 stak (disp); need (1); add (tir add)
STAK(DISP);
NEED(1);
ADD(51);
// 943 %finish
L_0084:;
// 944 need (1); add (tir stopicr); ca = ca + 5
NEED(1);
ADD(28);
*CA = *CA + 5;
// 945 %if reg&16 # 0 %start
if (REG & 16 == 0) goto L_0085;
// 946 !indirect ref - won't work if absolute!!
// 947 need (16)
NEED(16);
// 948 add (tir augrb); addl (-5); ! Go back to specifier byte
ADD(81);
ADDL(-5);
// 949 add (tir staub); add (16_FF); ! stack byte 16_FF = @L^X(PC)
ADD(7);
ADD(255);
// 950 add (tir stoub); ! store byte
ADD(33);
// 951 add (tir augrb); addl (4); ! return to correct ca
ADD(81);
ADDL(4);
// 952 %finish
L_0085:;
// 953 %continue
goto L_005B;
// 954 c(obj reloc): ! relocate gla
case_C_8:;
// 955 ! error ("Not PIC", 0) %if pic # 0
// 956 gb = getlong; gx = getlong
GB = GETLONG();
GX = GETLONG();
// 957 plug glap (glapp, gx, gb, tir stopidr)
PLUGGLAP(/*?*/ &GLAPP, GX, GB, 27);
// 958 %continue
goto L_005B;
// 959 c(obj set): !set gla
case_C_9:;
// 960 cx = def(getlong)_ca; ! Switch label address
CX = DEF[GETLONG()].CA;
// 961 gb = getlong; ! Gla address to plug
GB = GETLONG();
// 962 plug glap (codep, cx+4, gb, tir stold)
PLUGGLAP(/*?*/ &CODEP, CX + 4, GB, 25);
// 963 %continue
goto L_005B;
// 964 c(obj header):
case_C_10:;
// 965 get (nbase); ! base
GET(/*?*/ &NBASE);
// 966 tag = getword; ! tag
TAG = GETWORD();
// 967 lim = getword
LIM = GETWORD();
// 968 this line = getword
THISLINE = GETWORD();
// 969 dump code (nbase, tag, def(lim)_ca)
DUMPCODE(NBASE, TAG, DEF[LIM].CA);
// 970 %continue
goto L_005B;
// 971 c(obj call):
case_C_11:;
// 972 tag = getlong
TAG = GETLONG();
// 973 disp = def(tag)_ca-ca-2
DISP = DEF[TAG].CA - *CA - 2;
// 974 start immed (5)
STARTIMMED(5);
// 975 n = range (disp, 1)
N = RANGE(DISP, 1);
// 976 %if n = 1 %start;
if (N != 1) goto L_0086;
// 977 add (16_AF); add (disp)
ADD(175);
ADD(DISP);
// 978 %else %if n = 2
goto L_0087;
L_0086:;
if (N != 2) goto L_0088;
// 979 add (16_CF); addw (disp-1)
ADD(207);
ADDW(DISP - 1);
// 980 %else
goto L_0087;
L_0088:;
// 981 add (16_EF); addl (disp-3)
ADD(239);
ADDL(DISP - 3);
// 982 %finish
L_0087:;
// 983 end immed
ENDIMMED();
// 984 %continue
goto L_005B;
// 985 c(obj jump): ! jump <cond> <tag>
case_C_12:;
// 986 get (cond); tag = getword
GET(/*?*/ &COND);
TAG = GETWORD();
// 987 cond = cond&15
COND = COND & 15;
// 988 disp = def(tag)_ca-ca-2
DISP = DEF[TAG].CA - *CA - 2;
// 989 size = range (disp, 1)
SIZE = RANGE(DISP, 1);
// 990 start immed (8)
STARTIMMED(8);
// 991 %if cond = 0 %start; !unconditional
if (COND != 0) goto L_0089;
// 992 %if size = 1 %start
if (SIZE != 1) goto L_008A;
// 993 add (brb); add (disp)
ADD(17);
ADD(DISP);
// 994 %else %if size = 2
goto L_008B;
L_008A:;
if (SIZE != 2) goto L_008C;
// 995 add (brw); addw (disp-1)
ADD(49);
ADDW(DISP - 1);
// 996 %else
goto L_008B;
L_008C:;
// 997 add (jmp); add (16_EF); addl (disp-4)
ADD(23);
ADD(239);
ADDL(DISP - 4);
// 998 %finish
L_008B:;
// 999 %else; !conditional
goto L_008D;
L_0089:;
// 1000 %if size = 1 %start
if (SIZE != 1) goto L_008E;
// 1001 add (branch(cond)); add (disp)
ADD(BRANCH[COND]);
ADD(DISP);
// 1002 %else %if size = 2
goto L_008F;
L_008E:;
if (SIZE != 2) goto L_0090;
// 1003 add (branch(cond!!7)); add (3)
ADD(BRANCH[COND ^ 7]);
ADD(3);
// 1004 add (brw); addw (disp-3)
ADD(49);
ADDW(DISP - 3);
// 1005 %else
goto L_008F;
L_0090:;
// 1006 add (branch(cond!!7)); add (6)
ADD(BRANCH[COND ^ 7]);
ADD(6);
// 1007 add (jmp); add (16_EF); addl (disp-6)
ADD(23);
ADD(239);
ADDL(DISP - 6);
// 1008 %finish
L_008F:;
// 1009 %finish
L_008D:;
// 1010 end immed
ENDIMMED();
// 1011 %continue
goto L_005B;
// 1012 c(obj b lab): ! m/code byte label reference
case_C_20:;
// 1013 c(obj w lab): ! " " " word " " " " " "
case_C_21:;
// 1014 disp = def(getword)_ca-ca-1
DISP = DEF[GETWORD()].CA - *CA - 1;
// 1015 start immed (2)
STARTIMMED(2);
// 1016 %if ocode = obj w lab %start; !word
if (OCODE != 21) goto L_0091;
// 1017 addw (disp-1)
ADDW(DISP - 1);
// 1018 %else; !byte
goto L_0092;
L_0091:;
// 1019 error ("branch overflow", disp) %unless -128 <= disp <= 127
{
// Double-sided test on DISP (Part I)
int tmp;
if (-128 > (tmp = DISP)) goto L_007D;
// Double-sided test on DISP (Part II)
if (tmp <= 127) goto L_0093;
}
L_007D:;
ERROR(_imp_str_literal_size(31, "branch overflow"), DISP);
L_0093:;
// 1020 add (disp)
ADD(DISP);
// 1021 %finish
L_0092:;
// 1022 end immed
ENDIMMED();
// 1023 %continue
goto L_005B;
// 1024 c(obj prim spec):
case_C_13:;
// 1025 get (pno); set prim text (pno)
GET(/*?*/ &PNO);
SETPRIMTEXT(PNO);
// 1026 spec (2_1000, 0, 0, 0)
SPEC(8, 0, 0, 0);
// 1027 %continue
goto L_005B;
// 1028 c(obj prim ref):
case_C_24:;
// 1029 get (pno); set prim text (pno)
GET(/*?*/ &PNO);
SETPRIMTEXT(PNO);
// 1030 %if pno # proc enter prim %start
if (PNO == 13) goto L_0094;
// 1031 start immed (1); add (jsb); end immed
STARTIMMED(1);
ADD(22);
ENDIMMED();
// 1032 %finish
L_0094:;
// 1033 stag (text)
STAG(
*({
__typeof__(_imp_string31) tmp = TEXT /*q*/;
(_imp_string34 *)&tmp;
})
);
// 1034 need (1); add (tir stopicr); ca = ca + 5
NEED(1);
ADD(28);
*CA = *CA + 5;
// 1035 %continue
goto L_005B;
// 1036 c(obj line): ! line number
case_C_15:;
// 1037 this line = getword
THISLINE = GETWORD();
// 1038 dump line %if ldump # 0
if (LDUMP == 0) goto L_0095;
DUMPLINE();
L_0095:;
// 1039 %repeat
L_005B:;
goto L_0068;
// 1040
// 1041 c(obj term):!block end
case_C_16:;
// 1042 %if diagp_pa # 0 %start
if (DIAGP.PA == 0) goto L_0096;
// 1043 buff == diagp
BUFF = (struct PSECTFM *)/*?*/ &DIAGP;
// 1044 start immed (1); add (0); end immed
STARTIMMED(1);
ADD(0);
ENDIMMED();
// 1045 %finish
L_0096:;
// 1046 evword = getword; !events
EVWORD = GETWORD();
// 1047 %if evword # 0 %start; !events trapped
if (EVWORD == 0) goto L_0097;
// 1048 evlow = getword; !evlow
EVLOW = GETWORD();
// 1049 evep = getword; !evep
EVEP = GETWORD();
// 1050 buff == codep; save = ca
BUFF = (struct PSECTFM *)/*?*/ &CODEP;
SAVE = *CA;
// 1051 select (evp)
SELECT(EVP);
// 1052 start immed (16)
STARTIMMED(16);
// 1053 addl (evword); !ev list
ADDL(EVWORD);
// 1054 addl (def(evlow)_ca); !from
ADDL(DEF[EVLOW].CA);
// 1055 addl (save); !to (ca)
ADDL(SAVE);
// 1056 addl (def(evep)_ca); !entry point
ADDL(DEF[EVEP].CA);
// 1057 end immed
ENDIMMED();
// 1058 evp = evp + 16
EVP = EVP + 16;
// 1059 %finish
L_0097:;
// 1060
// 1061 c(obj end):
case_C_14:;
// 1062 bsel (n, diagp, old da)
BSEL(/*?*/ &N, /*?*/ &DIAGP, OLDDA);
// 1063 bsel (n, linep, old la)
BSEL(/*?*/ &N, /*?*/ &LINEP, OLDLA);
// 1064 bsel (n, codep, old ca)
BSEL(/*?*/ &N, /*?*/ &CODEP, OLDCA);
// 1065 %end
return;
case_C_dispatch:
if (C_index < 1 || C_index > 25)
_imp_signalf(6, 3, C_index, "->C(%d) out of bounds at %s line %d", C_index, C_file, C_line);
goto *C[C_index - 1];
case_C_missing:
_imp_signalf(8, 2, C_index, "switch jump to undefined label C(%d): at %s line %d", C_index, C_file, C_line);
} /* end of DUMPCODE */
// ?TYPE unused
// 1066
// 1067 %routine DUMP ALL CODE
void DUMPALLCODE(void) {
// 1068 select input tank (object)
SELECTINPUTTANK(OBJECT);
// 1069 procs = 0
PROCS = 0;
// 1070 dump code (0, 0, 0)
DUMPCODE(0, 0, 0);
// 1071 %end
return;
} /* end of DUMPALLCODE */
// 1072
// 1073 %routine DEFINE PSECT (%record(psect fm) %name ps,
void DEFINEPSECT(struct PSECTFM * PS, int ALIGN, int FLAGS, int SIZE, _imp_string31 NAME) {
// 1074+ %integer align, flags, size,
// 1075+ %string(31) name)
// 1076 %own %integer psect no = 0
static int PSECTNO = 0;
// 1077 set work (obj gsd)
SETWORK(1);
// 1078 add (gsd psc); ! P-sect def field
ADD(0);
// 1079 add (align); ! Align (as power of 2)
ADD(ALIGN);
// 1080 addw (flags); ! P-sect flags (rd,wrt,exe etc)
ADDW(FLAGS);
// 1081 addl (size); ! Allocation in bytes
ADDL(SIZE);
// 1082 add string (0, name); ! Ident
ADDSTRING(0,
*({
__typeof__(_imp_string31) tmp = NAME /*q*/;
(_imp_string63 *)&tmp;
})
);
// 1083 ps = 0
*PS = (struct PSECTFM){0};
// 1084 ps_dump = 1; ps_type = obj tir; ps_bp = 1
PS->DUMP = 1;
PS->TYPE = 2;
PS->BP = 1;
// 1085 ps_max = size
PS->MAX = SIZE;
// 1086 ps_index = psect no
PS->INDEX = PSECTNO;
// 1087 psect no = psect no + 1
PSECTNO = PSECTNO + 1;
// 1088 flush buff
FLUSHBUFF();
// 1089 buff == ps; ps_pa = -999; ! ensure SELECT happens...
BUFF = (struct PSECTFM *)PS;
PS->PA = -999;
// 1090 select (0)
SELECT(0);
// 1091 %end
return;
} /* end of DEFINEPSECT */
// 1092
// 1093 %routine DUMP MODULE HEADER
void DUMPMODULEHEADER(void) {
// 1094 %string(31) temp
_imp_string31 TEMP;
// 1095 select output (object file)
_imp_SELECTOUTPUT(1);
// 1096 set work (obj hdr); !header
SETWORK(0);
// 1097 add (hdr mhd); !module header record
ADD(0);
// 1098 add (0); !structure level
ADD(0);
// 1099 addw (max rec); !max record length
ADDW(512);
// 1100 add string (0, module); !module name
ADDSTRING(0,
*({
__typeof__(_imp_string63) tmp = MODULE /*q*/;
(_imp_string63 *)&tmp;
})
);
// 1101 add string (0, "V01.00"); !module version
ADDSTRING(0, _imp_str_literal_size(63, "V01.00"));
// 1102 temp = date . " " . time
_imp_strncpy(/*?*/ &TEMP, ({
__typeof__(_imp_string255) tmp; /*B*/
tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ &*({
_imp_string255 tmp =
_imp_join(({
__typeof__(_imp_string255) tmp; /*D*/
tmp = DATE();
(void *)&tmp;
}),
(_imp_string *)/*?*/ _imp_str_literal_ptr(" "));
(_imp_string255 *)&tmp;
}),
({
__typeof__(_imp_string255) tmp; /*E*/
tmp = TIME();
(void *)&tmp;
}));
(_imp_string255 *)&tmp;
});
(void *)&tmp;
}),
/*max:*/ 31);
// 1103 length(temp) = length(temp) - 3; !remove milliseconds
*_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &TEMP) = *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &TEMP) - 3;
// 1104 add string (1, temp); !creation date
ADDSTRING(1,
*({
__typeof__(_imp_string31) tmp = TEMP /*q*/;
(_imp_string63 *)&tmp;
})
);
// 1105 add string (1, "IMP is wonderful!"); !last patch!!
ADDSTRING(1, _imp_str_literal_size(63, "IMP is wonderful!"));
// 1106 set work (obj hdr)
SETWORK(0);
// 1107 add (hdr lng); !language sub-header
ADD(1);
// 1108 add string (1, "VAX-11 Imp77 ".version)
ADDSTRING(1,
*({
__typeof__(_imp_string255) tmp = *({
_imp_string255 tmp = _imp_join((_imp_string *)/*?*/ _imp_str_literal_ptr("VAX-11 Imp77 "),
(_imp_string *)/*?*/ &VERSION);
(_imp_string255 *)&tmp;
}) /*q*/;
(_imp_string63 *)&tmp;
})
);
// 1109 %end
return;
} /* end of DUMPMODULEHEADER */
// 1110
// 1111 %routine DEFINE PSECTS
void DEFINEPSECTS(void) {
// 1112 define psect (codep, quad, code flags, code size, code name)
DEFINEPSECT(/*?*/ &CODEP, 3, 233, CODESIZE,
*({
__typeof__(_imp_string10) tmp = CODENAME /*q*/;
(_imp_string31 *)&tmp;
})
);
// 1113 define psect (glapp, quad, glap flags, glap size, glap name)
DEFINEPSECT(/*?*/ &GLAPP, 3, GLAPFLAGS, GLAPSIZE,
*({
__typeof__(_imp_string10) tmp = GLAPNAME /*q*/;
(_imp_string31 *)&tmp;
})
);
// 1114 %if diags # 0 %start
if (DIAGS == 0) goto L_0098;
// 1115 define psect (diagp, quad, diag flags, diag size+2, diag name)
DEFINEPSECT(/*?*/ &DIAGP, 3, 169, DIAGSIZE + 2,
*({
__typeof__(_imp_string10) tmp = DIAGNAME /*q*/;
(_imp_string31 *)&tmp;
})
);
// 1116 ! add 2 to ensure 0 word at end...
// 1117 %else
goto L_0099;
L_0098:;
// 1118 diagp_dump = 0
DIAGP.DUMP = 0;
// 1119 %finish
L_0099:;
// 1120 %if ldump # 0 %start
if (LDUMP == 0) goto L_009A;
// 1121 define psect (linep, quad, line flags, line size, line name)
DEFINEPSECT(/*?*/ &LINEP, 3, 169, LINESIZE,
*({
__typeof__(_imp_string10) tmp = LINENAME /*q*/;
(_imp_string31 *)&tmp;
})
);
// 1122 !fill in length word
// 1123 buff == linep; select (0)
BUFF = (struct PSECTFM *)/*?*/ &LINEP;
SELECT(0);
// 1124 start immed (2); addw (line size); end immed
STARTIMMED(2);
ADDW(LINESIZE);
ENDIMMED();
// 1125 %else
goto L_009B;
L_009A:;
// 1126 linep_dump = 0
LINEP.DUMP = 0;
// 1127 %finish
L_009B:;
// 1128 %end
return;
} /* end of DEFINEPSECTS */
// 1129
// 1130 %routine INITIALISE
void INITIALISE(void) {
// 1131 %integer j
int J;
// 1132 ext used(j) = 0 %for j = 1, 1, max externals
// %for J = 1, 1, 400 %cycle
{
J = 0;
L_009C:
if (J == 400) goto L_009D;
J += 1;
EXTUSED[J - 1] = 0;
goto L_009C;
}
L_009D:;
// 1133 select input tank (directives)
SELECTINPUTTANK(DIRECTIVES);
// 1134 refs = 0; procs = 0; def(0) = 0
REFS = 0;
PROCS = 0;
DEF[0] = (struct DEFFM){0};
// 1135 ca == codep_pa; ga == glapp_pa
CA = (int *)/*?*/ &CODEP.PA;
GA = (int *)/*?*/ &GLAPP.PA;
// 1136 %end
return;
} /* end of INITIALISE */
// 1137
// 1138 %routine SPEC INIT PROC
void SPECINITPROC(void) {
// 1139 %return %if entry tag < 0 %or init = 0
if (ENTRYTAG < 0) goto L_009E;
if (INIT != 0) goto L_009F;
L_009E:;
return;
L_009F:;
// 1140 set work (obj gsd)
SETWORK(1);
// 1141 add (gsd sym); ! symbol entry
ADD(1);
// 1142 add (0); ! unknown data type
ADD(0);
// 1143 addw (2_1000); ! flags
ADDW(8);
// 1144 add string (0, init proc); ! name
ADDSTRING(0,
*({
__typeof__(_imp_string10) tmp = INITPROC /*q*/;
(_imp_string63 *)&tmp;
})
);
// 1145 flush buff
FLUSHBUFF();
// 1146 %end
return;
} /* end of SPECINITPROC */
// 1147
// 1148 %routine PLUG PSECTS
void PLUGPSECTS(void) {
// 1149 buff == glapp; select (12); ! plug things into gla
BUFF = (struct PSECTFM *)/*?*/ &GLAPP;
SELECT(12);
// 1150 ! code psect base
// 1151 need (50)
NEED(50);
// 1152 stpb (codep, 4); add (tir stold)
STPB(/*?*/ &CODEP, 4);
ADD(25);
// 1153 ga = ga + 4
*GA = *GA + 4;
// 1154 ! diags psect base
// 1155 %if diags # 0 %start
if (DIAGS == 0) goto L_00A0;
// 1156 stpb (diagp, 4)
STPB(/*?*/ &DIAGP, 4);
// 1157 %else
goto L_00A1;
L_00A0:;
// 1158 stak (4)
STAK(4);
// 1159 %finish
L_00A1:;
// 1160 add (tir stold)
ADD(25);
// 1161 ga = ga + 4
*GA = *GA + 4;
// 1162 ! lines psect base
// 1163 %if ldump # 0 %start
if (LDUMP == 0) goto L_00A2;
// 1164 stpb (linep, 4)
STPB(/*?*/ &LINEP, 4);
// 1165 %else
goto L_00A3;
L_00A2:;
// 1166 stak (4)
STAK(4);
// 1167 %finish
L_00A3:;
// 1168 add (tir stold)
ADD(25);
// 1169 ga = ga + 4
*GA = *GA + 4;
// 1170 start immed (10)
STARTIMMED(10);
// 1171 addw (0); ! null string
ADDW(0);
// 1172 addl (proc tab(1)_diag ep)
ADDL(PROCTAB[0].DIAGEP);
// 1173 addl (event base)
ADDL(EVENTBASE);
// 1174 end immed
ENDIMMED();
// 1175 buff == codep; select (evp)
BUFF = (struct PSECTFM *)/*?*/ &CODEP;
SELECT(EVP);
// 1176 stak (0); add (tir stol)
STAK(0);
ADD(22);
// 1177 %if diags # 0 %start
if (DIAGS == 0) goto L_00A4;
// 1178 buff == diagp; select (diag size)
BUFF = (struct PSECTFM *)/*?*/ &DIAGP;
SELECT(DIAGSIZE);
// 1179 start immed (2); addw (0); end immed
STARTIMMED(2);
ADDW(0);
ENDIMMED();
// 1180 %finish
L_00A4:;
// 1181 %end
return;
} /* end of PLUGPSECTS */
// 1182
// 1183 %routine DUMP EOM
void DUMPEOM(void) {
// 1184 set work (obj eom)
SETWORK(3);
// 1185 add (0); ! Successful compilation
ADD(0);
// 1186 %if entry tag >= 0 %start
if (ENTRYTAG < 0) goto L_00A5;
// 1187 add (0)
ADD(0);
// 1188 addl (def(entry tag)_ca)
ADDL(DEF[ENTRYTAG].CA);
// 1189 %finish
L_00A5:;
// 1190 flush buff
FLUSHBUFF();
// 1191 %end
return;
} /* end of DUMPEOM */
// 1192
// 1193 %routine FLUSH BUFFERS
void FLUSHBUFFERS(void) {
// 1194 buff == codep; flush buff
BUFF = (struct PSECTFM *)/*?*/ &CODEP;
FLUSHBUFF();
// 1195 buff == glapp; flush buff
BUFF = (struct PSECTFM *)/*?*/ &GLAPP;
FLUSHBUFF();
// 1196 buff == diagp; flush buff
BUFF = (struct PSECTFM *)/*?*/ &DIAGP;
FLUSHBUFF();
// 1197 buff == linep; flush buff
BUFF = (struct PSECTFM *)/*?*/ &LINEP;
FLUSHBUFF();
// 1198 buff == workp; flush buff
BUFF = (struct PSECTFM *)/*?*/ &WORKP;
FLUSHBUFF();
// 1199 %end
return;
} /* end of FLUSHBUFFERS */
// 1200
// 1201 %routine REPORT INFO
void REPORTINFO(void) {
// 1202 %integer stream
int STREAM;
// 1203 %for stream = report, listing-report, listing %cycle
// %for STREAM = 0, 2 - 0, 2 %cycle
{
int _increment = 2 - 0;
if (invalid_for_loop(0, _increment, 2)) _imp_signal(5, 1, 0, "Illegal cycle STREAM = 0, 2 - 0, 2");
STREAM = 0 - _increment;
L_00A6:
if (STREAM == 2) goto L_00A7;
STREAM += _increment;
// 1204 %continue %if clog = 0 %and stream = report
if (CLOG != 0) goto L_00A9;
if (STREAM != 0) goto L_00A9;
goto L_00A8;
L_00A9:;
// 1205 select output (stream)
_imp_SELECTOUTPUT(STREAM);
// 1206 print string ("Code"); write (codep_max-4, 1)
_imp_PRINTSTRING(_imp_str_literal("Code"));
_imp_WRITE(CODEP.MAX - 4, 1);
// 1207 print string (" bytes Glap"); write (glapp_max, 1)
_imp_PRINTSTRING(_imp_str_literal(" bytes Glap"));
_imp_WRITE(GLAPP.MAX, 1);
// 1208 print string (" bytes Diags"); write (diagp_max+linep_max, 1)
_imp_PRINTSTRING(_imp_str_literal(" bytes Diags"));
_imp_WRITE(DIAGP.MAX + LINEP.MAX, 1);
// 1209 print string (" bytes Total size")
_imp_PRINTSTRING(_imp_str_literal(" bytes Total size"));
// 1210 write (codep_max-4+glapp_max+diagp_max+linep_max, 1)
_imp_WRITE(CODEP.MAX - 4 + GLAPP.MAX + DIAGP.MAX + LINEP.MAX, 1);
// 1211 print string (" bytes"); newline
_imp_PRINTSTRING(_imp_str_literal(" bytes"));
_imp_NEWLINE();
// 1212 %repeat
L_00A8:;
goto L_00A6;
}
L_00A7:;
// 1213 %end
return;
} /* end of REPORTINFO */
// 1214
// 1215 %routine TIME (%routine R, %string(15) name)
void TIME(void (*R)(void), _imp_string15 NAME) {
// 1216 %external %integer %function %spec PAGEFAULTS
extern int PAGEFAULTS(void);
// 1217 %integer t, p
int T;
int P;
// 1218 %own %integer called = 0
static int CALLED = 0;
// 1219 p = page faults; t = cputime
P = PAGEFAULTS();
T = CPUTIME();
// 1220 R
R();
// 1221 t = cputime - t; p = pagefaults - p
T = CPUTIME() - T;
P = PAGEFAULTS() - P;
// 1222 %return %if timing = 0
if (TIMING != 0) goto L_00AA;
return;
L_00AA:;
// 1223 select output (report)
_imp_SELECTOUTPUT(0);
// 1224 print string ("Pass 3 breakdown:") %and newline %if called = 0
if (CALLED != 0) goto L_00AB;
_imp_PRINTSTRING(_imp_str_literal("Pass 3 breakdown:"));
_imp_NEWLINE();
L_00AB:;
// 1225 called = 1
CALLED = 1;
// 1226 spaces (3)
_imp_SPACES(3);
// 1227 print string (name); print symbol (':')
_imp_PRINTSTRING(
*({
__typeof__(_imp_string15) tmp = NAME /*q*/;
(_imp_string255 *)&tmp;
})
);
_imp_PRINTSYMBOL(58);
// 1228 spaces (15-length(name)); space
_imp_SPACES(15 - *_imp_LENGTH((_imp_string255 *)/*p*/ /*?*/ &NAME));
_imp_SPACE();
// 1229 %if t >= 20 %start
if (T < 20) goto L_00AC;
// 1230 write (t, -5); print string ("ms, ")
_imp_WRITE(T, -5);
_imp_PRINTSTRING(_imp_str_literal("ms, "));
// 1231 %else
goto L_00AD;
L_00AC:;
// 1232 print string ("negligible, ")
_imp_PRINTSTRING(_imp_str_literal("negligible, "));
// 1233 %finish
L_00AD:;
// 1234 write (p, -3); print string (" page fault")
_imp_WRITE(P, -3);
_imp_PRINTSTRING(_imp_str_literal(" page fault"));
// 1235 print symbol ('s') %if p # 1
if (P == 1) goto L_00AE;
_imp_PRINTSYMBOL(115);
L_00AE:;
// 1236 newline
_imp_NEWLINE();
// 1237 select output (object file)
_imp_SELECTOUTPUT(1);
// 1238 %end
return;
} /* end of TIME */
// 1239
// 1240 ! MAIN CODE
// 1241
// 1242 initialise
INITIALISE();
// 1243 time (input directives, "Directive input")
TIME(INPUTDIRECTIVES, _imp_str_literal_size(15, "Directive input"));
// 1244 time (stretch jumps, "Jump stretching")
TIME(STRETCHJUMPS, _imp_str_literal_size(15, "Jump stretching"));
// 1245 dump module header
DUMPMODULEHEADER();
// 1246 define psects
DEFINEPSECTS();
// 1247 spec init proc
SPECINITPROC();
// 1248 time (dump all code, "Code dumping")
TIME(DUMPALLCODE, _imp_str_literal_size(15, "Code dumping"));
// 1249 plug psects
PLUGPSECTS();
// 1250 flush buffers
FLUSHBUFFERS();
// 1251 dump eom
DUMPEOM();
// 1252 report info
REPORTINFO();
// 1253
// 1254 %end
return;
} /* end of PASS3 */
// ?OBJDBG unused
// ?TIRSTOGB unused
// ?TIRSTOW unused
// ?TIRSTOB unused
// ?SAFEHIGH unused
// ?SAFELOW unused
// ?PIC unused
// 1255
// 1256 %BEGIN
int main(int argc, char **argv) { /*%begin*/
_imp_initialise(argc, argv);
// 1257 %END
_imp_stop(0);
return 0;
end_0:;
}
// 1258
// 1259 %end %of %file