Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/MLRISC/x86/omit-frameptr/x86omit-frameptr.sml
ViewVC logotype

View of /sml/trunk/src/MLRISC/x86/omit-frameptr/x86omit-frameptr.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 889 - (download) (annotate)
Thu Jul 19 20:35:20 2001 UTC (18 years, 2 months ago) by george
File size: 14031 byte(s)
Substantial simplification in the CELLS interface
(* replaces uses and definitions of a virtual frame pointer (vfp) with the appropriate
 * operation on the stack pointer. 
 *
 * Invariant: fp = sp + delta &&  stack grows from high to low 	&& fp >= sp
 *
 * Assumptions: At the entry node fp = sp + idelta
 *
 * The tricky business is to recognize that things that look like register may
 * really be memory registers.
 *)
functor X86OmitFramePointer (
    structure I : X86INSTR 
    structure F : FLOWGRAPH where I = I
    structure PC : PRINT_CLUSTER where F=F
    structure MemRegs : MEMORY_REGISTERS where I=I
    val memRegBase : CellsBasis.cell option): OMIT_FRAME_POINTER = 
struct
  structure F = F
  structure I = I
  structure C = I.C
  structure CB = CellsBasis
  val sp = C.esp

  val dumpCfg = MLRiscControl.getFlag "dump-cfg-after-omit-frame-pointer"

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

  fun omitframeptr{vfp:CB.cell, idelta:Int32.int option, cl as F.CLUSTER{entry, blkCounter, ...}} = let

    (* rewrite a list of instructions where the gap between fp and sp is delta *)
    fun rewrite(instrs, idelta) = let

      (* What kind of register? *)
      datatype which = SP | FP | OTHER
      fun isSp cell = CB.sameColor(cell, sp)
      fun isVfp cell = CB.sameColor(cell, vfp)
      fun which(cell) = if isSp(cell) then SP else if isVfp(cell) then FP else OTHER
      fun either(cell) = isSp(cell) orelse isVfp(cell) 


      (* Has the instruction been rewritten? *)
      val changedFlag = ref false		


      (* 
       * rewrite a single instruction assuming gap (fp=sp+delta) 
       * returns NONE is instruction is deleted and SOME(instruction) otherwise.
       *)

      fun doInstr(instr, delta:Int32.int option) = let

        (* if a delta exists then add to it, 
	 * otherwise maintain that there is no delta
	 *)
	fun addToDelta i = 
	  (case delta 
	   of SOME d => SOME(i+d)
	    | NONE => NONE
	  (*esac*))

	fun incOffset(i) = 
	  (case delta
	   of NONE => error "incOffset"
	    | SOME k => k+i
	  (*esac*))

        fun incDisp(I.Immed i) = I.Immed(incOffset(i))
	  | incDisp _ = error "incDisp"	(* CONSTANTS? *)

	fun operand(opnd as I.Displace{base, disp, mem}) = 
	    if isVfp base then 
	      (changedFlag := true;
	       I.Displace{base=sp, mem=mem, disp=incDisp(disp)})
	    else opnd
	  | operand(opnd as I.Indexed{base, index, scale, disp, mem}) = 
	    if isVfp index then 
	      error "operand: frame pointer used in index"
	    else (case base
	      of NONE => opnd
	       | SOME b => 
		 if isVfp b then 
		    (changedFlag := true;
		     I.Indexed{base=SOME(sp), index=index, scale=scale, mem=mem, 
			       disp=incDisp(disp)})
		 else opnd
	     (*esac*))
	  | operand(opnd as I.MemReg _) = 
	      operand(MemRegs.memReg{reg=opnd, base=Option.valOf memRegBase})
	  | operand(opnd as I.FDirect _) = 
	      operand(MemRegs.memReg{reg=opnd, base=Option.valOf memRegBase})
	  | operand(opnd) = opnd


	fun annotate(i, k:Int32.int option) = let
	  val instr = 
	    if !changedFlag then 
	       (changedFlag := false;
		case k 
		of NONE => i
	         | SOME d => 
	           if d <> 0 then let
	              val cmt = "offset adjusted to " ^ Int32.toString d
	              val ann = #create MLRiscAnnotations.COMMENT cmt
  	            in I.ANNOTATION{i=i, a=ann}
	            end
	          else i
	        (*esac*))
	    else i
	in (SOME(instr),k)
	end

        fun unchanged(i) = annotate(i, delta)  
        fun changedto(i, k) = annotate(i, k)

        fun compare(test, lsrc, rsrc) = unchanged(test{lsrc=operand(lsrc), rsrc=operand(rsrc)})
        fun float(oper, opnd) = unchanged(oper(operand(opnd)))

      in
        case instr
        of I.JMP(opnd,labs) => unchanged(I.JMP(operand opnd, labs))
	 | I.JCC{cond:I.cond, opnd:I.operand} => 
	    unchanged(I.JCC{cond=cond, opnd=operand(opnd)})
	 | I.CALL{opnd, defs, uses, cutsTo, mem, return, pops=0} => 
	    unchanged(I.CALL{opnd=operand(opnd), defs=defs, uses=uses,
			     cutsTo=cutsTo, mem=mem, pops=0,
			     return=return})
	 | I.CALL{opnd, defs, uses, cutsTo, mem, return, pops} =>
	   changedto(I.CALL{opnd=operand(opnd), defs=defs, uses=uses,
			    cutsTo=cutsTo, mem=mem, pops=pops,
			    return=return},
		     addToDelta(~pops))
	 | I.ENTER{src1=I.Immed i1, src2=I.Immed i2} => changedto(instr,  addToDelta(i1 + i2*4))
	 | I.LEAVE => (SOME instr, NONE)
	 | I.RET opnd => (SOME instr, NONE)
	 | I.MOVE{mvOp:I.move, src=I.Direct s, dst=I.Direct d} =>
	   (case (which d, which s)
	    of (FP, SP) => (NONE, SOME 0)
	     | (SP, FP) => (case delta
		 of NONE => error "MOVE: (SP, FP)"
	          | SOME 0 => (NONE, SOME 0)
		  | SOME n => let 
		       val addr = I.Displace{base=sp, disp=I.Immed(n), mem=I.Region.stack}
		     in
		       (SOME(I.LEA{r32=sp, addr=addr}), SOME 0)
		     end
                 (*esac*))
	     | (OTHER, OTHER) => unchanged(instr)
	     | (FP, FP) => (NONE, delta)
	     | (SP, SP) => (NONE, delta)
	     | (FP, _) => error "MOVE: to FP"
	     | (SP, _) => error "MOVE: to SP"
	     | (OTHER, SP) => unchanged(instr)
	     | (OTHER, FP) => error "MOVE: FP to OTHER"	(* d:=sp+delta; lazy!*)
	   (*esac*))
	 | I.MOVE{mvOp, src, dst as I.Direct d} =>
	     if either(d) then error "MOVE: assignment to FP/SP"
	     else unchanged(I.MOVE{mvOp=mvOp, src=operand(src), dst=dst})
	 | I.MOVE{mvOp, src, dst} => 
	     unchanged(I.MOVE{mvOp=mvOp, src=operand(src), dst=operand(dst)})
	 | I.LEA{r32:CB.cell, addr as I.Displace{base, disp=I.Immed d, mem}} => 
	   (case (which r32, which base) 
	    of (SP, SP) => 
	         (* assumes stack grows from high to low. 
		  * if sp is incremented by a positive delta, then the gap is
		  * reduced by delta-d;
		  * if sp is decremented, the the gap is increased and d is negative.
		  *)
	         changedto(instr, addToDelta(~d))
	     | (SP, FP) => 
		 (*    sp = fp + d 
		  * or sp = sp + delta + d
		  *)
		 changedto(I.LEA{r32=r32, addr=operand(addr)}, SOME(incOffset(d)))
	     | (FP, FP) => 
		 (* fp = fp + d
		  * if d is positive, then the gap is increased to delta+d,
		  * if d is negative, then the gap is reduced.
                  *)
		 (NONE, SOME(incOffset(d)))
	     | (FP, SP) => (NONE, addToDelta(d))
	     | (SP, OTHER) => error "LEA: sp changed by non-immed"
	     | (FP, OTHER) => error "LEA: fp changed by non-immed"
	     | _ => unchanged(instr)
	   (*esac*))
	 | I.LEA{r32, addr} => 
	   if either(r32) then error "LEA: SP/FP changed by non-immed"
	   else unchanged(I.LEA{r32=r32, addr=operand(addr)})
	 | I.CMPL{lsrc: I.operand, rsrc: I.operand} => compare(I.CMPL, lsrc, rsrc)
	 | I.CMPW{lsrc: I.operand, rsrc: I.operand} => compare(I.CMPW, lsrc, rsrc)
	 | I.CMPB{lsrc: I.operand, rsrc: I.operand} => compare(I.CMPB, lsrc, rsrc)
	 | I.TESTL{lsrc: I.operand, rsrc: I.operand} => compare(I.TESTL, lsrc, rsrc)
	 | I.TESTW{lsrc: I.operand, rsrc: I.operand} => compare(I.TESTW, lsrc, rsrc)
	 | I.TESTB{lsrc: I.operand, rsrc: I.operand} => compare(I.TESTB, lsrc, rsrc)
	 | I.BITOP{bitOp:I.bitOp, lsrc: I.operand, rsrc: I.operand} =>
	    unchanged(I.BITOP{bitOp=bitOp, lsrc=operand(lsrc), rsrc=operand(rsrc)})
	 | I.BINARY{binOp=I.ADDL, src=I.Immed(k), dst=I.Direct(d)} => 
	   (case which d
	    of SP => changedto(instr, addToDelta(~k))
	     | FP => (NONE, SOME(incOffset(k)))
	     | OTHER => unchanged(instr)
           (*esac*))
	 | I.BINARY{binOp=I.SUBL, src=I.Immed(k), dst=I.Direct(d)} => 
           (case which d
	    of SP => changedto(instr, addToDelta(k))
	     | FP => (NONE, SOME(incOffset(~k)))
	     | OTHER => unchanged(instr)
           (*esac*))
	 | I.BINARY{binOp, dst as I.Direct(d), src} =>
	   if either(d) then error "binary: assignment to SP | FP"
	   else unchanged(I.BINARY{binOp=binOp, src=operand(src), dst=dst})
	 | I.BINARY{binOp, src, dst} =>
	    unchanged(I.BINARY{binOp=binOp, src=operand(src), dst=operand(dst)})
	 | I.CMPXCHG{lock:bool, sz:I.isize, src:I.operand, dst:I.operand} =>
	    unchanged(I.CMPXCHG{lock=lock, sz=sz, src=operand(src), dst=operand(dst)})
	 | I.MULTDIV{multDivOp:I.multDivOp, src:I.operand} =>
	    unchanged(I.MULTDIV{multDivOp=multDivOp, src=operand(src)})
	 | I.MUL3{dst:CB.cell, src2:Int32.int, src1:I.operand} => 
	   if either(dst) then error "MUL3: assignment to FP/SP"
	   else unchanged(I.MUL3{dst=dst, src2=src2, src1=operand(src1)})
	 | I.UNARY{unOp=I.INCL, opnd as I.Direct(r)} =>
	   (case (which r)
	    of SP => changedto(instr, addToDelta(~1))
	     | FP => (NONE, SOME(incOffset(1)))
	     | OTHER => unchanged(I.UNARY{unOp=I.INCL, opnd=opnd})
           (*esac*))
	 | I.UNARY{unOp=I.DECL, opnd as I.Direct(r)} => 
	   (case (which r)
	    of SP => changedto(instr, addToDelta(1))
	     | FP => (NONE, SOME(incOffset(~1)))
	     | OTHER => unchanged(I.UNARY{unOp=I.DECL, opnd=opnd})
	   (*esac*))
	 | I.UNARY{unOp, opnd} => unchanged(I.UNARY{unOp=unOp, opnd=operand(opnd)})
	 | I.SET{cond:I.cond, opnd:I.operand} => 
	     unchanged(I.SET{cond=cond, opnd=operand(opnd)})
	 | I.CMOV{cond:I.cond, src as I.Direct(s), dst:CB.cell} =>
	     if either(s) orelse either(dst) then 
	       error "CMOV: FP/SP in conditional move"
	     else unchanged(I.CMOV{cond=cond, src=operand(src), dst=dst})
	 | I.PUSHL opnd => changedto(I.PUSHL(operand(opnd)), addToDelta(4))
	 | I.PUSHW opnd => changedto(I.PUSHW(operand(opnd)), addToDelta(2))
	 | I.PUSHB opnd => changedto(I.PUSHB(operand(opnd)), addToDelta(1))
	 | I.POP opnd => changedto(I.POP(operand(opnd)), addToDelta(~4))
	 | I.COPY{dst:CB.cell list, src:CB.cell list, tmp:I.operand option} => let
	    (* the situation where SP <- FP is somewhat complicated.
	     * The copy must be extracted, and a lea generated.
	     * Should it be before or after the parallel copy? Depends on if SP is used. 
	     * However, will such a thing ever exist in a parallel copy!?
	     *)
	    fun okay(s, d, acc) = 
	      (case (which s, which d) 
               of (FP, SP) => true
		| (SP, FP) => error "COPY:SP<-FP; lazy!"
		| (SP, OTHER) => error "COPY:SP<-OTHER"
		| (FP, OTHER) => error "COPY:FP<-OTHER"
		| (OTHER, SP) => error "COPY:OTHER<-SP"
		| (OTHER, FP)  => error "COPY:OTHER<-FP"
		| _ => acc
	      (*esac*))
	   in changedto(instr, if ListPair.foldl okay false (dst, src) then SOME 0 else delta)
	   end
	 | I.FBINARY{binOp:I.fbinOp, src:I.operand, dst:I.operand} =>
	    unchanged(I.FBINARY{binOp=binOp, src=operand(src), dst=operand(dst)})
	 | I.FIBINARY{binOp:I.fibinOp, src:I.operand} =>
	    unchanged(I.FIBINARY{binOp=binOp, src=operand(src)})
	 | I.FUCOM opnd => unchanged(I.FUCOM(operand opnd))
	 | I.FUCOMP opnd => unchanged(I.FUCOMP(operand (opnd)))
	 | I.FSTPL opnd => float(I.FSTPL, opnd)
	 | I.FSTPS opnd => float(I.FSTPS, opnd)
	 | I.FSTPT opnd  => float(I.FSTPT, opnd)
	 | I.FSTL opnd => float(I.FSTL, opnd)
	 | I.FSTS opnd => float(I.FSTS, opnd)
	 | I.FLDL opnd => float(I.FLDL, opnd)
	 | I.FLDS opnd => float(I.FLDS, opnd)
	 | I.FLDT opnd => float(I.FLDT, opnd)
	 | I.FILD opnd => float(I.FILD, opnd)
	 | I.FILDL opnd => float(I.FILDLL, opnd)
	 | I.FILDLL opnd => float(I.FILDLL, opnd)
	 | I.FENV{fenvOp:I.fenvOp, opnd:I.operand} =>
	     unchanged(I.FENV{fenvOp=fenvOp, opnd=operand(opnd)})
	 | I.FMOVE{fsize:I.fsize, src:I.operand, dst:I.operand} =>
	     unchanged(I.FMOVE{fsize=fsize, src=operand(src), dst=operand(dst)})
	 | I.FILOAD{isize:I.isize, ea:I.operand, dst:I.operand} =>
	     unchanged(I.FILOAD{isize=isize, ea=operand(ea), dst=operand(dst)})
	 | I.FBINOP{fsize, binOp, lsrc, rsrc, dst} =>
	     unchanged(I.FBINOP{fsize=fsize, binOp=binOp, lsrc=operand(lsrc), 
				rsrc=operand(rsrc), dst=operand(dst)})
	 | I.FIBINOP{isize, binOp, lsrc, rsrc, dst} =>
	     unchanged(I.FIBINOP{isize=isize, binOp=binOp, lsrc=operand(lsrc), 
				rsrc=operand(rsrc), dst=operand(dst)})
	 | I.FUNOP{fsize:I.fsize, unOp:I.funOp, src:I.operand, dst:I.operand} =>
	     unchanged(I.FUNOP{fsize=fsize, unOp=unOp, src=operand(src), 
			       dst=operand(dst)})
	 | I.FCMP{fsize:I.fsize, lsrc:I.operand, rsrc:I.operand} =>
	     unchanged(I.FCMP{fsize=fsize, lsrc=operand(lsrc), rsrc=operand(rsrc)})
	 | I.ANNOTATION{i:I.instruction, a:Annotations.annotation} => let
	     val (instr, delta) = doInstr(i, delta)
	   in
	      case instr 
	      of NONE => (NONE, delta)
	       | SOME(i) => changedto(I.ANNOTATION{i=i, a=a}, delta)
           end	       
	 | _ => unchanged(instr)
      end  (* doInstr *)


      (* rewrite instructions *)
      fun doInstrs([], instrs, delta) = (instrs, delta)
        | doInstrs(instr::rest, acc, delta) = let
            val (instr, delta2) = doInstr(instr, delta)
	  in
	    case instr
	    of NONE => doInstrs(rest, acc, delta2)
	     | SOME(i) => doInstrs(rest, i::acc, delta2)
	  end


    in doInstrs(instrs, [], idelta)
    end (* rewrite *)


    

    (* rewrite blocks using a depth first traversal of the blocks *)
    val info = Array.array(!blkCounter, {visited=false, delta=NONE:Int32.int option})
    fun dfs(F.BBLOCK{blknum, insns, succ, ...}, delta) = let
          val {visited, delta=d} = Array.sub(info, blknum)
	  fun sameDelta(NONE, NONE) = true
	    | sameDelta(SOME i1: Int32.int option, SOME i2) = i1 = i2
	in
    	  if visited then (if sameDelta(d, delta) then () else error "dfs")
	  else let 
	      val (instrs, delta2) = rewrite(rev(!insns), delta)
	    in 
	      insns := instrs;
	      Array.update(info, blknum, {visited=true, delta=delta});
	      app (fn (blk, _) => dfs(blk, delta2)) (!succ)
	    end
	end
      | dfs(F.ENTRY{succ, ...}, delta) = 
	  app (fn (blk, _) => dfs(blk, delta)) (!succ)
      | dfs(F.EXIT _, _) = ()
      | dfs(_, _) = error "dfs: BBLOCK expected"



    val CB.CELL{col, ...} = vfp
  in 
    (* 
     * check that virtual frame pointer is a pseudo register or
     * aliased to the stack pointer.
     *)
    case !col
     of CB.PSEUDO => dfs(entry, idelta)
      | _ => error "virtual frame pointer not a pseudo register"
    (*esac*);
    
    (* output cluster  *)
    if !dumpCfg then 
      PC.printCluster TextIO.stdOut "after omit frame pointer"  cl
    else ()
  end
end


root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0