SECTION "CGK"

GET "b.CgHeader"
GET "b.Fp2Ops"

STATIC {
/* Floating point operations for ARM CG
   Version of  11 Sep 87 13:40:51
*/
   dummy = VersionMark;
   version = 1*256+5 }

LET CGFloat() BE {
   LET fr = NextFR();
   LET r = MoveToAnyCR(arg1);
   GenCPRT(ff.flt, fr, r, 0)
   h1!arg1, h3!arg1 := k.freg, fr }

AND CGFix() BE {
   LET fr = MoveToAnyCFR(arg1);
   LET r = NextR();
   GenCPRT(ff.fix, 0, r, fr);
   h1!arg1, h3!arg1 := k.reg, r }

AND CGFop(op) BE {
   LET reversed = FALSE;
   LET r1, r2, a, b = ?, ?, ?, ?;

   TEST IsConst(arg2) & SmallFloatingConstant(h3!arg2)~=Null THEN
      reversed, a, b := TRUE, arg1, arg2
   ELSE
      a, b := arg2, arg1

   r1 := MoveToAnyFR(a);
   r2 := IsConst(b) -> SmallFloatingConstant(h3!b), Null;
   op := VALOF SWITCHON op INTO {
      CASE s.fmult: RESULTIS ff.mlf
      CASE s.fdiv:  RESULTIS reversed -> ff.rdf, ff.dvf
      CASE s.fplus: RESULTIS ff.adf
      CASE s.fminus:RESULTIS reversed -> ff.rsf, ff.sbf };
   TEST r2~=Null THEN
      GenCPDO(op, r1, r1, ff.const, r2)
   ELSE {
      Lock(r1, k.freg);
      r2 := MoveToAnyCFR(b);
      GenCPDO(op, r1, r1, 0, r2);
      Unlock(r1, k.freg) };
   Lose(r1, k.freg) }

AND CGFUnop(op) BE
   TEST IsConst(arg1) THEN {
      LET n = h3!arg1;
      TEST op=s.abs
	 THEN h3!arg1 := n & ~fps.sign
	 ELSE IF n~=0 THEN h3!arg1 := n NEQV fps.sign }
   ELSE {
      LET fr = MoveToAnyFR(arg1);
      op := op=s.fabs -> ff.abs, ff.mnf;
      GenCPDO(op, fr, 0, 0, fr) }

AND CGFCompare(a, b) BE {
   LET r1 = MoveToAnyCFR(a);
   LET r2 = IsConst(b) -> SmallFloatingConstant(h3!b), Null;
   TEST r2~=Null THEN
      GenCPRT(ff.cmf+ff.const, r1, r.pc, r2)
   ELSE
      GenCPRT(ff.cmf, r1, r.pc, MoveToAnyCFR(b)) }

AND UsingFR(fr) = VALOF {
   FOR t = tempv TO arg1 BY sssize DO
      IF h1!t=k.freg & h3!t=fr
	 THEN RESULTIS t;

   RESULTIS 0 }

AND MoveToAnyCFR(x) = MoveFAux(x, (~IsConst(x) & h4!x~=0) | h2!x>=0)

AND MoveToAnyFR(x) = MoveFAux(x, TRUE)

AND MoveFAux(x, copyLocked) = VALOF {
   LET t, n, loc = ?, ?, ?;
   RemoveFalseIndirection(x);
   t, n, loc := h1!x, -1, h3!x;

   TEST t=k.freg THEN
      IF ~[copyLocked & Locked(loc, k.freg)] THEN
	 n := loc

   ELSE IF h2!x<0 THEN {
      n := LookForFR(t, loc);
      IF n>=0 & ~([copyLocked | h4!x~=0] & Locked(n, k.freg)) THEN
	 h1!x, h3!x := k.freg, n };

   IF n=-1 THEN n := NextFR();
   MoveToFR(n, x);
   RESULTIS h3!x }

