SECTION "CG6"
GET "CGHDR"
// COMPILES CODE FOR SWITCHON
// N = NO. OF CASES
// D = DEFAULT LABEL
LET CGSWITCH(N) BE
$(1 LET D = RDL()
LET V = GETVEC(2*N+1)
IF V=0 DO CGERROR("RUN OUT OF STORE",TRUE)
CASEK, CASEL := V, V+N
// READ AND SORT (K,L) PAIRS
FOR I = 1 TO N DO
$( LET A = RDN()
LET L = RDL()
LET J = I-1
UNTIL J=0 DO
$( IF A > CASEK!J BREAK
CASEK!(J+1) := CASEK!J
CASEL!(J+1) := CASEL!J
J := J - 1 $)
CASEK!(J+1), CASEL!(J+1) := A, L $)
CGPENDINGOP(V.R0)
STORE(0, SSP-2)
MOVETOR(ARG1,R0)
STACK(SSP-1)
UNLESS N=0 DO
// CARE WITH OVERFLOW !
TEST 2*N-6 > CASEK!N/2-CASEK!1/2
THEN LSWITCH(1, N, D)
OR $( BSWITCH(1, N, D)
GENBRANCH(F.JMP, D) $)
FREEVEC(V)
$)1
// BINARY SWITCH
AND BSWITCH(P, Q, D) BE TEST Q-P>6
THEN $( LET M = NEXTPARAM()
LET T = (P+Q)/2
GENRS(F.CMP, R0, K.NUMB, CASEK!T)
GENBRANCH(F.JGE,M)
BSWITCH(P, T-1, D)
GENBRANCH(F.JMP,D)
GENBREFJUMPS(50,0)
SETLAB(M)
INCODE := TRUE
GENBRANCH(F.JE,CASEL!T)
BSWITCH(T+1, Q, D) $)
ELSE FOR I = P TO Q DO
$( GENRS(F.CMP,R0,K.NUMB,CASEK!I)
GENBRANCH(F.JE,CASEL!I) $)
// LABEL VECTOR SWITCH
AND LSWITCH(P,Q,D) BE
$(1 LET L = NEXTPARAM()
GENRS(F.SUB,R0,K.NUMB,CASEK!P)
GENBRANCH(F.JL,D)
GENRS(F.CMP,R0,K.NUMB,CASEK!Q-CASEK!P)
GENBRANCH(F.JG,D)
GENSHIFT(F.SHL, 1, K.REG, R0)
CHECKBREFS(6)
CODEB(#X2E) // CODE SEGMENT OVERRIDE PREFIX
//*<3032
LISTL("JI label %N(BX)", L)
/*3032>*/
CODE(#123777, 0) // JI L(BX)
CODE(0, L)
INCODE := FALSE
GENBREFJUMPS(((CASEK!Q-CASEK!P)*2+50),0)
SETLAB(L)
FOR K=CASEK!P TO CASEK!Q TEST CASEK!P=K
THEN $(
//*<3032
LISTAT(S.ITEML, CASEL!P)
/*3032>*/
CODE(0, CASEL!P)
P := P+1 $)
ELSE CODE(0, D)
$)1
// CHECKS THAT AT LEAST N CONSECUTIVE BYTES
// MAY BE COMPILED WITHOUT ANY BRANCH REFS
// GOING OUT OF RANGE
AND CHECKBREFS(N) BE
$(
UNLESS BREFV=BREFP |
BREFV!1+129-N-(BREFP-BREFV)*2>=STVP DO
TEST INCODE
THEN $( LET L = NEXTPARAM()
BRLABREF(L, STVP+1)
CODEB(F.B)
CODEB(0)
GENBREFJUMPS(N+50,0)
SETLAB(L) $)
ELSE GENBREFJUMPS(N+50,0)
$)
// GENERATES JUMPS TO FILL IN ENOUGH BRANCH
// REFS TO ENSURE THAT AT LEAST N BYTES MAY
// BE COMPILED, GIVEN THAT LABEL X IS TO BE
// DEFINED AS THE NEXT LOCATION
AND GENBREFJUMPS(N,X) BE
$( LET P = BREFV
UNTIL P=BREFP |
P!1+129-N-(BREFP-BREFV)*2>=STVP DO
$( IF P!0=X DO // LEAVE REFS TO X
$( P := P+2
LOOP $)
IF BREFV!0=X DO // CHECK X STILL IN RANGE
$( UNLESS BREFV!1+126>STVP DO
$( GENBREFJUMPS(N,0)
RETURN $)
$)
$( LET L=P!0
SETLAB(L) // TO FILL IN BRANCH REFS
LABV!L := -1 // THEN UNSET L AGAIN
//*<3032
IF CGLISTING DO WRITES(" !!!")
LISTL("JMP L%N", L)
/*3032>*/
CODEB(#351) // JMP
CODE(-STVP-2, -L) // GIVES CORRECT DISP. WHEN SECTION OUTPUT
$)
$)
$)
// GENERATE A LABEL REF FOR A BRANCH INSTR
AND BRLABREF(L, A) BE
$( BREFP!0, BREFP!1 := L, A
BREFP := BREFP + 2 $)
AND CONDBRFN(OP) = VALOF SWITCHON OP INTO
$( CASE S.EQ: RESULTIS F.JE
CASE S.NE: RESULTIS F.JNE
CASE S.GR: RESULTIS F.JG
CASE S.LE: RESULTIS F.JLE
CASE S.GE: RESULTIS F.JGE
CASE S.LS: RESULTIS F.JL
DEFAULT: RESULTIS 0
$)
AND GENBRANCH(F, L) BE IF INCODE DO
$(1 LET A = LABV!L
CHECKBREFS(4)
IF A=-1 DO // LABEL IS UNSET
$( BRLABREF(L, STVP+1)
//*<3032
LISTL("%S L%N", SF(F), L)
/*3032>*/
CODEB(F)
CODEB(0)
IF F=F.JMP DO INCODE := FALSE
RETURN $)
IF STVP-A > 126 DO // BACK JUMP TOO FAR FOR BR
$( LET M = ?
IF F=F.JMP DO
$(
//*<3032
LISTL("JMP L%N", L)
/*3032>*/
CODEB(#351) // JMP
CODE(-STVP-2, -L)
INCODE := FALSE
RETURN $)
F := F NEQV 1
M := NEXTPARAM()
GENBRANCH(F, M)
//*<3032
LISTL("JMP L%N", L)
/*3032>*/
CODEB(#351) // JMP
CODE(-STVP-2, -L)
GENBREFJUMPS(50,M)
SETLAB(M)
RETURN $)
// IT MUST BE A SHORT BACKWARD JUMP
//*<3032
LISTL("%S L%N", SF(F), L)
/*3032>*/
CODEB(F)
CODEB(A-STVP-1)
IF F=F.JMP DO INCODE := FALSE
$)1
// GENERATE A MOV INSTR; WILL CALCULATE LVALUES
AND GENMOV(K1,N1,K2,N2) BE UNLESS K1=K2 & N1=N2 DO
$(1 LET M1,V1 = 0,0
LET R=LOOKINREGS(K1,N1)
IF R>=0 DO K1,N1 := K.REG,R
UNLESS K1=K2 & N1=N2 DO
$( IF (K1=K.LOC | K1=K.LAB | K1=K.GLOB) &
(K2=K.LOC | K2=K.LAB | K2=K.GLOB) DO
$( LET R = NEXTR(-1)
GENMOV(K1, N1, K.REG, R)
K1, N1 := K.REG, R
$)
SWITCHON K1 INTO
$( CASE K.LVLOC:
M1, V1 := M.LOC, 2*N1
GOTO L
CASE K.LVGLOB:
M1, V1 := M.GLOB, 2*N1
GOTO L
CASE K.LVLAB:
M1, V1 := M.LAB, N1
L: FORMDADDR(K2, N2)
TEST ADDR.M=M.REG DO
$(
//*<3032
LISTGEN("LEA", M.REG, ADDR.V, M1, V1)
/*3032>*/
CODERS(F.LEA, N2, M1, V1)
$)
OR
$( TEST M1=M.LAB DO
$(
//*<3032
LISTGEN(SF(F.MOVIMMTRM), ADDR.M, ADDR.V, M.LAB, V1)
/*3032>*/
CODEKD(F.MOVIMMTRM, 0, ADDR.M, ADDR.V)
LABREF(V1, STVP-2) // FOR LABEL FILLING
$)
OR
$( LET R = M1=M.LOC -> R.BP, R.DI
//*<3032
LISTGEN(SF(F.MOVRTRM),ADDR.M,ADDR.V,M.REG,TRANR(R))
/*3032>*/
CODERD(F.MOVRTRM, R, ADDR.M, ADDR.V)
//*<3032
LISTGEN("ADD",ADDR.M,ADDR.V,M.IMM,V1)
/*3032>*/
CODEKD(F.ADD,V1,ADDR.M,ADDR.V)
$)
$)
//*<3032
LISTGEN("SHR", ADDR.M, ADDR.V, 0)
/*3032>*/
CODED(F.SHR, ADDR.M, ADDR.V)
ENDCASE
CASE K.NUMB:
FORMDADDR(K2, N2)
IF N1=0 & ADDR.M=M.REG DO
$(
//*<3032
LISTGEN("XOR", M.REG, ADDR.V, M.REG, ADDR.V)
/*3032>*/
CODERD(F.XOR, N2, ADDR.M, ADDR.V)
ENDCASE
$)
IF ADDR.M=M.REG DO
$( CHECKBREFS(4)
//*<3032
LISTGEN(SF(F.MOVIMMTR), M.REG, ADDR.V, M.IMM, N1)
/*3032>*/
CODEB(F.MOVIMMTR | TRANR(N2))
CODE(N1, 0)
ENDCASE
$)
//*<3032
LISTGEN(SF(F.MOVIMMTRM),ADDR.M,ADDR.V,M.IMM,N1)
/*3032>*/
CODEKD(F.MOVIMMTRM, N1, ADDR.M, ADDR.V)
ENDCASE
DEFAULT:
TEST K1=K.REG DO
$( FORMDADDR(K2, N2)
//*<3032
LISTGEN(SF(F.MOVRTRM),ADDR.M,ADDR.V,M.REG,TRANR(N1))
/*3032>*/
CODERD(F.MOVRTRM, N1, ADDR.M, ADDR.V)
$)
OR
$( FORMSADDR(K1, N1)
UNLESS K2=K.REG DO CGERROR("K2 NOT A REG. *
* IN GENMOV %N", TRUE, K2)
//*<3032
LISTGEN(SF(F.MOVRTRM),M.REG,TRANR(N2),ADDR.M,ADDR.V)
/*3032>*/
CODERS(F.MOVRTRM, N2, ADDR.M, ADDR.V)
$)
$)
$)
REMEM(K1, N1, K2, N2)
$)1
AND GENSHIFT(F, B, K, N) BE
$( //F IS ANOTHER ONE OF THOSE 11 BIT OBJECTS
LET V = B=0 -> #20, 0
FORMDADDR(K, N)
//*<3032
TEST V=0 THEN LISTGEN(SF(F), ADDR.M, ADDR.V, 0)
OR LISTGEN(SF(F), ADDR.M, ADDR.V, M.REG, TRANR(R.CX))
/*3032>*/
CODED(F|V, ADDR.M, ADDR.V)
$)
AND GENRS(F,R,K,N) BE
$( FORMSADDR(K,N)
IF F=F.CMP GOTO GRL
IF F=F.OR & ADDR.M=M.REG DO
IF ADDR.V=TRANR(R) GOTO GRL
FORGET(K.REG, R)
GRL:
//*<3032
LISTGEN(SF(F),M.REG,TRANR(R),ADDR.M,ADDR.V)
/*3032>*/
CODERS(F,R,ADDR.M,ADDR.V)
$)
AND GENRD(F,R,K,N) BE
$( TEST F=F.CMP DO FORMSADDR(K, N) OR FORMDADDR(K, N)
//*<3032
LISTGEN(SF(F),ADDR.M,ADDR.V,M.REG,TRANR(R))
/*3032>*/
CODERD(F,R,ADDR.M,ADDR.V)
$)
AND GEND(F,K,N) BE
$( FORMDADDR(K, N)
//*<3032
LISTGEN(SF(F), ADDR.M, ADDR.V, 0)
/*3032>*/
CODED(F,ADDR.M,ADDR.V)
$)
AND GENF(F) BE IF INCODE DO
$( CHECKBREFS(2)
//*<3032
LISTL(SF(F))
/*3032>*/
CODEB(F)
$)
// INTERRUPT TYPE N
AND GENINT(N) BE IF INCODE DO
$( CHECKBREFS(3)
//*<3032
LISTL("INT %N", N)
/*3032>*/
CODEB(F.INT)
CODEB(N)
$)
AND GENKD(F, I, K, N) BE
$( LET R = LOOKINREGS(K.NUMB,I)
TEST F=F.CMP THEN FORMSADDR(K,N) OR FORMDADDR(K,N)
TEST R>=0 THEN
$(
//*<3032
LISTGEN(SF(F),ADDR.M,ADDR.V,M.REG,TRANR(R))
/*3032>*/
CODERD(F, R, ADDR.M, ADDR.V)
$)
OR
$(
//*<3032
LISTGEN(SF(F),ADDR.M,ADDR.V,M.IMM,I)
/*3032>*/
CODEKD(F, I, ADDR.M, ADDR.V)
$)
$)
// GENERATE A JI, JIS OR CIS INSTRUCTION;
// ONE EXTRA LEVEL OF INDIRECTION
AND GENJ(F,K,N) BE
$( FORMSADDR(K,N)
CHECKBREFS(4)
//*<3032
LISTGEN(F=F.JI->"JI",F=F.JIS->"JIS","CIS", ADDR.M, ADDR.V, 0)
/*3032>*/
CODEB(#377) // INDIRECT CONTROL TRANSFER
CODEB(CONSB2(F, ADDR.M, ADDR.V))
CODEDISP(ADDR.M, ADDR.V)
IF F=F.JI | F=F.JIS DO INCODE := FALSE
$)
// SWAP BYTES OF '8080' DOUBLE REGISTER
AND GENBYTEXCHG(N) BE
$( LET TN = TRANR(N)
//*<3032
LET S1, S2 = STRINGRB(TN), STRINGRB(TN+4)
/*3032>*/
UNLESS 0 <= TN <= 3 DO
CGERROR("NOT V80 IN GBXG", TRUE)
FORGET(K.REG, N)
CHECKBREFS(2)
//*<3032
LISTL("XCHG %S,%S", S1, S2)
/*3032>*/
CODEB(F.XCHGB)
CODEB(CONSB2(TN, M.REG, TN+4))
$)
// CLEAR L.S. BYTE OF '8080' DOUBLE REGISTER
AND GENCLEARBYTE(N) BE
$( LET TN = TRANR(N)
//*<3032
LET S = STRINGRB(TN)
/*3032>*/
UNLESS 0 <= TN <=3 DO
CGERROR("NOT V80 IN GCLB", TRUE)
FORGET(K.REG, N)
CHECKBREFS(2)
//*<3032
LISTL("XOR %S,%S", S, S)
/*3032>*/
CODEB(F.CLRB)
CODEB(CONSB2(TN, M.REG, TN))
$)
AND GENINCDEC(F, K, N) BE
$( FORMDADDR(K, N)
TEST ADDR.M=M.REG DO
$( CHECKBREFS(1)
//*<3032
LISTGEN(F=F.INC->"INC","DEC", ADDR.M, ADDR.V, 0)
/*3032>*/
CODEB(#100 | (F<<3) | ADDR.V)
$)
OR
$( CHECKBREFS(4)
//*<3032
LISTGEN(F=F.INC->"INC","DEC", ADDR.M, ADDR.V, 0)
/*3032>*/
CODEB(#377)
CODEB(CONSB2(F, ADDR.M, ADDR.V))
CODEDISP(ADDR.M, ADDR.V)
$)
$)
AND GENMULDIV(F, A) BE
$( LET K, N = H1!A, H2!A
FORMSADDR(K, N)
FORGET(K.REG, R.AX)
FORGET(K.REG, R.DX)
CHECKBREFS(4)
//*<3032
LISTGEN(F=F.IMUL->"IMUL","IDIV", ADDR.M, ADDR.V, 0)
/*3032>*/
CODEB(#367)
CODEB(CONSB2(F, ADDR.M, ADDR.V))
CODEDISP(ADDR.M, ADDR.V)
$)
.