|
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: 190464 (0x2e800)
Types: TextFile
Names: »hpasc1«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »hpasc1«
(*$L+*)
(* M20 *)
(* COPYRIGHTED 1980 BY MOTOROLA, INC. *)
PROGRAM DIRECT(OUTPUT,PCODE,OBJECT,LISTING);
(* AUGUST 7, 1980 *)
(* GENERATES S-RECORDS *)
(* 370 VERSION *)
(* LONG ADDRESSES *)
(* DIRECT CODE VERSION *)
(* 01/08/82 @ REPLACED BY ^ *
* (. REPLACED BY Æ *
* .) REPLACED BY Å *
* EXTERNAL REPLACED BY XEXTERNAL *
* FILE OF CHAR REPLACED BY TEXT *
* HENRIK JACOBSEN HC *)
CONST STRLENGTH = 64;
LINELNGTH = 133;
BITSPERDIGIT = 8;
LDIGIT = 3;
TOPDIGIT = 255;
MAXDIGIT = 256;
MAXLABEL = 400;
MAXCORE = 1044;
STKMAX = 32;
NDREGS = 5; NAREGS = 3; (*NBR OF REGS TO BE ALLOCATED FOR STACK*)
TYPE OPTYPS = (OP0, OPLI, OPT, OP2T, OPTI, OPT2I, OPI, OPTLI,
OP3I, OPTL2I, OPTL, OPENT, OPENTB, OPTV, OPLAB, ENDOP);
PCODES=(XAB, XAD, XAFI, XAND, XARG,
XAST, XATN, XCHK, XCHKF, XCLO, XCOS, XCSP,
XCSPF,XCUP, XCUPF,XCVB, XCVT, XDAS, XDATA,XDATB,XDEC, XDEF, XDIF,
XDIS, XDV, XEIO, XEND, XENT, XENTB,XEOF, XEOL, XEQU, XEXI, XEXP,
XEXT, XFJP, XGEQ, XGET, XGRT, XIFD, XINC, XIND, XINN, XINS, XINT,
XIOR, XISC, XIXA, XLAB, XLCA, XLDA, XLDC, XLEQ, XLES, XLOD, XLOG,
XLSC, XLSPA,XLTA, XLUPA,XMOD, XMOV, XMOVV,XMP, XMRK, XMST, XNEQ,
XNEW, XNG, XNOT, XODD, XPAG, XPEE, XPOK, XPOS, XPUT, XRDB, XRDC,
(*604*) XRDE, XRDH, XRDI, XRDJ, XRDQ, XRDR, XRDS, XRDV, XRET, XRLN, XRLS, XRND,
XRST, XRWT, XSB, XSCON,XSCOP,XSDEL,XSEE, XSGS, XSIN, XSINS,XSLEN,
(*RM*) XSPOS,XSQR, XSQT, XSTO, XSTP, XSTR, XTRC, XUJP, XUNI, XVJP, XWLN, XWRB,
(*604*) XWRC, XWRE, XWRH, XWRI, XWRJ, XWRQ, XWRR, XWRS, XWRV, XXJP, XSTC, XNONE,
XINDV, XLODV, XSTRV, XSTOV, XEQUV, XNEQV, XLESV, XLEQV,
XGRTV, XGEQV, XCVTSU, XCVTUS, XLDCV);
MNS = XAB .. XNONE;
TARGETOP = (TMOVE, TLINK, TUNLK, TRTS , TTST, TBGT, TNEG, TSUBQ,
TBTST, TSNZ, TADD, TSUB, TAND, TOR, TMULS, TDIVS,
TCMP, TCLR, TTRAP, TDCNT, TBSR, TADDQ,TCOMP, TLBSR,
TMOVEQ,TSEQ, TSNE, TSLT, TSLE, TSGT, TSGE, TLEA ,
TLBGT, TLBRA, TLBNE, TLBEQ, TLBLT, TASL, TBLT, TJMP,
(*RM*) TPEA, TBSET, TBZ, TSWAP, TCMPM, TJSR,
TBNZ, TBGE, TBLE, TCHK, TLBLE, TLBGE,
(*RM*) TLDQ, TEXTE, TBRA, TBNE, TEQU, TBEQ, TEOR, TDC );
DATATYPE = (ATYP,ITYP,JTYP,RTYP,QTYP,VTYP,STYP,BTYP,
(*RM*) PTYP,NOTATYP,CTYP,HTYP,UTYP);
MESSAGE = PACKED ARRAYÆ1..15Å OF CHAR;
ERRORMESSAGE = PACKED ARRAYÆ1..20Å OF CHAR;
IPTR = ^INSTRUCTION;
INSTRUCTION = RECORD INUSE : BOOLEAN;
NEXT : IPTR;
(*PREV : IPTR;*)
OPCODE: MNS;
OPTYPE: OPTYPS;
DTYPE,D1TYPE: DATATYPE;
OPAND1: INTEGER;
OPAND2: INTEGER;
OPAND3: INTEGER;
OPAND4: INTEGER;
OPSTRING: ^VSTRINGV;
(*RM*) OPSET: ^SETR
END;
VSTRINGV = RECORD STRINGL: 0..STRLENGTH;
VSTRINGA: PACKED ARRAY Æ 1..STRLENGTHÅ OF CHAR
END;
LINT = ARRAY Æ0..LDIGITÅ OF INTEGER; (*MULTIPLE PRECISION*)
ADDRESS = LINT; (*SHOULD BE "RECORD BYTE1,BYTE2,BYTE3:0..255 END"*)
LABELREF = RECORD CORELOC: ADDRESS;
NEXT: ^LABELREF
END;
LABL = RECORD LOCATION: ADDRESS;
DEFINED: BOOLEAN;
REFED: BOOLEAN;
REFCHAIN: ^LABELREF;
END;
LABTABLE = ARRAYÆ0..MAXLABELÅ OF LABL;
ESD = RECORD NAME: MNS; (*XEXTERNAL SYMBOL DEFINITION LIST*)
REFERENCE: ADDRESS;
NEXT: ^ESD
END;
EAMODE = (NONE,DDIRECT,ADIRECT,DEFER,INCR,DECR,
(*RM*) BASED,INDEX, PCINDEX, STSHORT,
RELATIVE,XEXTERNAL,LABELLED, LABIMMED,
(*RM*) PIMMED,
LIMMED,
(*RM*) IMMED,ABSOLUTE,STLONG); (* THIS ORDER IS IMPORTANT *)
REGISTER = (DNONE,D0,D1,D2,D3,D4,D5,D6,D7,
ANONE,A0,A1,A2,A3,A4,A5,A6,A7);
REGKIND = (AREG, DREG);
EFFADDR = RECORD MODE: EAMODE;
REG: REGISTER;
XREG: REGISTER;
DISPL: INTEGER
END;
(*RM*) SETR = RECORD
(*RM*) SETV: PACKED ARRAYÆ1..16Å OF CHAR
(*RM*) END;
VAR
DEBUG: INTEGER; (*DIAGNOTSIC FLAG *)
CHANGED: BOOLEAN;
ASCII: ARRAYÆCHARÅ OF INTEGER;
C: CHAR;
ERRORWR: BOOLEAN;
LISTING: TEXT;
PCODE: TEXT;
OBJECT: TEXT;
CHCNT,LINELEN: 1..LINELNGTH;
LINEBUF: ARRAYÆ1..LINELNGTHÅ OF CHAR;
LINECOUNT: INTEGER;
MACHINDEX: INTEGER;
SIZE: ARRAYÆDATATYPEÅ OF INTEGER;
(*RM*) DNAME: PACKED ARRAYÆDATATYPEÅ OF CHAR;
LONGTYPES: SET OF DATATYPE; (* = ÆPTYP,VTYP,STYPÅ*)
(*RM*) LASTLABEL: INTEGER; (* LABEL OF LAST LABELLED PCODE *)
FIRSTI, LASTI, CURRI, OPTIMI, TEMPI : IPTR;
(*480*) FAKEI: IPTR; (* DUMMY PCODE *)
OPTIM2,OPTIM3,OPTIM4,OPTIM5 : IPTR;
CURROPCODE: MNS; CURROPTYPE: OPTYPS;
TEMPLEVEL: INTEGER; (*LEVEL OF DISPLAY VECTOR CURRENTLY IN A4*)
COMMUTATIVE, SWITCH: BOOLEAN;
OPSYM: PACKED ARRAYÆ1..4Å OF CHAR;
MACHCODE: PACKED ARRAYÆ1..20Å OF CHAR;
VSTRING, BLANKS: PACKED ARRAYÆ1..STRLENGTHÅ OF CHAR;
CURRLABEL, HIGHLABEL, LABELOFFSET, DEFVALUE: INTEGER;
TOPLABEL : INTEGER;
LABELED, DOLLAR, ABSOL: BOOLEAN;
LEVEL, ALENGTH: INTEGER;
FLPC: BOOLEAN;
FMN: ARRAYÆ'A'..'Z'Å OF MNS;
MN: ARRAYÆMNSÅ OF PACKED ARRAYÆ1..4Å OF CHAR;
OT: ARRAYÆMNSÅ OF OPTYPS;
SUBTYPE: ARRAYÆMNSÅ OF 0..255;
RT: ARRAYÆPCODESÅ OF INTEGER; (* ADDRESSES OF RUNTIME ROUTINES*)
FL: ARRAYÆMNSÅ OF BOOLEAN;
TMN: ARRAYÆTARGETOPÅ OF PACKED ARRAYÆ1..5Å OF CHAR;
LABELTABLE, PROCTABLE: LABTABLE;
PC: ADDRESS;
LTEMP: LINT; (* TEMPORARY FOR LONG ARITHMETIC *)
CORE: ARRAYÆ1..MAXCOREÅ OF INTEGER;
GENLOC: LINT; (* CURRENT CODEGEN ADDRESS *)
GENSTART: LINT; (* FIRST ADDRESS OF CODE *)
GENSAVE: LINT; (*TEMP TO SAVE GENLOC *)
EXPROC: ADDRESS; (* SLOT TO STORE JUMP TO DISTANT PROC IN *)
CORECOUNT: 0..MAXCORE;
CORESAVE: 0..MAXCORE;
LOCOUNT: 0..MAXCORE;
MAINFLG: BOOLEAN; (* MAIN PROGRAM ENCOUNTERED *)
COREBASE: ADDRESS;
PROGSTART: ADDRESS;
RTJUMP: ADDRESS; (* START OF RUNTIME JUMP TABLE *)
STKSTART: ADDRESS; (* START OF STACK *)
HEAPSTART: ADDRESS; (* START OF HEAP *)
JTSIZE: INTEGER; (* NUMBER OF JUMP TABLE ELEMENTS *)
FIRSTESD: ^ESD;
SP: REGISTER;
DALLOC,AALLOC: 0..8;
DTOP,DBOT: DNONE..D7;
ATOP,ABOT: ANONE..A7;
(*REGISTER ALLOCATION VARIABLES*)
(*VALUE OF -1 MEANS NONE CURRENTLY ASSIGNED*)
REGTYPE: ARRAYÆREGISTERÅ OF DATATYPE;
TYPESTK: ARRAYÆ-1..STKMAXÅ OF DATATYPE;
KINDSTK: ARRAYÆ-1..STKMAXÅ OF REGKIND;
STKPTR: -1..STKMAX;
DREGS: ARRAYÆ0..NDREGSÅ OF REGISTER;
AREGS: ARRAYÆ0..NAREGSÅ OF REGISTER;
EADDIR, EAADIR, EAPOP, EAPUSH, EAIMMED, EAINCR,
(*RM*) EALIMM, EAREL, EALAB, EAPSET, EALONG,
EABASED, EANONE, EADEFER: EFFADDR;
AALLOCCNT, DALLOCCNT, DPUSHCNT, APUSHCNT, DPOPCNT, APOPCNT: INTEGER;
TEMPESD: ^ESD;
TEMPLABREF: ^LABELREF;
(*RM*) HEXDATA: PACKED ARRAYÆ1..16Å OF CHAR;
FUNCTION SUCCIBM(CH:CHAR):CHAR; (* HANDLES EBCDIC ALPHABET *)
BEGIN
IF CH = 'I' THEN SUCCIBM := 'J'
ELSE IF CH ='R' THEN SUCCIBM := 'S'
ELSE SUCCIBM := SUCC(CH)
END (* SUCCIBM *) ;
FUNCTION HEXBIN(I: INTEGER): INTEGER; (* CONVERT HEX CHAR TO BINARY *)
BEGIN
IF I >= 65
THEN HEXBIN := I - 55
ELSE HEXBIN := I - 48
END; (* HEXBIN *)
PROCEDURE ERROR(MSG: ERRORMESSAGE);
BEGIN ERRORWR:=TRUE;WRITELN(LISTING,'**ERROR** ',MSG) END; (* ERROR *)
(*480*) FUNCTION NEXTPCOD (PCODE: IPTR) : IPTR;
(*480*) (* GIVEN A PCODE, FIND NEXT ACTIVE ONE; IF NONE, RETURN FAKE ONE *)
(*480*) BEGIN
(*480*) REPEAT
(*480*) PCODE := PCODE^.NEXT;
(*480*) IF PCODE = NIL THEN PCODE := FAKEI
(*480*) UNTIL PCODE^.INUSE;
(*480*) NEXTPCOD := PCODE
(*480*) END; (*NEXTPCOD *)
FUNCTION CONDITIONAL(INST:IPTR):INTEGER;
(* IF CONDITIONAL P-CODE, RETURN NUMBER, ELSE RETURN 0 *)
BEGIN
WITH INST^ DO
BEGIN
CONDITIONAL := 0;
IF OPCODE = XNEQ THEN CONDITIONAL := 1 ELSE
IF OPCODE = XEQU THEN CONDITIONAL := 2 ELSE
IF OPCODE = XLES THEN CONDITIONAL := 3 ELSE
IF OPCODE = XLEQ THEN CONDITIONAL := 4 ELSE
IF OPCODE = XGRT THEN CONDITIONAL := 5 ELSE
IF OPCODE = XGEQ THEN CONDITIONAL := 6
END (*WITH*)
END; (*CONDITIONAL*)
FUNCTION GETHEX:BOOLEAN;
VAR I: INTEGER;
BEGIN
GETHEX := FALSE;
WHILE (LINEBUFÆCHCNTÅ=' ') AND (CHCNT<LINELEN) DO CHCNT := CHCNT + 1;
IF LINEBUFÆCHCNTÅ <> ' '
THEN BEGIN
GETHEX := TRUE;
FOR I := 0 TO 3 DO
BEGIN
LTEMPÆIÅ := 16 * HEXBIN(ASCIIÆLINEBUFÆCHCNTÅÅ) +
HEXBIN(ASCIIÆLINEBUFÆCHCNT + 1ÅÅ);
CHCNT := CHCNT + 2
END
END;
IF LINEBUFÆCHCNTÅ <> ' ' THEN GETHEX := FALSE;
END ; (*GETHEX*)
PROCEDURE GETSTRING;
BEGIN
WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
CHCNT := CHCNT + 1;
IF LINEBUFÆCHCNTÅ <> '''' THEN
BEGIN ERROR('STRING EXPECTED ');
VSTRING := BLANKS END
ELSE BEGIN
ALENGTH := 0;
REPEAT
REPEAT
CHCNT := CHCNT + 1;
ALENGTH := ALENGTH + 1;
IF ALENGTH <= STRLENGTH THEN
VSTRINGÆALENGTHÅ := LINEBUFÆCHCNTÅ;
UNTIL (LINEBUFÆCHCNTÅ = '''') OR (CHCNT = LINELEN);
CHCNT := CHCNT + 1
UNTIL LINEBUFÆCHCNTÅ <> '''';
IF ALENGTH > STRLENGTH
THEN ALENGTH := STRLENGTH
ELSE ALENGTH := ALENGTH - 1;
END
END; (*GETSTRING*)
FUNCTION GETINTEGER :INTEGER;
VAR I: INTEGER;
CH: CHAR;
MINUS: BOOLEAN;
BEGIN
WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
CHCNT := CHCNT + 1;
I := 0;
MINUS := LINEBUFÆCHCNTÅ = '-';
IF MINUS THEN CHCNT := CHCNT + 1;
WHILE (LINEBUFÆCHCNTÅ <> ' ') AND (CHCNT < LINELEN) DO
BEGIN
CH := LINEBUFÆCHCNTÅ;
IF (CH >= '0') AND (CH <= '9')
THEN I := I*10 + ORD(CH)-ORD('0')
(*RM*) ELSE IF LINEBUFÆCHCNTÅ <> ',' THEN ERROR('MALFORMED INTEGER ');
CHCNT := CHCNT + 1
END;
IF MINUS THEN GETINTEGER := -1*I ELSE GETINTEGER := I
END; (*GETINTEGER*)
PROCEDURE BUILDADDR (VAR ADDR: EFFADDR; KMODE: EAMODE;
KREG, KXREG: REGISTER; KDISPL: INTEGER);
BEGIN WITH ADDR DO BEGIN
MODE := KMODE;
REG := KREG;
XREG := KXREG;
DISPL:= KDISPL
END END; (*BUILDADDR*)
(*----------------------------------------------------------------------
MULTIPLE PRECISION ARITHMETIC ROUTINES
-----------------------------------------------------------------------*)
PROCEDURE PLINT(VAR FIL:TEXT; X:LINT); (* WRITE LONG VALUE *)
VAR I: INTEGER;
BEGIN
FOR I := 0 TO LDIGIT DO
WRITE(FIL,HEXDATAÆ(XÆIÅ DIV 16) + 1Å:1,
HEXDATAÆ(XÆIÅ MOD 16) + 1Å:1);
END; (*PLINT*)
FUNCTION SDV(VAR X: LINT; S: INTEGER): INTEGER; (*DIVIDE LONG BY INTEGER *)
(* X := X / S (UNSIGNED) *)
VAR
I, CARRY: INTEGER;
Z: LINT;
BEGIN
FOR I := LDIGIT DOWNTO 0 DO ZÆIÅ := 0;
IF S > 0 THEN
BEGIN
CARRY := 0;
FOR I := 0 TO LDIGIT DO
BEGIN
CARRY := CARRY * MAXDIGIT + XÆIÅ;
WHILE CARRY >= S DO
BEGIN
ZÆIÅ := ZÆIÅ + 1;
CARRY := CARRY - S;
END;
END;
END;
FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := ZÆIÅ;
SDV := CARRY;
END; (*SDV*)
FUNCTION SHORT(VAR X:LINT):BOOLEAN; (* DETERMINE IF LINT IS SHORT*)
VAR
I: INTEGER;
BEGIN
SHORT := FALSE;
IF ((XÆ0Å=0) AND (XÆ1Å=0) AND (XÆ2Å<128))
OR ((XÆ0Å=255) AND (XÆ1Å=255) AND (XÆ2Å>127))
THEN SHORT := TRUE
END; (*SHORT*)
PROCEDURE CLR(VAR X: LINT); (* CLEAR LONG VALUE *)
(* X := 0 *)
VAR
I: INTEGER;
BEGIN
FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := 0;
END; (*CLR*)
PROCEDURE LSB(VAR X: LINT; Y: LINT); (* SUBTRACT LONG FROM LONG *)
VAR
I, B: INTEGER;
BEGIN
B := 0; (* SET BORROW TO 0 *)
FOR I := LDIGIT DOWNTO 0 DO
BEGIN
XÆIÅ := XÆIÅ - YÆIÅ - B;
B := 0; (* RESET CARRY *)
IF XÆIÅ < 0
THEN
BEGIN
XÆIÅ := XÆIÅ + 256;
B := 1
END (*THEN*)
END (*FOR*)
END; (*LSB*)
PROCEDURE SSB(VAR X: LINT; S: INTEGER); FORWARD;
PROCEDURE SAD(VAR X: LINT; S: INTEGER); (* ADD INTEGER TO LONG *)
(* X := X + S *)
VAR
I,CARRY: INTEGER;
Z: LINT;
BEGIN
IF S < 0
THEN SSB(X, -S)
ELSE
BEGIN
CARRY := S;
FOR I := LDIGIT DOWNTO 0 DO
BEGIN
ZÆIÅ := XÆIÅ + CARRY;
IF ZÆIÅ > TOPDIGIT
THEN
BEGIN
CARRY := ZÆIÅ DIV MAXDIGIT;
ZÆIÅ := ZÆIÅ MOD MAXDIGIT;
END
ELSE CARRY := 0;
END;
FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := ZÆIÅ;
END
END; (*SAD*)
PROCEDURE SSB(* (VAR X: LINT; S: INTEGER) *); (* SUBTRACT INTEGER FROM LONG *)
(* X := X - S *)
VAR
I,BORROW: INTEGER;
Z: LINT;
BEGIN
(*0321D*) IF (S<0) AND (-S > 0) (* CHECKS FOR -32768 *)
THEN SAD(X, -S)
ELSE
BEGIN
BORROW := S;
FOR I := LDIGIT DOWNTO 0 DO
BEGIN
ZÆIÅ := XÆIÅ - BORROW;
IF ZÆIÅ < 0
THEN
BEGIN
BORROW := - (ZÆIÅ DIV MAXDIGIT);
ZÆIÅ := ZÆIÅ MOD MAXDIGIT;
IF ZÆIÅ < 0
THEN
BEGIN
BORROW := BORROW + 1;
ZÆIÅ := ZÆIÅ + MAXDIGIT;
END; (*BEGIN*)
END (*THEN*)
ELSE BORROW := 0;
END; (*FOR*)
FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := ZÆIÅ;
END (*ELSE*)
END; (*SSB*)
PROCEDURE LASGN(VAR X: INTEGER; Y: LINT); (* MOVE LONG TO SHORT*)
VAR
I, J: INTEGER;
BEGIN
J := YÆLDIGIT -1Å;
IF J > 127 THEN J := J - 256;
X := 256 * J + YÆLDIGITÅ
END; (* LASGN *)
PROCEDURE ASGN(VAR X: LINT; Y: LINT); (* MOVE LONG TO LONG *)
(* X := Y *)
BEGIN
X := Y;
END; (*ASGN*)
PROCEDURE SASGN(VAR X: LINT; Y: INTEGER); (* MOVE INTEGER TO LONG *)
(* X := LINT Y *)
VAR
I: INTEGER;
BEGIN
CLR(X);
IF Y > 0
THEN SAD(X,Y)
ELSE IF Y < 0
THEN SSB(X,-Y);
END; (*ASGN*)
PROCEDURE SHL(VAR X: LINT; S: INTEGER); (* SHIFT LONG LEFT INTEGER TIMES*)
(* X := X SHIFTED LEFT BY S BITS *)
VAR
I,J,CARRY: INTEGER;
Z: LINT;
BEGIN
FOR I := LDIGIT DOWNTO 0 DO ZÆIÅ := XÆIÅ;
FOR J := 1 TO S DIV BITSPERDIGIT DO
BEGIN
FOR I := 0 TO LDIGIT - 1 DO ZÆIÅ := ZÆI + 1Å;
ZÆLDIGITÅ := 0;
END;
FOR J := 1 TO S MOD BITSPERDIGIT DO
BEGIN
CARRY := 0;
FOR I := LDIGIT DOWNTO 0 DO
BEGIN
ZÆIÅ := 2 * ZÆIÅ + CARRY;
IF ZÆIÅ > TOPDIGIT
THEN
BEGIN
ZÆIÅ := ZÆIÅ - MAXDIGIT;
CARRY := 1;
END (*THEN*)
ELSE CARRY := 0;
END (*FOR*)
END; (*FOR*)
FOR I := LDIGIT DOWNTO 0 DO XÆIÅ := ZÆIÅ;
END; (*SHL*)
(*-------------------------------------------------------------------------
CODE GENERATION SECTION
-------------------------------------------------------------------------*)
(*604*) PROCEDURE PCPRINT;
(*604*) BEGIN
(*604*) IF ODD(DEBUG)
(*604*) THEN
(*604*) BEGIN
(*604*) PLINT(LISTING,PC);
(*604*) WRITE(LISTING,' ':21)
(*604*) END
(*604*) END; (* PCPRINT*)
PROCEDURE EMITCODE;
VAR
II, I, J, HI, MD, LO, CHKSUM: INTEGER;
SAVE: LINT;
PROCEDURE EMITBYTE(DATA: INTEGER); (*EXPAND BYTE INTO TWO HEX DIGITS*)
VAR
HI, LO: INTEGER;
CH: CHAR;
BEGIN (*EMITBYTE*)
CHKSUM := CHKSUM + DATA;
HI := DATA DIV 16;
LO := DATA MOD 16;
IF HI < 10
THEN CH := CHR(ORD('0') + HI)
ELSE CH := CHR(ORD('A') + HI - 10);
WRITE(OBJECT,CH);
IF LO < 10
THEN CH := CHR(ORD('0') + LO)
ELSE CH := CHR(ORD('A') + LO - 10);
WRITE(OBJECT,CH);
END; (*EMITBYTE*)
BEGIN (*EMITCODE*)
IF (CORECOUNT>0)
THEN
BEGIN
I := LOCOUNT;
WHILE I <= CORECOUNT DO
BEGIN
CHKSUM := 0;
IF CORECOUNT - I >= 31
THEN J := I + 31
ELSE J := CORECOUNT;
ASGN(SAVE,GENLOC);
(* LO := GENLOCÆLDIGITÅ; *)
(* MD := GENLOCÆLDIGIT-1Å; *)
(* HI := GENLOCÆLDIGIT-2Å; *)
LO := SDV(GENLOC,256);
MD := SDV(GENLOC,256);
HI := SDV(GENLOC,256);
ASGN(GENLOC,SAVE);
IF HI = 0
THEN BEGIN
WRITE(OBJECT,'S1');
EMITBYTE(J-I+4)
END
ELSE BEGIN
WRITE(OBJECT,'S2');
EMITBYTE(J-I+5)
END;
IF HI <> 0
THEN EMITBYTE(HI);
EMITBYTE(MD);
EMITBYTE(LO); (* EMIT ADDRESS FIELD *)
FOR II := I TO J DO
BEGIN
IF (COREÆIIÅ < 0) OR (COREÆIIÅ > 256)
THEN
BEGIN
ERROR('BAD EMIT DATA ');
WRITELN(LISTING,'VALUE ',COREÆIIÅ,' AT ',II,
' PC=') ;
PLINT(LISTING,PC)
END; (*THEN*)
EMITBYTE(COREÆIIÅ);
END; (*FOR*)
EMITBYTE(255-(CHKSUM MOD 256));
WRITELN(OBJECT,' ');
SAD(GENLOC,J-I+1);
I := J + 1;
END; (*WHILE*)
CORECOUNT := 0;
IF LOCOUNT = 1 THEN COREBASE := PC;
END; (*THEN*)
END; (*EMITCODE*)
PROCEDURE EMITEND;
BEGIN
WRITELN(OBJECT,'S9030000FC');
END; (*EMITEND*)
PROCEDURE FLUSH; (*CURRENTLY CALLED AT END OF EACH BASIC BLOCK*)
(*I.E. ONLY LOCAL OPTIMIZATION IS BEING DONE*)
PROCEDURE GENERATE(INSTR: IPTR);
VAR SOURCE, DEST: EFFADDR;
TEMPESD: ^ESD;
K: INTEGER;
OPCDE: TARGETOP;
PROCEDURE RESETLABEL;
VAR I: INTEGER;
BEGIN
FOR I:= 0 TO HIGHLABEL DO
BEGIN LABELTABLEÆIÅ.DEFINED :=FALSE;
LABELTABLEÆIÅ.REFCHAIN := NIL;
LABELTABLEÆIÅ.REFED :=FALSE
END;
IF TOPLABEL < HIGHLABEL THEN TOPLABEL := HIGHLABEL;
(*#*) LABELOFFSET := LABELOFFSET + HIGHLABEL; HIGHLABEL := 0;
END;
PROCEDURE GENX(OP: TARGETOP; SIZE: INTEGER; EA1,EA2: EFFADDR); FORWARD;
(*RM*) PROCEDURE VSTRINGIMMED(STARTCH,COUNT: INTEGER);
(*RM*) VAR K: INTEGER;
(*RM*) BEGIN
WITH INSTR^ DO BEGIN
WRITE(LISTING,'''':1);
K := STARTCH;
(*RM*) WHILE K < STARTCH + COUNT DO BEGIN
EAIMMED.DISPL := ASCIIÆOPSTRING^.VSTRINGAÆKÅÅ;
GENX(TDC,1,EAIMMED,EANONE);
(*RM*) IF OPSTRING^.VSTRINGAÆKÅ = '''' THEN WRITE(LISTING,'''''':2)
(*RM*) ELSE WRITE(LISTING,OPSTRING^.VSTRINGAÆKÅ:1);
(*RM*) K := K + 1
(*RM*) END;
(*RM*) WRITE(LISTING,'''':1)
(*RM*) END (* WITH *)
(*RM*) END; (* VSTRINGIMMED *)
(*RM*) PROCEDURE HEXVSTRING(K:INTEGER);
(*RM*) VAR I:INTEGER;
CH:CHAR;
(*RM*) BEGIN
(*RM*) WITH INSTR^ DO BEGIN
(*RM*) FOR I := 1 TO 8 DO
BEGIN
CH:=OPSET^.SETVÆ K + 1 Å;
(*RM*) WRITE(LISTING, CH :1) ;
IF NOT ODD(I)
THEN BEGIN
EAIMMED.DISPL := 16 *
HEXBIN(ASCIIÆOPSET^.SETVÆK + I - 1ÅÅ) +
HEXBIN(ASCIIÆOPSET^.SETVÆK + IÅÅ);
GENX(TDC,1,EAIMMED,EANONE);
END; (*IF*)
(*RM*) END (*FOR*)
END; (*WITH*)
(*RM*) END; (* HEXVSTRING *)
PROCEDURE GENX (* (OP:TARGETOP; SIZE: INTEGER; EA1,EA2: EFFADDR) *) ;
VAR I, SUBOP, OPC, OPI: INTEGER;
PROCEDURE PRINTINSTRUCTION;
VAR BYTES: INTEGER;
PROCEDURE PRINTEA(EA: EFFADDR);
VAR AR: INTEGER;
BEGIN WITH EA DO
BEGIN
AR := ORD(REG)-ORD(A0);
CASE MODE OF
NONE: ;
DDIRECT: WRITE(LISTING, 'D',ORD(REG)-ORD(D0):1);
ADIRECT: WRITE(LISTING, 'A', AR:1);
DEFER: WRITE(LISTING, '(A', AR:1, ')');
INCR: WRITE(LISTING, '(A', AR:1,')+');
DECR: WRITE(LISTING, '-(A', AR:1,')');
BASED: WRITE(LISTING, DISPL:1, '(A', AR:1,
')');
INDEX: WRITE(LISTING, DISPL:1,
'(A', AR:1, ',', 'D', ORD(XREG)-ORD(D0):1,')');
ABSOLUTE: WRITE(LISTING,DISPL:1);
IMMED: WRITE(LISTING,'#',DISPL:1);
RELATIVE: BEGIN
WRITE(LISTING,'*');
IF DISPL> 0 THEN
WRITE(LISTING,'+',DISPL:1)
ELSE IF DISPL< 0 THEN WRITE(LISTING,DISPL:1)
END;
LABELLED: IF CURROPCODE = XCUP
THEN WRITE(LISTING,'USER':4,DISPL:1)
ELSE WRITE(LISTING,
'L',DISPL + LABELOFFSET:1);
LABIMMED: BEGIN
IF DISPL <0 THEN WRITE(LISTING,'#-L',-DISPL:1)
ELSE WRITE(LISTING,'#L',DISPL + LABELOFFSET:1)
END;
(*RM*) PIMMED: BEGIN
(*RM*) WRITE(LISTING,'#$':2);
(*RM*) HEXVSTRING(DISPL)
(*RM*) END;
(*RM*) STSHORT: BEGIN
(*RM*) WRITE(LISTING,'#':1);
(*RM*) VSTRINGIMMED(DISPL,2)
(*RM*) END;
(*RM*) STLONG : BEGIN
(*RM*) WRITE(LISTING,'#':1);
(*RM*) VSTRINGIMMED(DISPL,4)
(*RM*) END;
LIMMED: BEGIN
WITH INSTR^ DO BEGIN
WRITE(LISTING,'#$');
WRITE(LISTING,HEXDATAÆOPAND1 DIV 16 + 1Å);
WRITE(LISTING,HEXDATAÆOPAND1 MOD 16 + 1Å);
WRITE(LISTING,HEXDATAÆOPAND2 DIV 16 + 1Å);
WRITE(LISTING,HEXDATAÆOPAND2 MOD 16 + 1Å);
WRITE(LISTING,HEXDATAÆOPAND3 DIV 16 + 1Å);
WRITE(LISTING,HEXDATAÆOPAND3 MOD 16 + 1Å);
WRITE(LISTING,HEXDATAÆOPAND4 DIV 16 + 1Å);
WRITE(LISTING,HEXDATAÆOPAND4 MOD 16 + 1Å);
END
END;
(*RM*) XEXTERNAL: BEGIN WRITE(LISTING,'X',MNÆINSTR^.OPCODEÅ:3);
IF INSTR^.D1TYPE <> NOTATYP THEN
WRITE(LISTING,DNAMEÆINSTR^.D1TYPEÅ:1);
IF INSTR^.DTYPE <> NOTATYP THEN
WRITE(LISTING,DNAMEÆINSTR^.DTYPEÅ:1);
END; (* XEXTERNAL *)
PCINDEX: BEGIN WRITE(LISTING,'***PCINDEX***') END;
END END;
END; (*PRINTEA*)
BEGIN (*PRINTINSTRUCTION*)
WRITE(LISTING, ' ':10);
FOR BYTES:=1 TO 5 DO IF TMNÆOP,BYTESÅ<>' ' THEN WRITE
(LISTING, TMNÆOP,BYTESÅ);
IF SIZE = 1 THEN WRITE(LISTING,'.B ')
ELSE IF SIZE >= 4 THEN WRITE(LISTING,'.L ')
ELSE WRITE(LISTING,' ');
PRINTEA(EA1);
IF EA2.MODE <> NONE THEN BEGIN
WRITE(LISTING,',');
PRINTEA(EA2);
END;
IF FLPC THEN
BEGIN
WRITE(LISTING,' ':2,'***** FLUSH ',
MNÆINSTR^.OPCODEÅ);
FLPC := FALSE
END;
IF EA1.REG = A3
THEN WRITE(LISTING,' ',MNÆINSTR^.OPCODEÅ:3,
DNAMEÆINSTR^.D1TYPEÅ:1,
DNAMEÆINSTR^.DTYPEÅ:1);
WRITELN(LISTING,' ');
END; (*PRINTINSTRUCTION*)
PROCEDURE BUFFER(VALU: LINT; SIZE: INTEGER); (* PUT LONG VALUE IN CORE*)
VAR
I,B: INTEGER;
V: LINT;
PROCEDURE HEXWRITE(DATA: INTEGER); (*WRITE CONTENTS OF CORE CELL*)
VAR HI, LO: INTEGER;
CH: CHAR;
BEGIN
IF (DATA < 0) OR (DATA > 256)
THEN ERROR('BAD DATA IN HEXWRITE');
HI := DATA DIV 16;
LO := DATA MOD 16;
IF HI < 10
THEN CH := CHR(ORD('0') + HI)
ELSE CH := CHR(ORD('A') + HI - 10);
IF ODD(DEBUG) AND (OP <> TDC) THEN
BEGIN
MACHCODEÆMACHINDEXÅ := CH;
MACHINDEX := MACHINDEX + 1
END;
IF LO < 10
THEN CH := CHR(ORD('0') + LO)
ELSE CH := CHR(ORD('A') + LO - 10);
IF ODD(DEBUG) AND (OP <> TDC) THEN
BEGIN
MACHCODEÆMACHINDEXÅ := CH;
MACHINDEX := MACHINDEX + 1
END;
END; (*HEXWRITE*)
BEGIN (* BUFFER *)
IF SIZE + CORECOUNT > MAXCORE - 22
THEN EMITCODE;
FOR I := 1 TO SIZE DO
COREÆCORECOUNT + IÅ := VALUÆLDIGIT - SIZE + IÅ;
FOR I := 1 TO SIZE DO HEXWRITE(COREÆCORECOUNT + IÅ );
CORECOUNT := CORECOUNT + SIZE;
SAD(PC, SIZE);
IF ODD(DEBUG) AND (OP <> TDC) THEN MACHINDEX := MACHINDEX + 1;
END; (*BUFFER *)
PROCEDURE GEN8(A: INTEGER);
VAR
L: LINT;
BEGIN
SASGN(L, A);
BUFFER(L, 1);
END; (* GEN8*)
PROCEDURE GEN16(A: INTEGER);
VAR
L: LINT;
BEGIN
SASGN(L, A);
BUFFER(L, 2);
END; (*GEN16*)
PROCEDURE GEN448(A,B,C: INTEGER);
VAR
L: LINT;
BEGIN
IF C < 0 THEN C := C + 256; (* ADJUST TO ONE BYTE *)
SASGN(L, A);
SHL(L, 4); SAD(L, B);
SHL(L, 8); SAD(L, C);
BUFFER(L, 2)
END; (*GEN448*)
PROCEDURE GEN43333(A,B,C,D,E: INTEGER);
VAR
L: LINT;
BEGIN
SASGN(L, A);
SHL(L, 3); SAD(L, B);
SHL(L, 3); SAD(L, C);
SHL(L, 3); SAD(L, D);
SHL(L, 3); SAD(L, E);
BUFFER(L, 2);
END; (*GEN43333*)
PROCEDURE GEN4318(A,B,C,D: INTEGER);
VAR
L: LINT;
BEGIN
IF D < 0 THEN D := D + 256; (* ADJUST LENGTH OF OPERAND *)
SASGN(L, A);
SHL(L, 3); SAD(L, B);
SHL(L, 1); SAD(L, C);
SHL(L, 8); SAD(L, D);
BUFFER(L, 2);
END; (*GEN4318*)
PROCEDURE GENNULL; (* WRITE SOME SPACES*)
BEGIN
END; (*GENNULL*)
PROCEDURE GENEAEXT(E: EFFADDR);
VAR
R: INTEGER;
K: LINT;
BEGIN
IF E.MODE >= BASED
THEN IF (E.MODE=INDEX) OR (E.MODE=PCINDEX)
THEN
BEGIN
IF E.DISPL < 0 THEN E.DISPL := E.DISPL + 256;
IF E.XREG < ANONE
THEN R := ORD(E.XREG) - ORD(D0)
ELSE R := ORD(E.XREG) - ORD(A0) + 8;
SASGN(K, R);
SHL(K, 1);
IF NOT(REGTYPEÆE.XREGÅ IN ÆITYP,BTYP,CTYP,HTYPÅ)
THEN SAD(K, 1);
SHL(K, 11); SAD(K, E.DISPL);
BUFFER(K, 2);
END
ELSE
BEGIN
IF E.MODE = RELATIVE THEN E.DISPL := E.DISPL - 2;
SASGN(K, E.DISPL);
IF (E.MODE = IMMED) AND (SIZE = 4) THEN BUFFER(K,4) ELSE
IF NOT ( E.MODE IN ÆPIMMED, STSHORT, STLONG,LIMMEDÅ ) THEN
BUFFER(K, 2) (* 4 INSTEAD OF 2 FOR ABS/IMMED LONG*)
ELSE IF E.MODE = LIMMED
THEN BEGIN
WITH INSTR^ DO BEGIN
KÆ0Å := OPAND1;
KÆ1Å := OPAND2;
KÆ2Å := OPAND3;
KÆ3Å := OPAND4;
BUFFER(K,4)
END
END
END
ELSE IF OP <> TMOVE
THEN GENNULL
END; (*GENEAEXT*)
FUNCTION REG(EA: EFFADDR): INTEGER;
(* GENERATE CODED VALUE OF REG FIELD FOR GIVEN EFFECTIVE ADDRESS *)
BEGIN
IF EA.MODE < STSHORT
THEN IF (EA.REG = DNONE) OR (EA.REG = ANONE)
THEN ERROR('A/DNONE IN SUBR REG ')
ELSE IF EA.REG < ANONE
THEN REG := ORD(EA.REG) - ORD(D0)
ELSE REG := ORD(EA.REG) - ORD(A0)
ELSE CASE EA.MODE OF
ABSOLUTE: REG := 0;
RELATIVE: REG := 2;
PCINDEX: REG := 3;
IMMED: REG := 4;
LIMMED: REG := 4;
LABELLED: REG := 2; (*?*)
LABIMMED: REG := 4; (*?*)
PIMMED: REG := 4;
STSHORT: REG := 4;
STLONG: REG := 4;
XEXTERNAL: REG := 2;
END (*CASE*)
END; (*REG*)
FUNCTION MODE(EA: EFFADDR): INTEGER;
(* GENERATE CODED VALUE OF MODE FIELD FOR GIVEN EFFECTIVE ADDRESS*)
BEGIN
CASE EA.MODE OF
DDIRECT: MODE := 0;
ADIRECT: MODE := 1;
DEFER: MODE := 2;
INCR: MODE := 3;
DECR: MODE := 4;
BASED: MODE := 5;
INDEX: MODE := 6;
PCINDEX: MODE := 7;
ABSOLUTE:MODE := 7;
IMMED: MODE := 7;
LIMMED: MODE := 7;
RELATIVE:MODE := 7;
LABELLED:MODE := 7; (*?*)
LABIMMED:MODE := 7; (*?*)
NONE: MODE := 7;
PIMMED: MODE := 7;
STSHORT: MODE := 7;
STLONG: MODE := 7;
XEXTERNAL:MODE := 7;
END (* CASE*)
END; (*MODE*)
BEGIN (*GENX*)
IF EA1.MODE = LIMMED
THEN WITH INSTR^ DO
IF OPAND1 + OPAND2 + OPAND3 + OPAND4 = 0
THEN BEGIN
IF (OP=TMOVE) OR (OP=TCMP)
THEN BEGIN
EA1.MODE := IMMED;
EA1.DISPL := 0
END
END
ELSE IF OPAND1 + OPAND2 + OPAND3 = 0
THEN BEGIN
IF (OP=TADD) OR (OP=TSUB)
AND (OPAND4 > 0) AND (OPAND4 <= 8)
THEN BEGIN
EA1.MODE := IMMED;
EA1.DISPL := OPAND4
END
ELSE
IF (OP=TMOVE)
AND (OPAND4 > 0) AND (OPAND4 < 128)
THEN BEGIN
EA1.MODE := IMMED;
EA1.DISPL := OPAND4
END
END
ELSE
IF (OPAND1 + OPAND2 + OPAND3 = 765)
AND (OP=TMOVE)
AND (OPAND4 > 127) AND (OPAND4 < 256)
THEN BEGIN
EA1.MODE := IMMED;
EA1.DISPL := OPAND4 -256
END;
(* CHECK FOR MOVEQ, ADDQ, SUBQ *)
IF OP = TMOVE
THEN
BEGIN
IF ((EA1.MODE=IMMED) AND (EA1.DISPL=0) AND (EA2.MODE<>ADIRECT))
THEN
BEGIN
EA1 := EA2;
EA2 := EANONE;
OP := TCLR;
END
ELSE
(*0423A*) IF (EA2.MODE = DDIRECT) AND (EA1.DISPL > -128)
AND (EA1.DISPL < 128)
AND (EA1.MODE = IMMED)
THEN
BEGIN
OP := TMOVEQ;
SIZE := 4
END; (*THEN*)
END; (* THEN*)
IF (OP = TADD) OR (OP = TSUB)
THEN
BEGIN
IF (EA1.MODE=IMMED) AND (EA1.DISPL > 0) AND (EA1.DISPL<=8)
THEN
BEGIN
IF OP = TADD
THEN OP := TADDQ
ELSE OP := TSUBQ
END (*THEN*)
END; (*THEN*)
(* CHECK FOR CMP THAT CAN BE TST *)
IF OP = TCMP
THEN
BEGIN
IF ((EA1.MODE=IMMED) AND (EA1.DISPL = 0) AND (EA2.MODE<>ADIRECT))
THEN
BEGIN
EA1 := EA2;
EA2 := EANONE;
OP := TTST
END
END;
IF ODD(DEBUG) AND (OP <> TDC) AND (OP<>TEQU) THEN BEGIN PLINT(LISTING,PC);
WRITE(LISTING,' ')
END ;
CASE OP OF
TMOVE: BEGIN
CASE SIZE OF 1: I:=1;
2: I:=3;
(*RM*) 4: I:=2
END; (*CASE*)
GEN43333(I, REG(EA2), MODE(EA2), MODE(EA1), REG(EA1));
GENEAEXT(EA1); GENEAEXT(EA2);
IF (EA1.MODE < BASED) AND (EA2.MODE < BASED)
THEN GENNULL
END; (*TMOVE*)
TLINK: BEGIN
GEN43333(4,7,1,2,ORD(EA1.REG)-ORD(A0));
GENEAEXT(EA2)
END; (*TLINK*)
TUNLK: BEGIN
GEN43333(4,7,1,3,ORD(EA1.REG)-ORD(A0));
GENNULL
END;
TRTS : BEGIN
GEN43333(4,7,1,6,5);
GENNULL
END;
TTST, TCLR, TNEG, TCOMP:
BEGIN
IF SIZE = 1
THEN I := 0
ELSE IF SIZE = 4
THEN I := 2
ELSE I := 1;
CASE OP OF TTST: SUBOP := 5;
TCLR: SUBOP := 1;
TNEG: SUBOP := 2;
TCOMP: SUBOP := 3
END (*CASE*);
GEN43333(4,SUBOP,I,MODE(EA1),REG(EA1));
GENEAEXT(EA1);
END; (*TTST*)
TBTST, TBSET:
BEGIN
IF OP = TBTST
THEN SUBOP := 0 (*BTST*)
ELSE SUBOP := 3; (*BSET*)
IF EA1.MODE = IMMED
THEN
BEGIN
GEN43333(0,4,SUBOP,MODE(EA2),REG(EA2));
GENEAEXT(EA2);
GENEAEXT(EA1) (* BIT NUMBER *)
END
ELSE
BEGIN
GEN43333(0,REG(EA1),4+SUBOP,MODE(EA2),REG(EA2));
GENEAEXT(EA2);
END
END; (*TBTST*)
TOR, TEOR, TSUB, TAND, TADD, TCMP:
BEGIN
IF SIZE = 1
THEN I := 0
ELSE IF SIZE = 4
THEN I := 2
ELSE I := 1;
CASE OP OF
TOR: BEGIN OPC := 8; OPI := 0 END;
TEOR:BEGIN OPC := 11; OPI := 5 END;
TSUB: BEGIN OPC := 9; OPI := 2 END;
TCMP: BEGIN OPC := 11; OPI := 6 END;
TAND: BEGIN OPC := 12; OPI := 1 END;
TADD: BEGIN OPC := 13; OPI := 3 END
END; (*CASE*)
IF (EA1.MODE IN ÆIMMED,LABELLED,LABIMMED,LIMMED,
PIMMED,STSHORT,STLONGÅ) AND (EA2.MODE <> ADIRECT)
THEN
BEGIN
GEN43333(0,OPI,I,MODE(EA2),REG(EA2));
GENEAEXT(EA1);
IF EA2.MODE >= BASED
THEN GENEAEXT(EA2);
END (*THEN*)
ELSE
IF EA2.MODE = ADIRECT
THEN
BEGIN
IF I = 2
THEN SUBOP := 7
ELSE SUBOP := 3;
GEN43333(OPC,REG(EA2),SUBOP,MODE(EA1),REG(EA1));
GENEAEXT(EA1)
END (*THEN*)
ELSE
IF (EA2.MODE=DDIRECT) AND (OP<>TEOR)
THEN
BEGIN
GEN43333(OPC,REG(EA2),I,
MODE(EA1),REG(EA1));
GENEAEXT(EA1)
END (*THEN*)
ELSE
IF EA1.MODE = DDIRECT
THEN
BEGIN
IF OP = TCMP
THEN
ERROR('TO MEMORY COMPARE ');
GEN43333(OPC,REG(EA1),4+I,
MODE(EA2),REG(EA2));
GENEAEXT(EA2)
END (*THEN*)
ELSE ERROR('MEMORY/MEMORY +-ETC ')
END; (*TOR*)
TMULS, TDIVS:
BEGIN
CASE OP OF
TMULS: OPC := 12;
TDIVS: OPC := 8
END; (*CASE*)
GEN43333(OPC,REG(EA2),7,MODE(EA1),REG(EA1));
GENEAEXT(EA1)
END; (*TMULS*)
TTRAP: BEGIN
GEN448(4,14,64 + EA1.DISPL);
GENNULL
END; (*TTRAP*)
TSEQ, TSNE, TSLT, TSNZ, TSLE, TSGT, TSGE:
BEGIN
CASE OP OF
TSEQ: SUBOP := 7;
TSNE: SUBOP := 6;
TSNZ: SUBOP := 6;
TSLT: SUBOP := 13;
TSLE: SUBOP := 15;
TSGT: SUBOP := 14;
TSGE: SUBOP := 12;
END; (*CASE*)
GEN43333(5,SUBOP DIV 2,4*(SUBOP MOD 2) + 3,MODE(EA1),REG(EA1));
GENEAEXT(EA1)
END; (*TSEQ*)
TJMP, TJSR: BEGIN
CASE OP OF
TJMP: SUBOP := 3;
TJSR: SUBOP := 2
END; (*CASE*)
GEN43333(4,7,SUBOP,MODE(EA1),REG(EA1));
GENEAEXT(EA1)
END; (*TJMP*)
TBRA, TBNE, TBNZ, TBGT, TBGE, TBSR, TBEQ, TBZ, TBLT, TBLE:
BEGIN
CASE OP OF
TBRA: SUBOP := 0;
TBSR: SUBOP := 1;
TBNE: SUBOP := 6;
TBNZ: SUBOP := 6;
TBEQ: SUBOP := 7;
TBZ: SUBOP := 7;
TBGE: SUBOP := 12;
TBLT: SUBOP := 13;
TBGT: SUBOP := 14;
TBLE: SUBOP := 15
END; (*CASE*)
I := EA1.DISPL;
IF EA1.MODE = RELATIVE
THEN I := I -2
ELSE IF EA1.MODE = LABELLED
THEN IF ((LABELTABLEÆIÅ.DEFINED)
AND (CURROPCODE <> XCUP))
OR ((PROCTABLEÆIÅ.DEFINED)
AND (CURROPCODE = XCUP))
THEN
BEGIN
IF CURROPCODE = XCUP
THEN LTEMP := PROCTABLEÆIÅ.LOCATION
ELSE LTEMP := LABELTABLEÆIÅ.LOCATION;
LSB(LTEMP, PC);
SSB(LTEMP, 2);
LASGN(I, LTEMP)
END
ELSE I := 0; (* FORWARD REFERENCE*)
GEN448(6,SUBOP,I);
GENNULL
END; (*TBRA*)
TMOVEQ, TLDQ: BEGIN
GEN4318(7,REG(EA2),0,EA1.DISPL);
GENNULL
END; (*TMOVEQ*)
TADDQ, TSUBQ:
BEGIN
IF SIZE = 1
THEN I := 0
ELSE IF SIZE = 4
THEN I := 2
ELSE I := 1;
IF OP = TADDQ
THEN SUBOP := 0
ELSE SUBOP := 4; (* SUBQ*)
IF EA1.DISPL = 8 THEN EA1.DISPL := 0; (* ADJUST FOR IMMED 8 *)
GEN43333(5,EA1.DISPL,SUBOP+I,MODE(EA2),REG(EA2));
IF EA1.DISPL = 0 THEN EA1.DISPL := 8; (*REPAIR IMMED 8*)
GENEAEXT(EA2)
END; (*TADDQ*)
TLEA, TCHK:
BEGIN
IF OP = TLEA
THEN SUBOP := 7
ELSE SUBOP := 6; (*CHK*)
GEN43333(4,REG(EA2),SUBOP,MODE(EA1),REG(EA1));
GENEAEXT(EA1)
END; (*TLEA*)
TPEA: BEGIN
GEN43333(4,4,1,MODE(EA1),REG(EA1));
GENEAEXT(EA1)
END; (*TPEA*)
TDC: BEGIN
IF SIZE = 1
THEN GEN8(EA1.DISPL);
IF SIZE = 2
THEN GEN16(EA1.DISPL);
END; (*TDC*)
TLBSR, TLBLT, TLBEQ, TLBRA, TLBGT, TLBNE, TLBLE, TLBGE:
BEGIN
CASE OP OF
TLBRA: SUBOP := 0;
TLBSR: SUBOP := 1;
TLBNE: SUBOP := 6;
TLBEQ: SUBOP := 7;
TLBGE: SUBOP := 12;
TLBLT: SUBOP := 13;
TLBGT: SUBOP := 14;
TLBLE: SUBOP := 15;
END; (*CASE*)
I := EA1.DISPL;
IF EA1.MODE = RELATIVE
THEN I := I
ELSE IF EA1.MODE = LABELLED
THEN IF (LABELTABLEÆIÅ.DEFINED
AND (CURROPCODE <> XCUP))
OR (PROCTABLEÆIÅ.DEFINED
AND (CURROPCODE = XCUP))
THEN
BEGIN
IF CURROPCODE = XCUP
THEN LTEMP := PROCTABLEÆIÅ.LOCATION
ELSE LTEMP := LABELTABLEÆIÅ.LOCATION;
LSB(LTEMP, PC);
SSB(LTEMP, 2);
LASGN(I, LTEMP)
END
ELSE I := 0 (*FORWARD REF*)
ELSE IF EA1.MODE = XEXTERNAL
THEN I := -(I );
GEN448(6,SUBOP,0);
SUBOP := EA1.DISPL;
EA1.DISPL := I;
GENEAEXT(EA1);
EA1.DISPL := SUBOP;
END; (*TLBSR*)
TSWAP: BEGIN
GEN43333(4,4,1,0,REG(EA1));
GENNULL
END; (*TSWAP*)
TEXTE: BEGIN
IF SIZE = 4
THEN I := 3
ELSE I := 2;
GEN43333(4,4,I,0,REG(EA1));
GENNULL
END; (*TEXTE*)
TCMPM: BEGIN
CASE SIZE OF
1: I := 4;
2: I := 5;
4: I := 6
END; (*CASE*)
GEN43333(11,REG(EA2),I,1,REG(EA1));
GENNULL
END; (*TCMPM*)
TDCNT: BEGIN (* WARNING: THIS IS OLD DCNT *)
GEN4318(7,REG(EA1),1,256 - EA2.DISPL);
GENNULL
END (*TDCNT*) ;
TASL: WRITELN(LISTING,'****ASL NOT SUPPORTED YET***');
TEQU: ;
END; (*CASE*)
IF OP <> TDC THEN
BEGIN
IF (OP <> TEQU) AND ODD(DEBUG) THEN WRITE(LISTING,MACHCODE);
MACHCODE := ' ';
MACHINDEX := 1;
PRINTINSTRUCTION
END;
END; (*GENX*)
PROCEDURE PUSHDREG;
VAR K: INTEGER;
BEGIN IF DALLOC <= 0 THEN ERROR('NO D REG TO PUSH ')
ELSE BEGIN K := SIZEÆREGTYPEÆDBOTÅÅ;
(*1204B*) IF K = 8 THEN K := 4; (* POWERSETS*)
EADDIR.REG := DBOT;
GENX(TMOVE,K,EADDIR,EAPUSH);
STKPTR:=STKPTR + 1;
IF STKPTR > STKMAX THEN ERROR('TOO MANY REG PUSHES ');
KINDSTKÆSTKPTRÅ := DREG;
TYPESTKÆSTKPTRÅ := REGTYPEÆDBOTÅ;
DALLOC := DALLOC - 1;
IF DALLOC = 0 THEN
BEGIN
DBOT := DNONE;
DTOP := DNONE
END
ELSE
DBOT := DREGSÆ(ORD(DBOT)-ORD(D0)+1) MOD NDREGSÅ;
END
END; (*PUSHDREG*)
PROCEDURE PUSHAREG;
VAR K: INTEGER;
BEGIN IF AALLOC <= 0 THEN ERROR('NO A REG TO PUSH ')
ELSE BEGIN K := SIZEÆREGTYPEÆABOTÅÅ;
EAADIR.REG := ABOT;
GENX(TMOVE,K,EAADIR,EAPUSH);
STKPTR:=STKPTR + 1;
IF STKPTR > STKMAX THEN ERROR('TOO MANY REG PUSHES ');
KINDSTKÆSTKPTRÅ := AREG;
TYPESTKÆSTKPTRÅ := REGTYPEÆABOTÅ;
AALLOC := AALLOC -1;
IF AALLOC = 0 THEN BEGIN ABOT := ANONE; ATOP := ANONE END
ELSE
ABOT := AREGSÆ(ORD(ABOT)-ORD(A0) + 1) MOD NAREGSÅ;
END
END; (*PUSHAREG*)
PROCEDURE PUSHALLD;
BEGIN WHILE DALLOC > 0 DO PUSHDREG END;
PROCEDURE PUSHALL;
BEGIN WHILE AALLOC > 0 DO PUSHAREG;
WHILE DALLOC > 0 DO PUSHDREG
END;
PROCEDURE FREEALL;
BEGIN
DALLOC := 0; DTOP := DNONE; DBOT := DNONE;
AALLOC := 0; ATOP := ANONE; ABOT := ANONE
END; (*FREEALL*)
PROCEDURE POPREG(KIND: REGKIND);
PROCEDURE POPD;
VAR K: INTEGER;
(*RM*) BEGIN
(*RM*) IF DBOT = DNONE THEN
(*RM*) BEGIN
(*RM*) DBOT := D0;
(*RM*) DTOP := D0
(*RM*) END ELSE
DBOT :=
DREGSÆ (ORD(DBOT)-ORD(D0)-1+NDREGS) MOD NDREGSÅ;
DALLOC := DALLOC + 1;
IF STKPTR < 0 THEN ERROR('POPPING EMPTY STACK ')
ELSE BEGIN
K := SIZEÆTYPESTKÆSTKPTRÅÅ;
(*1204B*) IF K = 8 THEN K := 4; (*POWERSETS*)
EADDIR.REG := DBOT;
GENX(TMOVE,K,EAPOP, EADDIR);
REGTYPEÆDBOTÅ := TYPESTKÆSTKPTRÅ;
IF STKPTR >= 0 THEN STKPTR := STKPTR -1;
DPOPCNT := DPOPCNT + 1;
END
END; (*POPD*)
PROCEDURE POPA;
VAR K: INTEGER;
(*RM*) BEGIN IF ABOT = ANONE THEN
(*RM*) BEGIN
(*RM*) ABOT := A0;
(*RM*) ATOP := A0
(*RM*) END
ELSE ABOT :=
AREGSÆ (ORD(ABOT)-ORD(A0)-1+NAREGS) MOD NAREGSÅ;
AALLOC := AALLOC + 1;
IF STKPTR < 0 THEN ERROR('POPPING EMPTY STACK ')
ELSE BEGIN
K := SIZEÆTYPESTKÆSTKPTRÅÅ;
EAADIR.REG := ABOT;
GENX(TMOVE,K,EAPOP, EAADIR);
REGTYPEÆABOTÅ := TYPESTKÆSTKPTRÅ;
IF STKPTR >= 0 THEN STKPTR := STKPTR -1;
APOPCNT := APOPCNT + 1;
END
END; (*POPA*)
BEGIN IF KIND = DREG THEN
BEGIN WHILE KINDSTKÆSTKPTRÅ <> DREG DO POPA;
(*RM*) IF STKPTR >= 0 THEN POPD
ELSE ERROR('NO D REG TO POP ')
END
ELSE
BEGIN WHILE KINDSTKÆSTKPTRÅ <> AREG DO POPD;
(*RM*) IF STKPTR >= 0 THEN POPA
ELSE ERROR('NO A REG TO POP ')
END
END;
FUNCTION PREVIOUS(R:REGISTER):REGISTER;
BEGIN
PREVIOUS := DREGSÆ(ORD(R)-ORD(D0)-1+NDREGS) MOD NDREGSÅ
END; (* PREVIOUS *)
PROCEDURE ALLOCDREG;
BEGIN
DALLOCCNT := DALLOCCNT + 1;
IF DALLOC >= NDREGS THEN BEGIN PUSHDREG;
DPUSHCNT:=DPUSHCNT+1
END;
DALLOC := DALLOC + 1;
DTOP := DREGSÆ(ORD(DTOP)-ORD(D0)+1) MOD NDREGSÅ;
IF DBOT = DNONE THEN DBOT := DTOP;
REGTYPEÆDTOPÅ := INSTR^.DTYPE;
END; (*ALLOCDREG*)
PROCEDURE ALLOCAREG;
BEGIN
AALLOCCNT := AALLOCCNT + 1;
IF AALLOC >= NAREGS THEN BEGIN PUSHAREG;
APUSHCNT:=APUSHCNT+1
END;
AALLOC := AALLOC + 1;
ATOP := AREGSÆ(ORD(ATOP)-ORD(A0)+1) MOD NAREGSÅ;
IF ABOT = ANONE THEN ABOT := ATOP;
(*1011*) REGTYPEÆATOPÅ := ATYP;
END; (*ALLOCAREG*)
PROCEDURE FREEDREG;
BEGIN IF DALLOC > 1 THEN BEGIN
DALLOC := DALLOC -1;
DTOP := DREGSÆ(ORD(DTOP)-ORD(D0)+NDREGS-1) MOD NDREGSÅ
(*-1 AND WRAPAROUND*)
END
ELSE IF DALLOC = 1 THEN BEGIN
DALLOC := 0;
(*RM*) DBOT := DNONE;
DTOP := DNONE
END
ELSE ERROR('FREE NONALLOC''D DREG')
END; (*FREEDREG*)
PROCEDURE FREEAREG;
BEGIN IF AALLOC > 1 THEN BEGIN
AALLOC := AALLOC -1;
ATOP := AREGSÆ(ORD(ATOP)-ORD(A0)+NAREGS-1) MOD NAREGSÅ
(*-1 AND WRAPAROUND*)
END
ELSE IF AALLOC = 1 THEN BEGIN
AALLOC := 0;
(*RM*) ABOT := ANONE;
ATOP := ANONE
END
ELSE ERROR('FREE NONALLOC''D AREG')
END; (*FREEAREG*)
PROCEDURE EFFADDRESS(INSTR: IPTR; VAR OPADDR: EFFADDR);
(*USED BY LOD, LDA, STR, TAKES LEVEL, OFFSET
IN OPAND1 AND OPAND2 AND RETURNS MODE,
REGISTER, AND DISPLACEMENT OF CORRESPONDING
68000 ADDRESS*)
VAR SRC: EFFADDR;
BEGIN WITH INSTR^ DO
BEGIN IF OPAND1 (*LEVEL*) = 0 THEN (*GLOBAL ACCESS*)
OPADDR.REG := A5 (*GLOBAL BASE REGISTER*)
ELSE IF OPAND1 = LEVEL THEN (*LOCAL ACCESS*)
OPADDR.REG := A6 (*FRAME POINTER*)
ELSE BEGIN
IF TEMPLEVEL <> OPAND1 THEN
BEGIN
EAADIR.REG := A4;
BUILDADDR(SRC,BASED,A5,ANONE,4*OPAND1 + 8);
GENX(TMOVE,4,SRC,EAADIR);
TEMPLEVEL := OPAND1
(*SAVE LEVEL OF DISPLAY ENTRY
CURRENTLY HELD IN A4*)
END;
OPADDR.REG := A4; (*TEMPORARY INTERMEDIATE PTR*)
END;
OPADDR.MODE := BASED;
OPADDR.DISPL := OPAND2; (*OFFSET*)
IF (OPADDR.REG = A4) OR (OPADDR.REG = A6) THEN
IF OPAND2 >= 0 THEN OPADDR.DISPL := OPAND2 + 12;
IF OPADDR.DISPL = 0 THEN OPADDR.MODE := DEFER
END;
END; (*EFFADDRESS*)
PROCEDURE DOUBLEOP(VAR SRC, DST:EFFADDR; COMMUTATIVE: BOOLEAN;
VAR SWITCH: BOOLEAN);
(*RM*) BEGIN
(*RM*) IF INSTR^.DTYPE = ATYP THEN BEGIN
(*RM*) IF NOT COMMUTATIVE OR (AALLOC>=2) THEN
(*RM*) BEGIN
(*RM*) WHILE AALLOC <= 1 DO POPREG(AREG);
(*RM*) BUILDADDR(SRC,ADIRECT,ATOP,ANONE,0);
(*RM*) FREEAREG;
(*RM*) BUILDADDR(DST,ADIRECT,ATOP,ANONE,0);
(*RM*) SWITCH := FALSE
(*RM*) END ELSE
(*RM*) BEGIN
(*RM*) IF AALLOC < 1 THEN POPREG(AREG);
(*RM*) (*AALLOC = 1 AT THIS POINT *)
(*RM*) BUILDADDR(DST,ADIRECT,ATOP,ANONE,0);
(*RM*) BUILDADDR(SRC,INCR,SP,ANONE,0);
(*RM*) SWITCH := TRUE;
(*RM*) IF NOT (INSTR^.DTYPE IN LONGTYPES) THEN STKPTR := STKPTR -1;
(*RM*) END
(*RM*) END ELSE
BEGIN IF NOT COMMUTATIVE OR (DALLOC >= 2) THEN
BEGIN
WHILE DALLOC <= 1 DO POPREG(DREG);
BUILDADDR(SRC,DDIRECT,DTOP,ANONE,0);
FREEDREG;
BUILDADDR(DST,DDIRECT,DTOP,ANONE,0);
SWITCH := FALSE
END
ELSE BEGIN
IF DALLOC < 1 THEN POPREG(DREG);
(*DALLOC = 1 AT THIS POINT*)
BUILDADDR(DST,DDIRECT,DTOP,ANONE,0);
BUILDADDR(SRC,INCR,SP,ANONE,0);
SWITCH := TRUE;
(*RM*) IF NOT (INSTR^.DTYPE IN LONGTYPES) THEN STKPTR := STKPTR -1;
END
(*RM*) END
(*RM*) END;
PROCEDURE SINGLEOP(VAR SRC:EFFADDR);
(*RM*) BEGIN
(*RM*) IF INSTR^.DTYPE = ATYP THEN
(*RM*) BEGIN IF AALLOC = 0 THEN POPREG(AREG);
(*RM*) BUILDADDR(SRC,ADIRECT,ATOP,ANONE,0)
(*RM*) END ELSE
BEGIN IF DALLOC = 0 THEN POPREG(DREG);
BUILDADDR(SRC,DDIRECT,DTOP,ANONE,0);
(*RM*) END
END;
PROCEDURE LOADBIG(ADDR: EFFADDR; BYTES: INTEGER);
(* PROCEDURE TO LOAD POWERSETS ONTO STACK *)
BEGIN
ALLOCDREG;
EADDIR.REG := DTOP;
GENX(TMOVE,4,ADDR,EADDIR);
IF ADDR.MODE = BASED
THEN ADDR.DISPL := ADDR.DISPL + 4
ELSE IF ADDR.MODE=DEFER
THEN BEGIN
ADDR.MODE := BASED;
ADDR.DISPL := 4
END
ELSE ERROR('LOADBIG W/BAD MODE ');
ALLOCDREG;
EADDIR.REG := DTOP;
GENX(TMOVE,4,ADDR,EADDIR);
END; (*LOADBIG*)
PROCEDURE STOREBIG(ADDR: EFFADDR; BYTES: INTEGER);
(* PROCEDURE TO STORE POWERSETS OFF THE STACK *)
BEGIN
EADDIR.REG := PREVIOUS(DTOP);
GENX(TMOVE,4,EADDIR,ADDR);
IF ADDR.MODE = BASED
THEN ADDR.DISPL := ADDR.DISPL + 4
ELSE IF ADDR.MODE = DEFER
THEN BEGIN
ADDR.MODE := BASED;
ADDR.DISPL := 4
END
ELSE ERROR('STOREBIG W/BAD MODE ');
EADDIR.REG := DTOP;
FREEDREG;
GENX(TMOVE,4,EADDIR,ADDR);
FREEDREG
END; (*STOREBIG*)
PROCEDURE STORELITTLE; (*GEN CODE TO MOVE TOP DATA ITEM TO MEMORY*)
BEGIN IF DALLOC > 0 THEN
BEGIN EADDIR.REG := DTOP;
GENX(TMOVE,SIZEÆINSTR^.DTYPEÅ,EADDIR,SOURCE);
FREEDREG;
END
ELSE BEGIN GENX(TMOVE,SIZEÆINSTR^.DTYPEÅ,EAPOP,SOURCE);
STKPTR := STKPTR - 1;
END
END; (*STORELITTLE*)
PROCEDURE REFERENCELABEL(LABL: INTEGER; WHERE: ADDRESS);
(* CALLED TO SAVE FORWARD REFERENCE INFO *)
BEGIN
NEW(TEMPLABREF);
WITH TEMPLABREF^ DO
BEGIN
IF INSTR^.OPCODE=XCUP
THEN NEXT := PROCTABLEÆLABLÅ.REFCHAIN
ELSE NEXT := LABELTABLEÆLABLÅ.REFCHAIN;
CORELOC := WHERE
END; (*WITH*)
IF INSTR^.OPCODE=XCUP
THEN BEGIN
PROCTABLEÆLABLÅ.REFCHAIN := TEMPLABREF;
PROCTABLEÆLABLÅ.REFED := TRUE;
CLR (PROCTABLEÆLABLÅ.LOCATION);
PROCTABLEÆLABLÅ.LOCATIONÆ0Å := 1
END (*ELSE*)
ELSE BEGIN
LABELTABLEÆLABLÅ.REFCHAIN := TEMPLABREF ;
LABELTABLEÆLABLÅ.REFED := TRUE;
IF INSTR^.OPCODE = XENT
THEN SASGN(LABELTABLEÆLABLÅ.LOCATION, -1)
ELSE CLR(LABELTABLEÆLABLÅ.LOCATION);
END; (*ELSE*)
END; (*REFERENCELABEL*)
PROCEDURE LONGBSR; (* RUNTIME ROUTINE BRANCH CALCULATION *)
VAR
I: INTEGER;
RTNAME: PCODES;
BEGIN
WITH INSTR^ DO
BEGIN
RTNAME := OPCODE;
IF DTYPE = VTYP
THEN BEGIN
IF RTNAME = XIND THEN RTNAME := XINDV
ELSE IF RTNAME = XLOD THEN RTNAME := XLODV
ELSE IF RTNAME = XSTR THEN RTNAME := XSTRV
ELSE IF RTNAME = XSTO THEN RTNAME := XSTOV
ELSE IF RTNAME = XEQU THEN RTNAME := XEQUV
ELSE IF RTNAME = XNEQ THEN RTNAME := XNEQV
ELSE IF RTNAME = XLES THEN RTNAME := XLESV
ELSE IF RTNAME = XLEQ THEN RTNAME := XLEQV
ELSE IF RTNAME = XGRT THEN RTNAME := XGRTV
ELSE IF RTNAME = XGEQ THEN RTNAME := XGEQV
ELSE IF RTNAME = XLDC THEN RTNAME := XLDCV
END
ELSE IF RTNAME = XCVT
THEN IF (D1TYPE=STYP) AND (DTYPE=UTYP)
THEN RTNAME := XCVTSU
ELSE IF (D1TYPE=UTYP) AND (DTYPE=STYP)
THEN RTNAME := XCVTUS;
CLR(LTEMP);
LSB(LTEMP,RTJUMP);
SAD(LTEMP,RTÆRTNAMEÅ);
SSB(LTEMP,4096);
LASGN(SOURCE.DISPL,LTEMP);
BUILDADDR(SOURCE,BASED,A3,ANONE,SOURCE.DISPL);
GENX(TJSR,2,SOURCE,EANONE)
END (*WITH*)
END; (*LONGBSR*)
PROCEDURE MAIN;
BEGIN
IF INSTR^.OPAND1 = 0 THEN
BEGIN
PROGSTART := PC;
MAINFLG := TRUE;
WRITELN(LISTING,'MAIN',' ':6,'EQU *');
END
ELSE WRITELN(LISTING,'USER':4,CURRLABEL:1,' EQU *')
END ; (* MAIN *)
PROCEDURE GENXXJP;
BEGIN
(*0421B*) IF DALLOC = 0 THEN POPREG(DREG);
EADDIR.REG := DTOP;
EALIMM.DISPL := INSTR^.OPAND1 + 1;
GENX(TCMP,2,EALIMM,EADDIR);
LTEMP := PC;
SSB(LTEMP, 2);
REFERENCELABEL(EALIMM.DISPL,LTEMP);
(*RM*) EAREL.DISPL := 20;
GENX(TBGT,2,EAREL,EANONE);
EALIMM.DISPL := INSTR^.OPAND1;
GENX(TSUB,2,EALIMM,EADDIR);
LTEMP := PC;
SSB(LTEMP, 2);
REFERENCELABEL(EALIMM.DISPL,LTEMP);
(*RM*) EAREL.DISPL := 14;
GENX(TBLT,2,EAREL,EANONE);
EALAB.DISPL := INSTR^.OPAND1 + 2;
ALLOCAREG;
EAADIR.REG := ATOP;
GENX(TLEA,2,EALAB,EAADIR);
LTEMP := PC;
SSB(LTEMP, 2);
REFERENCELABEL(EALAB.DISPL,LTEMP);
GENX(TADD,2,EADDIR,EADDIR);
BUILDADDR(SOURCE,INDEX,ATOP,DTOP,0);
GENX(TADD,2,SOURCE,EAADIR);
EADEFER.REG := ATOP;
GENX(TJMP,2,EADEFER,EANONE);
FREEDREG; FREEAREG
END (* GENXXJP *) ;
(*RM*) PROCEDURE LOADPSET;
(*RM*) BEGIN
(*RM*) WITH INSTR^ DO BEGIN
(*RM*) ALLOCDREG;
(*RM*) EADDIR.REG := DTOP;
(*RM*) EAPSET.DISPL := 0;
(*RM*) GENX(TMOVE,4,EAPSET,EADDIR);
(*RM*) ALLOCDREG;
(*RM*) EADDIR.REG := DTOP;
(*RM*) EAPSET.DISPL := 8;
(*RM*) GENX(TMOVE,4,EAPSET,EADDIR)
(*RM*) END
(*RM*) END; (* LOADPSET *)
PROCEDURE SETOPS;
BEGIN
WITH INSTR^ DO BEGIN
WHILE DALLOC < 4 DO POPREG(DREG);
IF OPCODE = XDIF THEN BEGIN
EADDIR.REG := DTOP;
(*1324A*) GENX(TCOMP,4,EADDIR,EANONE);
EADDIR.REG := PREVIOUS(DTOP);
(*1324A*) GENX(TCOMP,4,EADDIR,EANONE);
END;
IF OPCODE = XUNI THEN OPCDE := TOR
ELSE OPCDE := TAND;
BUILDADDR(SOURCE,DDIRECT,DTOP,DNONE,0);
EADDIR.REG := PREVIOUS(PREVIOUS(DTOP));
GENX(OPCDE,4,SOURCE,EADDIR);
SOURCE.REG := PREVIOUS(DTOP);
EADDIR.REG := PREVIOUS(PREVIOUS(PREVIOUS(DTOP)));
GENX(OPCDE,4,SOURCE,EADDIR);
FREEDREG;FREEDREG;
END
END; (* SETOPS *)
PROCEDURE PXLAB;
BEGIN WITH INSTR^ DO BEGIN
IF OPAND1 = 0 THEN OPAND1 := -1;
(*604*) PCPRINT;
WRITE(LISTING,'L',OPAND1 + LABELOFFSET:1);
BUILDADDR(SOURCE,RELATIVE,ANONE,ANONE,0);
GENX(TEQU,0,SOURCE,EANONE)
END;
END; (* PXLAB *)
PROCEDURE PXEND;
VAR I: INTEGER;
BEGIN
EMITCODE;
IF MAINFLG THEN BEGIN
GENLOC := GENSTART;
WRITE(LISTING,' RORG $');
PLINT(LISTING,GENSTART);
LTEMP := PC;
WRITELN(LISTING,' ');
LSB(LTEMP,GENSTART);
SSB(LTEMP,20);
GENSAVE := PC;
PC := GENSTART;
(* LOAD STACK *)
WRITE(LISTING,' ':39,'MOVE.L $');
PLINT(LISTING,STKSTART);
WRITELN(LISTING,',A7');
EAIMMED.DISPL := 11900; (* TMOVE 2E7C *)
GENX(TDC,2,EAIMMED,EANONE);
EAIMMED.DISPL := STKSTARTÆ0Å;
GENX(TDC,1,EAIMMED,EANONE);
EAIMMED.DISPL := STKSTARTÆ1Å;
GENX(TDC,1,EAIMMED,EANONE);
EAIMMED.DISPL := STKSTARTÆ2Å;
GENX(TDC,1,EAIMMED,EANONE);
EAIMMED.DISPL := STKSTARTÆ3Å;
GENX(TDC,1,EAIMMED,EANONE);
(* LEA 11EA,A3 *)
WRITE(LISTING,' ':39,'LEA $');
LTEMP := RTJUMP;
SAD(LTEMP,4096);
PLINT(LISTING,LTEMP);
WRITELN(LISTING,',A3');
EAIMMED.DISPL := 18425; (* LEA 47F9 *)
GENX(TDC,2,EAIMMED,EANONE);
EAIMMED.DISPL := LTEMPÆ0Å;
GENX(TDC,1,EAIMMED,EANONE);
EAIMMED.DISPL := LTEMPÆ1Å;
GENX(TDC,1,EAIMMED,EANONE);
EAIMMED.DISPL := LTEMPÆ2Å;
GENX(TDC,1,EAIMMED,EANONE);
EAIMMED.DISPL := LTEMPÆ3Å;
GENX(TDC,1,EAIMMED,EANONE);
(* JSR -490(A3) INITIALIZE ENVIRONMENT *)
LONGBSR;
IF (HEAPSTARTÆ0Å=255) AND (HEAPSTARTÆ1Å=255)
AND (HEAPSTARTÆ2Å=255) AND (HEAPSTARTÆ3Å=255)
THEN BEGIN
HEAPSTART := GENSAVE;
SAD(HEAPSTART,10)
END;
WRITE(LISTING,' ':10,'DC.L ':7,'$':1);
PLINT(LISTING,HEAPSTART);
WRITELN(LISTING,' ');
FOR I := 0 TO 3 DO
BEGIN
EAIMMED.DISPL := HEAPSTARTÆIÅ;
GENX(TDC,1,EAIMMED,EANONE)
END;
(* BRA OR JSR TO MAIN *)
LTEMP := PROGSTART;
LSB(LTEMP,PC);
IF SHORT(LTEMP) THEN BEGIN
LASGN(EAREL.DISPL, LTEMP);
GENX(TLBRA,2,EAREL,EANONE);
END ELSE
BEGIN
EADEFER.REG := A3;
SSB(LTEMP,2);
GENX(TJSR,2,EADEFER,EANONE);
WRITE(LISTING,' ':10,'DC.L ':7,'$':1);
PLINT(LISTING,LTEMP);
WRITELN(LISTING,' ');
FOR I := 0 TO 3 DO
BEGIN
EAIMMED.DISPL := LTEMPÆIÅ;
GENX(TDC,1,EAIMMED,EANONE)
END
END;
PC := GENSAVE;
EMITCODE;
END; (*BEGIN*)
EMITEND
;WRITELN(LISTING,' END');
END; (*PXEND*)
PROCEDURE PXDEF;
BEGIN WITH INSTR^ DO BEGIN
IF LABELED AND NOT DOLLAR THEN
BEGIN
IF OPAND1= 0 THEN OPAND1 := 1-LABELOFFSET;
(*604*) PCPRINT;
WRITE(LISTING,'L',OPAND1 + LABELOFFSET:1);
BUILDADDR(SOURCE,ABSOLUTE,ANONE,ANONE,OPAND2);
GENX(TEQU,0,SOURCE,EANONE)
END;
IF LABELED AND DOLLAR THEN
BEGIN GETSTRING;
WRITE(OUTPUT,'***** REFERENCE TO EXTERNAL PROCEDURE ',
VSTRING:ALENGTH,' AT LOCATION ');
LTEMP := EXPROC;
SSB(LTEMP,10);
PLINT(OUTPUT,LTEMP);
WRITELN(OUTPUT,' ');
END
ELSE IF NOT LABELED THEN
ERROR('DEF WITH NO LABEL ')
END;
END; (*PXDEF*)
PROCEDURE PXENT; (* OPAND1 IS NEW LEVEL*)
BEGIN WITH INSTR^ DO BEGIN
(*OPAND2 IS LABEL WHICH GIVES LOCAL DATA SZ*)
(*VSTRING IS NEW PROC/FUNC NAME*)
EMITCODE;
RESETLABEL;
MAIN;
LEVEL := OPAND1;
IF TEMPLEVEL = LEVEL THEN TEMPLEVEL := -1;
(*INVALIDATE A4 (POINTER TO INTERMEDIATE
LEXICAL LEVEL) IF DISPLAY ENTRY CHANGES*)
IF LEVEL = 1 THEN
BEGIN
WRITE(OUTPUT,'*****ENTRY TO PROCEDURE ':25,
VSTRING:ALENGTH,' AT LOCATION ');
PLINT(OUTPUT,PC);
WRITELN(OUTPUT,' ')
END;
(*1212A*) IF LEVEL = 0 THEN
(*1212A*) BEGIN
(*1212A*) EAADIR.REG := A7;
(*1212A*) EALIMM.DISPL := -OPAND2;
(*1212A*) GENX(TADD,0,EALIMM,EAADIR);
LTEMP := PC;
SSB(LTEMP, 2);
(*1212A*) REFERENCELABEL(OPAND2 - LABELOFFSET,LTEMP)
(*1212A*) END
(*1212A*) ELSE BEGIN
BUILDADDR(SOURCE,BASED,A5,ANONE,8+4*LEVEL);
(*DISPLAY IS ^A5(6)*)
GENX(TMOVE,4,SOURCE,EAPUSH);
EAADIR.REG := A6; (*FRAME POINTER*)
EALIMM.DISPL := -OPAND2 ;
GENX(TLINK,0,EAADIR,EALIMM) ;
LTEMP := PC;
SSB( LTEMP, 2);
REFERENCELABEL(OPAND2 - LABELOFFSET,LTEMP);
GENX(TMOVE,4,EAADIR,SOURCE);
(*1212A*) END;
END;
END; (* PXENT *)
PROCEDURE PXRET;
BEGIN WITH INSTR^ DO BEGIN
IF OPAND1 <> LEVEL THEN
ERROR('ENT/RET LEVELS NOT =');
EAADIR.REG := A6; (*FRAME POINTER*)
GENX(TUNLK,0,EAADIR,EANONE);
BUILDADDR(SOURCE,BASED,A5,ANONE,8+4*LEVEL);
GENX(TMOVE,4,EAPOP,SOURCE);
(*RM*) (* CODE TO FLUSH ARGUMENTS FROM STACK *)
(*RM*) IF OPAND2 <> 0 THEN
(*RM*) BEGIN
(*RM*) ALLOCAREG;
(*RM*) EAADIR.REG := ATOP;
(*RM*) GENX(TMOVE,4,EAPOP,EAADIR);
(*RM*) EAIMMED.DISPL := OPAND2;
(*RM*) EAADIR.REG := SP;
(*RM*) GENX(TADD,4,EAIMMED,EAADIR);
(*RM*) EADEFER.REG := ATOP;
(*RM*) GENX(TJMP,0,EADEFER,EANONE);
(*RM*) FREEAREG
(*RM*) END ELSE
GENX(TRTS,0,EANONE,EANONE)
END;
END; (*PXRET*)
(*604*) PROCEDURE PXAD; FORWARD;
PROCEDURE PXAB;
BEGIN WITH INSTR^ DO BEGIN
SINGLEOP(SOURCE);
(*RM*) K := SIZEÆDTYPEÅ;
CASE SUBTYPEÆOPCODEÅ OF
(*604*) 1 (*AB *): BEGIN GENX(TTST,K,SOURCE,EANONE);
(*RM*) EAREL.DISPL := 4;
GENX(TBGT,0,EAREL,EANONE);
(*604*) GENX(TNEG,K,SOURCE,EANONE)
END;
(*604*) 2 (*NG *): GENX(TNEG,K,SOURCE,EANONE);
(*RM*) 3 (*DEC*): BEGIN EAIMMED.DISPL := OPAND1;
GENX(TSUB,K,EAIMMED,SOURCE)
(*RM*) END;
(*RM*) 4 (*INC*): BEGIN EAIMMED.DISPL := OPAND1;
(*480*) IF DTYPE = ATYP THEN K := 2;
(*RM*) GENX(TADD,K,EAIMMED,SOURCE) END;
5 (*NOT*): BEGIN
OPTIMI := NEXTPCOD(INSTR);
IF OPTIMI^.OPCODE=XFJP
THEN BEGIN
OPTIMI^.OPAND3 := 102; (*BEQ TO FJP*)
END
ELSE BEGIN
(*RM*) EAIMMED.DISPL := 1;
(*RM*) GENX(TEOR,1,EAIMMED,SOURCE)
END
(*RM*) END;
(*0421C*) 6 (*ODD*): BEGIN EAIMMED.DISPL := 1;(*BIT # = 0*)
(*0421C*) GENX(TAND,1,EAIMMED,SOURCE);
(*0421C*) REGTYPEÆDTOPÅ := BTYP;
END;
(*RM*) 7 (*SQR*): (*CHECK SIZES??*)
(*604*) IF DTYPE = JTYP
(*604*) THEN BEGIN
(*604*) IF DALLOC < 1
(*604*) THEN POPREG(DREG);
(*604*) EADDIR.REG := DTOP;
(*604*) ALLOCDREG;
(*604*) BUILDADDR(DEST,DDIRECT,
(*604*) DTOP,ANONE,0);
(*604*) GENX(TMOVE,4,EADDIR,DEST);
(*604*) OPCODE := XMP;
(*604*) PXAD;
(*604*) END ELSE
(*604*) BEGIN
(*604*) IF DTYPE = HTYP
(*604*) THEN BEGIN
(*604*) IF DALLOC<1 THEN POPREG(DREG);
(*604*) BUILDADDR(SOURCE,DDIRECT,DTOP,
(*604*) ANONE,0);
(*604*) GENX(TEXTE,2,SOURCE,EANONE)
(*604*) END;
(*RM*) GENX(TMULS,2,SOURCE,SOURCE);
(*604*) END;
(* CHECK OVFL
MOV.W TO TEMP
EXT.L TEMP
CMP TEMP WITH SOURCE
BNE *+2
TRAP OVFL *)
END
END;
END; (*PXAB*)
PROCEDURE PXAD;
BEGIN WITH INSTR^ DO BEGIN
CASE SUBTYPEÆOPCODEÅ OF
(*604*) 1,3,4: COMMUTATIVE := TRUE;
(*604*) 5: IF DTYPE IN ÆJTYP,HTYPÅ THEN COMMUTATIVE := FALSE
(*604*) ELSE COMMUTATIVE := TRUE;
2,6,7: COMMUTATIVE := FALSE
END;
DOUBLEOP(SOURCE,DEST,COMMUTATIVE,SWITCH);
K := SIZEÆDTYPEÅ;
IF DTYPE = NOTATYP THEN K := 1; (* ASSUME BOOLEAN*)
(*604*) IF (DTYPE = JTYP)
(*604*) AND (SUBTYPEÆOPCODEÅ IN Æ5,6,7Å)
(*604*) THEN BEGIN
(*604*) LONGBSR;
(*604*) EAIMMED.DISPL := ORD(DEST.REG) - ORD(D0);
(*604*) PCPRINT;
(*604*) WRITELN(LISTING,' ':10,'DC.W ',
(*604*) EAIMMED.DISPL:0);
(*604*) GENX(TDC,2,EAIMMED,EANONE);
(*604*) END ELSE
CASE SUBTYPEÆOPCODEÅ OF
1 (*ADD*): GENX(TADD,K,SOURCE, DEST);
2 (*SB *): GENX(TSUB,K,SOURCE, DEST);
3 (*AND*): GENX(TAND,K,SOURCE, DEST);
4 (*IOR*): GENX(TOR, K,SOURCE, DEST);
(*604*) 5 (*MP *): BEGIN
(***CHECK OVFL; SEE CODE FOR SQR*)
(*604*) IF DTYPE = HTYP
(*604*) THEN GENX(TEXTE,2,SOURCE,EANONE);
(*604*) IF (DTYPE = HTYP)
(*604*) THEN GENX(TEXTE,2,DEST,EANONE);
(*604*) GENX(TMULS,2,SOURCE,DEST)
END;
(*604*) 6 (*DV *): BEGIN
(*604*) IF DTYPE = HTYP
(*604*) THEN BEGIN
(*604*) GENX(TEXTE,2,SOURCE,EANONE);
(*604*) GENX(TEXTE,2,DEST,EANONE)
(*604*) END;
(*604*) GENX(TEXTE,4,DEST,EANONE);
(*RM*) GENX(TDIVS,2,SOURCE,DEST)
END;
(*604*) 7 (*MOD*): BEGIN
(*604*) IF DTYPE = HTYP
(*604*) THEN BEGIN
(*604*) GENX(TEXTE,2,SOURCE,EANONE);
(*604*) GENX(TEXTE,2,DEST,EANONE)
(*604*) END;
(*604*) GENX(TEXTE,4,DEST,EANONE);
(*RM*) GENX(TDIVS,2,SOURCE,DEST);
(*RM*) GENX(TSWAP,2,DEST,EANONE)
END;
END
END;
END; (*PXAD*)
PROCEDURE PXCLO;
VAR I:INTEGER;
BEGIN WITH INSTR^ DO BEGIN
IF SHORT(FIRSTESD^.REFERENCE)
AND (FIRSTESD^.REFERENCEÆ2Å=0)
AND (FIRSTESD^.REFERENCEÆ3Å=0) THEN
BEGIN TEMPESD:= FIRSTESD;
NEW(FIRSTESD); FIRSTESD^.NEXT:=TEMPESD;
END;
LTEMP := PC;
SAD(LTEMP, 2);
FIRSTESD^.REFERENCE := LTEMP;
FIRSTESD^.NAME := OPCODE;
IF (OPCODE=XWRB) OR (OPCODE=XWRC) OR (OPCODE=XWRI)
(*604*) OR (OPCODE=XWRH) OR (OPCODE=XWRJ)
THEN BEGIN
(*0610B*) IF OPCODE=XWRC THEN DTYPE := CTYP
(*0610B*) ELSE IF OPCODE=XWRI THEN DTYPE := ITYP
(*0610B*) ELSE IF OPCODE=XWRH THEN DTYPE := HTYP
(*0610B*) ELSE IF OPCODE=XWRJ THEN DTYPE := JTYP;
IF DALLOC + AALLOC = 0
THEN BEGIN
EADDIR.REG := D1;
GENX(TMOVE,2,EAPOP,EADDIR);
EADDIR.REG := D0;
(*0610B*) GENX(TMOVE,SIZEÆDTYPEÅ,EAPOP,EADDIR);
EAADIR.REG := A0;
GENX(TMOVE,4,EAPOP,EAADIR);
STKPTR := STKPTR - 3;
DPOPCNT := DPOPCNT + 3;
END
ELSE IF (DALLOC=1) AND (AALLOC=0)
THEN BEGIN
BUILDADDR(SOURCE,DDIRECT,DTOP,ANONE,0);
EADDIR.REG := D1;
GENX(TMOVE,2,SOURCE,EADDIR);
EADDIR.REG := D0;
(*0610B*) GENX(TMOVE,SIZEÆDTYPEÅ,EAPOP,EADDIR);
EAADIR.REG := A0;
GENX(TMOVE,4,EAPOP,EAADIR);
STKPTR := STKPTR -2;
DPOPCNT := DPOPCNT +2;
(*1015E*) END
(*1015E*) ELSE IF (DALLOC=2) AND (AALLOC=0)
(*1015E*) THEN BEGIN
(*1015E*) EAADIR.REG := A0;
(*1015E*) GENX(TMOVE,4,EAPOP,EAADIR);
(*1015E*) STKPTR := STKPTR -1;
(*1015E*) DPOPCNT := DPOPCNT +1;
(*1015E*) END;
END;
IF (OPCODE=XWRV) OR (OPCODE=XWRS)
(*1205B*) THEN BEGIN PUSHALLD; STKPTR := STKPTR -2 END;
(*1207C*) IF OPCODE = XWRV THEN STKPTR := STKPTR - 1;
IF (OPCODE=XPEE)
THEN
BEGIN
IF AALLOC = 0 THEN POPREG(AREG)
END;
(*MAKE SURE PARAMETERS ARE IN RIGHT PLACE?*)
DTYPE := NOTATYP;
(*RM*) IF OPCODE <> XEIO THEN LONGBSR
ELSE IF AALLOC = 0 THEN BEGIN
(* REMOVE FILE POINTER FROM STACK *)
EAIMMED.DISPL := 4;
EAADIR.REG := SP;
GENX(TADD,2,EAIMMED,EAADIR)
END;
(*RM*) FREEALL ;
(*1031A*) IF (OPCODE=XEOL) OR (OPCODE=XEOF) OR (OPCODE=XPOS)
(*1031A*) THEN
(*1031A*) BEGIN
(*1031A*) ALLOCDREG;
(*1031A*) IF OPCODE=XPOS
(*1031A*) THEN REGTYPEÆDTOPÅ := ITYP
(*1031A*) ELSE REGTYPEÆDTOPÅ := BTYP;
(*1031A*) END
(*RM*) ELSE IF (OPCODE <> XEIO) AND (OPCODE<>XCLO) AND (OPCODE<>XIFD)
(*RM*) AND (OPCODE<>XSEE) AND (OPCODE<>XRST) AND (OPCODE<>XRWT)
(*RM*) AND (OPCODE<>XRLN) AND (OPCODE<>XWLN)
(*1023A*) AND (OPCODE<>XGET) AND (OPCODE<>XPUT)
(*1206A*) AND (OPCODE<>XPAG)
(*RM*) THEN ALLOCAREG;
(*1207H*) IF OPCODE = XAFI THEN STKPTR := STKPTR - 1;
END;
END (*PXCLO*) ;
PROCEDURE PXLOD;
BEGIN WITH INSTR^ DO BEGIN
EFFADDRESS(INSTR,SOURCE);
CASE SUBTYPEÆOPCODEÅ OF
1 (*LOD*): BEGIN IF DTYPE = ATYP THEN
BEGIN
OPTIMI := NEXTPCOD(INSTR);
IF OPTIMI^.OPCODE=XARG
THEN BEGIN GENX(TMOVE,4,SOURCE,EAPUSH);
OPTIMI^.INUSE := FALSE END
ELSE IF ( OPTIMI^.OPCODE=XSTR)
AND ((OPTIMI^.OPAND1=LEVEL)
OR (OPTIMI^.OPAND1=0)
OR (OPTIMI^.OPAND1=OPAND1))
THEN BEGIN
EFFADDRESS(OPTIMI,DEST);
OPTIMI^.INUSE := FALSE;
GENX(TMOVE,4,SOURCE,DEST)
END
ELSE
BEGIN ALLOCAREG;
EAADIR.REG := ATOP;
GENX(TMOVE,4,SOURCE,EAADIR);
END;
END
ELSE IF NOT (DTYPE IN LONGTYPES) THEN
BEGIN
OPTIMI := NEXTPCOD(INSTR);
EADDIR.REG := DTOP;
OPTIMI^.INUSE := FALSE;
OPTIM2 := NEXTPCOD(OPTIMI);
IF ((OPTIMI^.OPCODE=XAD)
OR (OPTIMI^.OPCODE=XSB)
OR (OPTIMI^.OPCODE=XAND)
OR (OPTIMI^.OPCODE=XIOR))
AND (DTOP<>DNONE)
THEN BEGIN
CASE SUBTYPEÆOPTIMI^.OPCODEÅ OF
1: OPCDE := TADD;
2: OPCDE := TSUB;
3: OPCDE := TAND;
4: OPCDE := TOR;
END; (*CASE*)
GENX(OPCDE,SIZEÆDTYPEÅ,SOURCE,EADDIR);
END
ELSE IF (OPTIMI^.OPCODE = XLDC)
AND (CONDITIONAL(OPTIM2)>0)
THEN BEGIN
EAIMMED.DISPL := OPTIMI^.OPAND1;
IF DTYPE = CTYP
THEN EAIMMED.DISPL :=
ASCIIÆOPTIMI^.OPSTRING^.VSTRINGAÆ1ÅÅ;
IF OPTIMI^.DTYPE=JTYP
THEN BEGIN
OPAND1 := OPTIMI^.OPAND1;
OPAND2 := OPTIMI^.OPAND2;
OPAND3 := OPTIMI^.OPAND3;
OPAND4 := OPTIMI^.OPAND4;
GENX(TCMP,4,EALONG,SOURCE);
END
ELSE
IF EAIMMED.DISPL = 0
THEN GENX(TTST,SIZEÆDTYPEÅ,
SOURCE,EANONE)
ELSE GENX(TCMP,SIZEÆDTYPEÅ,
EAIMMED,SOURCE);
OPTIM2^.OPAND3 := 200; (*FLAG SET*)
END
ELSE IF OPTIMI^.OPCODE=XARG
THEN GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EAPUSH)
ELSE IF OPTIMI^.OPCODE=XSTO
THEN BEGIN
EADEFER.REG := ATOP;
GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EADEFER)
;FREEAREG
END
ELSE IF (OPTIMI^.OPCODE = XSTR)
AND ((OPTIMI^.OPAND1 = LEVEL)
OR (OPTIMI^.OPAND1 = 0)
OR (OPTIMI^.OPAND1 = OPAND1))
THEN BEGIN
EABASED.DISPL :=OPTIMI^.OPAND2;
IF (EABASED.DISPL >=0) AND
(OPTIMI^.OPAND1=LEVEL)
THEN EABASED.DISPL := EABASED.DISPL+12;
IF OPTIMI^.OPAND1 = 0
THEN EABASED.REG := A5
ELSE IF OPTIMI^.OPAND1 = LEVEL
THEN EABASED.REG := A6
ELSE EABASED.REG := A4;
GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EABASED)
END
ELSE IF (((OPTIMI^.OPCODE=XINC)
OR (OPTIMI^.OPCODE=XDEC))
AND ((OPTIM2^.OPCODE=XSTR)
AND (OPTIM2^.OPAND1=OPAND1)
AND (OPTIM2^.OPAND2=OPAND2)))
THEN BEGIN
OPTIM2^.INUSE := FALSE;
IF OPTIMI^.OPCODE = XDEC
THEN OPCDE := TSUB
ELSE OPCDE := TADD;
EAIMMED.DISPL := OPTIMI^.OPAND1;
GENX(OPCDE,SIZEÆDTYPEÅ,EAIMMED,SOURCE)
END
ELSE IF ( CONDITIONAL(OPTIMI) > 0)
AND (DTOP<>DNONE)
THEN BEGIN
GENX(TCMP,SIZEÆDTYPEÅ,SOURCE,EADDIR);
OPTIMI^.OPAND3 := 100; (*SET FLAG *)
OPTIMI^.INUSE := TRUE
END
ELSE BEGIN
ALLOCDREG;
EADDIR.REG := DTOP;
GENX(TMOVE,SIZEÆDTYPEÅ,
SOURCE,EADDIR) ;
OPTIMI^.INUSE:= TRUE
END
END
ELSE (*LONG TYPE: P, S, OR V*)
(*RM*) BEGIN IF DTYPE = PTYP THEN OPAND3:=8;
IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
(*1015D*) PUSHALL;
EAADIR.REG := A0;
GENX(TLEA,2,SOURCE,EAADIR);
IF (AALLOC<>0) OR (DALLOC<>0)
THEN ERROR
('REGISTERS NOT EMPTY ');
FREEALL;
LONGBSR;
IF DTYPE = VTYP THEN BEGIN
(*604*) PCPRINT;
WRITELN(LISTING,' ':10,
'DC.W ',OPAND3:0);
EAIMMED.DISPL := OPAND3;
GENX(TDC,2,EAIMMED,EANONE);
END
END ELSE
LOADBIG(SOURCE,OPAND3 (*SIZE*))
(*RM*) END
END;
2 (*LDA*): BEGIN
(*480*) OPTIMI := NEXTPCOD(INSTR);
IF (OPTIMI^.OPCODE=XARG) OR (OPTIMI^.OPCODE=XMST)
(*480*) OR (((OPTIMI^.OPCODE=XLDC) OR (OPTIMI^.OPCODE=XLOD)
(*480*) OR (OPTIMI^.OPCODE=XIND))
(*480*) AND (OPTIMI^.DTYPE IN ÆSTYP,VTYPÅ))
THEN BEGIN
OPTIMI^.INUSE := FALSE;
(*480*) IF (OPTIMI^.OPCODE<>XMST)AND(OPTIMI^.OPCODE<>XARG)
(*480*) THEN OPTIMI^.INUSE := TRUE;
(*480*) IF OPTIMI^.OPCODE <> XARG
THEN BEGIN
PUSHALL;
STKPTR := STKPTR + 1;
KINDSTKÆSTKPTRÅ := AREG;
TYPESTKÆSTKPTRÅ := ATYP;
END;
GENX(TPEA,2,SOURCE,EANONE)
END ELSE BEGIN
ALLOCAREG;
EAADIR.REG := ATOP;
GENX(TLEA,2,SOURCE,EAADIR)
END
END;
3 (*STR*): BEGIN IF DTYPE = ATYP THEN
BEGIN IF AALLOC > 0 THEN
BEGIN EAADIR.REG := ATOP;
GENX(TMOVE,4,EAADIR,SOURCE);
FREEAREG
END
ELSE BEGIN
GENX(TMOVE,4,EAPOP,SOURCE);
STKPTR := STKPTR - 1;
END
END ELSE (*DTYPE <> ATYP*)
IF NOT (DTYPE IN LONGTYPES) THEN
STORELITTLE
(*RM*) ELSE BEGIN
(*RM*) IF DTYPE = PTYP THEN OPAND3:=8;
IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
EADDIR.REG := D0;
EAIMMED.DISPL := OPAND3;
IF DTYPE = STYP THEN
GENX(TMOVE,4,EAIMMED,EADDIR);
EAADIR.REG := A0;
GENX(TLEA,2,SOURCE,EAADIR);
IF (AALLOC<>0) OR (DALLOC<>0)
THEN ERROR
('REGISTERS NOT EMPTY ');
FREEALL;
LONGBSR;
IF DTYPE = VTYP THEN BEGIN
PCPRINT;
WRITELN(LISTING,' ':10,'DC.W ',
OPAND3:0);
GENX(TDC,2,EAIMMED,EANONE)
END
END ELSE
(*RM*) STOREBIG(SOURCE,OPAND3)
(*RM*) END
END
END
END;
END; (*PXLOD*)
PROCEDURE PXIXA;
BEGIN WITH INSTR^ DO BEGIN
(*T <- T' + T * OPAND1; WHERE T' IS ADDR AND T IS DATA*)
IF DALLOC <= 0 THEN POPREG(DREG);
EADDIR.REG := DTOP;
IF OPAND1 = 2 THEN
GENX(TADD,2,EADDIR,EADDIR)
(***MORE OPTIMIZATION POSSIBLE FOR SMALL OPAND1'S*)
ELSE BEGIN EAIMMED.DISPL := OPAND1;
(*OP*) IF OPAND1 <> 1 THEN
GENX(TMULS,2,EAIMMED,EADDIR) END;
IF AALLOC <= 0 THEN POPREG(AREG);
EAADIR.REG := ATOP;
(*OP*) EADDIR.REG := DTOP;
(*OP*) GENX(TADD,2,EADDIR,EAADIR);
FREEDREG;
END;
END; (*PXIXA*)
PROCEDURE PXIND;
BEGIN WITH INSTR^ DO BEGIN
(*T <- MEMÆT + OPAND1Å*)
IF AALLOC <= 0 THEN POPREG(AREG);
BUILDADDR(SOURCE,BASED,ATOP,ANONE,OPAND1);
IF OPAND1 = 0 THEN SOURCE.MODE := DEFER;
IF DTYPE = ATYP
THEN
BEGIN
OPTIMI := NEXTPCOD(INSTR);
IF OPTIMI^.OPCODE = XSTR
THEN
BEGIN
EFFADDRESS(OPTIMI,DEST);
OPTIMI^.INUSE := FALSE;
GENX(TMOVE,4,SOURCE,DEST)
;FREEAREG
END
ELSE
BEGIN
EAADIR.REG := ATOP;
GENX(TMOVE,4,SOURCE,EAADIR)
END
END
ELSE BEGIN
IF NOT (DTYPE IN LONGTYPES) THEN
BEGIN
OPTIMI := NEXTPCOD(INSTR);
OPTIMI^.INUSE := FALSE;
(*0610A*) IF (DTOP=DNONE) AND ((OPTIMI^.OPCODE=XAD)
(*0610A*) OR (OPTIMI^.OPCODE=XSB) OR
(*0610A*) (OPTIMI^.OPCODE=XAND) OR
(*0610A*) (OPTIMI^.OPCODE=XIOR))
(*0610A*) THEN POPREG(DREG);
EADDIR.REG := DTOP;
FREEAREG;
OPTIM2 := NEXTPCOD(OPTIMI);
IF OPTIMI^.OPCODE = XARG
THEN GENX(TMOVE,SIZEÆDTYPEÅ,
SOURCE,EAPUSH)
ELSE
IF OPTIMI^.OPCODE=XAD
THEN GENX(TADD,SIZEÆDTYPEÅ,SOURCE,EADDIR)
ELSE IF OPTIMI^.OPCODE=XSB
THEN GENX(TSUB,SIZEÆDTYPEÅ,SOURCE,EADDIR)
ELSE IF OPTIMI^.OPCODE=XAND
THEN GENX(TAND,SIZEÆDTYPEÅ,SOURCE,EADDIR)
ELSE IF OPTIMI^.OPCODE=XIOR
THEN GENX(TOR,SIZEÆDTYPEÅ,SOURCE,EADDIR)
ELSE IF OPTIMI^.OPCODE = XSTR
THEN
BEGIN
EFFADDRESS(OPTIMI,DEST);
GENX(TMOVE,SIZEÆDTYPEÅ,
SOURCE,DEST)
END
ELSE IF (OPTIMI^.OPCODE = XLDC)
AND (CONDITIONAL(OPTIM2)>0)
THEN
BEGIN
EAIMMED.DISPL :=
OPTIMI^.OPAND1;
IF DTYPE = CTYP
THEN EAIMMED.DISPL :=
ASCIIÆOPTIMI^.OPSTRING^.VSTRINGAÆ1ÅÅ;
IF OPTIMI^.DTYPE=JTYP
THEN BEGIN
OPAND1 := OPTIMI^.OPAND1;
OPAND2 := OPTIMI^.OPAND2;
OPAND3 := OPTIMI^.OPAND3;
OPAND4 := OPTIMI^.OPAND4;
GENX(TCMP,4,EALONG,SOURCE);
END
ELSE
IF EAIMMED.DISPL = 0
THEN GENX(TTST,SIZEÆDTYPEÅ
,SOURCE,EANONE)
ELSE GENX(TCMP,SIZEÆDTYPEÅ
,EAIMMED,SOURCE);
OPTIM2^.OPAND3 :=200
END
ELSE BEGIN
OPTIMI^.INUSE := TRUE;
ALLOCDREG;
EADDIR.REG := DTOP;
GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EADDIR);
END;
END
ELSE BEGIN IF DTYPE = PTYP THEN OPAND2 :=8;
IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
FREEAREG;
PUSHALL;
EAADIR.REG := A0;
GENX(TLEA,2,SOURCE,EAADIR);
LONGBSR;
IF DTYPE = VTYP THEN BEGIN
(*604*) PCPRINT;
WRITELN(LISTING,' ':10,
'DC.W ',OPAND2:0);
EAIMMED.DISPL := OPAND2;
GENX(TDC,2,EAIMMED,EANONE)
END
END ELSE BEGIN (*PTYP*)
LOADBIG(SOURCE,OPAND2);
(*1207E*) IF DTYPE = PTYP THEN FREEAREG;
END;
END;
END
END;
END ; (*PXIND*)
PROCEDURE PXSTO;
BEGIN WITH INSTR^ DO BEGIN
(* MEMÆT'Å <- T *)
IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
IF (AALLOC<>0) OR (DALLOC<>0) THEN
ERROR('REGISTERS NOT EMPTY ');
FREEALL;
IF DTYPE = STYP THEN BEGIN
ALLOCDREG;
EAIMMED.DISPL := OPAND1;
EADDIR.REG := DTOP;
GENX(TMOVE,2,EAIMMED,EADDIR);
END;
LONGBSR;
IF DTYPE = VTYP THEN BEGIN
(*604*) PCPRINT;
WRITELN(LISTING,'DC.W ',OPAND1:0);
EAIMMED.DISPL := OPAND1;
GENX(TDC,2,EAIMMED,EANONE)
END ELSE
FREEDREG;
(*1207D*) STKPTR := STKPTR - 1;
END ELSE
IF DTYPE = PTYP THEN BEGIN
WHILE DALLOC<2 DO POPREG(DREG);
IF AALLOC < 1 THEN POPREG(AREG);
(*1303A*) BUILDADDR(SOURCE,DEFER,ATOP,ANONE,0);
STOREBIG(SOURCE,8);
FREEAREG;
END ELSE
IF DTYPE = ATYP THEN
BEGIN WHILE AALLOC < 2 DO POPREG(AREG);
EAADIR.REG := ATOP;
FREEAREG;
BUILDADDR(SOURCE,DEFER,ATOP,ANONE,0);
GENX(TMOVE,4,EAADIR,SOURCE);
FREEAREG
END
ELSE BEGIN IF DALLOC < 1 THEN POPREG(DREG);
IF AALLOC < 1 THEN POPREG(AREG);
BUILDADDR(SOURCE,DEFER,ATOP,ANONE,0);
STORELITTLE;
FREEAREG;
END
END;
END; (*PXSTO *)
PROCEDURE PXLDC;
VAR J,K: INTEGER;
BEGIN WITH INSTR^ DO BEGIN
IF DTYPE = ATYP THEN
BEGIN ALLOCAREG;
EAADIR.REG := ATOP;
(*604*) GENX(TMOVE,4,EALONG,EAADIR) (* LOAD 4 CONSTS *)
END ELSE
(*604*) IF DTYPE = JTYP
(*604*) THEN BEGIN
(*604*) ALLOCDREG;
(*604*) EADDIR.REG := DTOP;
(*604*) GENX(TMOVE,4,EALONG,EADDIR)
(*604*) END ELSE
(*480*) IF DTYPE IN ÆSTYP,VTYPÅ THEN
BEGIN
(*480*) IF DTYPE = VTYP THEN
(*480*) BEGIN
(*480*) K := OPSTRING^.STRINGL; (* STRING LEN*)
(*480*) (*IF STC THRU HERE *) IF OPCODE = XLDC THEN OPAND3:=OPAND1;
(*480*) OPSTRING^.STRINGL := OPAND3; (*VEC *)
(*480*) IF K < OPAND3
(*480*) THEN FOR J := K + 1 TO OPAND3 DO
(*480*) OPSTRING^.VSTRINGAÆJÅ := ' '
(*480*) END;
PUSHALL;
LONGBSR;
K := OPSTRING^.STRINGL;
EAIMMED.DISPL := K;
IF ODD(K) THEN K := K + 1;
(*604*) PCPRINT;
WRITELN(LISTING,' ':10,'DC.W ',
EAIMMED.DISPL:0);
GENX(TDC,2,EAIMMED,EANONE);
(*604*) PCPRINT;
WRITE(LISTING,' ':10,'DC.W ');
VSTRINGIMMED(1,K);
WRITELN(LISTING,' ');
END
ELSE
(*RM*) IF DTYPE = PTYP THEN
(*RM*) LOADPSET
(*RM*) ELSE
BEGIN
IF DTYPE = CTYP THEN
EAIMMED.DISPL := ASCIIÆOPSTRING^.VSTRINGAÆ1ÅÅ
ELSE
EAIMMED.DISPL := OPAND1;
OPTIMI := NEXTPCOD(INSTR);
OPTIMI^.INUSE := FALSE;
IF (OPTIMI^.OPCODE=XARG) OR (OPTIMI^.OPCODE=XEXI)
OR (OPTIMI^.OPCODE=XWRS) OR (OPTIMI^.OPCODE=XWRV)
THEN BEGIN
IF (OPTIMI^.OPCODE=XWRS) OR (OPTIMI^.OPCODE=XWRV)
THEN PUSHALLD;
IF OPTIMI^.OPCODE<>XARG THEN BEGIN
OPTIMI^.INUSE := TRUE;
OPTIMI^.DTYPE := DTYPE
(*1205B*) ;
(*1205B*) IF OPTIMI^.OPCODE<>XEXI THEN BEGIN
(*1205B*) STKPTR := STKPTR +1;
(*1205B*) TYPESTKÆSTKPTRÅ := DTYPE;
(*1205B*) KINDSTKÆSTKPTRÅ := DREG;
(*1205B*) END END;
GENX(TMOVE,SIZEÆOPTIMI^.DTYPEÅ,EAIMMED,EAPUSH)
; OPTIMI^.DTYPE := NOTATYP
END
ELSE IF OPTIMI^.OPCODE=XSTO
THEN BEGIN
EADEFER.REG := ATOP;
GENX(TMOVE,SIZEÆOPTIMI^.DTYPEÅ,EAIMMED,EADEFER)
;FREEAREG
END
ELSE IF (OPTIMI^.OPCODE = XSTR)
AND ((OPTIMI^.OPAND1 = LEVEL)
OR (OPTIMI^.OPAND1 = 0))
THEN BEGIN
EABASED.DISPL := OPTIMI^.OPAND2;
IF (EABASED.DISPL>=0) AND (OPTIMI^.OPAND1=LEVEL)
THEN EABASED.DISPL := EABASED.DISPL+12;
IF OPTIMI^.OPAND1 = 0
THEN EABASED.REG := A5
ELSE EABASED.REG := A6;
GENX(TMOVE,SIZEÆOPTIMI^.DTYPEÅ,EAIMMED,EABASED)
END
ELSE IF (CONDITIONAL(OPTIMI) > 0)
AND (DTOP<>DNONE)
THEN BEGIN
EADDIR.REG := DTOP;
IF EAIMMED.DISPL=0 THEN
GENX(TTST,SIZEÆDTYPEÅ,EADDIR,EANONE)
ELSE
GENX(TCMP,SIZEÆDTYPEÅ,EAIMMED,EADDIR);
OPTIMI^.OPAND3 := 100; (* SET FLAG *)
OPTIMI^.INUSE := TRUE
END
ELSE IF OPTIMI^.OPCODE=XIXA
THEN BEGIN
EAIMMED.DISPL := OPAND1 * OPTIMI^.OPAND1;
EAADIR.REG := ATOP;
GENX(TADD,2,EAIMMED,EAADIR)
END
ELSE
BEGIN
ALLOCDREG;
OPTIMI^.INUSE := TRUE;
EADDIR.REG := DTOP;
GENX(TMOVE ,2,EAIMMED,EADDIR);
END
END
END;
END; (*PXLDC*)
(*480*) PROCEDURE PXSTC;
(*480*) BEGIN WITH INSTR^ DO BEGIN
(*480*) EFFADDRESS(INSTR,SOURCE);
(*480*) PUSHALL;
(*480*) EAADIR.REG := A0;
(*480*) GENX(TLEA,2,SOURCE,EAADIR);
(*480*) PXLDC (* LET LOAD CONSTANT PROCESSOR DO REST *)
(*480*) END (* WITH *)
(*480*) END; (*PXSTC*)
PROCEDURE PXLTA;
BEGIN WITH INSTR^ DO BEGIN
ALLOCAREG;
EAADIR.REG := SP;
BUILDADDR(SOURCE,DEFER,ATOP,ANONE,0);
GENX(TMOVE,4,EAADIR,SOURCE)
END;
END; (*PXLTA*)
PROCEDURE PXLCA;
BEGIN
;(*LEAVE INDICATION TO ALLOCATE STORAGE AT END
OF THIS BLOCK; GEN LEA ATOP WITH PC^(DISPL)*)
END; (* PXLCA*)
PROCEDURE PXISC;
BEGIN WITH INSTR^ DO BEGIN
EAIMMED.DISPL := 1;
EADEFER.REG := A5;
GENX(TADD,4,EAIMMED,EADEFER) (*'SC' IS ^A5*)
END;
END; (*PXISC*)
PROCEDURE PXLSC;
BEGIN WITH INSTR^ DO BEGIN
EAIMMED.DISPL := OPAND1;
EADEFER.REG := A5;
GENX(TMOVE,4,EAIMMED,EADEFER) (*'SC' IS ^A5*)
END;
END; (*PXLSC*)
PROCEDURE PXEQU;
VAR FLAG: BOOLEAN; (* TRUE MEANS NO DREG WAS ALLOC YET *)
BEGIN WITH INSTR^ DO BEGIN
FLAG := FALSE;
IF OPAND3 = 200
THEN BEGIN
FLAG := TRUE;
OPAND3 := 100
END;
IF DTYPE IN ÆSTYP,VTYPÅ THEN BEGIN
LONGBSR;
IF DTYPE = VTYP
THEN
BEGIN
EAIMMED.DISPL := OPAND1; (* VEC LEN *)
(*604*) PCPRINT;
IF DEBUG <> 0 THEN
WRITELN(LISTING,' ':10,'DC.W ',
OPAND1:0);
GENX(TDC,2,EAIMMED,EANONE)
(*604*) END;
IF (AALLOC<>0) OR (DALLOC<>0) THEN
ERROR('REGISTERS NOT EMPTY ');
FREEALL;
ALLOCDREG;
(*0326A*) REGTYPEÆDTOPÅ := BTYP;
END ELSE IF DTYPE = PTYP THEN BEGIN
WHILE DALLOC < 4 DO POPREG(DREG);
(*THE BELOW SHOULD BE OPTIMIZED FOR THE CASE
WHEN ONE ARGUMENT IS A CONSTANT*)
CASE SUBTYPEÆOPCODEÅ OF
1 (*EQU*) : OPCDE := TEOR;
2 (*NEQ*) : OPCDE := TEOR;
4 (*LEQ*) : BEGIN
OPCDE := TAND;
EADDIR.REG := DTOP;
GENX(TCOMP,4,EADDIR,EANONE);
EADDIR.REG := PREVIOUS(DTOP);
GENX(TCOMP,4,EADDIR,EANONE);
END;
6 (*GEQ*) : BEGIN
OPCDE := TAND;
EADDIR.REG :=
PREVIOUS(PREVIOUS(DTOP));
GENX(TCOMP,4,EADDIR,EANONE);
EADDIR.REG :=
PREVIOUS(PREVIOUS(PREVIOUS(DTOP)));
GENX(TCOMP,4,EADDIR,EANONE);
END;
END; (*CASE*)
BUILDADDR(SOURCE,DDIRECT,DTOP,ANONE,0);
FREEDREG;
BUILDADDR(DEST,DDIRECT,PREVIOUS(DTOP),ANONE,0);
GENX(OPCDE,4,SOURCE,DEST);
SOURCE.REG := DTOP;
FREEDREG;
DEST.REG := PREVIOUS(DTOP);
GENX(OPCDE,4,SOURCE,DEST);
SOURCE.REG := DTOP;
FREEDREG;
DEST.REG := DTOP;
GENX(TOR,4,SOURCE,DEST);
SWITCH := FALSE;
IF OPCODE <> XNEQ THEN OPCODE := XEQU;
END ELSE BEGIN
OPTIMI := NEXTPCOD(INSTR);
SWITCH := FALSE;
IF OPAND3<>100 THEN BEGIN (*CMP ALREADY DONE*)
DOUBLEOP(SOURCE,DEST,TRUE(*COMMUTATIVITY*),SWITCH);
K := SIZEÆDTYPEÅ;
GENX(TCMP,K,SOURCE,DEST);
(*1207A*) IF DTYPE = ATYP THEN FREEAREG;
END
END;
IF DTYPE <> STYP THEN BEGIN
EADDIR.REG := DTOP;
CASE SUBTYPEÆOPCODEÅ OF
1 (*EQU*) : OPCDE:=TSEQ;
2 (*NEQ*) : OPCDE:=TSNE;
3 (*LES*) : IF SWITCH THEN
OPCDE:=TSGT
ELSE OPCDE:=TSLT;
4 (*LEQ*) : IF SWITCH THEN
OPCDE:=TSGE
ELSE OPCDE:=TSLE;
5 (*GRT*) : IF SWITCH THEN
OPCDE:=TSLT
ELSE OPCDE:=TSGT;
6 (*GEQ*) : IF SWITCH THEN
OPCDE:=TSLE
ELSE OPCDE:=TSGE;
END;
(*RM*) IF DTYPE = ATYP THEN BEGIN
(*RM*) ALLOCDREG;
(*RM*) EADDIR.REG := DTOP
(*RM*) END;
IF OPTIMI = NIL THEN OPTIMI:=INSTR; (*FORCE NOTEQ*)
IF OPTIMI^.OPCODE = XFJP
THEN
BEGIN
OPTIMI^.OPAND3 := 100 + CONDITIONAL(INSTR)
;IF FLAG
THEN OPTIMI^.OPAND3 := OPTIMI^.OPAND3 + 100
END
ELSE BEGIN
IF FLAG
THEN BEGIN
ALLOCDREG;
EADDIR.REG := DTOP
END;
IF DTYPE <> VTYP
THEN
BEGIN
GENX(OPCDE,2,EADDIR,EANONE);
REGTYPEÆDTOPÅ := BTYP;
GENX(TNEG,1,EADDIR,EANONE)
END
END
END;
END;
END; (*PXEQU*)
PROCEDURE PXSTP;
BEGIN WITH INSTR^ DO BEGIN
PUSHALL;
(*PUSH ZERO ARGUMENT ON STACK*)
GENX(TCLR,2,EAPUSH,EANONE);
EAIMMED.DISPL := 14;
GENX(TTRAP,2,EAIMMED,EANONE);
EAIMMED.DISPL := 3;
GENX(TDC,2,EAIMMED,EANONE);
END;
END; (*PXSTP*)
PROCEDURE PXEXI;
BEGIN WITH INSTR^ DO BEGIN
PUSHALL;
(*EXIT ARGUMENT ALREADY ON STACK*)
EAIMMED.DISPL := 14;
GENX(TTRAP,2,EAIMMED,EANONE);
EAIMMED.DISPL := OPAND1 + 3;
GENX(TDC,2,EAIMMED,EANONE);
END;
END; (*PXEXI*)
PROCEDURE PXDIS;
BEGIN WITH INSTR^ DO BEGIN
IF AALLOC < 1 THEN POPREG(AREG);
(*604*) LONGBSR;
(*604*) EAIMMED.DISPL := OPAND1;
(*604*) PCPRINT;
(*604*) WRITELN(LISTING,' ':10,'DC.W ',OPAND1:0);
(*604*) GENX(TDC,2,EAIMMED,EANONE);
FREEAREG;
END;
END; (*PXDIS*)
PROCEDURE PXNEW;
BEGIN WITH INSTR^ DO BEGIN
(*RM*) (*HEAP POINTER IS ^A5(4) *)
IF AALLOC < 1 THEN POPREG(AREG);
(*604*) LONGBSR;
(*604*) EAIMMED.DISPL := OPAND1; (* LENGTH TO ALLOC *)
(*604*) PCPRINT;
(*604*) WRITELN(LISTING,' ':10,'DC.W ',OPAND1:0);
(*604*) GENX(TDC,2,EAIMMED,EANONE);
(*604*) FREEAREG;
END;
END; (*PXNEW*)
PROCEDURE PXMRK;
BEGIN WITH INSTR^ DO BEGIN
IF AALLOC < 1 THEN POPREG(AREG);
(*604*) LONGBSR;
FREEAREG;
END;
END; (*PXMRK*)
PROCEDURE PXRLS;
BEGIN WITH INSTR^ DO BEGIN
(*604*) IF AALLOC < 1 THEN POPREG(AREG);
(*604*) LONGBSR;
(*604*) FREEAREG;
END;
END; (*PXRLS*)
PROCEDURE PXMST;
BEGIN
PUSHALL;
END; (*PXMST*)
PROCEDURE PXARG;
BEGIN WITH INSTR^ DO BEGIN
(*604*) IF OPAND1 <> 0 THEN BEGIN
(*RM*) IF (DALLOC=2) AND (DTYPE=PTYP) THEN
(*1205A*) BEGIN
(*1205A*) EADDIR.REG := DTOP;
(*1205A*) GENX(TMOVE,4,EADDIR,EAPUSH);
(*1205A*) EADDIR.REG := DBOT;
(*1205A*) GENX(TMOVE,4,EADDIR,EAPUSH);
(*1205A*) FREEDREG;FREEDREG
(*1205A*) END;
(*1205G*) IF (NOT (DTYPE IN LONGTYPES)) AND (DALLOC=0) AND (AALLOC=0)
(*1205G*) THEN STKPTR := STKPTR -1;
(*RM*) IF AALLOC = 1 THEN BEGIN PUSHAREG;
STKPTR:=STKPTR-1 END;
(*RM*) IF DALLOC = 1 THEN BEGIN PUSHDREG;
STKPTR := STKPTR -1 END;
IF (DALLOC <> 0) OR (AALLOC <> 0)
THEN ERROR('STK NONEMPTY IN ARG ')
(*604*) END
END;
END; (*PXARG*)
PROCEDURE PXAST;
BEGIN WITH INSTR^ DO BEGIN
(*ASSUMES PREVIOUS 'MST' HAS DONE PUSHALL*)
IF ODD(OPAND1) THEN OPAND1:=OPAND1+1;
EAIMMED.DISPL := OPAND1;(*SHOULD BE LONG #*)
EAADIR.REG := SP;
GENX(TSUB,4,EAIMMED,EAADIR);
(*0416A*) IF NOT (DTYPE IN LONGTYPES) THEN BEGIN
STKPTR := STKPTR +1;
IF STKPTR>STKMAX THEN
ERROR('TOO MANY REG PUSHES ');
IF OPAND1=4 THEN KINDSTKÆSTKPTRÅ
:= AREG ELSE KINDSTKÆSTKPTRÅ
:= DREG;
IF OPAND1=4 THEN TYPESTKÆSTKPTRÅ:=ATYP
ELSE IF OPAND1=2 THEN TYPESTKÆSTKPTRÅ:=ITYP
ELSE IF OPAND1=1 THEN TYPESTKÆSTKPTRÅ:=BTYP
ELSE IF OPAND1=8 THEN TYPESTKÆSTKPTRÅ:=PTYP
ELSE TYPESTKÆSTKPTRÅ:=VTYP;
IF DTYPE <> NOTATYP THEN BEGIN
TYPESTKÆSTKPTRÅ:=DTYPE;
IF DTYPE = ATYP
THEN KINDSTKÆSTKPTRÅ := AREG
ELSE KINDSTKÆSTKPTRÅ := DREG;
END;
(*0416A*) END; (* LONGTYPES CODE *)
END;
END; (*PXAST*)
PROCEDURE PXMOV;
BEGIN WITH INSTR^ DO BEGIN
WHILE AALLOC < 2 DO POPREG(AREG);
IF OPCODE = XMOV THEN
BEGIN ALLOCDREG;
EAIMMED.DISPL := OPAND1;
EADDIR.REG := DTOP;
GENX(TMOVE,2,EAIMMED,EADDIR)
END
ELSE IF DALLOC < 1 THEN POPREG(DREG);
(*BYTE COUNT IS NOW IN DTOP*)
BUILDADDR(SOURCE,INCR,ATOP,ANONE,0);
FREEAREG;
BUILDADDR(DEST,INCR,ATOP,ANONE,0);
(*RM*) GENX(TMOVE,1,SOURCE,DEST);
(*ONLY MOVES BYTE AT A TIME NOW*)(*FIX LIKE '_BIG'*)
EADDIR.REG := DTOP;
(*RM*) EAIMMED.DISPL := 1;
(*RM*) GENX(TSUB,2,EAIMMED,EADDIR);
(*RM*) EAREL.DISPL := -4;
(*RM*) GENX(TBNE,0,EAREL,EANONE);
FREEAREG;FREEDREG;
END;
END; (*PXMOV*)
PROCEDURE PXCUP;
BEGIN WITH INSTR^ DO BEGIN
IF NOT PROCTABLEÆCURRLABELÅ.DEFINED THEN
BEGIN
LTEMP := PC;
SAD(LTEMP, 2);
REFERENCELABEL(CURRLABEL,LTEMP)
END;
PROCTABLEÆCURRLABELÅ.REFED := TRUE;
PUSHALL;
LTEMP := PROCTABLEÆCURRLABELÅ.LOCATION ;
LSB(LTEMP, PC);
IF SHORT(LTEMP) THEN BEGIN
LASGN(EAREL.DISPL, LTEMP);
IF (EAREL.DISPL >-128) AND (EAREL.DISPL < 127) THEN
BEGIN
EALAB.DISPL := CURRLABEL;
GENX(TBSR, 2,EALAB,EANONE) ;
END
ELSE BEGIN
EALAB.DISPL := CURRLABEL;
GENX(TLBSR,2,EALAB,EANONE);
END;
END ELSE
BEGIN
EADEFER.REG := A3;
GENX(TJSR,2,EADEFER,EANONE);
(*604*) PCPRINT;
WRITE(LISTING,' ':10,'DC.L ':7,'$':1);
SSB(LTEMP,2);
PLINT(LISTING,LTEMP);
WRITELN(LISTING,' ');
FOR K := 0 TO 3 DO
BEGIN
EAIMMED.DISPL := LTEMPÆKÅ;
GENX(TDC,1,EAIMMED,EANONE)
END
END
END;
END; (*PXCUP*)
PROCEDURE PXVJP;
BEGIN WITH INSTR^ DO BEGIN
(*604*) PCPRINT;
(*RM*) WRITELN(LISTING,' ':10,'DC.W L',
(*RM*) OPAND1 + LABELOFFSET:0,'-L',
(*RM*) LASTLABEL + LABELOFFSET:0); (* GENX!!*)
IF LABELTABLEÆOPAND1Å.DEFINED
THEN
BEGIN
LTEMP := LABELTABLEÆOPAND1Å.LOCATION;
LSB(LTEMP,LABELTABLEÆLASTLABELÅ.LOCATION);
LASGN(EAIMMED.DISPL, LTEMP)
END
ELSE
BEGIN
LTEMP := LABELTABLEÆLASTLABEL-1Å.LOCATION;
LSB(LTEMP,LABELTABLEÆLASTLABEL-2Å.LOCATION);
SAD(LTEMP,1);
SHL(LTEMP,1); (*TIMES 2*)
(*0401A*)
LASGN(EAIMMED.DISPL,LTEMP)
END;
GENX(TDC,2,EAIMMED,EANONE);
(*RM*) END;
END; (*PXVJP*)
PROCEDURE PXUJP;
VAR FLAG: BOOLEAN; (* INDICATES THAT CMP ALREADY DONE *)
BEGIN WITH INSTR^ DO BEGIN
FLAG := OPAND3 >= 200;
IF FLAG THEN OPAND3 := OPAND3 - 100;
IF LABELTABLEÆOPAND1Å.DEFINED = TRUE
THEN
BEGIN
LTEMP := LABELTABLEÆOPAND1Å.LOCATION;
LSB(LTEMP, PC);
SSB(LTEMP,2);
LASGN(K, LTEMP)
END
ELSE K := 200;
CASE SUBTYPEÆOPCODEÅ OF
1 (*UJP*) : BEGIN OPCDE := TBRA;
IF (K<-127) OR (K>127) THEN OPCDE := TLBRA END;
2 (*FJP*) : BEGIN OPCDE := TBEQ ;
IF (K<-127) OR (K>127) THEN OPCDE := TLBEQ ;
IF (DALLOC = 0) AND (OPAND3 < 100)
THEN POPREG(DREG);
END
END;
BUILDADDR(SOURCE,LABELLED,ANONE,ANONE,OPAND1);
IF OPAND3 >100
THEN BEGIN
OPAND3 := OPAND3 - 100;
IF SWITCH THEN
BEGIN
IF (OPAND3=3) OR (OPAND3=4) THEN OPAND3:=OPAND3+2
ELSE IF (OPAND3=5) OR (OPAND3=6) THEN OPAND3:=OPAND3-2;
END ;
CASE OPAND3 OF
1: ; (* NEQ ALREADY TURNED AROUND *)
2: IF OPCDE = TBEQ THEN OPCDE := TBNE
ELSE OPCDE := TLBNE;
3: IF OPCDE = TBEQ THEN OPCDE := TBGE
ELSE OPCDE := TLBGE;
4: IF OPCDE = TBEQ THEN OPCDE := TBGT
ELSE OPCDE := TLBGT;
5: IF OPCDE = TBEQ THEN OPCDE := TBLE
ELSE OPCDE := TLBLE;
6: IF OPCDE = TBEQ THEN OPCDE := TBLT
ELSE OPCDE := TLBLT;
END; (*CASE*)
END;
GENX(OPCDE,0,SOURCE,EANONE) ;
IF LABELTABLEÆOPAND1Å.DEFINED = FALSE THEN
BEGIN
LTEMP := PC;
SSB(LTEMP, 2);
REFERENCELABEL(OPAND1,LTEMP);
END;
IF (OPCODE = XFJP) AND (NOT FLAG) THEN FREEDREG;
END;
END; (*PXUJP*)
PROCEDURE PXDIF;
BEGIN
(*THE BELOW SHOULD BE OPTIMIZED FOR THE CASE
WHEN ONE ARGUMENT IS A CONSTANT *)
SETOPS;
END; (*PXDIF*)
(*604*) PROCEDURE PXSPOS;
(*604*) BEGIN
(*604*) WITH INSTR^ DO
(*604*) BEGIN
(*604*) LONGBSR;
(*604*) IF OPCODE <> XSCON
THEN BEGIN
DTYPE := ITYP;
ALLOCDREG
END
(*604*) END
(*604*) END; (* PXSPOS *)
PROCEDURE PXSDEL;
BEGIN
WITH INSTR^ DO
BEGIN
IF DALLOC = 0
THEN BEGIN
EADDIR.REG := D1;
GENX(TMOVE,2,EAPOP,EADDIR);
EADDIR.REG := D0;
GENX(TMOVE,2,EAPOP,EADDIR);
STKPTR := STKPTR - 2;
DPOPCNT := DPOPCNT + 2
END ELSE
IF DALLOC = 1
THEN BEGIN
BUILDADDR(SOURCE,DDIRECT,DTOP,ANONE,0);
EADDIR.REG := D1;
GENX(TMOVE,2,SOURCE,EADDIR);
EADDIR.REG := D0;
GENX(TMOVE,2,EAPOP,EADDIR);
STKPTR := STKPTR - 1;
DPOPCNT := DPOPCNT + 1
END;
LONGBSR
END;
FREEDREG;FREEDREG
END; (* PXSDEL *)
(*604*) PROCEDURE PXSINS;
BEGIN
WITH INSTR^ DO
BEGIN
IF DALLOC = 0 THEN POPREG(DREG);
IF DTOP <> D0
THEN BEGIN
BUILDADDR(SOURCE,DDIRECT,DTOP,ANONE,0);
EADDIR.REG := D0;
GENX(TMOVE,2,SOURCE,EADDIR)
END;
LONGBSR;
FREEDREG;
END
END; (* PXSINS *)
PROCEDURE PXINN;
BEGIN WITH INSTR^ DO BEGIN
WHILE DALLOC < 3 DO POPREG(DREG);
(* THE BELOW SHOULD BE OPTIMIZED FOR THE CASE
WHERE ONE ARGUMENT IS A CONSTANT*)
(*RM*) EADDIR.REG := PREVIOUS(PREVIOUS(DTOP));
EAIMMED.DISPL := 32;
(*RM*) GENX(TCMP,1,EAIMMED,EADDIR);
(*RM*) EAREL.DISPL := 6;
(*RM*) GENX(TBLT,0,EAREL,EANONE);
BUILDADDR(DEST,DDIRECT,PREVIOUS(DTOP),DNONE,0);
GENX(TBTST,0,EADDIR,DEST);
(*RM*) EAREL.DISPL := 4;
(*RM*) GENX(TBRA,0,EAREL,EANONE);
(*RM*) BUILDADDR(DEST,DDIRECT,DTOP,DNONE,0);
GENX(TBTST,0,EADDIR,DEST);
FREEDREG; FREEDREG;
EADDIR.REG := DTOP;
(*RM*) GENX(TSNE,0,EADDIR,EANONE);
(*1015A*) GENX(TNEG,1,EADDIR,EANONE);
(*1323A*) REGTYPEÆDTOPÅ := BTYP;
END;
END; (*PXINN*)
PROCEDURE PXSGS;
BEGIN WITH INSTR^ DO BEGIN
IF DALLOC < 1 THEN POPREG(DREG);
(*THE BELOW SHOULD BE OPTIMIZED FOR THE CASE
WHEN ONE ARGUMENT IS A CONSTANT*)
(*RM*) ALLOCDREG;ALLOCDREG;
(*RM*) EADDIR.REG := DTOP;
(*RM*) GENX(TCLR,4,EADDIR,EANONE);
(*RM*) EADDIR.REG := PREVIOUS(DTOP);
(*RM*) GENX(TCLR,4,EADDIR,EANONE);
(*RM*) EADDIR.REG := PREVIOUS(PREVIOUS(DTOP));
(*RM*) EAIMMED.DISPL := 32;
(*RM*) GENX(TCMP,1,EAIMMED,EADDIR);
(*RM*) EAREL.DISPL := 6;
(*1204A*) GENX(TBGE,0,EAREL,EANONE);
(*RM*) BUILDADDR(DEST,DDIRECT,PREVIOUS(DTOP),DNONE,0);
(*RM*) GENX(TBSET,0,EADDIR,DEST);
(*RM*) EAREL.DISPL := 4;
(*RM*) GENX(TBRA,0,EAREL,EANONE);
(*RM*) BUILDADDR(DEST,DDIRECT,DTOP,DNONE,0);
(*RM*) GENX(TBSET,0,EADDIR,DEST);
(*1204A*) GENX(TMOVE,4,DEST,EADDIR);
(*1204A*) FREEDREG;
END;
END; (*PXSGS*)
PROCEDURE PXCHK;
BEGIN
WITH INSTR^ DO
BEGIN
EADDIR.REG := D7; (* USE D7 FOR CHECKING *)
SOURCE := EADDIR;
(*604*) IF ((DTYPE<>ATYP) AND (DTOP=DNONE)) OR ((DTYPE=ATYP) AND (ATOP=ANONE))
THEN BEGIN
SOURCE.REG := A7;
SOURCE.MODE := DEFER
END
(*604*) ELSE IF DTYPE=ATYP THEN BEGIN
(*604*) SOURCE.REG := ATOP;
(*604*) SOURCE.MODE := ADIRECT
(*604*) END
(*604*) ELSE SOURCE.REG := DTOP;
(*604*) GENX(TMOVE,SIZEÆDTYPEÅ,SOURCE,EADDIR);
IF SIZEÆDTYPEÅ = 1
THEN GENX(TEXTE,2,EADDIR,EANONE);
(*604*) IF DTYPE IN ÆATYP,JTYPÅ
(*604*) THEN BEGIN OPAND1:=1; OPAND2:=1 END; (* FAKE OUT NEXT INSTRS*)
IF OPAND2 = 0
THEN BEGIN
GENX(TNEG,2,EADDIR,EANONE);
EAIMMED.DISPL := -OPAND1
END;
IF OPAND1 = 0 THEN EAIMMED.DISPL := OPAND2;
IF (OPAND1=0) OR (OPAND2=0)
THEN GENX(TCHK,2,EAIMMED,EADDIR)
ELSE
(*604*) IF NOT (DTYPE IN ÆJTYP,ATYPÅ)
(*604*) THEN BEGIN
SASGN(LTEMP,OPAND2);
IF OPAND1 > 0
THEN SAD (LTEMP,OPAND1)
ELSE SSB(LTEMP,OPAND1);
IF SHORT(LTEMP)
THEN BEGIN
EAIMMED.DISPL := OPAND1;
GENX(TSUB,2,EAIMMED,EADDIR);
EAIMMED.DISPL := OPAND2 - OPAND1;
GENX(TCHK,2,EAIMMED,EADDIR)
END
ELSE BEGIN
EAIMMED.DISPL := OPAND1;
GENX(TCMP,2,EAIMMED,EADDIR);
EAREL.DISPL := 8;
GENX(TBLT,0,EAREL,EANONE);
EAIMMED.DISPL := OPAND2;
GENX(TCMP,2,EAIMMED,EADDIR);
EAREL.DISPL := 2;
GENX(TBLE,0,EAREL,EANONE);
EAIMMED.DISPL := 13;
GENX(TTRAP,2,EAIMMED,EANONE)
END
END
(*604*) ELSE IF DTYPE=JTYP THEN BEGIN (*JTYP*)
(*604*) EAPSET.DISPL := 0;
(*604*) GENX(TCMP,4,EAPSET,EADDIR);
(*604*) EAREL.DISPL := 10;
(*604*) GENX(TBLT,0,EAREL,EANONE);
(*604*) EAPSET.DISPL := 8;
(*604*) GENX(TCMP,4,EAPSET,EADDIR);
(*604*) EAREL.DISPL := 4;
(*604*) GENX(TBLE,0,EAREL,EANONE);
(*604*) EAIMMED.DISPL := 13;
(*604*) GENX(TTRAP,2,EAIMMED,EANONE)
(*604*) END
(*604*) ELSE BEGIN (*ATYP*)
(*604*) EABASED.DISPL := 368;
(*604*) EABASED.REG := A5;
(*604*) GENX(TCMP,4,EABASED,EADDIR);
(*604*) EAREL.DISPL := 6;
(*604*) GENX(TBLT,0,EAREL,EANONE);
(*604*) EABASED.DISPL := 4;
(*604*) GENX(TCMP,4,EABASED,EADDIR);
(*604*) EAREL.DISPL := 4;
(*604*) GENX(TBLE,0,EAREL,EANONE);
(*604*) EAIMMED.DISPL := 13;
(*604*) GENX(TTRAP,2,EAIMMED,EANONE)
(*604*) END
END (* WITH *)
END; (*PXCHK*)
(*RM*) PROCEDURE PXCVB;
BEGIN WITH INSTR^ DO BEGIN
(*604*) IF (NOT (DTYPE IN LONGTYPES))
(*604*) THEN BEGIN
(*604*) IF DALLOC < 1 THEN POPREG(DREG);
(*604*) IF OPCODE = XCVB
(*604*) THEN BEGIN
(*604*) IF DALLOC < 2 THEN POPREG(DREG);
(*604*) EADDIR.REG := PREVIOUS(DTOP)
(*604*) END
(*604*) ELSE EADDIR.REG := DTOP;
(*604*) REGTYPEÆEADDIR.REGÅ := DTYPE;
(*604*) IF (D1TYPE=HTYP) AND (DTYPE=JTYP)
(*604*) THEN GENX(TEXTE,2,EADDIR,EANONE);
(*604*) IF SIZEÆDTYPEÅ > SIZEÆD1TYPEÅ
(*604*) THEN GENX(TEXTE,SIZEÆDTYPEÅ,EADDIR,EANONE);
(*604*) END;
(*604*) IF (D1TYPE=CTYP) AND (DTYPE=STYP)
(*604*) THEN BEGIN
(*604*) IF DALLOC<1 THEN POPREG(DREG);
(*604*) EADDIR.REG := DTOP;
(*604*) FREEDREG;
PUSHALL;
GENX(TMOVE,1,EADDIR,EAPUSH);
(*604*) EAIMMED.DISPL := 1;
(*604*) GENX(TMOVE,2,EAIMMED,EAPUSH)
(*604*) END;
(*RM*) IF ((D1TYPE=VTYP) AND (DTYPE=STYP)) THEN BEGIN
(*RM*) EAIMMED.DISPL := OPAND1;
(*RM*) GENX(TMOVE,2,EAIMMED,EAPUSH);
(*RM*) END;
(*RM*) IF ((D1TYPE=STYP) AND (DTYPE=VTYP))
(*RM*) OR ((D1TYPE=STYP) AND (DTYPE=UTYP))
(*RM*) OR ((D1TYPE=UTYP) AND (DTYPE=STYP)) THEN BEGIN
(*RM*) ALLOCDREG;
(*RM*) EADDIR.REG := DTOP;
(*RM*) EAIMMED.DISPL := OPAND1;
(*RM*) GENX(TMOVE,4,EAIMMED,EADDIR);
(*RM*) FREEDREG;
LONGBSR;
(*RM*) END
(*RM*) END;
END; (*PXCVB*)
BEGIN (* GENERATE *)
CASE INSTR^.OPCODE OF
XATN,XCOS,XSIN,XEXP,XSQT,XLOG,XRND,XTRC:
ERROR('REAL NOT IMPLEMENTED');
(*604*) XSCON,XSPOS,XSLEN: PXSPOS;
(*604*) XSINS : PXSINS;
XSDEL,XSCOP : PXSDEL;
XLAB: PXLAB;
(*RM*) XEND: PXEND;
XDEF: PXDEF;
XENT,XENTB: PXENT;
XRET: PXRET;
XAB,XNG,XSQR,XNOT,XDEC,XINC,XODD: PXAB;
XAD,XSB,XMP,XDV,XMOD,XIOR,XAND: PXAD;
XCLO,XIFD,XAFI,XEOL,XEOF,XGET,XPUT,XPOS,XSEE,XPEE,XPOK,
(*604*) XRDH, XWRH,
XRST,XRWT,XRLN,XWLN,XPAG,XEIO,
XRDB,XRDC,XRDE,XRDI,XRDJ,XRDQ,XRDR,XRDS,XRDV,
XWRB,XWRC,XWRE,XWRI,XWRJ,XWRQ,XWRR,XWRS,XWRV: PXCLO;
XLOD,XLDA,XSTR: PXLOD;
XIXA: PXIXA;
XIND: PXIND;
XSTO: PXSTO;
(*480*) XSTC: PXSTC;
XLDC: PXLDC;
XLTA: PXLTA;
XLCA: PXLCA;
XISC: PXISC;
XLSC: PXLSC;
XEQU,XNEQ,XLES,XLEQ,XGRT,XGEQ: PXEQU;
XSTP: PXSTP;
XEXI: PXEXI;
XDIS: PXDIS;
XNEW: PXNEW;
XMRK: PXMRK;
XRLS: PXRLS;
XMST: PXMST;
XARG: PXARG;
XAST: PXAST;
XMOV,XMOVV: PXMOV;
XCUP: PXCUP;
XXJP: GENXXJP;
XVJP: PXVJP;
XUJP,XFJP: PXUJP;
XDIF,XINT,XUNI: PXDIF;
XINN: PXINN;
XSGS: PXSGS;
XCHK:PXCHK ;
XCVB,XCVT: PXCVB;
XCHKF,XDAS,XEXT,XINS,XLUPA,XLSPA,XCSP,XCSPF,XCUPF,XDATA,XDATB: ;
(*NOT CURRENTLY GEN'ED BY COMPILER*)
XNONE: ;
END (*CASES*)
END; (*GENERATE*)
BEGIN (*FLUSH*)
OPTIMI := FIRSTI;
CHANGED := FALSE;
WHILE OPTIMI <> NIL DO
BEGIN
WITH OPTIMI^ DO
BEGIN
(*480*) IF INUSE AND ((OPCODE = XLDC) OR (OPCODE = XINC)
(*480*) OR (OPCODE = XLDA))
THEN
BEGIN
CASE OPCODE OF
(*480*) XLDA: BEGIN
(*480*) IF NOT (DTYPE IN LONGTYPES)
(*480*) THEN
(*480*) BEGIN
(*480*) OPTIM2 := NEXTPCOD(OPTIMI);
(*480*) OPTIM3 := NEXTPCOD(OPTIM2);
(*480*) IF (OPTIM2^.OPCODE=XLDC)
(*480*) AND (OPTIM2^.DTYPE=ITYP)
(*480*) AND(OPTIM3^.OPCODE=XIXA)
(*480*) THEN BEGIN
(*480*) OPTIM2^.INUSE :=FALSE;
(*480*) OPTIM3^.INUSE := FALSE;
(*480*) OPTIMI^.OPAND2 :=
(*480*) OPTIMI^.OPAND2 +
(*480*) OPTIM2^.OPAND1 *
(*480*) OPTIM3^.OPAND1;
(*480*) CHANGED := TRUE
(*480*) END
(*480*) ELSE IF ((OPTIM2^.OPCODE=XLDC)
(*480*) OR (OPTIM2^.OPCODE=XLOD))
(*480*) AND (OPTIM3^.OPCODE=XSTO)
(*480*) THEN BEGIN
(*480*) INUSE := FALSE;
(*480*) CHANGED := TRUE;
(*480*) OPTIM3^.OPAND3 :=
(*480*) OPTIM3^.OPAND1;
(*480*) OPTIM3^.OPAND1:=OPAND1;
(*480*) OPTIM3^.OPAND2:=OPAND2;
(*480*) OPTIM3^.OPCODE:=XSTR
(*480*) END
(*480*) ELSE IF OPTIM2^.OPCODE=XIND
(*480*) THEN BEGIN
(*480*) OPTIM2^.INUSE :=FALSE;
(*480*) CHANGED := TRUE;
(*480*) OPTIMI^.OPCODE := XLOD;
(*480*) OPTIMI^.DTYPE :=
(*480*) OPTIM2^.DTYPE;
(*480*) OPTIMI^.OPTYPE := OPTLI;
(*480*) OPTIMI^.OPAND2 :=
(*480*) OPTIMI^.OPAND2 +
(*480*) OPTIM2^.OPAND1;
(*480*) OPTIMI^.OPAND3 :=
(*480*) OPTIM2^.OPAND2;
(*480*) END
(*480*) END
(*480*) END; (* XLDA*)
XLDC: BEGIN
IF NOT (DTYPE IN LONGTYPES)
AND (DTYPE <> JTYP) AND (DTYPE<>ATYP)
THEN
BEGIN
CHANGED := TRUE; (*ASSUME*)
(*480*) TEMPI := NEXTPCOD(OPTIMI);
IF TEMPI^.OPCODE=XDEC
THEN
BEGIN
OPAND1:=OPAND1
- TEMPI^.OPAND1;
TEMPI^.INUSE:=FALSE;
END (*THEN*)
ELSE IF TEMPI^.OPCODE=XINC
THEN BEGIN
OPAND1:=OPAND1+
TEMPI^.OPAND1;
TEMPI^.INUSE:=FALSE
END
ELSE IF TEMPI^.OPCODE=XAD
THEN BEGIN
OPCODE := XINC;
TEMPI^.INUSE:=FALSE
END
ELSE IF TEMPI^.OPCODE=XSB
THEN BEGIN
OPCODE:= XDEC;
TEMPI^.INUSE := FALSE
END
(*480*) ELSE IF TEMPI^.OPCODE=XNG
(*480*) THEN BEGIN
(*480*) OPAND1 := -OPAND1;
(*480*) TEMPI^.INUSE:=FALSE
(*480*) END
ELSE IF (OPAND1=0)
AND (TEMPI^.OPCODE=XIXA)
THEN BEGIN
INUSE := FALSE;
TEMPI^.INUSE:=FALSE
END
(*480*) ELSE IF (TEMPI^.OPCODE=XCVT)
(*480*) AND (TEMPI^.D1TYPE=CTYP)
(*480*) AND (TEMPI^.DTYPE=ITYP)
(*480*) THEN BEGIN
(*480*) TEMPI^.INUSE := FALSE;
(*480*) DTYPE := ITYP;
(*480*) OPAND1 :=ASCIIÆ
(*480*) OPSTRING^.
(*480*) VSTRINGAÆ1ÅÅ
(*480*) END
ELSE CHANGED := FALSE;
END (*THEN*)
(*480*) ELSE
(*480*) BEGIN (* S OR V *)
(*480*) CHANGED := TRUE;
(*480*) OPTIM2 := NEXTPCOD(OPTIMI);
(*480*) IF (OPTIM2^.OPCODE=XCVT)
(*480*) AND (DTYPE = STYP)
(*480*) AND (OPTIM2^.D1TYPE=STYP)
(*480*) AND (OPTIM2^.DTYPE=VTYP)
AND (OPTIM2^.OPAND1<=STRLENGTH)
(*480*) THEN BEGIN
(*480*) OPTIM2^.INUSE := FALSE;
(*480*) OPAND1 := OPTIM2^.OPAND1;
(*480*) DTYPE := VTYP;
(*480*) END
(*480*) ELSE IF (OPTIM2^.OPCODE=XSTR)
(*480*) AND (OPTIM2^.DTYPE=VTYP)
(*480*) AND(DTYPE = VTYP)
AND (OPAND1<=STRLENGTH)
(*480*) THEN BEGIN
(*480*) OPTIM2^.INUSE := FALSE;
(*480*) OPCODE := XSTC;
(*480*) OPAND3 := OPAND1;
(*480*) OPAND1:=OPTIM2^.OPAND1;
(*480*) OPAND2:=OPTIM2^.OPAND2
(*480*) END
(*480*) ELSE CHANGED := FALSE
(*480*) END (* S OR V *)
END; (*XLDC*)
XINC: BEGIN
IF NOT (DTYPE IN LONGTYPES)
AND (DTYPE<>JTYP) AND (DTYPE <> ATYP)
THEN BEGIN
TEMPI := NEXTPCOD(OPTIMI);
IF TEMPI^.OPCODE=XDEC
THEN BEGIN
OPAND1:=OPAND1
- TEMPI^.OPAND1;
TEMPI^.INUSE:=FALSE;
IF OPAND1 = 0
THEN INUSE := FALSE
ELSE CHANGED :=TRUE;
END
END
END; (*XINC*)
END; (*CASE*)
END; (*THEN*)
END; (*WITH*)
IF NOT CHANGED THEN OPTIMI := OPTIMI^.NEXT ELSE OPTIMI:=FIRSTI;
CHANGED := FALSE;
END; (*WHILE*)
TEMPI := FIRSTI;
WHILE TEMPI <> NIL DO
BEGIN
IF TEMPI^.INUSE THEN BEGIN
IF ODD(DEBUG DIV 2) THEN FLPC := TRUE;
GENERATE(TEMPI);
TEMPI^.INUSE := FALSE END;
TEMPI := TEMPI^.NEXT
END;
LASTI := FIRSTI;
TEMPLEVEL := -1; (*INVALIDATE A4 (POINTER TO INTERMED LEXICAL LEVEL*)
END; (*FLUSH*)
(*-------------------------------------------------------------------------
INPUT SCANNER SECTION
-------------------------------------------------------------------------*)
PROCEDURE NEXTLINE ;
VAR I: INTEGER ;
BEGIN
IF EOF(PCODE) THEN WRITELN(OUTPUT,'**** EOF ENCOUNTERED':24) ;
(* HALT NEEDED INSIDE THIS 'THEN' *)
REPEAT
LINELEN := 1 ;
WHILE NOT EOLN(PCODE) AND (LINELEN < LINELNGTH) DO
BEGIN
READ(PCODE,LINEBUFÆLINELENÅ);
LINELEN := LINELEN + 1
END;
READLN(PCODE);
LINEBUFÆLINELENÅ := ' ' ;
IF LINEBUFÆ1Å = '.' THEN LINECOUNT := LINECOUNT+1 ;
IF (ODD(DEBUG DIV 8) AND (LINEBUFÆ1Å='.'))
OR (ODD(DEBUG DIV 4) AND (LINEBUFÆ1Å<>'.'))
THEN BEGIN
WRITE(LISTING, '*' );
FOR I:=1 TO LINELEN DO WRITE(LISTING, LINEBUFÆIÅ) ;
IF LINEBUFÆ1Å = '.'
THEN WRITE(LISTING,' ':(95 - LINELEN),LINECOUNT:6);
WRITELN(LISTING,' ')
END;
UNTIL (LINEBUFÆ1Å <> '.') OR EOF(PCODE);
CHCNT := 1 ;
END (* NEXTLINE *) ;
PROCEDURE GETHEADER;
VAR
I: INTEGER;
OKVAL: BOOLEAN;
BEGIN
NEXTLINE;
LINEBUFÆLINELEN+1Å := ' ';
IF LINEBUFÆ3Å<>'2'
THEN WRITELN(OUTPUT,' ***** INPUT NOT M68000 PCODES!',
' COMPILER PHASE 2 ABORTING. *****');
CHCNT := 5;
GETSTRING; (* MODULE NAME *)
MAINFLG := LINEBUFÆ17Å <> 'S'; (* MAIN OR SUBPROGRAM *)
CHCNT := 18; (* POINT BEYOND OPTIONS *)
OKVAL := GETHEX;
IF OKVAL THEN EXPROC := LTEMP; (* NUMBER OF ENTRIES IN JUMP TABLE *)
JTSIZE := GETINTEGER; (* NUMBER OF ENTRIES IN JUMP TABLE *)
PC := EXPROC;
SAD(PC,JTSIZE * 10);
OKVAL := GETHEX;
IF OKVAL THEN HEAPSTART := LTEMP;
OKVAL := GETHEX;
IF OKVAL THEN STKSTART := LTEMP;
GENSTART := PC;
IF MAINFLG THEN SAD(PC,24); (* LEAVE ROOM FOR INIT CODE *)
GENLOC := PC;
COREBASE := PC;
END; (* GETHEADER *)
PROCEDURE SCAN;
VAR XEXTERNAL: BOOLEAN;
(*RM*) I: INTEGER; (* COUNTER FOR SET INIT *)
PROCEDURE GETOPCODE; (*PROCESS INPUT LINE FOR A LEGAL OPCODE, LOOK
IT UP IN 'MN', SET CURROPCODE, CURROPTYPE *)
VAR I: INTEGER;
J: MNS;
BEGIN
WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
CHCNT := CHCNT + 1;
I := 1;
WHILE (LINEBUFÆCHCNTÅ <> ' ') AND (I<5) AND (CHCNT < LINELEN) DO
BEGIN
OPSYMÆIÅ := LINEBUFÆCHCNTÅ;
CHCNT := CHCNT + 1; I := I + 1;
END;
WHILE I < 5 DO BEGIN OPSYMÆIÅ := ' '; I := I + 1 END;
CURROPCODE := XNONE;
IF (OPSYMÆ1Å<>'Y') AND (OPSYMÆ1Å<>'Z') THEN
FOR J := FMNÆOPSYMÆ1ÅÅ TO PRED(FMNÆSUCCIBM(OPSYMÆ1Å)Å) DO
IF MNÆJÅ = OPSYM THEN CURROPCODE := J;
IF CURROPCODE = XNONE THEN BEGIN ERROR('ILLEGAL OPCODE ');
CURROPTYPE := OP0
END
ELSE CURROPTYPE := OTÆCURROPCODEÅ;
END; (*GETOPCODE*)
PROCEDURE GETTYPE;
BEGIN
WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
CHCNT := CHCNT + 1;
WITH CURRI^ DO BEGIN
DTYPE := NOTATYP;
IF (LINEBUFÆCHCNTÅ>='A') AND (LINEBUFÆCHCNTÅ<='V') THEN
CASE LINEBUFÆCHCNTÅ OF
'D','E','F','G','K','L','M','N','O','T': ;
'A': DTYPE := ATYP;
(*RM*) 'H': DTYPE := HTYP;
'I': DTYPE := ITYP;
'J': DTYPE := JTYP;
'R': DTYPE := RTYP;
'Q': DTYPE := QTYP;
(*RM*) 'U': DTYPE := UTYP;
'V': DTYPE := VTYP;
'S': DTYPE := STYP;
'B': DTYPE := BTYP;
'C': DTYPE := CTYP;
'P': DTYPE := PTYP
END;
END;
CHCNT := CHCNT + 1;
END; (*GETTYPE*)
PROCEDURE GETLABEL;
BEGIN
WHILE (LINEBUFÆCHCNTÅ = ' ') AND (CHCNT < LINELEN) DO
CHCNT := CHCNT + 1;
IF LINEBUFÆCHCNTÅ = 'L' THEN DOLLAR := FALSE
ELSE IF LINEBUFÆCHCNTÅ = '$' THEN DOLLAR := TRUE
ELSE ERROR('LABEL EXPECTED ');
CHCNT := CHCNT + 1;
IF DOLLAR THEN CURRLABEL := GETINTEGER
ELSE BEGIN CURRLABEL := GETINTEGER - LABELOFFSET ;
IF CURRLABEL<0 THEN CURRLABEL:= 0; (* NEEDED IF OLD PCODES *)
IF CURRLABEL > HIGHLABEL THEN HIGHLABEL:= CURRLABEL
END
END; (*GETLABEL*)
PROCEDURE DEFINELABEL( ABSOL: BOOLEAN);
PROCEDURE FIXUP(ABSOL: BOOLEAN);
VAR ADDR1: ^LABELREF; ADDR2: LINT;
ADDR3: INTEGER;
I: INTEGER;
BEGIN
ADDR1 := LABELTABLEÆCURRLABELÅ.REFCHAIN;
REPEAT
ADDR2 := ADDR1^.CORELOC ;
LTEMP := ADDR2;
LSB(LTEMP,COREBASE);
SAD(LTEMP,1);
LASGN(I, LTEMP);
IF I <= 0
THEN
BEGIN
GENSAVE := GENLOC;
GENLOC := ADDR2;
LOCOUNT := MAXCORE - 20;
CORESAVE := CORECOUNT;
CORECOUNT := MAXCORE - 19;
END;
IF NOT ABSOL
THEN BEGIN
LTEMP := PC;
LSB(LTEMP, ADDR2);
LASGN(I,LTEMP);
IF LOCOUNT <> 1
THEN ADDR3 := LOCOUNT
ELSE
BEGIN
LTEMP := ADDR2;
LSB(LTEMP, COREBASE);
SAD(LTEMP, 1);
LASGN(ADDR3,LTEMP)
END;
COREÆADDR3Å := I DIV 256;
COREÆADDR3+1Å := I MOD 256
END ELSE
BEGIN
IF LOCOUNT <> 1
THEN ADDR3 := LOCOUNT
ELSE
BEGIN
LTEMP := ADDR2;
LSB(LTEMP,COREBASE);
SAD (LTEMP,1);
LASGN(ADDR3,LTEMP)
END;
LASGN(I, LABELTABLEÆCURRLABELÅ.LOCATION);
COREÆADDR3Å := DEFVALUE DIV 256;
COREÆADDR3+1Å := DEFVALUE MOD 256;
IF (DEFVALUE < 0) OR (I < 0)
THEN BEGIN
COREÆADDR3Å := ABS(COREÆADDR3Å);
COREÆADDR3+1Å:=ABS(COREÆADDR3+1Å);
COREÆADDR3Å := 255 - COREÆADDR3Å;
COREÆADDR3+1Å := 256 - COREÆADDR3+1Å;
IF COREÆADDR3+1Å = 256
THEN BEGIN
COREÆADDR3+1Å := 0;
COREÆADDR3Å := COREÆADDR3Å + 1;;
IF COREÆADDR3Å = 256
THEN COREÆADDR3Å := 0;
END;
END
END ;
IF LOCOUNT <> 1
THEN
BEGIN
EMITCODE;
GENLOC := GENSAVE;
LOCOUNT := 1;
CORECOUNT := CORESAVE;
END;
ADDR1 := ADDR1^.NEXT;
UNTIL ADDR1 = NIL;
END; (*FIXUPLABEL*)
BEGIN (*DEFINELABEL*)
FLUSH;
WITH LABELTABLEÆCURRLABELÅ DO BEGIN
IF DEFINED THEN ERROR ('DOUBLY DEFINED LABEL')
ELSE IF REFED THEN FIXUP(ABSOL);
DEFINED := TRUE;
IF NOT ABSOL THEN LOCATION := PC
ELSE SASGN(LOCATION, DEFVALUE)
END
END; (*DEFINELABEL*)
PROCEDURE DEFINEPROC(ABSOL: BOOLEAN);
PROCEDURE FIXUPPROC;
VAR
ADDR1:^LABELREF; ADDR2: LINT; I: INTEGER;
BEGIN
GENSAVE := GENLOC;
CORESAVE := CORECOUNT;
ADDR1 := PROCTABLEÆCURRLABELÅ.REFCHAIN;
REPEAT
LOCOUNT := MAXCORE - 20;
CORECOUNT := MAXCORE - 17; (* DATA IS IN -20 TO -17 *)
ADDR2 := ADDR1^.CORELOC;
IF CURROPCODE = XDEF
THEN BEGIN
LTEMP := EXPROC;
LSB(LTEMP, ADDR2)
END
ELSE BEGIN
LTEMP := PC;
LSB(LTEMP, ADDR2)
END;
FOR I := 0 TO 3 DO
COREÆLOCOUNT + IÅ := LTEMPÆIÅ;
GENLOC := ADDR2;
EMITCODE;
ADDR1 := ADDR1^.NEXT;
UNTIL ADDR1 = NIL;
GENLOC := GENSAVE;
LOCOUNT := 1;
CORECOUNT := CORESAVE;
END; (*FIXUPPROC*)
BEGIN
FLUSH;
WITH PROCTABLEÆCURRLABELÅ DO BEGIN
IF CURROPCODE = XENT THEN EMITCODE;
IF DEFINED THEN ERROR('DOUBLY DEFINED LABEL')
ELSE IF REFED THEN FIXUPPROC;
DEFINED := TRUE;
IF NOT ABSOL THEN LOCATION := PC
ELSE SASGN(LOCATION, DEFVALUE);
IF CURROPCODE=XDEF
THEN BEGIN
LOCATION := EXPROC;
SAD(EXPROC,10);
END
END
END; (*DEFINEPROC*)
PROCEDURE QUAI(VAR NEWI: IPTR);(*"QUAI" IS "QUEUE UP ANOTHER INSTRUCTION"*)
BEGIN IF LASTI^.INUSE THEN
IF LASTI^.NEXT = NIL THEN
BEGIN NEW(TEMPI);
TEMPI^.OPSTRING := NIL;
TEMPI^.OPSET := NIL;
TEMPI^.NEXT := NIL;
LASTI^.NEXT := TEMPI;
LASTI := TEMPI
END
ELSE LASTI := LASTI^.NEXT;
NEWI := LASTI
END; (*QUAI*)
BEGIN (*SCAN*)
NEXTLINE;
IF LINEBUFÆ1Å <> ' ' THEN BEGIN LABELED := TRUE; (*COLLECT LABEL*)
(*RM*) GETLABEL; LASTLABEL := CURRLABEL
END
ELSE LABELED := FALSE;
GETOPCODE;
IF CURROPCODE = XDEF
THEN IF NOT DOLLAR
THEN
BEGIN
DEFVALUE := GETINTEGER;
ABSOL := TRUE
END
ELSE ABSOL := FALSE
ELSE ABSOL := FALSE;
IF LABELED THEN IF DOLLAR THEN DEFINEPROC(ABSOL)
ELSE DEFINELABEL(ABSOL);
QUAI(CURRI); (*GET A QUEUE SLOT FOR A NEW INSTRUCTION *)
WITH CURRI^ DO BEGIN
INUSE := TRUE; DTYPE := NOTATYP; D1TYPE := NOTATYP;
OPCODE := CURROPCODE; OPTYPE := CURROPTYPE;
OPAND1 := 0; OPAND2 := 0; OPAND3 := 0;
CASE OPTYPE OF
ENDOP, OP0: BEGIN
OPAND1 := CURRLABEL;
IF CURROPCODE = XDEF THEN
IF NOT DOLLAR THEN OPAND2 := DEFVALUE
END;
OPLI: BEGIN OPAND1 := GETINTEGER; OPAND2 := GETINTEGER;
DTYPE := ATYP END;
OPT: BEGIN GETTYPE;
IF DTYPE IN LONGTYPES THEN OPAND1 := GETINTEGER
END;
OPLAB: BEGIN GETLABEL; OPAND1 := CURRLABEL END;
(*RM*) OP2T: BEGIN GETTYPE; D1TYPE := DTYPE; GETTYPE;
(*RM*) IF D1TYPE IN ÆSTYP,UTYP,VTYPÅ THEN
(*RM*) OPAND1 := GETINTEGER END;
OPTI: BEGIN GETTYPE;
IF DTYPE = NOTATYP THEN CHCNT := CHCNT - 1;
OPAND1 := GETINTEGER;
IF (OPAND1=0) AND (OPCODE = XARG)
THEN BEGIN
OPCODE := XNONE;
INUSE := FALSE
END;
IF DTYPE IN LONGTYPES THEN OPAND2 := GETINTEGER
END;
OPT2I: BEGIN
GETTYPE;
IF DTYPE <> JTYP
THEN BEGIN OPAND1 := GETINTEGER;
OPAND2 := GETINTEGER
END
ELSE BEGIN
IF OPSET = NIL THEN NEW(OPSET);
WITH OPSET^ DO BEGIN
FOR I := 1 TO 8 DO BEGIN
OPAND1 := GETINTEGER;
SETVÆI*2-1Å :=
HEXDATAÆOPAND1 DIV 16 + 1Å;
SETVÆI*2Å :=
HEXDATAÆOPAND1 MOD 16 + 1Å
END
END;
OPAND1 := 1;
END
END;
OPI: OPAND1 := GETINTEGER;
OP3I: BEGIN OPAND1 := GETINTEGER;
OPAND2 := GETINTEGER;
OPAND3 := GETINTEGER
END;
OPTLI: BEGIN GETTYPE; OPAND1 := GETINTEGER;
OPAND2 := GETINTEGER;
IF DTYPE IN LONGTYPES THEN OPAND3 := GETINTEGER
END;
OPTL2I: BEGIN GETTYPE; OPAND1 := GETINTEGER;
OPAND2 := GETINTEGER;
OPAND3 := GETINTEGER END;
OPTV: BEGIN GETTYPE;
(*604*) IF DTYPE IN ÆITYP,HTYPÅ THEN OPAND1 := GETINTEGER
(*604*) ELSE IF (DTYPE=ATYP) AND (OPCODE<>XLDC)
(*604*) THEN OPAND1 := GETINTEGER
ELSE IF DTYPE IN Æ STYP,CTYPÅ THEN BEGIN
IF OPSTRING = NIL THEN NEW(OPSTRING);
GETSTRING;
IF DTYPE = CTYP THEN ALENGTH := 1;
OPSTRING^.STRINGL := ALENGTH;
OPSTRING^.VSTRINGA := VSTRING
END
ELSE IF DTYPE = BTYP THEN BEGIN
OPAND1 := GETINTEGER
END
(*604*) ELSE IF DTYPE = PTYP THEN BEGIN
(*RM*) IF OPSET = NIL THEN NEW(OPSET);
(*RM*) WITH OPSET^ DO BEGIN
(*RM*) FOR I := 1 TO 8 DO BEGIN
(*RM*) OPAND1 := GETINTEGER;
(*RM*) SETVÆI*2-1Å := HEXDATAÆOPAND1 DIV 16+1Å;
(*RM*) SETVÆI*2Å := HEXDATAÆOPAND1 MOD 16 + 1Å;
(*RM*) END
(*RM*) END;
OPAND1 := 0
END ELSE IF DTYPE IN ÆATYP,JTYPÅ
THEN BEGIN
OPAND1 := GETINTEGER;
OPAND2 := GETINTEGER;
OPAND3 := GETINTEGER;
OPAND4 := GETINTEGER
(*RM*) END ELSE ; (* R NOT IMPLEMENTED *)
END;
OPENT: BEGIN OPAND1 := GETINTEGER;
OPAND2 := GETINTEGER; (*SEGSIZE LABEL*)
GETSTRING; (*OPTIONS(IGNORED)*)
IF (VSTRINGÆ1Å>='0') AND(VSTRINGÆ1Å<='9')
THEN DEBUG := ORD(VSTRINGÆ1Å)-ORD('0');
IF (VSTRINGÆ2Å>='0') AND (VSTRINGÆ2Å<='9')
THEN DEBUG := DEBUG * 10 +
ORD(VSTRINGÆ2Å)-ORD('0');
GETSTRING; (*NAME*)
END;
OPENTB: (*NOT CURRENTLY IMPLEMENTED*)
END (*CASE*)
END (*WITH*)
END; (*SCAN*)
(*-------------------------------------------------------------------------
INITIALIZATION SECTION
-------------------------------------------------------------------------*)
PROCEDURE INIT;
VAR I: INTEGER;
J: MNS;
R: REGISTER;
BEGIN
ERRORWR := FALSE;
WRITELN(LISTING,' ':10,'LLEN',' ':3,'120');
STKPTR := -1;
FLPC := FALSE;
DALLOC := 0; AALLOC := 0;
DTOP := DNONE; ATOP := ANONE;
DBOT := DNONE; ABOT := ANONE;
SP := A7;
DALLOCCNT := 0; AALLOCCNT := 0;
DPUSHCNT := 0; APUSHCNT := 0;
DPOPCNT := 0; APOPCNT := 0;
LONGTYPES := ÆPTYP,VTYP,STYP,UTYPÅ;
SASGN(PC,12388);
DEBUG := 9;
GENLOC := PC;
CORECOUNT := 0;
GENSTART := PC;
LOCOUNT := 1;
COREBASE := PC;
CLR(PROGSTART);
MAINFLG := FALSE;
LINECOUNT := -1;
SASGN(RTJUMP,490);
STKSTARTÆ0Å := 0; STKSTARTÆ1Å := 0; STKSTARTÆ2Å := 127;
STKSTARTÆ3Å := 254;
HEAPSTARTÆ0Å := 255; HEAPSTARTÆ1Å := 255; HEAPSTARTÆ2Å := 255;
HEAPSTARTÆ3Å := 255; (* INITIALIZE HEAPSTART TO HEX FFFFFFFF *)
JTSIZE := 10;
LEVEL := 0;
TEMPLEVEL := -1; (*-1 WHENEVER A4 NOT POINTING TO A VALID DISPLAY LEVEL*)
HIGHLABEL := 0; LABELOFFSET := 0;
TOPLABEL := 0;
ABSOL := FALSE;
FOR I:= 0 TO MAXLABEL DO BEGIN PROCTABLEÆIÅ.DEFINED :=FALSE;
PROCTABLEÆIÅ.REFED :=FALSE;
PROCTABLEÆIÅ.REFCHAIN := NIL;
LABELTABLEÆIÅ.REFCHAIN := NIL;
LABELTABLEÆIÅ.DEFINED :=FALSE;
LABELTABLEÆIÅ.REFED :=FALSE
END;
NEW(FIRSTESD); WITH FIRSTESD^ DO BEGIN NAME := XNONE;
NEXT := NIL;
SASGN(REFERENCE, 0);
END;
SIZEÆATYPÅ := 4;
SIZEÆITYPÅ := 2;
SIZEÆJTYPÅ := 4;
SIZEÆRTYPÅ := 4;
SIZEÆQTYPÅ := 8;
SIZEÆVTYPÅ := 4;
SIZEÆSTYPÅ := 4;
SIZEÆBTYPÅ := 1;
SIZEÆPTYPÅ := 8;
SIZEÆNOTATYPÅ := 0;
SIZEÆCTYPÅ := 1;
(*RM*) SIZEÆHTYPÅ := 1;
(*RM*) SIZEÆUTYPÅ := 4;
(*480*) NEW(FAKEI);
(*480*) WITH FAKEI^ DO
(*480*) BEGIN
(*480*) OPCODE := XNONE; NEXT := NIL; OPAND1 := 0; INUSE := TRUE;
(*480*) OPTYPE := OP0; DTYPE := NOTATYP; D1TYPE := NOTATYP;
(*480*) OPAND2 := 0; OPAND3 := 0; OPSTRING := NIL; OPSET := NIL
(*480*) END;
NEW(FIRSTI); LASTI := FIRSTI; FIRSTI^.NEXT := NIL; FIRSTI^.INUSE := FALSE;
FIRSTI^.OPSTRING := NIL; FIRSTI^.OPSET := NIL;
FOR I := 1 TO STRLENGTH DO BLANKSÆIÅ := ' ';
MNÆXAB Å :='AB '; MNÆXAD Å :='AD ';
MNÆXAFI Å :='AFI '; MNÆXAND Å :='AND ';
MNÆXARG Å :='ARG ';
MNÆXAST Å :='AST '; MNÆXATN Å :='ATN ';
MNÆXCHK Å :='CHK '; MNÆXCHKFÅ :='CHKF';
MNÆXCLO Å :='CLO ';
MNÆXCOS Å :='COS '; MNÆXCSP Å :='CSP ';
MNÆXCSPFÅ :='CSPF'; MNÆXCUP Å :='CUP ';
MNÆXCUPFÅ :='CUPF'; MNÆXCVB Å :='CVB ';
MNÆXCVT Å :='CVT '; MNÆXDAS Å :='DAS ';
MNÆXDATAÅ :='DATA'; MNÆXDATBÅ :='DATB';
MNÆXDEC Å :='DEC '; MNÆXDEF Å :='DEF ';
MNÆXDIF Å :='DIF '; MNÆXDIS Å :='DIS ';
MNÆXDV Å :='DV '; MNÆXEIO Å :='EIO ';
MNÆXEND Å :='END ';
MNÆXENT Å :='ENT '; MNÆXENTBÅ :='ENTB';
MNÆXEOF Å :='EOF ';
MNÆXEOL Å :='EOL '; MNÆXEQU Å :='EQU ';
(*1015B*) MNÆXEXI Å :='EXIT'; MNÆXEXP Å :='EXP ';
MNÆXEXT Å :='EXT '; MNÆXFJP Å :='FJP ';
MNÆXGEQ Å :='GEQ '; MNÆXGET Å :='GET ';
MNÆXGRT Å :='GRT '; MNÆXIFD Å :='IFD ';
MNÆXINC Å :='INC '; MNÆXIND Å :='IND ';
MNÆXINN Å :='INN '; MNÆXINS Å :='INS ';
MNÆXINT Å :='INT '; MNÆXIOR Å :='IOR ';
MNÆXISC Å :='ISC '; MNÆXIXA Å :='IXA ';
MNÆXLAB Å :='LAB '; MNÆXLCA Å :='LCA ';
MNÆXLDA Å :='LDA '; MNÆXLDC Å :='LDC ';
MNÆXLEQ Å :='LEQ '; MNÆXLES Å :='LES ';
MNÆXLOD Å :='LOD '; MNÆXLOG Å :='LOG ';
MNÆXLSC Å :='LSC '; MNÆXLSPAÅ :='LSPA';
MNÆXLTA Å :='LTA '; MNÆXLUPAÅ :='LUPA';
MNÆXMOD Å :='MOD '; MNÆXMOV Å :='MOV ';
MNÆXMOVVÅ :='MOVV'; MNÆXMP Å :='MP ';
MNÆXMRK Å :='MRK '; MNÆXMST Å :='MST ';
MNÆXNEQ Å :='NEQ ';
MNÆXNEW Å :='NEW '; MNÆXNG Å :='NG ';
MNÆXNOT Å :='NOT '; MNÆXODD Å :='ODD ';
MNÆXPAG Å :='PAG '; MNÆXPEE Å :='PEE ';
MNÆXPOK Å :='POK '; MNÆXPOS Å :='POS ';
MNÆXPUT Å :='PUT '; MNÆXRDB Å :='RDB ';
MNÆXRDC Å :='RDC '; MNÆXRDE Å :='RDE ';
MNÆXRDI Å :='RDI '; MNÆXRDJ Å :='RDJ ';
(*604*) MNÆXRDH Å := 'RDH '; MNÆXWRH Å := 'WRH ';
MNÆXRDQ Å :='RDQ '; MNÆXRDR Å :='RDR ';
MNÆXRDS Å :='RDS '; MNÆXRDV Å :='RDV ';
MNÆXRET Å :='RET ';
MNÆXRLN Å :='RLN '; MNÆXRLS Å :='RLS ';
MNÆXRND Å :='RND ';
MNÆXRST Å :='RST '; MNÆXRWT Å :='RWT ';
MNÆXSB Å :='SB '; MNÆXSCONÅ :='SCON';
MNÆXSCOPÅ :='SCOP'; MNÆXSDELÅ :='SDEL';
MNÆXSEE Å :='SEE '; MNÆXSGS Å :='SGS ';
MNÆXSIN Å :='SIN '; MNÆXSINSÅ :='SINS';
MNÆXSLENÅ :='SLEN'; MNÆXSPOSÅ :='SPOS';
MNÆXSQR Å :='SQR '; MNÆXSQT Å :='SQT ';
MNÆXSTC Å :='STC ';
MNÆXSTO Å :='STO '; MNÆXSTP Å :='STP ';
MNÆXSTR Å :='STR '; MNÆXTRC Å :='TRC ';
MNÆXUJP Å :='UJP '; MNÆXUNI Å :='UNI ';
(*RM*) MNÆXVJP Å :='VJP ';
MNÆXWLN Å :='WLN '; MNÆXWRB Å :='WRB ';
MNÆXWRC Å :='WRC '; MNÆXWRE Å :='WRE ';
MNÆXWRI Å :='WRI '; MNÆXWRJ Å :='WRJ ';
MNÆXWRQ Å :='WRQ '; MNÆXWRR Å :='WRR ';
MNÆXWRS Å :='WRS '; MNÆXWRV Å :='WRV ';
MNÆXXJP Å :='XJP ';
MNÆXNONEÅ :=' ';
FMNÆ'A'Å :=XAB ; FMNÆ'B'Å :=XCHK;
FMNÆ'C'Å :=XCHK; FMNÆ'D'Å :=XDAS;
FMNÆ'E'Å :=XEIO; FMNÆ'F'Å :=XFJP;
FMNÆ'G'Å :=XGEQ; FMNÆ'H'Å :=XIFD;
FMNÆ'I'Å :=XIFD; FMNÆ'J'Å :=XLAB;
FMNÆ'K'Å :=XLAB; FMNÆ'L'Å :=XLAB;
FMNÆ'M'Å :=XMOD; FMNÆ'N'Å :=XNEQ;
FMNÆ'O'Å :=XODD; FMNÆ'P'Å :=XPAG;
FMNÆ'Q'Å :=XRDB; FMNÆ'R'Å :=XRDB;
FMNÆ'S'Å :=XSB ; FMNÆ'T'Å :=XTRC;
(*RM*) FMNÆ'U'Å :=XUJP; FMNÆ'V'Å :=XVJP;
FMNÆ'W'Å :=XWLN; FMNÆ'X'Å :=XXJP;
FMNÆ'Y'Å :=XNONE;FMNÆ'Z'Å :=XNONE;
TMNÆTMOVE Å :='MOVE '; TMNÆTLINK Å :='LINK '; TMNÆTUNLK Å :='UNLK ';
TMNÆTRTS Å :='RTS '; TMNÆTTST Å :='TST '; TMNÆTBGT Å :='BGT.S';
TMNÆTNEG Å :='NEG '; TMNÆTSUBQ Å :='SUB '; TMNÆTBTST Å :='BTST ';
TMNÆTSNZ Å :='SNZ '; TMNÆTADD Å :='ADD '; TMNÆTSUB Å :='SUB ';
TMNÆTAND Å :='AND '; TMNÆTOR Å :='OR '; TMNÆTMULS Å :='MULS ';
TMNÆTDIVS Å :='DIVS '; TMNÆTCMP Å :='CMP '; TMNÆTCLR Å :='CLR ';
TMNÆTTRAP Å :='TRAP '; TMNÆTDCNT Å :='DCNT '; TMNÆTBSR Å :='BSR.S';
TMNÆTADDQ Å :='ADD '; TMNÆTCOMP Å :='NOT '; TMNÆTLBSR Å :='BSR ';
TMNÆTMOVEQÅ :='MOVE '; TMNÆTSEQ Å :='SEQ '; TMNÆTSNE Å :='SNE ';
TMNÆTSGE Å :='SGE '; TMNÆTSLT Å :='SLT '; TMNÆTSGT Å :='SGT ';
TMNÆTSLE Å :='SLE '; TMNÆTLEA Å :='LEA '; TMNÆTLDQ Å :='MOVE ';
TMNÆTBRAÅ :='BRA.S'; TMNÆTBNE Å :='BNE.S'; TMNÆTEQU Å :='EQU ';
TMNÆTBEQÅ :='BEQ.S';
TMNÆTLBGTÅ :='BGT '; TMNÆTLBRA Å :='BRA ';
TMNÆTLBNEÅ :='BNE '; TMNÆTLBEQÅ :='BEQ ';
TMNÆTLBLTÅ :='BLT '; TMNÆTASL Å := 'ASL ';
TMNÆTBLT Å :='BLT.S'; TMNÆTJMPÅ := 'JMP ';
TMNÆTPEA Å :='PEA '; TMNÆTBSETÅ := 'BSET ';
TMNÆTBZ Å :='BEQ '; TMNÆTJSR Å := 'JSR ';
(*RM*) TMNÆTEOR Å :='EOR ';
(*RM*) TMNÆTEXTE Å := 'EXT '; TMNÆTSWAPÅ :='SWAP ';
TMNÆTCMPM Å := 'CMPM ';
TMNÆTBNZ Å := 'BNE.S'; TMNÆTBGE Å := 'BGE.S';
TMNÆTBLE Å := 'BLE.S'; TMNÆTCHK Å := 'CHK ';
TMNÆTDC Å := 'DC '; (*DUMMY INSTR*)
TMNÆTLBLEÅ := 'BLE '; TMNÆTLBGEÅ := 'BGE ';
(*RM*) DNAMEÆATYPÅ := 'A'; DNAMEÆITYPÅ := 'I'; DNAMEÆJTYPÅ := 'J';
(*RM*) DNAMEÆRTYPÅ := 'R'; DNAMEÆQTYPÅ := 'Q'; DNAMEÆVTYPÅ := 'V';
(*RM*) DNAMEÆSTYPÅ := 'S'; DNAMEÆBTYPÅ := 'B'; DNAMEÆPTYPÅ := 'P';
(*RM*) DNAMEÆNOTATYPÅ :=' '; DNAMEÆCTYPÅ := 'C'; DNAMEÆHTYPÅ :='H';
(*RM*) DNAMEÆUTYPÅ := 'U';
FOR J := XAB TO XXJP DO OTÆJÅ := OP0;
OTÆXAB Å := OPT ; OTÆXAD Å := OPT ;
(*604*) OTÆXARG Å := OPTI ; (* CHANGE FOR 6809 CHIPS STUFF *)
OTÆXAST Å := OPTI ; OTÆXATN Å := OPT ;
(*604*) OTÆXCHK Å := OPT2I ; OTÆXCHKFÅ := OPT ;
OTÆXCOS Å := OPT ; OTÆXCSP Å := OPLAB ;
OTÆXCUP Å := OPLAB ;
OTÆXCVB Å := OP2T ;
OTÆXCVT Å := OP2T ; OTÆXDAS Å := OPI ;
(*DATA,DATB*)
OTÆXDEC Å := OPTI ;
OTÆXDIS Å := OPI ;
OTÆXDV Å := OPT ; OTÆXEND Å := ENDOP ;
OTÆXENT Å := OPENT ; OTÆXENTBÅ := OPENTB;
OTÆXEQU Å := OPT ;
OTÆXEXI Å := OPI ;
OTÆXEXP Å := OPT ;
OTÆXEXT Å := OPTL2I; OTÆXFJP Å := OPLAB ;
OTÆXGEQ Å := OPT ;
OTÆXGRT Å := OPT ;
OTÆXINC Å := OPTI ; OTÆXIND Å := OPTI ;
OTÆXINS Å := OP3I ;
OTÆXIXA Å := OPI ;
OTÆXLCA Å := OPTV ;
OTÆXLDA Å := OPLI ; OTÆXLDC Å := OPTV ;
OTÆXLEQ Å := OPT ; OTÆXLES Å := OPT ;
OTÆXLOD Å := OPTLI ; OTÆXLOG Å := OPT ;
OTÆXLSC Å := OPI ; OTÆXLSPAÅ := OPI ;
OTÆXLUPAÅ := OPI ;
OTÆXMOD Å := OPT ; OTÆXMOV Å := OPI ;
OTÆXMP Å := OPT ;
OTÆXNEQ Å := OPT ;
OTÆXNEW Å := OPI ; OTÆXNG Å := OPT ;
OTÆXODD Å := OPT ;
OTÆXRET Å := OPLI ;
OTÆXRND Å := OPT ;
OTÆXSB Å := OPT ;
OTÆXSIN Å := OPT ;
OTÆXSQR Å := OPT ; OTÆXSQT Å := OPT ;
OTÆXSTO Å := OPT ;
OTÆXSTR Å := OPTLI ; OTÆXTRC Å := OPT ;
OTÆXUJP Å := OPLAB ;
(*RM*) OTÆXVJP Å := OPLAB;
OTÆXXJP Å := OPLAB ;
FOR J := XAB TO XNONE DO FLÆJÅ := TRUE;
FLÆXAB Å := FALSE; FLÆXAD Å := FALSE; FLÆXAND Å := FALSE;
FLÆXAST Å := FALSE; FLÆXCVB Å := FALSE; FLÆXCVT Å := FALSE;
FLÆXDAS Å := FALSE;
FLÆXDATAÅ := FALSE; FLÆXDATBÅ := FALSE; FLÆXDEC Å := FALSE;
FLÆXDIF Å := FALSE; FLÆXDV Å := FALSE; FLÆXEQU Å := FALSE;
FLÆXEXT Å := FALSE;
FLÆXGEQ Å := FALSE; FLÆXGRT Å := FALSE; FLÆXINC Å := FALSE;
FLÆXIND Å := FALSE; FLÆXINN Å := FALSE; FLÆXINS Å := FALSE;
FLÆXINT Å := FALSE;
FLÆXIOR Å := FALSE;
FLÆXIXA Å := FALSE; FLÆXLCA Å := FALSE; FLÆXLDA Å := FALSE;
FLÆXLDC Å := FALSE; FLÆXLEQ Å := FALSE; FLÆXLES Å := FALSE;
FLÆXLOD Å := FALSE; FLÆXLSPAÅ := FALSE; FLÆXLTA Å := FALSE;
FLÆXLUPAÅ := FALSE;
FLÆXMOD Å := FALSE; FLÆXMOV Å := FALSE; FLÆXMP Å := FALSE;
FLÆXNEQ Å := FALSE; FLÆXNG Å := FALSE; FLÆXNOT Å := FALSE;
FLÆXODD Å := FALSE; FLÆXSB Å := FALSE; FLÆXSQR Å := FALSE;
FLÆXUNI Å := FALSE; FLÆXNONEÅ := FALSE;
FOR J := XAB TO XXJP DO SUBTYPEÆJÅ := 0;
SUBTYPEÆXAB Å := 1; SUBTYPEÆXAD Å := 1;
SUBTYPEÆXNG Å := 2; SUBTYPEÆXSB Å := 2;
SUBTYPEÆXDEC Å := 3; SUBTYPEÆXAND Å := 3;
SUBTYPEÆXINC Å := 4; SUBTYPEÆXIOR Å := 4;
SUBTYPEÆXNOT Å := 5; SUBTYPEÆXMP Å := 5;
SUBTYPEÆXODD Å := 6; SUBTYPEÆXDV Å := 6;
SUBTYPEÆXSQR Å := 7; SUBTYPEÆXMOD Å := 7;
SUBTYPEÆXLOD Å := 1; SUBTYPEÆXEQU Å := 1;
SUBTYPEÆXLDA Å := 2; SUBTYPEÆXNEQ Å := 2;
SUBTYPEÆXSTR Å := 3; SUBTYPEÆXLES Å := 3;
SUBTYPEÆXLEQ Å := 4;
SUBTYPEÆXGRT Å := 5;
SUBTYPEÆXGEQ Å := 6;
SUBTYPEÆXUJP Å := 1;
SUBTYPEÆXFJP Å := 2;
BUILDADDR(EANONE,NONE,ANONE,ANONE,0);
BUILDADDR(EADDIR,DDIRECT,ANONE,ANONE,0);
BUILDADDR(EAADIR,ADIRECT,ANONE,ANONE,0);
BUILDADDR(EAIMMED,IMMED,ANONE,ANONE,0);
BUILDADDR(EADEFER,DEFER,ANONE,ANONE,0);
BUILDADDR(EAINCR,INCR,ANONE,ANONE,0);
BUILDADDR(EAPOP,INCR,SP,ANONE,0);
BUILDADDR(EAPUSH,DECR,SP,ANONE,0);
BUILDADDR(EALIMM,LABIMMED,ANONE,ANONE,0);
BUILDADDR(EAREL,RELATIVE,ANONE,ANONE,0);
BUILDADDR(EALAB,LABELLED,ANONE,ANONE,0);
(*RM*) BUILDADDR(EAPSET,PIMMED,ANONE,ANONE,0);
BUILDADDR(EABASED,BASED,ANONE,ANONE,0);
BUILDADDR(EALONG,LIMMED,ANONE,ANONE,0);
FOR R := DNONE TO A7 DO REGTYPEÆRÅ := NOTATYP;
R := D0;
FOR I:= 0 TO NDREGS DO BEGIN DREGSÆIÅ := R;
R := SUCC(R)
END;
R := A0;
FOR I:= 0 TO NAREGS DO BEGIN AREGSÆIÅ := R;
R := SUCC(R)
END;
MACHCODE := ' ';
MACHINDEX := 1;
HEXDATA := '0123456789ABCDEF';
SASGN(EXPROC,12288); (* HEX 3000 *)
FOR C := CHR(0) TO CHR(127) DO ASCIIÆCÅ := 32; (*BLANK*)
ASCIIÆ'a'Å:=97; ASCIIÆ'b'Å:=98; ASCIIÆ'c'Å:=99; ASCIIÆ'd'Å:=100;
ASCIIÆ'e'Å:=101;ASCIIÆ'f'Å:=102;ASCIIÆ'g'Å:=103;ASCIIÆ'h'Å:=104;
ASCIIÆ'i'Å:=105;ASCIIÆ'j'Å:=106;ASCIIÆ'k'Å:=107;ASCIIÆ'l'Å:=108;
ASCIIÆ'm'Å:=109;ASCIIÆ'n'Å:=110;ASCIIÆ'o'Å:=111;ASCIIÆ'p'Å:=112;
ASCIIÆ'q'Å:=113;ASCIIÆ'r'Å:=114;ASCIIÆ's'Å:=115;ASCIIÆ't'Å:=116;
ASCIIÆ'u'Å:=117;ASCIIÆ'v'Å:=118;ASCIIÆ'w'Å:=119;ASCIIÆ'x'Å:=120;
ASCIIÆ'y'Å:=121;ASCIIÆ'z'Å:=122;
ASCIIÆ'A'Å:=65; ASCIIÆ'B'Å:=66; ASCIIÆ'C'Å:=67; ASCIIÆ'D'Å:=68;
ASCIIÆ'E'Å:=69; ASCIIÆ'F'Å:=70; ASCIIÆ'G'Å:=71; ASCIIÆ'H'Å:=72;
ASCIIÆ'I'Å:=73; ASCIIÆ'J'Å:=74; ASCIIÆ'K'Å:=75; ASCIIÆ'L'Å:=76;;
ASCIIÆ'M'Å:=77; ASCIIÆ'N'Å:=78; ASCIIÆ'O'Å:=79; ASCIIÆ'P'Å:=80;
ASCIIÆ'Q'Å:=81; ASCIIÆ'R'Å:=82; ASCIIÆ'S'Å:=83; ASCIIÆ'T'Å:=84;
ASCIIÆ'U'Å:=85; ASCIIÆ'V'Å:=86; ASCIIÆ'W'Å:=87; ASCIIÆ'X'Å:=88;
ASCIIÆ'Y'Å:=89; ASCIIÆ'Z'Å:=90;
ASCIIÆ'0'Å:=48; ASCIIÆ'1'Å:=49; ASCIIÆ'2'Å:=50; ASCIIÆ'3'Å:=51;
ASCIIÆ'4'Å:=52; ASCIIÆ'5'Å:=53; ASCIIÆ'6'Å:=54; ASCIIÆ'7'Å:=55;
ASCIIÆ'8'Å:=56; ASCIIÆ'9'Å:=57;
ASCIIÆ' 'Å:=32; ASCIIÆ'*'Å:=42; ASCIIÆ'>'Å:=62;
ASCIIÆ'!'Å:=33; ASCIIÆ'+'Å:=43; ASCIIÆ'?'Å:=63;
ASCIIÆ'"'Å:=34; ASCIIÆ','Å:=44; ASCIIÆ'^'Å:=64;
ASCIIÆ'#'Å:=35; ASCIIÆ'-'Å:=45;
ASCIIÆ'$'Å:=36; ASCIIÆ'.'Å:=46; ASCIIÆ'Ø'Å:=92;
ASCIIÆ'%'Å:=37; ASCIIÆ'/'Å:=47;
ASCIIÆ'&'Å:=38; ASCIIÆ':'Å:=58; ASCIIÆ'!'Å:=94;
ASCIIÆ''''Å:=39;ASCIIÆ';'Å:=59;
ASCIIÆ'('Å:=40; ASCIIÆ'<'Å:=60;
ASCIIÆ')'Å:=41; ASCIIÆ'='Å:=61;
ASCIIÆ'Æ'Å:=91; ASCIIÆ'Å'Å:=93;
ASCIIÆ'_'Å:=95; ASCIIÆ'æ'Å:=123; ASCIIÆ'å'Å:=125;
ASCIIÆ'`'Å:=96; ASCIIÆ'ø'Å:=124; ASCIIÆ'^'Å:=126;
RTÆXCVBÅ := 4228; RTÆXAFIÅ := 4112; RTÆXCLOÅ := 4116;
RTÆXDISÅ := 4104; RTÆXEOFÅ := 4120; RTÆXEOLÅ := 4124;
RTÆXEQUÅ := 4268; RTÆXEXIÅ := 4096; RTÆXGEQÅ := 4288;
RTÆXENDÅ := 4096;
RTÆXGETÅ := 4128; RTÆXGRTÅ := 4284; RTÆXIFDÅ := 4132;
RTÆXINDÅ := 4264; RTÆXLEQÅ := 4280; RTÆXLESÅ := 4276;
RTÆXLODÅ := 4264; RTÆXNEQÅ := 4272; RTÆXNEWÅ := 4108;
RTÆXPAGÅ := 4136; RTÆXPEEÅ := 4140; RTÆXPOKÅ := 4144;
RTÆXPOSÅ := 4148; RTÆXPUTÅ := 4152; RTÆXRDBÅ := 4176;
RTÆXRDCÅ := 4180; RTÆXRDIÅ := 4184; RTÆXRDSÅ := 4188;
RTÆXRDVÅ := 4212; RTÆXRLNÅ := 4156; RTÆXRSTÅ := 4160;
RTÆXRWTÅ := 4164; RTÆXSCONÅ:= 4232; RTÆXSCOPÅ:= 4236;
RTÆXSDELÅ:= 4240; RTÆXSEEÅ := 4168; RTÆXSINSÅ := 4244;
RTÆXSLENÅ:= 4248; RTÆXSPOSÅ:= 4252; RTÆXSTOÅ := 4260;
RTÆXSTPÅ := 4100; RTÆXSTRÅ := 4256; RTÆXWLNÅ := 4172;
RTÆXWRBÅ := 4192; RTÆXWRCÅ := 4196; RTÆXWRIÅ := 4200;
RTÆXWRSÅ := 4204; RTÆXWRVÅ := 4208; RTÆXCVTÅ := 4220;
RTÆXCVTSUÅ := 4216; RTÆXCVTUSÅ := 4224; RTÆXLDCÅ := 4292;
RTÆXSTRVÅ := 4296; RTÆXSTOVÅ := 4300; RTÆXINDVÅ := 4304;
RTÆXLODVÅ := 4304; RTÆXEQUVÅ := 4308; RTÆXNEQVÅ := 4312;
RTÆXLESVÅ := 4316; RTÆXLEQVÅ := 4320; RTÆXGRTVÅ := 4324;
RTÆXGEQVÅ := 4328; RTÆXLDCVÅ := 4332; RTÆXSTCÅ := 4336;
RTÆXMPÅ := 4340; RTÆXDVÅ := 4344; RTÆXMODÅ := 4348;
RTÆXRLSÅ := 4148; RTÆXMRKÅ := 4144; RTÆXRDHÅ := 4528;
RTÆXRDJÅ := 4532; RTÆXWRHÅ := 4520; RTÆXWRJÅ := 4524;
END; (*INIT*)
(*-------------------------------------------------------------------------
SUMMARY PROCEDURE
-------------------------------------------------------------------------*)
PROCEDURE SUMMARIZE;
BEGIN WRITELN(LISTING,'*D REGISTERS: ',DALLOCCNT,' ALLOCATIONS, REQUIRING ',
DPUSHCNT,' PUSHES');
WRITELN(LISTING,'* AND ', DPOPCNT,' POPS');
WRITELN(LISTING,'*A REGISTERS: ',AALLOCCNT,' ALLOCATIONS, REQUIRING ',
APUSHCNT,' PUSHES');
WRITELN(LISTING,'* AND ', APOPCNT,' POPS');
WRITELN(LISTING,'*');
WRITE(LISTING,'*TOTAL OF ');
LTEMP := PC;
LSB(LTEMP,GENSTART);
PLINT(LISTING,LTEMP);
WRITELN(LISTING,' BYTES GENERATED.');
WRITE(OUTPUT,' CODE GENERATOR PRODUCED ');
PLINT(OUTPUT,LTEMP);
WRITELN(OUTPUT,' BYTES OF CODE.');
WRITELN(OUTPUT,' LABELS USED:',TOPLABEL:4);
IF ERRORWR THEN WRITELN(OUTPUT,' ***** ERROR(S) DETECTED *****')
ELSE WRITELN(OUTPUT,' NO ERRORS DETECTED.');
WRITELN(OUTPUT,'STACKPTR = ',STKPTR:5);
PAGE(LISTING)
END;
(*-------------------------------------------------------------------------
MAIN PROGRAM
-------------------------------------------------------------------------*)
BEGIN
REWRITE(LISTING);
WRITELN(LISTING,'* M68000 PASCAL COMPILER PHASE TWO VERSION 1.10 08/07/80 ');
RESET(PCODE);
REWRITE(OBJECT);
WRITELN(OUTPUT,' M68000 PASCAL COMPILER PHASE TWO VERSION 1.10');
WRITELN(OUTPUT,' COPYRIGHTED 1980 BY MOTOROLA, INC.');
WRITELN(LISTING,' ');
INIT;
GETHEADER;
IF LINEBUFÆ3Å = '2' THEN
REPEAT
SCAN;
(*WITH CURRI^ DO
WRITELN(LISTING,'* ',MNÆOPCODEÅ,ORD(OPTYPE),OPAND1,OPAND2,OPAND3);*)
IF FLÆCURRI^.OPCODEÅ THEN FLUSH;
UNTIL CURRI^.OPTYPE = ENDOP;
SUMMARIZE;
END.
▶EOF◀