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)
$)

.