SECTION "CG7"
GET "CGHDR"
// FORMS A SOURCE ADDRESS (M,V) PAIR;
// LOOKS IN THE REGISTERS
LET FORMSADDR(K,N) BE
$( LET R=LOOKINREGS(K,N)
IF R>=0 DO
$( ADDR.M,ADDR.V := M.REG,TRANR(R)
RETURN $)
FORMADDR(K,N)
$)
// FORMS A DESTINATION ADDRESS (M,V) PAIR;
// FORGETS THE VALUE OF THE DESTINATION
AND FORMDADDR(K,N) BE
$( FORGET(K,N)
FORMADDR(K,N)
$)
// FORMS A MACHINE ADDRESS PAIR (M,V)
// FOR USE BY A CODE- ROUTINE
AND FORMADDR(K,N) BE
SWITCHON K INTO
$( CASE K.LOC:
ADDR.M,ADDR.V := M.LOC,2*N
ENDCASE
CASE K.NUMB:
ADDR.M,ADDR.V := M.IMM,N
ENDCASE
CASE K.GLOB:
ADDR.M,ADDR.V := M.GLOB,2*N
ENDCASE
CASE K.LAB:
ADDR.M,ADDR.V := M.LAB,N
ENDCASE
CASE K.REG:
ADDR.M,ADDR.V := M.REG,TRANR(N)
ENDCASE
CASE K.XBX:
ADDR.M,ADDR.V := M.BX,N
ENDCASE
CASE K.XSI:
ADDR.M,ADDR.V := M.SI,N
ENDCASE
DEFAULT: CGERROR("BAD ADDRESS TYPE %N", TRUE, K)
$)
// CALLED BY GENMOV TO UPDATE THE CONTENTS
// OF THE REGISTERS
AND REMEM(K1,N1,K2,N2) BE
TEST K2=K.REG
THEN SETINFO(N2,K1,N1)
ELSE IF K1=K.REG & REG.K!N1=K.NONE DO
SETINFO(N1,K2,N2)
// SETS THE INFO FOR REGISTER R TO (K,N)
AND SETINFO(R,K,N) BE
$( SWITCHON K INTO
$( CASE K.REG:
K := REG.K!N
N := REG.N!N
ENDCASE
DEFAULT:
K := K.NONE
CASE K.LOC: CASE K.GLOB:
CASE K.LAB:
CASE K.MLOC: CASE K.MGLOB:
CASE K.MLAB:
CASE K.LVLOC: CASE K.LVGLOB:
CASE K.LVLAB:
CASE K.NUMB:
$)
REG.K!R := K
REG.N!R := N
$)
// FORGETS THE VALUE OF A REGISTER OR VARIABLE
AND FORGET(K,N) BE
$( SWITCHON K INTO
$( CASE K.REG:
REG.K!N := K.NONE
DEFAULT:
RETURN
CASE K.LOC:
FORGET(K.MLOC,N)
ENDCASE
CASE K.GLOB:
FORGET(K.MGLOB,N)
ENDCASE
CASE K.LAB:
FORGET(K.MLAB,N)
CASE K.MLOC: CASE K.MGLOB: CASE K.MLAB:
$)
FOR R=R0 TO R4 DO IF REG.K!R=K & REG.N!R=N DO
REG.K!R := K.NONE
$)
// FORGETS THE VALUES OF ALL VARIABLES; CALLED
// AFTER AN INDIRECT ASSIGNMENT
AND FORGETVARS() BE
FOR R=R0 TO R4 SWITCHON REG.K!R INTO
$( CASE K.LOC: CASE K.GLOB:
CASE K.LAB:
CASE K.MLOC: CASE K.MGLOB:
CASE K.MLAB:
REG.K!R := K.NONE
DEFAULT:
$)
// FORGETS THE CONTENTS OF ALL REGISTERS; CALLED
// AFTER LABELS, PROCEDURE CALLS
AND FORGETALL() BE
FOR R=R0 TO R4 DO REG.K!R := K.NONE
//MAKE 1 BYTE OF CODE
AND CODEB(B) BE
$(1 PUTVBYTE(STV, STVP, B)
STVP := STVP + 1
CHECKSPACE()
$)1
// MAKES ONE WORD OF CODE; L INDICATES A LABEL REF
AND CODE(A, L) BE
$(1 UNLESS L=0 DO LABREF(L, STVP)
PWABO(STV, STVP, A)
STVP := STVP + 2
CHECKSPACE()
$)1
AND CODED(F, M, V) BE IF INCODE DO
$(1 CHECKBREFS(4)
CODEB(F>>3) // F IS AN 11 BIT COMPOSITE
CODEB(CONSB2(F&7,M,V))
CODEDISP(M,V)
$)1
AND CODEKD(F, I, M, V) BE IF INCODE DO
$( IF F=F.MOVIMMTRM DO
$( CHECKBREFS(6)
CODEB(#307)
CODEB(CONSB2(0, M, V))
CODEDISP(M, V)
CODE(I, 0)
RETURN
$)
IF F=F.MOVIMMTR DO
$( CHECKBREFS(3)
CODEB(#270|V)
CODE(I, 0)
RETURN
$)
IF M=M.REG DO
IF V=TRANR(R.AX) DO
$( CHECKBREFS(3)
CODEB((F<<3)|5)
CODE(I, 0)
RETURN
$)
$( LET S = SMALLNUM(I) -> 2, 0
UNLESS F=F.ADD | F=F.SUB | F=F.CMP DO S := 0
TEST S=2 THEN CHECKBREFS(5) OR CHECKBREFS(6)
CODEB(#201|S)
CODEB(CONSB2(F, M, V))
CODEDISP(M, V)
TEST S=0 DO CODE(I, 0)
OR CODEB(I)
$)
$)
AND CODERS(F, R, M, V) BE IF INCODE DO
$(1 CHECKBREFS(4)
TEST M=M.IMM THEN
$( TEST R=R.AX THEN
$( CODEB((F<<3)|5)
CODE(V, 0)
$)
OR
$( LET S = SMALLNUM(V) -> 2,0
UNLESS F=F.ADD | F=F.SUB | F=F.CMP DO S := 0
CODEB(#201|S)
CODEB(CONSB2(F,M.REG,TRANR(R)))
TEST S=0 DO CODE(V, 0) OR CODEB(V)
$)
$)
OR
$( TEST F=F.MOVRTRM DO CODEB(F.MOVRTRM | 2)
OR $( TEST F=F.LEA DO CODEB(F.LEA) OR CODEB((F<<3)|3) $)
CODEB(CONSB2(TRANR(R),M,V))
CODEDISP(M,V)
$)
$)1
AND CODERD(F, R, M, V) BE IF INCODE DO
$( CHECKBREFS(4)
TEST F=F.MOVRTRM DO CODEB(F.MOVRTRM)
OR CODEB((F<<3)|1)
CODEB(CONSB2(TRANR(R), M, V))
CODEDISP(M, V)
$)
// INSERTS A PROFILE COUNT
AND INSERTCOUNT() BE
$(1 LET L = NEXTPARAM()
CHECKBREFS(9)
//*<3032
LISTL("INC L%N", L)
/*3032>*/
CODEB(#X2E) // CODE SEGMENT OVERRIDE PREFIX
CODEB(#377)
CODEB(6) // INC L
CODE(0, L)
//*<3032
LISTL("JMP $+4")
/*3032>*/
CODEB(#353) // BRANCH ROUND COUNT
CODEB(2)
SETLAB(L)
//*<3032
LISTAT(S.ITEMN, 0)
/*3032>*/
CODE(0, 0) // WORD FOR THE COUNT
$)1
// SET THE LABEL L TO THE CURRENT LOCATION
AND SETLAB(L) BE
$(1 LET P = BREFV
UNLESS LABV!L=-1 DO
CGERROR("LABEL L%N SET TWICE", FALSE, L)
IF INCODE DO UNLESS BREFP=BREFV DO
// ELIMINATE REDUNDANT BRANCHES
IF (BREFP-2)!0=L & (BREFP-2)!1=STVP-1 DO
STVP, BREFP := STVP-2, BREFP-2
LABV!L := STVP
//*<3032
LISTLAB(L)
/*3032>*/
// FILL IN FORWARD BRANCH REFS
UNTIL P-BREFP>=0 DO TEST !P=L
THEN $( LET LOC = P!1
LET A = STVP - LOC - 1
IF A>127 DO
CGERROR("BAD BR LAB L%N", FALSE, L)
PUTVBYTE(STV, LOC, A)
BREFP := BREFP - 2
FOR Q = P TO BREFP-1 DO Q!0 := Q!2 $)
ELSE P := P+2
$)1
// COMPILE OCODE LABEL L
AND CGLAB(L) BE
$(1
UNLESS INCODE DO GENBREFJUMPS(50,L)
SETLAB(L)
INCODE := TRUE
IF PROFILING DO INSERTCOUNT()
FORGETALL()
$)1
// COMPILES NAMES FOR S.ENTRY, S.SECTION
AND CGNAME(OP,N) BE
$(1 LET V = VEC 17/BYTESPERWORD+1
//*<3032
LET ASTAR, ASPACE = ASKII('**'), ASKII('*S')
/*3032>*/
/*<8086
LET ASTAR, ASPACE = '**', '*S'
/*8086>*/
PUTBYTE(V, 0, OP=S.ENTRY->7, 17)
FOR I = 1 TO 9 DO PUTBYTE(V,I+8,GETBYTE(DATVEC,I)) // DATE
FOR I=1 TO N DO
$( LET C = RDN()
IF I <=7 DO PUTBYTE(V, I, C) $)
FOR I = N+1 TO 7 DO PUTBYTE(V, I, N=0->ASTAR, ASPACE)
PUTBYTE(V, 8, ASPACE)
IF NAMING DO
$( IF OP=S.SECTION DO
$(
//*<3032
LISTL("SECTION")
/*3032>*/
CODE(SECWORD, 0)
$)
//*<3032
LISTL(V)
/*3032>*/
FOR I = 0 TO OP=S.ENTRY->6,16 BY 2 DO
$( CODEB(GETBYTE(V,I)); CODEB(GETBYTE(V,I+1)) $)
$)
$)1
AND CGSTRING(N) BE
$(1 LET L,W = NEXTPARAM(),N
LOADT(K.LVLAB,L)
CGDATA(S.DATALAB, L)
$( UNLESS N=0 DO W :=(RDN()<<8) | W
CGDATA(S.ITEMN, W)
IF N<=1 BREAK
N, W := N-2, RDN() $) REPEAT
$)1
// GENERATE A LABEL REFERENCE
// L>0 => RELOCATION
AND LABREF(L, P) BE
$(1 DP := DP-3
CHECKSPACE()
H1!DP, H2!DP, H3!DP := 0, L, P
!REFLISTE := DP
REFLISTE := DP $)1
AND CGDATA(A, L) BE
$(1 DP := DP-3
CHECKSPACE()
H1!DP, H2!DP, H3!DP := 0, A, L
!DLISTE := DP
DLISTE := DP $)1
AND CGSTATICS() BE
$(1 LET D = DLIST
LET P = ?
EVEN()
$( PWABO(STV, 0, STVP>>1) //FILL IN NO. OF WORDS OF CODE
P := STVP
CODE(0, 0) //THIS WILL HOLD NO. OF DATA WORDS
$)
UNTIL D=0 DO
$(
SWITCHON H2!D INTO
$( CASE S.DATALAB: SETLAB(H3!D); ENDCASE
CASE S.ITEML: $( LET IL = NEXTPARAM()
CODE(0, IL) // REFER TO DESCRIPTOR
//*<3032
LISTL(" DW L%N", IL)
/*3032>*/
SETLAB(IL)
$)
CASE S.GLOBAL: CODE(0, H3!D)
CODE(0, 0) // GETS FILLED IN WITH SEG BY LOADSEG
//*<3032
LISTL(" DW L%N", H3!D)
LISTL(" DW 0 SEG")
/*3032>*/
ENDCASE
CASE S.ITEMN: CODE(H3!D, 0)
//*<3032
LISTAT(S.ITEMN, H3!D)
/*3032>*/
ENDCASE $)
D := !D $)
$( DSIZE := (STVP-P)>>1
PWABO(STV, P, DSIZE) //FILL IN DATA SECTION SIZE
$)
$)1
AND INITDATALISTS() BE
$(1 REFLIST := 0
REFLISTE := @REFLIST
DLIST := 0
DLISTE := @DLIST
$)1
AND CHECKSPACE() BE IF STV+STVP/2-DP>0 DO
CGERROR("PROGRAM TOO LARGE*
* %N WORDS COMPILED",TRUE, STVP)
// CONSTRUCT 2ND BYTE OF MANY INSTRUCTIONS
// FORMAT IS (MOD. MID. DSP) ([2 3 3]) BITS
AND CONSB2(MID, RM, DSP) = VALOF
$( LET MOD = RM=M.REG -> #300,
RM=M.LAB -> 0,
RM=M.LOC & DSP=0 -> #100,
DSP=0 -> 0,
SMALLNUM(DSP) -> #100, #200
RESULTIS MOD + (MID<<3) +
(RM=M.LAB -> M.LOC, RM=M.REG -> DSP, RM)
$)
AND CODEDISP(M, V) BE
$( IF M=M.LAB DO $( CODE(0, V); RETURN $)
UNLESS M=M.REG | (V=0 & M~=M.LOC) DO
TEST SMALLNUM(V) DO CODEB(V)
OR CODE(V, 0)
$)
AND EVEN() BE
UNLESS ISEVEN() DO
$( CHECKBREFS(1)
IF ISEVEN() RETURN
//*<3032
LISTL("NOP")
/*3032>*/
CODEB(F.NOP)
$)
AND SMALLNUM(I) = -128 <= I <= 127
// PUT WORD AT BYTE OFFSET IN VECTOR (STRANGE SIMULATION OF
// 16 BIT WORDS! )
AND PWABO(V, OT, W) BE
$(P LET P = OT/2
TEST (OT & 1)=0 DO
V!P := ((W&255)<<8)|((W𫓸)>>8)
OR
$( V!P := (V!P & #177400) | (W & 255)
V!(P+1) := (V!(P+1) & #377) | (W & #177400)
$)
$)P
// ADD WORD AT BYTE OFFSET
AND ADDABO(V, OT, W) BE
$(A LET P = OT/2
LET T = ?
TEST (OT & 1)=0 DO
T := (V!P>>8) | ((V!P&255)<<8)
OR
T := (V!P & 255) | (V!(P+1) & #177400)
PWABO(V, OT, T+W)
$)A
.