SCM Repository
View of /sml/branches/SMLNJ/src/MLRISC/cluster/clustergen.sml
Parent Directory
|
Revision Log
Revision 469 -
(download)
(annotate)
Wed Nov 10 22:42:52 1999 UTC (21 years, 5 months ago) by monnier
File size: 8603 byte(s)
Wed Nov 10 22:42:52 1999 UTC (21 years, 5 months ago) by monnier
File size: 8603 byte(s)
version 110.23
(* flowgen.sml * * COPYRIGHT (c) 1995 AT&T Bell Laboratories. * *) functor ClusterGen (structure Flowgraph : FLOWGRAPH structure InsnProps : INSN_PROPERTIES structure MLTree : MLTREE val output : Flowgraph.cluster -> unit sharing Flowgraph.I = InsnProps.I sharing MLTree.Constant = InsnProps.I.Constant sharing MLTree.PseudoOp = Flowgraph.P ) : FLOWGRAPH_GEN = struct structure F = Flowgraph structure Props = InsnProps structure I = Flowgraph.I structure C = I.C structure T = MLTree structure P = T.PseudoOp structure S = T.Stream type label = Label.label fun error msg = MLRiscErrorMsg.error("ClusterGen",msg) type flowgraph = F.cluster fun newStream() = let val bblkCnt = ref 0 val entryLabels = ref ([] : Label.label list) val regmap = ref NONE fun can'tUse _ = error "unimplemented" val aliasF = ref can'tUse : (T.alias -> unit) ref val NOBLOCK = F.EXIT{blknum=0,freq=ref 0,pred=ref []} val currBlock : F.block ref = ref NOBLOCK val blockList : F.block list ref = ref [] fun nextBlkNum () = !bblkCnt before bblkCnt := !bblkCnt + 1 (** Note - currBlock will always be a reference to a F.BBLOCK{..} **) fun newBasicBlk init = F.BBLOCK{blknum=nextBlkNum(), freq=ref 1, annotations=ref [], liveIn=ref C.empty, liveOut=ref C.empty, succ=ref [], pred=ref [], insns=ref init} local fun blockListAdd b = let val blocks = !blockList in case !currBlock of blk as F.BBLOCK _ => (blockList:=b::blk::blocks; currBlock:=NOBLOCK) | _ => blockList := b::blocks end in fun pseudoOp pOp = blockListAdd (F.PSEUDO pOp) fun defineLabel lab = blockListAdd(F.LABEL lab) fun entryLabel lab = (entryLabels := lab::(!entryLabels); blockListAdd(F.LABEL lab)) end (*local*) (** emitInstr - instructions are always added to currBlock. **) fun emitInstr instr = let fun addInstr (F.BBLOCK{insns, ...}) = insns := instr::(!insns) | addInstr _ = currBlock:=newBasicBlk [instr] in addInstr(!currBlock); case Props.instrKind instr of Props.IK_JUMP => (blockList:= !currBlock :: (!blockList); currBlock := NOBLOCK) | _ => () (*esac*) end fun annotation a = case !currBlock of F.BBLOCK{annotations,...} => annotations := a :: !annotations | _ => (currBlock := newBasicBlk []; annotation a) fun exitBlock liveRegs = let val addReg = C.addCell C.GP val addFreg = C.addCell C.FP val addCCreg = C.addCell C.CC (* we don't care about memory locations that may be live. *) fun live(T.GPR(T.REG(_,r))::rest, acc) = live(rest, addReg(r, acc)) | live(T.FPR(T.FREG(_,f))::rest, acc) = live(rest, addFreg(f, acc)) | live(T.CCR(T.CC c)::rest, acc) = live(rest, addCCreg(c, acc)) | live(_::rest, acc) = live(rest, acc) | live([], acc) = acc val lout = live(liveRegs, C.empty) fun findCodeBlock(F.BBLOCK{liveOut,...}::_) = liveOut | findCodeBlock(F.LABEL _::blks) = findCodeBlock blks | findCodeBlock _ = error "exitBlock.codeBlock" in case !currBlock of F.BBLOCK{liveOut, ...} => (liveOut := lout; blockList := !currBlock :: (!blockList); currBlock := NOBLOCK) | _ => let val outRef = findCodeBlock (!blockList) in outRef := lout end (*esac*) end fun endCluster(annotations) = let exception LabTbl val labTbl : F.block Intmap.intmap = Intmap.new(16, LabTbl) val addLabTbl = Intmap.add labTbl val lookupLabTbl = Intmap.map labTbl (* find next code block *) exception NextCodeBlock fun nextCodeBlock((blk as F.BBLOCK _)::_) = blk | nextCodeBlock(_::rest) = nextCodeBlock rest | nextCodeBlock [] = raise NextCodeBlock (* mapping of labels to code blocks *) fun fillLabTbl(F.LABEL lab::blks) = (addLabTbl(Label.id lab, nextCodeBlock blks) handle NextCodeBlock => (); fillLabTbl blks) (*| fillLabTbl(F.ORDERED labs::blks) = fillLabTbl(labs@blks)*) | fillLabTbl(_::blks) = fillLabTbl(blks) | fillLabTbl [] = () val exitBlk = F.EXIT{blknum=nextBlkNum(), pred=ref [], freq=ref 1} (** update successor and predecessor information **) fun graphEdges((blk as F.BBLOCK{blknum,insns,succ,...})::blks) = let fun updtPred(F.BBLOCK{pred, ...},w) = pred := (blk,w)::(!pred) | updtPred(F.EXIT{pred, ...},w) = pred := (blk,w)::(!pred) fun succBlks([], acc) = acc | succBlks(Props.FALLTHROUGH::labs, acc) = ((succBlks(labs, (nextCodeBlock blks,ref 0)::acc)) handle NextCodeBlock => error "graphEdges.succBlks") | succBlks(Props.LABELLED lab::labs, acc) = ((succBlks(labs,(lookupLabTbl(Label.id lab),ref 0)::acc)) handle LabTbl => succBlks(labs, (exitBlk,ref 0)::acc)) | succBlks(Props.ESCAPES::labs,acc) = succBlks(labs, (exitBlk,ref 0)::acc) val lastInstr = ((hd (!insns)) handle _ => error "endCluster.graphEdges.lastInstr") fun lastCodeBlock(F.BBLOCK _ :: _) = false | lastCodeBlock(_::rest) = lastCodeBlock rest | lastCodeBlock [] = true in case Props.instrKind lastInstr of Props.IK_JUMP => succ:=succBlks (Props.branchTargets lastInstr,[]) | _ => if lastCodeBlock blks then succ := [(exitBlk,ref 0)] (* control must escape via trap *) else succ := [(nextCodeBlock blks,ref 0)] (*esac*); app updtPred (!succ); graphEdges(blks) end | graphEdges(_::blks) = graphEdges(blks) | graphEdges [] = () fun mkEntryBlock () = let val blocks = map (fn Label.Label{id,...} => (lookupLabTbl id,ref 0)) (!entryLabels) val entryBlk = F.ENTRY{blknum=nextBlkNum(), freq=ref 1, succ=ref blocks} in app (fn (F.BBLOCK{pred, ...},w) => pred := (entryBlk,w)::(!pred)) blocks; entryBlk end val _ = case !currBlock of blk as F.BBLOCK _ => blockList := blk :: !blockList | _ => () val blocks = rev(!blockList) val _ = blockList := [] val _ = fillLabTbl(blocks) val _ = graphEdges(blocks) val cluster = F.CLUSTER{blocks=blocks, entry=mkEntryBlock(), exit=exitBlk, blkCounter=ref(!bblkCnt), regmap= Option.valOf(!regmap), annotations=ref(annotations)} val _ = regmap := NONE val _ = aliasF := can'tUse in output cluster end fun beginCluster _ = let val map = C.regmap() in entryLabels := []; bblkCnt := 0; blockList := []; currBlock := NOBLOCK; regmap := SOME map; aliasF := Intmap.add map; map end fun comment msg = annotation(#create BasicAnnotations.COMMENT msg) fun alias(v,r) = !aliasF(v,r) in S.STREAM { beginCluster= beginCluster, endCluster = endCluster, emit = emitInstr, defineLabel = defineLabel, entryLabel = entryLabel, pseudoOp = pseudoOp, exitBlock = exitBlock, annotation = annotation, comment = comment, alias = alias, phi = can'tUse } end end
root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |
Powered by ViewVC 1.0.0 |