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&#177400)>>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
.