AND NextFR() = VALOF {
   STATIC { possible = 0 };

   LET IsItFree(fr) = VALOF {
      IF UsingFR(fr) | Locked(fr, k.freg) THEN RESULTIS FALSE;
      IF possible<0 THEN possible := fr;
      IF HasSlavedLoc(fr, k.freg) THEN RESULTIS FALSE;
      RESULTIS TRUE };

   possible := -1;
   IF IsItFree(fr.0) THEN RESULTIS fr.0;
   IF IsItFree(fr.1) THEN RESULTIS fr.1;
   IF IsItFree(fr.2) THEN RESULTIS fr.2;
   IF IsItFree(fr.3) THEN RESULTIS fr.3;
   IF IsItFree(fr.4) THEN RESULTIS fr.4;
   IF IsItFree(fr.5) THEN RESULTIS fr.5;
   IF IsItFree(fr.6) THEN RESULTIS fr.6;
   IF IsItFree(fr.7) THEN RESULTIS fr.7;

   IF possible>=0 THEN {
      DiscardReg(possible, k.freg);
      RESULTIS possible };

   FOR t = tempv TO arg1 BY sssize DO
      IF h1!t=k.freg THEN {
	 LET fr = h3!t; StoreT(t); DiscardReg(fr, k.freg); RESULTIS fr };

   BackTrace();
   PrintSimulatedStack();
   CGError(FALSE, "No free register found in NextFR");
   RESULTIS 0 }

AND FreeFR(r) BE
   FOR t = tempv TO arg1 BY sssize DO
      IF h1!t=k.freg & h3!t=r
	 THEN { StoreT(t); RETURN }

AND CheckFPConstant(n) BE
   IF n<fps.mantissa | n LGR (fps.sign+fps.expt) THEN
      CGError(OnlyWarning, "Integer constant %n used as floating point operand", n)

AND MoveToFR(fr, x) BE {
   LET t, ind, n, k = h1!x, h2!x, h3!x, h4!x;
   LET loc = n
   AND b, m = 0, 0;
   IF ind>=0 THEN {
      IF fr<0 THEN fr := NextFR();
      fr := CompileDS(f.ld, fr, fr, x);
      GOTO l };

   TEST k~=0 & t~=k.number THEN {
      LET r = MoveToAnyCR(x);
      t, n := k.reg, r }

   ELSE {
      LET r = LookForFR(t, n);
      TEST r>=0 THEN
	 t, n := k.freg, r
      ELSE IF t=k.loc THEN {
	 r := RegisterDedicatedToLoc(n);
	 IF r~=Null THEN t, n := k.reg, r } };

   SWITCHON t INTO {
      CASE k.number:
	 loc := n+k;
      {  LET sc = SmallFloatingConstant(loc);
	 IF sc~=Null THEN {
	    GenCPDO(ff.mvf, fr, 0, ff.const, sc);
	    ENDCASE }
	 CheckFPConstant(loc)
	 TEST usesRL THEN {
	    CheckRLLoaded();
	    b, m, n := r.l, 0, staticDataSize+Fdata(loc) }
	 ELSE
	    b, m, n := r.pc, LocalConstLab, Fdata(loc);
	 n := n/BytesPerWord;
	 GOTO lb }

      DEFAULT:
	 n := MoveToAnyCR(x);
      CASE k.reg:
	 IF RegInPendingList(pendingLoads, n)~=Null THEN
	    FlushPendingLoadsForReg(n);
	 MoveRtoFR(n, fr, x);
	 MoveRToR(k.reg, n, k.freg, fr);
	 ENDCASE

      CASE k.freg:
	 IF fr~=n THEN {
	    GenCPDO(ff.mvf, fr, 0, 0, n);
	    MoveRToR(k.freg, n, k.freg, fr) };
	 ENDCASE

      CASE k.lab:
	 m := n; n := 0;
	 b := CheckRLLoaded();
	 GOTO la

      CASE k.glob:
	 b := r.g;
	 GOTO la;

      CASE k.static:
	 b := CheckRLLoaded();
	 GOTO la;

      CASE k.loc:
	 TEST usesFrame THEN
	    b := linkageNotStored=r.b -> r.p,
		 linkageNotStored -> r.ts, r.p
	 ELSE
	    b, n := r.ts, n-saveSpaceSize;
	 n := (nextStackWord/BytesPerWord)*n;

     la: FlushPendingStoresForSLoc(t, n);
     lb: GenCPDT(f.ld, fr, b, m, n);
	 MoveSToR(k.freg, fr, t, loc);
	 ENDCASE };
l:
   h1!x, h2!x, h3!x, h4!x := k.freg, -1, fr, 0 }

