|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 244992 (0x3bd00)
Types: TextFile
Names: »list1«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »list1«
82.01.12. 12.40. pascal version 1980.06.17
1 (*$L+*)
2 (* M20 *)
3 (* COPYRIGHTED 1980 BY MOTOROLA, INC. *)
4 PROGRAM DIRECT(OUTPUT,PCODE,OBJECT,LISTING);
5 (* AUGUST 7, 1980 *)
6 (* GENERATES S-RECORDS *)
7 (* 370 VERSION *)
8 (* LONG ADDRESSES *)
9 (* DIRECT CODE VERSION *)
10 (* 01/08/82 @ REPLACED BY ^ *
11 * (. REPLACED BY Æ *
12 * .) REPLACED BY Å *
13 * EXTERNAL REPLACED BY XEXTERNAL *
14 * FILE OF CHAR REPLACED BY TEXT *
15 * HENRIK JACOBSEN HC *)
16 CONST STRLENGTH = 64;
17 LINELNGTH = 133;
18 BITSPERDIGIT = 8;
19 LDIGIT = 3;
20 TOPDIGIT = 255;
21 MAXDIGIT = 256;
22 MAXLABEL = 400;
23 MAXCORE = 1044;
24 STKMAX = 32;
25 NDREGS = 5; NAREGS = 3; (*NBR OF REGS TO BE ALLOCATED FOR STACK*)
26
27
28 TYPE OPTYPS = (OP0, OPLI, OPT, OP2T, OPTI, OPT2I, OPI, OPTLI,
29 OP3I, OPTL2I, OPTL, OPENT, OPENTB, OPTV, OPLAB, ENDOP);
30
31 PCODES=(XAB, XAD, XAFI, XAND, XARG,
32 XAST, XATN, XCHK, XCHKF, XCLO, XCOS, XCSP,
33 XCSPF,XCUP, XCUPF,XCVB, XCVT, XDAS, XDATA,XDATB,XDEC, XDEF, XDIF,
34 XDIS, XDV, XEIO, XEND, XENT, XENTB,XEOF, XEOL, XEQU, XEXI, XEXP,
35 XEXT, XFJP, XGEQ, XGET, XGRT, XIFD, XINC, XIND, XINN, XINS, XINT,
36 XIOR, XISC, XIXA, XLAB, XLCA, XLDA, XLDC, XLEQ, XLES, XLOD, XLOG,
37 XLSC, XLSPA,XLTA, XLUPA,XMOD, XMOV, XMOVV,XMP, XMRK, XMST, XNEQ,
38 XNEW, XNG, XNOT, XODD, XPAG, XPEE, XPOK, XPOS, XPUT, XRDB, XRDC,
39 (*604*) XRDE, XRDH, XRDI, XRDJ, XRDQ, XRDR, XRDS, XRDV, XRET, XRLN, XRLS, XRND,
40 XRST, XRWT, XSB, XSCON,XSCOP,XSDEL,XSEE, XSGS, XSIN, XSINS,XSLEN,
41 (*RM*) XSPOS,XSQR, XSQT, XSTO, XSTP, XSTR, XTRC, XUJP, XUNI, XVJP, XWLN, XWRB,
42 (*604*) XWRC, XWRE, XWRH, XWRI, XWRJ, XWRQ, XWRR, XWRS, XWRV, XXJP, XSTC, XNONE,
43 XINDV, XLODV, XSTRV, XSTOV, XEQUV, XNEQV, XLESV, XLEQV,
44 XGRTV, XGEQV, XCVTSU, XCVTUS, XLDCV);
45
46 MNS = XAB .. XNONE;
47
48 TARGETOP = (TMOVE, TLINK, TUNLK, TRTS , TTST, TBGT, TNEG, TSUBQ,
49 TBTST, TSNZ, TADD, TSUB, TAND, TOR, TMULS, TDIVS,
50 TCMP, TCLR, TTRAP, TDCNT, TBSR, TADDQ,TCOMP, TLBSR,
51 TMOVEQ,TSEQ, TSNE, TSLT, TSLE, TSGT, TSGE, TLEA ,
52 TLBGT, TLBRA, TLBNE, TLBEQ, TLBLT, TASL, TBLT, TJMP,
53 (*RM*) TPEA, TBSET, TBZ, TSWAP, TCMPM, TJSR,
54 TBNZ, TBGE, TBLE, TCHK, TLBLE, TLBGE,
55 (*RM*) TLDQ, TEXTE, TBRA, TBNE, TEQU, TBEQ, TEOR, TDC );
56
57 DATATYPE = (ATYP,ITYP,JTYP,RTYP,QTYP,VTYP,STYP,BTYP,
58 (*RM*) PTYP,NOTATYP,CTYP,HTYP,UTYP);
59
60 MESSAGE = PACKED ARRAYÆ1..15Å OF CHAR;
61 ERRORMESSAGE = PACKED ARRAYÆ1..20Å OF CHAR;
62
63
64
65 IPTR = ^INSTRUCTION;
66 INSTRUCTION = RECORD INUSE : BOOLEAN;
67 NEXT : IPTR;
68 (*PREV : IPTR;*)
69 OPCODE: MNS;
70 OPTYPE: OPTYPS;
71 DTYPE,D1TYPE: DATATYPE;
72 OPAND1: INTEGER;
73 OPAND2: INTEGER;
74 OPAND3: INTEGER;
75 OPAND4: INTEGER;
76 OPSTRING: ^VSTRINGV;
77 (*RM*) OPSET: ^SETR
78 END;
79
80 VSTRINGV = RECORD STRINGL: 0..STRLENGTH;
81 VSTRINGA: PACKED ARRAY Æ 1..STRLENGTHÅ OF CHAR
82 END;
83
84
85 LINT = ARRAY Æ0..LDIGITÅ OF INTEGER; (*MULTIPLE PRECISION*)
86
87 ADDRESS = LINT; (*SHOULD BE "RECORD BYTE1,BYTE2,BYTE3:0..255 END"*)
88
89 LABELREF = RECORD CORELOC: ADDRESS;
90 NEXT: ^LABELREF
91 END;
92
93 LABL = RECORD LOCATION: ADDRESS;
94 DEFINED: BOOLEAN;
95 REFED: BOOLEAN;
96 REFCHAIN: ^LABELREF;
97 END;
98 LABTABLE = ARRAYÆ0..MAXLABELÅ OF LABL;
99
100 ESD = RECORD NAME: MNS; (*XEXTERNAL SYMBOL DEFINITION LIST*)
101 REFERENCE: ADDRESS;
102 NEXT: ^ESD
103 END;
104
105 EAMODE = (NONE,DDIRECT,ADIRECT,DEFER,INCR,DECR,
106 (*RM*) BASED,INDEX, PCINDEX, STSHORT,
107 RELATIVE,XEXTERNAL,LABELLED, LABIMMED,
108 (*RM*) PIMMED,
109 LIMMED,
110 (*RM*) IMMED,ABSOLUTE,STLONG); (* THIS ORDER IS IMPORTANT *)
111
112 REGISTER = (DNONE,D0,D1,D2,D3,D4,D5,D6,D7,
113 ANONE,A0,A1,A2,A3,A4,A5,A6,A7);
114
115 REGKIND = (AREG, DREG);
116
117 EFFADDR = RECORD MODE: EAMODE;
118 REG: REGISTER;
119 XREG: REGISTER;
120 DISPL: INTEGER
121 END;
122
123 (*RM*) SETR = RECORD
124 (*RM*) SETV: PACKED ARRAYÆ1..16Å OF CHAR
125 (*RM*) END;
126
127 VAR
128 DEBUG: INTEGER; (*DIAGNOTSIC FLAG *)
129 CHANGED: BOOLEAN;
130 ASCII: ARRAYÆCHARÅ OF INTEGER;
131 C: CHAR;
132 ERRORWR: BOOLEAN;
133 LISTING: TEXT;
134 PCODE: TEXT;
135 OBJECT: TEXT;
136 CHCNT,LINELEN: 1..LINELNGTH;
137 LINEBUF: ARRAYÆ1..LINELNGTHÅ OF CHAR;
138 LINECOUNT: INTEGER;
139 MACHINDEX: INTEGER;
140
141 SIZE: ARRAYÆDATATYPEÅ OF INTEGER;
142 (*RM*) DNAME: PACKED ARRAYÆDATATYPEÅ OF CHAR;
143 LONGTYPES: SET OF DATATYPE; (* = ÆPTYP,VTYP,STYPÅ*)
144
145 (*RM*) LASTLABEL: INTEGER; (* LABEL OF LAST LABELLED PCODE *)
146
147 FIRSTI, LASTI, CURRI, OPTIMI, TEMPI : IPTR;
148 (*480*) FAKEI: IPTR; (* DUMMY PCODE *)
149 OPTIM2,OPTIM3,OPTIM4,OPTIM5 : IPTR;
150 CURROPCODE: MNS; CURROPTYPE: OPTYPS;
151
152 TEMPLEVEL: INTEGER; (*LEVEL OF DISPLAY VECTOR CURRENTLY IN A4*)
153 COMMUTATIVE, SWITCH: BOOLEAN;
154
155 OPSYM: PACKED ARRAYÆ1..4Å OF CHAR;
156 MACHCODE: PACKED ARRAYÆ1..20Å OF CHAR;
157 VSTRING, BLANKS: PACKED ARRAYÆ1..STRLENGTHÅ OF CHAR;
158 CURRLABEL, HIGHLABEL, LABELOFFSET, DEFVALUE: INTEGER;
159 TOPLABEL : INTEGER;
160 LABELED, DOLLAR, ABSOL: BOOLEAN;
161 LEVEL, ALENGTH: INTEGER;
162 FLPC: BOOLEAN;
163
164 FMN: ARRAYÆ'A'..'Z'Å OF MNS;
165 MN: ARRAYÆMNSÅ OF PACKED ARRAYÆ1..4Å OF CHAR;
166 OT: ARRAYÆMNSÅ OF OPTYPS;
167 SUBTYPE: ARRAYÆMNSÅ OF 0..255;
168 RT: ARRAYÆPCODESÅ OF INTEGER; (* ADDRESSES OF RUNTIME ROUTINES*)
169 FL: ARRAYÆMNSÅ OF BOOLEAN;
170 TMN: ARRAYÆTARGETOPÅ OF PACKED ARRAYÆ1..5Å OF CHAR;
171
172 LABELTABLE, PROCTABLE: LABTABLE;
173
174 PC: ADDRESS;
175 LTEMP: LINT; (* TEMPORARY FOR LONG ARITHMETIC *)
176 CORE: ARRAYÆ1..MAXCOREÅ OF INTEGER;
177 GENLOC: LINT; (* CURRENT CODEGEN ADDRESS *)
178 GENSTART: LINT; (* FIRST ADDRESS OF CODE *)
179 GENSAVE: LINT; (*TEMP TO SAVE GENLOC *)
180 EXPROC: ADDRESS; (* SLOT TO STORE JUMP TO DISTANT PROC IN *)
181 CORECOUNT: 0..MAXCORE;
182 CORESAVE: 0..MAXCORE;
183 LOCOUNT: 0..MAXCORE;
184 MAINFLG: BOOLEAN; (* MAIN PROGRAM ENCOUNTERED *)
185 COREBASE: ADDRESS;
186 PROGSTART: ADDRESS;
187 RTJUMP: ADDRESS; (* START OF RUNTIME JUMP TABLE *)
188 STKSTART: ADDRESS; (* START OF STACK *)
189 HEAPSTART: ADDRESS; (* START OF HEAP *)
190 JTSIZE: INTEGER; (* NUMBER OF JUMP TABLE ELEMENTS *)
191
192 FIRSTESD: ^ESD;
193
194 SP: REGISTER;
195 DALLOC,AALLOC: 0..8;
196 DTOP,DBOT: DNONE..D7;
197 ATOP,ABOT: ANONE..A7;
198 (*REGISTER ALLOCATION VARIABLES*)
199 (*VALUE OF -1 MEANS NONE CURRENTLY ASSIGNED*)
200
201 REGTYPE: ARRAYÆREGISTERÅ OF DATATYPE;
202 TYPESTK: ARRAYÆ-1..STKMAXÅ OF DATATYPE;
203 KINDSTK: ARRAYÆ-1..STKMAXÅ OF REGKIND;
204 STKPTR: -1..STKMAX;
205
206 DREGS: ARRAYÆ0..NDREGSÅ OF REGISTER;
207 AREGS: ARRAYÆ0..NAREGSÅ OF REGISTER;
208
209 EADDIR, EAADIR, EAPOP, EAPUSH, EAIMMED, EAINCR,
210 (*RM*) EALIMM, EAREL, EALAB, EAPSET, EALONG,
211 EABASED, EANONE, EADEFER: EFFADDR;
212
213 AALLOCCNT, DALLOCCNT, DPUSHCNT, APUSHCNT, DPOPCNT, APOPCNT: INTEGER;
214 TEMPESD: ^ESD;
215 TEMPLABREF: ^LABELREF;
216
217 (*RM*) HEXDATA: PACKED ARRAYÆ1..16Å OF CHAR;
218
219 FUNCTION SUCCIBM(CH:CHAR):CHAR; (* HANDLES EBCDIC ALPHABET *)
220 0 BEGIN
221 1 IF CH = 'I' THEN SUCCIBM := 'J'
222 2 ELSE IF CH ='R' THEN SUCCIBM := 'S'
223 3 ELSE SUCCIBM := SUCC(CH)
224 END (* SUCCIBM *) ;
225
226
227 FUNCTION HEXBIN(I: INTEGER): INTEGER; (* CONVERT HEX CHAR TO BINARY *)
228 0 BEGIN
229 1 IF I >= 65
230 2 THEN HEXBIN := I - 55
231 3 ELSE HEXBIN := I - 48
232 END; (* HEXBIN *)
233
234 PROCEDURE ERROR(MSG: ERRORMESSAGE);
235 BEGIN ERRORWR:=TRUE;WRITELN(LISTING,'**ERROR** ',MSG) END; (* ERROR *)
236
237 (*480*) FUNCTION NEXTPCOD (PCODE: IPTR) : IPTR;
238 (*480*) (* GIVEN A PCODE, FIND NEXT ACTIVE ONE; IF NONE, RETURN FAKE ONE *)
239 0 (*480*) BEGIN
240 1 (*480*) REPEAT
241 2 (*480*) PCODE := PCODE^.NEXT;
242 3 (*480*) IF PCODE = NIL THEN PCODE := FAKEI
243 4 (*480*) UNTIL PCODE^.INUSE;
244 5 (*480*) NEXTPCOD := PCODE
245 (*480*) END; (*NEXTPCOD *)
246
247 FUNCTION CONDITIONAL(INST:IPTR):INTEGER;
248 (* IF CONDITIONAL P-CODE, RETURN NUMBER, ELSE RETURN 0 *)
249 0 BEGIN
250 1 WITH INST^ DO
251 2 BEGIN
252 3 CONDITIONAL := 0;
253 4 IF OPCODE = XNEQ THEN CONDITIONAL := 1 ELSE
254 5 IF OPCODE = XEQU THEN CONDITIONAL := 2 ELSE
255 6 IF OPCODE = XLES THEN CONDITIONAL := 3 ELSE
256 7 IF OPCODE = XLEQ THEN CONDITIONAL := 4 ELSE
257 8 IF OPCODE = XGRT THEN CONDITIONAL := 5 ELSE
258 9 IF OPCODE = XGEQ THEN CONDITIONAL := 6
259 10 END (*WITH*)
260 END; (*CONDITIONAL*)
261
262 FUNCTION GETHEX:BOOLEAN;
263 VAR I: INTEGER;
264 0 BEGIN
265 1 GETHEX := FALSE;
266 2 WHILE (LINEBUFÆCHCNTÅ=' ') AND (CHCNT<LINELEN) DO CHCNT := CHCNT + 1;
267 3 IF LINEBUFÆCHCNTÅ <> ' '
268 4 THEN BEGIN
269 5 GETHEX := TRUE;
270 6 FOR I := 0 TO 3 DO
271 7 BEGIN
272 8 LTEMPÆIÅ := 16 * HEXBIN(ASCIIÆLINEBUFÆCHCNTÅÅ) +
273 9 HEXBIN(ASCIIÆLINEBUFÆCHCNT + 1ÅÅ);
274 10 CHCNT := CHCNT + 2
275 11 END
276 12 END;
277 13 IF LINEBUFÆCHCNTÅ <> ' ' THEN GETHEX := FALSE;
278 END ; (*GETHEX*)
279
280 PROCEDURE GETSTRING;
281 0 BEGIN
282 1 WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
283 2 CHCNT := CHCNT + 1;
284 3 IF LINEBUFÆCHCNTÅ <> '''' THEN
285 4 BEGIN ERROR('STRING EXPECTED ');
286 5 VSTRING := BLANKS END
287 6 ELSE BEGIN
288 7 ALENGTH := 0;
289 8 REPEAT
290 9 REPEAT
291 10 CHCNT := CHCNT + 1;
292 11 ALENGTH := ALENGTH + 1;
293 12 IF ALENGTH <= STRLENGTH THEN
294 13 VSTRINGÆALENGTHÅ := LINEBUFÆCHCNTÅ;
295 14 UNTIL (LINEBUFÆCHCNTÅ = '''') OR (CHCNT = LINELEN);
296 15 CHCNT := CHCNT + 1
297 16 UNTIL LINEBUFÆCHCNTÅ <> '''';
298 17 IF ALENGTH > STRLENGTH
299 18 THEN ALENGTH := STRLENGTH
300 19 ELSE ALENGTH := ALENGTH - 1;
301 20 END
302 END; (*GETSTRING*)
303
304 FUNCTION GETINTEGER :INTEGER;
305 VAR I: INTEGER;
306 CH: CHAR;
307 MINUS: BOOLEAN;
308 0 BEGIN
309 1 WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
310 2 CHCNT := CHCNT + 1;
311 3 I := 0;
312 4 MINUS := LINEBUFÆCHCNTÅ = '-';
313 5 IF MINUS THEN CHCNT := CHCNT + 1;
314 6 WHILE (LINEBUFÆCHCNTÅ <> ' ') AND (CHCNT < LINELEN) DO
315 7 BEGIN
316 8 CH := LINEBUFÆCHCNTÅ;
317 9 IF (CH >= '0') AND (CH <= '9')
318 10 THEN I := I*10 + ORD(CH)-ORD('0')
319 11 (*RM*) ELSE IF LINEBUFÆCHCNTÅ <> ',' THEN ERROR('MALFORMED INTEGER ');
320 12 CHCNT := CHCNT + 1
321 13 END;
322 14 IF MINUS THEN GETINTEGER := -1*I ELSE GETINTEGER := I
323 END; (*GETINTEGER*)
324
325
326 PROCEDURE BUILDADDR (VAR ADDR: EFFADDR; KMODE: EAMODE;
327 KREG, KXREG: REGISTER; KDISPL: INTEGER);
328 0 BEGIN WITH ADDR DO BEGIN
329 1 MODE := KMODE;
330 2 REG := KREG;
331 3 XREG := KXREG;
332 4 DISPL:= KDISPL
333 END END; (*BUILDADDR*)
334
335 (*----------------------------------------------------------------------
336 MULTIPLE PRECISION ARITHMETIC ROUTINES
337 -----------------------------------------------------------------------*)
338
339
340 PROCEDURE PLINT(VAR FIL:TEXT; X:LINT); (* WRITE LONG VALUE *)
341 VAR I: INTEGER;
342 0 BEGIN
343 1 FOR I := 0 TO LDIGIT DO
344 2 WRITE(FIL,HEXDATAÆ(XÆIÅ DIV 16) + 1Å:1,
345 3 HEXDATAÆ(XÆIÅ MOD 16) + 1Å:1);
346 END; (*PLINT*)
347
348 FUNCTION SDV(VAR X: LINT; S: INTEGER): INTEGER; (*DIVIDE LONG BY INTEGER *)
349 (* X := X / S (UNSIGNED) *)
350 VAR
351 I, CARRY: INTEGER;
352 Z: LINT;
353 0 BEGIN
354 1 FOR I := LDIGIT DOWNTO 0 DO ZÆIÅ := 0;
355 2 IF S > 0 THEN
356 3 BEGIN
357 4 CARRY := 0;
358 5 FOR I := 0 TO LDIGIT DO
359 6 BEGIN
360 7 CARRY := CARRY * MAXDIGIT + XÆIÅ;
361 8 WHILE CARRY >= S DO
362 9 BEGIN
363 10 ZÆIÅ := ZÆIÅ + 1;
364 11 CARRY := CARRY - S;
365 12 END;
366 13 END;
367 14 END;
368 15 FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := ZÆIÅ;
369 16 SDV := CARRY;
370 END; (*SDV*)
371
372 FUNCTION SHORT(VAR X:LINT):BOOLEAN; (* DETERMINE IF LINT IS SHORT*)
373 VAR
374 I: INTEGER;
375 0 BEGIN
376 1 SHORT := FALSE;
377 2 IF ((XÆ0Å=0) AND (XÆ1Å=0) AND (XÆ2Å<128))
378 3 OR ((XÆ0Å=255) AND (XÆ1Å=255) AND (XÆ2Å>127))
379 4 THEN SHORT := TRUE
380 END; (*SHORT*)
381
382
383 PROCEDURE CLR(VAR X: LINT); (* CLEAR LONG VALUE *)
384 (* X := 0 *)
385 VAR
386 I: INTEGER;
387 0 BEGIN
388 1 FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := 0;
389 END; (*CLR*)
390
391 PROCEDURE LSB(VAR X: LINT; Y: LINT); (* SUBTRACT LONG FROM LONG *)
392 VAR
393 I, B: INTEGER;
394 0 BEGIN
395 1 B := 0; (* SET BORROW TO 0 *)
396 2 FOR I := LDIGIT DOWNTO 0 DO
397 3 BEGIN
398 4 XÆIÅ := XÆIÅ - YÆIÅ - B;
399 5 B := 0; (* RESET CARRY *)
400 6 IF XÆIÅ < 0
401 7 THEN
402 8 BEGIN
403 9 XÆIÅ := XÆIÅ + 256;
404 10 B := 1
405 11 END (*THEN*)
406 12 END (*FOR*)
407 END; (*LSB*)
408
409
410 PROCEDURE SSB(VAR X: LINT; S: INTEGER); FORWARD;
411
412 PROCEDURE SAD(VAR X: LINT; S: INTEGER); (* ADD INTEGER TO LONG *)
413 (* X := X + S *)
414 VAR
415 I,CARRY: INTEGER;
416 Z: LINT;
417 0 BEGIN
418 1 IF S < 0
419 2 THEN SSB(X, -S)
420 3 ELSE
421 4 BEGIN
422 5 CARRY := S;
423 6 FOR I := LDIGIT DOWNTO 0 DO
424 7 BEGIN
425 8 ZÆIÅ := XÆIÅ + CARRY;
426 9 IF ZÆIÅ > TOPDIGIT
427 10 THEN
428 11 BEGIN
429 12 CARRY := ZÆIÅ DIV MAXDIGIT;
430 13 ZÆIÅ := ZÆIÅ MOD MAXDIGIT;
431 14 END
432 15 ELSE CARRY := 0;
433 16 END;
434 17 FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := ZÆIÅ;
435 18 END
436 END; (*SAD*)
437
438 PROCEDURE SSB(* (VAR X: LINT; S: INTEGER) *); (* SUBTRACT INTEGER FROM LONG *)
439 (* X := X - S *)
440 VAR
441 I,BORROW: INTEGER;
442 Z: LINT;
443 0 BEGIN
444 1 (*0321D*) IF (S<0) AND (-S > 0) (* CHECKS FOR -32768 *)
445 2 THEN SAD(X, -S)
446 3 ELSE
447 4 BEGIN
448 5 BORROW := S;
449 6 FOR I := LDIGIT DOWNTO 0 DO
450 7 BEGIN
451 8 ZÆIÅ := XÆIÅ - BORROW;
452 9 IF ZÆIÅ < 0
453 10 THEN
454 11 BEGIN
455 12 BORROW := - (ZÆIÅ DIV MAXDIGIT);
456 13 ZÆIÅ := ZÆIÅ MOD MAXDIGIT;
457 14 IF ZÆIÅ < 0
458 15 THEN
459 16 BEGIN
460 17 BORROW := BORROW + 1;
461 18 ZÆIÅ := ZÆIÅ + MAXDIGIT;
462 19 END; (*BEGIN*)
463 20 END (*THEN*)
464 21 ELSE BORROW := 0;
465 22 END; (*FOR*)
466 23 FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := ZÆIÅ;
467 24 END (*ELSE*)
468 END; (*SSB*)
469
470 PROCEDURE LASGN(VAR X: INTEGER; Y: LINT); (* MOVE LONG TO SHORT*)
471 VAR
472 I, J: INTEGER;
473 0 BEGIN
474 1 J := YÆLDIGIT -1Å;
475 2 IF J > 127 THEN J := J - 256;
476 3 X := 256 * J + YÆLDIGITÅ
477 END; (* LASGN *)
478
479 PROCEDURE ASGN(VAR X: LINT; Y: LINT); (* MOVE LONG TO LONG *)
480 (* X := Y *)
481 0 BEGIN
482 1 X := Y;
483 END; (*ASGN*)
484
485 PROCEDURE SASGN(VAR X: LINT; Y: INTEGER); (* MOVE INTEGER TO LONG *)
486 (* X := LINT Y *)
487 VAR
488 I: INTEGER;
489 0 BEGIN
490 1 CLR(X);
491 2 IF Y > 0
492 3 THEN SAD(X,Y)
493 4 ELSE IF Y < 0
494 5 THEN SSB(X,-Y);
495 END; (*ASGN*)
496
497 PROCEDURE SHL(VAR X: LINT; S: INTEGER); (* SHIFT LONG LEFT INTEGER TIMES*)
498 (* X := X SHIFTED LEFT BY S BITS *)
499 VAR
500 I,J,CARRY: INTEGER;
501 Z: LINT;
502 0 BEGIN
503 1 FOR I := LDIGIT DOWNTO 0 DO ZÆIÅ := XÆIÅ;
504 2 FOR J := 1 TO S DIV BITSPERDIGIT DO
505 3 BEGIN
506 4 FOR I := 0 TO LDIGIT - 1 DO ZÆIÅ := ZÆI + 1Å;
507 5 ZÆLDIGITÅ := 0;
508 6 END;
509 7 FOR J := 1 TO S MOD BITSPERDIGIT DO
510 8 BEGIN
511 9 CARRY := 0;
512 10 FOR I := LDIGIT DOWNTO 0 DO
513 11 BEGIN
514 12 ZÆIÅ := 2 * ZÆIÅ + CARRY;
515 13 IF ZÆIÅ > TOPDIGIT
516 14 THEN
517 15 BEGIN
518 16 ZÆIÅ := ZÆIÅ - MAXDIGIT;
519 17 CARRY := 1;
520 18 END (*THEN*)
521 19 ELSE CARRY := 0;
522 20 END (*FOR*)
523 21 END; (*FOR*)
524 22 FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := ZÆIÅ;
525 END; (*SHL*)
526
527
528
529
530
531 (*-------------------------------------------------------------------------
532 CODE GENERATION SECTION
533 -------------------------------------------------------------------------*)
534
535 (*604*) PROCEDURE PCPRINT;
536 0 (*604*) BEGIN
537 1 (*604*) IF ODD(DEBUG)
538 2 (*604*) THEN
539 3 (*604*) BEGIN
540 4 (*604*) PLINT(LISTING,PC);
541 5 (*604*) WRITE(LISTING,' ':21)
542 6 (*604*) END
543 (*604*) END; (* PCPRINT*)
544
545 PROCEDURE EMITCODE;
546 VAR
547 II, I, J, HI, MD, LO, CHKSUM: INTEGER;
548 SAVE: LINT;
549
550 PROCEDURE EMITBYTE(DATA: INTEGER); (*EXPAND BYTE INTO TWO HEX DIGITS*)
551 VAR
552 HI, LO: INTEGER;
553 CH: CHAR;
554 0 BEGIN (*EMITBYTE*)
555 1 CHKSUM := CHKSUM + DATA;
556 2 HI := DATA DIV 16;
557 3 LO := DATA MOD 16;
558 4 IF HI < 10
559 5 THEN CH := CHR(ORD('0') + HI)
560 6 ELSE CH := CHR(ORD('A') + HI - 10);
561 7 WRITE(OBJECT,CH);
562 8 IF LO < 10
563 9 THEN CH := CHR(ORD('0') + LO)
564 10 ELSE CH := CHR(ORD('A') + LO - 10);
565 11 WRITE(OBJECT,CH);
566 END; (*EMITBYTE*)
567
568 0 BEGIN (*EMITCODE*)
569 1 IF (CORECOUNT>0)
570 2 THEN
571 3 BEGIN
572 4 I := LOCOUNT;
573 5 WHILE I <= CORECOUNT DO
574 6 BEGIN
575 7 CHKSUM := 0;
576 8 IF CORECOUNT - I >= 31
577 9 THEN J := I + 31
578 10 ELSE J := CORECOUNT;
579 11 ASGN(SAVE,GENLOC);
580 12 (* LO := GENLOCÆLDIGITÅ; *)
581 13 (* MD := GENLOCÆLDIGIT-1Å; *)
582 14 (* HI := GENLOCÆLDIGIT-2Å; *)
583 15 LO := SDV(GENLOC,256);
584 16 MD := SDV(GENLOC,256);
585 17 HI := SDV(GENLOC,256);
586 18 ASGN(GENLOC,SAVE);
587 19 IF HI = 0
588 20 THEN BEGIN
589 21 WRITE(OBJECT,'S1');
590 22 EMITBYTE(J-I+4)
591 23 END
592 24 ELSE BEGIN
593 25 WRITE(OBJECT,'S2');
594 26 EMITBYTE(J-I+5)
595 27 END;
596 28 IF HI <> 0
597 29 THEN EMITBYTE(HI);
598 30 EMITBYTE(MD);
599 31 EMITBYTE(LO); (* EMIT ADDRESS FIELD *)
600 32 FOR II := I TO J DO
601 33 BEGIN
602 34 IF (COREÆIIÅ < 0) OR (COREÆIIÅ > 256)
603 35 THEN
604 36 BEGIN
605 37 ERROR('BAD EMIT DATA ');
606 38 WRITELN(LISTING,'VALUE ',COREÆIIÅ,' AT ',II,
607 39 ' PC=') ;
608 40 PLINT(LISTING,PC)
609 41 END; (*THEN*)
610 42 EMITBYTE(COREÆIIÅ);
611 43 END; (*FOR*)
612 44 EMITBYTE(255-(CHKSUM MOD 256));
613 45 WRITELN(OBJECT,' ');
614 46 SAD(GENLOC,J-I+1);
615 47 I := J + 1;
616 48 END; (*WHILE*)
617 49 CORECOUNT := 0;
618 50 IF LOCOUNT = 1 THEN COREBASE := PC;
619 51 END; (*THEN*)
620 END; (*EMITCODE*)
621
622 PROCEDURE EMITEND;
623 0 BEGIN
624 1 WRITELN(OBJECT,'S9030000FC');
625 END; (*EMITEND*)
626
627 PROCEDURE FLUSH; (*CURRENTLY CALLED AT END OF EACH BASIC BLOCK*)
628 (*I.E. ONLY LOCAL OPTIMIZATION IS BEING DONE*)
629
630 PROCEDURE GENERATE(INSTR: IPTR);
631
632 VAR SOURCE, DEST: EFFADDR;
633 TEMPESD: ^ESD;
634 K: INTEGER;
635 OPCDE: TARGETOP;
636
637 PROCEDURE RESETLABEL;
638 VAR I: INTEGER;
639 0 BEGIN
640 1 FOR I:= 0 TO HIGHLABEL DO
641 2 BEGIN LABELTABLEÆIÅ.DEFINED :=FALSE;
642 3 LABELTABLEÆIÅ.REFCHAIN := NIL;
643 4 LABELTABLEÆIÅ.REFED :=FALSE
644 5 END;
645 6 IF TOPLABEL < HIGHLABEL THEN TOPLABEL := HIGHLABEL;
646 7 (*#*) LABELOFFSET := LABELOFFSET + HIGHLABEL; HIGHLABEL := 0;
647 END;
648
649
650
651 PROCEDURE GENX(OP: TARGETOP; SIZE: INTEGER; EA1,EA2: EFFADDR); FORWARD;
652 (*RM*) PROCEDURE VSTRINGIMMED(STARTCH,COUNT: INTEGER);
653 (*RM*) VAR K: INTEGER;
654 0 (*RM*) BEGIN
655 1 WITH INSTR^ DO BEGIN
656 2 WRITE(LISTING,'''':1);
657 3 K := STARTCH;
658 4 (*RM*) WHILE K < STARTCH + COUNT DO BEGIN
659 5 EAIMMED.DISPL := ASCIIÆOPSTRING^.VSTRINGAÆKÅÅ;
660 6 GENX(TDC,1,EAIMMED,EANONE);
661 7 (*RM*) IF OPSTRING^.VSTRINGAÆKÅ = '''' THEN WRITE(LISTING,'''''':2)
662 8 (*RM*) ELSE WRITE(LISTING,OPSTRING^.VSTRINGAÆKÅ:1);
663 9 (*RM*) K := K + 1
664 10 (*RM*) END;
665 11 (*RM*) WRITE(LISTING,'''':1)
666 12 (*RM*) END (* WITH *)
667 (*RM*) END; (* VSTRINGIMMED *)
668
669 (*RM*) PROCEDURE HEXVSTRING(K:INTEGER);
670 (*RM*) VAR I:INTEGER;
671 CH:CHAR;
672 0 (*RM*) BEGIN
673 1 (*RM*) WITH INSTR^ DO BEGIN
674 2 (*RM*) FOR I := 1 TO 8 DO
675 3 BEGIN
676 4 CH:=OPSET^.SETVÆ K + 1 Å;
677 5 (*RM*) WRITE(LISTING, CH :1) ;
678 6 IF NOT ODD(I)
679 7 THEN BEGIN
680 8 EAIMMED.DISPL := 16 *
681 9 HEXBIN(ASCIIÆOPSET^.SETVÆK + I - 1ÅÅ) +
682 10 HEXBIN(ASCIIÆOPSET^.SETVÆK + IÅÅ);
683 11 GENX(TDC,1,EAIMMED,EANONE);
684 12 END; (*IF*)
685 13 (*RM*) END (*FOR*)
686 14 END; (*WITH*)
687 (*RM*) END; (* HEXVSTRING *)
688
689 PROCEDURE GENX (* (OP:TARGETOP; SIZE: INTEGER; EA1,EA2: EFFADDR) *) ;
690 VAR I, SUBOP, OPC, OPI: INTEGER;
691
692 PROCEDURE PRINTINSTRUCTION;
693 VAR BYTES: INTEGER;
694 PROCEDURE PRINTEA(EA: EFFADDR);
695 VAR AR: INTEGER;
696 0 BEGIN WITH EA DO
697 1 BEGIN
698 2 AR := ORD(REG)-ORD(A0);
699 3 CASE MODE OF
700 4 NONE: ;
701 5 DDIRECT: WRITE(LISTING, 'D',ORD(REG)-ORD(D0):1);
702 6 ADIRECT: WRITE(LISTING, 'A', AR:1);
703 7 DEFER: WRITE(LISTING, '(A', AR:1, ')');
704 8 INCR: WRITE(LISTING, '(A', AR:1,')+');
705 9 DECR: WRITE(LISTING, '-(A', AR:1,')');
706 10 BASED: WRITE(LISTING, DISPL:1, '(A', AR:1,
707 11 ')');
708 12 INDEX: WRITE(LISTING, DISPL:1,
709 13 '(A', AR:1, ',', 'D', ORD(XREG)-ORD(D0):1,')');
710 14 ABSOLUTE: WRITE(LISTING,DISPL:1);
711 15 IMMED: WRITE(LISTING,'#',DISPL:1);
712 16 RELATIVE: BEGIN
713 17 WRITE(LISTING,'*');
714 18 IF DISPL> 0 THEN
715 19 WRITE(LISTING,'+',DISPL:1)
716 20 ELSE IF DISPL< 0 THEN WRITE(LISTING,DISPL:1)
717 21 END;
718 22 LABELLED: IF CURROPCODE = XCUP
719 23 THEN WRITE(LISTING,'USER':4,DISPL:1)
720 24 ELSE WRITE(LISTING,
721 25 'L',DISPL + LABELOFFSET:1);
722 26 LABIMMED: BEGIN
723 27 IF DISPL <0 THEN WRITE(LISTING,'#-L',-DISPL:1)
724 28 ELSE WRITE(LISTING,'#L',DISPL + LABELOFFSET:1)
725 29 END;
726 30 (*RM*) PIMMED: BEGIN
727 31 (*RM*) WRITE(LISTING,'#$':2);
728 32 (*RM*) HEXVSTRING(DISPL)
729 33 (*RM*) END;
730 34 (*RM*) STSHORT: BEGIN
731 35 (*RM*) WRITE(LISTING,'#':1);
732 36 (*RM*) VSTRINGIMMED(DISPL,2)
733 37 (*RM*) END;
734 38 (*RM*) STLONG : BEGIN
735 39 (*RM*) WRITE(LISTING,'#':1);
736 40 (*RM*) VSTRINGIMMED(DISPL,4)
737 41 (*RM*) END;
738 42 LIMMED: BEGIN
739 43 WITH INSTR^ DO BEGIN
740 44 WRITE(LISTING,'#$');
741 45 WRITE(LISTING,HEXDATAÆOPAND1 DIV 16 + 1Å);
742 46 WRITE(LISTING,HEXDATAÆOPAND1 MOD 16 + 1Å);
743 47 WRITE(LISTING,HEXDATAÆOPAND2 DIV 16 + 1Å);
744 48 WRITE(LISTING,HEXDATAÆOPAND2 MOD 16 + 1Å);
745 49 WRITE(LISTING,HEXDATAÆOPAND3 DIV 16 + 1Å);
746 50 WRITE(LISTING,HEXDATAÆOPAND3 MOD 16 + 1Å);
747 51 WRITE(LISTING,HEXDATAÆOPAND4 DIV 16 + 1Å);
748 52 WRITE(LISTING,HEXDATAÆOPAND4 MOD 16 + 1Å);
749 53 END
750 54 END;
751 55 (*RM*) XEXTERNAL: BEGIN WRITE(LISTING,'X',MNÆINSTR^.OPCODEÅ:3);
752 56 IF INSTR^.D1TYPE <> NOTATYP THEN
753 57 WRITE(LISTING,DNAMEÆINSTR^.D1TYPEÅ:1);
754 58 IF INSTR^.DTYPE <> NOTATYP THEN
755 59 WRITE(LISTING,DNAMEÆINSTR^.DTYPEÅ:1);
756 60 END; (* XEXTERNAL *)
757 61 PCINDEX: BEGIN WRITE(LISTING,'***PCINDEX***') END;
758 62 END END;
759 END; (*PRINTEA*)
760
761 0 BEGIN (*PRINTINSTRUCTION*)
762 1 WRITE(LISTING, ' ':10);
763 2 FOR BYTES:=1 TO 5 DO IF TMNÆOP,BYTESÅ<>' ' THEN WRITE
764 3 (LISTING, TMNÆOP,BYTESÅ);
765 4 IF SIZE = 1 THEN WRITE(LISTING,'.B ')
766 5 ELSE IF SIZE >= 4 THEN WRITE(LISTING,'.L ')
767 6 ELSE WRITE(LISTING,' ');
768 7 PRINTEA(EA1);
769 8 IF EA2.MODE <> NONE THEN BEGIN
770 9 WRITE(LISTING,',');
771 10 PRINTEA(EA2);
772 11 END;
773 12 IF FLPC THEN
774 13 BEGIN
775 14 WRITE(LISTING,' ':2,'***** FLUSH ',
776 15 MNÆINSTR^.OPCODEÅ);
777 16 FLPC := FALSE
778 17 END;
779 18 IF EA1.REG = A3
780 19 THEN WRITE(LISTING,' ',MNÆINSTR^.OPCODEÅ:3,
781 20 DNAMEÆINSTR^.D1TYPEÅ:1,
782 21 DNAMEÆINSTR^.DTYPEÅ:1);
783 22 WRITELN(LISTING,' ');
784 END; (*PRINTINSTRUCTION*)
785
786
787 PROCEDURE BUFFER(VALU: LINT; SIZE: INTEGER); (* PUT LONG VALUE IN CORE*)
788 VAR
789 I,B: INTEGER;
790 V: LINT;
791 PROCEDURE HEXWRITE(DATA: INTEGER); (*WRITE CONTENTS OF CORE CELL*)
792 VAR HI, LO: INTEGER;
793 CH: CHAR;
794 0 BEGIN
795 1 IF (DATA < 0) OR (DATA > 256)
796 2 THEN ERROR('BAD DATA IN HEXWRITE');
797 3 HI := DATA DIV 16;
798 4 LO := DATA MOD 16;
799 5 IF HI < 10
800 6 THEN CH := CHR(ORD('0') + HI)
801 7 ELSE CH := CHR(ORD('A') + HI - 10);
802 8 IF ODD(DEBUG) AND (OP <> TDC) THEN
803 9 BEGIN
804 10 MACHCODEÆMACHINDEXÅ := CH;
805 11 MACHINDEX := MACHINDEX + 1
806 12 END;
807 13 IF LO < 10
808 14 THEN CH := CHR(ORD('0') + LO)
809 15 ELSE CH := CHR(ORD('A') + LO - 10);
810 16 IF ODD(DEBUG) AND (OP <> TDC) THEN
811 17 BEGIN
812 18 MACHCODEÆMACHINDEXÅ := CH;
813 19 MACHINDEX := MACHINDEX + 1
814 20 END;
815 END; (*HEXWRITE*)
816 0 BEGIN (* BUFFER *)
817 1 IF SIZE + CORECOUNT > MAXCORE - 22
818 2 THEN EMITCODE;
819 3 FOR I := 1 TO SIZE DO
820 4 COREÆCORECOUNT + IÅ := VALUÆLDIGIT - SIZE + IÅ;
821 5 FOR I := 1 TO SIZE DO HEXWRITE(COREÆCORECOUNT + IÅ );
822 6 CORECOUNT := CORECOUNT + SIZE;
823 7 SAD(PC, SIZE);
824 8 IF ODD(DEBUG) AND (OP <> TDC) THEN MACHINDEX := MACHINDEX + 1;
825 END; (*BUFFER *)
826
827 PROCEDURE GEN8(A: INTEGER);
828 VAR
829 L: LINT;
830 0 BEGIN
831 1 SASGN(L, A);
832 2 BUFFER(L, 1);
833 END; (* GEN8*)
834
835 PROCEDURE GEN16(A: INTEGER);
836 VAR
837 L: LINT;
838 0 BEGIN
839 1 SASGN(L, A);
840 2 BUFFER(L, 2);
841 END; (*GEN16*)
842
843 PROCEDURE GEN448(A,B,C: INTEGER);
844 VAR
845 L: LINT;
846 0 BEGIN
847 1 IF C < 0 THEN C := C + 256; (* ADJUST TO ONE BYTE *)
848 2 SASGN(L, A);
849 3 SHL(L, 4); SAD(L, B);
850 4 SHL(L, 8); SAD(L, C);
851 5 BUFFER(L, 2)
852 END; (*GEN448*)
853
854 PROCEDURE GEN43333(A,B,C,D,E: INTEGER);
855 VAR
856 L: LINT;
857 0 BEGIN
858 1 SASGN(L, A);
859 2 SHL(L, 3); SAD(L, B);
860 3 SHL(L, 3); SAD(L, C);
861 4 SHL(L, 3); SAD(L, D);
862 5 SHL(L, 3); SAD(L, E);
863 6 BUFFER(L, 2);
864 END; (*GEN43333*)
865
866 PROCEDURE GEN4318(A,B,C,D: INTEGER);
867 VAR
868 L: LINT;
869 0 BEGIN
870 1 IF D < 0 THEN D := D + 256; (* ADJUST LENGTH OF OPERAND *)
871 2 SASGN(L, A);
872 3 SHL(L, 3); SAD(L, B);
873 4 SHL(L, 1); SAD(L, C);
874 5 SHL(L, 8); SAD(L, D);
875 6 BUFFER(L, 2);
876 END; (*GEN4318*)
877
878 PROCEDURE GENNULL; (* WRITE SOME SPACES*)
879 0 BEGIN
880 END; (*GENNULL*)
881
882 PROCEDURE GENEAEXT(E: EFFADDR);
883 VAR
884 R: INTEGER;
885 K: LINT;
886 0 BEGIN
887 1 IF E.MODE >= BASED
888 2 THEN IF (E.MODE=INDEX) OR (E.MODE=PCINDEX)
889 3 THEN
890 4 BEGIN
891 5 IF E.DISPL < 0 THEN E.DISPL := E.DISPL + 256;
892 6 IF E.XREG < ANONE
893 7 THEN R := ORD(E.XREG) - ORD(D0)
894 8 ELSE R := ORD(E.XREG) - ORD(A0) + 8;
895 9 SASGN(K, R);
896 10 SHL(K, 1);
897 11 IF NOT(REGTYPEÆE.XREGÅ IN ÆITYP,BTYP,CTYP,HTYPÅ)
898 12 THEN SAD(K, 1);
899 13 SHL(K, 11); SAD(K, E.DISPL);
900 14 BUFFER(K, 2);
901 15 END
902 16 ELSE
903 17 BEGIN
904 18 IF E.MODE = RELATIVE THEN E.DISPL := E.DISPL - 2;
905 19 SASGN(K, E.DISPL);
906 20 IF (E.MODE = IMMED) AND (SIZE = 4) THEN BUFFER(K,4) ELSE
907 21 IF NOT ( E.MODE IN ÆPIMMED, STSHORT, STLONG,LIMMEDÅ ) THEN
908 22 BUFFER(K, 2) (* 4 INSTEAD OF 2 FOR ABS/IMMED LONG*)
909 23 ELSE IF E.MODE = LIMMED
910 24 THEN BEGIN
911 25 WITH INSTR^ DO BEGIN
912 26 KÆ0Å := OPAND1;
913 27 KÆ1Å := OPAND2;
914 28 KÆ2Å := OPAND3;
915 29 KÆ3Å := OPAND4;
916 30 BUFFER(K,4)
917 31 END
918 32 END
919 33 END
920 34 ELSE IF OP <> TMOVE
921 35 THEN GENNULL
922 END; (*GENEAEXT*)
923
924 FUNCTION REG(EA: EFFADDR): INTEGER;
925 (* GENERATE CODED VALUE OF REG FIELD FOR GIVEN EFFECTIVE ADDRESS *)
926 0 BEGIN
927 1 IF EA.MODE < STSHORT
928 2 THEN IF (EA.REG = DNONE) OR (EA.REG = ANONE)
929 3 THEN ERROR('A/DNONE IN SUBR REG ')
930 4 ELSE IF EA.REG < ANONE
931 5 THEN REG := ORD(EA.REG) - ORD(D0)
932 6 ELSE REG := ORD(EA.REG) - ORD(A0)
933 7 ELSE CASE EA.MODE OF
934 8 ABSOLUTE: REG := 0;
935 9 RELATIVE: REG := 2;
936 10 PCINDEX: REG := 3;
937 11 IMMED: REG := 4;
938 12 LIMMED: REG := 4;
939 13 LABELLED: REG := 2; (*?*)
940 14 LABIMMED: REG := 4; (*?*)
941 15 PIMMED: REG := 4;
942 16 STSHORT: REG := 4;
943 17 STLONG: REG := 4;
944 18 XEXTERNAL: REG := 2;
945 19 END (*CASE*)
946 END; (*REG*)
947
948 FUNCTION MODE(EA: EFFADDR): INTEGER;
949 (* GENERATE CODED VALUE OF MODE FIELD FOR GIVEN EFFECTIVE ADDRESS*)
950 0 BEGIN
951 1 CASE EA.MODE OF
952 2 DDIRECT: MODE := 0;
953 3 ADIRECT: MODE := 1;
954 4 DEFER: MODE := 2;
955 5 INCR: MODE := 3;
956 6 DECR: MODE := 4;
957 7 BASED: MODE := 5;
958 8 INDEX: MODE := 6;
959 9 PCINDEX: MODE := 7;
960 10 ABSOLUTE:MODE := 7;
961 11 IMMED: MODE := 7;
962 12 LIMMED: MODE := 7;
963 13 RELATIVE:MODE := 7;
964 14 LABELLED:MODE := 7; (*?*)
965 15 LABIMMED:MODE := 7; (*?*)
966 16 NONE: MODE := 7;
967 17 PIMMED: MODE := 7;
968 18 STSHORT: MODE := 7;
969 19 STLONG: MODE := 7;
970 20 XEXTERNAL:MODE := 7;
971 21 END (* CASE*)
972 END; (*MODE*)
973
974 0 BEGIN (*GENX*)
975 1 IF EA1.MODE = LIMMED
976 2 THEN WITH INSTR^ DO
977 3 IF OPAND1 + OPAND2 + OPAND3 + OPAND4 = 0
978 4 THEN BEGIN
979 5 IF (OP=TMOVE) OR (OP=TCMP)
980 6 THEN BEGIN
981 7 EA1.MODE := IMMED;
982 8 EA1.DISPL := 0
983 9 END
984 10 END
985 11 ELSE IF OPAND1 + OPAND2 + OPAND3 = 0
986 12 THEN BEGIN
987 13 IF (OP=TADD) OR (OP=TSUB)
988 14 AND (OPAND4 > 0) AND (OPAND4 <= 8)
989 15 THEN BEGIN
990 16 EA1.MODE := IMMED;
991 17 EA1.DISPL := OPAND4
992 18 END
993 19 ELSE
994 20 IF (OP=TMOVE)
995 21 AND (OPAND4 > 0) AND (OPAND4 < 128)
996 22 THEN BEGIN
997 23 EA1.MODE := IMMED;
998 24 EA1.DISPL := OPAND4
999 25 END
1000 26 END
1001 27 ELSE
1002 28 IF (OPAND1 + OPAND2 + OPAND3 = 765)
1003 29 AND (OP=TMOVE)
1004 30 AND (OPAND4 > 127) AND (OPAND4 < 256)
1005 31 THEN BEGIN
1006 32 EA1.MODE := IMMED;
1007 33 EA1.DISPL := OPAND4 -256
1008 34 END;
1009 35 (* CHECK FOR MOVEQ, ADDQ, SUBQ *)
1010 36 IF OP = TMOVE
1011 37 THEN
1012 38 BEGIN
1013 39 IF ((EA1.MODE=IMMED) AND (EA1.DISPL=0) AND (EA2.MODE<>ADIRECT))
1014 40 THEN
1015 41 BEGIN
1016 42 EA1 := EA2;
1017 43 EA2 := EANONE;
1018 44 OP := TCLR;
1019 45 END
1020 46 ELSE
1021 47 (*0423A*) IF (EA2.MODE = DDIRECT) AND (EA1.DISPL > -128)
1022 48 AND (EA1.DISPL < 128)
1023 49 AND (EA1.MODE = IMMED)
1024 50 THEN
1025 51 BEGIN
1026 52 OP := TMOVEQ;
1027 53 SIZE := 4
1028 54 END; (*THEN*)
1029 55 END; (* THEN*)
1030 56 IF (OP = TADD) OR (OP = TSUB)
1031 57 THEN
1032 58 BEGIN
1033 59 IF (EA1.MODE=IMMED) AND (EA1.DISPL > 0) AND (EA1.DISPL<=8)
1034 60 THEN
1035 61 BEGIN
1036 62 IF OP = TADD
1037 63 THEN OP := TADDQ
1038 64 ELSE OP := TSUBQ
1039 65 END (*THEN*)
1040 66 END; (*THEN*)
1041 67 (* CHECK FOR CMP THAT CAN BE TST *)
1042 68 IF OP = TCMP
1043 69 THEN
1044 70 BEGIN
1045 71 IF ((EA1.MODE=IMMED) AND (EA1.DISPL = 0) AND (EA2.MODE<>ADIRECT))
1046 72 THEN
1047 73 BEGIN
1048 74 EA1 := EA2;
1049 75 EA2 := EANONE;
1050 76 OP := TTST
1051 77 END
1052 78 END;
1053 79 IF ODD(DEBUG) AND (OP <> TDC) AND (OP<>TEQU) THEN BEGIN PLINT(LISTING,PC);
1054 80 WRITE(LISTING,' ')
1055 81 END ;
1056 82 CASE OP OF
1057 83 TMOVE: BEGIN
1058 84 CASE SIZE OF 1: I:=1;
1059 85 2: I:=3;
1060 86 (*RM*) 4: I:=2
1061 87 END; (*CASE*)
1062 88 GEN43333(I, REG(EA2), MODE(EA2), MODE(EA1), REG(EA1));
1063 89 GENEAEXT(EA1); GENEAEXT(EA2);
1064 90 IF (EA1.MODE < BASED) AND (EA2.MODE < BASED)
1065 91 THEN GENNULL
1066 92 END; (*TMOVE*)
1067 93
1068 94 TLINK: BEGIN
1069 95 GEN43333(4,7,1,2,ORD(EA1.REG)-ORD(A0));
1070 96 GENEAEXT(EA2)
1071 97 END; (*TLINK*)
1072 98 TUNLK: BEGIN
1073 99 GEN43333(4,7,1,3,ORD(EA1.REG)-ORD(A0));
1074 100 GENNULL
1075 101 END;
1076 102
1077 103 TRTS : BEGIN
1078 104 GEN43333(4,7,1,6,5);
1079 105 GENNULL
1080 106 END;
1081 107
1082 108 TTST, TCLR, TNEG, TCOMP:
1083 109 BEGIN
1084 110 IF SIZE = 1
1085 111 THEN I := 0
1086 112 ELSE IF SIZE = 4
1087 113 THEN I := 2
1088 114 ELSE I := 1;
1089 115 CASE OP OF TTST: SUBOP := 5;
1090 116 TCLR: SUBOP := 1;
1091 117 TNEG: SUBOP := 2;
1092 118 TCOMP: SUBOP := 3
1093 119 END (*CASE*);
1094 120 GEN43333(4,SUBOP,I,MODE(EA1),REG(EA1));
1095 121 GENEAEXT(EA1);
1096 122 END; (*TTST*)
1097 123
1098 124 TBTST, TBSET:
1099 125 BEGIN
1100 126 IF OP = TBTST
1101 127 THEN SUBOP := 0 (*BTST*)
1102 128 ELSE SUBOP := 3; (*BSET*)
1103 129 IF EA1.MODE = IMMED
1104 130 THEN
1105 131 BEGIN
1106 132 GEN43333(0,4,SUBOP,MODE(EA2),REG(EA2));
1107 133 GENEAEXT(EA2);
1108 134 GENEAEXT(EA1) (* BIT NUMBER *)
1109 135 END
1110 136 ELSE
1111 137 BEGIN
1112 138 GEN43333(0,REG(EA1),4+SUBOP,MODE(EA2),REG(EA2));
1113 139 GENEAEXT(EA2);
1114 140 END
1115 141 END; (*TBTST*)
1116 142
1117 143 TOR, TEOR, TSUB, TAND, TADD, TCMP:
1118 144 BEGIN
1119 145 IF SIZE = 1
1120 146 THEN I := 0
1121 147 ELSE IF SIZE = 4
1122 148 THEN I := 2
1123 149 ELSE I := 1;
1124 150 CASE OP OF
1125 151 TOR: BEGIN OPC := 8; OPI := 0 END;
1126 152 TEOR:BEGIN OPC := 11; OPI := 5 END;
1127 153 TSUB: BEGIN OPC := 9; OPI := 2 END;
1128 154 TCMP: BEGIN OPC := 11; OPI := 6 END;
1129 155 TAND: BEGIN OPC := 12; OPI := 1 END;
1130 156 TADD: BEGIN OPC := 13; OPI := 3 END
1131 157 END; (*CASE*)
1132 158 IF (EA1.MODE IN ÆIMMED,LABELLED,LABIMMED,LIMMED,
1133 159 PIMMED,STSHORT,STLONGÅ) AND (EA2.MODE <> ADIRECT)
1134 160 THEN
1135 161 BEGIN
1136 162 GEN43333(0,OPI,I,MODE(EA2),REG(EA2));
1137 163 GENEAEXT(EA1);
1138 164 IF EA2.MODE >= BASED
1139 165 THEN GENEAEXT(EA2);
1140 166 END (*THEN*)
1141 167 ELSE
1142 168 IF EA2.MODE = ADIRECT
1143 169 THEN
1144 170 BEGIN
1145 171 IF I = 2
1146 172 THEN SUBOP := 7
1147 173 ELSE SUBOP := 3;
1148 174 GEN43333(OPC,REG(EA2),SUBOP,MODE(EA1),REG(EA1));
1149 175 GENEAEXT(EA1)
1150 176 END (*THEN*)
1151 177 ELSE
1152 178 IF (EA2.MODE=DDIRECT) AND (OP<>TEOR)
1153 179 THEN
1154 180 BEGIN
1155 181 GEN43333(OPC,REG(EA2),I,
1156 182 MODE(EA1),REG(EA1));
1157 183 GENEAEXT(EA1)
1158 184 END (*THEN*)
1159 185 ELSE
1160 186 IF EA1.MODE = DDIRECT
1161 187 THEN
1162 188 BEGIN
1163 189 IF OP = TCMP
1164 190 THEN
1165 191 ERROR('TO MEMORY COMPARE ');
1166 192 GEN43333(OPC,REG(EA1),4+I,
1167 193 MODE(EA2),REG(EA2));
1168 194 GENEAEXT(EA2)
1169 195 END (*THEN*)
1170 196 ELSE ERROR('MEMORY/MEMORY +-ETC ')
1171 197 END; (*TOR*)
1172 198
1173 199 TMULS, TDIVS:
1174 200 BEGIN
1175 201 CASE OP OF
1176 202 TMULS: OPC := 12;
1177 203 TDIVS: OPC := 8
1178 204 END; (*CASE*)
1179 205 GEN43333(OPC,REG(EA2),7,MODE(EA1),REG(EA1));
1180 206 GENEAEXT(EA1)
1181 207 END; (*TMULS*)
1182 208
1183 209 TTRAP: BEGIN
1184 210 GEN448(4,14,64 + EA1.DISPL);
1185 211 GENNULL
1186 212 END; (*TTRAP*)
1187 213
1188 214 TSEQ, TSNE, TSLT, TSNZ, TSLE, TSGT, TSGE:
1189 215 BEGIN
1190 216 CASE OP OF
1191 217 TSEQ: SUBOP := 7;
1192 218 TSNE: SUBOP := 6;
1193 219 TSNZ: SUBOP := 6;
1194 220 TSLT: SUBOP := 13;
1195 221 TSLE: SUBOP := 15;
1196 222 TSGT: SUBOP := 14;
1197 223 TSGE: SUBOP := 12;
1198 224 END; (*CASE*)
1199 225 GEN43333(5,SUBOP DIV 2,4*(SUBOP MOD 2) + 3,MODE(EA1),REG(EA1));
1200 226 GENEAEXT(EA1)
1201 227 END; (*TSEQ*)
1202 228
1203 229 TJMP, TJSR: BEGIN
1204 230 CASE OP OF
1205 231 TJMP: SUBOP := 3;
1206 232 TJSR: SUBOP := 2
1207 233 END; (*CASE*)
1208 234 GEN43333(4,7,SUBOP,MODE(EA1),REG(EA1));
1209 235 GENEAEXT(EA1)
1210 236 END; (*TJMP*)
1211 237
1212 238 TBRA, TBNE, TBNZ, TBGT, TBGE, TBSR, TBEQ, TBZ, TBLT, TBLE:
1213 239 BEGIN
1214 240 CASE OP OF
1215 241 TBRA: SUBOP := 0;
1216 242 TBSR: SUBOP := 1;
1217 243 TBNE: SUBOP := 6;
1218 244 TBNZ: SUBOP := 6;
1219 245 TBEQ: SUBOP := 7;
1220 246 TBZ: SUBOP := 7;
1221 247 TBGE: SUBOP := 12;
1222 248 TBLT: SUBOP := 13;
1223 249 TBGT: SUBOP := 14;
1224 250 TBLE: SUBOP := 15
1225 251 END; (*CASE*)
1226 252 I := EA1.DISPL;
1227 253 IF EA1.MODE = RELATIVE
1228 254 THEN I := I -2
1229 255 ELSE IF EA1.MODE = LABELLED
1230 256 THEN IF ((LABELTABLEÆIÅ.DEFINED)
1231 257 AND (CURROPCODE <> XCUP))
1232 258 OR ((PROCTABLEÆIÅ.DEFINED)
1233 259 AND (CURROPCODE = XCUP))
1234 260 THEN
1235 261 BEGIN
1236 262 IF CURROPCODE = XCUP
1237 263 THEN LTEMP := PROCTABLEÆIÅ.LOCATION
1238 264 ELSE LTEMP := LABELTABLEÆIÅ.LOCATION;
1239 265 LSB(LTEMP, PC);
1240 266 SSB(LTEMP, 2);
1241 267 LASGN(I, LTEMP)
1242 268 END
1243 269 ELSE I := 0; (* FORWARD REFERENCE*)
1244 270 GEN448(6,SUBOP,I);
1245 271 GENNULL
1246 272 END; (*TBRA*)
1247 273
1248 274 TMOVEQ, TLDQ: BEGIN
1249 275 GEN4318(7,REG(EA2),0,EA1.DISPL);
1250 276 GENNULL
1251 277 END; (*TMOVEQ*)
1252 278
1253 279 TADDQ, TSUBQ:
1254 280 BEGIN
1255 281 IF SIZE = 1
1256 282 THEN I := 0
1257 283 ELSE IF SIZE = 4
1258 284 THEN I := 2
1259 285 ELSE I := 1;
1260 286 IF OP = TADDQ
1261 287 THEN SUBOP := 0
1262 288 ELSE SUBOP := 4; (* SUBQ*)
1263 289 IF EA1.DISPL = 8 THEN EA1.DISPL := 0; (* ADJUST FOR IMMED 8 *)
1264 290 GEN43333(5,EA1.DISPL,SUBOP+I,MODE(EA2),REG(EA2));
1265 291 IF EA1.DISPL = 0 THEN EA1.DISPL := 8; (*REPAIR IMMED 8*)
1266 292 GENEAEXT(EA2)
1267 293 END; (*TADDQ*)
1268 294
1269 295 TLEA, TCHK:
1270 296 BEGIN
1271 297 IF OP = TLEA
1272 298 THEN SUBOP := 7
1273 299 ELSE SUBOP := 6; (*CHK*)
1274 300 GEN43333(4,REG(EA2),SUBOP,MODE(EA1),REG(EA1));
1275 301 GENEAEXT(EA1)
1276 302 END; (*TLEA*)
1277 303
1278 304 TPEA: BEGIN
1279 305 GEN43333(4,4,1,MODE(EA1),REG(EA1));
1280 306 GENEAEXT(EA1)
1281 307 END; (*TPEA*)
1282 308
1283 309 TDC: BEGIN
1284 310 IF SIZE = 1
1285 311 THEN GEN8(EA1.DISPL);
1286 312 IF SIZE = 2
1287 313 THEN GEN16(EA1.DISPL);
1288 314 END; (*TDC*)
1289 315
1290 316 TLBSR, TLBLT, TLBEQ, TLBRA, TLBGT, TLBNE, TLBLE, TLBGE:
1291 317 BEGIN
1292 318 CASE OP OF
1293 319 TLBRA: SUBOP := 0;
1294 320 TLBSR: SUBOP := 1;
1295 321 TLBNE: SUBOP := 6;
1296 322 TLBEQ: SUBOP := 7;
1297 323 TLBGE: SUBOP := 12;
1298 324 TLBLT: SUBOP := 13;
1299 325 TLBGT: SUBOP := 14;
1300 326 TLBLE: SUBOP := 15;
1301 327 END; (*CASE*)
1302 328 I := EA1.DISPL;
1303 329 IF EA1.MODE = RELATIVE
1304 330 THEN I := I
1305 331 ELSE IF EA1.MODE = LABELLED
1306 332 THEN IF (LABELTABLEÆIÅ.DEFINED
1307 333 AND (CURROPCODE <> XCUP))
1308 334 OR (PROCTABLEÆIÅ.DEFINED
1309 335 AND (CURROPCODE = XCUP))
1310 336 THEN
1311 337 BEGIN
1312 338 IF CURROPCODE = XCUP
1313 339 THEN LTEMP := PROCTABLEÆIÅ.LOCATION
1314 340 ELSE LTEMP := LABELTABLEÆIÅ.LOCATION;
1315 341 LSB(LTEMP, PC);
1316 342 SSB(LTEMP, 2);
1317 343 LASGN(I, LTEMP)
1318 344 END
1319 345 ELSE I := 0 (*FORWARD REF*)
1320 346 ELSE IF EA1.MODE = XEXTERNAL
1321 347 THEN I := -(I );
1322 348 GEN448(6,SUBOP,0);
1323 349 SUBOP := EA1.DISPL;
1324 350 EA1.DISPL := I;
1325 351 GENEAEXT(EA1);
1326 352 EA1.DISPL := SUBOP;
1327 353 END; (*TLBSR*)
1328 354
1329 355 TSWAP: BEGIN
1330 356 GEN43333(4,4,1,0,REG(EA1));
1331 357 GENNULL
1332 358 END; (*TSWAP*)
1333 359
1334 360 TEXTE: BEGIN
1335 361 IF SIZE = 4
1336 362 THEN I := 3
1337 363 ELSE I := 2;
1338 364 GEN43333(4,4,I,0,REG(EA1));
1339 365 GENNULL
1340 366 END; (*TEXTE*)
1341 367
1342 368 TCMPM: BEGIN
1343 369 CASE SIZE OF
1344 370 1: I := 4;
1345 371 2: I := 5;
1346 372 4: I := 6
1347 373 END; (*CASE*)
1348 374 GEN43333(11,REG(EA2),I,1,REG(EA1));
1349 375 GENNULL
1350 376 END; (*TCMPM*)
1351 377
1352 378
1353 379 TDCNT: BEGIN (* WARNING: THIS IS OLD DCNT *)
1354 380 GEN4318(7,REG(EA1),1,256 - EA2.DISPL);
1355 381 GENNULL
1356 382 END (*TDCNT*) ;
1357 383 TASL: WRITELN(LISTING,'****ASL NOT SUPPORTED YET***');
1358 384
1359 385 TEQU: ;
1360 386 END; (*CASE*)
1361 387
1362 388 IF OP <> TDC THEN
1363 389 BEGIN
1364 390 IF (OP <> TEQU) AND ODD(DEBUG) THEN WRITE(LISTING,MACHCODE);
1365 391 MACHCODE := ' ';
1366 392 MACHINDEX := 1;
1367 393 PRINTINSTRUCTION
1368 394 END;
1369 END; (*GENX*)
1370 PROCEDURE PUSHDREG;
1371 VAR K: INTEGER;
1372 0 BEGIN IF DALLOC <= 0 THEN ERROR('NO D REG TO PUSH ')
1373 1 ELSE BEGIN K := SIZEÆREGTYPEÆDBOTÅÅ;
1374 2 (*1204B*) IF K = 8 THEN K := 4; (* POWERSETS*)
1375 3 EADDIR.REG := DBOT;
1376 4 GENX(TMOVE,K,EADDIR,EAPUSH);
1377 5 STKPTR:=STKPTR + 1;
1378 6 IF STKPTR > STKMAX THEN ERROR('TOO MANY REG PUSHES ');
1379 7 KINDSTKÆSTKPTRÅ := DREG;
1380 8 TYPESTKÆSTKPTRÅ := REGTYPEÆDBOTÅ;
1381 9 DALLOC := DALLOC - 1;
1382 10 IF DALLOC = 0 THEN
1383 11 BEGIN
1384 12 DBOT := DNONE;
1385 13 DTOP := DNONE
1386 14 END
1387 15 ELSE
1388 16 DBOT := DREGSÆ(ORD(DBOT)-ORD(D0)+1) MOD NDREGSÅ;
1389 17 END
1390 END; (*PUSHDREG*)
1391
1392
1393 PROCEDURE PUSHAREG;
1394 VAR K: INTEGER;
1395 0 BEGIN IF AALLOC <= 0 THEN ERROR('NO A REG TO PUSH ')
1396 1 ELSE BEGIN K := SIZEÆREGTYPEÆABOTÅÅ;
1397 2 EAADIR.REG := ABOT;
1398 3 GENX(TMOVE,K,EAADIR,EAPUSH);
1399 4 STKPTR:=STKPTR + 1;
1400 5 IF STKPTR > STKMAX THEN ERROR('TOO MANY REG PUSHES ');
1401 6 KINDSTKÆSTKPTRÅ := AREG;
1402 7 TYPESTKÆSTKPTRÅ := REGTYPEÆABOTÅ;
1403 8 AALLOC := AALLOC -1;
1404 9 IF AALLOC = 0 THEN BEGIN ABOT := ANONE; ATOP := ANONE END
1405 10 ELSE
1406 11 ABOT := AREGSÆ(ORD(ABOT)-ORD(A0) + 1) MOD NAREGSÅ;
1407 12 END
1408 END; (*PUSHAREG*)
1409
1410
1411 PROCEDURE PUSHALLD;
1412 BEGIN WHILE DALLOC > 0 DO PUSHDREG END;
1413
1414
1415 PROCEDURE PUSHALL;
1416 0 BEGIN WHILE AALLOC > 0 DO PUSHAREG;
1417 1 WHILE DALLOC > 0 DO PUSHDREG
1418 END;
1419
1420 PROCEDURE FREEALL;
1421 0 BEGIN
1422 1 DALLOC := 0; DTOP := DNONE; DBOT := DNONE;
1423 2 AALLOC := 0; ATOP := ANONE; ABOT := ANONE
1424 END; (*FREEALL*)
1425
1426
1427 PROCEDURE POPREG(KIND: REGKIND);
1428
1429 PROCEDURE POPD;
1430 VAR K: INTEGER;
1431 0 (*RM*) BEGIN
1432 1 (*RM*) IF DBOT = DNONE THEN
1433 2 (*RM*) BEGIN
1434 3 (*RM*) DBOT := D0;
1435 4 (*RM*) DTOP := D0
1436 5 (*RM*) END ELSE
1437 6 DBOT :=
1438 7 DREGSÆ (ORD(DBOT)-ORD(D0)-1+NDREGS) MOD NDREGSÅ;
1439 8 DALLOC := DALLOC + 1;
1440 9 IF STKPTR < 0 THEN ERROR('POPPING EMPTY STACK ')
1441 10 ELSE BEGIN
1442 11 K := SIZEÆTYPESTKÆSTKPTRÅÅ;
1443 12 (*1204B*) IF K = 8 THEN K := 4; (*POWERSETS*)
1444 13 EADDIR.REG := DBOT;
1445 14 GENX(TMOVE,K,EAPOP, EADDIR);
1446 15 REGTYPEÆDBOTÅ := TYPESTKÆSTKPTRÅ;
1447 16 IF STKPTR >= 0 THEN STKPTR := STKPTR -1;
1448 17 DPOPCNT := DPOPCNT + 1;
1449 18 END
1450 END; (*POPD*)
1451
1452 PROCEDURE POPA;
1453 VAR K: INTEGER;
1454 0 (*RM*) BEGIN IF ABOT = ANONE THEN
1455 1 (*RM*) BEGIN
1456 2 (*RM*) ABOT := A0;
1457 3 (*RM*) ATOP := A0
1458 4 (*RM*) END
1459 5 ELSE ABOT :=
1460 6 AREGSÆ (ORD(ABOT)-ORD(A0)-1+NAREGS) MOD NAREGSÅ;
1461 7 AALLOC := AALLOC + 1;
1462 8 IF STKPTR < 0 THEN ERROR('POPPING EMPTY STACK ')
1463 9 ELSE BEGIN
1464 10 K := SIZEÆTYPESTKÆSTKPTRÅÅ;
1465 11 EAADIR.REG := ABOT;
1466 12 GENX(TMOVE,K,EAPOP, EAADIR);
1467 13 REGTYPEÆABOTÅ := TYPESTKÆSTKPTRÅ;
1468 14 IF STKPTR >= 0 THEN STKPTR := STKPTR -1;
1469 15 APOPCNT := APOPCNT + 1;
1470 16 END
1471 END; (*POPA*)
1472
1473
1474 0 BEGIN IF KIND = DREG THEN
1475 1 BEGIN WHILE KINDSTKÆSTKPTRÅ <> DREG DO POPA;
1476 2 (*RM*) IF STKPTR >= 0 THEN POPD
1477 3 ELSE ERROR('NO D REG TO POP ')
1478 4 END
1479 5 ELSE
1480 6 BEGIN WHILE KINDSTKÆSTKPTRÅ <> AREG DO POPD;
1481 7 (*RM*) IF STKPTR >= 0 THEN POPA
1482 8 ELSE ERROR('NO A REG TO POP ')
1483 9 END
1484 END;
1485
1486
1487 FUNCTION PREVIOUS(R:REGISTER):REGISTER;
1488 0 BEGIN
1489 1 PREVIOUS := DREGSÆ(ORD(R)-ORD(D0)-1+NDREGS) MOD NDREGSÅ
1490 END; (* PREVIOUS *)
1491
1492 PROCEDURE ALLOCDREG;
1493 0 BEGIN
1494 1 DALLOCCNT := DALLOCCNT + 1;
1495 2 IF DALLOC >= NDREGS THEN BEGIN PUSHDREG;
1496 3 DPUSHCNT:=DPUSHCNT+1
1497 4 END;
1498 5 DALLOC := DALLOC + 1;
1499 6 DTOP := DREGSÆ(ORD(DTOP)-ORD(D0)+1) MOD NDREGSÅ;
1500 7 IF DBOT = DNONE THEN DBOT := DTOP;
1501 8 REGTYPEÆDTOPÅ := INSTR^.DTYPE;
1502 END; (*ALLOCDREG*)
1503
1504 PROCEDURE ALLOCAREG;
1505 0 BEGIN
1506 1 AALLOCCNT := AALLOCCNT + 1;
1507 2 IF AALLOC >= NAREGS THEN BEGIN PUSHAREG;
1508 3 APUSHCNT:=APUSHCNT+1
1509 4 END;
1510 5 AALLOC := AALLOC + 1;
1511 6 ATOP := AREGSÆ(ORD(ATOP)-ORD(A0)+1) MOD NAREGSÅ;
1512 7 IF ABOT = ANONE THEN ABOT := ATOP;
1513 8 (*1011*) REGTYPEÆATOPÅ := ATYP;
1514 END; (*ALLOCAREG*)
1515
1516 PROCEDURE FREEDREG;
1517 0 BEGIN IF DALLOC > 1 THEN BEGIN
1518 1 DALLOC := DALLOC -1;
1519 2 DTOP := DREGSÆ(ORD(DTOP)-ORD(D0)+NDREGS-1) MOD NDREGSÅ
1520 3 (*-1 AND WRAPAROUND*)
1521 4 END
1522 5 ELSE IF DALLOC = 1 THEN BEGIN
1523 6 DALLOC := 0;
1524 7 (*RM*) DBOT := DNONE;
1525 8 DTOP := DNONE
1526 9 END
1527 10 ELSE ERROR('FREE NONALLOC''D DREG')
1528 END; (*FREEDREG*)
1529
1530
1531 PROCEDURE FREEAREG;
1532 0 BEGIN IF AALLOC > 1 THEN BEGIN
1533 1 AALLOC := AALLOC -1;
1534 2 ATOP := AREGSÆ(ORD(ATOP)-ORD(A0)+NAREGS-1) MOD NAREGSÅ
1535 3 (*-1 AND WRAPAROUND*)
1536 4 END
1537 5 ELSE IF AALLOC = 1 THEN BEGIN
1538 6 AALLOC := 0;
1539 7 (*RM*) ABOT := ANONE;
1540 8 ATOP := ANONE
1541 9 END
1542 10 ELSE ERROR('FREE NONALLOC''D AREG')
1543 END; (*FREEAREG*)
1544
1545
1546 PROCEDURE EFFADDRESS(INSTR: IPTR; VAR OPADDR: EFFADDR);
1547 (*USED BY LOD, LDA, STR, TAKES LEVEL, OFFSET
1548 IN OPAND1 AND OPAND2 AND RETURNS MODE,
1549 REGISTER, AND DISPLACEMENT OF CORRESPONDING
1550 68000 ADDRESS*)
1551 VAR SRC: EFFADDR;
1552 0 BEGIN WITH INSTR^ DO
1553 1 BEGIN IF OPAND1 (*LEVEL*) = 0 THEN (*GLOBAL ACCESS*)
1554 2 OPADDR.REG := A5 (*GLOBAL BASE REGISTER*)
1555 3 ELSE IF OPAND1 = LEVEL THEN (*LOCAL ACCESS*)
1556 4 OPADDR.REG := A6 (*FRAME POINTER*)
1557 5 ELSE BEGIN
1558 6 IF TEMPLEVEL <> OPAND1 THEN
1559 7 BEGIN
1560 8 EAADIR.REG := A4;
1561 9 BUILDADDR(SRC,BASED,A5,ANONE,4*OPAND1 + 8);
1562 10 GENX(TMOVE,4,SRC,EAADIR);
1563 11 TEMPLEVEL := OPAND1
1564 12 (*SAVE LEVEL OF DISPLAY ENTRY
1565 13 CURRENTLY HELD IN A4*)
1566 14 END;
1567 15 OPADDR.REG := A4; (*TEMPORARY INTERMEDIATE PTR*)
1568 16 END;
1569 17 OPADDR.MODE := BASED;
1570 18 OPADDR.DISPL := OPAND2; (*OFFSET*)
1571 19 IF (OPADDR.REG = A4) OR (OPADDR.REG = A6) THEN
1572 20 IF OPAND2 >= 0 THEN OPADDR.DISPL := OPAND2 + 12;
1573 21 IF OPADDR.DISPL = 0 THEN OPADDR.MODE := DEFER
1574 22 END;
1575 END; (*EFFADDRESS*)
1576
1577 PROCEDURE DOUBLEOP(VAR SRC, DST:EFFADDR; COMMUTATIVE: BOOLEAN;
1578 VAR SWITCH: BOOLEAN);
1579 0 (*RM*) BEGIN
1580 1 (*RM*) IF INSTR^.DTYPE = ATYP THEN BEGIN
1581 2 (*RM*) IF NOT COMMUTATIVE OR (AALLOC>=2) THEN
1582 3 (*RM*) BEGIN
1583 4 (*RM*) WHILE AALLOC <= 1 DO POPREG(AREG);
1584 5 (*RM*) BUILDADDR(SRC,ADIRECT,ATOP,ANONE,0);
1585 6 (*RM*) FREEAREG;
1586 7 (*RM*) BUILDADDR(DST,ADIRECT,ATOP,ANONE,0);
1587 8 (*RM*) SWITCH := FALSE
1588 9 (*RM*) END ELSE
1589 10 (*RM*) BEGIN
1590 11 (*RM*) IF AALLOC < 1 THEN POPREG(AREG);
1591 12 (*RM*) (*AALLOC = 1 AT THIS POINT *)
1592 13 (*RM*) BUILDADDR(DST,ADIRECT,ATOP,ANONE,0);
1593 14 (*RM*) BUILDADDR(SRC,INCR,SP,ANONE,0);
1594 15 (*RM*) SWITCH := TRUE;
1595 16 (*RM*) IF NOT (INSTR^.DTYPE IN LONGTYPES) THEN STKPTR := STKPTR -1;
1596 17 (*RM*) END
1597 18 (*RM*) END ELSE
1598 19 BEGIN IF NOT COMMUTATIVE OR (DALLOC >= 2) THEN
1599 20 BEGIN
1600 21 WHILE DALLOC <= 1 DO POPREG(DREG);
1601 22 BUILDADDR(SRC,DDIRECT,DTOP,ANONE,0);
1602 23 FREEDREG;
1603 24 BUILDADDR(DST,DDIRECT,DTOP,ANONE,0);
1604 25 SWITCH := FALSE
1605 26 END
1606 27 ELSE BEGIN
1607 28 IF DALLOC < 1 THEN POPREG(DREG);
1608 29 (*DALLOC = 1 AT THIS POINT*)
1609 30 BUILDADDR(DST,DDIRECT,DTOP,ANONE,0);
1610 31 BUILDADDR(SRC,INCR,SP,ANONE,0);
1611 32 SWITCH := TRUE;
1612 33 (*RM*) IF NOT (INSTR^.DTYPE IN LONGTYPES) THEN STKPTR := STKPTR -1;
1613 34 END
1614 35 (*RM*) END
1615 (*RM*) END;
1616
1617 PROCEDURE SINGLEOP(VAR SRC:EFFADDR);
1618 0 (*RM*) BEGIN
1619 1 (*RM*) IF INSTR^.DTYPE = ATYP THEN
1620 2 (*RM*) BEGIN IF AALLOC = 0 THEN POPREG(AREG);
1621 3 (*RM*) BUILDADDR(SRC,ADIRECT,ATOP,ANONE,0)
1622 4 (*RM*) END ELSE
1623 5 BEGIN IF DALLOC = 0 THEN POPREG(DREG);
1624 6 BUILDADDR(SRC,DDIRECT,DTOP,ANONE,0);
1625 7 (*RM*) END
1626 END;
1627
1628
1629 PROCEDURE LOADBIG(ADDR: EFFADDR; BYTES: INTEGER);
1630 (* PROCEDURE TO LOAD POWERSETS ONTO STACK *)
1631 0 BEGIN
1632 1 ALLOCDREG;
1633 2 EADDIR.REG := DTOP;
1634 3 GENX(TMOVE,4,ADDR,EADDIR);
1635 4 IF ADDR.MODE = BASED
1636 5 THEN ADDR.DISPL := ADDR.DISPL + 4
1637 6 ELSE IF ADDR.MODE=DEFER
1638 7 THEN BEGIN
1639 8 ADDR.MODE := BASED;
1640 9 ADDR.DISPL := 4
1641 10 END
1642 11 ELSE ERROR('LOADBIG W/BAD MODE ');
1643 12 ALLOCDREG;
1644 13 EADDIR.REG := DTOP;
1645 14 GENX(TMOVE,4,ADDR,EADDIR);
1646 END; (*LOADBIG*)
1647
1648
1649 PROCEDURE STOREBIG(ADDR: EFFADDR; BYTES: INTEGER);
1650 (* PROCEDURE TO STORE POWERSETS OFF THE STACK *)
1651 0 BEGIN
1652 1 EADDIR.REG := PREVIOUS(DTOP);
1653 2 GENX(TMOVE,4,EADDIR,ADDR);
1654 3 IF ADDR.MODE = BASED
1655 4 THEN ADDR.DISPL := ADDR.DISPL + 4
1656 5 ELSE IF ADDR.MODE = DEFER
1657 6 THEN BEGIN
1658 7 ADDR.MODE := BASED;
1659 8 ADDR.DISPL := 4
1660 9 END
1661 10 ELSE ERROR('STOREBIG W/BAD MODE ');
1662 11 EADDIR.REG := DTOP;
1663 12 FREEDREG;
1664 13 GENX(TMOVE,4,EADDIR,ADDR);
1665 14 FREEDREG
1666 END; (*STOREBIG*)
1667
1668
1669 PROCEDURE STORELITTLE; (*GEN CODE TO MOVE TOP DATA ITEM TO MEMORY*)
1670 0 BEGIN IF DALLOC > 0 THEN
1671 1 BEGIN EADDIR.REG := DTOP;
1672 2 GENX(TMOVE,SIZEÆINSTR^.DTYPEÅ,EADDIR,SOURCE);
1673 3 FREEDREG;
1674 4 END
1675 5 ELSE BEGIN GENX(TMOVE,SIZEÆINSTR^.DTYPEÅ,EAPOP,SOURCE);
1676 6 STKPTR := STKPTR - 1;
1677 7 END
1678 END; (*STORELITTLE*)
1679
1680 PROCEDURE REFERENCELABEL(LABL: INTEGER; WHERE: ADDRESS);
1681 (* CALLED TO SAVE FORWARD REFERENCE INFO *)
1682 0 BEGIN
1683 1 NEW(TEMPLABREF);
1684 2 WITH TEMPLABREF^ DO
1685 3 BEGIN
1686 4 IF INSTR^.OPCODE=XCUP
1687 5 THEN NEXT := PROCTABLEÆLABLÅ.REFCHAIN
1688 6 ELSE NEXT := LABELTABLEÆLABLÅ.REFCHAIN;
1689 7 CORELOC := WHERE
1690 8 END; (*WITH*)
1691 9 IF INSTR^.OPCODE=XCUP
1692 10 THEN BEGIN
1693 11 PROCTABLEÆLABLÅ.REFCHAIN := TEMPLABREF;
1694 12 PROCTABLEÆLABLÅ.REFED := TRUE;
1695 13 CLR (PROCTABLEÆLABLÅ.LOCATION);
1696 14 PROCTABLEÆLABLÅ.LOCATIONÆ0Å := 1
1697 15 END (*ELSE*)
1698 16 ELSE BEGIN
1699 17 LABELTABLEÆLABLÅ.REFCHAIN := TEMPLABREF ;
1700 18 LABELTABLEÆLABLÅ.REFED := TRUE;
1701 19 IF INSTR^.OPCODE = XENT
1702 20 THEN SASGN(LABELTABLEÆLABLÅ.LOCATION, -1)
1703 21 ELSE CLR(LABELTABLEÆLABLÅ.LOCATION);
1704 22 END; (*ELSE*)
1705 END; (*REFERENCELABEL*)
1706
1707
1708 PROCEDURE LONGBSR; (* RUNTIME ROUTINE BRANCH CALCULATION *)
1709 VAR
1710 I: INTEGER;
1711 RTNAME: PCODES;
1712 0 BEGIN
1713 1 WITH INSTR^ DO
1714 2 BEGIN
1715 3 RTNAME := OPCODE;
1716 4 IF DTYPE = VTYP
1717 5 THEN BEGIN
1718 6 IF RTNAME = XIND THEN RTNAME := XINDV
1719 7 ELSE IF RTNAME = XLOD THEN RTNAME := XLODV
1720 8 ELSE IF RTNAME = XSTR THEN RTNAME := XSTRV
1721 9 ELSE IF RTNAME = XSTO THEN RTNAME := XSTOV
1722 10 ELSE IF RTNAME = XEQU THEN RTNAME := XEQUV
1723 11 ELSE IF RTNAME = XNEQ THEN RTNAME := XNEQV
1724 12 ELSE IF RTNAME = XLES THEN RTNAME := XLESV
1725 13 ELSE IF RTNAME = XLEQ THEN RTNAME := XLEQV
1726 14 ELSE IF RTNAME = XGRT THEN RTNAME := XGRTV
1727 15 ELSE IF RTNAME = XGEQ THEN RTNAME := XGEQV
1728 16 ELSE IF RTNAME = XLDC THEN RTNAME := XLDCV
1729 17 END
1730 18 ELSE IF RTNAME = XCVT
1731 19 THEN IF (D1TYPE=STYP) AND (DTYPE=UTYP)
1732 20 THEN RTNAME := XCVTSU
1733 21 ELSE IF (D1TYPE=UTYP) AND (DTYPE=STYP)
1734 22 THEN RTNAME := XCVTUS;
1735 23 CLR(LTEMP);
1736 24 LSB(LTEMP,RTJUMP);
1737 25 SAD(LTEMP,RTÆRTNAMEÅ);
1738 26 SSB(LTEMP,4096);
1739 27 LASGN(SOURCE.DISPL,LTEMP);
1740 28 BUILDADDR(SOURCE,BASED,A3,ANONE,SOURCE.DISPL);
1741 29 GENX(TJSR,2,SOURCE,EANONE)
1742 30 END (*WITH*)
1743 END; (*LONGBSR*)
1744
1745 PROCEDURE MAIN;
1746 0 BEGIN
1747 1 IF INSTR^.OPAND1 = 0 THEN
1748 2 BEGIN
1749 3 PROGSTART := PC;
1750 4 MAINFLG := TRUE;
1751 5 WRITELN(LISTING,'MAIN',' ':6,'EQU *');
1752 6 END
1753 7 ELSE WRITELN(LISTING,'USER':4,CURRLABEL:1,' EQU *')
1754 END ; (* MAIN *)
1755
1756 PROCEDURE GENXXJP;
1757 0 BEGIN
1758 1 (*0421B*) IF DALLOC = 0 THEN POPREG(DREG);
1759 2 EADDIR.REG := DTOP;
1760 3 EALIMM.DISPL := INSTR^.OPAND1 + 1;
1761 4 GENX(TCMP,2,EALIMM,EADDIR);
1762 5 LTEMP := PC;
1763 6 SSB(LTEMP, 2);
1764 7 REFERENCELABEL(EALIMM.DISPL,LTEMP);
1765 8 (*RM*) EAREL.DISPL := 20;
1766 9 GENX(TBGT,2,EAREL,EANONE);
1767 10 EALIMM.DISPL := INSTR^.OPAND1;
1768 11 GENX(TSUB,2,EALIMM,EADDIR);
1769 12 LTEMP := PC;
1770 13 SSB(LTEMP, 2);
1771 14 REFERENCELABEL(EALIMM.DISPL,LTEMP);
1772 15 (*RM*) EAREL.DISPL := 14;
1773 16 GENX(TBLT,2,EAREL,EANONE);
1774 17 EALAB.DISPL := INSTR^.OPAND1 + 2;
1775 18 ALLOCAREG;
1776 19 EAADIR.REG := ATOP;
1777 20 GENX(TLEA,2,EALAB,EAADIR);
1778 21 LTEMP := PC;
1779 22 SSB(LTEMP, 2);
1780 23 REFERENCELABEL(EALAB.DISPL,LTEMP);
1781 24 GENX(TADD,2,EADDIR,EADDIR);
1782 25 BUILDADDR(SOURCE,INDEX,ATOP,DTOP,0);
1783 26 GENX(TADD,2,SOURCE,EAADIR);
1784 27 EADEFER.REG := ATOP;
1785 28 GENX(TJMP,2,EADEFER,EANONE);
1786 29 FREEDREG; FREEAREG
1787 END (* GENXXJP *) ;
1788
1789
1790 (*RM*) PROCEDURE LOADPSET;
1791 0 (*RM*) BEGIN
1792 1 (*RM*) WITH INSTR^ DO BEGIN
1793 2 (*RM*) ALLOCDREG;
1794 3 (*RM*) EADDIR.REG := DTOP;
1795 4 (*RM*) EAPSET.DISPL := 0;
1796 5 (*RM*) GENX(TMOVE,4,EAPSET,EADDIR);
1797 6 (*RM*) ALLOCDREG;
1798 7 (*RM*) EADDIR.REG := DTOP;
1799 8 (*RM*) EAPSET.DISPL := 8;
1800 9 (*RM*) GENX(TMOVE,4,EAPSET,EADDIR)
1801 10 (*RM*) END
1802 (*RM*) END; (* LOADPSET *)
1803
1804
1805 PROCEDURE SETOPS;
1806 0 BEGIN
1807 1 WITH INSTR^ DO BEGIN
1808 2 WHILE DALLOC < 4 DO POPREG(DREG);
1809 3 IF OPCODE = XDIF THEN BEGIN
1810 4 EADDIR.REG := DTOP;
1811 5 (*1324A*) GENX(TCOMP,4,EADDIR,EANONE);
1812 6 EADDIR.REG := PREVIOUS(DTOP);
1813 7 (*1324A*) GENX(TCOMP,4,EADDIR,EANONE);
1814 8 END;
1815 9 IF OPCODE = XUNI THEN OPCDE := TOR
1816 10 ELSE OPCDE := TAND;
1817 11 BUILDADDR(SOURCE,DDIRECT,DTOP,DNONE,0);
1818 12 EADDIR.REG := PREVIOUS(PREVIOUS(DTOP));
1819 13 GENX(OPCDE,4,SOURCE,EADDIR);
1820 14 SOURCE.REG := PREVIOUS(DTOP);
1821 15 EADDIR.REG := PREVIOUS(PREVIOUS(PREVIOUS(DTOP)));
1822 16 GENX(OPCDE,4,SOURCE,EADDIR);
1823 17 FREEDREG;FREEDREG;
1824 18 END
1825 END; (* SETOPS *)
1826
1827
1828 PROCEDURE PXLAB;
1829 0 BEGIN WITH INSTR^ DO BEGIN
1830 1 IF OPAND1 = 0 THEN OPAND1 := -1;
1831 2 (*604*) PCPRINT;
1832 3 WRITE(LISTING,'L',OPAND1 + LABELOFFSET:1);
1833 4 BUILDADDR(SOURCE,RELATIVE,ANONE,ANONE,0);
1834 5 GENX(TEQU,0,SOURCE,EANONE)
1835 6 END;
1836 END; (* PXLAB *)
1837
1838 PROCEDURE PXEND;
1839 VAR I: INTEGER;
1840 0 BEGIN
1841 1 EMITCODE;
1842 2 IF MAINFLG THEN BEGIN
1843 3 GENLOC := GENSTART;
1844 4 WRITE(LISTING,' RORG $');
1845 5 PLINT(LISTING,GENSTART);
1846 6 LTEMP := PC;
1847 7 WRITELN(LISTING,' ');
1848 8 LSB(LTEMP,GENSTART);
1849 9 SSB(LTEMP,20);
1850 10 GENSAVE := PC;
1851 11 PC := GENSTART;
1852 12 (* LOAD STACK *)
1853 13 WRITE(LISTING,' ':39,'MOVE.L $');
1854 14 PLINT(LISTING,STKSTART);
1855 15 WRITELN(LISTING,',A7');
1856 16 EAIMMED.DISPL := 11900; (* TMOVE 2E7C *)
1857 17 GENX(TDC,2,EAIMMED,EANONE);
1858 18 EAIMMED.DISPL := STKSTARTÆ0Å;
1859 19 GENX(TDC,1,EAIMMED,EANONE);
1860 20 EAIMMED.DISPL := STKSTARTÆ1Å;
1861 21 GENX(TDC,1,EAIMMED,EANONE);
1862 22 EAIMMED.DISPL := STKSTARTÆ2Å;
1863 23 GENX(TDC,1,EAIMMED,EANONE);
1864 24 EAIMMED.DISPL := STKSTARTÆ3Å;
1865 25 GENX(TDC,1,EAIMMED,EANONE);
1866 26 (* LEA 11EA,A3 *)
1867 27 WRITE(LISTING,' ':39,'LEA $');
1868 28 LTEMP := RTJUMP;
1869 29 SAD(LTEMP,4096);
1870 30 PLINT(LISTING,LTEMP);
1871 31 WRITELN(LISTING,',A3');
1872 32 EAIMMED.DISPL := 18425; (* LEA 47F9 *)
1873 33 GENX(TDC,2,EAIMMED,EANONE);
1874 34 EAIMMED.DISPL := LTEMPÆ0Å;
1875 35 GENX(TDC,1,EAIMMED,EANONE);
1876 36 EAIMMED.DISPL := LTEMPÆ1Å;
1877 37 GENX(TDC,1,EAIMMED,EANONE);
1878 38 EAIMMED.DISPL := LTEMPÆ2Å;
1879 39 GENX(TDC,1,EAIMMED,EANONE);
1880 40 EAIMMED.DISPL := LTEMPÆ3Å;
1881 41 GENX(TDC,1,EAIMMED,EANONE);
1882 42 (* JSR -490(A3) INITIALIZE ENVIRONMENT *)
1883 43 LONGBSR;
1884 44 IF (HEAPSTARTÆ0Å=255) AND (HEAPSTARTÆ1Å=255)
1885 45 AND (HEAPSTARTÆ2Å=255) AND (HEAPSTARTÆ3Å=255)
1886 46 THEN BEGIN
1887 47 HEAPSTART := GENSAVE;
1888 48 SAD(HEAPSTART,10)
1889 49 END;
1890 50 WRITE(LISTING,' ':10,'DC.L ':7,'$':1);
1891 51 PLINT(LISTING,HEAPSTART);
1892 52 WRITELN(LISTING,' ');
1893 53 FOR I := 0 TO 3 DO
1894 54 BEGIN
1895 55 EAIMMED.DISPL := HEAPSTARTÆIÅ;
1896 56 GENX(TDC,1,EAIMMED,EANONE)
1897 57 END;
1898 58 (* BRA OR JSR TO MAIN *)
1899 59 LTEMP := PROGSTART;
1900 60 LSB(LTEMP,PC);
1901 61 IF SHORT(LTEMP) THEN BEGIN
1902 62 LASGN(EAREL.DISPL, LTEMP);
1903 63 GENX(TLBRA,2,EAREL,EANONE);
1904 64 END ELSE
1905 65 BEGIN
1906 66 EADEFER.REG := A3;
1907 67 SSB(LTEMP,2);
1908 68 GENX(TJSR,2,EADEFER,EANONE);
1909 69 WRITE(LISTING,' ':10,'DC.L ':7,'$':1);
1910 70 PLINT(LISTING,LTEMP);
1911 71 WRITELN(LISTING,' ');
1912 72 FOR I := 0 TO 3 DO
1913 73 BEGIN
1914 74 EAIMMED.DISPL := LTEMPÆIÅ;
1915 75 GENX(TDC,1,EAIMMED,EANONE)
1916 76 END
1917 77 END;
1918 78 PC := GENSAVE;
1919 79 EMITCODE;
1920 80 END; (*BEGIN*)
1921 81 EMITEND
1922 82 ;WRITELN(LISTING,' END');
1923 END; (*PXEND*)
1924
1925 PROCEDURE PXDEF;
1926 0 BEGIN WITH INSTR^ DO BEGIN
1927 1 IF LABELED AND NOT DOLLAR THEN
1928 2 BEGIN
1929 3 IF OPAND1= 0 THEN OPAND1 := 1-LABELOFFSET;
1930 4 (*604*) PCPRINT;
1931 5 WRITE(LISTING,'L',OPAND1 + LABELOFFSET:1);
1932 6 BUILDADDR(SOURCE,ABSOLUTE,ANONE,ANONE,OPAND2);
1933 7 GENX(TEQU,0,SOURCE,EANONE)
1934 8 END;
1935 9 IF LABELED AND DOLLAR THEN
1936 10 BEGIN GETSTRING;
1937 11 WRITE(OUTPUT,'***** REFERENCE TO EXTERNAL PROCEDURE ',
1938 12 VSTRING:ALENGTH,' AT LOCATION ');
1939 13 LTEMP := EXPROC;
1940 14 SSB(LTEMP,10);
1941 15 PLINT(OUTPUT,LTEMP);
1942 16 WRITELN(OUTPUT,' ');
1943 17 END
1944 18 ELSE IF NOT LABELED THEN
1945 19 ERROR('DEF WITH NO LABEL ')
1946 20 END;
1947 END; (*PXDEF*)
1948
1949 PROCEDURE PXENT; (* OPAND1 IS NEW LEVEL*)
1950 0 BEGIN WITH INSTR^ DO BEGIN
1951 1 (*OPAND2 IS LABEL WHICH GIVES LOCAL DATA SZ*)
1952 2 (*VSTRING IS NEW PROC/FUNC NAME*)
1953 3 EMITCODE;
1954 4 RESETLABEL;
1955 5 MAIN;
1956 6 LEVEL := OPAND1;
1957 7 IF TEMPLEVEL = LEVEL THEN TEMPLEVEL := -1;
1958 8 (*INVALIDATE A4 (POINTER TO INTERMEDIATE
1959 9 LEXICAL LEVEL) IF DISPLAY ENTRY CHANGES*)
1960 10 IF LEVEL = 1 THEN
1961 11 BEGIN
1962 12 WRITE(OUTPUT,'*****ENTRY TO PROCEDURE ':25,
1963 13 VSTRING:ALENGTH,' AT LOCATION ');
1964 14 PLINT(OUTPUT,PC);
1965 15 WRITELN(OUTPUT,' ')
1966 16 END;
1967 17 (*1212A*) IF LEVEL = 0 THEN
1968 18 (*1212A*) BEGIN
1969 19 (*1212A*) EAADIR.REG := A7;
1970 20 (*1212A*) EALIMM.DISPL := -OPAND2;
1971 21 (*1212A*) GENX(TADD,0,EALIMM,EAADIR);
1972 22 LTEMP := PC;
1973 23 SSB(LTEMP, 2);
1974 24 (*1212A*) REFERENCELABEL(OPAND2 - LABELOFFSET,LTEMP)
1975 25 (*1212A*) END
1976 26 (*1212A*) ELSE BEGIN
1977 27 BUILDADDR(SOURCE,BASED,A5,ANONE,8+4*LEVEL);
1978 28 (*DISPLAY IS ^A5(6)*)
1979 29 GENX(TMOVE,4,SOURCE,EAPUSH);
1980 30 EAADIR.REG := A6; (*FRAME POINTER*)
1981 31 EALIMM.DISPL := -OPAND2 ;
1982 32 GENX(TLINK,0,EAADIR,EALIMM) ;
1983 33 LTEMP := PC;
1984 34 SSB( LTEMP, 2);
1985 35 REFERENCELABEL(OPAND2 - LABELOFFSET,LTEMP);
1986 36 GENX(TMOVE,4,EAADIR,SOURCE);
1987 37 (*1212A*) END;
1988 38 END;
1989 END; (* PXENT *)
1990
1991 PROCEDURE PXRET;
1992 0 BEGIN WITH INSTR^ DO BEGIN
1993 1 IF OPAND1 <> LEVEL THEN
1994 2 ERROR('ENT/RET LEVELS NOT =');
1995 3 EAADIR.REG := A6; (*FRAME POINTER*)
1996 4 GENX(TUNLK,0,EAADIR,EANONE);
1997 5 BUILDADDR(SOURCE,BASED,A5,ANONE,8+4*LEVEL);
1998 6 GENX(TMOVE,4,EAPOP,SOURCE);
1999 7 (*RM*) (* CODE TO FLUSH ARGUMENTS FROM STACK *)
2000 8 (*RM*) IF OPAND2 <> 0 THEN
2001 9 (*RM*) BEGIN
2002 10 (*RM*) ALLOCAREG;
2003 11 (*RM*) EAADIR.REG := ATOP;
2004 12 (*RM*) GENX(TMOVE,4,EAPOP,EAADIR);
2005 13 (*RM*) EAIMMED.DISPL := OPAND2;
2006 14 (*RM*) EAADIR.REG := SP;
2007 15 (*RM*) GENX(TADD,4,EAIMMED,EAADIR);
2008 16 (*RM*) EADEFER.REG := ATOP;
2009 17 (*RM*) GENX(TJMP,0,EADEFER,EANONE);
2010 18 (*RM*) FREEAREG
2011 19 (*RM*) END ELSE
2012 20 GENX(TRTS,0,EANONE,EANONE)
2013 21 END;
2014 END; (*PXRET*)
2015
2016 (*604*) PROCEDURE PXAD; FORWARD;
2017 PROCEDURE PXAB;
2018 0 BEGIN WITH INSTR^ DO BEGIN
2019 1 SINGLEOP(SOURCE);
2020 2 (*RM*) K := SIZEÆDTYPEÅ;
2021 3 CASE SUBTYPEÆOPCODEÅ OF
2022 4 (*604*) 1 (*AB *): BEGIN GENX(TTST,K,SOURCE,EANONE);
2023 5 (*RM*) EAREL.DISPL := 4;
2024 6 GENX(TBGT,0,EAREL,EANONE);
2025 7 (*604*) GENX(TNEG,K,SOURCE,EANONE)
2026 8 END;
2027 9 (*604*) 2 (*NG *): GENX(TNEG,K,SOURCE,EANONE);
2028 10 (*RM*) 3 (*DEC*): BEGIN EAIMMED.DISPL := OPAND1;
2029 11 GENX(TSUB,K,EAIMMED,SOURCE)
2030 12 (*RM*) END;
2031 13 (*RM*) 4 (*INC*): BEGIN EAIMMED.DISPL := OPAND1;
2032 14 (*480*) IF DTYPE = ATYP THEN K := 2;
2033 15 (*RM*) GENX(TADD,K,EAIMMED,SOURCE) END;
2034 16 5 (*NOT*): BEGIN
2035 17 OPTIMI := NEXTPCOD(INSTR);
2036 18 IF OPTIMI^.OPCODE=XFJP
2037 19 THEN BEGIN
2038 20 OPTIMI^.OPAND3 := 102; (*BEQ TO FJP*)
2039 21 END
2040 22 ELSE BEGIN
2041 23 (*RM*) EAIMMED.DISPL := 1;
2042 24 (*RM*) GENX(TEOR,1,EAIMMED,SOURCE)
2043 25 END
2044 26 (*RM*) END;
2045 27 (*0421C*) 6 (*ODD*): BEGIN EAIMMED.DISPL := 1;(*BIT # = 0*)
2046 28 (*0421C*) GENX(TAND,1,EAIMMED,SOURCE);
2047 29 (*0421C*) REGTYPEÆDTOPÅ := BTYP;
2048 30 END;
2049 31 (*RM*) 7 (*SQR*): (*CHECK SIZES??*)
2050 32 (*604*) IF DTYPE = JTYP
2051 33 (*604*) THEN BEGIN
2052 34 (*604*) IF DALLOC < 1
2053 35 (*604*) THEN POPREG(DREG);
2054 36 (*604*) EADDIR.REG := DTOP;
2055 37 (*604*) ALLOCDREG;
2056 38 (*604*) BUILDADDR(DEST,DDIRECT,
2057 39 (*604*) DTOP,ANONE,0);
2058 40 (*604*) GENX(TMOVE,4,EADDIR,DEST);
2059 41 (*604*) OPCODE := XMP;
2060 42 (*604*) PXAD;
2061 43 (*604*) END ELSE
2062 44 (*604*) BEGIN
2063 45 (*604*) IF DTYPE = HTYP
2064 46 (*604*) THEN BEGIN
2065 47 (*604*) IF DALLOC<1 THEN POPREG(DREG);
2066 48 (*604*) BUILDADDR(SOURCE,DDIRECT,DTOP,
2067 49 (*604*) ANONE,0);
2068 50 (*604*) GENX(TEXTE,2,SOURCE,EANONE)
2069 51 (*604*) END;
2070 52 (*RM*) GENX(TMULS,2,SOURCE,SOURCE);
2071 53 (*604*) END;
2072 54 (* CHECK OVFL
2073 55 MOV.W TO TEMP
2074 56 EXT.L TEMP
2075 57 CMP TEMP WITH SOURCE
2076 58 BNE *+2
2077 59 TRAP OVFL *)
2078 60 END
2079 61 END;
2080 END; (*PXAB*)
2081
2082 PROCEDURE PXAD;
2083 0 BEGIN WITH INSTR^ DO BEGIN
2084 1 CASE SUBTYPEÆOPCODEÅ OF
2085 2 (*604*) 1,3,4: COMMUTATIVE := TRUE;
2086 3 (*604*) 5: IF DTYPE IN ÆJTYP,HTYPÅ THEN COMMUTATIVE := FALSE
2087 4 (*604*) ELSE COMMUTATIVE := TRUE;
2088 5 2,6,7: COMMUTATIVE := FALSE
2089 6 END;
2090 7 DOUBLEOP(SOURCE,DEST,COMMUTATIVE,SWITCH);
2091 8 K := SIZEÆDTYPEÅ;
2092 9 IF DTYPE = NOTATYP THEN K := 1; (* ASSUME BOOLEAN*)
2093 10 (*604*) IF (DTYPE = JTYP)
2094 11 (*604*) AND (SUBTYPEÆOPCODEÅ IN Æ5,6,7Å)
2095 12 (*604*) THEN BEGIN
2096 13 (*604*) LONGBSR;
2097 14 (*604*) EAIMMED.DISPL := ORD(DEST.REG) - ORD(D0);
2098 15 (*604*) PCPRINT;
2099 16 (*604*) WRITELN(LISTING,' ':10,'DC.W ',
2100 17 (*604*) EAIMMED.DISPL:0);
2101 18 (*604*) GENX(TDC,2,EAIMMED,EANONE);
2102 19 (*604*) END ELSE
2103 20 CASE SUBTYPEÆOPCODEÅ OF
2104 21 1 (*ADD*): GENX(TADD,K,SOURCE, DEST);
2105 22 2 (*SB *): GENX(TSUB,K,SOURCE, DEST);
2106 23 3 (*AND*): GENX(TAND,K,SOURCE, DEST);
2107 24 4 (*IOR*): GENX(TOR, K,SOURCE, DEST);
2108 25 (*604*) 5 (*MP *): BEGIN
2109 26 (***CHECK OVFL; SEE CODE FOR SQR*)
2110 27 (*604*) IF DTYPE = HTYP
2111 28 (*604*) THEN GENX(TEXTE,2,SOURCE,EANONE);
2112 29 (*604*) IF (DTYPE = HTYP)
2113 30 (*604*) THEN GENX(TEXTE,2,DEST,EANONE);
2114 31 (*604*) GENX(TMULS,2,SOURCE,DEST)
2115 32 END;
2116 33 (*604*) 6 (*DV *): BEGIN
2117 34 (*604*) IF DTYPE = HTYP
2118 35 (*604*) THEN BEGIN
2119 36 (*604*) GENX(TEXTE,2,SOURCE,EANONE);
2120 37 (*604*) GENX(TEXTE,2,DEST,EANONE)
2121 38 (*604*) END;
2122 39 (*604*) GENX(TEXTE,4,DEST,EANONE);
2123 40 (*RM*) GENX(TDIVS,2,SOURCE,DEST)
2124 41 END;
2125 42 (*604*) 7 (*MOD*): BEGIN
2126 43 (*604*) IF DTYPE = HTYP
2127 44 (*604*) THEN BEGIN
2128 45 (*604*) GENX(TEXTE,2,SOURCE,EANONE);
2129 46 (*604*) GENX(TEXTE,2,DEST,EANONE)
2130 47 (*604*) END;
2131 48 (*604*) GENX(TEXTE,4,DEST,EANONE);
2132 49 (*RM*) GENX(TDIVS,2,SOURCE,DEST);
2133 50 (*RM*) GENX(TSWAP,2,DEST,EANONE)
2134 51 END;
2135 52 END
2136 53 END;
2137 END; (*PXAD*)
2138
2139 PROCEDURE PXCLO;
2140 VAR I:INTEGER;
2141 0 BEGIN WITH INSTR^ DO BEGIN
2142 1 IF SHORT(FIRSTESD^.REFERENCE)
2143 2 AND (FIRSTESD^.REFERENCEÆ2Å=0)
2144 3 AND (FIRSTESD^.REFERENCEÆ3Å=0) THEN
2145 4 BEGIN TEMPESD:= FIRSTESD;
2146 5 NEW(FIRSTESD); FIRSTESD^.NEXT:=TEMPESD;
2147 6 END;
2148 7 LTEMP := PC;
2149 8 SAD(LTEMP, 2);
2150 9 FIRSTESD^.REFERENCE := LTEMP;
2151 10 FIRSTESD^.NAME := OPCODE;
2152 11 IF (OPCODE=XWRB) OR (OPCODE=XWRC) OR (OPCODE=XWRI)
2153 12 (*604*) OR (OPCODE=XWRH) OR (OPCODE=XWRJ)
2154 13 THEN BEGIN
2155 14 (*0610B*) IF OPCODE=XWRC THEN DTYPE := CTYP
2156 15 (*0610B*) ELSE IF OPCODE=XWRI THEN DTYPE := ITYP
2157 16 (*0610B*) ELSE IF OPCODE=XWRH THEN DTYPE := HTYP
2158 17 (*0610B*) ELSE IF OPCODE=XWRJ THEN DTYPE := JTYP;
2159 18 IF DALLOC + AALLOC = 0
2160 19 THEN BEGIN
2161 20 EADDIR.REG := D1;
2162 21 GENX(TMOVE,2,EAPOP,EADDIR);
2163 22 EADDIR.REG := D0;
2164 23 (*0610B*) GENX(TMOVE,SIZEÆDTYPEÅ,EAPOP,EADDIR);
2165 24 EAADIR.REG := A0;
2166 25 GENX(TMOVE,4,EAPOP,EAADIR);
2167 26 STKPTR := STKPTR - 3;
2168 27 DPOPCNT := DPOPCNT + 3;
2169 28 END
2170 29 ELSE IF (DALLOC=1) AND (AALLOC=0)
2171 30 THEN BEGIN
2172 31 BUILDADDR(SOURCE,DDIRECT,DTOP,ANONE,0);
2173 32 EADDIR.REG := D1;
2174 33 GENX(TMOVE,2,SOURCE,EADDIR);
2175 34 EADDIR.REG := D0;
2176 35 (*0610B*) GENX(TMOVE,SIZEÆDTYPEÅ,EAPOP,EADDIR);
2177 36 EAADIR.REG := A0;
2178 37 GENX(TMOVE,4,EAPOP,EAADIR);
2179 38 STKPTR := STKPTR -2;
2180 39 DPOPCNT := DPOPCNT +2;
2181 40 (*1015E*) END
2182 41 (*1015E*) ELSE IF (DALLOC=2) AND (AALLOC=0)
2183 42 (*1015E*) THEN BEGIN
2184 43 (*1015E*) EAADIR.REG := A0;
2185 44 (*1015E*) GENX(TMOVE,4,EAPOP,EAADIR);
2186 45 (*1015E*) STKPTR := STKPTR -1;
2187 46 (*1015E*) DPOPCNT := DPOPCNT +1;
2188 47 (*1015E*) END;
2189 48 END;
2190 49 IF (OPCODE=XWRV) OR (OPCODE=XWRS)
2191 50 (*1205B*) THEN BEGIN PUSHALLD; STKPTR := STKPTR -2 END;
2192 51 (*1207C*) IF OPCODE = XWRV THEN STKPTR := STKPTR - 1;
2193 52 IF (OPCODE=XPEE)
2194 53 THEN
2195 54 BEGIN
2196 55 IF AALLOC = 0 THEN POPREG(AREG)
2197 56 END;
2198 57 (*MAKE SURE PARAMETERS ARE IN RIGHT PLACE?*)
2199 58 DTYPE := NOTATYP;
2200 59 (*RM*) IF OPCODE <> XEIO THEN LONGBSR
2201 60 ELSE IF AALLOC = 0 THEN BEGIN
2202 61 (* REMOVE FILE POINTER FROM STACK *)
2203 62 EAIMMED.DISPL := 4;
2204 63 EAADIR.REG := SP;
2205 64 GENX(TADD,2,EAIMMED,EAADIR)
2206 65 END;
2207 66 (*RM*) FREEALL ;
2208 67 (*1031A*) IF (OPCODE=XEOL) OR (OPCODE=XEOF) OR (OPCODE=XPOS)
2209 68 (*1031A*) THEN
2210 69 (*1031A*) BEGIN
2211 70 (*1031A*) ALLOCDREG;
2212 71 (*1031A*) IF OPCODE=XPOS
2213 72 (*1031A*) THEN REGTYPEÆDTOPÅ := ITYP
2214 73 (*1031A*) ELSE REGTYPEÆDTOPÅ := BTYP;
2215 74 (*1031A*) END
2216 75 (*RM*) ELSE IF (OPCODE <> XEIO) AND (OPCODE<>XCLO) AND (OPCODE<>XIFD)
2217 76 (*RM*) AND (OPCODE<>XSEE) AND (OPCODE<>XRST) AND (OPCODE<>XRWT)
2218 77 (*RM*) AND (OPCODE<>XRLN) AND (OPCODE<>XWLN)
2219 78 (*1023A*) AND (OPCODE<>XGET) AND (OPCODE<>XPUT)
2220 79 (*1206A*) AND (OPCODE<>XPAG)
2221 80 (*RM*) THEN ALLOCAREG;
2222 81 (*1207H*) IF OPCODE = XAFI THEN STKPTR := STKPTR - 1;
2223 82 END;
2224 END (*PXCLO*) ;
2225
2226 PROCEDURE PXLOD;
2227 0 BEGIN WITH INSTR^ DO BEGIN
2228 1 EFFADDRESS(INSTR,SOURCE);
2229 2 CASE SUBTYPEÆOPCODEÅ OF
2230 3 1 (*LOD*): BEGIN IF DTYPE = ATYP THEN
2231 4 BEGIN
2232 5 OPTIMI := NEXTPCOD(INSTR);
2233 6 IF OPTIMI^.OPCODE=XARG
2234 7 THEN BEGIN GENX(TMOVE,4,SOURCE,EAPUSH);
2235 8 OPTIMI^.INUSE := FALSE END
2236 9 ELSE IF ( OPTIMI^.OPCODE=XSTR)
2237 10 AND ((OPTIMI^.OPAND1=LEVEL)
2238 11 OR (OPTIMI^.OPAND1=0)
2239 12 OR (OPTIMI^.OPAND1=OPAND1))
2240 13 THEN BEGIN
2241 14 EFFADDRESS(OPTIMI,DEST);
2242 15 OPTIMI^.INUSE := FALSE;
2243 16 GENX(TMOVE,4,SOURCE,DEST)
2244 17 END
2245 18 ELSE
2246 19 BEGIN ALLOCAREG;
2247 20 EAADIR.REG := ATOP;
2248 21 GENX(TMOVE,4,SOURCE,EAADIR);
2249 22 END;
2250 23 END
2251 24 ELSE IF NOT (DTYPE IN LONGTYPES) THEN
2252 25 BEGIN
2253 26 OPTIMI := NEXTPCOD(INSTR);
2254 27 EADDIR.REG := DTOP;
2255 28 OPTIMI^.INUSE := FALSE;
2256 29 OPTIM2 := NEXTPCOD(OPTIMI);
2257 30 IF ((OPTIMI^.OPCODE=XAD)
2258 31 OR (OPTIMI^.OPCODE=XSB)
2259 32 OR (OPTIMI^.OPCODE=XAND)
2260 33 OR (OPTIMI^.OPCODE=XIOR))
2261 34 AND (DTOP<>DNONE)
2262 35 THEN BEGIN
2263 36 CASE SUBTYPEÆOPTIMI^.OPCODEÅ OF
2264 37 1: OPCDE := TADD;
2265 38 2: OPCDE := TSUB;
2266 39 3: OPCDE := TAND;
2267 40 4: OPCDE := TOR;
2268 41 END; (*CASE*)
2269 42 GENX(OPCDE,SIZEÆDTYPEÅ,SOURCE,EADDIR);
2270 43 END
2271 44 ELSE IF (OPTIMI^.OPCODE = XLDC)
2272 45 AND (CONDITIONAL(OPTIM2)>0)
2273 46 THEN BEGIN
2274 47 EAIMMED.DISPL := OPTIMI^.OPAND1;
2275 48 IF DTYPE = CTYP
2276 49 THEN EAIMMED.DISPL :=
2277 50 ASCIIÆOPTIMI^.OPSTRING^.VSTRINGAÆ1ÅÅ;
2278 51 IF OPTIMI^.DTYPE=JTYP
2279 52 THEN BEGIN
2280 53 OPAND1 := OPTIMI^.OPAND1;
2281 54 OPAND2 := OPTIMI^.OPAND2;
2282 55 OPAND3 := OPTIMI^.OPAND3;
2283 56 OPAND4 := OPTIMI^.OPAND4;
2284 57 GENX(TCMP,4,EALONG,SOURCE);
2285 58 END
2286 59 ELSE
2287 60 IF EAIMMED.DISPL = 0
2288 61 THEN GENX(TTST,SIZEÆDTYPEÅ,
2289 62 SOURCE,EANONE)
2290 63 ELSE GENX(TCMP,SIZEÆDTYPEÅ,
2291 64 EAIMMED,SOURCE);
2292 65 OPTIM2^.OPAND3 := 200; (*FLAG SET*)
2293 66 END
2294 67 ELSE IF OPTIMI^.OPCODE=XARG
2295 68 THEN GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EAPUSH)
2296 69 ELSE IF OPTIMI^.OPCODE=XSTO
2297 70 THEN BEGIN
2298 71 EADEFER.REG := ATOP;
2299 72 GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EADEFER)
2300 73 ;FREEAREG
2301 74 END
2302 75 ELSE IF (OPTIMI^.OPCODE = XSTR)
2303 76 AND ((OPTIMI^.OPAND1 = LEVEL)
2304 77 OR (OPTIMI^.OPAND1 = 0)
2305 78 OR (OPTIMI^.OPAND1 = OPAND1))
2306 79 THEN BEGIN
2307 80 EABASED.DISPL :=OPTIMI^.OPAND2;
2308 81 IF (EABASED.DISPL >=0) AND
2309 82 (OPTIMI^.OPAND1=LEVEL)
2310 83 THEN EABASED.DISPL := EABASED.DISPL+12;
2311 84 IF OPTIMI^.OPAND1 = 0
2312 85 THEN EABASED.REG := A5
2313 86 ELSE IF OPTIMI^.OPAND1 = LEVEL
2314 87 THEN EABASED.REG := A6
2315 88 ELSE EABASED.REG := A4;
2316 89 GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EABASED)
2317 90 END
2318 91 ELSE IF (((OPTIMI^.OPCODE=XINC)
2319 92 OR (OPTIMI^.OPCODE=XDEC))
2320 93 AND ((OPTIM2^.OPCODE=XSTR)
2321 94 AND (OPTIM2^.OPAND1=OPAND1)
2322 95 AND (OPTIM2^.OPAND2=OPAND2)))
2323 96 THEN BEGIN
2324 97 OPTIM2^.INUSE := FALSE;
2325 98 IF OPTIMI^.OPCODE = XDEC
2326 99 THEN OPCDE := TSUB
2327 100 ELSE OPCDE := TADD;
2328 101 EAIMMED.DISPL := OPTIMI^.OPAND1;
2329 102 GENX(OPCDE,SIZEÆDTYPEÅ,EAIMMED,SOURCE)
2330 103 END
2331 104 ELSE IF ( CONDITIONAL(OPTIMI) > 0)
2332 105 AND (DTOP<>DNONE)
2333 106 THEN BEGIN
2334 107 GENX(TCMP,SIZEÆDTYPEÅ,SOURCE,EADDIR);
2335 108 OPTIMI^.OPAND3 := 100; (*SET FLAG *)
2336 109 OPTIMI^.INUSE := TRUE
2337 110 END
2338 111
2339 112 ELSE BEGIN
2340 113 ALLOCDREG;
2341 114 EADDIR.REG := DTOP;
2342 115 GENX(TMOVE,SIZEÆDTYPEÅ,
2343 116 SOURCE,EADDIR) ;
2344 117 OPTIMI^.INUSE:= TRUE
2345 118 END
2346 119 END
2347 120 ELSE (*LONG TYPE: P, S, OR V*)
2348 121 (*RM*) BEGIN IF DTYPE = PTYP THEN OPAND3:=8;
2349 122 IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
2350 123 (*1015D*) PUSHALL;
2351 124 EAADIR.REG := A0;
2352 125 GENX(TLEA,2,SOURCE,EAADIR);
2353 126 IF (AALLOC<>0) OR (DALLOC<>0)
2354 127 THEN ERROR
2355 128 ('REGISTERS NOT EMPTY ');
2356 129 FREEALL;
2357 130 LONGBSR;
2358 131 IF DTYPE = VTYP THEN BEGIN
2359 132 (*604*) PCPRINT;
2360 133 WRITELN(LISTING,' ':10,
2361 134 'DC.W ',OPAND3:0);
2362 135 EAIMMED.DISPL := OPAND3;
2363 136 GENX(TDC,2,EAIMMED,EANONE);
2364 137 END
2365 138 END ELSE
2366 139 LOADBIG(SOURCE,OPAND3 (*SIZE*))
2367 140 (*RM*) END
2368 141 END;
2369 142 2 (*LDA*): BEGIN
2370 143 (*480*) OPTIMI := NEXTPCOD(INSTR);
2371 144 IF (OPTIMI^.OPCODE=XARG) OR (OPTIMI^.OPCODE=XMST)
2372 145 (*480*) OR (((OPTIMI^.OPCODE=XLDC) OR (OPTIMI^.OPCODE=XLOD)
2373 146 (*480*) OR (OPTIMI^.OPCODE=XIND))
2374 147 (*480*) AND (OPTIMI^.DTYPE IN ÆSTYP,VTYPÅ))
2375 148 THEN BEGIN
2376 149 OPTIMI^.INUSE := FALSE;
2377 150 (*480*) IF (OPTIMI^.OPCODE<>XMST)AND(OPTIMI^.OPCODE<>XARG)
2378 151 (*480*) THEN OPTIMI^.INUSE := TRUE;
2379 152 (*480*) IF OPTIMI^.OPCODE <> XARG
2380 153 THEN BEGIN
2381 154 PUSHALL;
2382 155 STKPTR := STKPTR + 1;
2383 156 KINDSTKÆSTKPTRÅ := AREG;
2384 157 TYPESTKÆSTKPTRÅ := ATYP;
2385 158 END;
2386 159 GENX(TPEA,2,SOURCE,EANONE)
2387 160 END ELSE BEGIN
2388 161 ALLOCAREG;
2389 162 EAADIR.REG := ATOP;
2390 163 GENX(TLEA,2,SOURCE,EAADIR)
2391 164 END
2392 165 END;
2393 166 3 (*STR*): BEGIN IF DTYPE = ATYP THEN
2394 167 BEGIN IF AALLOC > 0 THEN
2395 168 BEGIN EAADIR.REG := ATOP;
2396 169 GENX(TMOVE,4,EAADIR,SOURCE);
2397 170 FREEAREG
2398 171 END
2399 172 ELSE BEGIN
2400 173 GENX(TMOVE,4,EAPOP,SOURCE);
2401 174 STKPTR := STKPTR - 1;
2402 175 END
2403 176 END ELSE (*DTYPE <> ATYP*)
2404 177 IF NOT (DTYPE IN LONGTYPES) THEN
2405 178 STORELITTLE
2406 179 (*RM*) ELSE BEGIN
2407 180 (*RM*) IF DTYPE = PTYP THEN OPAND3:=8;
2408 181 IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
2409 182 EADDIR.REG := D0;
2410 183 EAIMMED.DISPL := OPAND3;
2411 184 IF DTYPE = STYP THEN
2412 185 GENX(TMOVE,4,EAIMMED,EADDIR);
2413 186 EAADIR.REG := A0;
2414 187 GENX(TLEA,2,SOURCE,EAADIR);
2415 188 IF (AALLOC<>0) OR (DALLOC<>0)
2416 189 THEN ERROR
2417 190 ('REGISTERS NOT EMPTY ');
2418 191 FREEALL;
2419 192 LONGBSR;
2420 193 IF DTYPE = VTYP THEN BEGIN
2421 194 PCPRINT;
2422 195 WRITELN(LISTING,' ':10,'DC.W ',
2423 196 OPAND3:0);
2424 197 GENX(TDC,2,EAIMMED,EANONE)
2425 198 END
2426 199 END ELSE
2427 200 (*RM*) STOREBIG(SOURCE,OPAND3)
2428 201 (*RM*) END
2429 202 END
2430 203 END
2431 204 END;
2432 END; (*PXLOD*)
2433
2434 PROCEDURE PXIXA;
2435 0 BEGIN WITH INSTR^ DO BEGIN
2436 1 (*T <- T' + T * OPAND1; WHERE T' IS ADDR AND T IS DATA*)
2437 2 IF DALLOC <= 0 THEN POPREG(DREG);
2438 3 EADDIR.REG := DTOP;
2439 4 IF OPAND1 = 2 THEN
2440 5 GENX(TADD,2,EADDIR,EADDIR)
2441 6 (***MORE OPTIMIZATION POSSIBLE FOR SMALL OPAND1'S*)
2442 7 ELSE BEGIN EAIMMED.DISPL := OPAND1;
2443 8 (*OP*) IF OPAND1 <> 1 THEN
2444 9 GENX(TMULS,2,EAIMMED,EADDIR) END;
2445 10 IF AALLOC <= 0 THEN POPREG(AREG);
2446 11 EAADIR.REG := ATOP;
2447 12 (*OP*) EADDIR.REG := DTOP;
2448 13 (*OP*) GENX(TADD,2,EADDIR,EAADIR);
2449 14 FREEDREG;
2450 15 END;
2451 END; (*PXIXA*)
2452
2453 PROCEDURE PXIND;
2454 0 BEGIN WITH INSTR^ DO BEGIN
2455 1 (*T <- MEMÆT + OPAND1Å*)
2456 2 IF AALLOC <= 0 THEN POPREG(AREG);
2457 3 BUILDADDR(SOURCE,BASED,ATOP,ANONE,OPAND1);
2458 4 IF OPAND1 = 0 THEN SOURCE.MODE := DEFER;
2459 5 IF DTYPE = ATYP
2460 6 THEN
2461 7 BEGIN
2462 8 OPTIMI := NEXTPCOD(INSTR);
2463 9 IF OPTIMI^.OPCODE = XSTR
2464 10 THEN
2465 11 BEGIN
2466 12 EFFADDRESS(OPTIMI,DEST);
2467 13 OPTIMI^.INUSE := FALSE;
2468 14 GENX(TMOVE,4,SOURCE,DEST)
2469 15 ;FREEAREG
2470 16 END
2471 17 ELSE
2472 18 BEGIN
2473 19 EAADIR.REG := ATOP;
2474 20 GENX(TMOVE,4,SOURCE,EAADIR)
2475 21 END
2476 22 END
2477 23 ELSE BEGIN
2478 24 IF NOT (DTYPE IN LONGTYPES) THEN
2479 25 BEGIN
2480 26 OPTIMI := NEXTPCOD(INSTR);
2481 27 OPTIMI^.INUSE := FALSE;
2482 28 (*0610A*) IF (DTOP=DNONE) AND ((OPTIMI^.OPCODE=XAD)
2483 29 (*0610A*) OR (OPTIMI^.OPCODE=XSB) OR
2484 30 (*0610A*) (OPTIMI^.OPCODE=XAND) OR
2485 31 (*0610A*) (OPTIMI^.OPCODE=XIOR))
2486 32 (*0610A*) THEN POPREG(DREG);
2487 33 EADDIR.REG := DTOP;
2488 34 FREEAREG;
2489 35 OPTIM2 := NEXTPCOD(OPTIMI);
2490 36 IF OPTIMI^.OPCODE = XARG
2491 37 THEN GENX(TMOVE,SIZEÆDTYPEÅ,
2492 38 SOURCE,EAPUSH)
2493 39 ELSE
2494 40 IF OPTIMI^.OPCODE=XAD
2495 41 THEN GENX(TADD,SIZEÆDTYPEÅ,SOURCE,EADDIR)
2496 42 ELSE IF OPTIMI^.OPCODE=XSB
2497 43 THEN GENX(TSUB,SIZEÆDTYPEÅ,SOURCE,EADDIR)
2498 44 ELSE IF OPTIMI^.OPCODE=XAND
2499 45 THEN GENX(TAND,SIZEÆDTYPEÅ,SOURCE,EADDIR)
2500 46 ELSE IF OPTIMI^.OPCODE=XIOR
2501 47 THEN GENX(TOR,SIZEÆDTYPEÅ,SOURCE,EADDIR)
2502 48 ELSE IF OPTIMI^.OPCODE = XSTR
2503 49 THEN
2504 50 BEGIN
2505 51 EFFADDRESS(OPTIMI,DEST);
2506 52 GENX(TMOVE,SIZEÆDTYPEÅ,
2507 53 SOURCE,DEST)
2508 54 END
2509 55 ELSE IF (OPTIMI^.OPCODE = XLDC)
2510 56 AND (CONDITIONAL(OPTIM2)>0)
2511 57 THEN
2512 58 BEGIN
2513 59 EAIMMED.DISPL :=
2514 60 OPTIMI^.OPAND1;
2515 61 IF DTYPE = CTYP
2516 62 THEN EAIMMED.DISPL :=
2517 63 ASCIIÆOPTIMI^.OPSTRING^.VSTRINGAÆ1ÅÅ;
2518 64 IF OPTIMI^.DTYPE=JTYP
2519 65 THEN BEGIN
2520 66 OPAND1 := OPTIMI^.OPAND1;
2521 67 OPAND2 := OPTIMI^.OPAND2;
2522 68 OPAND3 := OPTIMI^.OPAND3;
2523 69 OPAND4 := OPTIMI^.OPAND4;
2524 70 GENX(TCMP,4,EALONG,SOURCE);
2525 71 END
2526 72 ELSE
2527 73 IF EAIMMED.DISPL = 0
2528 74 THEN GENX(TTST,SIZEÆDTYPEÅ
2529 75 ,SOURCE,EANONE)
2530 76 ELSE GENX(TCMP,SIZEÆDTYPEÅ
2531 77 ,EAIMMED,SOURCE);
2532 78 OPTIM2^.OPAND3 :=200
2533 79 END
2534 80 ELSE BEGIN
2535 81 OPTIMI^.INUSE := TRUE;
2536 82 ALLOCDREG;
2537 83 EADDIR.REG := DTOP;
2538 84 GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EADDIR);
2539 85 END;
2540 86 END
2541 87 ELSE BEGIN IF DTYPE = PTYP THEN OPAND2 :=8;
2542 88 IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
2543 89 FREEAREG;
2544 90 PUSHALL;
2545 91 EAADIR.REG := A0;
2546 92 GENX(TLEA,2,SOURCE,EAADIR);
2547 93 LONGBSR;
2548 94 IF DTYPE = VTYP THEN BEGIN
2549 95 (*604*) PCPRINT;
2550 96 WRITELN(LISTING,' ':10,
2551 97 'DC.W ',OPAND2:0);
2552 98 EAIMMED.DISPL := OPAND2;
2553 99 GENX(TDC,2,EAIMMED,EANONE)
2554 100 END
2555 101 END ELSE BEGIN (*PTYP*)
2556 102 LOADBIG(SOURCE,OPAND2);
2557 103 (*1207E*) IF DTYPE = PTYP THEN FREEAREG;
2558 104 END;
2559 105 END;
2560 106 END
2561 107 END;
2562 END ; (*PXIND*)
2563
2564 PROCEDURE PXSTO;
2565 0 BEGIN WITH INSTR^ DO BEGIN
2566 1 (* MEMÆT'Å <- T *)
2567 2 IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
2568 3 IF (AALLOC<>0) OR (DALLOC<>0) THEN
2569 4 ERROR('REGISTERS NOT EMPTY ');
2570 5 FREEALL;
2571 6 IF DTYPE = STYP THEN BEGIN
2572 7 ALLOCDREG;
2573 8 EAIMMED.DISPL := OPAND1;
2574 9 EADDIR.REG := DTOP;
2575 10 GENX(TMOVE,2,EAIMMED,EADDIR);
2576 11 END;
2577 12 LONGBSR;
2578 13 IF DTYPE = VTYP THEN BEGIN
2579 14 (*604*) PCPRINT;
2580 15 WRITELN(LISTING,'DC.W ',OPAND1:0);
2581 16 EAIMMED.DISPL := OPAND1;
2582 17 GENX(TDC,2,EAIMMED,EANONE)
2583 18 END ELSE
2584 19 FREEDREG;
2585 20 (*1207D*) STKPTR := STKPTR - 1;
2586 21 END ELSE
2587 22 IF DTYPE = PTYP THEN BEGIN
2588 23 WHILE DALLOC<2 DO POPREG(DREG);
2589 24 IF AALLOC < 1 THEN POPREG(AREG);
2590 25 (*1303A*) BUILDADDR(SOURCE,DEFER,ATOP,ANONE,0);
2591 26 STOREBIG(SOURCE,8);
2592 27 FREEAREG;
2593 28 END ELSE
2594 29 IF DTYPE = ATYP THEN
2595 30 BEGIN WHILE AALLOC < 2 DO POPREG(AREG);
2596 31 EAADIR.REG := ATOP;
2597 32 FREEAREG;
2598 33 BUILDADDR(SOURCE,DEFER,ATOP,ANONE,0);
2599 34 GENX(TMOVE,4,EAADIR,SOURCE);
2600 35 FREEAREG
2601 36 END
2602 37 ELSE BEGIN IF DALLOC < 1 THEN POPREG(DREG);
2603 38 IF AALLOC < 1 THEN POPREG(AREG);
2604 39 BUILDADDR(SOURCE,DEFER,ATOP,ANONE,0);
2605 40 STORELITTLE;
2606 41 FREEAREG;
2607 42 END
2608 43 END;
2609 END; (*PXSTO *)
2610
2611 PROCEDURE PXLDC;
2612 VAR J,K: INTEGER;
2613 0 BEGIN WITH INSTR^ DO BEGIN
2614 1 IF DTYPE = ATYP THEN
2615 2 BEGIN ALLOCAREG;
2616 3 EAADIR.REG := ATOP;
2617 4 (*604*) GENX(TMOVE,4,EALONG,EAADIR) (* LOAD 4 CONSTS *)
2618 5 END ELSE
2619 6 (*604*) IF DTYPE = JTYP
2620 7 (*604*) THEN BEGIN
2621 8 (*604*) ALLOCDREG;
2622 9 (*604*) EADDIR.REG := DTOP;
2623 10 (*604*) GENX(TMOVE,4,EALONG,EADDIR)
2624 11 (*604*) END ELSE
2625 12 (*480*) IF DTYPE IN ÆSTYP,VTYPÅ THEN
2626 13 BEGIN
2627 14 (*480*) IF DTYPE = VTYP THEN
2628 15 (*480*) BEGIN
2629 16 (*480*) K := OPSTRING^.STRINGL; (* STRING LEN*)
2630 17 (*480*) (*IF STC THRU HERE *) IF OPCODE = XLDC THEN OPAND3:=OPAND1;
2631 18 (*480*) OPSTRING^.STRINGL := OPAND3; (*VEC *)
2632 19 (*480*) IF K < OPAND3
2633 20 (*480*) THEN FOR J := K + 1 TO OPAND3 DO
2634 21 (*480*) OPSTRING^.VSTRINGAÆJÅ := ' '
2635 22 (*480*) END;
2636 23 PUSHALL;
2637 24 LONGBSR;
2638 25 K := OPSTRING^.STRINGL;
2639 26 EAIMMED.DISPL := K;
2640 27 IF ODD(K) THEN K := K + 1;
2641 28 (*604*) PCPRINT;
2642 29 WRITELN(LISTING,' ':10,'DC.W ',
2643 30 EAIMMED.DISPL:0);
2644 31 GENX(TDC,2,EAIMMED,EANONE);
2645 32 (*604*) PCPRINT;
2646 33 WRITE(LISTING,' ':10,'DC.W ');
2647 34 VSTRINGIMMED(1,K);
2648 35 WRITELN(LISTING,' ');
2649 36 END
2650 37 ELSE
2651 38 (*RM*) IF DTYPE = PTYP THEN
2652 39 (*RM*) LOADPSET
2653 40 (*RM*) ELSE
2654 41 BEGIN
2655 42 IF DTYPE = CTYP THEN
2656 43 EAIMMED.DISPL := ASCIIÆOPSTRING^.VSTRINGAÆ1ÅÅ
2657 44 ELSE
2658 45 EAIMMED.DISPL := OPAND1;
2659 46 OPTIMI := NEXTPCOD(INSTR);
2660 47 OPTIMI^.INUSE := FALSE;
2661 48 IF (OPTIMI^.OPCODE=XARG) OR (OPTIMI^.OPCODE=XEXI)
2662 49 OR (OPTIMI^.OPCODE=XWRS) OR (OPTIMI^.OPCODE=XWRV)
2663 50 THEN BEGIN
2664 51 IF (OPTIMI^.OPCODE=XWRS) OR (OPTIMI^.OPCODE=XWRV)
2665 52 THEN PUSHALLD;
2666 53 IF OPTIMI^.OPCODE<>XARG THEN BEGIN
2667 54 OPTIMI^.INUSE := TRUE;
2668 55 OPTIMI^.DTYPE := DTYPE
2669 56 (*1205B*) ;
2670 57 (*1205B*) IF OPTIMI^.OPCODE<>XEXI THEN BEGIN
2671 58 (*1205B*) STKPTR := STKPTR +1;
2672 59 (*1205B*) TYPESTKÆSTKPTRÅ := DTYPE;
2673 60 (*1205B*) KINDSTKÆSTKPTRÅ := DREG;
2674 61 (*1205B*) END END;
2675 62 GENX(TMOVE,SIZEÆOPTIMI^.DTYPEÅ,EAIMMED,EAPUSH)
2676 63 ; OPTIMI^.DTYPE := NOTATYP
2677 64 END
2678 65 ELSE IF OPTIMI^.OPCODE=XSTO
2679 66 THEN BEGIN
2680 67 EADEFER.REG := ATOP;
2681 68 GENX(TMOVE,SIZEÆOPTIMI^.DTYPEÅ,EAIMMED,EADEFER)
2682 69 ;FREEAREG
2683 70 END
2684 71 ELSE IF (OPTIMI^.OPCODE = XSTR)
2685 72 AND ((OPTIMI^.OPAND1 = LEVEL)
2686 73 OR (OPTIMI^.OPAND1 = 0))
2687 74 THEN BEGIN
2688 75 EABASED.DISPL := OPTIMI^.OPAND2;
2689 76 IF (EABASED.DISPL>=0) AND (OPTIMI^.OPAND1=LEVEL)
2690 77 THEN EABASED.DISPL := EABASED.DISPL+12;
2691 78 IF OPTIMI^.OPAND1 = 0
2692 79 THEN EABASED.REG := A5
2693 80 ELSE EABASED.REG := A6;
2694 81 GENX(TMOVE,SIZEÆOPTIMI^.DTYPEÅ,EAIMMED,EABASED)
2695 82 END
2696 83 ELSE IF (CONDITIONAL(OPTIMI) > 0)
2697 84 AND (DTOP<>DNONE)
2698 85 THEN BEGIN
2699 86 EADDIR.REG := DTOP;
2700 87 IF EAIMMED.DISPL=0 THEN
2701 88 GENX(TTST,SIZEÆDTYPEÅ,EADDIR,EANONE)
2702 89 ELSE
2703 90 GENX(TCMP,SIZEÆDTYPEÅ,EAIMMED,EADDIR);
2704 91 OPTIMI^.OPAND3 := 100; (* SET FLAG *)
2705 92 OPTIMI^.INUSE := TRUE
2706 93 END
2707 94 ELSE IF OPTIMI^.OPCODE=XIXA
2708 95 THEN BEGIN
2709 96 EAIMMED.DISPL := OPAND1 * OPTIMI^.OPAND1;
2710 97 EAADIR.REG := ATOP;
2711 98 GENX(TADD,2,EAIMMED,EAADIR)
2712 99 END
2713 100 ELSE
2714 101 BEGIN
2715 102 ALLOCDREG;
2716 103 OPTIMI^.INUSE := TRUE;
2717 104 EADDIR.REG := DTOP;
2718 105 GENX(TMOVE ,2,EAIMMED,EADDIR);
2719 106 END
2720 107 END
2721 108 END;
2722 END; (*PXLDC*)
2723
2724 (*480*) PROCEDURE PXSTC;
2725 0 (*480*) BEGIN WITH INSTR^ DO BEGIN
2726 1 (*480*) EFFADDRESS(INSTR,SOURCE);
2727 2 (*480*) PUSHALL;
2728 3 (*480*) EAADIR.REG := A0;
2729 4 (*480*) GENX(TLEA,2,SOURCE,EAADIR);
2730 5 (*480*) PXLDC (* LET LOAD CONSTANT PROCESSOR DO REST *)
2731 6 (*480*) END (* WITH *)
2732 (*480*) END; (*PXSTC*)
2733
2734 PROCEDURE PXLTA;
2735 0 BEGIN WITH INSTR^ DO BEGIN
2736 1 ALLOCAREG;
2737 2 EAADIR.REG := SP;
2738 3 BUILDADDR(SOURCE,DEFER,ATOP,ANONE,0);
2739 4 GENX(TMOVE,4,EAADIR,SOURCE)
2740 5 END;
2741 END; (*PXLTA*)
2742
2743 PROCEDURE PXLCA;
2744 0 BEGIN
2745 1 ;(*LEAVE INDICATION TO ALLOCATE STORAGE AT END
2746 2 OF THIS BLOCK; GEN LEA ATOP WITH PC^(DISPL)*)
2747 END; (* PXLCA*)
2748
2749 PROCEDURE PXISC;
2750 0 BEGIN WITH INSTR^ DO BEGIN
2751 1 EAIMMED.DISPL := 1;
2752 2 EADEFER.REG := A5;
2753 3 GENX(TADD,4,EAIMMED,EADEFER) (*'SC' IS ^A5*)
2754 4 END;
2755 END; (*PXISC*)
2756
2757 PROCEDURE PXLSC;
2758 0 BEGIN WITH INSTR^ DO BEGIN
2759 1 EAIMMED.DISPL := OPAND1;
2760 2 EADEFER.REG := A5;
2761 3 GENX(TMOVE,4,EAIMMED,EADEFER) (*'SC' IS ^A5*)
2762 4 END;
2763 END; (*PXLSC*)
2764
2765 PROCEDURE PXEQU;
2766 VAR FLAG: BOOLEAN; (* TRUE MEANS NO DREG WAS ALLOC YET *)
2767 0 BEGIN WITH INSTR^ DO BEGIN
2768 1 FLAG := FALSE;
2769 2 IF OPAND3 = 200
2770 3 THEN BEGIN
2771 4 FLAG := TRUE;
2772 5 OPAND3 := 100
2773 6 END;
2774 7 IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
2775 8 LONGBSR;
2776 9 IF DTYPE = VTYP
2777 10 THEN
2778 11 BEGIN
2779 12 EAIMMED.DISPL := OPAND1; (* VEC LEN *)
2780 13 (*604*) PCPRINT;
2781 14 IF DEBUG <> 0 THEN
2782 15 WRITELN(LISTING,' ':10,'DC.W ',
2783 16 OPAND1:0);
2784 17 GENX(TDC,2,EAIMMED,EANONE)
2785 18 (*604*) END;
2786 19 IF (AALLOC<>0) OR (DALLOC<>0) THEN
2787 20 ERROR('REGISTERS NOT EMPTY ');
2788 21 FREEALL;
2789 22 ALLOCDREG;
2790 23 (*0326A*) REGTYPEÆDTOPÅ := BTYP;
2791 24 END ELSE IF DTYPE = PTYP THEN BEGIN
2792 25 WHILE DALLOC < 4 DO POPREG(DREG);
2793 26 (*THE BELOW SHOULD BE OPTIMIZED FOR THE CASE
2794 27 WHEN ONE ARGUMENT IS A CONSTANT*)
2795 28 CASE SUBTYPEÆOPCODEÅ OF
2796 29 1 (*EQU*) : OPCDE := TEOR;
2797 30 2 (*NEQ*) : OPCDE := TEOR;
2798 31 4 (*LEQ*) : BEGIN
2799 32 OPCDE := TAND;
2800 33 EADDIR.REG := DTOP;
2801 34 GENX(TCOMP,4,EADDIR,EANONE);
2802 35 EADDIR.REG := PREVIOUS(DTOP);
2803 36 GENX(TCOMP,4,EADDIR,EANONE);
2804 37 END;
2805 38 6 (*GEQ*) : BEGIN
2806 39 OPCDE := TAND;
2807 40 EADDIR.REG :=
2808 41 PREVIOUS(PREVIOUS(DTOP));
2809 42 GENX(TCOMP,4,EADDIR,EANONE);
2810 43 EADDIR.REG :=
2811 44 PREVIOUS(PREVIOUS(PREVIOUS(DTOP)));
2812 45 GENX(TCOMP,4,EADDIR,EANONE);
2813 46 END;
2814 47 END; (*CASE*)
2815 48 BUILDADDR(SOURCE,DDIRECT,DTOP,ANONE,0);
2816 49 FREEDREG;
2817 50 BUILDADDR(DEST,DDIRECT,PREVIOUS(DTOP),ANONE,0);
2818 51 GENX(OPCDE,4,SOURCE,DEST);
2819 52 SOURCE.REG := DTOP;
2820 53 FREEDREG;
2821 54 DEST.REG := PREVIOUS(DTOP);
2822 55 GENX(OPCDE,4,SOURCE,DEST);
2823 56 SOURCE.REG := DTOP;
2824 57 FREEDREG;
2825 58 DEST.REG := DTOP;
2826 59 GENX(TOR,4,SOURCE,DEST);
2827 60 SWITCH := FALSE;
2828 61 IF OPCODE <> XNEQ THEN OPCODE := XEQU;
2829 62 END ELSE BEGIN
2830 63 OPTIMI := NEXTPCOD(INSTR);
2831 64 SWITCH := FALSE;
2832 65 IF OPAND3<>100 THEN BEGIN (*CMP ALREADY DONE*)
2833 66 DOUBLEOP(SOURCE,DEST,TRUE(*COMMUTATIVITY*),SWITCH);
2834 67 K := SIZEÆDTYPEÅ;
2835 68 GENX(TCMP,K,SOURCE,DEST);
2836 69 (*1207A*) IF DTYPE = ATYP THEN FREEAREG;
2837 70 END
2838 71 END;
2839 72 IF DTYPE <> STYP THEN BEGIN
2840 73 EADDIR.REG := DTOP;
2841 74 CASE SUBTYPEÆOPCODEÅ OF
2842 75 1 (*EQU*) : OPCDE:=TSEQ;
2843 76 2 (*NEQ*) : OPCDE:=TSNE;
2844 77 3 (*LES*) : IF SWITCH THEN
2845 78 OPCDE:=TSGT
2846 79 ELSE OPCDE:=TSLT;
2847 80 4 (*LEQ*) : IF SWITCH THEN
2848 81 OPCDE:=TSGE
2849 82 ELSE OPCDE:=TSLE;
2850 83 5 (*GRT*) : IF SWITCH THEN
2851 84 OPCDE:=TSLT
2852 85 ELSE OPCDE:=TSGT;
2853 86 6 (*GEQ*) : IF SWITCH THEN
2854 87 OPCDE:=TSLE
2855 88 ELSE OPCDE:=TSGE;
2856 89 END;
2857 90 (*RM*) IF DTYPE = ATYP THEN BEGIN
2858 91 (*RM*) ALLOCDREG;
2859 92 (*RM*) EADDIR.REG := DTOP
2860 93 (*RM*) END;
2861 94 IF OPTIMI = NIL THEN OPTIMI:=INSTR; (*FORCE NOTEQ*)
2862 95 IF OPTIMI^.OPCODE = XFJP
2863 96 THEN
2864 97 BEGIN
2865 98 OPTIMI^.OPAND3 := 100 + CONDITIONAL(INSTR)
2866 99 ;IF FLAG
2867 100 THEN OPTIMI^.OPAND3 := OPTIMI^.OPAND3 + 100
2868 101 END
2869 102 ELSE BEGIN
2870 103 IF FLAG
2871 104 THEN BEGIN
2872 105 ALLOCDREG;
2873 106 EADDIR.REG := DTOP
2874 107 END;
2875 108 IF DTYPE <> VTYP
2876 109 THEN
2877 110 BEGIN
2878 111 GENX(OPCDE,2,EADDIR,EANONE);
2879 112 REGTYPEÆDTOPÅ := BTYP;
2880 113 GENX(TNEG,1,EADDIR,EANONE)
2881 114 END
2882 115 END
2883 116 END;
2884 117 END;
2885 END; (*PXEQU*)
2886
2887 PROCEDURE PXSTP;
2888 0 BEGIN WITH INSTR^ DO BEGIN
2889 1 PUSHALL;
2890 2 (*PUSH ZERO ARGUMENT ON STACK*)
2891 3 GENX(TCLR,2,EAPUSH,EANONE);
2892 4 EAIMMED.DISPL := 14;
2893 5 GENX(TTRAP,2,EAIMMED,EANONE);
2894 6 EAIMMED.DISPL := 3;
2895 7 GENX(TDC,2,EAIMMED,EANONE);
2896 8 END;
2897 END; (*PXSTP*)
2898
2899 PROCEDURE PXEXI;
2900 0 BEGIN WITH INSTR^ DO BEGIN
2901 1 PUSHALL;
2902 2 (*EXIT ARGUMENT ALREADY ON STACK*)
2903 3 EAIMMED.DISPL := 14;
2904 4 GENX(TTRAP,2,EAIMMED,EANONE);
2905 5 EAIMMED.DISPL := OPAND1 + 3;
2906 6 GENX(TDC,2,EAIMMED,EANONE);
2907 7 END;
2908 END; (*PXEXI*)
2909
2910 PROCEDURE PXDIS;
2911 0 BEGIN WITH INSTR^ DO BEGIN
2912 1 IF AALLOC < 1 THEN POPREG(AREG);
2913 2 (*604*) LONGBSR;
2914 3 (*604*) EAIMMED.DISPL := OPAND1;
2915 4 (*604*) PCPRINT;
2916 5 (*604*) WRITELN(LISTING,' ':10,'DC.W ',OPAND1:0);
2917 6 (*604*) GENX(TDC,2,EAIMMED,EANONE);
2918 7 FREEAREG;
2919 8 END;
2920 END; (*PXDIS*)
2921
2922 PROCEDURE PXNEW;
2923 0 BEGIN WITH INSTR^ DO BEGIN
2924 1 (*RM*) (*HEAP POINTER IS ^A5(4) *)
2925 2 IF AALLOC < 1 THEN POPREG(AREG);
2926 3 (*604*) LONGBSR;
2927 4 (*604*) EAIMMED.DISPL := OPAND1; (* LENGTH TO ALLOC *)
2928 5 (*604*) PCPRINT;
2929 6 (*604*) WRITELN(LISTING,' ':10,'DC.W ',OPAND1:0);
2930 7 (*604*) GENX(TDC,2,EAIMMED,EANONE);
2931 8 (*604*) FREEAREG;
2932 9 END;
2933 END; (*PXNEW*)
2934
2935 PROCEDURE PXMRK;
2936 0 BEGIN WITH INSTR^ DO BEGIN
2937 1 IF AALLOC < 1 THEN POPREG(AREG);
2938 2 (*604*) LONGBSR;
2939 3 FREEAREG;
2940 4 END;
2941 END; (*PXMRK*)
2942
2943 PROCEDURE PXRLS;
2944 0 BEGIN WITH INSTR^ DO BEGIN
2945 1 (*604*) IF AALLOC < 1 THEN POPREG(AREG);
2946 2 (*604*) LONGBSR;
2947 3 (*604*) FREEAREG;
2948 4 END;
2949 END; (*PXRLS*)
2950
2951 PROCEDURE PXMST;
2952 0 BEGIN
2953 1 PUSHALL;
2954 END; (*PXMST*)
2955
2956 PROCEDURE PXARG;
2957 0 BEGIN WITH INSTR^ DO BEGIN
2958 1 (*604*) IF OPAND1 <> 0 THEN BEGIN
2959 2 (*RM*) IF (DALLOC=2) AND (DTYPE=PTYP) THEN
2960 3 (*1205A*) BEGIN
2961 4 (*1205A*) EADDIR.REG := DTOP;
2962 5 (*1205A*) GENX(TMOVE,4,EADDIR,EAPUSH);
2963 6 (*1205A*) EADDIR.REG := DBOT;
2964 7 (*1205A*) GENX(TMOVE,4,EADDIR,EAPUSH);
2965 8 (*1205A*) FREEDREG;FREEDREG
2966 9 (*1205A*) END;
2967 10 (*1205G*) IF (NOT (DTYPE IN LONGTYPES)) AND (DALLOC=0) AND (AALLOC=0)
2968 11 (*1205G*) THEN STKPTR := STKPTR -1;
2969 12 (*RM*) IF AALLOC = 1 THEN BEGIN PUSHAREG;
2970 13 STKPTR:=STKPTR-1 END;
2971 14 (*RM*) IF DALLOC = 1 THEN BEGIN PUSHDREG;
2972 15 STKPTR := STKPTR -1 END;
2973 16 IF (DALLOC <> 0) OR (AALLOC <> 0)
2974 17 THEN ERROR('STK NONEMPTY IN ARG ')
2975 18 (*604*) END
2976 19 END;
2977 END; (*PXARG*)
2978
2979 PROCEDURE PXAST;
2980 0 BEGIN WITH INSTR^ DO BEGIN
2981 1 (*ASSUMES PREVIOUS 'MST' HAS DONE PUSHALL*)
2982 2 IF ODD(OPAND1) THEN OPAND1:=OPAND1+1;
2983 3 EAIMMED.DISPL := OPAND1;(*SHOULD BE LONG #*)
2984 4 EAADIR.REG := SP;
2985 5 GENX(TSUB,4,EAIMMED,EAADIR);
2986 6 (*0416A*) IF NOT (DTYPE IN LONGTYPES) THEN BEGIN
2987 7 STKPTR := STKPTR +1;
2988 8 IF STKPTR>STKMAX THEN
2989 9 ERROR('TOO MANY REG PUSHES ');
2990 10 IF OPAND1=4 THEN KINDSTKÆSTKPTRÅ
2991 11 := AREG ELSE KINDSTKÆSTKPTRÅ
2992 12 := DREG;
2993 13 IF OPAND1=4 THEN TYPESTKÆSTKPTRÅ:=ATYP
2994 14 ELSE IF OPAND1=2 THEN TYPESTKÆSTKPTRÅ:=ITYP
2995 15 ELSE IF OPAND1=1 THEN TYPESTKÆSTKPTRÅ:=BTYP
2996 16 ELSE IF OPAND1=8 THEN TYPESTKÆSTKPTRÅ:=PTYP
2997 17 ELSE TYPESTKÆSTKPTRÅ:=VTYP;
2998 18 IF DTYPE <> NOTATYP THEN BEGIN
2999 19 TYPESTKÆSTKPTRÅ:=DTYPE;
3000 20 IF DTYPE = ATYP
3001 21 THEN KINDSTKÆSTKPTRÅ := AREG
3002 22 ELSE KINDSTKÆSTKPTRÅ := DREG;
3003 23 END;
3004 24 (*0416A*) END; (* LONGTYPES CODE *)
3005 25 END;
3006 END; (*PXAST*)
3007
3008 PROCEDURE PXMOV;
3009 0 BEGIN WITH INSTR^ DO BEGIN
3010 1 WHILE AALLOC < 2 DO POPREG(AREG);
3011 2 IF OPCODE = XMOV THEN
3012 3 BEGIN ALLOCDREG;
3013 4 EAIMMED.DISPL := OPAND1;
3014 5 EADDIR.REG := DTOP;
3015 6 GENX(TMOVE,2,EAIMMED,EADDIR)
3016 7 END
3017 8 ELSE IF DALLOC < 1 THEN POPREG(DREG);
3018 9 (*BYTE COUNT IS NOW IN DTOP*)
3019 10 BUILDADDR(SOURCE,INCR,ATOP,ANONE,0);
3020 11 FREEAREG;
3021 12 BUILDADDR(DEST,INCR,ATOP,ANONE,0);
3022 13 (*RM*) GENX(TMOVE,1,SOURCE,DEST);
3023 14 (*ONLY MOVES BYTE AT A TIME NOW*)(*FIX LIKE '_BIG'*)
3024 15 EADDIR.REG := DTOP;
3025 16 (*RM*) EAIMMED.DISPL := 1;
3026 17 (*RM*) GENX(TSUB,2,EAIMMED,EADDIR);
3027 18 (*RM*) EAREL.DISPL := -4;
3028 19 (*RM*) GENX(TBNE,0,EAREL,EANONE);
3029 20 FREEAREG;FREEDREG;
3030 21 END;
3031 END; (*PXMOV*)
3032
3033 PROCEDURE PXCUP;
3034 0 BEGIN WITH INSTR^ DO BEGIN
3035 1 IF NOT PROCTABLEÆCURRLABELÅ.DEFINED THEN
3036 2 BEGIN
3037 3 LTEMP := PC;
3038 4 SAD(LTEMP, 2);
3039 5 REFERENCELABEL(CURRLABEL,LTEMP)
3040 6 END;
3041 7 PROCTABLEÆCURRLABELÅ.REFED := TRUE;
3042 8 PUSHALL;
3043 9 LTEMP := PROCTABLEÆCURRLABELÅ.LOCATION ;
3044 10 LSB(LTEMP, PC);
3045 11 IF SHORT(LTEMP) THEN BEGIN
3046 12 LASGN(EAREL.DISPL, LTEMP);
3047 13 IF (EAREL.DISPL >-128) AND (EAREL.DISPL < 127) THEN
3048 14 BEGIN
3049 15 EALAB.DISPL := CURRLABEL;
3050 16 GENX(TBSR, 2,EALAB,EANONE) ;
3051 17 END
3052 18 ELSE BEGIN
3053 19 EALAB.DISPL := CURRLABEL;
3054 20 GENX(TLBSR,2,EALAB,EANONE);
3055 21 END;
3056 22 END ELSE
3057 23 BEGIN
3058 24 EADEFER.REG := A3;
3059 25 GENX(TJSR,2,EADEFER,EANONE);
3060 26 (*604*) PCPRINT;
3061 27 WRITE(LISTING,' ':10,'DC.L ':7,'$':1);
3062 28 SSB(LTEMP,2);
3063 29 PLINT(LISTING,LTEMP);
3064 30 WRITELN(LISTING,' ');
3065 31 FOR K := 0 TO 3 DO
3066 32 BEGIN
3067 33 EAIMMED.DISPL := LTEMPÆKÅ;
3068 34 GENX(TDC,1,EAIMMED,EANONE)
3069 35 END
3070 36 END
3071 37 END;
3072 END; (*PXCUP*)
3073
3074 PROCEDURE PXVJP;
3075 0 BEGIN WITH INSTR^ DO BEGIN
3076 1 (*604*) PCPRINT;
3077 2 (*RM*) WRITELN(LISTING,' ':10,'DC.W L',
3078 3 (*RM*) OPAND1 + LABELOFFSET:0,'-L',
3079 4 (*RM*) LASTLABEL + LABELOFFSET:0); (* GENX!!*)
3080 5 IF LABELTABLEÆOPAND1Å.DEFINED
3081 6 THEN
3082 7 BEGIN
3083 8 LTEMP := LABELTABLEÆOPAND1Å.LOCATION;
3084 9 LSB(LTEMP,LABELTABLEÆLASTLABELÅ.LOCATION);
3085 10 LASGN(EAIMMED.DISPL, LTEMP)
3086 11 END
3087 12 ELSE
3088 13 BEGIN
3089 14 LTEMP := LABELTABLEÆLASTLABEL-1Å.LOCATION;
3090 15 LSB(LTEMP,LABELTABLEÆLASTLABEL-2Å.LOCATION);
3091 16 SAD(LTEMP,1);
3092 17 SHL(LTEMP,1); (*TIMES 2*)
3093 18 (*0401A*)
3094 19 LASGN(EAIMMED.DISPL,LTEMP)
3095 20 END;
3096 21 GENX(TDC,2,EAIMMED,EANONE);
3097 22 (*RM*) END;
3098 END; (*PXVJP*)
3099
3100 PROCEDURE PXUJP;
3101 VAR FLAG: BOOLEAN; (* INDICATES THAT CMP ALREADY DONE *)
3102 0 BEGIN WITH INSTR^ DO BEGIN
3103 1 FLAG := OPAND3 >= 200;
3104 2 IF FLAG THEN OPAND3 := OPAND3 - 100;
3105 3 IF LABELTABLEÆOPAND1Å.DEFINED = TRUE
3106 4 THEN
3107 5 BEGIN
3108 6 LTEMP := LABELTABLEÆOPAND1Å.LOCATION;
3109 7 LSB(LTEMP, PC);
3110 8 SSB(LTEMP,2);
3111 9 LASGN(K, LTEMP)
3112 10 END
3113 11 ELSE K := 200;
3114 12 CASE SUBTYPEÆOPCODEÅ OF
3115 13 1 (*UJP*) : BEGIN OPCDE := TBRA;
3116 14 IF (K<-127) OR (K>127) THEN OPCDE := TLBRA END;
3117 15 2 (*FJP*) : BEGIN OPCDE := TBEQ ;
3118 16 IF (K<-127) OR (K>127) THEN OPCDE := TLBEQ ;
3119 17 IF (DALLOC = 0) AND (OPAND3 < 100)
3120 18 THEN POPREG(DREG);
3121 19 END
3122 20 END;
3123 21 BUILDADDR(SOURCE,LABELLED,ANONE,ANONE,OPAND1);
3124 22 IF OPAND3 >100
3125 23 THEN BEGIN
3126 24 OPAND3 := OPAND3 - 100;
3127 25 IF SWITCH THEN
3128 26 BEGIN
3129 27 IF (OPAND3=3) OR (OPAND3=4) THEN OPAND3:=OPAND3+2
3130 28 ELSE IF (OPAND3=5) OR (OPAND3=6) THEN OPAND3:=OPAND3-2;
3131 29 END ;
3132 30 CASE OPAND3 OF
3133 31 1: ; (* NEQ ALREADY TURNED AROUND *)
3134 32 2: IF OPCDE = TBEQ THEN OPCDE := TBNE
3135 33 ELSE OPCDE := TLBNE;
3136 34 3: IF OPCDE = TBEQ THEN OPCDE := TBGE
3137 35 ELSE OPCDE := TLBGE;
3138 36 4: IF OPCDE = TBEQ THEN OPCDE := TBGT
3139 37 ELSE OPCDE := TLBGT;
3140 38 5: IF OPCDE = TBEQ THEN OPCDE := TBLE
3141 39 ELSE OPCDE := TLBLE;
3142 40 6: IF OPCDE = TBEQ THEN OPCDE := TBLT
3143 41 ELSE OPCDE := TLBLT;
3144 42 END; (*CASE*)
3145 43 END;
3146 44 GENX(OPCDE,0,SOURCE,EANONE) ;
3147 45 IF LABELTABLEÆOPAND1Å.DEFINED = FALSE THEN
3148 46 BEGIN
3149 47 LTEMP := PC;
3150 48 SSB(LTEMP, 2);
3151 49 REFERENCELABEL(OPAND1,LTEMP);
3152 50 END;
3153 51 IF (OPCODE = XFJP) AND (NOT FLAG) THEN FREEDREG;
3154 52 END;
3155 END; (*PXUJP*)
3156
3157 PROCEDURE PXDIF;
3158 0 BEGIN
3159 1 (*THE BELOW SHOULD BE OPTIMIZED FOR THE CASE
3160 2 WHEN ONE ARGUMENT IS A CONSTANT *)
3161 3 SETOPS;
3162 END; (*PXDIF*)
3163
3164 (*604*) PROCEDURE PXSPOS;
3165 0 (*604*) BEGIN
3166 1 (*604*) WITH INSTR^ DO
3167 2 (*604*) BEGIN
3168 3 (*604*) LONGBSR;
3169 4 (*604*) IF OPCODE <> XSCON
3170 5 THEN BEGIN
3171 6 DTYPE := ITYP;
3172 7 ALLOCDREG
3173 8 END
3174 9 (*604*) END
3175 (*604*) END; (* PXSPOS *)
3176
3177 PROCEDURE PXSDEL;
3178 0 BEGIN
3179 1 WITH INSTR^ DO
3180 2 BEGIN
3181 3 IF DALLOC = 0
3182 4 THEN BEGIN
3183 5 EADDIR.REG := D1;
3184 6 GENX(TMOVE,2,EAPOP,EADDIR);
3185 7 EADDIR.REG := D0;
3186 8 GENX(TMOVE,2,EAPOP,EADDIR);
3187 9 STKPTR := STKPTR - 2;
3188 10 DPOPCNT := DPOPCNT + 2
3189 11 END ELSE
3190 12 IF DALLOC = 1
3191 13 THEN BEGIN
3192 14 BUILDADDR(SOURCE,DDIRECT,DTOP,ANONE,0);
3193 15 EADDIR.REG := D1;
3194 16 GENX(TMOVE,2,SOURCE,EADDIR);
3195 17 EADDIR.REG := D0;
3196 18 GENX(TMOVE,2,EAPOP,EADDIR);
3197 19 STKPTR := STKPTR - 1;
3198 20 DPOPCNT := DPOPCNT + 1
3199 21 END;
3200 22 LONGBSR
3201 23 END;
3202 24 FREEDREG;FREEDREG
3203 END; (* PXSDEL *)
3204
3205 (*604*) PROCEDURE PXSINS;
3206 0 BEGIN
3207 1 WITH INSTR^ DO
3208 2 BEGIN
3209 3 IF DALLOC = 0 THEN POPREG(DREG);
3210 4 IF DTOP <> D0
3211 5 THEN BEGIN
3212 6 BUILDADDR(SOURCE,DDIRECT,DTOP,ANONE,0);
3213 7 EADDIR.REG := D0;
3214 8 GENX(TMOVE,2,SOURCE,EADDIR)
3215 9 END;
3216 10 LONGBSR;
3217 11 FREEDREG;
3218 12 END
3219 END; (* PXSINS *)
3220
3221
3222 PROCEDURE PXINN;
3223 0 BEGIN WITH INSTR^ DO BEGIN
3224 1 WHILE DALLOC < 3 DO POPREG(DREG);
3225 2 (* THE BELOW SHOULD BE OPTIMIZED FOR THE CASE
3226 3 WHERE ONE ARGUMENT IS A CONSTANT*)
3227 4 (*RM*) EADDIR.REG := PREVIOUS(PREVIOUS(DTOP));
3228 5 EAIMMED.DISPL := 32;
3229 6 (*RM*) GENX(TCMP,1,EAIMMED,EADDIR);
3230 7 (*RM*) EAREL.DISPL := 6;
3231 8 (*RM*) GENX(TBLT,0,EAREL,EANONE);
3232 9 BUILDADDR(DEST,DDIRECT,PREVIOUS(DTOP),DNONE,0);
3233 10 GENX(TBTST,0,EADDIR,DEST);
3234 11 (*RM*) EAREL.DISPL := 4;
3235 12 (*RM*) GENX(TBRA,0,EAREL,EANONE);
3236 13 (*RM*) BUILDADDR(DEST,DDIRECT,DTOP,DNONE,0);
3237 14 GENX(TBTST,0,EADDIR,DEST);
3238 15 FREEDREG; FREEDREG;
3239 16 EADDIR.REG := DTOP;
3240 17 (*RM*) GENX(TSNE,0,EADDIR,EANONE);
3241 18 (*1015A*) GENX(TNEG,1,EADDIR,EANONE);
3242 19 (*1323A*) REGTYPEÆDTOPÅ := BTYP;
3243 20 END;
3244 END; (*PXINN*)
3245
3246 PROCEDURE PXSGS;
3247 0 BEGIN WITH INSTR^ DO BEGIN
3248 1 IF DALLOC < 1 THEN POPREG(DREG);
3249 2 (*THE BELOW SHOULD BE OPTIMIZED FOR THE CASE
3250 3 WHEN ONE ARGUMENT IS A CONSTANT*)
3251 4 (*RM*) ALLOCDREG;ALLOCDREG;
3252 5 (*RM*) EADDIR.REG := DTOP;
3253 6 (*RM*) GENX(TCLR,4,EADDIR,EANONE);
3254 7 (*RM*) EADDIR.REG := PREVIOUS(DTOP);
3255 8 (*RM*) GENX(TCLR,4,EADDIR,EANONE);
3256 9 (*RM*) EADDIR.REG := PREVIOUS(PREVIOUS(DTOP));
3257 10 (*RM*) EAIMMED.DISPL := 32;
3258 11 (*RM*) GENX(TCMP,1,EAIMMED,EADDIR);
3259 12 (*RM*) EAREL.DISPL := 6;
3260 13 (*1204A*) GENX(TBGE,0,EAREL,EANONE);
3261 14 (*RM*) BUILDADDR(DEST,DDIRECT,PREVIOUS(DTOP),DNONE,0);
3262 15 (*RM*) GENX(TBSET,0,EADDIR,DEST);
3263 16 (*RM*) EAREL.DISPL := 4;
3264 17 (*RM*) GENX(TBRA,0,EAREL,EANONE);
3265 18 (*RM*) BUILDADDR(DEST,DDIRECT,DTOP,DNONE,0);
3266 19 (*RM*) GENX(TBSET,0,EADDIR,DEST);
3267 20 (*1204A*) GENX(TMOVE,4,DEST,EADDIR);
3268 21 (*1204A*) FREEDREG;
3269 22 END;
3270 END; (*PXSGS*)
3271
3272 PROCEDURE PXCHK;
3273 0 BEGIN
3274 1 WITH INSTR^ DO
3275 2 BEGIN
3276 3 EADDIR.REG := D7; (* USE D7 FOR CHECKING *)
3277 4 SOURCE := EADDIR;
3278 5 (*604*) IF ((DTYPE<>ATYP) AND (DTOP=DNONE)) OR ((DTYPE=ATYP) AND (ATOP=ANONE))
3279 6 THEN BEGIN
3280 7 SOURCE.REG := A7;
3281 8 SOURCE.MODE := DEFER
3282 9 END
3283 10 (*604*) ELSE IF DTYPE=ATYP THEN BEGIN
3284 11 (*604*) SOURCE.REG := ATOP;
3285 12 (*604*) SOURCE.MODE := ADIRECT
3286 13 (*604*) END
3287 14 (*604*) ELSE SOURCE.REG := DTOP;
3288 15 (*604*) GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EADDIR);
3289 16 IF SIZEÆDTYPEÅ = 1
3290 17 THEN GENX(TEXTE,2,EADDIR,EANONE);
3291 18 (*604*) IF DTYPE IN ÆATYP,JTYPÅ
3292 19 (*604*) THEN BEGIN OPAND1:=1; OPAND2:=1 END; (* FAKE OUT NEXT INSTRS*)
3293 20 IF OPAND2 = 0
3294 21 THEN BEGIN
3295 22 GENX(TNEG,2,EADDIR,EANONE);
3296 23 EAIMMED.DISPL := -OPAND1
3297 24 END;
3298 25 IF OPAND1 = 0 THEN EAIMMED.DISPL := OPAND2;
3299 26 IF (OPAND1=0) OR (OPAND2=0)
3300 27 THEN GENX(TCHK,2,EAIMMED,EADDIR)
3301 28 ELSE
3302 29 (*604*) IF NOT (DTYPE IN ÆJTYP,ATYPÅ)
3303 30 (*604*) THEN BEGIN
3304 31 SASGN(LTEMP,OPAND2);
3305 32 IF OPAND1 > 0
3306 33 THEN SAD (LTEMP,OPAND1)
3307 34 ELSE SSB(LTEMP,OPAND1);
3308 35 IF SHORT(LTEMP)
3309 36 THEN BEGIN
3310 37 EAIMMED.DISPL := OPAND1;
3311 38 GENX(TSUB,2,EAIMMED,EADDIR);
3312 39 EAIMMED.DISPL := OPAND2 - OPAND1;
3313 40 GENX(TCHK,2,EAIMMED,EADDIR)
3314 41 END
3315 42 ELSE BEGIN
3316 43 EAIMMED.DISPL := OPAND1;
3317 44 GENX(TCMP,2,EAIMMED,EADDIR);
3318 45 EAREL.DISPL := 8;
3319 46 GENX(TBLT,0,EAREL,EANONE);
3320 47 EAIMMED.DISPL := OPAND2;
3321 48 GENX(TCMP,2,EAIMMED,EADDIR);
3322 49 EAREL.DISPL := 2;
3323 50 GENX(TBLE,0,EAREL,EANONE);
3324 51 EAIMMED.DISPL := 13;
3325 52 GENX(TTRAP,2,EAIMMED,EANONE)
3326 53 END
3327 54 END
3328 55 (*604*) ELSE IF DTYPE=JTYP THEN BEGIN (*JTYP*)
3329 56 (*604*) EAPSET.DISPL := 0;
3330 57 (*604*) GENX(TCMP,4,EAPSET,EADDIR);
3331 58 (*604*) EAREL.DISPL := 10;
3332 59 (*604*) GENX(TBLT,0,EAREL,EANONE);
3333 60 (*604*) EAPSET.DISPL := 8;
3334 61 (*604*) GENX(TCMP,4,EAPSET,EADDIR);
3335 62 (*604*) EAREL.DISPL := 4;
3336 63 (*604*) GENX(TBLE,0,EAREL,EANONE);
3337 64 (*604*) EAIMMED.DISPL := 13;
3338 65 (*604*) GENX(TTRAP,2,EAIMMED,EANONE)
3339 66 (*604*) END
3340 67 (*604*) ELSE BEGIN (*ATYP*)
3341 68 (*604*) EABASED.DISPL := 368;
3342 69 (*604*) EABASED.REG := A5;
3343 70 (*604*) GENX(TCMP,4,EABASED,EADDIR);
3344 71 (*604*) EAREL.DISPL := 6;
3345 72 (*604*) GENX(TBLT,0,EAREL,EANONE);
3346 73 (*604*) EABASED.DISPL := 4;
3347 74 (*604*) GENX(TCMP,4,EABASED,EADDIR);
3348 75 (*604*) EAREL.DISPL := 4;
3349 76 (*604*) GENX(TBLE,0,EAREL,EANONE);
3350 77 (*604*) EAIMMED.DISPL := 13;
3351 78 (*604*) GENX(TTRAP,2,EAIMMED,EANONE)
3352 79 (*604*) END
3353 80 END (* WITH *)
3354 END; (*PXCHK*)
3355
3356
3357 (*RM*) PROCEDURE PXCVB;
3358 0 BEGIN WITH INSTR^ DO BEGIN
3359 1 (*604*) IF (NOT (DTYPE IN LONGTYPES))
3360 2 (*604*) THEN BEGIN
3361 3 (*604*) IF DALLOC < 1 THEN POPREG(DREG);
3362 4 (*604*) IF OPCODE = XCVB
3363 5 (*604*) THEN BEGIN
3364 6 (*604*) IF DALLOC < 2 THEN POPREG(DREG);
3365 7 (*604*) EADDIR.REG := PREVIOUS(DTOP)
3366 8 (*604*) END
3367 9 (*604*) ELSE EADDIR.REG := DTOP;
3368 10 (*604*) REGTYPEÆEADDIR.REGÅ := DTYPE;
3369 11 (*604*) IF (D1TYPE=HTYP) AND (DTYPE=JTYP)
3370 12 (*604*) THEN GENX(TEXTE,2,EADDIR,EANONE);
3371 13 (*604*) IF SIZEÆDTYPEÅ > SIZEÆD1TYPEÅ
3372 14 (*604*) THEN GENX(TEXTE,SIZEÆDTYPEÅ,EADDIR,EANONE);
3373 15 (*604*) END;
3374 16 (*604*) IF (D1TYPE=CTYP) AND (DTYPE=STYP)
3375 17 (*604*) THEN BEGIN
3376 18 (*604*) IF DALLOC<1 THEN POPREG(DREG);
3377 19 (*604*) EADDIR.REG := DTOP;
3378 20 (*604*) FREEDREG;
3379 21 PUSHALL;
3380 22 GENX(TMOVE,1,EADDIR,EAPUSH);
3381 23 (*604*) EAIMMED.DISPL := 1;
3382 24 (*604*) GENX(TMOVE,2,EAIMMED,EAPUSH)
3383 25 (*604*) END;
3384 26 (*RM*) IF ((D1TYPE=VTYP) AND (DTYPE=STYP)) THEN BEGIN
3385 27 (*RM*) EAIMMED.DISPL := OPAND1;
3386 28 (*RM*) GENX(TMOVE,2,EAIMMED,EAPUSH);
3387 29 (*RM*) END;
3388 30 (*RM*) IF ((D1TYPE=STYP) AND (DTYPE=VTYP))
3389 31 (*RM*) OR ((D1TYPE=STYP) AND (DTYPE=UTYP))
3390 32 (*RM*) OR ((D1TYPE=UTYP) AND (DTYPE=STYP)) THEN BEGIN
3391 33 (*RM*) ALLOCDREG;
3392 34 (*RM*) EADDIR.REG := DTOP;
3393 35 (*RM*) EAIMMED.DISPL := OPAND1;
3394 36 (*RM*) GENX(TMOVE,4,EAIMMED,EADDIR);
3395 37 (*RM*) FREEDREG;
3396 38 LONGBSR;
3397 39 (*RM*) END
3398 40 (*RM*) END;
3399 END; (*PXCVB*)
3400
3401 0 BEGIN (* GENERATE *)
3402 1 CASE INSTR^.OPCODE OF
3403 2 XATN,XCOS,XSIN,XEXP,XSQT,XLOG,XRND,XTRC:
3404 3 ERROR('REAL NOT IMPLEMENTED');
3405 4 (*604*) XSCON,XSPOS,XSLEN: PXSPOS;
3406 5 (*604*) XSINS : PXSINS;
3407 6 XSDEL,XSCOP : PXSDEL;
3408 7 XLAB: PXLAB;
3409 8 (*RM*) XEND: PXEND;
3410 9 XDEF: PXDEF;
3411 10 XENT,XENTB: PXENT;
3412 11 XRET: PXRET;
3413 12 XAB,XNG,XSQR,XNOT,XDEC,XINC,XODD: PXAB;
3414 13 XAD,XSB,XMP,XDV,XMOD,XIOR,XAND: PXAD;
3415 14 XCLO,XIFD,XAFI,XEOL,XEOF,XGET,XPUT,XPOS,XSEE,XPEE,XPOK,
3416 15 (*604*) XRDH, XWRH,
3417 16 XRST,XRWT,XRLN,XWLN,XPAG,XEIO,
3418 17 XRDB,XRDC,XRDE,XRDI,XRDJ,XRDQ,XRDR,XRDS,XRDV,
3419 18 XWRB,XWRC,XWRE,XWRI,XWRJ,XWRQ,XWRR,XWRS,XWRV: PXCLO;
3420 19 XLOD,XLDA,XSTR: PXLOD;
3421 20 XIXA: PXIXA;
3422 21 XIND: PXIND;
3423 22 XSTO: PXSTO;
3424 23 (*480*) XSTC: PXSTC;
3425 24 XLDC: PXLDC;
3426 25 XLTA: PXLTA;
3427 26 XLCA: PXLCA;
3428 27 XISC: PXISC;
3429 28 XLSC: PXLSC;
3430 29 XEQU,XNEQ,XLES,XLEQ,XGRT,XGEQ: PXEQU;
3431 30 XSTP: PXSTP;
3432 31 XEXI: PXEXI;
3433 32 XDIS: PXDIS;
3434 33 XNEW: PXNEW;
3435 34 XMRK: PXMRK;
3436 35 XRLS: PXRLS;
3437 36 XMST: PXMST;
3438 37 XARG: PXARG;
3439 38 XAST: PXAST;
3440 39 XMOV,XMOVV: PXMOV;
3441 40 XCUP: PXCUP;
3442 41 XXJP: GENXXJP;
3443 42 XVJP: PXVJP;
3444 43 XUJP,XFJP: PXUJP;
3445 44 XDIF,XINT,XUNI: PXDIF;
3446 45 XINN: PXINN;
3447 46 XSGS: PXSGS;
3448 47 XCHK:PXCHK ;
3449 48 XCVB,XCVT: PXCVB;
3450 49 XCHKF,XDAS,XEXT,XINS,XLUPA,XLSPA,XCSP,XCSPF,XCUPF,XDATA,XDATB: ;
3451 50 (*NOT CURRENTLY GEN'ED BY COMPILER*)
3452 51 XNONE: ;
3453 52 END (*CASES*)
3454 END; (*GENERATE*)
3455
3456
3457 0 BEGIN (*FLUSH*)
3458 1 OPTIMI := FIRSTI;
3459 2 CHANGED := FALSE;
3460 3 WHILE OPTIMI <> NIL DO
3461 4 BEGIN
3462 5 WITH OPTIMI^ DO
3463 6 BEGIN
3464 7 (*480*) IF INUSE AND ((OPCODE = XLDC) OR (OPCODE = XINC)
3465 8 (*480*) OR (OPCODE = XLDA))
3466 9 THEN
3467 10 BEGIN
3468 11 CASE OPCODE OF
3469 12 (*480*) XLDA: BEGIN
3470 13 (*480*) IF NOT (DTYPE IN LONGTYPES)
3471 14 (*480*) THEN
3472 15 (*480*) BEGIN
3473 16 (*480*) OPTIM2 := NEXTPCOD(OPTIMI);
3474 17 (*480*) OPTIM3 := NEXTPCOD(OPTIM2);
3475 18 (*480*) IF (OPTIM2^.OPCODE=XLDC)
3476 19 (*480*) AND (OPTIM2^.DTYPE=ITYP)
3477 20 (*480*) AND(OPTIM3^.OPCODE=XIXA)
3478 21 (*480*) THEN BEGIN
3479 22 (*480*) OPTIM2^.INUSE :=FALSE;
3480 23 (*480*) OPTIM3^.INUSE := FALSE;
3481 24 (*480*) OPTIMI^.OPAND2 :=
3482 25 (*480*) OPTIMI^.OPAND2 +
3483 26 (*480*) OPTIM2^.OPAND1 *
3484 27 (*480*) OPTIM3^.OPAND1;
3485 28 (*480*) CHANGED := TRUE
3486 29 (*480*) END
3487 30 (*480*) ELSE IF ((OPTIM2^.OPCODE=XLDC)
3488 31 (*480*) OR (OPTIM2^.OPCODE=XLOD))
3489 32 (*480*) AND (OPTIM3^.OPCODE=XSTO)
3490 33 (*480*) THEN BEGIN
3491 34 (*480*) INUSE := FALSE;
3492 35 (*480*) CHANGED := TRUE;
3493 36 (*480*) OPTIM3^.OPAND3 :=
3494 37 (*480*) OPTIM3^.OPAND1;
3495 38 (*480*) OPTIM3^.OPAND1:=OPAND1;
3496 39 (*480*) OPTIM3^.OPAND2:=OPAND2;
3497 40 (*480*) OPTIM3^.OPCODE:=XSTR
3498 41 (*480*) END
3499 42 (*480*) ELSE IF OPTIM2^.OPCODE=XIND
3500 43 (*480*) THEN BEGIN
3501 44 (*480*) OPTIM2^.INUSE :=FALSE;
3502 45 (*480*) CHANGED := TRUE;
3503 46 (*480*) OPTIMI^.OPCODE := XLOD;
3504 47 (*480*) OPTIMI^.DTYPE :=
3505 48 (*480*) OPTIM2^.DTYPE;
3506 49 (*480*) OPTIMI^.OPTYPE := OPTLI;
3507 50 (*480*) OPTIMI^.OPAND2 :=
3508 51 (*480*) OPTIMI^.OPAND2 +
3509 52 (*480*) OPTIM2^.OPAND1;
3510 53 (*480*) OPTIMI^.OPAND3 :=
3511 54 (*480*) OPTIM2^.OPAND2;
3512 55 (*480*) END
3513 56 (*480*) END
3514 57 (*480*) END; (* XLDA*)
3515 58 XLDC: BEGIN
3516 59 IF NOT (DTYPE IN LONGTYPES)
3517 60 AND (DTYPE <> JTYP) AND (DTYPE<>ATYP)
3518 61 THEN
3519 62 BEGIN
3520 63 CHANGED := TRUE; (*ASSUME*)
3521 64 (*480*) TEMPI := NEXTPCOD(OPTIMI);
3522 65 IF TEMPI^.OPCODE=XDEC
3523 66 THEN
3524 67 BEGIN
3525 68 OPAND1:=OPAND1
3526 69 - TEMPI^.OPAND1;
3527 70 TEMPI^.INUSE:=FALSE;
3528 71 END (*THEN*)
3529 72 ELSE IF TEMPI^.OPCODE=XINC
3530 73 THEN BEGIN
3531 74 OPAND1:=OPAND1+
3532 75 TEMPI^.OPAND1;
3533 76 TEMPI^.INUSE:=FALSE
3534 77 END
3535 78 ELSE IF TEMPI^.OPCODE=XAD
3536 79 THEN BEGIN
3537 80 OPCODE := XINC;
3538 81 TEMPI^.INUSE:=FALSE
3539 82 END
3540 83 ELSE IF TEMPI^.OPCODE=XSB
3541 84 THEN BEGIN
3542 85 OPCODE:= XDEC;
3543 86 TEMPI^.INUSE := FALSE
3544 87 END
3545 88 (*480*) ELSE IF TEMPI^.OPCODE=XNG
3546 89 (*480*) THEN BEGIN
3547 90 (*480*) OPAND1 := -OPAND1;
3548 91 (*480*) TEMPI^.INUSE:=FALSE
3549 92 (*480*) END
3550 93 ELSE IF (OPAND1=0)
3551 94 AND (TEMPI^.OPCODE=XIXA)
3552 95 THEN BEGIN
3553 96 INUSE := FALSE;
3554 97 TEMPI^.INUSE:=FALSE
3555 98 END
3556 99 (*480*) ELSE IF (TEMPI^.OPCODE=XCVT)
3557 100 (*480*) AND (TEMPI^.D1TYPE=CTYP)
3558 101 (*480*) AND (TEMPI^.DTYPE=ITYP)
3559 102 (*480*) THEN BEGIN
3560 103 (*480*) TEMPI^.INUSE := FALSE;
3561 104 (*480*) DTYPE := ITYP;
3562 105 (*480*) OPAND1 :=ASCIIÆ
3563 106 (*480*) OPSTRING^.
3564 107 (*480*) VSTRINGAÆ1ÅÅ
3565 108 (*480*) END
3566 109 ELSE CHANGED := FALSE;
3567 110 END (*THEN*)
3568 111 (*480*) ELSE
3569 112 (*480*) BEGIN (* S OR V *)
3570 113 (*480*) CHANGED := TRUE;
3571 114 (*480*) OPTIM2 := NEXTPCOD(OPTIMI);
3572 115 (*480*) IF (OPTIM2^.OPCODE=XCVT)
3573 116 (*480*) AND (DTYPE = STYP)
3574 117 (*480*) AND (OPTIM2^.D1TYPE=STYP)
3575 118 (*480*) AND (OPTIM2^.DTYPE=VTYP)
3576 119 AND (OPTIM2^.OPAND1<=STRLENGTH)
3577 120 (*480*) THEN BEGIN
3578 121 (*480*) OPTIM2^.INUSE := FALSE;
3579 122 (*480*) OPAND1 := OPTIM2^.OPAND1;
3580 123 (*480*) DTYPE := VTYP;
3581 124 (*480*) END
3582 125 (*480*) ELSE IF (OPTIM2^.OPCODE=XSTR)
3583 126 (*480*) AND (OPTIM2^.DTYPE=VTYP)
3584 127 (*480*) AND(DTYPE = VTYP)
3585 128 AND (OPAND1<=STRLENGTH)
3586 129 (*480*) THEN BEGIN
3587 130 (*480*) OPTIM2^.INUSE := FALSE;
3588 131 (*480*) OPCODE := XSTC;
3589 132 (*480*) OPAND3 := OPAND1;
3590 133 (*480*) OPAND1:=OPTIM2^.OPAND1;
3591 134 (*480*) OPAND2:=OPTIM2^.OPAND2
3592 135 (*480*) END
3593 136 (*480*) ELSE CHANGED := FALSE
3594 137 (*480*) END (* S OR V *)
3595 138 END; (*XLDC*)
3596 139 XINC: BEGIN
3597 140 IF NOT (DTYPE IN LONGTYPES)
3598 141 AND (DTYPE<>JTYP) AND (DTYPE <> ATYP)
3599 142 THEN BEGIN
3600 143 TEMPI := NEXTPCOD(OPTIMI);
3601 144 IF TEMPI^.OPCODE=XDEC
3602 145 THEN BEGIN
3603 146 OPAND1:=OPAND1
3604 147 - TEMPI^.OPAND1;
3605 148 TEMPI^.INUSE:=FALSE;
3606 149 IF OPAND1 = 0
3607 150 THEN INUSE := FALSE
3608 151 ELSE CHANGED :=TRUE;
3609 152 END
3610 153 END
3611 154 END; (*XINC*)
3612 155 END; (*CASE*)
3613 156 END; (*THEN*)
3614 157 END; (*WITH*)
3615 158 IF NOT CHANGED THEN OPTIMI := OPTIMI^.NEXT ELSE OPTIMI:=FIRSTI;
3616 159 CHANGED := FALSE;
3617 160 END; (*WHILE*)
3618 161 TEMPI := FIRSTI;
3619 162 WHILE TEMPI <> NIL DO
3620 163 BEGIN
3621 164 IF TEMPI^.INUSE THEN BEGIN
3622 165 IF ODD(DEBUG DIV 2) THEN FLPC := TRUE;
3623 166 GENERATE(TEMPI);
3624 167 TEMPI^.INUSE := FALSE END;
3625 168 TEMPI := TEMPI^.NEXT
3626 169 END;
3627 170 LASTI := FIRSTI;
3628 171 TEMPLEVEL := -1; (*INVALIDATE A4 (POINTER TO INTERMED LEXICAL LEVEL*)
3629 END; (*FLUSH*)
3630
3631
3632
3633 (*-------------------------------------------------------------------------
3634 INPUT SCANNER SECTION
3635 -------------------------------------------------------------------------*)
3636
3637 PROCEDURE NEXTLINE ;
3638 VAR I: INTEGER ;
3639 0 BEGIN
3640 1 IF EOF(PCODE) THEN WRITELN(OUTPUT,'**** EOF ENCOUNTERED':24) ;
3641 2 (* HALT NEEDED INSIDE THIS 'THEN' *)
3642 3 REPEAT
3643 4 LINELEN := 1 ;
3644 5 WHILE NOT EOLN(PCODE) AND (LINELEN < LINELNGTH) DO
3645 6 BEGIN
3646 7 READ(PCODE,LINEBUFÆLINELENÅ);
3647 8 LINELEN := LINELEN + 1
3648 9 END;
3649 10 READLN(PCODE);
3650 11 LINEBUFÆLINELENÅ := ' ' ;
3651 12 IF LINEBUFÆ1Å = '.' THEN LINECOUNT := LINECOUNT+1 ;
3652 13 IF (ODD(DEBUG DIV 8) AND (LINEBUFÆ1Å='.'))
3653 14 OR (ODD(DEBUG DIV 4) AND (LINEBUFÆ1Å<>'.'))
3654 15 THEN BEGIN
3655 16 WRITE(LISTING, '*' );
3656 17 FOR I:=1 TO LINELEN DO WRITE(LISTING, LINEBUFÆIÅ) ;
3657 18 IF LINEBUFÆ1Å = '.'
3658 19 THEN WRITE(LISTING,' ':(95 - LINELEN),LINECOUNT:6);
3659 20 WRITELN(LISTING,' ')
3660 21 END;
3661 22 UNTIL (LINEBUFÆ1Å <> '.') OR EOF(PCODE);
3662 23 CHCNT := 1 ;
3663 END (* NEXTLINE *) ;
3664
3665
3666
3667
3668 PROCEDURE GETHEADER;
3669 VAR
3670 I: INTEGER;
3671 OKVAL: BOOLEAN;
3672 0 BEGIN
3673 1 NEXTLINE;
3674 2 LINEBUFÆLINELEN+1Å := ' ';
3675 3 IF LINEBUFÆ3Å<>'2'
3676 4 THEN WRITELN(OUTPUT,' ***** INPUT NOT M68000 PCODES!',
3677 5 ' COMPILER PHASE 2 ABORTING. *****');
3678 6 CHCNT := 5;
3679 7 GETSTRING; (* MODULE NAME *)
3680 8 MAINFLG := LINEBUFÆ17Å <> 'S'; (* MAIN OR SUBPROGRAM *)
3681 9 CHCNT := 18; (* POINT BEYOND OPTIONS *)
3682 10 OKVAL := GETHEX;
3683 11 IF OKVAL THEN EXPROC := LTEMP; (* NUMBER OF ENTRIES IN JUMP TABLE *)
3684 12 JTSIZE := GETINTEGER; (* NUMBER OF ENTRIES IN JUMP TABLE *)
3685 13 PC := EXPROC;
3686 14 SAD(PC,JTSIZE * 10);
3687 15 OKVAL := GETHEX;
3688 16 IF OKVAL THEN HEAPSTART := LTEMP;
3689 17 OKVAL := GETHEX;
3690 18 IF OKVAL THEN STKSTART := LTEMP;
3691 19 GENSTART := PC;
3692 20 IF MAINFLG THEN SAD(PC,24); (* LEAVE ROOM FOR INIT CODE *)
3693 21 GENLOC := PC;
3694 22 COREBASE := PC;
3695 END; (* GETHEADER *)
3696
3697
3698 PROCEDURE SCAN;
3699
3700 VAR XEXTERNAL: BOOLEAN;
3701 (*RM*) I: INTEGER; (* COUNTER FOR SET INIT *)
3702
3703
3704 PROCEDURE GETOPCODE; (*PROCESS INPUT LINE FOR A LEGAL OPCODE, LOOK
3705 IT UP IN 'MN', SET CURROPCODE, CURROPTYPE *)
3706 VAR I: INTEGER;
3707 J: MNS;
3708 0 BEGIN
3709 1 WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
3710 2 CHCNT := CHCNT + 1;
3711 3
3712 4 I := 1;
3713 5 WHILE (LINEBUFÆCHCNTÅ <> ' ') AND (I<5) AND (CHCNT < LINELEN) DO
3714 6 BEGIN
3715 7 OPSYMÆIÅ := LINEBUFÆCHCNTÅ;
3716 8 CHCNT := CHCNT + 1; I := I + 1;
3717 9 END;
3718 10 WHILE I < 5 DO BEGIN OPSYMÆIÅ := ' '; I := I + 1 END;
3719 11
3720 12 CURROPCODE := XNONE;
3721 13 IF (OPSYMÆ1Å<>'Y') AND (OPSYMÆ1Å<>'Z') THEN
3722 14 FOR J := FMNÆOPSYMÆ1ÅÅ TO PRED(FMNÆSUCCIBM(OPSYMÆ1Å)Å) DO
3723 15 IF MNÆJÅ = OPSYM THEN CURROPCODE := J;
3724 16 IF CURROPCODE = XNONE THEN BEGIN ERROR('ILLEGAL OPCODE ');
3725 17 CURROPTYPE := OP0
3726 18 END
3727 19 ELSE CURROPTYPE := OTÆCURROPCODEÅ;
3728 END; (*GETOPCODE*)
3729
3730
3731 PROCEDURE GETTYPE;
3732 0 BEGIN
3733 1 WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
3734 2 CHCNT := CHCNT + 1;
3735 3 WITH CURRI^ DO BEGIN
3736 4 DTYPE := NOTATYP;
3737 5 IF (LINEBUFÆCHCNTÅ>='A') AND (LINEBUFÆCHCNTÅ<='V') THEN
3738 6 CASE LINEBUFÆCHCNTÅ OF
3739 7 'D','E','F','G','K','L','M','N','O','T': ;
3740 8 'A': DTYPE := ATYP;
3741 9 (*RM*) 'H': DTYPE := HTYP;
3742 10 'I': DTYPE := ITYP;
3743 11 'J': DTYPE := JTYP;
3744 12 'R': DTYPE := RTYP;
3745 13 'Q': DTYPE := QTYP;
3746 14 (*RM*) 'U': DTYPE := UTYP;
3747 15 'V': DTYPE := VTYP;
3748 16 'S': DTYPE := STYP;
3749 17 'B': DTYPE := BTYP;
3750 18 'C': DTYPE := CTYP;
3751 19 'P': DTYPE := PTYP
3752 20 END;
3753 21 END;
3754 22 CHCNT := CHCNT + 1;
3755 END; (*GETTYPE*)
3756
3757
3758 PROCEDURE GETLABEL;
3759 0 BEGIN
3760 1 WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
3761 2 CHCNT := CHCNT + 1;
3762 3 IF LINEBUFÆCHCNTÅ = 'L' THEN DOLLAR := FALSE
3763 4 ELSE IF LINEBUFÆCHCNTÅ = '$' THEN DOLLAR := TRUE
3764 5 ELSE ERROR('LABEL EXPECTED ');
3765 6 CHCNT := CHCNT + 1;
3766 7 IF DOLLAR THEN CURRLABEL := GETINTEGER
3767 8 ELSE BEGIN CURRLABEL := GETINTEGER - LABELOFFSET ;
3768 9 IF CURRLABEL<0 THEN CURRLABEL:= 0; (* NEEDED IF OLD PCODES *)
3769 10 IF CURRLABEL > HIGHLABEL THEN HIGHLABEL:= CURRLABEL
3770 11 END
3771 END; (*GETLABEL*)
3772
3773
3774 PROCEDURE DEFINELABEL( ABSOL: BOOLEAN);
3775
3776 PROCEDURE FIXUP(ABSOL: BOOLEAN);
3777 VAR ADDR1: ^LABELREF; ADDR2: LINT;
3778 ADDR3: INTEGER;
3779 I: INTEGER;
3780 0 BEGIN
3781 1 ADDR1 := LABELTABLEÆCURRLABELÅ.REFCHAIN;
3782 2 REPEAT
3783 3 ADDR2 := ADDR1^.CORELOC ;
3784 4 LTEMP := ADDR2;
3785 5 LSB(LTEMP,COREBASE);
3786 6 SAD(LTEMP,1);
3787 7 LASGN(I, LTEMP);
3788 8 IF I <= 0
3789 9 THEN
3790 10 BEGIN
3791 11 GENSAVE := GENLOC;
3792 12 GENLOC := ADDR2;
3793 13 LOCOUNT := MAXCORE - 20;
3794 14 CORESAVE := CORECOUNT;
3795 15 CORECOUNT := MAXCORE - 19;
3796 16 END;
3797 17 IF NOT ABSOL
3798 18 THEN BEGIN
3799 19 LTEMP := PC;
3800 20 LSB(LTEMP, ADDR2);
3801 21 LASGN(I,LTEMP);
3802 22 IF LOCOUNT <> 1
3803 23 THEN ADDR3 := LOCOUNT
3804 24 ELSE
3805 25 BEGIN
3806 26 LTEMP := ADDR2;
3807 27 LSB(LTEMP, COREBASE);
3808 28 SAD(LTEMP, 1);
3809 29 LASGN(ADDR3,LTEMP)
3810 30 END;
3811 31 COREÆADDR3Å := I DIV 256;
3812 32 COREÆADDR3+1Å := I MOD 256
3813 33 END ELSE
3814 34 BEGIN
3815 35 IF LOCOUNT <> 1
3816 36 THEN ADDR3 := LOCOUNT
3817 37 ELSE
3818 38 BEGIN
3819 39 LTEMP := ADDR2;
3820 40 LSB(LTEMP,COREBASE);
3821 41 SAD (LTEMP,1);
3822 42 LASGN(ADDR3,LTEMP)
3823 43 END;
3824 44 LASGN(I, LABELTABLEÆCURRLABELÅ.LOCATION);
3825 45 COREÆADDR3Å := DEFVALUE DIV 256;
3826 46 COREÆADDR3+1Å := DEFVALUE MOD 256;
3827 47 IF (DEFVALUE < 0) OR (I < 0)
3828 48 THEN BEGIN
3829 49 COREÆADDR3Å := ABS(COREÆADDR3Å);
3830 50 COREÆADDR3+1Å:=ABS(COREÆADDR3+1Å);
3831 51 COREÆADDR3Å := 255 - COREÆADDR3Å;
3832 52 COREÆADDR3+1Å := 256 - COREÆADDR3+1Å;
3833 53 IF COREÆADDR3+1Å = 256
3834 54 THEN BEGIN
3835 55 COREÆADDR3+1Å := 0;
3836 56 COREÆADDR3Å := COREÆADDR3Å + 1;;
3837 57 IF COREÆADDR3Å = 256
3838 58 THEN COREÆADDR3Å := 0;
3839 59 END;
3840 60 END
3841 61 END ;
3842 62 IF LOCOUNT <> 1
3843 63 THEN
3844 64 BEGIN
3845 65 EMITCODE;
3846 66 GENLOC := GENSAVE;
3847 67 LOCOUNT := 1;
3848 68 CORECOUNT := CORESAVE;
3849 69 END;
3850 70 ADDR1 := ADDR1^.NEXT;
3851 71 UNTIL ADDR1 = NIL;
3852 END; (*FIXUPLABEL*)
3853
3854 0 BEGIN (*DEFINELABEL*)
3855 1 FLUSH;
3856 2 WITH LABELTABLEÆCURRLABELÅ DO BEGIN
3857 3 IF DEFINED THEN ERROR ('DOUBLY DEFINED LABEL')
3858 4 ELSE IF REFED THEN FIXUP(ABSOL);
3859 5 DEFINED := TRUE;
3860 6 IF NOT ABSOL THEN LOCATION := PC
3861 7 ELSE SASGN(LOCATION, DEFVALUE)
3862 8 END
3863 END; (*DEFINELABEL*)
3864
3865 PROCEDURE DEFINEPROC(ABSOL: BOOLEAN);
3866
3867 PROCEDURE FIXUPPROC;
3868 VAR
3869 ADDR1:^LABELREF; ADDR2: LINT; I: INTEGER;
3870 0 BEGIN
3871 1 GENSAVE := GENLOC;
3872 2 CORESAVE := CORECOUNT;
3873 3 ADDR1 := PROCTABLEÆCURRLABELÅ.REFCHAIN;
3874 4 REPEAT
3875 5 LOCOUNT := MAXCORE - 20;
3876 6 CORECOUNT := MAXCORE - 17; (* DATA IS IN -20 TO -17 *)
3877 7 ADDR2 := ADDR1^.CORELOC;
3878 8 IF CURROPCODE = XDEF
3879 9 THEN BEGIN
3880 10 LTEMP := EXPROC;
3881 11 LSB(LTEMP, ADDR2)
3882 12 END
3883 13 ELSE BEGIN
3884 14 LTEMP := PC;
3885 15 LSB(LTEMP, ADDR2)
3886 16 END;
3887 17 FOR I := 0 TO 3 DO
3888 18 COREÆLOCOUNT + IÅ := LTEMPÆIÅ;
3889 19 GENLOC := ADDR2;
3890 20 EMITCODE;
3891 21 ADDR1 := ADDR1^.NEXT;
3892 22 UNTIL ADDR1 = NIL;
3893 23 GENLOC := GENSAVE;
3894 24 LOCOUNT := 1;
3895 25 CORECOUNT := CORESAVE;
3896 END; (*FIXUPPROC*)
3897
3898 0 BEGIN
3899 1 FLUSH;
3900 2 WITH PROCTABLEÆCURRLABELÅ DO BEGIN
3901 3 IF CURROPCODE = XENT THEN EMITCODE;
3902 4 IF DEFINED THEN ERROR('DOUBLY DEFINED LABEL')
3903 5 ELSE IF REFED THEN FIXUPPROC;
3904 6 DEFINED := TRUE;
3905 7 IF NOT ABSOL THEN LOCATION := PC
3906 8 ELSE SASGN(LOCATION, DEFVALUE);
3907 9 IF CURROPCODE=XDEF
3908 10 THEN BEGIN
3909 11 LOCATION := EXPROC;
3910 12 SAD(EXPROC,10);
3911 13 END
3912 14 END
3913 END; (*DEFINEPROC*)
3914
3915
3916
3917 PROCEDURE QUAI(VAR NEWI: IPTR);(*"QUAI" IS "QUEUE UP ANOTHER INSTRUCTION"*)
3918
3919 0 BEGIN IF LASTI^.INUSE THEN
3920 1 IF LASTI^.NEXT = NIL THEN
3921 2 BEGIN NEW(TEMPI);
3922 3 TEMPI^.OPSTRING := NIL;
3923 4 TEMPI^.OPSET := NIL;
3924 5 TEMPI^.NEXT := NIL;
3925 6 LASTI^.NEXT := TEMPI;
3926 7 LASTI := TEMPI
3927 8 END
3928 9 ELSE LASTI := LASTI^.NEXT;
3929 10 NEWI := LASTI
3930 END; (*QUAI*)
3931
3932
3933 0 BEGIN (*SCAN*)
3934 1 NEXTLINE;
3935 2
3936 3 IF LINEBUFÆ1Å <> ' ' THEN BEGIN LABELED := TRUE; (*COLLECT LABEL*)
3937 4 (*RM*) GETLABEL; LASTLABEL := CURRLABEL
3938 5 END
3939 6 ELSE LABELED := FALSE;
3940 7 GETOPCODE;
3941 8
3942 9 IF CURROPCODE = XDEF
3943 10 THEN IF NOT DOLLAR
3944 11 THEN
3945 12 BEGIN
3946 13 DEFVALUE := GETINTEGER;
3947 14 ABSOL := TRUE
3948 15 END
3949 16 ELSE ABSOL := FALSE
3950 17 ELSE ABSOL := FALSE;
3951 18
3952 19 IF LABELED THEN IF DOLLAR THEN DEFINEPROC(ABSOL)
3953 20 ELSE DEFINELABEL(ABSOL);
3954 21
3955 22 QUAI(CURRI); (*GET A QUEUE SLOT FOR A NEW INSTRUCTION *)
3956 23 WITH CURRI^ DO BEGIN
3957 24 INUSE := TRUE; DTYPE := NOTATYP; D1TYPE := NOTATYP;
3958 25 OPCODE := CURROPCODE; OPTYPE := CURROPTYPE;
3959 26 OPAND1 := 0; OPAND2 := 0; OPAND3 := 0;
3960 27
3961 28 CASE OPTYPE OF
3962 29 ENDOP, OP0: BEGIN
3963 30 OPAND1 := CURRLABEL;
3964 31 IF CURROPCODE = XDEF THEN
3965 32 IF NOT DOLLAR THEN OPAND2 := DEFVALUE
3966 33 END;
3967 34 OPLI: BEGIN OPAND1 := GETINTEGER; OPAND2 := GETINTEGER;
3968 35 DTYPE := ATYP END;
3969 36 OPT: BEGIN GETTYPE;
3970 37 IF DTYPE IN LONGTYPES THEN OPAND1 := GETINTEGER
3971 38 END;
3972 39 OPLAB: BEGIN GETLABEL; OPAND1 := CURRLABEL END;
3973 40 (*RM*) OP2T: BEGIN GETTYPE; D1TYPE := DTYPE; GETTYPE;
3974 41 (*RM*) IF D1TYPE IN ÆSTYP,UTYP,VTYPÅ THEN
3975 42 (*RM*) OPAND1 := GETINTEGER END;
3976 43 OPTI: BEGIN GETTYPE;
3977 44 IF DTYPE = NOTATYP THEN CHCNT := CHCNT - 1;
3978 45 OPAND1 := GETINTEGER;
3979 46 IF (OPAND1=0) AND (OPCODE = XARG)
3980 47 THEN BEGIN
3981 48 OPCODE := XNONE;
3982 49 INUSE := FALSE
3983 50 END;
3984 51 IF DTYPE IN LONGTYPES THEN OPAND2 := GETINTEGER
3985 52 END;
3986 53 OPT2I: BEGIN
3987 54 GETTYPE;
3988 55 IF DTYPE <> JTYP
3989 56 THEN BEGIN OPAND1 := GETINTEGER;
3990 57 OPAND2 := GETINTEGER
3991 58 END
3992 59 ELSE BEGIN
3993 60 IF OPSET = NIL THEN NEW(OPSET);
3994 61 WITH OPSET^ DO BEGIN
3995 62 FOR I := 1 TO 8 DO BEGIN
3996 63 OPAND1 := GETINTEGER;
3997 64 SETVÆI*2-1Å :=
3998 65 HEXDATAÆOPAND1 DIV 16 + 1Å;
3999 66 SETVÆI*2Å :=
4000 67 HEXDATAÆOPAND1 MOD 16 + 1Å
4001 68 END
4002 69 END;
4003 70 OPAND1 := 1;
4004 71 END
4005 72 END;
4006 73 OPI: OPAND1 := GETINTEGER;
4007 74 OP3I: BEGIN OPAND1 := GETINTEGER;
4008 75 OPAND2 := GETINTEGER;
4009 76 OPAND3 := GETINTEGER
4010 77 END;
4011 78 OPTLI: BEGIN GETTYPE; OPAND1 := GETINTEGER;
4012 79 OPAND2 := GETINTEGER;
4013 80 IF DTYPE IN LONGTYPES THEN OPAND3 := GETINTEGER
4014 81 END;
4015 82 OPTL2I: BEGIN GETTYPE; OPAND1 := GETINTEGER;
4016 83 OPAND2 := GETINTEGER;
4017 84 OPAND3 := GETINTEGER END;
4018 85 OPTV: BEGIN GETTYPE;
4019 86 (*604*) IF DTYPE IN ÆITYP,HTYPÅ THEN OPAND1 := GETINTEGER
4020 87 (*604*) ELSE IF (DTYPE=ATYP) AND (OPCODE<>XLDC)
4021 88 (*604*) THEN OPAND1 := GETINTEGER
4022 89 ELSE IF DTYPE IN Æ STYP,CTYPÅ THEN BEGIN
4023 90 IF OPSTRING = NIL THEN NEW(OPSTRING);
4024 91 GETSTRING;
4025 92 IF DTYPE = CTYP THEN ALENGTH := 1;
4026 93 OPSTRING^.STRINGL := ALENGTH;
4027 94 OPSTRING^.VSTRINGA := VSTRING
4028 95 END
4029 96 ELSE IF DTYPE = BTYP THEN BEGIN
4030 97 OPAND1 := GETINTEGER
4031 98 END
4032 99 (*604*) ELSE IF DTYPE = PTYP THEN BEGIN
4033 100 (*RM*) IF OPSET = NIL THEN NEW(OPSET);
4034 101 (*RM*) WITH OPSET^ DO BEGIN
4035 102 (*RM*) FOR I := 1 TO 8 DO BEGIN
4036 103 (*RM*) OPAND1 := GETINTEGER;
4037 104 (*RM*) SETVÆI*2-1Å := HEXDATAÆOPAND1 DIV 16+1Å;
4038 105 (*RM*) SETVÆI*2Å := HEXDATAÆOPAND1 MOD 16 + 1Å;
4039 106 (*RM*) END
4040 107 (*RM*) END;
4041 108 OPAND1 := 0
4042 109 END ELSE IF DTYPE IN ÆATYP,JTYPÅ
4043 110 THEN BEGIN
4044 111 OPAND1 := GETINTEGER;
4045 112 OPAND2 := GETINTEGER;
4046 113 OPAND3 := GETINTEGER;
4047 114 OPAND4 := GETINTEGER
4048 115
4049 116 (*RM*) END ELSE ; (* R NOT IMPLEMENTED *)
4050 117 END;
4051 118 OPENT: BEGIN OPAND1 := GETINTEGER;
4052 119 OPAND2 := GETINTEGER; (*SEGSIZE LABEL*)
4053 120 GETSTRING; (*OPTIONS(IGNORED)*)
4054 121 IF (VSTRINGÆ1Å>='0') AND(VSTRINGÆ1Å<='9')
4055 122 THEN DEBUG := ORD(VSTRINGÆ1Å)-ORD('0');
4056 123 IF (VSTRINGÆ2Å>='0') AND (VSTRINGÆ2Å<='9')
4057 124 THEN DEBUG := DEBUG * 10 +
4058 125 ORD(VSTRINGÆ2Å)-ORD('0');
4059 126 GETSTRING; (*NAME*)
4060 127 END;
4061 128 OPENTB: (*NOT CURRENTLY IMPLEMENTED*)
4062 129 END (*CASE*)
4063 130 END (*WITH*)
4064 END; (*SCAN*)
4065
4066
4067
4068
4069
4070 (*-------------------------------------------------------------------------
4071 INITIALIZATION SECTION
4072 -------------------------------------------------------------------------*)
4073
4074 PROCEDURE INIT;
4075
4076 VAR I: INTEGER;
4077 J: MNS;
4078 R: REGISTER;
4079
4080 0 BEGIN
4081 1 ERRORWR := FALSE;
4082 2 WRITELN(LISTING,' ':10,'LLEN',' ':3,'120');
4083 3
4084 4
4085 5 STKPTR := -1;
4086 6 FLPC := FALSE;
4087 7 DALLOC := 0; AALLOC := 0;
4088 8 DTOP := DNONE; ATOP := ANONE;
4089 9 DBOT := DNONE; ABOT := ANONE;
4090 10 SP := A7;
4091 11
4092 12 DALLOCCNT := 0; AALLOCCNT := 0;
4093 13 DPUSHCNT := 0; APUSHCNT := 0;
4094 14 DPOPCNT := 0; APOPCNT := 0;
4095 15
4096 16 LONGTYPES := ÆPTYP,VTYP,STYP,UTYPÅ;
4097 17
4098 18 SASGN(PC,12388);
4099 19 DEBUG := 9;
4100 20 GENLOC := PC;
4101 21 CORECOUNT := 0;
4102 22 GENSTART := PC;
4103 23 LOCOUNT := 1;
4104 24 COREBASE := PC;
4105 25 CLR(PROGSTART);
4106 26 MAINFLG := FALSE;
4107 27 LINECOUNT := -1;
4108 28 SASGN(RTJUMP,490);
4109 29 STKSTARTÆ0Å := 0; STKSTARTÆ1Å := 0; STKSTARTÆ2Å := 127;
4110 30 STKSTARTÆ3Å := 254;
4111 31 HEAPSTARTÆ0Å := 255; HEAPSTARTÆ1Å := 255; HEAPSTARTÆ2Å := 255;
4112 32 HEAPSTARTÆ3Å := 255; (* INITIALIZE HEAPSTART TO HEX FFFFFFFF *)
4113 33 JTSIZE := 10;
4114 34 LEVEL := 0;
4115 35 TEMPLEVEL := -1; (*-1 WHENEVER A4 NOT POINTING TO A VALID DISPLAY LEVEL*)
4116 36
4117 37 HIGHLABEL := 0; LABELOFFSET := 0;
4118 38 TOPLABEL := 0;
4119 39 ABSOL := FALSE;
4120 40 FOR I:= 0 TO MAXLABEL DO BEGIN PROCTABLEÆIÅ.DEFINED :=FALSE;
4121 41 PROCTABLEÆIÅ.REFED :=FALSE;
4122 42 PROCTABLEÆIÅ.REFCHAIN := NIL;
4123 43 LABELTABLEÆIÅ.REFCHAIN := NIL;
4124 44 LABELTABLEÆIÅ.DEFINED :=FALSE;
4125 45 LABELTABLEÆIÅ.REFED :=FALSE
4126 46 END;
4127 47
4128 48 NEW(FIRSTESD); WITH FIRSTESD^ DO BEGIN NAME := XNONE;
4129 49 NEXT := NIL;
4130 50 SASGN(REFERENCE, 0);
4131 51 END;
4132 52
4133 53 SIZEÆATYPÅ := 4;
4134 54 SIZEÆITYPÅ := 2;
4135 55 SIZEÆJTYPÅ := 4;
4136 56 SIZEÆRTYPÅ := 4;
4137 57 SIZEÆQTYPÅ := 8;
4138 58 SIZEÆVTYPÅ := 4;
4139 59 SIZEÆSTYPÅ := 4;
4140 60 SIZEÆBTYPÅ := 1;
4141 61 SIZEÆPTYPÅ := 8;
4142 62 SIZEÆNOTATYPÅ := 0;
4143 63 SIZEÆCTYPÅ := 1;
4144 64 (*RM*) SIZEÆHTYPÅ := 1;
4145 65 (*RM*) SIZEÆUTYPÅ := 4;
4146 66
4147 67
4148 68 (*480*) NEW(FAKEI);
4149 69 (*480*) WITH FAKEI^ DO
4150 70 (*480*) BEGIN
4151 71 (*480*) OPCODE := XNONE; NEXT := NIL; OPAND1 := 0; INUSE := TRUE;
4152 72 (*480*) OPTYPE := OP0; DTYPE := NOTATYP; D1TYPE := NOTATYP;
4153 73 (*480*) OPAND2 := 0; OPAND3 := 0; OPSTRING := NIL; OPSET := NIL
4154 74 (*480*) END;
4155 75 NEW(FIRSTI); LASTI := FIRSTI; FIRSTI^.NEXT := NIL; FIRSTI^.INUSE := FALSE;
4156 76 FIRSTI^.OPSTRING := NIL; FIRSTI^.OPSET := NIL;
4157 77
4158 78 FOR I := 1 TO STRLENGTH DO BLANKSÆIÅ := ' ';
4159 79
4160 80 MNÆXAB Å :='AB '; MNÆXAD Å :='AD ';
4161 81 MNÆXAFI Å :='AFI '; MNÆXAND Å :='AND ';
4162 82 MNÆXARG Å :='ARG ';
4163 83 MNÆXAST Å :='AST '; MNÆXATN Å :='ATN ';
4164 84 MNÆXCHK Å :='CHK '; MNÆXCHKFÅ :='CHKF';
4165 85 MNÆXCLO Å :='CLO ';
4166 86 MNÆXCOS Å :='COS '; MNÆXCSP Å :='CSP ';
4167 87 MNÆXCSPFÅ :='CSPF'; MNÆXCUP Å :='CUP ';
4168 88 MNÆXCUPFÅ :='CUPF'; MNÆXCVB Å :='CVB ';
4169 89 MNÆXCVT Å :='CVT '; MNÆXDAS Å :='DAS ';
4170 90 MNÆXDATAÅ :='DATA'; MNÆXDATBÅ :='DATB';
4171 91 MNÆXDEC Å :='DEC '; MNÆXDEF Å :='DEF ';
4172 92 MNÆXDIF Å :='DIF '; MNÆXDIS Å :='DIS ';
4173 93 MNÆXDV Å :='DV '; MNÆXEIO Å :='EIO ';
4174 94 MNÆXEND Å :='END ';
4175 95 MNÆXENT Å :='ENT '; MNÆXENTBÅ :='ENTB';
4176 96 MNÆXEOF Å :='EOF ';
4177 97 MNÆXEOL Å :='EOL '; MNÆXEQU Å :='EQU ';
4178 98 (*1015B*) MNÆXEXI Å :='EXIT'; MNÆXEXP Å :='EXP ';
4179 99 MNÆXEXT Å :='EXT '; MNÆXFJP Å :='FJP ';
4180 100 MNÆXGEQ Å :='GEQ '; MNÆXGET Å :='GET ';
4181 101 MNÆXGRT Å :='GRT '; MNÆXIFD Å :='IFD ';
4182 102 MNÆXINC Å :='INC '; MNÆXIND Å :='IND ';
4183 103 MNÆXINN Å :='INN '; MNÆXINS Å :='INS ';
4184 104 MNÆXINT Å :='INT '; MNÆXIOR Å :='IOR ';
4185 105 MNÆXISC Å :='ISC '; MNÆXIXA Å :='IXA ';
4186 106 MNÆXLAB Å :='LAB '; MNÆXLCA Å :='LCA ';
4187 107 MNÆXLDA Å :='LDA '; MNÆXLDC Å :='LDC ';
4188 108 MNÆXLEQ Å :='LEQ '; MNÆXLES Å :='LES ';
4189 109 MNÆXLOD Å :='LOD '; MNÆXLOG Å :='LOG ';
4190 110 MNÆXLSC Å :='LSC '; MNÆXLSPAÅ :='LSPA';
4191 111 MNÆXLTA Å :='LTA '; MNÆXLUPAÅ :='LUPA';
4192 112 MNÆXMOD Å :='MOD '; MNÆXMOV Å :='MOV ';
4193 113 MNÆXMOVVÅ :='MOVV'; MNÆXMP Å :='MP ';
4194 114 MNÆXMRK Å :='MRK '; MNÆXMST Å :='MST ';
4195 115 MNÆXNEQ Å :='NEQ ';
4196 116 MNÆXNEW Å :='NEW '; MNÆXNG Å :='NG ';
4197 117 MNÆXNOT Å :='NOT '; MNÆXODD Å :='ODD ';
4198 118 MNÆXPAG Å :='PAG '; MNÆXPEE Å :='PEE ';
4199 119 MNÆXPOK Å :='POK '; MNÆXPOS Å :='POS ';
4200 120 MNÆXPUT Å :='PUT '; MNÆXRDB Å :='RDB ';
4201 121 MNÆXRDC Å :='RDC '; MNÆXRDE Å :='RDE ';
4202 122 MNÆXRDI Å :='RDI '; MNÆXRDJ Å :='RDJ ';
4203 123 (*604*) MNÆXRDH Å := 'RDH '; MNÆXWRH Å := 'WRH ';
4204 124 MNÆXRDQ Å :='RDQ '; MNÆXRDR Å :='RDR ';
4205 125 MNÆXRDS Å :='RDS '; MNÆXRDV Å :='RDV ';
4206 126 MNÆXRET Å :='RET ';
4207 127 MNÆXRLN Å :='RLN '; MNÆXRLS Å :='RLS ';
4208 128 MNÆXRND Å :='RND ';
4209 129 MNÆXRST Å :='RST '; MNÆXRWT Å :='RWT ';
4210 130 MNÆXSB Å :='SB '; MNÆXSCONÅ :='SCON';
4211 131 MNÆXSCOPÅ :='SCOP'; MNÆXSDELÅ :='SDEL';
4212 132 MNÆXSEE Å :='SEE '; MNÆXSGS Å :='SGS ';
4213 133 MNÆXSIN Å :='SIN '; MNÆXSINSÅ :='SINS';
4214 134 MNÆXSLENÅ :='SLEN'; MNÆXSPOSÅ :='SPOS';
4215 135 MNÆXSQR Å :='SQR '; MNÆXSQT Å :='SQT ';
4216 136 MNÆXSTC Å :='STC ';
4217 137 MNÆXSTO Å :='STO '; MNÆXSTP Å :='STP ';
4218 138 MNÆXSTR Å :='STR '; MNÆXTRC Å :='TRC ';
4219 139 MNÆXUJP Å :='UJP '; MNÆXUNI Å :='UNI ';
4220 140 (*RM*) MNÆXVJP Å :='VJP ';
4221 141 MNÆXWLN Å :='WLN '; MNÆXWRB Å :='WRB ';
4222 142 MNÆXWRC Å :='WRC '; MNÆXWRE Å :='WRE ';
4223 143 MNÆXWRI Å :='WRI '; MNÆXWRJ Å :='WRJ ';
4224 144 MNÆXWRQ Å :='WRQ '; MNÆXWRR Å :='WRR ';
4225 145 MNÆXWRS Å :='WRS '; MNÆXWRV Å :='WRV ';
4226 146 MNÆXXJP Å :='XJP ';
4227 147 MNÆXNONEÅ :=' ';
4228 148
4229 149 FMNÆ'A'Å :=XAB ; FMNÆ'B'Å :=XCHK;
4230 150 FMNÆ'C'Å :=XCHK; FMNÆ'D'Å :=XDAS;
4231 151 FMNÆ'E'Å :=XEIO; FMNÆ'F'Å :=XFJP;
4232 152 FMNÆ'G'Å :=XGEQ; FMNÆ'H'Å :=XIFD;
4233 153 FMNÆ'I'Å :=XIFD; FMNÆ'J'Å :=XLAB;
4234 154 FMNÆ'K'Å :=XLAB; FMNÆ'L'Å :=XLAB;
4235 155 FMNÆ'M'Å :=XMOD; FMNÆ'N'Å :=XNEQ;
4236 156 FMNÆ'O'Å :=XODD; FMNÆ'P'Å :=XPAG;
4237 157 FMNÆ'Q'Å :=XRDB; FMNÆ'R'Å :=XRDB;
4238 158 FMNÆ'S'Å :=XSB ; FMNÆ'T'Å :=XTRC;
4239 159 (*RM*) FMNÆ'U'Å :=XUJP; FMNÆ'V'Å :=XVJP;
4240 160 FMNÆ'W'Å :=XWLN; FMNÆ'X'Å :=XXJP;
4241 161 FMNÆ'Y'Å :=XNONE;FMNÆ'Z'Å :=XNONE;
4242 162
4243 163 TMNÆTMOVE Å :='MOVE '; TMNÆTLINK Å :='LINK '; TMNÆTUNLK Å :='UNLK ';
4244 164 TMNÆTRTS Å :='RTS '; TMNÆTTST Å :='TST '; TMNÆTBGT Å :='BGT.S';
4245 165 TMNÆTNEG Å :='NEG '; TMNÆTSUBQ Å :='SUB '; TMNÆTBTST Å :='BTST ';
4246 166 TMNÆTSNZ Å :='SNZ '; TMNÆTADD Å :='ADD '; TMNÆTSUB Å :='SUB ';
4247 167 TMNÆTAND Å :='AND '; TMNÆTOR Å :='OR '; TMNÆTMULS Å :='MULS ';
4248 168 TMNÆTDIVS Å :='DIVS '; TMNÆTCMP Å :='CMP '; TMNÆTCLR Å :='CLR ';
4249 169 TMNÆTTRAP Å :='TRAP '; TMNÆTDCNT Å :='DCNT '; TMNÆTBSR Å :='BSR.S';
4250 170 TMNÆTADDQ Å :='ADD '; TMNÆTCOMP Å :='NOT '; TMNÆTLBSR Å :='BSR ';
4251 171 TMNÆTMOVEQÅ :='MOVE '; TMNÆTSEQ Å :='SEQ '; TMNÆTSNE Å :='SNE ';
4252 172 TMNÆTSGE Å :='SGE '; TMNÆTSLT Å :='SLT '; TMNÆTSGT Å :='SGT ';
4253 173 TMNÆTSLE Å :='SLE '; TMNÆTLEA Å :='LEA '; TMNÆTLDQ Å :='MOVE ';
4254 174 TMNÆTBRAÅ :='BRA.S'; TMNÆTBNE Å :='BNE.S'; TMNÆTEQU Å :='EQU ';
4255 175 TMNÆTBEQÅ :='BEQ.S';
4256 176 TMNÆTLBGTÅ :='BGT '; TMNÆTLBRA Å :='BRA ';
4257 177 TMNÆTLBNEÅ :='BNE '; TMNÆTLBEQÅ :='BEQ ';
4258 178 TMNÆTLBLTÅ :='BLT '; TMNÆTASL Å := 'ASL ';
4259 179 TMNÆTBLT Å :='BLT.S'; TMNÆTJMPÅ := 'JMP ';
4260 180 TMNÆTPEA Å :='PEA '; TMNÆTBSETÅ := 'BSET ';
4261 181 TMNÆTBZ Å :='BEQ '; TMNÆTJSR Å := 'JSR ';
4262 182 (*RM*) TMNÆTEOR Å :='EOR ';
4263 183 (*RM*) TMNÆTEXTE Å := 'EXT '; TMNÆTSWAPÅ :='SWAP ';
4264 184 TMNÆTCMPM Å := 'CMPM ';
4265 185 TMNÆTBNZ Å := 'BNE.S'; TMNÆTBGE Å := 'BGE.S';
4266 186 TMNÆTBLE Å := 'BLE.S'; TMNÆTCHK Å := 'CHK ';
4267 187 TMNÆTDC Å := 'DC '; (*DUMMY INSTR*)
4268 188 TMNÆTLBLEÅ := 'BLE '; TMNÆTLBGEÅ := 'BGE ';
4269 189
4270 190
4271 191
4272 192 (*RM*) DNAMEÆATYPÅ := 'A'; DNAMEÆITYPÅ := 'I'; DNAMEÆJTYPÅ := 'J';
4273 193 (*RM*) DNAMEÆRTYPÅ := 'R'; DNAMEÆQTYPÅ := 'Q'; DNAMEÆVTYPÅ := 'V';
4274 194 (*RM*) DNAMEÆSTYPÅ := 'S'; DNAMEÆBTYPÅ := 'B'; DNAMEÆPTYPÅ := 'P';
4275 195 (*RM*) DNAMEÆNOTATYPÅ :=' '; DNAMEÆCTYPÅ := 'C'; DNAMEÆHTYPÅ :='H';
4276 196 (*RM*) DNAMEÆUTYPÅ := 'U';
4277 197
4278 198 FOR J := XAB TO XXJP DO OTÆJÅ := OP0;
4279 199
4280 200 OTÆXAB Å := OPT ; OTÆXAD Å := OPT ;
4281 201 (*604*) OTÆXARG Å := OPTI ; (* CHANGE FOR 6809 CHIPS STUFF *)
4282 202 OTÆXAST Å := OPTI ; OTÆXATN Å := OPT ;
4283 203 (*604*) OTÆXCHK Å := OPT2I ; OTÆXCHKFÅ := OPT ;
4284 204 OTÆXCOS Å := OPT ; OTÆXCSP Å := OPLAB ;
4285 205 OTÆXCUP Å := OPLAB ;
4286 206 OTÆXCVB Å := OP2T ;
4287 207 OTÆXCVT Å := OP2T ; OTÆXDAS Å := OPI ;
4288 208 (*DATA,DATB*)
4289 209 OTÆXDEC Å := OPTI ;
4290 210 OTÆXDIS Å := OPI ;
4291 211 OTÆXDV Å := OPT ; OTÆXEND Å := ENDOP ;
4292 212 OTÆXENT Å := OPENT ; OTÆXENTBÅ := OPENTB;
4293 213 OTÆXEQU Å := OPT ;
4294 214 OTÆXEXI Å := OPI ;
4295 215 OTÆXEXP Å := OPT ;
4296 216 OTÆXEXT Å := OPTL2I; OTÆXFJP Å := OPLAB ;
4297 217 OTÆXGEQ Å := OPT ;
4298 218 OTÆXGRT Å := OPT ;
4299 219 OTÆXINC Å := OPTI ; OTÆXIND Å := OPTI ;
4300 220 OTÆXINS Å := OP3I ;
4301 221 OTÆXIXA Å := OPI ;
4302 222 OTÆXLCA Å := OPTV ;
4303 223 OTÆXLDA Å := OPLI ; OTÆXLDC Å := OPTV ;
4304 224 OTÆXLEQ Å := OPT ; OTÆXLES Å := OPT ;
4305 225 OTÆXLOD Å := OPTLI ; OTÆXLOG Å := OPT ;
4306 226 OTÆXLSC Å := OPI ; OTÆXLSPAÅ := OPI ;
4307 227 OTÆXLUPAÅ := OPI ;
4308 228 OTÆXMOD Å := OPT ; OTÆXMOV Å := OPI ;
4309 229 OTÆXMP Å := OPT ;
4310 230 OTÆXNEQ Å := OPT ;
4311 231 OTÆXNEW Å := OPI ; OTÆXNG Å := OPT ;
4312 232 OTÆXODD Å := OPT ;
4313 233 OTÆXRET Å := OPLI ;
4314 234 OTÆXRND Å := OPT ;
4315 235 OTÆXSB Å := OPT ;
4316 236 OTÆXSIN Å := OPT ;
4317 237 OTÆXSQR Å := OPT ; OTÆXSQT Å := OPT ;
4318 238 OTÆXSTO Å := OPT ;
4319 239 OTÆXSTR Å := OPTLI ; OTÆXTRC Å := OPT ;
4320 240 OTÆXUJP Å := OPLAB ;
4321 241 (*RM*) OTÆXVJP Å := OPLAB;
4322 242 OTÆXXJP Å := OPLAB ;
4323 243
4324 244 FOR J := XAB TO XNONE DO FLÆJÅ := TRUE;
4325 245
4326 246 FLÆXAB Å := FALSE; FLÆXAD Å := FALSE; FLÆXAND Å := FALSE;
4327 247 FLÆXAST Å := FALSE; FLÆXCVB Å := FALSE; FLÆXCVT Å := FALSE;
4328 248 FLÆXDAS Å := FALSE;
4329 249 FLÆXDATAÅ := FALSE; FLÆXDATBÅ := FALSE; FLÆXDEC Å := FALSE;
4330 250 FLÆXDIF Å := FALSE; FLÆXDV Å := FALSE; FLÆXEQU Å := FALSE;
4331 251 FLÆXEXT Å := FALSE;
4332 252 FLÆXGEQ Å := FALSE; FLÆXGRT Å := FALSE; FLÆXINC Å := FALSE;
4333 253 FLÆXIND Å := FALSE; FLÆXINN Å := FALSE; FLÆXINS Å := FALSE;
4334 254 FLÆXINT Å := FALSE;
4335 255 FLÆXIOR Å := FALSE;
4336 256 FLÆXIXA Å := FALSE; FLÆXLCA Å := FALSE; FLÆXLDA Å := FALSE;
4337 257 FLÆXLDC Å := FALSE; FLÆXLEQ Å := FALSE; FLÆXLES Å := FALSE;
4338 258 FLÆXLOD Å := FALSE; FLÆXLSPAÅ := FALSE; FLÆXLTA Å := FALSE;
4339 259 FLÆXLUPAÅ := FALSE;
4340 260 FLÆXMOD Å := FALSE; FLÆXMOV Å := FALSE; FLÆXMP Å := FALSE;
4341 261 FLÆXNEQ Å := FALSE; FLÆXNG Å := FALSE; FLÆXNOT Å := FALSE;
4342 262 FLÆXODD Å := FALSE; FLÆXSB Å := FALSE; FLÆXSQR Å := FALSE;
4343 263 FLÆXUNI Å := FALSE; FLÆXNONEÅ := FALSE;
4344 264
4345 265 FOR J := XAB TO XXJP DO SUBTYPEÆJÅ := 0;
4346 266
4347 267 SUBTYPEÆXAB Å := 1; SUBTYPEÆXAD Å := 1;
4348 268 SUBTYPEÆXNG Å := 2; SUBTYPEÆXSB Å := 2;
4349 269 SUBTYPEÆXDEC Å := 3; SUBTYPEÆXAND Å := 3;
4350 270 SUBTYPEÆXINC Å := 4; SUBTYPEÆXIOR Å := 4;
4351 271 SUBTYPEÆXNOT Å := 5; SUBTYPEÆXMP Å := 5;
4352 272 SUBTYPEÆXODD Å := 6; SUBTYPEÆXDV Å := 6;
4353 273 SUBTYPEÆXSQR Å := 7; SUBTYPEÆXMOD Å := 7;
4354 274
4355 275 SUBTYPEÆXLOD Å := 1; SUBTYPEÆXEQU Å := 1;
4356 276 SUBTYPEÆXLDA Å := 2; SUBTYPEÆXNEQ Å := 2;
4357 277 SUBTYPEÆXSTR Å := 3; SUBTYPEÆXLES Å := 3;
4358 278 SUBTYPEÆXLEQ Å := 4;
4359 279 SUBTYPEÆXGRT Å := 5;
4360 280 SUBTYPEÆXGEQ Å := 6;
4361 281 SUBTYPEÆXUJP Å := 1;
4362 282 SUBTYPEÆXFJP Å := 2;
4363 283
4364 284 BUILDADDR(EANONE,NONE,ANONE,ANONE,0);
4365 285 BUILDADDR(EADDIR,DDIRECT,ANONE,ANONE,0);
4366 286 BUILDADDR(EAADIR,ADIRECT,ANONE,ANONE,0);
4367 287 BUILDADDR(EAIMMED,IMMED,ANONE,ANONE,0);
4368 288 BUILDADDR(EADEFER,DEFER,ANONE,ANONE,0);
4369 289 BUILDADDR(EAINCR,INCR,ANONE,ANONE,0);
4370 290 BUILDADDR(EAPOP,INCR,SP,ANONE,0);
4371 291 BUILDADDR(EAPUSH,DECR,SP,ANONE,0);
4372 292 BUILDADDR(EALIMM,LABIMMED,ANONE,ANONE,0);
4373 293 BUILDADDR(EAREL,RELATIVE,ANONE,ANONE,0);
4374 294 BUILDADDR(EALAB,LABELLED,ANONE,ANONE,0);
4375 295 (*RM*) BUILDADDR(EAPSET,PIMMED,ANONE,ANONE,0);
4376 296 BUILDADDR(EABASED,BASED,ANONE,ANONE,0);
4377 297 BUILDADDR(EALONG,LIMMED,ANONE,ANONE,0);
4378 298
4379 299 FOR R := DNONE TO A7 DO REGTYPEÆRÅ := NOTATYP;
4380 300
4381 301 R := D0;
4382 302 FOR I:= 0 TO NDREGS DO BEGIN DREGSÆIÅ := R;
4383 303 R := SUCC(R)
4384 304 END;
4385 305 R := A0;
4386 306 FOR I:= 0 TO NAREGS DO BEGIN AREGSÆIÅ := R;
4387 307 R := SUCC(R)
4388 308 END;
4389 309
4390 310 MACHCODE := ' ';
4391 311 MACHINDEX := 1;
4392 312 HEXDATA := '0123456789ABCDEF';
4393 313
4394 314 SASGN(EXPROC,12288); (* HEX 3000 *)
4395 315
4396 316 FOR C := CHR(0) TO CHR(127) DO ASCIIÆCÅ := 32; (*BLANK*)
4397 317 ASCIIÆ'a'Å:=97; ASCIIÆ'b'Å:=98; ASCIIÆ'c'Å:=99; ASCIIÆ'd'Å:=100;
4398 318 ASCIIÆ'e'Å:=101;ASCIIÆ'f'Å:=102;ASCIIÆ'g'Å:=103;ASCIIÆ'h'Å:=104;
4399 319 ASCIIÆ'i'Å:=105;ASCIIÆ'j'Å:=106;ASCIIÆ'k'Å:=107;ASCIIÆ'l'Å:=108;
4400 320 ASCIIÆ'm'Å:=109;ASCIIÆ'n'Å:=110;ASCIIÆ'o'Å:=111;ASCIIÆ'p'Å:=112;
4401 321 ASCIIÆ'q'Å:=113;ASCIIÆ'r'Å:=114;ASCIIÆ's'Å:=115;ASCIIÆ't'Å:=116;
4402 322 ASCIIÆ'u'Å:=117;ASCIIÆ'v'Å:=118;ASCIIÆ'w'Å:=119;ASCIIÆ'x'Å:=120;
4403 323 ASCIIÆ'y'Å:=121;ASCIIÆ'z'Å:=122;
4404 324 ASCIIÆ'A'Å:=65; ASCIIÆ'B'Å:=66; ASCIIÆ'C'Å:=67; ASCIIÆ'D'Å:=68;
4405 325 ASCIIÆ'E'Å:=69; ASCIIÆ'F'Å:=70; ASCIIÆ'G'Å:=71; ASCIIÆ'H'Å:=72;
4406 326 ASCIIÆ'I'Å:=73; ASCIIÆ'J'Å:=74; ASCIIÆ'K'Å:=75; ASCIIÆ'L'Å:=76;;
4407 327 ASCIIÆ'M'Å:=77; ASCIIÆ'N'Å:=78; ASCIIÆ'O'Å:=79; ASCIIÆ'P'Å:=80;
4408 328 ASCIIÆ'Q'Å:=81; ASCIIÆ'R'Å:=82; ASCIIÆ'S'Å:=83; ASCIIÆ'T'Å:=84;
4409 329 ASCIIÆ'U'Å:=85; ASCIIÆ'V'Å:=86; ASCIIÆ'W'Å:=87; ASCIIÆ'X'Å:=88;
4410 330 ASCIIÆ'Y'Å:=89; ASCIIÆ'Z'Å:=90;
4411 331 ASCIIÆ'0'Å:=48; ASCIIÆ'1'Å:=49; ASCIIÆ'2'Å:=50; ASCIIÆ'3'Å:=51;
4412 332 ASCIIÆ'4'Å:=52; ASCIIÆ'5'Å:=53; ASCIIÆ'6'Å:=54; ASCIIÆ'7'Å:=55;
4413 333 ASCIIÆ'8'Å:=56; ASCIIÆ'9'Å:=57;
4414 334 ASCIIÆ' 'Å:=32; ASCIIÆ'*'Å:=42; ASCIIÆ'>'Å:=62;
4415 335 ASCIIÆ'!'Å:=33; ASCIIÆ'+'Å:=43; ASCIIÆ'?'Å:=63;
4416 336 ASCIIÆ'"'Å:=34; ASCIIÆ','Å:=44; ASCIIÆ'^'Å:=64;
4417 337 ASCIIÆ'#'Å:=35; ASCIIÆ'-'Å:=45;
4418 338 ASCIIÆ'$'Å:=36; ASCIIÆ'.'Å:=46; ASCIIÆ'Ø'Å:=92;
4419 339 ASCIIÆ'%'Å:=37; ASCIIÆ'/'Å:=47;
4420 340 ASCIIÆ'&'Å:=38; ASCIIÆ':'Å:=58; ASCIIÆ'!'Å:=94;
4421 341 ASCIIÆ''''Å:=39;ASCIIÆ';'Å:=59;
4422 342 ASCIIÆ'('Å:=40; ASCIIÆ'<'Å:=60;
4423 343 ASCIIÆ')'Å:=41; ASCIIÆ'='Å:=61;
4424 344 ASCIIÆ'Æ'Å:=91; ASCIIÆ'Å'Å:=93;
4425 345 ASCIIÆ'_'Å:=95; ASCIIÆ'æ'Å:=123; ASCIIÆ'å'Å:=125;
4426 346 ASCIIÆ'`'Å:=96; ASCIIÆ'ø'Å:=124; ASCIIÆ'^'Å:=126;
4427 347
4428 348 RTÆXCVBÅ := 4228; RTÆXAFIÅ := 4112; RTÆXCLOÅ := 4116;
4429 349 RTÆXDISÅ := 4104; RTÆXEOFÅ := 4120; RTÆXEOLÅ := 4124;
4430 350 RTÆXEQUÅ := 4268; RTÆXEXIÅ := 4096; RTÆXGEQÅ := 4288;
4431 351 RTÆXENDÅ := 4096;
4432 352 RTÆXGETÅ := 4128; RTÆXGRTÅ := 4284; RTÆXIFDÅ := 4132;
4433 353 RTÆXINDÅ := 4264; RTÆXLEQÅ := 4280; RTÆXLESÅ := 4276;
4434 354 RTÆXLODÅ := 4264; RTÆXNEQÅ := 4272; RTÆXNEWÅ := 4108;
4435 355 RTÆXPAGÅ := 4136; RTÆXPEEÅ := 4140; RTÆXPOKÅ := 4144;
4436 356 RTÆXPOSÅ := 4148; RTÆXPUTÅ := 4152; RTÆXRDBÅ := 4176;
4437 357 RTÆXRDCÅ := 4180; RTÆXRDIÅ := 4184; RTÆXRDSÅ := 4188;
4438 358 RTÆXRDVÅ := 4212; RTÆXRLNÅ := 4156; RTÆXRSTÅ := 4160;
4439 359 RTÆXRWTÅ := 4164; RTÆXSCONÅ:= 4232; RTÆXSCOPÅ:= 4236;
4440 360 RTÆXSDELÅ:= 4240; RTÆXSEEÅ := 4168; RTÆXSINSÅ := 4244;
4441 361 RTÆXSLENÅ:= 4248; RTÆXSPOSÅ:= 4252; RTÆXSTOÅ := 4260;
4442 362 RTÆXSTPÅ := 4100; RTÆXSTRÅ := 4256; RTÆXWLNÅ := 4172;
4443 363 RTÆXWRBÅ := 4192; RTÆXWRCÅ := 4196; RTÆXWRIÅ := 4200;
4444 364 RTÆXWRSÅ := 4204; RTÆXWRVÅ := 4208; RTÆXCVTÅ := 4220;
4445 365 RTÆXCVTSUÅ := 4216; RTÆXCVTUSÅ := 4224; RTÆXLDCÅ := 4292;
4446 366 RTÆXSTRVÅ := 4296; RTÆXSTOVÅ := 4300; RTÆXINDVÅ := 4304;
4447 367 RTÆXLODVÅ := 4304; RTÆXEQUVÅ := 4308; RTÆXNEQVÅ := 4312;
4448 368 RTÆXLESVÅ := 4316; RTÆXLEQVÅ := 4320; RTÆXGRTVÅ := 4324;
4449 369 RTÆXGEQVÅ := 4328; RTÆXLDCVÅ := 4332; RTÆXSTCÅ := 4336;
4450 370 RTÆXMPÅ := 4340; RTÆXDVÅ := 4344; RTÆXMODÅ := 4348;
4451 371 RTÆXRLSÅ := 4148; RTÆXMRKÅ := 4144; RTÆXRDHÅ := 4528;
4452 372 RTÆXRDJÅ := 4532; RTÆXWRHÅ := 4520; RTÆXWRJÅ := 4524;
4453 373
4454 END; (*INIT*)
4455
4456
4457 (*-------------------------------------------------------------------------
4458 SUMMARY PROCEDURE
4459 -------------------------------------------------------------------------*)
4460
4461 PROCEDURE SUMMARIZE;
4462 0 BEGIN WRITELN(LISTING,'*D REGISTERS: ',DALLOCCNT,' ALLOCATIONS, REQUIRING ',
4463 1 DPUSHCNT,' PUSHES');
4464 2 WRITELN(LISTING,'* AND ', DPOPCNT,' POPS');
4465 3 WRITELN(LISTING,'*A REGISTERS: ',AALLOCCNT,' ALLOCATIONS, REQUIRING ',
4466 4 APUSHCNT,' PUSHES');
4467 5 WRITELN(LISTING,'* AND ', APOPCNT,' POPS');
4468 6 WRITELN(LISTING,'*');
4469 7 WRITE(LISTING,'*TOTAL OF ');
4470 8 LTEMP := PC;
4471 9 LSB(LTEMP,GENSTART);
4472 10 PLINT(LISTING,LTEMP);
4473 11 WRITELN(LISTING,' BYTES GENERATED.');
4474 12 WRITE(OUTPUT,' CODE GENERATOR PRODUCED ');
4475 13 PLINT(OUTPUT,LTEMP);
4476 14 WRITELN(OUTPUT,' BYTES OF CODE.');
4477 15 WRITELN(OUTPUT,' LABELS USED:',TOPLABEL:4);
4478 16 IF ERRORWR THEN WRITELN(OUTPUT,' ***** ERROR(S) DETECTED *****')
4479 17 ELSE WRITELN(OUTPUT,' NO ERRORS DETECTED.');
4480 18 WRITELN(OUTPUT,'STACKPTR = ',STKPTR:5);
4481 19 PAGE(LISTING)
4482 END;
4483
4484
4485 (*-------------------------------------------------------------------------
4486 MAIN PROGRAM
4487 -------------------------------------------------------------------------*)
4488
4489 0 BEGIN
4490 1 REWRITE(LISTING);
4491 2 WRITELN(LISTING,'* M68000 PASCAL COMPILER PHASE TWO VERSION 1.10 08/07/80 ');
4492 3 RESET(PCODE);
4493 4 REWRITE(OBJECT);
4494 5 WRITELN(OUTPUT,' M68000 PASCAL COMPILER PHASE TWO VERSION 1.10');
4495 6 WRITELN(OUTPUT,' COPYRIGHTED 1980 BY MOTOROLA, INC.');
4496 7 WRITELN(LISTING,' ');
4497 8 INIT;
4498 9 GETHEADER;
4499 10 IF LINEBUFÆ3Å = '2' THEN
4500 11 REPEAT
4501 12 SCAN;
4502 13 (*WITH CURRI^ DO
4503 14 WRITELN(LISTING,'* ',MNÆOPCODEÅ,ORD(OPTYPE),OPAND1,OPAND2,OPAND3);*)
4504 15 IF FLÆCURRI^.OPCODEÅ THEN FLUSH;
4505 16 UNTIL CURRI^.OPTYPE = ENDOP;
4506 17 SUMMARIZE;
4507 END.
Code: 52K + 348 Halfwords
end
blocksread = 999
▶EOF◀