SECTION "MCG5"

GET "CG68HDR"

LET cgrv() BE

$(1 LET r = 0

    IF pendingop=s.minus & h1!arg1=k.numb
    THEN pendingop, h2!arg1 := s.plus, -h2!arg1

    IF pendingop=s.plus & (h1!arg1=k.numb | h1!arg2=k.numb)
    $(  LET arg = arg2
        LET n = h2!arg1
        IF h1!arg2=k.numb DO arg, n := arg1, h2!arg2
        n := 4*n
        IF -128<=n<=127 DO
        $( pendingop := s.none
           r := movetoanyrsh.(arg, TRUE)
           lose1(k.ir0+r, n)
           RETURN
        $)
    $)

    cgpendingop()
    r := movetoanyrsh.(arg1, TRUE)
    h1!arg1, h2!arg1 := k.ir0+r, 0
$)1


AND cgglobal(n) BE
$( cgstatics()
   code2(0)
   FOR i = 1 TO n DO $( code2(rdgn()); code2(labv!rdl()) $)
   code2(maxgn)
   IF n=0
   $( CGERROR(0, "****** WARNING: Code cannot be accessed")
      maxgn := 0
   $)
$)


AND cgentry(n,l) BE
$(  LET count   = (CGFLAGS & cgf.callcounting)  ~= 0 |
                  (CGFLAG2 & cgf2.profcount)    ~= 0
    LET name    = (CGFLAGS &  cgf.procnames                        ) ~= 0
    LET lib     = name & (CGFLAG2 & cgf2.library) ~= 0
    LET old.addr= ?

    cnop()
    IF count    $(   code2(0);   old.addr := stvp $)
    IF lib      THEN code2(23456)       // Manifest ..
    cgname(s.entry,n, name)
    setlab(l)
    forgetall()
    IF count $( code(#X52AC); CODE(old.addr - stvp -2) $)
    incode      := TRUE
    countflag   := FALSE
$)


AND cgsave(n) BE
$( FOR r = r1 TO r4 $( LET s = 3+r-r1; IF s>=n BREAK; remem(r, k.loc, s) $)
   initstack(n)
$)


// function or routine call
AND cgapply(op,k) BE
$( LET sa1 = k+3
   LET sa4 = k+6

   cgpendingop()

   // store args 5,6,...
   store(sa4+1, ssp-2)

   // now deal with non-args
   FOR t = tempv TO arg2 BY 3 DO
   $( IF h3!t>=k BREAK
      IF h1!t>=k.reg DO storet(t)
   $)

   // move args 1-4 to arg registers
   FOR t = arg2 TO tempv BY -3 DO
   $( LET s = h3!t
      LET r = s-k-2
      IF s<sa1 BREAK
      IF s<=sa4 & isfree(r) DO movetor(t,r)
   $)
   FOR t = arg2 TO tempv BY -3 DO
   $( LET s = h3!t
      LET r = s-k-2
      IF s<sa1 BREAK
      IF s<=sa4 DO movetor(t,r)
   $)

   // deal with args not in SS
   FOR s = sa1 TO sa4 DO
   $( LET r = s-k-2
      IF s>=h3!tempv BREAK
      IF regusedby(arg1)=r DO movetor(arg1,r7)
      loadt(k.loc,s)
      movetor(arg1,r)
      stack(ssp-1)
   $)

   loadt(k.numb, 4*k)
   movetor(arg1, r0) // put the stack inc in R0
   stack(ssp-1)

   movetoa(rb)                  // MOVE <arg1>,B
   genea(f.jsr, m.2s, 0)        // JSR (S)
   forgetall()
   stack(k)
   IF op=s.fnap DO loadt(k.reg,r1)
$)


AND cgreturn(op) BE
$( cgpendingop()
   IF op=s.fnrn DO
   $( movetor(arg1,r1)
      stack(ssp-1)
   $)
   genea(f.jmp, m.2r, 0)     // JMP (R)
   initstack(ssp)
$)


// used for OCODE operators JT and JF
AND cgcondjump.(b,l,pend) BE
$(1 STATIC $( need.cmp = TRUE; OLD.CODE=0 $)
    LET bfn     = ?
    LET tested  = FALSE
    LET clear.cmp(a) BE $( need.cmp := FALSE;   old.code(a) $)
//; CGERROR(0, "Clear %X4", a) $)
    LET set.cmp(a)   BE $( need.cmp := TRUE;    old.code(a) $)
//; CGERROR(0, "Set %X4", a) $)
//  LET x.cmp(a)     BE $(                      old.code(a) $)
//; CGERROR(0, "gen %X4", a) $)
    old.code    := code
    code        := clear.cmp
    need.CMP    := TRUE

TEST pend = s.none | pendingop = s.none
THEN IF pendingop = s.none
THEN pendingop := pend
ELSE
$(  //  TEST condbfn(pend) = 0          // conditional
    $(  cgpendingop()
        pendingop := pend
    $)

$)
    bfn := condbfn(pendingop)
    IF bfn=0
    $(  LET singlebit   = FALSE

        IF pendingop=s.logand & (arg1!h1 = k.numb | arg2!h1 = k.numb)
        $(  IF arg2!h1 = k.numb THEN swapargs()
            Singlebit := arg1!h2
//          IF singlebit=0 THEN CGERROR(0, "IF (a & 0)   found")
            singlebit := ((singlebit) & (singlebit-1)) = 0      // Can use TST
        $)
        TEST singlebit & (CGFLAG2 & cgf2.opt) ~= 0
        $(  LET bit = 0
            FOR i = 0 TO bitsperword-1 DO IF (1<<i)=arg1!h2 THEN bit := i
            store(0,ssp-3)
            lose1(arg2!h1, arg2!h2)                     // discard number
            ssp         := ssp+1                        // BUT LEAVE SSP ALONE!!

            TEST arg1!h1 = k.reg
            $(  LET r = ((arg1!h2) & 7)
//              CGERROR(0, "WARNING : BTST on bit %N of r %N", bit, r)
                geneaw(f.btst, m.00+r, 0, bit)
                forgetr(r)
            $)
            ELSE
            $(  LET byte = BYTESPERWORD-1 - bit/8
                bit := 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 (arg1!h1=k.loc | arg1!h1=K.glob) & (arg1!h2=3) & (byte ~= 0)
                THEN byte, arg1!h2 := byte-BYTESPERWORD, 4

                formea(arg1!h1, arg1!h2)
//              CGERROR(0, "WARNING : BTST on bit %N, byte %N", bit, ea.d+byte)
                geneaw(f.btst, ea.m, ea.d+byte, bit)
                forgetvar(arg1!h1, arg1!h2)
            $)
            bfn         := f.bne                        //????
            TESTED      := TRUE
            need.cmp    := FALSE

        $)
        ELSE
        $(  cgpendingop()
            loadt(k.numb,0)
            bfn := f.bne
        $)
    $)
    pendingop := s.none
    code := set.cmp
    store(0,ssp-3)              // really ssp-3 ????
    code := old.code
// Can frig around with '<1' == '<=0' etc
    UNLESS b DO bfn := compbfn(bfn)
    UNLESS tested
    DO  TEST need.cmp | (arg2!h1 ~= k.numb) | (arg2!h2 ~= 0)
        THEN bfn := cgcmp(bfn)
        ELSE bfn := swap.cmp(bfn)
//    code := old.code
    genb(bfn,l)
    stack(ssp-2)
    countflag := (CGFLAG2 & cgf2.profcount) ~= 0                        //PBprofcounting
//  code := old.code
$)1


// Compile code to set the condition code to reflect
// the result of <arg2> rel <arg1>.

AND cgcmp(f) =
    cgdyadic(fns.cmp, TRUE, TRUE) = notswapped -> f, swap.cmp(f)

AND swap.cmp(f) =
    f=f.blt -> f.bgt,
    f=f.bgt -> f.blt,
    f=f.ble -> f.bge,
    f=f.bge -> f.ble,
    f

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


