SECTION "MCG4"

GET "CG68HDR"

LET cgdyadic(fns, swappable, mem2) = VALOF

// MEM2 is TRUE if the function is CMP or if an
// assignment is being compiled (in which case the
// function is ADD, SUB, AND or OR).  The destination
// of the assignment is represented by ARG2.
// If MEM2 is FALSE no memory location may be changed,
// and the result of the operation will be
// represented (on return) by ARG2.

// If SWAPPABLE is TRUE the operands may be swapped if
// there is some advantage in doing so.

// The result is SWAPPED if the operands were swapped,
// and NOTSWAPPED otherwise.  SSP is not altered.
// FNS is a vector of 9 elements

// 0  FT.QR  ADDQ SUBQ                     #q,ea   GENQEA
// 1  FT.QM  ADDQ SUBQ                     #q,ea   GENQEA
// 2  FT.RR  ADD  SUB  CMP  AND  OR  EOR   ea,Dn   GENREA
// 3  FT.RM  ADD  SUB       AND  OR  EOR   Dn,ea   GENREA
// 4  FT.IR  ADDI SUBI CMPI ANDI ORI EORI  #ww,Dn  GENWEA
// 5  FT.IM  ADDI SUBI CMPI ANDI ORI EORI  #ww,ea  GENWEA
// 6  FT.MR  ADD  SUB  CMP  AND  OR        ea,Dn   GENREA
// 7  FT.ZR            TST                         GENEA
// 8  FT.ZM            TST                         GENEA

// Empty entries have value -1 indicating that
// that version of the function does not
// exist.
// The register slave is updated appropriately.
$( LET drcl = c.r
   IF fns=fns.cmp DO drcl := c.cr

    IF arg1!h1 = K.numb & arg2!h1 = K.numb
    THEN cgerror(0, "CGdyadic given two constants %N, %N (%N)", arg1!h2, arg2!h2, fns)
//IF (stflags & stf.cgf.opt) = 0        // I.e.FALSE
IF (cgflag2 & cgf2.opt) ~= 0 & arg1!h1 = K.numb &
                        (fns=fns.and | fns=fns.or | fns=fns.eor)
$(  LET bit = (fns=fns.and) -> ~(arg1!h2), arg1!h2
    IF single.bit(bit)
    $(  LET f = (fns=fns.and) -> f.bclr, (fns=fns.or) -> f.bset, f.bchg
        TEST arg2!h1 = k.reg    // Use class ...
        $(  LET r = ((arg2!h2) & 7)
            IF mem2
            THEN cgerror(0, "attempt to set a bit in a slaved register")
            geneaw(f, m.00 + r, 0, log(bit))
            forgetr(r)
            RESULTIS notswapped
        $)
        ELSE IF mem2
        $(  LET byte    = BYTESPERWORD-1 - (log(bit)/8)
            LET cl      = class(arg2)
            bit := log(bit) REM 8
            //  If I've got to add on a byte offset, then force it to use
            //  addressing mode 5 rather than 2 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            IF (arg2!h1 = k.loc | arg2!h1 = K.glob) & (arg2!h2=3) & (byte ~= 0)
            THEN byte, arg2!h2 := byte-BYTESPERWORD, 4

            formea(arg2!h1, arg2!h2)
            geneaw(f, ea.m, ea.d+byte, bit)
            forgetvar(arg2!h1, arg2!h2)
            RESULTIS notswapped
        $)
    $)
$)

   arg1cl := class(arg1)
   IF arg1cl=0 DO
   $( movetoanycr(arg1)
      LOOP
   $)
   arg2cl := class(arg2)
   IF arg2cl=0 DO
   $( movetoanycr(arg2)
      LOOP
   $)

   IF arg1cl=c.m=arg2cl DO
   $( // both unslaved memory operands
      // put the source in a register
      movetoanyr(arg1)
      LOOP
   $)

   IF arg1cl=c.b+c.w DO
   $( // if unslaved byte sized but not quick
      // put in register
      movetoanyr(arg1)
      LOOP
   $)

   IF arg2cl=c.b+c.w DO
   $( // if unslaved byte sized but not quick
      // put in register
      movetoanyr(arg2)
      LOOP
   $)


   fntab := fns

   IF try(mem2, drcl) RESULTIS notswapped

   // If MEM2 is TRUE and the function is
   // ADD SUB AND OR EOR then the above call
   // of TRY will succeed.

   IF swappable DO
   $( swapargs()
      IF try(mem2, drcl) RESULTIS swapped
      swapargs()
   $)

// we have failed to compile anything this
// time round, so let us try to simplify
// the operands and try again.

   IF NOT swappable & NOT mem2 & (arg2cl&c.r)=0 DO
   $( // make SUB ...,Dn possible
      movetoanyr(arg2)
      LOOP
   $)

//  This has been F I X E D !! by IDW & AJW - Mended by PB
   UNLESS (arg2cl & c.w) = 0 UNLESS mem2 & fns ~= fns.cmp
// THEN cgerror(0, "Warning ... c.w ~= 0 BUT mem2") ELSE
   $( movetoanyr(arg2)  // mem2 = FALSE
      LOOP
   $)

   UNLESS (arg1cl & c.w) = 0 DO
   $( movetoanyr(arg1)
      LOOP
   $)

//  This has also been F I X E D !! by IDW & AJW - Mended by PB
   IF (arg2cl & c.r) = 0
   UNLESS mem2 & fns ~= fns.cmp
// THEN cgerror(0, "Warning ... c.r ~= 0 BUT mem2") ELSE
   $( movetoanyr(arg2)  // mem2 = FALSE
      LOOP
   $)

   IF (arg1cl & c.r) = 0 DO
   $( movetoanyr(arg1)
      LOOP
   $)

//debug   bug(1)
cgerror(0, "Error in cgdyadic [argcl=%X8, %X8, %S]",
                                        arg1cl, arg2cl, mem2 -> "TRUE", "FALSE")
ABORT(1002,1002)
   RESULTIS notswapped
$) REPEAT

