CVS: sml-dist/src/MLRISC/amd64/ra amd64PseudoR.sml, NONE, 1.1 amd64RA.sml, NONE, 1.1 amd64RegAlloc.sml, NONE, 1.1 amd64Rewrite.sig, NONE, 1.1 amd64Rewrite.sml, NONE, 1.1 amd64SpillInstr.sml, NONE, 1.1

Matthias Blume <[email protected]> Thu, 05 Oct 2006 08:09:18 -0700
Newsgroups gmane.comp.lang.sml.smlnj.commits
Message-ID <[email protected]>
Update of /cvsroot/smlnj/sml-dist/src/MLRISC/amd64/ra
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv621/amd64/ra

Added Files:
	amd64PseudoR.sml amd64RA.sml amd64RegAlloc.sml 
	amd64Rewrite.sig amd64Rewrite.sml amd64SpillInstr.sml 
Log Message:
added AMD64 stuff to MLRISC tree

--- NEW FILE: amd64PseudoR.sml ---
signature AMD64REWRITE_PSEUDO = sig
  structure F : FLOWGRAPH
    (* 
     * Takes a cluster and returns a range of registers to prohibit 
     * from spilling.  The arguments are:
     * 1. The first pseudo register
     * 2. The regmap before RA32.  If this is guaranteed to be 
     *    an identity you can use the identity function.   
     *    I use I.C.lookup regmap.
     *    
     * 3. The cluster.
     *
     * It returns a range of registers.
     *
     * NOTE: this version does not assume that the original regmap
     *       is an identity.  So there is some ugly regmap business to
     *       take care of.
     *
     *)
  val rewrite : 
      { firstPseudo    : F.I.C.cell,
        originalRegmap : F.I.C.cell -> F.I.C.cell,
        pruneCellSets  : bool (* should we remove references to memory 
                               * registers from all cell sets?
                               *)
      } -> F.cluster -> F.I.C.cell * F.I.C.cell
end


functor AMD64RewritePseudo
  (structure Instr : AMD64INSTR
   structure Flowgraph : FLOWGRAPH where I = Instr
   val ea : int -> Instr.operand) : AMD64REWRITE_PSEUDO =
