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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1133 - (download) (annotate)
Tue Mar 12 03:56:23 2002 UTC (17 years, 3 months ago) by george
File size: 4839 byte(s)
Tested the jump chain elimination on all architectures (except the
hppa).  This is on by default right now and is profitable for the
alpha and x86, however, it may not be profitable for the sparc and ppc
when compiling the compiler.

The gc test will typically jump to a label at the end of the cluster,
where there is another jump to an external cluster containing the actual
code to invoke gc. This is to allow factoring of common gc invocation
sequences. That is to say, we generate:

	   ja	L1	% jump if above to L1

	   jmp L2

After jump chain elimination the 'ja L1' instructions is converted to
'ja L2'. On the sparc and ppc, many of the 'ja L2' instructions may end
up being implemented in their long form (if L2 is far away) using:

	jbe	L3	% jump if below or equal to L3
        jmp 	L2

For large compilation units L2  may be far away.
(* bbsched2.sml
 * COPYRIGHT (c) 1996 Bell Laboratories.

(** bbsched2.sml - invoke scheduling after span dependent resolution **)

functor BBSched2
    (structure Emitter : INSTRUCTION_EMITTER
     structure CFG     : CONTROL_FLOW_GRAPH
			where I = Emitter.I
		          and P = Emitter.S.P
     structure Jumps   : SDI_JUMPS
     			where I = CFG.I
     structure Props   : INSN_PROPERTIES
			where I = CFG.I
    ) = 

  structure CFG = CFG
  structure G = Graph
  structure I = CFG.I
  structure C = I.C
  structure E = Emitter
  structure J = Jumps
  structure P = CFG.P

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

  datatype code =
      SDI of {size : int ref,		(* variable sized *)
	      insn : I.instruction}
    | FIXED of {size: int,		(* size of fixed instructions *)
		insns: I.instruction list}
  datatype compressed = 
      PSEUDO of P.pseudo_op
    | LABEL  of Label.label
    | CODE of  code list

  datatype cluster = CLUSTER of compressed list

  val clusterList : cluster list ref = ref []
  val dataList : P.pseudo_op list ref = ref []
  fun cleanUp() = (clusterList := []; dataList := [])

  fun bbsched(G.GRAPH{graph_info=CFG.INFO{data, ...}, ...}, blocks) = let
   fun compress [] = []
      | compress((_, CFG.BLOCK{align, labels, insns, ...}) :: rest) = let
          fun alignIt(chunks) = 
	    (case !align of NONE => chunks | SOME p => PSEUDO(p)::chunks)

	  fun mkCode(0, [], [], code) = code
	    | mkCode(size, insns, [], code) = FIXED{size=size, insns=insns}:: code
	    | mkCode(size, insns, instr::instrs, code) = let
		val s = J.minSize instr
		if J.isSdi instr then let
		    val sdi = SDI{size=ref s, insn=instr}
		    if size = 0 then 
		      mkCode(0, [], instrs, sdi::code)
		      mkCode(0, [], instrs, 
			     sdi::FIXED{size=size, insns=insns}::code)
		else mkCode(size+s, instr::insns, instrs, code)
	    (map LABEL (!labels) @ 
	       CODE(mkCode(0, [], !insns, [])) :: compress rest)
    clusterList:=CLUSTER(compress blocks):: (!clusterList);
    dataList := !data @ !dataList

  fun finish() = let
    fun labels(PSEUDO pOp::rest, pos, chgd) = 
          (P.adjustLabels(pOp, pos); labels(rest, pos+P.sizeOf(pOp,pos), chgd))
      | labels(LABEL lab::rest, pos, chgd) = 
	 if Label.addrOf(lab) = pos then labels(rest, pos, chgd)
	 else (Label.setAddr(lab, pos); labels(rest, pos, true))
      | labels(CODE code::rest, pos, chgd) = let
 	  fun doCode(FIXED{size, ...}::rest, pos, changed) = 
	        doCode(rest, pos+size, changed)
	    | doCode(SDI{size, insn}::rest, pos, changed) = let
	  	val newSize = J.sdiSize(insn, Label.addrOf, pos)
		  if newSize <= !size then doCode(rest, !size + pos, changed)
		  else (size:=newSize; doCode(rest, newSize+pos, true))
	    | doCode([], pos, changed) = labels(rest, pos, changed)
        in doCode(code, pos, chgd)
      | labels([], pos,chgd) = (pos, chgd)

    fun clusterLabels clusters = let
      fun f (CLUSTER cl, (pos, chgd)) = labels(cl, pos, chgd)
    in List.foldl f (0, false) clusters

    fun fixpoint zl = let 
      val (size, changed) = clusterLabels zl
    in if changed then fixpoint zl else size

    val Emitter.S.STREAM{emit,defineLabel,beginCluster,pseudoOp,...} = 
            Emitter.makeStream []

    fun emitCluster(CLUSTER(comp),loc) = let
	  fun process(PSEUDO pOp,loc) = (pseudoOp pOp; loc + P.sizeOf(pOp,loc))
	    | process(LABEL lab,loc) = (defineLabel lab; loc)
	    | process(CODE code,loc) = let
		fun emitInstrs insns = app emit insns
		fun e(FIXED{insns, size,...},loc) = (emitInstrs insns; loc+size)
		  | e(SDI{size, insn},loc) = 
		       (emitInstrs(J.expand(insn, !size, loc)); !size + loc)
	      in foldl e loc code
	in foldl process loc comp

    fun initLabels(clusters) = let
      fun init(PSEUDO(p)::rest, loc) = 
	   (P.adjustLabels(p, loc); init(rest, loc + P.sizeOf(p, loc)))
	| init(LABEL lab::rest, loc) = (Label.setAddr(lab,loc); init(rest, loc))
	| init(CODE code::rest, loc) = let
 	   fun size(FIXED{size, ...}) = size
	     | size(SDI{size, ...}) = !size
	    init(rest, List.foldl (fn (c, b) => size(c) + b) loc code)
        | init([], loc) = loc

        (fn (CLUSTER(cl), loc) => init(cl, loc)) 0 clusters

    (* The dataList is in reverse order and the clusters are in reverse *)
    fun dataCluster([], acc) = CLUSTER(acc)
      | dataCluster(d::dl, acc) = dataCluster(dl, PSEUDO d::acc)
    val compressed = 
      rev (dataCluster(!dataList, []) :: !clusterList) before cleanUp()
    beginCluster(fixpoint (compressed));
    foldl emitCluster 0 compressed; 
  end (*finish*)
end (* bbsched2 *)

ViewVC Help
Powered by ViewVC 1.0.0