AND single.bit(x) = (x~=0) & (x & (x-1))=0

AND try(mem2, drcl) =

// try to compile an instruction for
// ARG2 op ARG1
// the result is TRUE iff successful
// FNTAB holds the function codes for op
// ARG1CL and ARG2CL are already setup
    match(ft.qr,         c.q,   c.r)    |
    match(ft.rr,         c.cr,  drcl)   |
    mem2 & match(ft.qm,  c.q,   c.m)    |
    match(ft.mr,         c.m,   drcl)   |
    mem2 & match(ft.rm,  c.cr,  c.m)    |
    match(ft.zr,         c.z,   drcl)   |
    mem2 & match(ft.zm,  c.z,   c.m)    |
    // only use immediate instructions
    // if the constant is larger than a byte
    match(ft.ir,         c.w,   drcl)   |
    mem2 & match(ft.im,  c.w,   c.m)    -> TRUE, FALSE


AND match(ft.entry, cl1, cl2) = VALOF

// Compile an instruction if the operands match
// the required classifications CL1 and CL2 and
// the corresponding function code exists.
// If the destination is a register that is
// updated, FORGETR is called and ARG2 updated
// appropriately.
// FNTAB will contain function code variations
// for one of the following:
//    ADD  SUB  CMP  AND  OR  EOR
// The state of the register slave is updated
// if any instruction is compiled.
$( LET f = fntab!ft.entry
   LET k1, n1, k2, n2 = ?, ?, ?, ?
   LET s, r = ?, ?

///* DEBUG */  writef("MATCH(%N,%X4, %X4) ARG1CL=%X4 ARG2CL=%X4*N",
///* DEBUG */          ft.entry, cl1, cl2, arg1cl, arg2cl)

   IF f=-1 |
      (arg1cl & cl1) \= cl1 |
      (arg2cl & cl2) \= cl2 RESULTIS FALSE

   IF cl1=c.w DO
      // check that the constant is larger than a byte
      UNLESS (arg1cl & c.b) = 0 RESULTIS FALSE
///* DEBUG */  writes( "Successful match.*N" )

   // The match was successful so compile
   // an instruction.
   k1, n1 := h1!arg1, h2!arg1
   k2, n2 := h1!arg2, h2!arg2

   IF cl1=c.cr DO s := choosereg(arg1cl&c.regs)
   IF cl2=c.cr DO r := choosereg(arg2cl&c.regs)
   IF cl2=c.r  DO r := n2 & 7

   SWITCHON ft.entry INTO
   $( CASE ft.qr: // the function is ADDQ or SUBQ
           IF n1=0 ENDCASE
           IF n1<0 DO n1, f := -n1, f.addq+f.subq-f
           genqea(f, n1, m.00+r, 0)
           ENDCASE

      CASE ft.qm: // the function is ADDQ or SUBQ
           IF n1=0 ENDCASE
           IF n1<0 DO n1, f := -n1, f.addq+f.subq-f
           formea(k2, n2)
           genqea(f, n1, ea.m, ea.d)
           r := -1
           ENDCASE

      CASE ft.zr: // the function is CMP (actually TST)
           genea(f, m.00+r, 0)
           ENDCASE

      CASE ft.zm: // the function is CMP (actually TST)
           formea(k2, n2)
           genea(f, ea.m, ea.d)
           r := -1
           ENDCASE

      CASE ft.rr:
           TEST f=f.eor
           THEN genrea(f, s, m.00+r, 0)
           ELSE genrea(f, r, m.00+s, 0)
           ENDCASE

      CASE ft.rm:
           formea(k2, n2)
           genrea(f, s, ea.m, ea.d)
           r := -1
           ENDCASE

      CASE ft.ir:
           genwr(f, n1, r)
           ENDCASE

      CASE ft.im:
           formea(k2, n2)
           genwea(f, n1, ea.m, ea.d)
           r := -1
           ENDCASE

      CASE ft.mr:
           formea(k1, n1)
           genrea(f, r, ea.m, ea.d)
           ENDCASE

      DEFAULT:
        CGERROR(0, "Match failed")
//debug bug(5)
   $)

   UNLESS fntab=fns.cmp TEST r>=0
   THEN forgetr(r)
   ELSE forgetvar(k2, n2)

//debug   IF debug>5 DO dboutput(3)

   RESULTIS TRUE
$)