struct
  structure C = AMD64Cells
  structure I = Instr
  structure F = Flowgraph

  fun error msg = MLRiscErrorMsg.error("AMD64RewritePseudo",msg)

  fun rewrite {firstPseudo, originalRegmap, pruneCellSets} 
              (F.CLUSTER{blocks, regmap, ...}) = 
  let
    val first = C.newReg()
    val lookup = C.lookup regmap
    fun shuffle(dests, srcs, tmp)  = let
      fun move(rd,rs) = I.MOVE{mvOp=I.MOVL, src=rs, dst=rd}
      fun loop((p as (rd, dst, rs, src))::rest, changed, used, done, instrs) = 
	  if List.exists (fn (r : I.C.cell) => dst=r) used then
	    loop(rest, changed, used, p::done, instrs)
	  else 
	    loop(rest, true, used, done, move(I.Direct rd, I.Direct rs)::instrs)
	| loop([], false, _, done, instrs) = (done, instrs)
	| loop([], true, _, done, instrs) = 
	    loop(done, false, map #4 done, [], instrs)

      fun cycle([], instrs) = instrs
	| cycle(moves, instrs) = 
	  (case loop(moves, false, map #4 moves, [], instrs) 
	   of ([], instrs) => instrs
	    | ((rd, rd', rs, rs')::nonCyclic, instrs) => let
		val SOME tmpR = tmp
		val instrs' = move(tmpR, I.Direct rs)::instrs
		val (cyclic, instrs'') = 
		  loop(nonCyclic, false, map #4 nonCyclic, [], instrs')
	      in cycle(cyclic, move(I.Direct rd, Option.valOf tmp)::instrs'')
	      end
	  (*esac*))
      fun rmCoalesced([], [], remain, coalesced) = (remain, coalesced)
	| rmCoalesced(rd::rds, rs::rss, remain, coalesced) = let
	    val dst = lookup rd
	    val src = lookup rs
	  in
	    if dst = ~1 then (* eliminate dead copies *)
	      rmCoalesced(rds, rss, remain, coalesced)
            else if dst = src then 
	      rmCoalesced(rds, rss, remain, 
                          move(I.Direct rd, I.Direct rs)::coalesced)
	    else rmCoalesced(rds, rss, (rd, dst, rs, src)::remain, coalesced)
	  end
    in rev (cycle (rmCoalesced(dests, srcs, [], [])))
    end

    fun doBlock(F.BBLOCK{blknum, insns, liveOut, succ, ...}) = let
	  fun pseudoR r = (r >= 8 andalso r < firstPseudo)
	  fun resetLiveOut() = let
	    fun reset(gp, fp, cc) = 
	      liveOut := (List.filter (not o pseudoR) gp, fp, cc)
	  in
	    case !succ
	     of [] => reset(!liveOut)
	      | [(F.EXIT _,_)] => reset(!liveOut)
	      | _ => ()
	  end

	  (* subst: hd(acc) is the last instruction in the stream. *)
	  fun subst(instr, acc) = let
            fun mark(i,[]) = i
              | mark(i,a::an) = mark(I.ANNOTATION{i=i,a=a},an)

	    fun movl{src, dst, acc} = 
	        I.MOVE{mvOp=I.MOVL, src=src, dst=dst}::acc

	    fun displace(base, disp, acc, mem) = 
            let val base' = originalRegmap base
            in  if pseudoR base' then 
	        let val tmpR = C.newReg()
		    val newDisp = I.Displace{base=tmpR, disp=disp, mem=mem}
  		in (newDisp, movl{src=ea base', dst=I.Direct tmpR, acc=acc})
		end
 	        else (I.Displace{base=base, disp=disp, mem=mem}, acc)
            end

	    fun indexedEa(base, index, scale, disp, mem) = 
	      I.Indexed{base=base, index=index, scale=scale, disp=disp, mem=mem}

	    fun indexed(NONE, index, scale, disp, acc, mem) = 
                let val index' = originalRegmap index
                in  if pseudoR index' then 
		    let val tmpR = C.newReg()
		        val newIndx = indexedEa(NONE, tmpR, scale, disp, mem)
		    in (newIndx,movl{src=ea index', dst=I.Direct tmpR, acc=acc})
		    end
		    else (indexedEa(NONE, index, scale, disp, mem), acc)
                end
	      | indexed(ba as SOME base, index, scale, disp, acc, mem) = 
                let val base'  = originalRegmap base
                    val index' = originalRegmap index
		    val b = pseudoR base'
		    val i = pseudoR index'
		in  if b andalso i then 
                    let val tmpB = C.newReg()
		        val tmpI = C.newReg()
		        val opnd = indexedEa(SOME tmpB, tmpI, scale, disp, mem)
		    in (opnd, movl{src=ea base', dst=I.Direct tmpB, 
				   acc=movl{src=ea index', 
                                            dst=I.Direct tmpI, acc=acc}})
		    end
		  else if b then let
		      val tmpB = C.newReg()
		    in (indexedEa(SOME tmpB, index, scale, disp, mem), 
			movl{src=ea base', dst=I.Direct tmpB, acc=acc})
		    end
		  else if i then let
		      val tmpI = C.newReg()
		    in (indexedEa(ba, tmpI, scale, disp, mem), 
			movl{src=ea index', dst=I.Direct tmpI, acc=acc})
		    end
		  else (indexedEa(ba, index, scale, disp, mem), acc)

		end
	    fun direct(r, acc) = 
            let val r' = originalRegmap r
            in  if pseudoR r' then (ea r', acc) else (I.Direct r, acc) 
            end

	    fun operand(I.Direct r, acc) = direct(r, acc)
	      | operand(I.Indexed{base, index, scale, disp, mem}, acc) = 
		 indexed(base, index, scale, disp, acc, mem)
	      | operand(I.Displace{base, disp, mem}, acc) = 
                 displace(base, disp, acc, mem)
	      | operand arg = arg

	    fun done(opnd, f, an) = 
	    let val (opnd', acc') = operand(opnd, acc)
	    in  mark(f opnd', an) :: acc'
	    end

	    fun memArg(I.Displace _) = true
	      | memArg(I.Indexed _) = true
	      | memArg(I.MemReg _) = true
	      | memArg(I.LabelEA _) = true
	      | memArg _ = false

	    fun withTmp f =
            let val t = C.newReg()
	    in  f t
	    end

            fun rewriteCmpTest(cmptest, lsrc, rsrc, an) =
            let val (lsrcOpnd, acc1) = operand(lsrc, acc)
                val (rsrcOpnd, acc2) = operand(rsrc, acc1)
	    in  if memArg lsrcOpnd andalso memArg rsrcOpnd then 
		    withTmp(fn t =>
		       mark(cmptest{lsrc=I.Direct t, rsrc=rsrcOpnd},an)::
			 movl{src=lsrcOpnd, dst=I.Direct t, acc=acc2})
		else
		    mark(cmptest{lsrc=lsrcOpnd, rsrc=rsrcOpnd},an)::acc2
	    end

            fun rewrite(instr,an) =
	    case instr
	     of I.JMP(opnd, labs) => done(opnd,fn opnd => I.JMP(opnd, labs),an)
	      | I.JCC{opnd, cond} => 
                  done(opnd,fn opnd => I.JCC{opnd=opnd, cond=cond}, an)
	      | I.MOVE{src, dst, mvOp} => let
		  val (srcOpnd, acc1) = operand(src, acc)
		  val (dstOpnd, acc2) = operand(dst, acc1)
		in
		  if memArg srcOpnd andalso memArg dstOpnd then 
		    withTmp(fn t =>
		       mark(I.MOVE{src=I.Direct t, dst=dstOpnd, mvOp=mvOp},an)::
			    movl{src=srcOpnd, dst=I.Direct t, acc=acc2})
		  else 
		    mark(I.MOVE{src=srcOpnd, dst=dstOpnd, mvOp=mvOp},an)::acc2
		end
	      | I.LEA{r32, addr} => let
		  val (srcOpnd, acc1) = operand(addr, acc)
                  val r32' = originalRegmap r32
		in
		  if pseudoR r32' then 
		    withTmp(fn t =>
		       movl{dst=ea r32', src=I.Direct t, 
		 	    acc=mark(I.LEA{r32=t, addr=srcOpnd},an)::acc1})
		  else mark(I.LEA{r32=r32, addr=srcOpnd},an)::acc1
		end
	      | I.LEAQ{r32, addr} => let
		  val (srcOpnd, acc1) = operand(addr, acc)
                  val r64' = originalRegmap r64
		in
		  if pseudoR r64' then 
		    withTmp(fn t =>
		       movl{dst=ea r64', src=I.Direct t, 
		 	    acc=mark(I.LEAQ{r64=t, addr=srcOpnd},an)::acc1})
		  else mark(I.LEAQ{r64=r64, addr=srcOpnd},an)::acc1
		end
	      | I.CMPL{lsrc, rsrc} => rewriteCmpTest(I.CMPL, lsrc, rsrc, an)
	      | I.CMPW{lsrc, rsrc} => rewriteCmpTest(I.CMPW, lsrc, rsrc, an)
	      | I.CMPB{lsrc, rsrc} => rewriteCmpTest(I.CMPB, lsrc, rsrc, an)
	      | I.TESTL{lsrc, rsrc} => rewriteCmpTest(I.TESTL, lsrc, rsrc, an)
	      | I.TESTW{lsrc, rsrc} => rewriteCmpTest(I.TESTW, lsrc, rsrc, an)
	      | I.TESTB{lsrc, rsrc} => rewriteCmpTest(I.TESTB, lsrc, rsrc, an)
	      | I.BINARY{binOp, src, dst} => let
		  val (srcOpnd, acc1) = operand(src, acc)
		  val (dstOpnd, acc2) = operand(dst, acc1)
		in 
		  if memArg srcOpnd andalso memArg dstOpnd then
		    withTmp(fn t =>
	             mark(I.BINARY{binOp=binOp,src=I.Direct t,dst=dstOpnd},an)::
			 movl{src=srcOpnd, dst=I.Direct t, acc=acc2})
		  else 
                    mark(I.BINARY{binOp=binOp,src=srcOpnd,dst=dstOpnd},an)::acc2
		end
	      | I.CALL(opnd,def,use,mem) => let
		  val (opnd1, acc1) = operand(opnd, acc)
		  fun cellset(gp, fp, cc) =
                    if pruneCellSets then
		      (List.filter (not o pseudoR) gp, fp, cc)
                    else
                      (gp, fp, cc)
		in mark(I.CALL(opnd1, cellset def, cellset use, mem),an)::acc1
		end
	      | I.CALLQ(opnd,def,use,mem) => let
		  val (opnd1, acc1) = operand(opnd, acc)
		  fun cellset(gp, fp, cc) =
                    if pruneCellSets then
		      (List.filter (not o pseudoR) gp, fp, cc)
                    else
                      (gp, fp, cc)
		in mark(I.CALLQ(opnd1, cellset def, cellset use, mem),an)::acc1
		end
	      | I.MULTDIV{multDivOp, src} => 
		  done(src, 
                       fn opnd => I.MULTDIV{multDivOp=multDivOp, src=opnd}, an)
	      | I.MUL3{dst, src1, src2} =>  let
		  val (src1Opnd, acc1) = operand(src1, acc)
                  val dst' = originalRegmap dst
		in
		  if pseudoR dst' then
		    withTmp(fn t =>
		      movl{dst=ea dst', src=I.Direct t, acc=
			mark(I.MUL3{dst=t, src1=src1Opnd, src2=src2},an)::acc1})
		  else mark(I.MUL3{dst=dst, src1=src1Opnd, src2=src2},an)::acc1
		end
	      | I.UNARY{unOp, opnd} => 
		  done(opnd, fn opnd => I.UNARY{unOp=unOp, opnd=opnd}, an)
	      | I.SET{cond, opnd} => 
		  done(opnd, fn opnd => I.SET{cond=cond, opnd=opnd}, an)
	      | I.PUSHL opnd => done(opnd, I.PUSHL, an)	
	      | I.PUSHW opnd => done(opnd, I.PUSHW, an)	
	      | I.PUSHB opnd => done(opnd, I.PUSHB, an)	
	      | I.POP opnd => done(opnd, I.POP, an)
	      | I.CMOV{cond, src, dst} => 
                  let val (srcOpnd, acc1) = operand(src, acc)
                      val dst' = originalRegmap dst
                  in  if pseudoR dst then
		        withTmp(fn t =>
		         movl{dst=ea dst', src=I.Direct t, acc=
                           mark(I.CMOV{cond=cond, dst=t, src=srcOpnd},an)::
                             acc1})
		      else 
                        mark(I.CMOV{cond=cond, dst=dst, src=srcOpnd},an)::acc1
                  end
	      | I.CMOVQ{cond, src, dst} => 
                  let val (srcOpnd, acc1) = operand(src, acc)
                      val dst' = originalRegmap dst
                  in  if pseudoR dst then
		        withTmp(fn t =>
		         movl{dst=ea dst', src=I.Direct t, acc=
                           mark(I.CMOVQ{cond=cond, dst=t, src=srcOpnd},an)::
                             acc1})
		      else 
                        mark(I.CMOVQ{cond=cond, dst=dst, src=srcOpnd},an)::acc1
                  end
	      | I.COPY{dst, src, tmp} => let
		  (* Note:
		   *  Parallel copies are not allowed after this point.
		   *  Consider:
		   *    (r8, r9, edx) <- (566, 567, 560)
		   *
		   *  RA32 may well decide to allocate 560 to r8.
		   *  After the rewrite we will get:
		   *
		   *      mem[r8] <- 566
		   *	  mem[r9] <- 567
		   *          edx <- 560
		   * 
		   * If 560 should spill, we all of a sudden have the 
		   * incorrect value being read from the spill location.
		   *)
		  fun f((instr as I.MOVE{mvOp, src, dst})::rest, acc) =
		      (case (src, dst)
			of (I.Direct s, I.Direct d) =>
                        let val d' = originalRegmap d   
                            val s' = originalRegmap s
			in  if s'=d' then f(rest, acc) 
                            else if pseudoR d' andalso pseudoR s' then
			            f(rest, withTmp(fn t =>
				       (movl{src=I.Direct t, dst=ea d', 
                                           acc=movl{src=ea s', 
                                             dst=I.Direct t, acc=acc}})))
			    else if pseudoR d' then
			      f(rest, withTmp(fn t =>
				 (movl{src=I.Direct s, dst=ea d', acc=acc})))
			    else if pseudoR s' then
			      f(rest, withTmp(fn t =>
			         (movl{src=ea s', dst=I.Direct d, acc=acc})))
			    else f(rest,I.COPY{src=[s], dst=[d],tmp=NONE}::acc)
                        end

		         | _  => f(rest, instr::acc)
		      (*esac*))

		    | f([], acc) = acc
	        in f(shuffle (dst, src, tmp), acc)
		end
	      | I.FSTPT opnd => done(opnd, I.FSTPT, an)
	      | I.FSTPL opnd => done(opnd, I.FSTPL, an)
	      | I.FSTPS opnd => done(opnd, I.FSTPS, an)
	      | I.FSTL opnd => done(opnd, I.FSTL, an)
	      | I.FSTS opnd => done(opnd, I.FSTS, an)
	      | I.FLDT opnd => done(opnd, I.FLDT, an)
	      | I.FLDL opnd => done(opnd, I.FLDL, an)
	      | I.FLDS opnd => done(opnd, I.FLDS, an)
	      | I.FILD opnd => done(opnd, I.FILD, an)
	      | I.FILDL opnd => done(opnd, I.FILDL, an)
	      | I.FILDLL opnd => done(opnd, I.FILDLL, an)
	      | I.FENV{fenvOp, opnd} => done(opnd, 
                    fn opnd => I.FENV{fenvOp=fenvOp,opnd=opnd}, an)
	      | I.FBINARY{src,dst,binOp} => 
		  done(src, 
                       fn opnd => I.FBINARY{binOp=binOp, src=opnd, dst=dst},an)
	      | I.FIBINARY{src,binOp} => 
		  done(src, fn opnd => I.FIBINARY{binOp=binOp, src=opnd},an)
              | I.ANNOTATION{i,a} => rewrite(i,a::an)
	      | _ => mark(instr,an)::acc
          in  rewrite(instr,[])
	  end (* subst *)
	in insns := List.foldl subst [] (rev(!insns));
	   if pruneCellSets then resetLiveOut() else ()
	end (*doBlock*)
      | doBlock _ = ()
  in app doBlock blocks;  (first, C.newReg())
  end (* rewrite *)
end

--- NEW FILE: amd64RA.sml ---
(*
 * AMD64 specific register allocator.
 * This module abstracts out all the nasty RA business on the amd64.  
 * So you should only have to write the callbacks.
 *
 *   Here's more some info on the amd64 functor.
 *Basically the new functor encapsulates all the features in the
 *amd64 register allocator, including things like memory pseudo registers,
 *and the new floating point allocator that maps things onto the %st registers.
 *For floating point, we can also switch between the sethi-ullman mode and 
 *the %st register mode.
 *
 *   Notes on the parameters of the functor: 
 *
 *>   structure SpillHeur : RA_SPILL_HEURISTICS
 *
 *   This should be one of the spill heuristic module like ChaitinSpillHeur or
 * Command ('i' to return to index):  you can also roll your own.
 *
 *>   structure Spill : RA_SPILL 
 *
 *   This should be either RASpill or RASpillWithRenaming.
 *
 *>   val fast_floating_point : bool ref
 *
 *    This flag is used to turn on the new amd64 fp mode.  The same flag
 *    is also passed to the amd64 instruction selection module.
 *
 *>   datatype raPhase = SPILL_PROPAGATION | SPILL_COLORING
 *
 *    This datatype specifies which additional phases we should run.
 *
 *>   val beforeRA : flowgraph -> spill_info
 *
 *    This callback is invoked before each call to RA.  The RA may have
 *    to perform both integer and floating point RA.  This is called before
 *    integer RA.   
 *
 *    The callbacks for integer and floating point are separated into
 *    the substructures Int and Float.
 *
 *>   structure Int :
 *>   sig
 *>      val avail     : I.C.cell list
 *>      val dedicated : I.C.cell list
 *>      val memRegs   : I.C.cell list
 *>      val phases    : raPhase list
 *>      val spillLoc  : spill_info * Annotations.annotations ref *
 *>                      RAGraph.logical_spill_id -> I.operand
 *>      val spillInit :  RAGraph.interferenceGraph -> unit
 *>   end                 
 *
 *    avail is the list of registers available for allocation
 *    memRegs is the list of memory registers that may appear in the program
 *    phases is a list of additional RA phases.  I recommend turning on 
 *    everything:
 *
 *         [SPILL_PROPAGATION, SPILL_COLORING]
 *
 *    spillInit is called once before spilling occurs.
 *
 *    spillLoc is a callback that maps logical_spill_ids into an amd64
 *    effective address.  The list of allocations is from the block in which
 *    the spilled instruction occurs.  The client should keep track of 
 *    existing ids, and allocate a new effective address when a new id occurs.
 *    In general, the client should keep track of a single table of free
 *    spill space for both integer and floating point registers.
 *
 *    Previously, the spill/reload routines have to do special things in the
 *    presence of memory registers, but that stuff is taken care of in the
 *    new module, so all spillLoc has to do is map logical_spill_ids into
 *    effective address.
 *
 *>   structure Float :
 *>   sig
 *>      val avail     : I.C.cell list
 *>      val dedicated : I.C.cell list
 *>      val memRegs   : I.C.cell list
 *>      val phases    : raPhase list
 *>      val spillLoc  : spill_info * Annotations.annotations ref *
 *>                      RAGraph.logical_spill_id -> I.operand
 *>      val spillInit : RAGraph.interferenceGraph -> unit
 *>   end   
 *
 *    For floating point, it is similar.
 *
 *>   
 *>      val fastMemRegs : I.C.cell list
 *>      val fastPhases  : raPhase list
 *
 *    When fast_floating_point is turned on, we use different parameters:  
 *
 *    avail is set to [%st(0), ..., %st(6)]  
 *    dedicated is set to []
 *    memRegs is set to fastMemRegs
 *
 *    In general, the flow of the module is like this:
 *
 *    ra:
 *         call beforeRA()
 *         integer RA --- call Int.spillInit() once if spilling is needed
 *         floating fp RA --- call Real.spillInit() once if spilling is needed
 *         if !fast_floating_point then
 *            invoke the module AMD64FP to convert fake %fp registers 
 *            into real %st registers
 *         endif
 *
 *)

functor AMD64RA 
  ( structure I          : AMD64INSTR
    structure InsnProps  : INSN_PROPERTIES 
			       where I = I
    structure CFG        : CONTROL_FLOW_GRAPH 
			       where I = I
    structure Asm        : INSTRUCTION_EMITTER 
			       where I = I 
				 and S.P = CFG.P

      (* Spilling heuristics determines which node should be spilled 
       * You can use Chaitin, ChowHenessey, or one of your own.
       *)
    structure SpillHeur : RA_SPILL_HEURISTICS 

      (* The Spill module figures out the strategies for inserting 
       * spill code.  You can use RASpill, or RASpillWithRenaming,
       * or write your own if you are feeling adventurous.
       *)
    structure Spill : RA_SPILL where I = I 


    type spill_info (* user-defined abstract type *)

       (* Should we use allocate register on the floating point stack? 
        * Note that this flag must match the one passed to the code generator 
        * module.
        *)
    val fast_floating_point : bool ref

    datatype raPhase = SPILL_PROPAGATION 
                     | SPILL_COLORING

    datatype spillOperandKind = SPILL_LOC | CONST_VAL

    (* Called before register allocation; perform your initialization here. *)
    val beforeRA : CFG.cfg -> spill_info

    (* Integer register allocation parameters *)
    structure Int :
    sig
       val avail     : CellsBasis.cell list
       val dedicated : CellsBasis.cell list
       val memRegs   : CellsBasis.cell list
       val phases    : raPhase list

       val spillLoc  : {info:spill_info,
                        an  :Annotations.annotations ref,
                        cell:CellsBasis.cell, (* spilled cell *)
                        id  :RAGraph.logical_spill_id
                       } -> 
                       { opnd: I.ea,
                         kind: spillOperandKind
                       }

       (* This function is called once before spilling begins *)
       val spillInit :  RAGraph.interferenceGraph -> unit

    end   

    (* Floating point register allocation parameters *)
    structure Float :
    sig
       (* Sethi-Ullman mode *)
       val avail     : CellsBasis.cell list
       val dedicated : CellsBasis.cell list
       val memRegs   : CellsBasis.cell list
       val phases    : raPhase list

       val spillLoc  : spill_info * Annotations.annotations ref * RAGraph.logical_spill_id 
		           -> I.ea

       (* This function is called once before spilling begins *)
       val spillInit : RAGraph.interferenceGraph -> unit

       (* When fast_floating_point is on, use these instead: *)
       val fastMemRegs : CellsBasis.cell list
       val fastPhases  : raPhase list
    end

  ) : CFG_OPTIMIZATION =
struct

    structure CFG = CFG
    structure I = I
    structure C = I.C
    structure CB = CellsBasis

    val name = "AMD64RA"

    type flowgraph = CFG.cfg

    val intSpillCnt = MLRiscControl.mkCounter ("ra-int-spills", "RA int spill count")
    val intReloadCnt = MLRiscControl.mkCounter ("ra-int-reloads", "RA int reload count")
    val intRenameCnt = MLRiscControl.mkCounter ("ra-int-renames", "RA int rename count")
    val floatSpillCnt = MLRiscControl.mkCounter ("ra-float-spills", "RA float spill count")
    val floatReloadCnt = MLRiscControl.mkCounter ("ra-float-reloads", "RA float reload count")
    val floatRenameCnt = MLRiscControl.mkCounter ("ra-float-renames", "RA float rename count")

    fun inc c = c := !c + 1

    val amd64CfgDebugFlg = MLRiscControl.mkFlag ("amd64-cfg-debug", "amd64 CFG debug mode")

    fun error msg = MLRiscErrorMsg.error("AMD64RA",msg)

    structure PrintFlowgraph=
       PrintFlowgraph(structure CFG=CFG
                      structure Asm = Asm)

    structure AMD64FP = 
       AMD64FP(structure AMD64Instr = I
             structure AMD64Props = InsnProps
             structure Flowgraph = CFG
             structure Liveness = Liveness(CFG)
             structure Asm = Asm
            )

   structure AMD64SpillInstr = AMD64SpillInstr(structure Instr=I structure Props=InsnProps)
   val spillFInstr = AMD64SpillInstr.spill CB.FP
   val reloadFInstr = AMD64SpillInstr.reload CB.FP
   val spillInstr = AMD64SpillInstr.spill CB.GP
   val reloadInstr = AMD64SpillInstr.reload CB.GP

    val sz = 64 (* default integer width *)

   fun annotate([], i) = i
     | annotate(a::an, i) = annotate(an, I.ANNOTATION{a=a, i=i})

    (* 
     * Dead code elimination 
     *)
    exception AMD64DeadCode
    val affectedBlocks =
	  IntHashTable.mkTable(32,AMD64DeadCode) : bool IntHashTable.hash_table
    val deadRegs       =
	  IntHashTable.mkTable(32,AMD64DeadCode) : bool IntHashTable.hash_table

    fun removeDeadCode(cfg as Graph.GRAPH graph) = let
        val blocks = #nodes graph ()
        val find = IntHashTable.find deadRegs
        fun isDead r = 
            case find (CB.cellId r) of
               SOME _ => true
            |  NONE   => false
        fun isAffected i = getOpt (IntHashTable.find affectedBlocks i, false)
        fun isDeadInstr(I.ANNOTATION{i, ...}) = isDeadInstr i 
          | isDeadInstr(I.INSTR(I.MOVE{dst=I.Direct (_,rd), ...})) = isDead rd
          | isDeadInstr(I.COPY{k=CB.GP, dst=[rd], ...}) = isDead rd
(*          | isDeadInstr(I.INSTR(I.MOVE{dst=I.MemReg rd, ...})) = isDead rd*)
          | isDeadInstr _ = false
        fun scan [] = ()
          | scan((blknum, CFG.BLOCK{insns, ...})::rest) =
            (if isAffected blknum then 
                ((* deadblocks := !deadblocks + 1; *)
                 insns := elim(!insns, [])
                ) else ();
             scan rest)
       and elim([], code) = rev code
         | elim(i::instrs, code) = 
          if isDeadInstr i then 
             ((* deadcode := !deadcode + 1; *) elim(instrs, code))
          else elim(instrs, i::code)
    in if IntHashTable.numItems affectedBlocks > 0 then 
          (scan blocks;
	     IntHashTable.clear deadRegs;
	     IntHashTable.clear affectedBlocks)
       else ()
    end

    (* This function finds out which pseudo memory registers are unused.
     * Those that are unused are made available for spilling.
     * The register allocator calls this function right before spilling 
     * a set of nodes.
     *)
    val firstSpill = ref true
    val firstFPSpill = ref true

    fun spillInit(graph, CB.GP) = 
        if !firstSpill then (* only do this once! *)
            (Int.spillInit graph;
             firstSpill := false
            )
         else ()
      | spillInit(graph, CB.FP) = 
        if !firstFPSpill then
            (Float.spillInit graph;
             firstFPSpill := false
            )
        else ()
      | spillInit _ = error "spillInit"

    (* This is the generic register allocator *)
    structure Ra = 
      RegisterAllocator
       (SpillHeur)
       (MemoryRA             (* for memory coalescing *)
         (RADeadCodeElim     (* do the funky dead code elimination stuff *)
            (ClusterRA
               (structure Flowgraph = CFG
                structure Asm = Asm
                structure InsnProps = InsnProps
                structure Spill = Spill
               )
            )
            (fun cellkind CB.GP = true | cellkind _ = false
             val deadRegs = deadRegs
             val affectedBlocks = affectedBlocks
             val spillInit = spillInit
            )
         )
      )


    (* -------------------------------------------------------------------
     * Floating point stuff 
     * -------------------------------------------------------------------*)
    val KF32 = length Float.avail
    structure FR32 = GetReg(val nRegs=KF32 
                            val available=map CB.registerId Float.avail
                            val first=CB.registerId(I.C.ST 8))

    val availF8 = C.Regs CB.FP {from=0, to=6, step=1}
    val KF8  = length availF8
    structure FR8  = GetReg(val nRegs=KF8
                            val available=map CB.registerId availF8
                            val first=CB.registerId(I.C.ST 0))

    (* -------------------------------------------------------------------
     * Callbacks for floating point K=32 
     * -------------------------------------------------------------------*)
    fun fcopy{dst, src, tmp} = 
	I.COPY{k=CB.FP, sz=64, dst=dst, src=src, tmp=tmp}

    fun copyInstrF((rds as [_], rss as [_]), _) =
          fcopy{dst=rds, src=rss, tmp=NONE}
      | copyInstrF((rds, rss), I.COPY{k=CB.FP, tmp, ...}) = 
          fcopy{dst=rds, src=rss, tmp=tmp}
      | copyInstrF(x, I.ANNOTATION{i,a}) = 
          I.ANNOTATION{i=copyInstrF(x, i), a=a}
      | copyInstrF _ = error "copyInstrF"

    val copyInstrF = fn x => [copyInstrF x]
 
    fun getFregLoc(S, an, Ra.FRAME loc) = Float.spillLoc(S, an, loc)
      | getFregLoc(S, an, Ra.MEM_REG r) = I.FDirect r

    (* spill floating point *)
    fun spillF S {annotations=an, kill, reg, spillLoc, instr} = let
      (* preserve annotation on instruction *)
      fun spill(instrAn, I.ANNOTATION{a, i}) = spill(a::instrAn, i)
	| spill(instrAn, I.KILL{regs, spilled}) = 
	   {code=
	      [annotate
		(instrAn, 
		 I.KILL {regs=C.rmvFreg(reg, regs), 
			 spilled=C.addFreg(reg, spilled)})],
	     proh = [], 
	     newReg=NONE}
	| spill(instrAn, I.LIVE _) = error "spillF: LIVE"
	| spill(_, I.COPY _) = error "spillF: COPY"
	| spill(instrAn, I.INSTR _) = 
	  (inc floatSpillCnt;
	   spillFInstr(instr, reg, getFregLoc(S, an, spillLoc)))
    in spill([], instr)
    end

    fun spillFreg S {src, reg, spillLoc, annotations=an} = 
       (inc floatSpillCnt;
        let val fstp = [I.fstpl(getFregLoc(S, an, spillLoc))]
        in  if CB.sameColor(src,C.ST0) then fstp
            else I.fldl(I.FDirect(src))::fstp
        end
       )

   fun spillFcopyTmp S {copy=I.COPY{k=CB.FP, dst, src, ...}, spillLoc, reg,
                        annotations=an} =
        (inc floatSpillCnt;
         fcopy{dst=dst, src=src, tmp=SOME(getFregLoc(S, an, spillLoc))}
        )
     | spillFcopyTmp S {copy=I.ANNOTATION{i,a}, spillLoc, reg, annotations} =
        let val i = spillFcopyTmp S {copy=i, spillLoc=spillLoc, reg=reg,
                                     annotations=annotations}
        in  I.ANNOTATION{i=i, a=a} end
     | spillFcopyTmp _ _ = error "spillFcopyTmp"

    (* rename floating point *)
    fun renameF{instr, fromSrc, toSrc} =
        (inc floatRenameCnt;
         reloadFInstr(instr, fromSrc, I.FDirect toSrc)
        )

    (* reload floating point *)
    fun reloadF S {annotations=an,reg,spillLoc,instr} = let
      fun reload(instrAn, I.ANNOTATION{a,i}) = reload(a::instrAn, i)
	| reload(instrAn, I.LIVE{regs, spilled}) = 
	   {code=[I.LIVE{regs=C.rmvFreg(reg, regs), spilled=C.addFreg(reg, spilled)}],
	    proh=[],
	    newReg=NONE}
	| reload(_, I.KILL _) = error "reloadF: KILL"
	| reload (_, I.COPY _) = error "reloadF: COPY"
	| reload(instrAn, instr as I.INSTR _) = 
  	   (inc floatReloadCnt;
	    reloadFInstr(instr, reg, getFregLoc(S, an, spillLoc)))
    in reload([], instr)
    end

    fun reloadFreg S {dst, reg, spillLoc, annotations=an} = 
        (inc floatReloadCnt;
         if CB.sameColor(dst,C.ST0) then 
            [I.fldl(getFregLoc(S, an, spillLoc))]
         else  
            [I.fldl(getFregLoc(S, an, spillLoc)), I.fstpl(I.FDirect dst)]
        )

    (* -------------------------------------------------------------------
     * Callbacks for floating point K=7 
     * -------------------------------------------------------------------*)
    fun FMemReg f = let val fx = CB.registerNum f
                    in  if fx >= 8 andalso fx < 32
                        then I.FDirect f else I.FPR f
                    end

    fun copyInstrF'((rds as [d], rss as [s]), _) =
         I.fmove{fsize=I.FP64,src=FMemReg s,dst=FMemReg d}
      | copyInstrF'((rds, rss), I.COPY{k=CB.FP, tmp, ...}) = 
         fcopy{dst=rds, src=rss, tmp=tmp}
      | copyInstrF'(x, I.ANNOTATION{i, a}) =
         I.ANNOTATION{i=copyInstrF'(x,i), a=a}
      | copyInstrF' _ = error "copyInstrF'"

    val copyInstrF' = fn x => [copyInstrF' x]

    fun spillFreg' S {src, reg, spillLoc, annotations=an} = 
        (inc floatSpillCnt;
         [I.fmove{fsize=I.FP64, src=FMemReg src, 
                  dst=getFregLoc(S, an,spillLoc)}]
        )

    fun renameF'{instr, fromSrc, toSrc} =
        (inc floatRenameCnt;
         reloadFInstr(instr, fromSrc, I.FPR toSrc)
        )

    fun reloadFreg' S {dst, reg, spillLoc, annotations=an} = 
        (inc floatReloadCnt;
         [I.fmove{fsize=I.FP64, dst=FMemReg dst, 
                  src=getFregLoc(S,an,spillLoc)}]
        )

    (* -------------------------------------------------------------------
     * Integer 8 stuff 
     * -------------------------------------------------------------------*)
    fun copy{dst, src, tmp} = I.COPY{k=CB.GP, sz=sz, dst=dst, src=src, tmp=tmp}
    fun memToMemMove{dst, src} =
        let val tmp = I.C.newReg() 
        in  [I.move{mvOp=I.MOVQ,src=src,dst=I.Direct (sz,tmp)},
             I.move{mvOp=I.MOVQ,src=I.Direct (sz,tmp),dst=dst}
            ]
        end

    fun copyInstrR((rds as [d], rss as [s]), _) =
        if CB.sameColor(d,s) then [] else [copy{dst=rds, src=rss, tmp=NONE}]
      | copyInstrR((rds, rss), I.COPY{k=CB.GP, tmp, ...}) = 
         [copy{dst=rds, src=rss, tmp=tmp}]
      | copyInstrR(x, I.ANNOTATION{i, a}) = 
          copyInstrR(x, i) (* XXX *)
      | copyInstrR _ = error "copyInstrR"
      

    fun getRegLoc(S, an, cell, Ra.FRAME loc) = 
         Int.spillLoc{info=S, an=an, cell=cell, id=loc}
      | getRegLoc(S, an, cell, Ra.MEM_REG r) = raise Fail "memory registers unsupported"
(* FIXME: now that memory regs are gone, what to do here? *)
(*{opnd=I.MemReg r,kind=SPILL_LOC}*)

        (* No, logical spill locations... *)

    structure GR8 = GetReg(val nRegs=16 (* FIXME!!!  this is the true number of regs *)
                           val available=map CB.registerId Int.avail
                           val first=0)

    val K16 = length Int.avail

     (* register allocation for general purpose registers *)
    fun spillR16 S {annotations=an, kill, reg, spillLoc, instr} = let
      fun annotate([], i) = i
	| annotate(a::an, i) = annotate(an, I.ANNOTATION{a=a, i=i})

      (* preserve annotation on instruction *)
      fun spill(instrAn, I.ANNOTATION{a,i}) = spill(a::instrAn, i)
	| spill(instrAn, I.KILL{regs, spilled}) = 
	   {code=
	      [annotate
		(instrAn, 
		 I.KILL {regs=C.rmvReg(reg, regs), 
			 spilled=C.addReg(reg, spilled)})],
	     proh = [], 
	     newReg=NONE}
	| spill(instrAn, I.LIVE _) = error "spill: LIVE"
	| spill(_, I.COPY _) = error "spill: COPY"
	| spill(instrAn, I.INSTR _) = 
	  (case getRegLoc(S, an, reg, spillLoc) 
	    of {opnd=spillLoc, kind=SPILL_LOC} => 
		   ( inc intSpillCnt;
		     spillInstr(annotate(instrAn, instr), reg, spillLoc)
		    ) 
	     | _ => (* don't have to spill a constant *)
		   {code=[], newReg=NONE, proh=[]} 
	  (*esac*))
    in spill([], instr)
    end

    fun isMemReg r = false
    (*let val x = CB.registerNum r
                     in if x >= 8 andalso x < 32 
			then (print "memreg"; raise Fail "dfs")
			else false
		     end*)

    fun spillReg S {src, reg, spillLoc, annotations=an} = 
        let val _ = inc intSpillCnt
            val {opnd=dstLoc,kind} = getRegLoc(S,an,reg,spillLoc)
            val isMemReg = isMemReg src
            val srcLoc = I.Direct (sz,src)
        in  if kind=CONST_VAL orelse InsnProps.eqOpn(srcLoc, dstLoc) then []
            else [I.move{mvOp=I.MOVQ, src=srcLoc, dst=dstLoc}]
        end

    fun spillCopyTmp S {copy=I.COPY{k=CB.GP, src, dst,...}, 
                        reg, spillLoc, annotations=an} = 
        (case getRegLoc(S, an, reg, spillLoc) of
           {opnd=tmp, kind=SPILL_LOC} =>
            (inc intSpillCnt;
             copy{dst=dst, src=src, tmp=SOME tmp}
            )
         | _ => error "spillCopyTmp"
        )
      | spillCopyTmp S {copy=I.ANNOTATION{i, a}, reg, spillLoc, annotations} =
        I.ANNOTATION{i=spillCopyTmp S {copy=i, reg=reg, spillLoc=spillLoc,
                                       annotations=annotations}, a=a}
      | spillCopyTmp _ _ = error "spillCopyTmp(2)"
   
    fun renameR8{instr, fromSrc, toSrc} = 
        (inc intRenameCnt;
         reloadInstr(instr, fromSrc, I.Direct (sz,toSrc))
        )


    fun reloadR8 S {annotations=an, reg, spillLoc, instr} = let
      fun reload(instrAn, I.ANNOTATION{a,i}) = reload(a::instrAn, i)
	| reload(instrAn, I.LIVE{regs, spilled}) = 
	   {code=[I.LIVE{regs=C.rmvReg(reg, regs), spilled=C.addReg(reg, spilled)}],
	    proh=[],
	    newReg=NONE}
	| reload(_, I.KILL _) = error "reload: KILL"
	| reload (_, I.COPY _) = error "reload: COPY"
	| reload(instrAn, instr as I.INSTR _)  = 
  	 ( inc intReloadCnt;
	   reloadInstr(annotate(instrAn, instr), reg, #opnd(getRegLoc(S,an,reg,spillLoc)))
  	  ) 
    in reload([], instr)
    end 

    fun reloadReg S {dst, reg, spillLoc, annotations=an} = 
        let val _ = inc intReloadCnt
            val srcLoc = #opnd(getRegLoc(S, an, reg, spillLoc))
            val isMemReg = isMemReg dst
            val dstLoc = I.Direct (sz,dst)
        in  if InsnProps.eqOpn(srcLoc,dstLoc) then []
            else [I.move{mvOp=I.MOVQ, src=srcLoc, dst=dstLoc}]
        end

    fun resetRA() = 
      (firstSpill := true;
       firstFPSpill := true;
       IntHashTable.clear affectedBlocks; 
       IntHashTable.clear deadRegs;
       if !fast_floating_point then FR8.reset() else FR32.reset(); 
       GR8.reset()
      )

    (* Dedicated + available registers *)
    local 
      fun mark(arr, _, [], others) = others
	| mark(arr, len, r::rs, others) = let
	    val r = CB.registerId r
          in
	    if r >= len then mark(arr, len, rs, r::others)
	    else (Array.update(arr, r, true); mark(arr, len, rs, others))
          end
      val dedicatedR   = Array.array(32,false)
      val dedicatedF32 = Array.array(64,false)
      val otherR = mark(dedicatedR, 32, Int.dedicated, [])
      val otherF32 = mark(dedicatedF32, 64, Float.dedicated, [])
      fun isDedicated (len, arr, other) r = 
	(r < len andalso Array.sub(arr, r)) orelse List.exists (fn d => r = d) other
    in
      val isDedicatedR : int -> bool = isDedicated (32, dedicatedR, otherR)
      val isDedicatedF32 : int -> bool = isDedicated (64, dedicatedF32, otherF32)
      val isDedicatedF8 : int -> bool = fn _ => false
    end

    fun phases ps =
    let fun f([], m) = m
          | f(SPILL_PROPAGATION::ps, m) = f(ps, Ra.SPILL_PROPAGATION+m)
          | f(SPILL_COLORING::ps, m) = f(ps, Ra.SPILL_COLORING+m)
    in  f(ps, Ra.NO_OPTIMIZATION)
    end

    (* RA parameters *)

    (* How to allocate integer registers:    
     * Perform register alocation + memory allocation
     *)
    fun RAInt S = 
                {spill     = spillR16 S,
                 spillSrc  = spillReg S,
                 spillCopyTmp= spillCopyTmp S,
                 reload    = reloadR8 S,
                 reloadDst = reloadReg S,
                 renameSrc = renameR8,
                 copyInstr = copyInstrR,
                 K         = K16,
                 getreg    = GR8.getreg,
                 cellkind  = CB.GP,   
                 dedicated = isDedicatedR,
                 spillProh = [],
                 memRegs   = Int.memRegs,
                 mode      = phases(Int.phases)
                } : Ra.raClient

    (* How to allocate floating point registers:    
     * Allocate all fp registers on the stack.  This is the easy way.
     *)
    fun RAFP32 S =
                {spill     = spillF S,
                 spillSrc  = spillFreg S,
                 spillCopyTmp= spillFcopyTmp S,
                 reload    = reloadF S,
                 reloadDst = reloadFreg S,
                 renameSrc = renameF,
                 copyInstr = copyInstrF,
                 K         = KF32,
                 getreg    = FR32.getreg,
                 cellkind  = CB.FP,   
                 dedicated = isDedicatedF32,
                 spillProh = [],
                 memRegs   = Float.memRegs,
                 mode      = phases(Float.phases)
                } : Ra.raClient

    (* How to allocate floating point registers:    
     * Allocate fp registers on the %st stack.  Also perform
     * memory allcoation.
     *)
     fun RAFP8 S =
                {spill     = spillF S,
                 spillSrc  = spillFreg' S,
                 spillCopyTmp= spillFcopyTmp S,
                 reload    = reloadF S,
                 reloadDst = reloadFreg' S,
                 renameSrc = renameF',
                 copyInstr = copyInstrF',
                 K         = KF8,
                 getreg    = FR8.getreg,
                 cellkind  = CB.FP,   
                 dedicated = isDedicatedF8,
                 spillProh = [],
                 memRegs   = Float.fastMemRegs,
                 mode      = phases(Float.fastPhases) 
                } : Ra.raClient

    (* Two RA modes, fast and normal *) 
    fun fast_fp S = [RAInt S, RAFP8 S]
    fun normal_fp S = [RAInt S, RAFP32 S]
 
    (* The main ra routine *)
    fun run cluster =
    let val printGraph = 
            if !amd64CfgDebugFlg then 
               PrintFlowgraph.printCFG(!MLRiscControl.debug_stream)
            else fn msg => fn _ => () 

        val S = beforeRA cluster 
        val _ = resetRA()

        (* generic register allocator *)

        val cluster = Ra.ra
                      (if !fast_floating_point then fast_fp S else normal_fp S)
                      cluster

        val _ = removeDeadCode cluster

        val _ = printGraph "\t---After register allocation K=8---\n" cluster

        (* Run the FP translation phase when fast floating point has
         * been enabled
         *)
        val cluster = 
             if !fast_floating_point andalso I.C.numCell CB.FP () > 0 then 
             let val cluster = AMD64FP.run cluster
             in  printGraph "\t---After AMD64 FP translation ---\n" cluster;
                 cluster
             end
             else cluster
    in  cluster
    end

end

--- NEW FILE: amd64RegAlloc.sml ---
functor AMD64RegAlloc
    (structure I : INSTRUCTIONS where C = AMD64Cells
     structure P : INSN_PROPERTIES where I = I
     structure F : FLOWGRAPH where I = I
     structure Asm : INSTRUCTION_EMITTER where I = I and P = F.P
    ) : 
  sig

    functor IntRa (structure RaUser : RA_USER_PARAMS 
		     where I = I
		     and B = F.B) : RA

    functor FloatRa (structure RaUser : RA_USER_PARAMS 
		     where I = I
		     and B = F.B) : RA
  end =
struct
  structure C = I.C

    (* liveness analysis for general purpose registers *)
  structure RegLiveness =
    Liveness(structure Flowgraph=F
	     structure Instruction=I
	     val defUse = P.defUse C.GP
	     val regSet = C.getCell C.GP
	     val cellset = C.updateCell C.GP)


  (* integer register allocator *)
  functor IntRa = 
      RegAllocator
	 (structure RaArch = struct

	     structure InsnProps = P
	     structure AsmEmitter = Asm
	     structure I = I
	     structure Liveness=RegLiveness
	     val defUse = P.defUse C.GP
	     val firstPseudoR = 32
	     val maxPseudoR = AMD64Cells.maxCell
	     val numRegs = AMD64Cells.numCell C.GP
	     val regSet = C.getCell C.GP
	  end)



  (* liveness analysis for floating point registers *)
  structure FregLiveness = 
    Liveness(structure Flowgraph=F
	     structure Instruction=I
	     val defUse = P.defUse C.FP
	     val regSet = C.getCell C.FP
	     val cellset = C.updateCell C.FP)

  (* floating register allocator *)
  functor FloatRa = 
    RegAllocator
       (structure RaArch = struct

          structure InsnProps = P
	  structure AsmEmitter = Asm
	  structure Liveness=FregLiveness
	  structure I = I

	  val defUse = P.defUse C.FP
	  val firstPseudoR = 64
	  val maxPseudoR = AMD64Cells.maxCell
	  val numRegs = AMD64Cells.numCell C.FP
	  val regSet = C.getCell C.FP
	end)
end

--- NEW FILE: amd64Rewrite.sig ---
signature AMD64REWRITE = sig
  structure I  : AMD64INSTR
  structure CB : CELLS_BASIS = CellsBasis
  val rewriteUse : I.instruction * CB.cell * CB.cell -> I.instruction
  val rewriteDef : I.instruction * CB.cell * CB.cell -> I.instruction
  val frewriteUse : I.instruction * CB.cell * CB.cell -> I.instruction
  val frewriteDef : I.instruction * CB.cell * CB.cell -> I.instruction
end


--- NEW FILE: amd64Rewrite.sml ---
(* amd64Rewrite.sml
 *
 * COPYRIGHT (c) 1997 Bell Labs
 *)
functor AMD64Rewrite(Instr : AMD64INSTR) : AMD64REWRITE = struct
  structure I=Instr
  structure C=I.C
  structure CB = CellsBasis
  fun error msg = MLRiscErrorMsg.error("AMD64Rewrite", msg)

  fun operand (rs,rt) opnd =
    (case opnd
     of I.Direct (ty,r) => if CB.sameColor(r,rs) then I.Direct (ty,rt) else opnd
      | I.Displace{base, disp, mem} => 
	  if CB.sameColor(base,rs) then I.Displace{base=rt, disp=disp, mem=mem} 
          else opnd
      | I.Indexed{base as SOME b, index, scale, disp, mem} => let
	  val base'= if CB.sameColor(b,rs) then SOME rt else base
	  val index'=if CB.sameColor(index,rs) then rt else index
	in I.Indexed{base=base', index=index', scale=scale, disp=disp, mem=mem}
	end
      | I.Indexed{base, index, scale, disp, mem=mem}  => 
	if CB.sameColor(index,rs) then 
	  I.Indexed{base=base, index=rt, scale=scale, disp=disp, mem=mem}
	else opnd
      | _ => opnd
    (*esac*))

  fun rewriteUse(instr, rs, rt) = let
    val operand = operand (rs, rt)
    fun replace r = if CB.sameColor(r,rs) then rt else r
    fun rewriteAMD64Use(instr) = 
     (case instr
      of I.JMP(opnd, labs) => I.JMP(operand opnd, labs)
       | I.JCC{cond, opnd} => I.JCC{cond=cond, opnd = operand opnd}
       | I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} => 
	   I.CALL{opnd=operand opnd, defs=defs, return=return,
		  uses=CB.CellSet.map {from=rs,to=rt} uses, cutsTo=cutsTo,
		  mem=mem, pops=pops}
       | I.CALLQ{opnd, defs, uses, return, cutsTo, mem, pops} => 
	   I.CALLQ{opnd=operand opnd, defs=defs, return=return,
		  uses=CB.CellSet.map {from=rs,to=rt} uses, cutsTo=cutsTo,
		  mem=mem, pops=pops}
       | I.MOVE{mvOp, src, dst as I.Direct _} => 
	   I.MOVE{mvOp=mvOp, src=operand src, dst=dst}
       | I.MOVE{mvOp, src, dst} => 
	   I.MOVE{mvOp=mvOp, src=operand src, dst=operand dst}
       | I.LEA{r32, addr} => I.LEA{r32=r32, addr=operand addr}
       | I.LEAQ{r64, addr} => I.LEAQ{r64=r64, addr=operand addr}
       | I.CMPL{lsrc, rsrc} => I.CMPL{lsrc=operand lsrc, rsrc=operand rsrc}
       | I.CMPW{lsrc, rsrc} => I.CMPW{lsrc=operand lsrc, rsrc=operand rsrc}
       | I.CMPB{lsrc, rsrc} => I.CMPB{lsrc=operand lsrc, rsrc=operand rsrc}
       | I.TESTL{lsrc, rsrc} => I.TESTL{lsrc=operand lsrc, rsrc=operand rsrc}
       | I.TESTW{lsrc, rsrc} => I.TESTW{lsrc=operand lsrc, rsrc=operand rsrc}
       | I.TESTB{lsrc, rsrc} => I.TESTB{lsrc=operand lsrc, rsrc=operand rsrc}
       | I.BITOP{bitOp, lsrc, rsrc} => 
	  I.BITOP{bitOp=bitOp, lsrc=operand lsrc, rsrc=operand rsrc}
       | I.BINARY{binOp, src, dst} => 
	  I.BINARY{binOp=binOp, src=operand src, dst=operand dst}
       | I.SHIFT{shiftOp, src, dst, count} => 
	  I.SHIFT{shiftOp=shiftOp, src=operand src, dst=operand dst, 
                  count=operand src}
       | I.CMPXCHG{lock, sz, src, dst} => 
	  I.CMPXCHG{lock=lock, sz=sz, src=operand src, dst=operand dst}
       | I.MULTDIV{multDivOp, src} => 
	  I.MULTDIV{multDivOp=multDivOp, src=operand src}
       | I.MUL3{dst, src1, src2} => 
	  I.MUL3{dst=dst, src1=operand src1, src2=src2}
       | I.MULQ3{dst, src1, src2} => 
	  I.MULQ3{dst=dst, src1=operand src1, src2=src2}
       | I.UNARY{unOp, opnd} => I.UNARY{unOp=unOp, opnd=operand opnd}
       | I.SET{cond, opnd} => I.SET{cond=cond, opnd=operand opnd}
       | I.PUSHL opnd => I.PUSHL(operand opnd)
       | I.PUSHW opnd => I.PUSHW(operand opnd)
       | I.PUSHB opnd => I.PUSHB(operand opnd)
       | I.POP opnd  => I.POP(operand opnd)
       | I.FSTPT opnd => I.FSTPT(operand opnd)
       | I.FSTPL opnd => I.FSTPL(operand opnd)
       | I.FSTPS opnd => I.FSTPS(operand opnd)
       | I.FSTL opnd => I.FSTL(operand opnd)
       | I.FSTS opnd => I.FSTS(operand opnd)
       | I.FLDT opnd => I.FLDT(operand opnd)
       | I.FLDL opnd => I.FLDL(operand opnd)
       | I.FLDS opnd => I.FLDS(operand opnd)
       | I.FUCOM opnd => I.FUCOM(operand opnd)
       | I.FUCOMP opnd => I.FUCOMP(operand opnd)
       | I.FCOMI opnd => I.FCOMI(operand opnd)
       | I.FCOMIP opnd => I.FCOMIP(operand opnd)
       | I.FUCOMI opnd => I.FUCOMI(operand opnd)
       | I.FUCOMIP opnd => I.FUCOMIP(operand opnd)
       | I.FENV{fenvOp,opnd} => I.FENV{fenvOp=fenvOp, opnd=operand opnd}
       | I.FBINARY{binOp, src, dst} => 
	  I.FBINARY{binOp=binOp, src=operand src, dst=dst}
       | I.FIBINARY{binOp, src} => 
	  I.FIBINARY{binOp=binOp, src=operand src}

	 (* Pseudo floating point instructions *)
       | I.FMOVE{fsize,src,dst} => 
	  I.FMOVE{fsize=fsize,src=operand src,dst=operand dst}
       | I.FILOAD{isize,ea,dst} => 
	  I.FILOAD{isize=isize,ea=operand ea,dst=operand dst}
       | I.FBINOP{fsize,binOp,lsrc,rsrc,dst} =>
	  I.FBINOP{fsize=fsize,binOp=binOp,
		   lsrc=operand lsrc,rsrc=operand rsrc,dst=operand dst}
       | I.FIBINOP{isize,binOp,lsrc,rsrc,dst} =>
	  I.FIBINOP{isize=isize,binOp=binOp,
		    lsrc=operand lsrc,rsrc=operand rsrc,dst=operand dst}
       | I.FUNOP{fsize,unOp,src,dst} =>
	  I.FUNOP{fsize=fsize,unOp=unOp,src=operand src,dst=operand dst}
       | I.FCMP{i,fsize,lsrc,rsrc} =>
	  I.FCMP{i=i,fsize=fsize,lsrc=operand lsrc,rsrc=operand rsrc}

       | I.CMOV{cond, src, dst} => I.CMOV{cond=cond, src=operand src, dst=dst}
       | I.CMOVQ{cond, src, dst} => I.CMOVQ{cond=cond, src=operand src, dst=dst}
       | _ => instr
    (*esac*))

    fun f(I.ANNOTATION{a,i}) = 
	 I.ANNOTATION{i=rewriteUse(i, rs, rt),
		      a = case a of
			     CB.DEF_USE{cellkind=CB.GP,defs,uses} =>
			       CB.DEF_USE{cellkind=CB.GP,uses=map replace uses,
					 defs=defs}
			    | _ => a}
      | f(I.INSTR i) = I.INSTR(rewriteAMD64Use(i))
      | f(I.COPY{k as CB.GP, sz, dst, src, tmp}) = 
	  I.COPY{k=k, sz=sz, dst=dst, src=map replace src, tmp=tmp}
      | f _  = error "rewriteUse:f"
  in f (instr:I.instruction)
  end

  fun rewriteDef(instr, rs, rt) = let
    fun operand(opnd as I.Direct (ty, r)) = 
	if CB.sameColor(r,rs) then I.Direct (ty,rt) else opnd
      | operand _ = error "operand: not I.Direct"
    fun replace r = if CB.sameColor(r,rs) then rt else r
    fun rewriteAMD64Def(instr) =
     (case instr 
      of I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} => 
	   I.CALL{opnd=opnd, cutsTo=cutsTo, 
		  return=CB.CellSet.map {from=rs,to=rt} return, pops=pops,
		  defs=CB.CellSet.map {from=rs,to=rt} defs, uses=uses, mem=mem}
       | I.MOVE{mvOp, src, dst} => I.MOVE{mvOp=mvOp, src=src, dst=operand dst}
       | I.LEA{r32, addr} => I.LEA{r32=replace r32, addr=addr}
       | I.LEAQ{r64, addr} => I.LEAQ{r64=replace r64, addr=addr}
       | I.BINARY{binOp, src, dst} => 
            I.BINARY{binOp=binOp, src=src, dst=operand dst}
       | I.SHIFT{shiftOp, src, dst, count} => 
            I.SHIFT{shiftOp=shiftOp, src=src, count=count, dst=operand dst}
       | I.CMPXCHG{lock, sz, src, dst} => 
	  I.CMPXCHG{lock=lock, sz=sz, src=src, dst=operand dst}
       | I.MUL3{dst, src1, src2} => I.MUL3{dst=replace dst, src1=src1, src2=src2}
       | I.MULQ3{dst, src1, src2} => I.MULQ3{dst=replace dst, src1=src1, src2=src2}
       | I.UNARY{unOp, opnd} => I.UNARY{unOp=unOp, opnd=operand opnd}
       | I.SET{cond, opnd} => I.SET{cond=cond, opnd=operand opnd}
       | I.CMOV{cond, src, dst} => I.CMOV{cond=cond, src=src, dst=replace dst}
       | I.CMOVQ{cond, src, dst} => I.CMOVQ{cond=cond, src=src, dst=replace dst}
       | _ => instr
    (*esac*))

    fun f (I.ANNOTATION{a,i}) =
	   I.ANNOTATION{i=rewriteDef(i,rs,rt),
			  a=(case a of
			      CB.DEF_USE{cellkind=CB.GP,defs,uses} =>
			        CB.DEF_USE{cellkind=CB.GP,uses=uses,
				 	   defs=map replace defs}
			     | _ => a)}
      | f (I.INSTR i) = I.INSTR(rewriteAMD64Def(i))
      | f (I.COPY{k as CB.GP, sz, dst, src, tmp}) =
	  I.COPY{k=k, sz=sz, dst=map replace dst, src=src, tmp=tmp}
      | f _ = error "rewriteDef:f"
  in f(instr)
  end

  fun frewriteUse(instr, fs, ft) = let
    fun foperand(opnd as I.FDirect f) = 
	   if CB.sameColor(f,fs) then I.FDirect ft else opnd
      | foperand(opnd as I.FPR f) = 
	   if CB.sameColor(f,fs) then I.FPR ft else opnd
      | foperand opnd = opnd

    fun replace f = if CB.sameColor(f,fs) then ft else f
    fun frewriteAMD64Use(instr) = 
     (case instr
      of I.FLDL opnd => I.FLDL(foperand opnd)
       | I.FLDS opnd => I.FLDS(foperand opnd)
       | I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} => 
	   I.CALL{opnd=opnd, defs=defs, return=return, cutsTo=cutsTo,
		  uses=CB.CellSet.map {from=fs, to=ft} uses, mem=mem, pops=pops }
       | I.FBINARY{binOp, src, dst} => 
	   I.FBINARY{binOp=binOp, src=foperand src, dst=foperand dst}
       | I.FUCOM opnd => I.FUCOM(foperand opnd)
       | I.FUCOMP opnd => I.FUCOMP(foperand opnd)
       | I.FCOMI opnd => I.FCOMI(foperand opnd)
       | I.FCOMIP opnd => I.FCOMIP(foperand opnd)
       | I.FUCOMI opnd => I.FUCOMI(foperand opnd)
       | I.FUCOMIP opnd => I.FUCOMIP(foperand opnd)

	 (* Pseudo floating point instructions *)
       | I.FMOVE{fsize,dst,src} =>
	  I.FMOVE{fsize=fsize,dst=dst,src=foperand src}
       | I.FBINOP{fsize,binOp,lsrc,rsrc,dst} =>
	  I.FBINOP{fsize=fsize,binOp=binOp,
		   lsrc=foperand lsrc,rsrc=foperand rsrc,dst=dst}
       | I.FIBINOP{isize,binOp,lsrc,rsrc,dst} =>
	  I.FIBINOP{isize=isize,binOp=binOp,
		    lsrc=foperand lsrc,rsrc=foperand rsrc,dst=dst}
       | I.FUNOP{fsize,unOp,src,dst} =>
	  I.FUNOP{fsize=fsize,unOp=unOp,src=foperand src,dst=dst}
       | I.FCMP{i,fsize,lsrc,rsrc} =>
	  I.FCMP{i=i,fsize=fsize,lsrc=foperand lsrc,rsrc=foperand rsrc}
       | _ => instr
    (*esac*))

    fun f(I.ANNOTATION{a, i}) = 
	   I.ANNOTATION{i=frewriteUse(i,fs,ft),
			  a=case a of
			     CB.DEF_USE{cellkind=CB.FP,defs,uses} =>
			       CB.DEF_USE{cellkind=CB.FP,uses=map replace uses,
					 defs=defs}
			    | _ => a}
      | f(I.INSTR i) = I.INSTR(frewriteAMD64Use(i))
      | f(I.COPY{k as CB.FP, sz, dst, src, tmp}) = 
	  I.COPY{k=k, sz=sz, dst=dst, src=map replace src, tmp=tmp}
      | f _ = error "frewrite"
  in f(instr)
  end

  fun frewriteDef(instr, fs, ft) = let
    fun foperand(opnd as I.FDirect r) = 
	 if CB.sameColor(r,fs) then I.FDirect ft else opnd
      | foperand(opnd as I.FPR r) = 
	 if CB.sameColor(r,fs) then I.FPR ft else opnd
      | foperand opnd = opnd
    fun replace f = if CB.sameColor(f,fs) then ft else f
    fun frewriteAMD64Def(instr) = 
     (case instr
      of I.FSTPT opnd => I.FSTPT(foperand opnd)
       | I.FSTPL opnd => I.FSTPL(foperand opnd)
       | I.FSTPS opnd => I.FSTPS(foperand opnd)
       | I.FSTL opnd => I.FSTL(foperand opnd)
       | I.FSTS opnd => I.FSTS(foperand opnd)
       | I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} => 
	   I.CALL{opnd=opnd, defs=CB.CellSet.map {from=fs, to=ft} defs, 
			     return=CB.CellSet.map {from=fs, to=ft} return,
		  uses=uses, cutsTo=cutsTo, mem=mem, pops=pops}
       | I.FBINARY{binOp, src, dst} => I.FBINARY{binOp=binOp, src=src, dst=foperand dst}

	 (* Pseudo floating point instructions *)
       | I.FMOVE{fsize,src,dst} => 
	  I.FMOVE{fsize=fsize,src=src,dst=foperand dst}
       | I.FILOAD{isize,ea,dst} => 
	  I.FILOAD{isize=isize,ea=ea,dst=foperand dst}
       | I.FBINOP{fsize,binOp,lsrc,rsrc,dst} =>
	  I.FBINOP{fsize=fsize,binOp=binOp,lsrc=lsrc,rsrc=rsrc,dst=foperand dst}
       | I.FIBINOP{isize,binOp,lsrc,rsrc,dst} =>
	  I.FIBINOP{isize=isize,binOp=binOp,lsrc=lsrc,rsrc=rsrc,dst=foperand dst}
       | I.FUNOP{fsize,unOp,src,dst} =>
	  I.FUNOP{fsize=fsize,unOp=unOp,src=src,dst=foperand dst}
       | _  => instr
    (*esac*))

    fun f(I.ANNOTATION{i,a}) =
	   I.ANNOTATION{i=frewriteDef(i,fs,ft),
			  a=case a of
			     CB.DEF_USE{cellkind=CB.FP,defs,uses} =>
			       CB.DEF_USE{cellkind=CB.FP,uses=uses,
					 defs=map replace defs}
			    | _ => a}
      | f(I.INSTR(i)) = I.INSTR(frewriteAMD64Def(i))
      | f(I.COPY{k as CB.FP, dst, src, tmp, sz}) = 
	  I.COPY{k=k, sz=sz, dst=map replace dst, src=src, tmp=tmp}
      | f _ = error "frewriteDef"
  in f(instr)
  end
end


--- NEW FILE: amd64SpillInstr.sml ---
(* AMD64Spill.sml 
 *
 * AMD64 spilling is complicated business. 
 * Allen: and it just got more complicated; now we have to recognize the regmap.
 * I've also improved the spilling code so that more instructions are
 * recognized.  Addressing modes are now folded into the existing instruction
 * whenever possible.  This eliminates some redundant temporaries which were
 * introduced before.
 *)
functor AMD64SpillInstr(structure Instr: AMD64INSTR
                 structure Props: INSN_PROPERTIES where I = Instr
		) : ARCH_SPILL_INSTR = struct

  structure I  = Instr
  structure C  = I.C
  structure CB = CellsBasis

  fun error msg = MLRiscErrorMsg.impossible("AMD64Spill: "^ msg)

  fun immed(I.Immed _) = true
    | immed(I.ImmedLabel _) = true
    | immed _ = false

  fun immedOrReg(I.Direct r) = true
    | immedOrReg(I.Immed _) = true
    | immedOrReg(I.ImmedLabel _) = true
    | immedOrReg _ = false

  fun isMemory(I.Displace _) = true
    | isMemory(I.Indexed _) = true
    | isMemory(I.LabelEA _) = true
(*    | isMemory (I.MemReg _) = true*)
    | isMemory _ = false

  (* Annotate instruction *)
  fun annotate(instr,[]) = instr
    | annotate(instr,a::an) = annotate(I.ANNOTATION{i=instr,a=a},an)

  fun mark(instr, an) = annotate(I.INSTR instr, an)

  fun liveKill(add, rmv) ({regs, spilled}, reg) = 
      {regs=rmv(reg, regs), spilled=add(reg, spilled)}

  val fLiveKill = liveKill (C.addFreg, C.rmvFreg)
  val rLiveKill = liveKill (C.addReg, C.rmvReg)

  val newReg = C.newReg

  val ty = 64

  fun spillR(instr, reg, spillLoc) = let
    fun amd64Spill(instr, an) = let
      fun done(instr, an) = {code=[mark(instr, an)], proh=[], newReg=NONE}
    in
      case instr of 
	I.CALL{opnd=addr, defs, uses, return, cutsTo, mem, pops} =>
	  done(I.CALL{opnd=addr, defs=C.rmvReg(reg,defs), 
				 return=return, uses=uses, 
		      cutsTo=cutsTo, mem=mem, pops=pops}, an)
      | I.MOVE{mvOp as (I.MOVZBL|I.MOVZBQ|I.MOVSBL|I.MOVSBQ|
			I.MOVZWL|I.MOVZWQ|I.MOVSWL|I.MOVSWQ|
			I.MOVSLQ), src, dst} => 
	  let val tmpR = newReg() val tmp = I.Direct (ty, tmpR)
	  in  {proh=[tmpR], newReg=SOME tmpR,
	       code=[mark(I.MOVE{mvOp=mvOp, src=src, dst=tmp}, an),
		     I.move{mvOp=I.MOVQ, src=tmp, dst=spillLoc}]
	      }
	  end
      | I.MOVE{mvOp, src as I.Direct (_,rs), dst} =>
	  if CB.sameColor(rs,reg) then {code=[], proh=[], newReg=NONE}
	  else done(I.MOVE{mvOp=mvOp, src=src, dst=spillLoc}, an)
      | I.MOVE{mvOp, src, dst=I.Direct _} => 
	  if Props.eqOpn(src, spillLoc) then {code=[], proh=[], newReg=NONE}
	  else if immed src then 
	     done(I.MOVE{mvOp=I.MOVQ, src=src, dst=spillLoc}, an)
	  else 
	  let val tmpR = newReg()
	      val tmp  = I.Direct (ty,tmpR)
	  in  {proh=[tmpR],
	       newReg=SOME tmpR,
	       code=[mark(I.MOVE{mvOp=mvOp, src=src, dst=tmp}, an),
		     I.move{mvOp=I.MOVQ, src=tmp, dst=spillLoc}]
	      }
	  end 
      | I.LEA{addr, r32} => 
	  let val tmpR = newReg()
	  in  {proh=[tmpR],
	       newReg=SOME tmpR,
	       code=[mark(I.LEA{addr=addr, r32=tmpR}, an),
		     I.move{mvOp=I.MOVQ, src=I.Direct (ty,tmpR), dst=spillLoc}]
	      }
	  end 
      | I.LEAQ{addr, r64} => 
	  let val tmpR = newReg()
	  in  {proh=[tmpR],
	       newReg=SOME tmpR,
	       code=[mark(I.LEAQ{addr=addr, r64=tmpR}, an),
		     I.move{mvOp=I.MOVQ, src=I.Direct (ty,tmpR), dst=spillLoc}]
	      }
	  end 
      | I.BINARY{binOp=I.XORL, src as I.Direct (_,rs), dst=I.Direct (_,rd)} => 
	  if CB.sameColor(rs,rd) then 
	     {proh=[],
	      code=[mark(I.MOVE{mvOp=I.MOVL, src=I.Immed 0, dst=spillLoc}, an)],
	      newReg=NONE
	     }
	  else
	     {proh=[],
	      code=[mark(I.BINARY{binOp=I.XORL, src=src, dst=spillLoc}, an)],
	      newReg=NONE
	     }
      | I.BINARY{binOp=I.XORQ, src as I.Direct (_,rs), dst=I.Direct (_,rd)} => 
	  if CB.sameColor(rs,rd) then 
	     {proh=[],
	      code=[mark(I.MOVE{mvOp=I.MOVQ, src=I.Immed 0, dst=spillLoc}, an)],
	      newReg=NONE
	     }
	  else
	     {proh=[],
	      code=[mark(I.BINARY{binOp=I.XORQ, src=src, dst=spillLoc}, an)],
	      newReg=NONE
	     }
      | I.BINARY{binOp, src, dst} => let (* note: dst = reg *)
	 fun multBinOp(I.MULQ|I.MULL|I.MULW|I.MULB|I.IMULQ|I.IMULL|I.IMULW|I.IMULB) = true
	   | multBinOp _ = false
	in
	  if multBinOp binOp then let
	     (* destination must remain a register *)
	      val tmpR = newReg()
	      val tmp = I.Direct (ty,tmpR)
	    in
	      {proh=[tmpR],
	       code=  [I.move{mvOp=I.MOVQ, src=spillLoc, dst=tmp},
		       I.binary{binOp=binOp, src=src, dst=tmp},
		       I.move{mvOp=I.MOVQ, src=tmp, dst=spillLoc}],
	       newReg=SOME tmpR
	      }
	    end
	  else if immedOrReg src then
	     (* can replace the destination directly *)
	     done(I.BINARY{binOp=binOp, src=src, dst=spillLoc}, an)
	  else let
	     (* a memory src and non multBinOp  
	      * --- cannot have two memory operands
	      *)
	      val tmpR = newReg()
	      val tmp = I.Direct (ty,tmpR)
	    in 
	      { proh=[tmpR],
		code=[I.move{mvOp=I.MOVQ, src=src, dst=tmp},
		      I.binary{binOp=binOp, src=tmp, dst=spillLoc}],
		newReg=NONE
	       }
	    end
	end 
      | I.SHIFT{shiftOp, count, src, dst} => error "go and implement SHIFT"
      | I.CMOV{cond, src, dst} => 
           (* note: dst must be a register *)
         (case spillLoc of
           I.Direct (_,r) =>
	      {proh=[],
	       newReg=NONE,
	       code=[mark(I.CMOV{cond=cond,src=src,dst=r},an)]
	      }
         | _ =>
	  let val tmpR = newReg()
	      val tmp  = I.Direct (ty,tmpR)
	  in  {proh=[tmpR],
	       newReg=SOME tmpR,
	       code=[I.move{mvOp=I.MOVQ, src=spillLoc, dst=tmp},
                     mark(I.CMOV{cond=cond,src=src,dst=tmpR},an),
		     I.move{mvOp=I.MOVQ, src=tmp, dst=spillLoc}]
	      }
	  end 
         )
      | I.CMOVQ{cond, src, dst} => 
           (* note: dst must be a register *)
         (case spillLoc of
           I.Direct (_,r) =>
	      {proh=[],
	       newReg=NONE,
	       code=[mark(I.CMOVQ{cond=cond,src=src,dst=r},an)]
	      }
         | _ =>
	  let val tmpR = newReg()
	      val tmp  = I.Direct (ty,tmpR)
	  in  {proh=[tmpR],
	       newReg=SOME tmpR,
	       code=[I.move{mvOp=I.MOVQ, src=spillLoc, dst=tmp},
                     mark(I.CMOVQ{cond=cond,src=src,dst=tmpR},an),
		     I.move{mvOp=I.MOVQ, src=tmp, dst=spillLoc}]
	      }
	  end 
         )

      | I.CMPXCHG{lock,sz,src,dst} => 
	   if immedOrReg src then
	       {proh=[],
		code=[mark(I.CMPXCHG{lock=lock,sz=sz,src=src,dst=spillLoc},an)],
		newReg=NONE
	       }
	   else
	   let val tmpR = newReg()
	       val tmp  = I.Direct (ty,tmpR)
	   in {proh=[],
	       code=[I.move{mvOp=I.MOVQ, src=src, dst=tmp},
		     mark(I.CMPXCHG{lock=lock,sz=sz,src=tmp,dst=spillLoc},an)],
	       newReg=NONE
	      }
	   end
      | I.MULTDIV _ => error "spill: MULTDIV"
      | I.MUL3{src1, src2, dst} => 
	  let val tmpR = newReg() 
	  in  {proh=[tmpR], newReg=SOME tmpR,
	       code=[mark(I.MUL3{src1=src1, src2=src2, dst=tmpR}, an),
		     I.move{mvOp=I.MOVQ, src=I.Direct (ty,tmpR), dst=spillLoc}]
	      }
	  end
      | I.MULQ3{src1, src2, dst} => 
	  let val tmpR = newReg() 
	  in  {proh=[tmpR], newReg=SOME tmpR,
	       code=[mark(I.MULQ3{src1=src1, src2=src2, dst=tmpR}, an),
		     I.move{mvOp=I.MOVQ, src=I.Direct (ty,tmpR), dst=spillLoc}]
	      }
	  end
      | I.UNARY{unOp, opnd} => done(I.UNARY{unOp=unOp, opnd=spillLoc}, an)
      | I.SET{cond, opnd} => done(I.SET{cond=cond, opnd=spillLoc}, an)
      | I.POP _ => done(I.POP spillLoc, an)
      | I.FNSTSW  => error "spill: FNSTSW"
      | _ => error "spill"
    end (* amd64Spill *)

    fun f(I.INSTR instr, an) = amd64Spill(instr, an)
      | f(I.ANNOTATION{a, i}, an) = f(i, a::an)
      | f(I.KILL lk, an) = 
	   {code=[annotate(I.KILL(rLiveKill (lk, reg)), an)],
	    proh=[],
	    newReg=NONE}
      | f _ = error "spill:f"
  in f(instr, [])
  end 

  fun reloadR(instr, reg, spillLoc) = let
    fun amd64Reload(instr, reg, spillLoc, an) = let
        fun operand(rt, opnd) =
	(case opnd
	 of I.Direct (ty,r) => if CB.sameColor(r,reg) then I.Direct (ty,rt) else opnd
	  | I.Displace{base, disp, mem} => 
	     if CB.sameColor(base,reg) 
	     then I.Displace{base=rt, disp=disp, mem=mem} 
	     else opnd
	  | I.Indexed{base=NONE, index, scale, disp, mem=mem} => 
	     if CB.sameColor(index,reg) then
	       I.Indexed{base=NONE, index=rt, scale=scale, disp=disp, mem=mem}
	     else opnd
	  | I.Indexed{base as SOME b, index, scale, disp, mem=mem} => 
	     if CB.sameColor(b,reg) then 
	       operand(rt, I.Indexed{base=SOME rt, index=index, 
				     scale=scale, disp=disp, mem=mem})
	     else if CB.sameColor(index,reg) then
	       I.Indexed{base=base, index=rt, scale=scale, disp=disp, mem=mem}
		  else opnd
	  | opnd => opnd
	(*esac*))

      fun done(instr, an) = {code=[mark(instr, an)], proh=[], newReg=NONE}

      fun isReloading (I.Direct (_,r)) = CB.sameColor(r,reg) 
        | isReloading _ = false

      (* This version assumes that the value of tmpR is killed *)
      fun withTmp(f, an) = 
	  case spillLoc of 
	    I.Direct (_,tmpR) =>  
		{newReg=NONE,
		 proh=[], 
		 code=[mark(f tmpR, an)]
		}
	  |  _ =>
	    let val tmpR = newReg()
	    in  {newReg=NONE,
		 proh=[tmpR], 
		 code=[I.move{mvOp=I.MOVQ, src=spillLoc, dst=I.Direct (ty,tmpR)}, 
		       mark(f tmpR, an)
		      ]
		}
	    end

      (* This version assumes that the value of tmpR is available afterwards *)
      fun withTmpAvail(f, an) =  
	  case spillLoc of
	     I.Direct (_,tmpR) =>
	      {newReg=SOME tmpR,
	       proh=[tmpR], 
	       code=[mark(f tmpR, an)]
	      }
	  |  _ =>
	      let val tmpR = newReg()
		  val tmp  = I.Direct (ty,tmpR)
	      in  {newReg=SOME tmpR,
		   proh=[tmpR], 
		   code=[I.move{mvOp=I.MOVQ, src=spillLoc, dst=I.Direct (ty,tmpR)}, 
			 mark(f tmpR, an)
			]
		  }
	      end

      fun replace(opn as I.Direct (_,r)) = 
	    if CB.sameColor(r,reg) then spillLoc else opn
	| replace opn         = opn

      (* Fold in a memory operand if possible.  Makes sure that both operands
       * are not in memory.  lsrc cannot be immediate.
       *)
      fun reloadCmp(cmp, lsrc, rsrc, an) = 
	  let fun reloadIt() =  
		withTmp(fn tmpR => 
		  cmp{lsrc=operand(tmpR, lsrc), rsrc=operand(tmpR, rsrc)}, an)
	  in  if immedOrReg lsrc andalso immedOrReg rsrc then
	      let val lsrc' = replace lsrc
		  val rsrc' = replace rsrc
	      in  if isMemory lsrc' andalso isMemory rsrc' then
		     reloadIt()
		  else
		     done(cmp{lsrc=lsrc', rsrc=rsrc'}, an)
	      end
	      else reloadIt()
	  end

      fun reloadBT(bitOp, lsrc, rsrc, an) = 
	     reloadCmp(fn {lsrc,rsrc} => I.BITOP{bitOp=bitOp,lsrc=lsrc,rsrc=rsrc},
		       lsrc, rsrc, an)

      (* Fold in a memory operand if possible.  Makes sure that the right 
       * operand is not in memory and left operand is not an immediate.
       *  lsrc   rsrc
       *   AL,   imm8  opc1 A8
       *  EAX,   imm32 opc1 A9
       *  r/m8,  imm8  opc2 F6/0 ib
       *  r/m32, imm32 opc2 F7/0 id
       *  r/m32, r32   opc3 85/r
       *)
      fun reloadTest(test, lsrc, rsrc, an) = 
	  let fun reloadIt() = 
		 withTmp(fn tmpR => 
		   test{lsrc=operand(tmpR, lsrc), rsrc=operand(tmpR, rsrc)}, an)
	  in  if immedOrReg lsrc andalso immedOrReg rsrc then
	      let val lsrc = replace lsrc
		  val rsrc = replace rsrc
	      in  if isMemory rsrc then 
		     if isMemory lsrc then reloadIt()
		     else (* it is commutative! *)
			done(test{lsrc=rsrc, rsrc=lsrc}, an)
		  else 
		     done(test{lsrc=lsrc, rsrc=rsrc}, an)
	      end
	      else reloadIt()
	  end

      fun reloadPush(push, arg as I.Direct _, an) =
	    done(push(replace arg), an)
	| reloadPush(push, arg, an) =
	    withTmpAvail(fn tmpR => push(operand(tmpR, arg)), an)

      fun reloadReal(realOp, opnd, an) =
	    withTmpAvail(fn tmpR => realOp(operand(tmpR, opnd)), an)
   in   
      case instr
      of I.JMP(I.Direct _, labs) => done(I.JMP(spillLoc, labs), an)
       | I.JMP(opnd, labs) => withTmp(fn t => I.JMP(operand(t, opnd), labs), an)
       | I.JCC{opnd=I.Direct _, cond} => done(I.JCC{opnd=spillLoc, cond=cond}, an)
       | I.JCC{opnd, cond} => 
	    withTmp(fn t => I.JCC{opnd=operand(t,opnd), cond=cond}, an)
       | I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} => 
	    withTmp(fn t => 
		I.CALL{opnd=operand(t, opnd), defs=defs, return=return,pops=pops,
		       uses=C.rmvReg(reg, uses), cutsTo=cutsTo, mem=mem}, an)
       | I.MOVE{mvOp, src as I.Direct _, dst as I.Direct _} => 
	  done(I.MOVE{mvOp=mvOp, src=replace src, dst=dst},an)
       | I.MOVE{mvOp, src, dst as I.Direct _} => 
	  withTmpAvail(fn t =>I.MOVE{mvOp=mvOp, src=operand(t, src), dst=dst},an)
       | I.MOVE{mvOp, src as I.Direct _, dst} => 
	  if Props.eqOpn(dst, spillLoc) then {code=[], proh=[], newReg=NONE}
	  else withTmpAvail (* dst is not the spill reg *)
	    (fn t => 
	       I.MOVE{mvOp=mvOp, src=operand(t, src), dst=operand(t, dst)}, an)
       | I.MOVE{mvOp, src, dst} => 
	  withTmpAvail (* dst is not the spill reg *)
	   (fn t => 
	      I.MOVE{mvOp=mvOp, src=operand(t, src), dst=operand(t, dst)}, an)
       | I.LEA{r32, addr} => 
	 withTmpAvail(fn tmpR => I.LEA{r32=r32, addr=operand(tmpR, addr)}, an)
       | I.LEAQ{r64, addr} => 
	 withTmpAvail(fn tmpR => I.LEAQ{r64=r64, addr=operand(tmpR, addr)}, an)
       | I.CMPQ{lsrc, rsrc} => reloadCmp(I.CMPQ, lsrc, rsrc, an) 
       | I.CMPL{lsrc, rsrc} => reloadCmp(I.CMPL, lsrc, rsrc, an) 
       | I.CMPW{lsrc, rsrc} => reloadCmp(I.CMPW, lsrc, rsrc, an) 
       | I.CMPB{lsrc, rsrc} => reloadCmp(I.CMPB, lsrc, rsrc, an) 
       | I.TESTQ{lsrc, rsrc} => reloadTest(I.TESTQ, lsrc, rsrc, an) 
       | I.TESTL{lsrc, rsrc} => reloadTest(I.TESTL, lsrc, rsrc, an) 
       | I.TESTW{lsrc, rsrc} => reloadTest(I.TESTW, lsrc, rsrc, an) 
       | I.TESTB{lsrc, rsrc} => reloadTest(I.TESTB, lsrc, rsrc, an) 
       | I.BITOP{bitOp,lsrc, rsrc} => reloadBT(bitOp, lsrc, rsrc, an) 
       | I.BINARY{binOp, src, dst as I.Direct _} => 
	    (case src of
	      I.Direct _ => 
		done(I.BINARY{binOp=binOp, src=replace src, dst=dst},an)
	    | _ => withTmp(fn tmpR => 
		I.BINARY{binOp=binOp, src=operand(tmpR, src), dst=dst}, an)
	    )
       | I.BINARY{binOp, src, dst} => 
	  withTmp(fn tmpR => I.BINARY{binOp=binOp, src=operand(tmpR, src), 
						   dst=operand(tmpR, dst)}, an)
       | I.CMOV{cond, src, dst} => 
         if CB.sameColor(dst,reg) then
            error "CMOV"
         else
            done(I.CMOV{cond=cond, src=spillLoc, dst=dst}, an)
       | I.CMOVQ{cond, src, dst} => 
         if CB.sameColor(dst,reg) then
            error "CMOV"
         else
            done(I.CMOVQ{cond=cond, src=spillLoc, dst=dst}, an)
       | I.SHIFT{shiftOp, count, src, dst} => error "go and implement SHIFT"
       | I.CMPXCHG{lock,sz,src,dst} => 
	  withTmp(fn tmpR => I.CMPXCHG{lock=lock, sz=sz,
				       src=operand(tmpR, src),
				       dst=operand(tmpR, dst)},an)
       | I.MULTDIV{multDivOp, src as I.Direct _} => 
	  done(I.MULTDIV{multDivOp=multDivOp, src=replace src}, an)
       | I.MULTDIV{multDivOp, src} =>
	  withTmp(fn tmpR => 
	      I.MULTDIV{multDivOp=multDivOp, src=operand(tmpR, src)}, an)
       | I.MUL3{src1, src2, dst} => 
	  withTmp(fn tmpR => 
	    I.MUL3{src1=operand(tmpR, src1), src2=src2, 
		   dst=if CB.sameColor(dst,reg) 
		       then error "reload:MUL3" else dst}, an)
       | I.MULQ3{src1, src2, dst} => 
	  withTmp(fn tmpR => 
	    I.MULQ3{src1=operand(tmpR, src1), src2=src2, 
		   dst=if CB.sameColor(dst,reg) 
		       then error "reload:MULQ3" else dst}, an)
       | I.UNARY{unOp, opnd} => 
	  withTmpAvail
	     (fn tmpR => I.UNARY{unOp=unOp, opnd=operand(tmpR, opnd)}, an)
       | I.SET{cond, opnd} => 
	  withTmpAvail(fn tmpR => I.SET{cond=cond, opnd=operand(tmpR, opnd)}, an)
       | I.PUSHL arg => reloadPush(I.PUSHL, arg, an)
       | I.PUSHW arg => reloadPush(I.PUSHW, arg, an)
       | I.PUSHB arg => reloadPush(I.PUSHB, arg, an)
       | I.FILD opnd => reloadReal(I.FILD, opnd, an) 
       | I.FILDL opnd => reloadReal(I.FILDL, opnd, an) 
       | I.FILDLL opnd => reloadReal(I.FILDLL, opnd, an) 
       | I.FLDT opnd => reloadReal(I.FLDT, opnd, an)
       | I.FLDL opnd => reloadReal(I.FLDL, opnd, an)
       | I.FLDS opnd => reloadReal(I.FLDS, opnd, an)
       | I.FSTPT opnd => reloadReal(I.FSTPT, opnd, an)
       | I.FSTPL opnd => reloadReal(I.FSTPL, opnd, an)
       | I.FSTPS opnd => reloadReal(I.FSTPS, opnd, an)
       | I.FSTL opnd => reloadReal(I.FSTL, opnd, an)
       | I.FSTS opnd => reloadReal(I.FSTS, opnd, an)
       | I.FUCOM opnd => reloadReal(I.FUCOM, opnd, an)
       | I.FUCOMP opnd => reloadReal(I.FUCOMP, opnd, an)
       | I.FCOMI opnd => reloadReal(I.FCOMI, opnd, an)
       | I.FCOMIP opnd => reloadReal(I.FCOMIP, opnd, an)
       | I.FUCOMI opnd => reloadReal(I.FUCOMI, opnd, an)
       | I.FUCOMIP opnd => reloadReal(I.FUCOMIP, opnd, an)
       | I.FENV{fenvOp, opnd} => reloadReal(fn opnd => 
				   I.FENV{fenvOp=fenvOp,opnd=opnd}, opnd, an)
       | I.FBINARY{binOp, src, dst} => 
	  withTmpAvail(fn tmpR => 
		   I.FBINARY{binOp=binOp, src=operand(tmpR, src), dst=dst}, an)
       | I.FIBINARY{binOp, src} => 
	  withTmpAvail
	    (fn tmpR => I.FIBINARY{binOp=binOp, src=operand(tmpR, src)}, an)

	 (* Pseudo fp instrctions *)
       | I.FMOVE{fsize,src,dst} => 
	  withTmpAvail
	    (fn tmpR => I.FMOVE{fsize=fsize, src=operand(tmpR, src), 
				dst=operand(tmpR, dst)}, an)
       | I.FILOAD{isize,ea,dst} => 
	  withTmpAvail
	    (fn tmpR => I.FILOAD{isize=isize, ea=operand(tmpR, ea), 
				 dst=operand(tmpR, dst)}, an)
       | I.FBINOP{fsize,binOp,lsrc,rsrc,dst} =>
	  withTmpAvail(fn tmpR =>
	     I.FBINOP{fsize=fsize, binOp=binOp, lsrc=operand(tmpR, lsrc),
		      rsrc=operand(tmpR, rsrc), dst=operand(tmpR, dst)}, an)
       | I.FIBINOP{isize,binOp,lsrc,rsrc,dst} =>
	  withTmpAvail(fn tmpR =>
	     I.FIBINOP{isize=isize, binOp=binOp, lsrc=operand(tmpR, lsrc),
		       rsrc=operand(tmpR, rsrc), dst=operand(tmpR, dst)}, an)
       | I.FUNOP{fsize,unOp,src,dst} =>
	  withTmpAvail(fn tmpR =>
	     I.FUNOP{fsize=fsize, unOp=unOp, src=operand(tmpR, src),
		     dst=operand(tmpR, dst)}, an)
       | I.FCMP{i,fsize,lsrc,rsrc} =>
	  withTmpAvail(fn tmpR =>
	     I.FCMP{i=i,fsize=fsize, 
		    lsrc=operand(tmpR, lsrc), rsrc=operand(tmpR, rsrc)
		   }, an)

       | _ => error "reload"
    end (*amd64Reload*)

    fun f(I.ANNOTATION{a, i}, an) = f(i, a::an)
      | f(I.INSTR i, an) = amd64Reload(i, reg, spillLoc, an)
      | f(I.LIVE lk, an) = 
	   {code=[annotate(I.LIVE(rLiveKill (lk, reg)), an)],
	    proh=[],
	    newReg=NONE}
      | f _ = error "reload: f"
  in f(instr, [])
  end (* reload *)




  fun spillF(instr, reg, spillLoc) = let
    fun amd64Fspill(instr, reg, spillLoc, an) = let
      fun withTmp(f, fsize, an) = let
	val tmpR = C.newFreg()
	val tmp  = I.FPR tmpR
      in 
	 { proh=[tmpR], 
	   code=[mark(f tmp, an), 
		 I.fmove{fsize=fsize, src=tmp, dst=spillLoc}],
	   newReg=SOME tmpR (* XXX Should we propagate the definition? *)
	  }
      end
    in
      case instr 
      of I.FSTPL _ => {proh=[], code=[mark(I.FSTPL spillLoc, an)], newReg=NONE}
       | I.FSTPS _ => {proh=[], code=[mark(I.FSTPS spillLoc, an)], newReg=NONE}
       | I.FSTPT _ => {proh=[], code=[mark(I.FSTPT spillLoc, an)], newReg=NONE}
       | I.FSTL _ => {proh=[], code=[mark(I.FSTL spillLoc, an)], newReg=NONE}
       | I.FSTS _ => {proh=[], code=[mark(I.FSTS spillLoc, an)], newReg=NONE}
       | I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} =>
	 {proh=[],
	  code=[mark(I.CALL{opnd=opnd, defs=C.rmvFreg(reg,defs), 
			    return=return, uses=uses, 
			    cutsTo=cutsTo, mem=mem, pops=pops}, an)],
	  newReg=NONE}
       | I.CALLQ{opnd, defs, uses, return, cutsTo, mem, pops} =>
	 {proh=[],
	  code=[mark(I.CALLQ{opnd=opnd, defs=C.rmvFreg(reg,defs), 
			    return=return, uses=uses, 
			    cutsTo=cutsTo, mem=mem, pops=pops}, an)],
	  newReg=NONE}

       (* Pseudo fp instrctions *)
       | I.FMOVE{fsize,src,dst} => 
	  if Props.eqOpn(src,spillLoc) then 
	    {proh=[], code=[], newReg=NONE}
	  else
	    {proh=[],code=[mark(I.FMOVE{fsize=fsize,src=src,dst=spillLoc},an)],
	     newReg=NONE}
       | I.FILOAD{isize,ea,dst} =>
	    {proh=[],code=[mark(I.FILOAD{isize=isize,ea=ea,dst=spillLoc},an)],
	     newReg=NONE} (* XXX bad for single precision *)
       | I.FBINOP{fsize as I.FP64,binOp,lsrc,rsrc,dst} =>
	    {proh=[],code=[mark(I.FBINOP{fsize=fsize,binOp=binOp,
					 lsrc=lsrc, rsrc=rsrc,
					 dst=spillLoc},an)],
	     newReg=NONE}
       | I.FBINOP{fsize,binOp,lsrc,rsrc,dst} =>
	  withTmp(fn tmpR =>
		  I.FBINOP{fsize=fsize, binOp=binOp,
			   lsrc=lsrc, rsrc=rsrc, dst=tmpR},
		  fsize, an)
       | I.FIBINOP{isize,binOp,lsrc,rsrc,dst} =>
	  withTmp(fn tmpR =>
		  I.FIBINOP{isize=isize, binOp=binOp,
			    lsrc=lsrc, rsrc=rsrc, dst=tmpR},
		  I.FP64, an) (* XXX *)
       | I.FUNOP{fsize,unOp,src,dst} =>
	  {proh=[],code=[mark(I.FUNOP{fsize=fsize,unOp=unOp,
				      src=src,dst=spillLoc},an)],
			newReg=NONE}
       | _ => error "fspill"
      (*esac*)
    end (* amd64Fspill *)
    fun f(I.ANNOTATION{a,i}, an) = f(i, a::an)
      | f(I.INSTR(i), an) = amd64Fspill(i, reg, spillLoc, an)
      | f(I.KILL lk, an) = 
	   {code=[annotate(I.KILL(fLiveKill (lk, reg)), an)],
	    proh=[],
	    newReg=NONE}
      | f _ = error "fspill:f"
  in f(instr, [])
  end


  fun reloadF(instr, reg, spillLoc) = let
    fun amd64Freload(instr, reg, spillLoc, an) = let
	fun rename(src as I.FDirect f) = 
	    if CB.sameColor(f,reg) then spillLoc else src 
	  | rename(src as I.FPR f) = 
	    if CB.sameColor(f,reg) then spillLoc else src 
	  | rename src = src

	fun withTmp(fsize, f, an) = 
	    case spillLoc of 
	      I.FDirect _ => {newReg=NONE, proh=[], code=[mark(f spillLoc, an)]}
	    | I.FPR _ => {newReg=NONE, proh=[], code=[mark(f spillLoc, an)]}
	    |  _ =>
	      let val ftmpR = C.newFreg()
		  val ftmp  = I.FPR(ftmpR)
	      in  {newReg=NONE,
		   proh=[ftmpR], 
		   code=[I.fmove{fsize=fsize, src=spillLoc, dst=ftmp}, 
			 mark(f ftmp, an)
			]
		  }
	      end
     in
	(case instr of 
	   I.FLDT opnd => {code=[mark(I.FLDT spillLoc, an)], proh=[], newReg=NONE}
	 | I.FLDL opnd => {code=[mark(I.FLDL spillLoc, an)], proh=[], newReg=NONE}
	 | I.FLDS opnd => {code=[mark(I.FLDS spillLoc, an)], proh=[], newReg=NONE}
	 | I.FUCOM opnd => {code=[mark(I.FUCOM spillLoc, an)],proh=[],newReg=NONE}
	 | I.FUCOMP opnd => {code=[mark(I.FUCOMP spillLoc, an)],proh=[],newReg=NONE}
	 | I.FCOMI opnd => {code=[mark(I.FCOMI spillLoc, an)],proh=[],newReg=NONE}
	 | I.FCOMIP opnd => {code=[mark(I.FCOMIP spillLoc, an)],proh=[],newReg=NONE}
	 | I.FUCOMI opnd => {code=[mark(I.FUCOMI spillLoc, an)],proh=[],newReg=NONE}
	 | I.FUCOMIP opnd => {code=[mark(I.FUCOMIP spillLoc, an)],proh=[],newReg=NONE}
	 | I.FBINARY{binOp, src=I.FDirect f, dst} => 
	     if CB.sameColor(f,reg) then 
	       {code=[mark(I.FBINARY{binOp=binOp, src=spillLoc, dst=dst}, an)],
		proh=[], 
		newReg=NONE}
	     else error "reloadF:FBINARY"

	 (* Pseudo fp instructions.
	  *)
	 | I.FMOVE{fsize,src,dst} => 
	    if Props.eqOpn(dst,spillLoc) then 
	      {code=[], proh=[], newReg=NONE}
	    else
	      {code=[mark(I.FMOVE{fsize=fsize,src=spillLoc,dst=dst},an)], 
		     proh=[], newReg=NONE}
	 | I.FBINOP{fsize,binOp,lsrc,rsrc,dst} =>
	    {code=[mark(I.FBINOP{fsize=fsize,binOp=binOp,
				 lsrc=rename lsrc, rsrc=rename rsrc,dst=dst},an)],
		   proh=[], newReg=NONE}
	 | I.FIBINOP{isize,binOp,lsrc,rsrc,dst} =>
	    {code=[mark(I.FIBINOP{isize=isize,binOp=binOp,
				  lsrc=rename lsrc,rsrc=rename rsrc,dst=dst},an)],
		   proh=[], newReg=NONE}
	 | I.FUNOP{fsize,unOp,src,dst} =>
	    {code=[mark(I.FUNOP{fsize=fsize,unOp=unOp,
				src=rename src, dst=dst},an)], 
		   proh=[], newReg=NONE}
	 | I.FCMP{i,fsize,lsrc,rsrc} =>
	    (* Make sure that both the lsrc and rsrc cannot be in memory *)
	    (case (lsrc, rsrc) of
	      (I.FPR fs1, I.FPR fs2) =>
		(case (CB.sameColor(fs1,reg), CB.sameColor(fs2,reg)) of
		   (true, true) =>
		   withTmp(fsize, 
		      fn tmp => I.FCMP{i=i,fsize=fsize,lsrc=tmp, rsrc=tmp}, an)
		 | (true, false) =>
		   {code=[mark(I.FCMP{i=i,fsize=fsize,lsrc=spillLoc,rsrc=rsrc},an)],
		    proh=[], newReg=NONE}
		 | (false, true) =>
		   {code=[mark(I.FCMP{i=i,fsize=fsize,lsrc=lsrc,rsrc=spillLoc},an)],
		    proh=[], newReg=NONE}
		 | _ => error "fcmp.1"
		)
	     | (I.FPR _, _) =>
		withTmp(fsize, 
		   fn tmp => I.FCMP{i=i,fsize=fsize,lsrc=tmp, rsrc=rsrc}, an)
	     | (_, I.FPR _) =>
		withTmp(fsize, 
		   fn tmp => I.FCMP{i=i,fsize=fsize,lsrc=lsrc, rsrc=tmp}, an)
	     | _ => error "fcmp.2"
	    )
	 | I.CALL{opnd, defs, uses, return, cutsTo, mem, pops} =>
	   {proh=[],
	    code=[mark(I.CALL{opnd=opnd, defs=C.rmvFreg(reg,defs), 
			      return=return, pops=pops,
			      uses=uses, cutsTo=cutsTo, mem=mem}, an)],
	    newReg=NONE}
	 | I.CALLQ{opnd, defs, uses, return, cutsTo, mem, pops} =>
	   {proh=[],
	    code=[mark(I.CALLQ{opnd=opnd, defs=C.rmvFreg(reg,defs), 
			      return=return, pops=pops,
			      uses=uses, cutsTo=cutsTo, mem=mem}, an)],
	    newReg=NONE}
	 | _  => error "reloadF"
	(*esac*))
    end (* amd64Freload *)

    fun f(I.ANNOTATION{a, i}, an) = f(i, a::an)
      | f(I.INSTR i, an) = amd64Freload(i, reg, spillLoc, an)
      | f(I.LIVE lk, an) = 
	   {code=[annotate(I.LIVE(fLiveKill (lk, reg)), an)],
	    proh=[],
	    newReg=NONE}
      | f _ = error "freload.f"

  in f(instr, [])
  end

  fun spillToEA CB.GP (reg, ea) = let
	fun returnMove() = 
	  {code=[I.move{mvOp=I.MOVQ, src=I.Direct (ty,reg), dst=ea}],
	   proh=[], newReg=NONE}
      in
	 case ea
	  of I.Displace _ => returnMove()
	   | I.Indexed _ => returnMove()
(*	   | I.MemReg _ => returnMove()*)
	   | _ => error "spillToEA: GP"
      end
    | spillToEA CB.FP (freg, ea) = error "spillToEA: FP"
    | spillToEA _ _ = error "spillToEA"

  fun reloadFromEA CB.GP (reg, ea) = let
        fun returnMove() = 
	  {code=[I.move{mvOp=I.MOVQ, dst=I.Direct (ty,reg), src=ea}],
	   proh=[],
	   newReg=NONE}
      in
	 case ea
	  of I.Displace _ => returnMove()
(*	   | I.MemReg _ => returnMove()*)
	   | I.Indexed _ => returnMove()
	   | _ => error "reloadFromEA: GP"
      end 
    | reloadFromEA CB.FP (freg, ea) = error "spillToEA: FP"
    | reloadFromEA _ _ = error "spillToEA"


  fun reload CB.GP = reloadR
    | reload CB.FP = reloadF
    | reload _ = error "reload"

  fun spill CB.GP = spillR
    | spill CB.FP = spillF
    | spill _ = error "spill"
end


-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys -- and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV