SECTION "CGH"

GET "b.CGheader"
GET "b.FPOps"	// for the register names

STATIC {
/* Version of 18 Mar 86 12:58:25
 */
   dummy = VersionMark;
   version = 1*256+14 }

/* The following procedures maintain a register memory.
   This remembers the place a register was loaded from,
   and anywhere it has been stored, and also whether
   the contents have been modified for use as an address.
*/

/* 1.8	17 Feb 86 17:20:08
     Incorporates floating point
   1.9	07 Mar 86 21:38:51
     k.static
   1.10  18 Mar 86 12:58:36
     post-increment fp instructions generated by StoreT must
     not have the  wb  bit set.
     Code improvement for !@thing
   1.11  21 Mar 86 11:19:13
     Deferred shifts
   1.12  20 May 87 11:09:36
     Bug fix: store to location forces loads from it to be done.
   1.13  30 Jun 87 15:52:16
     Bug fix: LoadAddress takes account of whether base to be loaded has an
     additive constant
*/

MANIFEST {
// register state description
   rsd.type=h1; rsd.shiftstate=h2; rsd.loc=h3;
   rsd.sl=h4; rsd.lock=h5;

// description of a saved register state
   srs.size = 4;
   srs.header = 4;
   srs.lab = 1; srs.tos = 2;
   srs.ps = 3;
   srs.blocksize = srs.size*(15+8)+srs.header;

   srsd.type=rsd.type; srsd.shiftstate=rsd.shiftstate;
   srsd.loc=rsd.loc; srsd.sl=rsd.sl };

STATIC {
   regList = 0; fregList = 0 };

LET InitialiseRegisterSlave() BE {
   regList := GetVector(RegSize*16);
   FOR i = 0 TO RegSize*16-1 DO regList!i := 0;
   fregList := GetVector(RegSize*8);
   FOR i = 0 TO RegSize*8-1 DO fregList!i := 0 }

LET ArgumentRegister(r) =
   reversedStack -> r.a4-r+1,
		    r

AND RegEntry(type, r) =
   type=k.reg -> regList+RegSize*r,
   type=k.freg -> fregList+RegSize*r,
		  CGError(TRUE, "bad type in RegEntry")


AND HasSlavedLoc(r, type) = VALOF {
   LET x = RegEntry(type, r);
   RESULTIS rsd.type!x~=0 -> TRUE,
	    rsd.sl!x~=0 -> TRUE,
			   FALSE }

AND DiscardRegs() BE {
   FOR i = r.0 TO r.14 DO DiscardReg(i, k.reg);
   Lock(r.nil, k.reg);
   FOR i = fr.0 TO fr.7 DO DiscardReg(i, k.freg) }

AND DiscardReg(r, type) BE {
   LET x = RegEntry(type, r);
   rsd.type!x, rsd.shiftstate!x := 0, 0;
   IF (r~=r.nil | type~=k.reg) THEN rsd.lock!x := 0;
   DiscardSL(@rsd.sl!x);
   IF type=k.reg THEN {
      FlushPendingUsesOfReg(r);
      x := LocHeldInRegister(r, type);
      IF x~=Null THEN {
	 MoveStoR(k.reg, r, k.loc, x);
	 Lock(r, type) } } }

AND DiscardNonLocalRegs() BE
   DiscardRegsIf(IsNonLocal)

AND DiscardNonConstRegs() BE
   DiscardRegsIf(IsNonConst)

AND IsNonLocal(t) = t~=k.number & t~=k.loc

AND IsNonConst(t) = t~=k.number

AND DiscardRegsIf(pred) BE {
   FOR r = r.0 TO r.14 DO DiscardIf(pred, r, k.reg)
   FOR r = fr.0 TO fr.7 DO DiscardIf(pred, r, k.freg) }

AND DiscardIf(pred, r, type) BE {
   LET p = RegEntry(type, r);
   LET q = @rsd.sl!p;
   LET x = !q;
   IF pred(rsd.type!p) THEN rsd.type!p, rsd.loc!p := 0, 0;
   WHILE x~=0 DO {
      TEST pred(sl.type!x) THEN
	 !q := FreeBlk(x, sl.size)
      ELSE
	 q := x;
      x := !q };
//   IF type=k.reg THEN FlushPendingUsesOfReg(r);
   IF rsd.type!p=0 & rsd.sl!p=0 THEN rsd.shiftstate!p := 0;
   IF type~=k.reg | (r~=r.nil & LocHeldInRegister(r)=Null)
      THEN rsd.lock!p := 0 }