AND SmallFloatingConstant(n) =
   n=0 -> 0,
   n=1.0 -> 1,
   n=2.0 -> 2,
   n=3.0 -> 3,
   n=4.0 -> 4,
   n=5.0 -> 5,
   n=0.5 -> 6,
   n=10.0 -> 7,
	    Null

AND StoreFR(fr, base, prepost, n) BE {
   TEST n<0 THEN
      prepost, n := prepost+f.down, -n
   ELSE
      prepost := prepost+f.up;
   IF (prepost&f.pre)=f.post THEN prepost := prepost | f.wb;
   F4Inst(f.st+ff.cpdt, base, fr<<12, ff.cpno+prepost+n) }

AND MoveRtoFR(r, fr, x) BE {
   GenF2(f.str, r, r.g, 0, -4);
   GenCPDT(f.ld, fr, r.g, 0, -1) }

AND MoveFRtoR(fr, r, x) BE {
   GenCPDT(f.st, fr, r.g, 0, -1);
   GenF2(f.ldr, r, r.g, 0, -4) }

AND GenCPRT(op, fr, r, fr2) BE
    F4Inst(op, fr, r<<12, ff.cprt+ff.cpno+fr2)

AND GenCPDO(op, frdest, fr1, isconst, fr2) BE
    F4Inst(op, fr1, frdest<<12, ff.cpdo+ff.cpno+isconst+fr2)

AND GenCPDT(op, fr, b, lab, offset) BE
    GenF2(op+ff.cpdt+ff.cpno, fr, b, lab, offset)

AND PackFPNum(mantissa, exponent, sign) = VALOF {
// Construction of floating point constants.
// Exponent is decimal.
// The construction avoids use of floating point operations
// (the easy way out) in order to run on a machine without support
// for them.  Maybe this wants reviewing later.
   LET x = #x96;
   LET op = PeekN();
   IF op=s.neg THEN
      CGError(OnlyWarning, "Integer negation of floating point constant");
   IF mantissa=0 THEN RESULTIS 0;  // The easy case
   sign := sign<0 -> #x80000000, 0;
   TEST exponent>0 THEN
      WHILE exponent~=0 DO {
	 TEST (mantissa&#xf8000000)=0 THEN
	    mantissa := mantissa*10
	 ELSE {
	    mantissa := MulDiv(mantissa, 10, 16);
	    IF result2>=8 THEN mantissa := mantissa+1;
	    x := x+4 };
	 exponent := exponent-1 }

   ELSE IF exponent<0 THEN {
      WHILE (mantissa&#xf8000000)~=0 DO mantissa, x := mantissa>>1, x+1;
      WHILE (mantissa&#x04000000)=0 DO mantissa, x := mantissa<<1, x-1;
      WHILE exponent~=0 DO {
	 mantissa := MulDiv(mantissa, 16, 10);
	 x := x-4;
	 WHILE (mantissa&#xf8000000)~=0 DO
	    mantissa, x := (mantissa>>1), x+1;
	 exponent := exponent+1 } };

   WHILE (mantissa&#xff000000)~=0 DO {
      IF (mantissa&1)~=0 THEN mantissa := mantissa+2;
      mantissa, x := mantissa>>1, x+1 };

   WHILE (mantissa&#x00800000)=0 DO mantissa, x := mantissa<<1, x-1;
   RESULTIS sign | (mantissa&fps.mantissa) | (x<<fps.exptshift) }
