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/backpatch/vlBackPatch.sml
ViewVC logotype

View of /sml/trunk/src/MLRISC/backpatch/vlBackPatch.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 744 - (download) (annotate)
Fri Dec 8 04:11:42 2000 UTC (18 years, 9 months ago) by leunga
File size: 4912 byte(s)

   A CVS update record!

   Changed type cell from int to datatype, and numerous other changes.
   Affect every client of MLRISC.  Lal says this can be bootstrapped on all
   machines.  See smlnj/HISTORY for details.

   Tag:  leunga-20001207-cell-monster-hack
(* vlBackPatch.sml -- variable length back patching. 
 *
 * Copyright 1999 by Bell Laboratories 
 *)
signature MC_EMIT = sig
  structure I : INSTRUCTIONS

  val emitInstr : I.instruction -> Word8Vector.vector
end

  
functor BackPatch
  (structure CodeString : CODE_STRING
   structure Jumps: SDI_JUMPS 
   structure Props : INSN_PROPERTIES 
   structure Emitter : MC_EMIT
   structure Flowgraph : FLOWGRAPH
   structure Asm : INSTRUCTION_EMITTER
      sharing Emitter.I = Jumps.I = Flowgraph.I = Props.I = Asm.I) : BBSCHED = 
struct 
  structure I = Jumps.I
  structure C = I.C
  structure F = Flowgraph
  structure P = F.P
  structure W8V = Word8Vector

  datatype desc =
      BYTES of W8V.vector * desc 
    | PSEUDO of P.pseudo_op  * desc
    | SDI of I.instruction * int ref * desc
    | LABEL of Label.label * desc
    | NIL

  datatype cluster = CLUSTER of {cluster: desc}

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

  val clusters = ref ([] : cluster list)

  fun cleanUp() = clusters := []

  fun bbsched(F.CLUSTER{blocks, ...}) = let
    fun bytes([], p) = p
      | bytes([s], p) = BYTES(s, p)
      | bytes(s, p) = BYTES(W8V.concat s, p)
    (* Note: Instructions start out in reverse order *)
    fun f(F.PSEUDO pOp::rest) = PSEUDO(pOp, f rest)
      | f(F.LABEL lab::rest) = LABEL(lab, f rest)
      | f(F.BBLOCK{insns, ...}::rest) = let
	 fun instrs([], b) = bytes(rev b, f rest)
	   | instrs(i::rest, b) = 
	     if Jumps.isSdi i then 
	       bytes(rev b, SDI(i, ref(Jumps.minSize i), instrs(rest, [])))
	     else
	       instrs(rest, Emitter.emitInstr(i)::b)
	in instrs(rev(!insns), []) 
	end 
      | f(F.ENTRY _::rest) = f rest
      | f(F.EXIT _::rest) = f rest
      | f [] = NIL
  in
    clusters := 
      CLUSTER{cluster=f blocks}:: !clusters
  end

  fun finish() = let
    fun labels (BYTES(s,rest), pos, chgd) = labels(rest, pos+W8V.length s, chgd)
      | labels (SDI(_, ref size, rest), pos, chgd) = labels(rest, pos+size, chgd)
      | labels (LABEL(l,rest), pos, changed) = 
        if Label.addrOf(l) = pos then labels(rest, pos, changed)
	else (Label.setAddr(l, pos); labels(rest, pos, true))
      | labels (PSEUDO(pOp, rest), pos, chgd) = let
	  val oldSz = P.sizeOf(pOp, pos)
	  val newSz = (P.adjustLabels(pOp, pos); P.sizeOf(pOp, pos))
        in labels(rest, pos + newSz, chgd orelse newSz<>oldSz)
	end
      | labels (NIL, pos, chgd) = (pos, chgd)

    fun clusterLabels clusters = let
      fun f (CLUSTER{cluster, ...}, (pos,chgd)) = labels(cluster, pos, chgd) 
    in List.foldl f (0, false) clusters
    end
      
    fun adjust([], pos) = () 
      | adjust(CLUSTER{cluster}::rest, pos) = let
	  fun f(pos, BYTES(s, rest)) = f(pos+W8V.length s, rest)
	    | f(pos, SDI(instr, r as ref size, rest)) = let
		val s = Jumps.sdiSize(instr, Label.addrOf, pos)
	      in
		if s > size then r := s else ();
		f (pos+size, rest)
	      end
	    | f(pos, LABEL(l,rest)) = f(pos, rest)
	    | f(pos, PSEUDO(pOp,rest)) = f(pos + P.sizeOf(pOp, pos), rest)
	    | f(pos, NIL) = adjust(rest, pos)
        in f(pos, cluster)
        end
       
    val nop = Props.nop()

    val loc = ref 0

    fun output v = 
      W8V.app (fn v => (CodeString.update(!loc, v); loc:= !loc+1)) v

    val Asm.S.STREAM{emit,...} = Asm.makeStream []

    fun chunk(pos, []) = ()
      | chunk(pos, CLUSTER{cluster}::rest) = let
          fun outputInstr i = output (Emitter.emitInstr(nop))
          fun nops 0 = ()
	    | nops n = 
	       if n < 0 then error "chunk.nops"
	       else (outputInstr(nop); nops(n-1))
	  fun f(pos, BYTES(s,r)) = (output s; f(pos+W8V.length s,r))
	    | f(pos, SDI(instr, ref size, r)) = let
	        val emitInstrs = map (fn i => Emitter.emitInstr(i))
	        val instrs = emitInstrs (Jumps.expand(instr, size, pos))
		val sum = List.foldl (fn (a,b) => (W8V.length a + b)) 0
		val n = size - sum instrs
              in
		if n > 0 then 
		  (print ("\t\t\t Inserting " ^ Int.toString n ^ "nops\n");
		   emit instr)
		else ();
		app output instrs;
		if n < 0 then 
		  error "chunk: numNops"
		else 
		  if n = 0 then () else nops(n);
		f(pos+size, r)
	      end
	    | f(pos, LABEL(lab, rest)) = 
	        if pos = Label.addrOf lab then f(pos,rest)
		else error "chunk: LABEL"
	    | f(pos, PSEUDO(pOp, rest)) = let
	        val s : Word8.word list ref = ref []
	      in
	        P.emitValue{pOp=pOp, loc=pos, 
			    emit=(fn w => s :=  w :: (!s))};
		output(W8V.fromList(rev(!s)));
		f(pos + P.sizeOf(pOp, pos), rest)
              end
	    | f(pos, NIL) = chunk(pos, rest)

        in f(pos, cluster)
	end

    fun fix clusters = let
      val (pos, changed) = clusterLabels clusters
    in if changed then (adjust(clusters, 0); fix clusters) else pos
    end

    val clusters = rev(!clusters) before clusters := []
  in
    CodeString.init(fix clusters);
    loc := 0; chunk(0, clusters)
  end (* finish *)

end (* functor BackPatch *)



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