AND LoadAddress(x) = VALOF {
   LET b, r, y = LookFor(x, ShiftedUp), -1, 0;
   TEST b>=0 THEN IF h4!x~=0 THEN {
      r := FindRegisterBetween(r.0, r.14, FALSE);
      IF r=Null THEN r := b;
      SetRToRPlusK(r, b, h4!x*4);
      y := RegEntry(k.reg, r);
      rsd.shiftstate!y := 2;
      RESULTIS r }
   ELSE {
      b := IsInARegister(x);
      TEST b>=0 THEN
	 TEST Locked(b, k.reg) THEN {
	    r := NextR();
	    MoveRtoR(k.reg, b, k.reg, r) }

	 ELSE {
	    LET n = FindRegisterBetween(r.0, r.14, FALSE);
	    IF n~=Null THEN {
	       r := n;
	       MoveRtoR(k.reg, b, k.reg, r) } }
      ELSE
	 b := MoveToAnyR(x) };

   IF r<0 THEN r := b;
   y := RegEntry(k.reg, r);

   IF rsd.shiftstate!y=0 THEN {
      FlushPendingUsesOfReg(r);
      FlushPendingLoadsForReg(b);
      ShiftRegisterDS(r, b, sh.asl, 2);
      rsd.shiftstate!y := 2 };

   RESULTIS r }

AND LoadCarAdd(x) = VALOF {
   LET b, r, y = LookFor(x, IsaCar), -1, 0;
   IF b<0 THEN {
      b := IsInARegister(x);
      TEST b>=0 THEN
	 TEST Locked(b, k.reg) THEN {
	    r := NextR();
	    MoveRtoR(k.reg, b, k.reg, r) }
	 ELSE {
	    LET n = FindRegisterBetween(r.0, r.14, FALSE);
	    IF n~=Null THEN {
	       r := n;
	       MoveRtoR(k.reg, b, k.reg, r) } }
      ELSE
	 b := MoveToAnyR(x) };

   IF r<0 THEN r := b;
   y := RegEntry(k.reg, r);

   IF rsd.shiftstate!y=0 THEN {
      FlushPendingUsesOfReg(r);
      FlushPendingLoadsForReg(b);
      GenF1K(f.bic, r, b, #xff000000);
      rsd.shiftstate!y := -1 };

   RESULTIS r }

AND MoveStoR(type, r, a, b) BE {
   LET x = RegEntry(type, r);
   rsd.type!x, rsd.shiftstate!x, rsd.loc!x := a, 0, b;
   DiscardSL(@rsd.sl!x) }

AND MoveRtoR(rtype, r, stype, s) BE {
   LET x, y = RegEntry(rtype, r), RegEntry(stype, s);
   rsd.type!y, rsd.shiftstate!y, rsd.loc!y :=
      rsd.type!x, rsd.shiftstate!x, rsd.loc!x
   CopySL(@rsd.sl!y, rsd.sl!x) }

AND StoreR(type, r, a, b) = VALOF {
   LET x = RegEntry(type, r);
   LET wastos = DiscardAddress(a, b);
   IF rsd.type!x=0 THEN rsd.type!x, rsd.shiftstate!x, rsd.loc!x := a, 0, b;
   AddLocToSL(@rsd.sl!x, a, b);
   RESULTIS wastos }

AND AddRegInfo(type, r, a, b) BE {
   LET x = RegEntry(type, r);
   IF rsd.type!x~=0 THEN AddLocToSL(@rsd.sl!x, rsd.type!x, rsd.loc!x)
   rsd.type!x, rsd.loc!x := a, b }

AND DiscardAddress(t, n) = VALOF {
   LET DiscardA(x, t, n) BE {
      IF rsd.type!x=t & rsd.loc!x=n THEN rsd.type!x := 0;
      DelLocFromSL(@rsd.sl!x, t, n) };
   FOR r = r.0 TO r.14 DO DiscardA(RegEntry(k.reg, r), t, n)
   FOR r = fr.0 TO fr.7 DO DiscardA(RegEntry(k.freg, r), t, n)
   FlushPendingLoadsForSLoc(t, n);
   RESULTIS DelSLocFromPendingList(@PendingStores, t, n) }

AND PrintRegList() BE {
   STATIC { nullState=FALSE };
   LET PrintR(type, r) BE {
      LET s = RegEntry(type, r);
      IF rsd.type!s~=0 | rsd.sl!s~=0 | rsd.lock!s~=0 THEN {
	 WrCh(rsd.lock!s=0 -> ' ', '**');
	 WrCh(type=k.reg -> 'R', 'F');
	 WriteF("%n: %n %n", r, rsd.type!s, rsd.loc!s);
	 IF rsd.shiftstate!s~=0 THEN WriteF(" [%n]", rsd.shiftstate!s);
	 PrintList(rsd.sl!s, 2, ": ", "", "*n");
	 NullState := FALSE } };
   nullState := TRUE;
   FOR r = r.0 TO r.14 DO PrintR(k.reg, r)
   FOR r = fr.0 TO fr.7 DO PrintR(k.freg, r)
   IF nullState THEN WriteS("Null*n") }

AND IsInaRegister(x) =
   (h2!x>=0 | h4!x~=0) -> Null,
   h1!x=k.reg	       -> h3!x,
			  LookFor(x, NotAddr)

AND LookFor(x, pred) = LookForSloc(pred, h1!x, h3!x)

AND LookForRegContainingType(t) = VALOF {
   FOR r = r.0 TO r.14 DO {
      LET v = RegEntry(k.reg, r);
      IF t=rsd.type!v & NotAddr(rsd.shiftstate!v) THEN
	 RESULTIS r };
   RESULTIS Null }

AND LocInRegister(r) = rsd.loc![RegEntry(k.reg, r)]

AND TurnIndIntoSLoc(x) = VALOF {
   LET k, r1, p, t = h4!x, ?, ?, ?;
   h4!x := 0;
   r1 := IsInARegister(x);
   IF r1=Null THEN RESULTIS FALSE;
   p := RegEntry(k.reg, r1);
   t := rsd.type!p;
   IF t~=k.lvloc & t~=k.lvglob & t~=k.lvstatic THEN
      RESULTIS FALSE;
   h1!x := t+k.loc-k.lvloc;
   h3!x := rsd.loc!p+k;
   RESULTIS TRUE }

AND RemoveFalseIndirection(x) BE {
   LET t, ind, n, k = h1!x, h2!x, h3!x, h4!x;
   TEST ind=0 & (t=k.lvloc | t=k.lvglob | t=k.lvstatic) THEN {
      h1!x := t+k.loc-k.lvloc;
      h2!x := -1;
      h3!x := n+k;
      h4!x := 0 }
   ELSE TEST ind=0 THEN {
      LET b = LookForSloc(ShiftedUp, t, n);
      IF b~=Null THEN {
	 LET p = OffsetInList(pendingStores, k.ireg, b, k)
	 IF p~=Null THEN {
	    h1!x := k.reg;
	    h2!x := -1;
	    h3!x := ps.reg!p;
	    h4!x := 0 } } }
   ELSE IF ind>=CarMark THEN {
      LET b = LookForSloc((ind=CarMark -> IsACar, NotAddr), t, n);
      IF b~=Null THEN {
	 LET p = OffsetInList(pendingStores, k.ireg, b, k/4)
	 IF p~=Null THEN {
	    h1!x := k.reg;
	    h2!x := -1;
	    h3!x := ps.reg!p;
	    h4!x := 0 } } } }

AND LookForSloc(pred, t, n) = VALOF {
   IF (CGDebugMode&db.regs)~=0 THEN {
      WriteF("Lookfor %n %n %s:*N", t, n,
		  pred=NotAddr -> "NotAddr",
		pred=ShiftedUp -> "ShiftedUp",
				  "IsACar");
      PrintRegList() };

   FOR r = r.0 TO r.14 DO {
      LET v = RegEntry(k.reg, r);
      IF [(t=rsd.type!v & n=rsd.loc!v) |
	  SlocInList(rsd.sl!v, t, n)~=Null] &
	 pred(rsd.shiftstate!v) THEN {
	 IF (CGDebugMode&db.regs)~=0 THEN WriteF("Found %n*n", r)
	 RESULTIS r } };

   t := SlocInList(PendingStores, t, n);
   IF t~=Null THEN {
      n := ps.reg!t;
      TEST pred(rsd.shiftstate![RegEntry(k.reg, n)]) THEN
	 t := n
      ELSE
	 t := Null };
   IF (CGDebugMode&db.regs)~=0 THEN WriteF("Found %n*n", t)
   RESULTIS t }

AND NotAddr(x) = x=0

AND ShiftedUp(x) = x>0

AND IsaCar(x) = x<0


AND LookForFR(t, n) = VALOF {
   IF (CGDebugMode&db.regs)~=0 THEN {
      WriteF("LookforF %n %n:*N", t, n);
      PrintRegList() };

   FOR r = fr.0 TO fr.7 DO {
      LET v = RegEntry(k.freg, r);
      IF [(t=rsd.type!v & n=rsd.loc!v) |
	  SlocInList(rsd.sl!v, t, n)~=Null] THEN {
	 IF (CGDebugMode&db.regs)~=0 THEN WriteF("Found %n*n", r)
	 RESULTIS r } };

   RESULTIS Null }


AND Lock(r, type) BE
   TEST type=k.reg THEN
      IF r.0<=r<=r.14
	 THEN rsd.lock![RegEntry(k.reg, r)] := -1
   ELSE TEST type=k.freg THEN
      IF fr.0<=r<=fr.7
	 THEN rsd.lock![RegEntry(k.freg, r)] := -1
   ELSE CGError(TRUE, "bad type in Lock")

AND Unlock(r, type) BE
   TEST type=k.reg THEN
      IF (r.0<=r<=r.14) & r~=r.nil & LocHeldInRegister(r)=Null
	 THEN rsd.lock![RegEntry(k.reg, r)] := 0
   ELSE TEST type=k.freg THEN
      IF fr.0<=r<=fr.7
	 THEN rsd.lock![RegEntry(k.freg, r)] := 0
   ELSE CGError(TRUE, "bad type in Lock")

AND Locked(r, type) = rsd.lock![RegEntry(type, r)] = -1

AND AddLocToSL(lvp, t, n) BE {
   LET v = FillBlk(sl.size, !lvp, t, n);
   !lvp := v }

AND CopySL(lvdest, source) BE
   WHILE source~=0 DO {
      AddLocToSL(lvdest, sl.type!source, sl.loc!source);
      source := !source }

AND DiscardSL(lvp) BE {
   DeleteList(!lvp, sl.size);
   !lvp := 0 }

AND DelLocFromSL(lvp, t, n) BE {
   LET p = !lvp;
   WHILE p~=0 DO {
      TEST sl.type!p=t & sl.loc!p=n THEN
	 !lvp := FreeBlk(p, sl.size)
      ELSE
	 lvp := p;
      p := !lvp } }

AND PrintRegisterState(s) BE {
   LET NullState = TRUE;
   WriteF("ss %n %n*n", srs.lab!s, srs.tos!s);
   s := s+srs.header;
   FOR r = r.0 TO r.14 DO {
      IF srsd.type!s~=0 | srsd.sl!s~=0 THEN {
	 WriteF("R%n: %n %n %n:", r, srsd.type!s, srsd.shiftstate!s, srsd.loc!s);
	 PrintList(srsd.sl!s, 2, "", "", "*n");
	 NullState := FALSE };
      s := s+srs.size };
   FOR r = fr.0 TO fr.7 DO {
      IF srsd.type!s~=0 | srsd.sl!s~=0 THEN {
	 WriteF("F%n: %n %n:", r, srsd.type!s, srsd.loc!s);
	 PrintList(srsd.sl!s, 2, "", "", "*n");
	 NullState := FALSE };
      s := s+srs.size };
   IF NullState THEN WriteS("Null*n") }

AND SaveRegisterState() = VALOF {
   LET CopyIn(type, r, y) = VALOF {
      LET x = RegEntry(type, r);
      srsd.shiftstate!y := rsd.shiftstate!x;
      srsd.sl!y := 0
      CopySL(@srsd.sl!y, rsd.sl!x);
      TEST k.loc<=rsd.type!x<=k.lab THEN {
	 LET t, n = rsd.type!x, rsd.loc!x;
	 srsd.type!y, srsd.loc!y := 0, 0;
	 IF SlocInList(srsd.sl!y, t, n)=Null
	    THEN AddLocToSL(@srsd.sl!y, t, n) }
      ELSE
	 srsd.type!y, srsd.loc!y := rsd.type!x, rsd.loc!x;
      RESULTIS y+srs.size };
   LET p = GetVector(srs.blocksize);
   LET y = p+srs.header;
   FOR r = r.0 TO r.14 DO y := CopyIn(k.reg, r, y)
   FOR r = fr.0 TO fr.7 DO y := CopyIn(k.freg, r, y)
   srs.tos!p := TOSOffset;
   srs.ps!p := CopyOfList(PendingStores, ps.size);
   RESULTIS p }

AND RestoreRegisterState(p) BE {
   LET CopyBack(type, r, y) = VALOF {
      LET x = RegEntry(type, r);
      rsd.type!x, rsd.shiftstate!x, rsd.loc!x, rsd.sl!x :=
	 srsd.type!y, srsd.shiftstate!y, srsd.loc!y, srsd.sl!y;
      IF rsd.type!x=0 & rsd.sl!x~=0 THEN {
	 LET q = rsd.sl!x;
	 rsd.type!x, rsd.loc!x := sl.type!q, sl.loc!q;
	 rsd.sl!x := FreeBlk(q, sl.size) };
      y := y+srs.size };
   LET y = p+srs.header;
   FOR r = r.0 TO r.14 DO y := CopyBack(k.reg, r, y);
   FOR r = fr.0 TO fr.7 DO y := CopyBack(k.freg, r, y);
   TOSOffset := srs.tos!p;
   PendingStores := srs.ps!p;
   FreeVector(p) }

AND IntersectionOfRegisterStates(p, q) = VALOF {
   LET res = GetVector(srs.blocksize);
   LET resy = res+srs.header;
   LET y1, y2 = p+srs.header, q+srs.header;

   IF (CGDebugMode&db.srs)~=0 THEN {
      WriteS("Forming intersection -- ");
      PrintRegisterState(p);
      PrintRegisterState(q) };
   FOR r = r.0 TO r.14+(fr.7-fr.0+1) DO {
      TEST srsd.shiftstate!y1~=srsd.shiftstate!y2 THEN
	 srsd.type!resy, srsd.shiftstate!resy, srsd.loc!resy, srsd.sl!resy :=
	       0, 0, 0, 0
      ELSE {
	 LET sl1, sl2 = srsd.sl!y1, srsd.sl!y2;
	 srsd.shiftstate!resy := srsd.shiftstate!y1;
	 TEST srsd.type!y1=srsd.type!y2 & srsd.loc!y1=srsd.loc!y2 THEN
	    srsd.type!resy, srsd.loc!resy := srsd.type!y1, srsd.loc!y1
	 ELSE
	    srsd.type!resy, srsd.loc!resy := 0, 0;
	 srsd.sl!resy := 0;
	 WHILE sl1~=0 DO {
	    LET t, n = sl.type!sl1, sl.loc!sl1;
	    IF SLocInList(sl2, t, n)~=Null
	       THEN AddLocToSL(@srsd.sl!resy, t, n);
	    sl1 := !sl1 } };
      DiscardSL(@srsd.sl!y1);
      DiscardSL(@srsd.sl!y2);
      y1, y2 := y1+srs.size, y2+srs.size;
      resy := resy+srs.size };
   srs.tos!res := srs.tos!p=srs.tos!q -> srs.tos!p,
					 -1;
   srs.ps!res := 0;
   FreeVector(p);
   FreeVector(q);

   IF (CGDebugMode&db.srs)~=0 THEN {
      WriteS("giving -- ");
      PrintRegisterState(res) };
   RESULTIS res }

AND FindSavedState(lab) = VALOF {
   LET q = @SavedStates;
   LET p = !q;
   WHILE p~=0 DO {
      IF srs.lab!p=lab THEN {
	 !q := !p; RESULTIS p }
      q := p; p := !p };
   RESULTIS Null }

AND SaveStateForLab(lab) BE {
   lab := TransferredLabel(lab);
   IF LabelFlagged(lab, lab.forwardjump) THEN {
      LET p = SaveRegisterState();
      LET s = FindSavedState(lab);
      IF s~=Null THEN
	 p := IntersectionOfRegisterStates(p, s);

      srs.lab!p := lab;
      !p := SavedStates;
      SavedStates := p;
      IF (CGDebugMode&db.srs)~=0 THEN {
	 WriteS("saving ");
	 PrintRegisterState(p) } } }

// Now some users of the register memory

AND MoveToAnyCRForStoreTo(x, t, n) = VALOF {
   LET r = MoveToAnyCRSomeTimeForStoreTo(x, t, n);
   FlushPendingLoadsForReg(r);
   RESULTIS r }

AND MoveToAnyCRSomeTimeForStoreTo(x, t, n) = VALOF {
   LET r =Null;
   IF h1!x=k.number & h2!x<0 THEN {
      TEST t=k.loc THEN {
	 LET p = SlocInList(pendingStores, t, n-1)
	 IF p~=Null THEN r := ps.reg!p }

      ELSE {
	 r := LookFor(n, t);
	 IF r~=Null THEN {
	    LET p = @pendingStores;
	    LET offset = h4!n;
	    {  p := SlocInList(!p, k.ireg, r);
	       TEST p=Null THEN {
		  r := Null; BREAK }
	       ELSE IF pl.offset!p=offset-1 THEN {
		  r := ps.reg!p; BREAK }
	    } REPEAT } };

      IF r~=Null THEN {
	 LET s = Null;
	 IF (CGDebugMode&db.regs)~=0
	    THEN WriteF("r%n adjacent", r);
	 s := LookFor(x, NotAddr);
	 IF s>r THEN RESULTIS s;
	 r := FindRegisterBetween(r+1, r.14, FALSE);
	 IF r~=Null THEN {
	    MoveToRSomeTime(r, x);
	    RESULTIS r } } };

   RESULTIS MoveToAnyCRSomeTime(x) }

AND MoveToAnyCR(x) = VALOF {
   LET r = MoveToAnyCRSomeTime(x);
   FlushPendingLoadsForReg(r);
   RESULTIS r }

AND MoveToAnyCRSomeTime(x) =
   // Ensure that the simulated stack item x is in a register.
   // The user of this routine guarantees that the contents of
   // the register will not be updated (so if the value is already
   // in a locked register, that will do.
      MoveAux(x, (~IsConst(x) & h4!x~=0) | h2!x>=0)

AND MoveToAnyR(x) = VALOF {
   LET r = MoveToAnyRSomeTime(x);
   FlushPendingLoadsForReg(r);
   RESULTIS r }

AND MoveToAnyRSomeTime(x) = MoveAux(x, TRUE)

AND MoveAux(x, copyLocked) = VALOF {
   LET t, n, loc = ?, ?, ?;
   RemoveFalseIndirection(x);
   t, n, loc := h1!x, -1, h3!x;
   TEST 1<=ArgumentNumber<=4 THEN {
      n := ArgumentRegister(ArgumentNumber);
      ArgumentNumber := Null }

   ELSE TEST t=k.reg | t=k.shreg THEN
      TEST copyLocked &
	   [Locked(loc, k.reg) |
	    RegInPendingList(PendingStores, loc)~=Null] THEN
	 n := NextR()
      ELSE
	 n := loc

   ELSE IF h2!x<0 THEN {
      n := LookFor(x, NotAddr);
      TEST n>=0 THEN
	 TEST [copyLocked | h4!x~=0] &
	      [Locked(n, k.reg) |
	       RegInPendingList(PendingStores, n)~=Null] THEN
	    n := NextR()
	 ELSE
	    h1!x, h3!x := k.reg, n
      ELSE {
	 LET pp = SlocInList(pendingLoads, t, loc-1)
	 TEST pp~=Null THEN {
	    LET otherR = ps.reg!pp;
	    n := FindRegisterBetween(r.0, r.14, FALSE);
	    TEST n=Null THEN {
	       n := FindRegisterBetween(otherR+1, r.14, TRUE);
	       IF n=Null THEN n := FindR() }
	    ELSE IF n<=otherR THEN {
	       LET r = FindRegisterBetween(otherR+1, r.14, FALSE);
	       IF r~=Null THEN n := r } }

	 ELSE TEST (VALOF {
	       pp := SlocInList(pendingLoads, t, loc+1);
	       RESULTIS pp })~=Null THEN {
	    LET otherR = ps.reg!pp;
	    n := FindRegisterBetween(r.0, r.14, FALSE);
	    TEST n=Null THEN {
	       n := FindRegisterBetween(r.0, otherR-1, TRUE);
	       IF n=Null THEN n := FindR() }
	    ELSE IF n>=otherR THEN {
	       LET r = FindRegisterBetween(r.0, otherR-1, FALSE);
	       IF r~=Null THEN n := r } }
	 ELSE
	    n := FindR();
	 FlushPendingUsesOfReg(n) } };
   MoveToRSomeTime(n, x);
   RESULTIS h3!x }

AND Using(r) = VALOF {
   FOR t = tempv TO arg1 BY SSSize DO
      IF (h1!t=k.reg | h1!t=k.shreg) & h3!t=r
	 THEN RESULTIS r;

   RESULTIS 0 }

AND NextR() = VALOF {
   LET r = FindR();
   FlushPendingUsesOfReg(r);
   RESULTIS r }

AND FindRegisterBetween(low, high, discard) = VALOF {
   STATIC { possibleR = 0; possibleR2 = 0 };
   LET IsItFree(r, low, high) = VALOF {
      LET x = RegEntry(k.reg, r);
      IF ~(low<=r<=high) THEN RESULTIS FALSE;
      IF Using(r)=0 THEN {
	 IF Locked(r, k.reg) THEN RESULTIS FALSE;
	 IF possibleR<0 THEN
	    TEST rsd.shiftstate!x~=0
	       THEN possibleR2 := r
	       ELSE possibleR := r;
	 IF (r=r.b | r=r.14) & linkageNotStored
	    THEN RESULTIS FALSE;
	 IF RegInPendingList(PendingStores, r)=Null &
	    RegInPendingList(PendingLoads, r)=Null &
	    rsd.type!x=0 & rsd.sl!x=0 THEN RESULTIS TRUE };
      RESULTIS FALSE };

   possibleR, possibleR2 := -1, -1;
   IF IsItFree(ArgumentRegister(1), low, high)
      THEN RESULTIS ArgumentRegister(1);
   IF IsItFree(ArgumentRegister(2), low, high)
      THEN RESULTIS ArgumentRegister(2);
   IF IsItFree(ArgumentRegister(3), low, high)
      THEN RESULTIS ArgumentRegister(3);
   IF IsItFree(ArgumentRegister(4), low, high)
      THEN RESULTIS ArgumentRegister(4);
   TEST ~reversedStack | linkageNotStored THEN {
      IF IsItFree(r.w1, low, high) THEN RESULTIS r.w1;
      IF IsItFree(r.b, low, high)  THEN RESULTIS r.b;
      IF UsesFrame & IsItFree(r.14, low, high) THEN RESULTIS r.14 }
   ELSE {
      IF UsesFrame & IsItFree(r.14, low, high) THEN RESULTIS r.14;
      IF IsItFree(r.b, low, high)  THEN RESULTIS r.b;
      IF IsItFree(r.w1, low, high) THEN RESULTIS r.w1 };

   IF discard THEN
      TEST possibleR>=0 THEN {
	 DiscardReg(possibleR, k.reg); RESULTIS possibleR }
      ELSE IF possibleR2>=0 THEN {
	 DiscardReg(possibleR2, k.reg); RESULTIS possibleR2 };

   RESULTIS Null }

AND FindR() = VALOF {
   LET r = FindRegisterBetween(r.0, r.14, TRUE);
   IF r~=Null THEN RESULTIS r;

   FOR t = tempv TO arg1 BY SSSize DO
      IF h1!t=k.reg & ~Locked(h3!t, k.reg) THEN {
	 r := h3!t; StoreT(t); DiscardReg(r, k.reg); RESULTIS r };

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

AND Lose(r, type) BE {
   ssp := ssp-1;
   TEST arg2=tempv THEN {
      h1!arg2, h2!arg2, h4!arg2 := k.loc, -1, 0;
      h3!arg2, h5!arg2 := ssp-2, ssp-2 }
   ELSE
      arg1, arg2 := arg2, arg2-SSSize;

   h1!arg1, h2!arg1, h3!arg1, h4!arg1 := type, -1, r, 0;
   h5!arg1 := ssp-1;
   DiscardReg(r, type) }

AND LoseR(r, d) BE {
   Lose(r, k.reg);
   IF d~=Null THEN h1!arg1, h4!arg1 := k.shreg, d }

AND PrintSimulatedStack() BE
   FOR p = tempv TO arg1 BY SSSize DO {
      WriteF("%n: ", p);
      FOR i = 0 TO SSSize-1 DO WriteF(" %n", p!i);
      NewLine() }

AND SSEntry(n) = VALOF {
   LET base = h5!tempv;
   LET top = h5!arg1;
   RESULTIS base<=n<=top -> tempv+[SSSize*(n-base)],
			    Null }

AND InitStack(s) BE {
   arg2, arg1 := tempv, tempv+SSSize;
   ssp := s
   h1!arg2, h2!arg2, h4!arg2 := k.loc, -1, 0;
   h3!arg2, h5!arg2 := ssp-2, ssp-2;
   h1!arg1, h2!arg1, h4!arg1 := k.loc, -1, 0;
   h3!arg1, h5!arg1 := ssp-1, ssp-1 }

AND Load(a, b) BE {
   arg2 := arg1;
   arg1 := arg1+SSSize;
   h1!arg1, h2!arg1, h3!arg1 := a, -1, b;
   h4!arg1, h5!arg1 := 0, ssp;
   ssp := ssp+1 }

AND SwapSS(x, y) BE {
   LET a, b, c, d = h1!y, h2!y, h3!y, h4!y;
   h1!y, h2!y, h3!y, h4!y := h1!x, h2!x, h3!x, h4!x;
   h1!x, h2!x, h3!x, h4!x := a, b, c, d }

AND Stack(n) BE {
   DelLocsAbove(n+1, TRUE);

   IF n>=ssp+4 THEN {
      Store(0, ssp);
      InitStack(n);
      RETURN };

   WHILE n>ssp DO Load(k.loc, ssp);

l: IF n=ssp THEN RETURN;
   IF arg2~=tempv THEN {
      arg1 := arg2;
      arg2 := arg2-SSSize;
      ssp := ssp-1;
      GOTO l };

   IF n=ssp-1 THEN {
      FOR h = h1 TO h5 DO h!arg1 := h!arg2;
      ssp := n;
      h1!arg2, h2!arg2, h4!arg2 := k.loc, -1, 0;
      h3!arg2, h5!arg2 := ssp-2, ssp-2;
      RETURN };

   InitStack(n) }

AND Store(p, r) BE
   FOR t = tempv TO arg1 BY SSSize DO {
      LET s = h5!t;
      IF s>r THEN RETURN;
      IF s>=p THEN StoreT(t) }

AND StoreT(x) BE {
   LET h5x = h5!x;
   LET t, i, loc, o = h1!x, h2!x, h3!x, h4!x
   UNLESS t=k.loc & i<0 & o=0 & loc=h5x THEN {
      LET n = RegisterDedicatedToLoc(h5x);
      LET storeNeeded, inFR = TRUE, FALSE;
      LET wastos = ?;
      LET d = n;

      TEST t=k.freg & i<0 & o=0 THEN
	 inFR := TRUE
      ELSE TEST n=Null THEN
	 n := MoveToAnyCRSomeTimeForStoreTo(x, k.loc, h5x)
      ELSE {
	 MoveToRSomeTime(n, x);
	 storeNeeded := FALSE };

      TEST inFR THEN
	 TEST d~=Null THEN
	    MoveFRToR(loc, d, x)
	 ELSE {
	    LET b, n = r.p, h5x;
	    TEST usesFrame THEN
	       IF linkageNotStored THEN b := r.ts
	    ELSE
	       b, n := r.ts, n-saveSpaceSize;
	    n := (nextStackWord/BytesPerWord)*n;
	    wastos := DiscardAddress(k.loc, h5x);
	    TEST wastos | h5x=TOSOffset THEN {
	       FOR n = h5x-1 TO 4 BY -1 DO {
		  LET p = SlocInList(PendingStores, k.loc, n);
		  IF p~=Null THEN {
		     FlushPendingStoresUpTo(p);
		     BREAK } };
	       IF h5x=TOSOffset THEN TOSOffset := TOSOffset+1
	       StoreFR(loc, r.ts, f.post/*f.wb implied*/, 1) }
	    ELSE
	       StoreFR(loc, b, f.pre, n);
	 wastos := StoreR(k.freg, loc, k.loc, h5x) }
      ELSE {
	 wastos := StoreR(k.reg, n, k.loc, h5x);
	 IF StoreNeeded THEN
	    TEST h5x=TOSOffset THEN {
	       AddToPendingStores(n, k.loc, h5x, TRUE, 0);
	       TOSOffset := TOSOffset+1 }
	    ELSE
	       AddToPendingStores(n, k.loc, h5x, wastos, 0) };
      h1!x, h2!x, h3!x, h4!x := k.loc, -1, h5x, 0 } }

AND IsSimpleStoreLoc(x) = VALOF {
   LET type = h1!x;
   RESULTIS h2!x<0 &
	    (type=k.loc | type=k.lab | type=k.static | type=k.glob) }

AND IsInTheStack(x) = h1!x=k.loc & h2!x<0 & h4!x=0

AND Class(x, FindCopy) = VALOF
   TEST h2!x>=0 THEN
      RESULTIS atype
   ELSE SWITCHON h1!x INTO
   {  CASE k.number: RESULTIS ktype
      CASE k.loc:
      CASE k.glob:
      CASE k.static:
      CASE k.lab:    IF h4!x=0 THEN
			IF ~FindCopy | LookFor(x, NotAddr)<0 THEN
			   RESULTIS atype
      DEFAULT:	     RESULTIS rtype
      CASE k.shreg:  RESULTIS shiftedrtype
      CASE k.reg:    RESULTIS locked(h3!x, k.reg) -> lockedrtype,
					      rtype }

AND IsConst(x) = VALOF
   TEST h1!x=k.number & h2!x<0 THEN {
      h3!x := h3!x+h4!x; h4!x := 0;
      RESULTIS TRUE }
   ELSE
      RESULTIS FALSE