AND swapargs() BE
$( LET k, n, cl = h1!arg1, h2!arg1, arg1cl
   h1!arg1, h2!arg1, arg1cl := h1!arg2, h2!arg2, arg2cl
   h1!arg2, h2!arg2, arg2cl := k, n, cl
$)


AND initftables() BE
$( fns.add := TABLE
#X5080,#X5080,#XD080,#XD180,#X0680,#X0680,#XD080,    -1,    -1
//  QR     QM     RR     RM     IR     IM     MR     ZR     ZM

   fns.sub := TABLE
#X5180,#X5180,#X9080,#X9180,#X0480,#X0480,#X9080,    -1,    -1
//  QR     QM     RR     RM     IR     IM     MR     ZR     ZM

   fns.cmp := TABLE
    -1,    -1,#XB080,    -1,#X0C80,#X0C80,#XB080,#X4A80,#X4A80
//  QR     QM     RR     RM     IR     IM     MR     ZR     ZM

   fns.and := TABLE
    -1,    -1,#XC080,#XC180,#X0280,#X0280,#XC080,    -1,    -1
//  QR     QM     RR     RM     IR     IM     MR     ZR     ZM

   fns.or  := TABLE
    -1,    -1,#X8080,#X8180,#X0080,#X0080,#X8080,    -1,    -1
//  QR     QM     RR     RM     IR     IM     MR     ZR     ZM

   fns.eor := TABLE
    -1,    -1,#XB180,#XB180,#X0A80,#X0A80,    -1,    -1,    -1
//  QR     QM     RR     RM     IR     IM     MR     ZR     ZM

$)

AND movetoanyrsh.(a) = VALOF
$( LET r = -1

   SWITCHON h1!a INTO
   $( CASE k.loc:
      CASE k.glob:
      CASE k.lab:
      CASE k.lvloc:
      CASE k.lvglob:
      CASE k.lvlab: h1!a := h1!a + k.sh
                    ENDCASE

      CASE k.numb:  h2!a := h2!a * 4
                    ENDCASE

      DEFAULT:      r := movetoanyr(a)
                    genshkr(f.lslkr, 2, r)
                    forgetr(r)
   $)

   IF r<0 DO r := movetoanyr(a)
   RESULTIS r
$)

// Get A in a data register for use as a
// source operand.
// No data registers will change before it is used
AND movetoanycr(a) = VALOF
$( LET cl = class(a)
   LET poss = cl & c.regs
   IF poss=0 RESULTIS movetoanyr(a)
   RESULTIS choosereg(poss)
$)

// move a SS item into any data register
AND movetoanyr(a) = VALOF
$( LET usedregs = regsinuse()
   LET poss = ?

   // is A already in a register?
   IF h1!a=k.reg RESULTIS h2!a

   // slaved registers that are free
   poss := class(a) & c.regs & NOT usedregs
   UNLESS poss=0 RESULTIS movetor(a, choosereg(poss))

   // suitable regs with no info that are free
   poss := c.regs & NOT (usedregs | regswithinfo())
   UNLESS poss=0 RESULTIS movetor(a, choosereg(poss))

   // suitable regs that are free
   poss := c.regs & NOT usedregs
   UNLESS poss=0 RESULTIS movetor(a, choosereg(poss))

   // If A is of form K.IRr
   // then move it to Dr.
   IF h1!a>=k.ir0 RESULTIS movetor(a, h1!a & 7)

   // all registers are in use
   // so free the oldest
   FOR t = tempv TO arg1 BY 3
       IF regusedby(t)>=0 DO
       $( storet(t)
          BREAK
       $)
   // The situation is now better so try again
$) REPEAT


// move a SS item A into data register Dr

AND movetor(a,r) = VALOF
$( LET k, n = h1!a, h2!a
   LET cl = ?

   // is A already where required?
   IF k=k.reg & n=r RESULTIS r

   // free register R if necessary
   UNLESS regusedby(a)=r DO
   $( freereg(r)
      k, n := h1!a, h2!a
   $)

   cl := class(a)

   IF cl=0 SWITCHON h1!a INTO
   $( CASE k.lvlocsh:
      CASE k.lvloc: n := n-3
      CASE k.lvglobsh:
      CASE k.lvglob:n := 4*n // convert to byte address
                 $( LET oldn = H2!a
                    LET ms = m.10 + (k&7)  // (P) or (G)
                    TEST n=0
                    THEN geneaea(f.movel, ms, 0, m.00+r, 0)
                    ELSE $( h1!a, h2!a := k.numb, n
                            movetor(a, r)
                            // compile   ADD P,Dr  or   ADD G,Dr
                            genrea(fns.add!ft.mr, r, ms, 0)
                         $)
                    n := oldn  // Restore n for remem
                 $)
           shret:   IF (k&k.sh)=0 DO
                       genshkr(f.lsrkr, 2, r)
                    GOTO ret

      CASE k.lvlabsh:
      CASE k.lvlab: formea(k.lab, n)
                    genrea(f.lea, rl, ea.m, ea.d)
                    numbinl := 0  // value in L unknown
                    geneaea(f.movel, m.1l, 0, m.00+r, 0)
                    GOTO shret

      CASE k.locsh:
      CASE k.globsh:
      CASE k.labsh: h1!a := h1!a - k.sh
                    movetor(a, r)
                    genshkr(f.lslkr, 2, r)
                    GOTO ret

      DEFAULT:  cgerror(0, "Bug 9 movetor")
//debug      bug(9)

   $)

   UNLESS (cl & c.cr) = 0 DO // value already in a register
   $( LET s = choosereg(cl & c.regs)
      IF (cl>>r & 1) = 0 DO
      $( // move only if necessary
         geneaea(f.movel, m.00+s, 0, m.00+r, 0)
         moveinfo(s, r)
      $)
      GOTO ret
   $)

   UNLESS (cl & c.b) = 0 DO  // a byte constant
   $( genmoveq(n&#XFF, r)
      GOTO ret
   $)

   formea(k, n)
   geneaea(f.movel, ea.m, ea.d, m.00+r, 0)

ret: forgetr(r)
     remem(r, k, n)
     h1!a, h2!a := k.reg, r
     RESULTIS r
$)

// move ARG1 to Ar
AND movetoa(r) BE
$( LET k, n, s = h1!arg1, h2!arg1, -1
   LET cl = class(arg1)

   UNLESS (cl & c.cr) = 0 DO // value is in a data register
      s := choosereg(cl & c.regs)

   IF s=-1 SWITCHON k INTO
   $( CASE k.lvlocsh:
      CASE k.lvglobsh:
                    formea(k&7, n)
                    genrea(f.lea, r, ea.m, ea.d)
                    RETURN

      CASE k.lvlabsh:
                    formea(k.lab, n)
                    genrea(f.lea, r, ea.m, ea.d)
                    RETURN


      CASE k.numb:  // use a D register for a byte constant
                    UNLESS (cl & c.b)=0 ENDCASE
                    formea(k.numb, n)
                    genrea(f.lea, r, ea.m, ea.d)
                    RETURN

      CASE k.loc:
      CASE k.glob:
      CASE k.lab:   formea(k, n)
                    geneaea(f.movel, ea.m, ea.d, m.10+r, 0)
                    RETURN

      DEFAULT:

   $)

   IF s=-1 DO s := movetoanycr(arg1)

   // compile  MOVEA.L Ds,Ar
   geneaea(f.movel, m.00+s, 0, m.10+r, 0)
$)


// find which register, if any, is used by
// an SS item
AND regusedby(a) = VALOF
$( LET k=h1!a
   IF k<k.reg RESULTIS -1
   IF k=k.reg RESULTIS h2!a
   RESULTIS k-k.ir0
$)


AND isfree(r) = VALOF
$( FOR t=tempv TO arg1 BY 3 DO
      IF regusedby(t)=r RESULTIS FALSE
   RESULTIS TRUE
$)


// Free register R by storing the SS item (if any)
// that depends on it.
AND freereg(r) BE FOR t=tempv TO arg1 BY 3 DO
                    IF regusedby(t)=r DO
                    $( storet(t)
                       BREAK
                    $)


// store the value of a SS item in its true
// stack location
// it uses CGDYADIC and preserves PENDINGOP
AND storet(a) BE UNLESS h2!a=h3!a & h1!a=k.loc DO
$( LET ak, an, s = h1!a, h2!a, h3!a
   LET pendop = pendingop
   pendingop := s.none
   h1!a, h2!a := k.loc, s
   loadt(k.loc, s)
   loadt(ak, an)
   cgmove()
   stack(ssp-2)
   pendingop := pendop
$)


// load an item (K,N) onto the SS
AND loadt(k, n) BE
$( cgpendingop()
   TEST arg1+3 >= tempt
   THEN cgerror(0, "SIMULATED STACK OVERFLOW")
   ELSE arg1, arg2 := arg1+3, arg2+3

   h1!arg1,h2!arg1,h3!arg1 := k,n,ssp
   ssp := ssp + 1
   IF maxssp<ssp DO maxssp := ssp
//debug   IF debug>6 DO dboutput(3)
$)


// replace the top two SS items by (K,N)
AND lose1(k, n) BE
$( ssp := ssp - 1
   TEST arg2=tempv
   THEN $( h1!arg2,h2!arg2 := k.loc,ssp-2
           h3!arg2 := ssp-2
        $)
   ELSE arg1, arg2 := arg1-3, arg2-3
   h1!arg1, h2!arg1, h3!arg1 := k,n,ssp-1
$)

AND cgslctst() BE
$(  LET size    = rdn()
    LET shift   = rdn()
    LET offset  = rdn()
    LET r       = ?
    LET oldop   = ?

    IF size = 0 THEN size := BITSPERWORD - size
    IF size+shift > BITSPERWORD THEN cgerror(10, "Invalid Selector")

    UNLESS offset=0
    $(  cgpendingop()
        loadt(K.numb, offset)
        pendingop := s.plus
    $)
    cgpendingop()
//---------------------- Arg1 now is the address of the word -------------------
    swapargs()
    oldop := pendingop
    storet(arg2)
    loadt(arg2!h1, arg2!h2)
//---------------------- Save address in arg3, while we look at the value ------
    cgrv()                              // The value ......
//    IF size=1 & arg2!h1 = k.numb THEN CGERROR(0, "Optimise to set/clr bit")

//NO.................UNLESS size=BITSPERWORD..........// Mask out the junk .....
//NO.................UNLESS size=BITSPERWORD..........// Mask out the junk .....
//NO.................UNLESS size=BITSPERWORD..........// Mask out the junk .....
//NO.................UNLESS size=BITSPERWORD..........// Mask out the junk .....
    $(
        cgpendingop()
        loadt(K.numb, (-1 << (shift + size)) | (-1 >> (bitsperword-shift)) )
        pendingop := s.logand
    $)
    cgpendingop()
//---------------------- Arg1 is the old part, Arg2 the new --------------------
    swapargs()                  // Now process the data
    UNLESS size=BITSPERWORD
    $(
        loadt(K.numb, (1<<size) -1)
        pendingop := s.logand
        cgpendingop()
    $)
    UNLESS shift=0
    $(  loadt(K.numb, shift)
        pendingop := s.lshift
        cgpendingop()
    $)
//---------------------- Now just OR arg1 and arg2 -----------------------------
    pendingop := s.logor
    cgpendingop()
    swapargs()
//---------------------- In case it was a simple operator ... ------------------
//    pendingop := oldop
    cgstind()
$)

AND cgslctap() BE               // size : bit offset : word offset
$(  LET size    = rdn()
    LET shift   = rdn()
    LET offset  = rdn()
    LET r       = ?

    IF size = 0 THEN size := BITSPERWORD - size
    IF size+shift > BITSPERWORD THEN cgerror(10, "Invalid Selector")

    UNLESS offset=0
    $(  cgpendingop()
        loadt(K.numb, offset)
        pendingop := s.plus
    $)
    cgrv()                      // The value ......
    UNLESS shift=0
    $(  cgpendingop()
        loadt(K.numb, shift)
        pendingop := s.rshift
    $)
    UNLESS size=BITSPERWORD
    $(  cgpendingop()
        loadt(K.numb, (1<<size) -1)
        pendingop := s.logand
    $)
    cgpendingop()               // Well .....
$)


AND cgbyteap(op) BE
$(1 LET byte    = op=s.putbyte | op=s.getbyte
    LET put     = op=s.putbyte | op=s.puthalfword
    cgpendingop()

 $( LET r = movetoanyrsh.(arg2)
    LET i = h2!arg1
    TEST h1!arg1=k.numb & ( byte -> (-128<=i<=127), (-64 <= i <= 63) )
    THEN UNLESS byte DO i := i*2
    ELSE
    $(  UNLESS byte TEST arg1!h1 = k.numb
        THEN h2!arg1 := i*2
        ELSE
        $(  LET r = movetoanyr(arg1)
            genshkr(f.lslkr, 1, r)
            forgetr(r)
        $)
        cgdyadic(fns.add, TRUE, FALSE)
        i := 0
    $)
    stack(ssp-1)
    // just to make certain
    r := movetoanyr(arg1)
    h1!arg1, h2!arg1 := k.ir0+r, i
    // ARG1 now represents the address of the
    // (di)byte in mode 6 addressible form.

    TEST PUT
    $(  LET m, d = 0, 0
        TEST h1!arg2=k.loc | h1!arg2=k.glob
        $(  formea(h1!arg2, h2!arg2)
            m, d := ea.m, ea.d + (byte -> 3, 2)
            IF m=m.2p DO m := m.5p
            IF m=m.2g DO m := m.5g
        $)
        ELSE m, d := m.00+movetoanycr(arg2), 0
        formea(h1!arg1, h2!arg1)
        // the address in EA.M and EA.D will not use L
        geneaea(byte -> f.moveb, f.movew, m, d, ea.m, ea.d)
        forgetvars()
        stack(ssp-2)
     $)
    ELSE
    $(  loadt(k.numb, 0)
        r := movetoanyr(arg1)
        formea(h1!arg2, h2!arg2)
        // byte assignment to a data register
        // does not extend the sign
        geneaea(byte -> f.moveb, f.movew, ea.m, ea.d, m.00+r, 0)
        forgetr(r)
        lose1(k.reg, r)
    $)
 $)
$)1

// compile code to move <arg1> to <arg2>
// where <arg2> represents a memory location
AND cgmove() BE
$( LET k, n = h1!arg2, h2!arg2
   LET m, d = -1, 0
   LET cl = class(arg1)

   UNLESS (cl&c.cr)=0 DO
      m := m.00+choosereg(cl, c.regs)

   IF m=-1 & (cl&c.b)\=0 DO
   $( IF h2!arg1=0 DO
      $( // use CLR instruction
         formea(k, n)
         genea(f.clr, ea.m, ea.d)
         forgetvar(k, n)
         RETURN
      $)
      // otherwise take advantage of MOVEQ
      m := m.00+movetoanycr(arg1)
   $)

   IF m=-1 & (cl&c.m+c.w)\=0 THEN
      UNLESS formea(h1!arg1, h2!arg1) DO
          // provided <arg1> address does not use L
          m, d := ea.m, ea.d
   IF m=-1 DO m := m.00+movetoanyr(arg1)

   formea(k, n)
   geneaea(f.movel, m, d, ea.m, ea.d)
   forgetvar(k, n)
   IF 0<=m<=7 DO remem(m, k, n) // M is D reg direct mode
$)


AND cgstind() BE
$( cgrv()
   swapargs()
   cgmove()
   stack(ssp-2)
$)


// store the top item of the SS in (K,N)
// K is K.LOC, K.GLOB or K.LAB
AND storein(k, n) BE
$(1 LET b = (h1!arg1=k & h2!arg1=n) -> 1,
            (h1!arg2=k & h2!arg2=n) -> 2, 0
    LET pendop = pendingop

    IF b=0 GOTO gencase

    pendingop := s.none
    SWITCHON pendop INTO

    $(2 DEFAULT:
        gencase: pendingop := pendop
                 cgpendingop()

        CASE s.none:
                 loadt(k, n)
                 swapargs()
                 cgmove()
                 ENDCASE

        CASE s.neg:
        CASE s.not:
                 UNLESS b=1 GOTO gencase
                 formea(k, n)
                 genea((pendop=s.neg -> f.neg, f.not),
                       ea.m, ea.d)
                 forgetvar(k, n)
                 stack(ssp-1)
                 RETURN

        CASE s.plus:
                 IF b=1 DO swapargs()
                 cgdyadic(fns.add, FALSE, TRUE)
                 ENDCASE

        CASE s.minus:
                 UNLESS b=2 GOTO gencase
                 cgdyadic(fns.sub, FALSE, TRUE)
                 ENDCASE

        CASE s.logor:
                 IF b=1 DO swapargs()
                 cgdyadic(fns.or,  FALSE, TRUE)
                 ENDCASE

        CASE s.logand:
                 IF b=1 DO swapargs()
                 cgdyadic(fns.and, FALSE, TRUE)
                 ENDCASE

    $)2
    stack(ssp-2)
$)1

AND log(bit) = VALOF
$(  FOR I = 0 TO BITSPERWORD-1 DO IF (1<<i) = bit THEN resultis i
    RESULTIS 0
$)

AND geneaw(f, m, d, w) BE IF incode DO
$( LET instr = f | (m&#77)
   insertcount()
   code(instr)
   code(w)
   genrand(m, d)
$)


