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

SCM Repository

[smlnj] Diff of /sml/trunk/src/MLRISC/cluster/clustergen.sml
ViewVC logotype

Diff of /sml/trunk/src/MLRISC/cluster/clustergen.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 497, Tue Dec 7 15:44:50 1999 UTC revision 498, Tue Dec 7 15:44:50 1999 UTC
# Line 8  Line 8 
8    (structure Flowgraph : FLOWGRAPH    (structure Flowgraph : FLOWGRAPH
9     structure InsnProps : INSN_PROPERTIES     structure InsnProps : INSN_PROPERTIES
10     structure MLTree : MLTREE     structure MLTree : MLTREE
   
    val output : Flowgraph.cluster -> unit  
11       sharing Flowgraph.I = InsnProps.I       sharing Flowgraph.I = InsnProps.I
12       sharing MLTree.Constant = InsnProps.I.Constant       sharing MLTree.Constant = InsnProps.I.Constant
13       sharing MLTree.PseudoOp = Flowgraph.P       sharing MLTree.PseudoOp = Flowgraph.P
# Line 17  Line 15 
15  struct  struct
16    
17    structure F = Flowgraph    structure F = Flowgraph
   structure Props = InsnProps  
18    structure I = Flowgraph.I    structure I = Flowgraph.I
19    structure C = I.C    structure C = I.C
20    
# Line 25  Line 22 
22    structure P = T.PseudoOp    structure P = T.PseudoOp
23    structure S = T.Stream    structure S = T.Stream
24    
   type label = Label.label  
   
25    fun error msg = MLRiscErrorMsg.error("ClusterGen",msg)    fun error msg = MLRiscErrorMsg.error("ClusterGen",msg)
26    
27      fun can'tUse _ = error "unimplemented"
28    
29    type flowgraph = F.cluster    type flowgraph = F.cluster
30    
31    fun newStream() =    (* This rewritten version allows increment flowgraph updates *)
32    let val bblkCnt = ref 0  
33        val entryLabels = ref ([] : Label.label list)    fun newStream{compile,flowgraph} =
34        val regmap  = ref NONE    let val NOBLOCK = F.LABEL(Label.Label{id= ~1, name="", addr=ref 0})
35        fun can'tUse _ = error "unimplemented"  
36        val aliasF  = ref can'tUse : (T.alias -> unit) ref        val (blkCounter, regmap, annotations, blocks, entry, exit) =
37        val NOBLOCK = F.EXIT{blknum=0,freq=ref 0,pred=ref []}            case flowgraph of
38        val currBlock : F.block ref = ref NOBLOCK              SOME(F.CLUSTER{blkCounter, regmap, annotations, blocks,
39        val blockList : F.block list ref = ref []                             entry, exit, ...}) =>
40        val blockNames : Annotations.annotations ref = ref []                    (ref(!blkCounter-2),
41                       ref regmap, !annotations, ref(rev blocks),
42        fun nextBlkNum () = !bblkCnt before bblkCnt := !bblkCnt + 1                     entry, exit)
43              | NONE => (ref 0, ref(C.regmap()), [], ref [], NOBLOCK, NOBLOCK)
44        (** Note - currBlock will always be a reference to a F.BBLOCK{..} **)  
45        fun newBasicBlk init =        val currBlock   = ref NOBLOCK
46            F.BBLOCK{blknum=nextBlkNum(),        val blockNames  = ref [] : Annotations.annotations ref
47          val aliasF      = ref (Intmap.add (!regmap))
48          val entryLabels = ref [] : Label.label list ref
49    
50          fun nextBlockNum() =
51          let val n = !blkCounter in blkCounter := n + 1; n end
52    
53          (* Create a new basic block *)
54          fun newBasicBlock insns =
55          let val n = !blkCounter
56          in  blkCounter := n + 1;
57              F.BBLOCK{blknum      = n,
58                     freq=ref 1,                     freq=ref 1,
59                     annotations=ref(!blockNames),                     annotations=ref(!blockNames),
60                     liveIn=ref C.empty,                     liveIn=ref C.empty,
61                     liveOut=ref C.empty,                     liveOut=ref C.empty,
62                     succ=ref [],                     succ=ref [],
63                     pred=ref [],                     pred=ref [],
64                     insns=ref init}                     insns       = ref insns
65        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*)  
66        end        end
67    
68        fun annotation a =        (* Add current block to the list *)
69            case #peek BasicAnnotations.BLOCK_NAMES a of        fun endCurrBlock() =
             SOME names =>  
             (blockNames := names;  
70               case !currBlock of               case !currBlock of
71                 blk as F.BBLOCK _ => (blockList:= blk :: (!blockList);              blk as F.BBLOCK _ => (blocks := blk:: !blocks; currBlock := NOBLOCK)
                                      currBlock := NOBLOCK)  
72               | _ => ()               | _ => ()
73              )  
74           | NONE =>        (* Add pseudo op/label to the block list *)
75              if #contains BasicAnnotations.EMPTY_BLOCK [a] then        fun blockListAdd b = (endCurrBlock(); blocks := b :: !blocks)
76          fun pseudoOp pOp = blockListAdd (F.PSEUDO pOp)
77          fun defineLabel lab = blockListAdd (F.LABEL lab)
78          fun entryLabel lab = (entryLabels := lab :: !entryLabels; defineLabel lab)
79    
80          (* Add an instruction to the current block *)
81          fun emit instr =
82              (case !currBlock of              (case !currBlock of
83                 blk as F.BBLOCK _ => blockList := blk :: (!blockList)              F.BBLOCK{insns, ...} => insns := instr :: !insns
84               | _ => blockList := newBasicBlk [] :: (!blockList)            | _ => currBlock := newBasicBlock [instr]
85               ;               ;
86               currBlock := NOBLOCK            case InsnProps.instrKind instr of
87                InsnProps.IK_JUMP => (blocks := !currBlock :: !blocks;
88                                      currBlock := NOBLOCK)
89              | _ => ()
90              )              )
91              else  
92          (* Add an annotation *)
93          fun annotation a =
94              case #peek MLRiscAnnotations.BLOCK_NAMES a of
95                SOME names => (endCurrBlock(); blockNames := names)
96              | NONE => if #contains MLRiscAnnotations.EMPTY_BLOCK [a] then
97              (case !currBlock of              (case !currBlock of
98                 F.BBLOCK{annotations,...} => annotations := a :: !annotations                            F.BBLOCK _ => ()
99              | _ => (currBlock := newBasicBlk []; annotation a)                          | _ => currBlock := newBasicBlock [];
100                            endCurrBlock())
101                        else (case !currBlock of
102                                F.BBLOCK{annotations, ...} =>
103                                 annotations := a :: !annotations
104                             |  _ => (currBlock := newBasicBlock []; annotation a)
105              )              )
106    
107        fun exitBlock liveRegs  = let        (* Add a comment *)
108          val addReg   = C.addCell C.GP        fun comment msg = annotation(#create MLRiscAnnotations.COMMENT msg)
109          val addFreg  = C.addCell C.FP  
110          val addCCreg = C.addCell C.CC        (* Mark a block as exit *)
111          fun exitBlock liveRegs =
112          let val addCCreg = C.addCell C.CC
113          (* we don't care about memory locations that may be live. *)          (* we don't care about memory locations that may be live. *)
114          fun live(T.GPR(T.REG(_,r))::rest, acc) = live(rest, addReg(r, acc))            fun live(T.GPR(T.REG(_,r))::rest, acc) = live(rest,C.addReg(r, acc))
115            | live(T.FPR(T.FREG(_,f))::rest, acc) = live(rest, addFreg(f, acc))              | live(T.FPR(T.FREG(_,f))::rest, acc) = live(rest,C.addFreg(f, acc))
116            | live(T.CCR(T.CC c)::rest, acc) = live(rest, addCCreg(c, acc))            | live(T.CCR(T.CC c)::rest, acc) = live(rest, addCCreg(c, acc))
117            | live(_::rest, acc) = live(rest, acc)            | live(_::rest, acc) = live(rest, acc)
118            | live([], acc) = acc            | live([], acc) = acc
119    
120          val lout = live(liveRegs, C.empty)            fun findLiveOut(F.BBLOCK{liveOut, ...}::_) = liveOut
121                | findLiveOut(F.LABEL _::blks) = findLiveOut blks
122                | findLiveOut _ = error "exitBlock: no basic block"
123          in  endCurrBlock();
124              findLiveOut (!blocks) := live(liveRegs, C.empty)
125          end
126    
127          fun findCodeBlock(F.BBLOCK{liveOut,...}::_)  = liveOut        (* Add an alias to the regmap *)
128            | findCodeBlock(F.LABEL _::blks) = findCodeBlock blks        fun alias(v,r) = !aliasF(v,r)
129            | findCodeBlock _                = error "exitBlock.codeBlock"  
130          (* Start a new cluster *)
131        in        fun beginCluster _ = !regmap
132          case !currBlock  
133           of F.BBLOCK{liveOut, ...} =>        (* End a cluster *)
134              (liveOut := lout;        fun endCluster blockAnnotations =
135               blockList := !currBlock :: (!blockList);        let exception LabelMap
136               currBlock := NOBLOCK)            val labelMap : F.block Intmap.intmap = Intmap.new(16, LabelMap)
137              val addLabelMap = Intmap.add labelMap
138    
139              (* find the next code block *)
140              fun nextCodeBlock((blk as F.BBLOCK _)::_) = blk
141                | nextCodeBlock(_::blks) = nextCodeBlock blks
142                | nextCodeBlock [] = error "nextCodeBlock"
143    
144              fun fillLabelMap(F.LABEL(Label.Label{id, ...})::blks,ids) =
145                  fillLabelMap(blks, id::ids)
146                | fillLabelMap((blk as F.BBLOCK _)::blks, ids) =
147                  let fun loop [] = ()
148                        | loop (id::ids) = (addLabelMap(id, blk); loop ids)
149                  in  loop ids; fillLabelMap(blks, [])  end
150                | fillLabelMap(_::blks, ids) = fillLabelMap(blks, ids)
151                | fillLabelMap([], _) = ()
152    
153              val exitBlk =
154                  case exit of
155                    F.EXIT{freq, ...} =>
156                         F.EXIT{blknum=nextBlockNum(), pred=ref [], freq=freq}
157                  | _ => F.EXIT{blknum=nextBlockNum(), pred=ref [], freq=ref 1}
158    
159              val (entryBlk, entryEdges) =
160                  case entry of
161                    F.ENTRY{freq, succ, ...} =>
162                        (F.ENTRY{blknum=nextBlockNum(), succ=succ, freq=freq},
163                         succ)
164            | _ =>            | _ =>
165              let val outRef = findCodeBlock (!blockList)                  let val edges = ref []
166              in  outRef := lout                  in  (F.ENTRY{blknum=nextBlockNum(), succ=edges, freq=ref 1},
167              end                       edges)
        (*esac*)  
168        end        end
169    
170        fun endCluster(annotations) = let            val lookupLabelMap = Intmap.mapWithDefault (labelMap, exitBlk)
           exception LabTbl  
           val labTbl : F.block Intmap.intmap = Intmap.new(16, LabTbl)  
           val addLabTbl = Intmap.add labTbl  
           val lookupLabTbl = Intmap.map labTbl  
171    
172            (* find next code block *)            fun addPred blk (F.BBLOCK{pred, ...}, w) = pred := (blk,w) :: !pred
173            exception NextCodeBlock              | addPred blk (F.EXIT{pred, ...}, w) = pred := (blk,w) :: !pred
174            fun nextCodeBlock((blk as F.BBLOCK _)::_) = blk              | addPred _   _ = error "addPred"
175              | nextCodeBlock(_::rest) = nextCodeBlock rest  
176              | nextCodeBlock [] = raise NextCodeBlock            (* Update successor and predecessor edges *)
177              fun insertGraphEdges [] = ()
178                | insertGraphEdges((blk as F.BBLOCK{blknum,insns,succ,...})::rest) =
179                  let fun succBlocks([], succs) = succs
180                        | succBlocks(InsnProps.FALLTHROUGH::labs, succs) =
181                            succBlocks(labs, (nextCodeBlock rest, ref 0)::succs)
182                        | succBlocks(InsnProps.LABELLED(Label.Label{id,...})::labs,
183                                     succs) =
184                            succBlocks(labs, (lookupLabelMap id, ref 0)::succs)
185                        | succBlocks(InsnProps.ESCAPES::labs, succs) =
186                            succBlocks(labs, (exitBlk, ref 0)::succs)
187    
188                      (* Is it the last code block *)
189                      fun isLastCodeBlock(F.BBLOCK _::_) = false
190                        | isLastCodeBlock(_::rest) = isLastCodeBlock rest
191                        | isLastCodeBlock [] = true
192    
193            (* mapping of labels to code blocks *)                in  case !insns of
           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)  
   
                 fun lastCodeBlock(F.BBLOCK _ :: _) = false  
                   | lastCodeBlock(_::rest) = lastCodeBlock rest  
                   | lastCodeBlock [] = true  
               in  
                 case !insns of  
194                    lastInstr::_ =>                    lastInstr::_ =>
195                      (case Props.instrKind lastInstr of                      (case InsnProps.instrKind lastInstr of
196                        Props.IK_JUMP => succ:=succBlks                         InsnProps.IK_JUMP =>
197                                          (Props.branchTargets lastInstr,[])                            succ := succBlocks
198                                 (InsnProps.branchTargets lastInstr,[])
199                        | _  =>                        | _  =>
200                          if lastCodeBlock blks then                         if isLastCodeBlock rest then
201                            succ := [(exitBlk,ref 0)]                            succ := [(exitBlk,ref 0)]
202                                      (* control must escape via trap *)                                    (* control must escape via trap! *)
203                          else succ := [(nextCodeBlock blks,ref 0)]                         else succ := [(nextCodeBlock rest, ref 0)]
204                      )                      )
205                  | [] => succ := [(nextCodeBlock blks,ref 0)]                    | [] => succ := [(nextCodeBlock rest, ref 0)]
206                  (*esac*);                    ;
207                  app updtPred (!succ);                    app (addPred blk) (!succ);
208                  graphEdges(blks)                    insertGraphEdges rest
209                end                end
210               | graphEdges(_::blks) = graphEdges(blks)              | insertGraphEdges(_::rest) = insertGraphEdges rest
211              | graphEdges [] = ()  
212              (* And entry edges *)
213            fun mkEntryBlock () = let            fun insertEntryEdges() =
214              val blocks =            let val newEntryEdges =
215                   map (fn Label.Label{id,...} => (lookupLabTbl id,ref 0))                    map (fn Label.Label{id, ...} => (lookupLabelMap id,ref 0))
216                         (!entryLabels)                         (!entryLabels)
217              val entryBlk = F.ENTRY{blknum=nextBlkNum(), freq=ref 1,            in  entryEdges := newEntryEdges @ !entryEdges;
218                                     succ=ref blocks}                app (addPred entryBlk) newEntryEdges
           in  
             app (fn (F.BBLOCK{pred, ...},w) =>  
                   pred := (entryBlk,w)::(!pred)) blocks;  
             entryBlk  
219            end            end
220    
           val _ = case !currBlock  
             of blk as F.BBLOCK _ => blockList := blk :: !blockList  
              | _ => ()  
221    
222            val blocks = rev(!blockList)            val _         = endCurrBlock()
223            val _ = blockList := []            val allBlocks = rev(!blocks)
224    
225                 (* clean up *)
226              val _         = blocks := []
227            val _ = blockNames := []            val _ = blockNames := []
228            val _ = fillLabTbl(blocks)  
229            val _ = graphEdges(blocks)               (* fill in edges *)
230              val _ = fillLabelMap(allBlocks, [])
231              val _ = insertGraphEdges(allBlocks)
232              val _ = insertEntryEdges()
233    
234                 (* create a new cluster *)
235            val cluster =            val cluster =
236             F.CLUSTER{blocks=blocks, entry=mkEntryBlock(), exit=exitBlk,                F.CLUSTER{blocks=allBlocks, entry=entryBlk, exit=exitBlk,
237                       blkCounter=ref(!bblkCnt), regmap= Option.valOf(!regmap),                          blkCounter=ref(!blkCounter), regmap= !regmap,
238                       annotations=ref(annotations)}                          annotations=ref(blockAnnotations @ annotations)}
239            val _ = regmap := NONE  
240            val _ = aliasF := can'tUse               (* reset regmap *)
241          in  output cluster            val _         = blkCounter := 0
242          end            val _         = regmap := C.regmap()
243              val _         = aliasF := Intmap.add (!regmap)
244        fun beginCluster _ =            val _         = entryLabels := []
245        let val map = C.regmap()        in  compile cluster
       in  entryLabels := [];  
           bblkCnt := 0;  
           blockList := [];  
           blockNames := [];  
           currBlock := NOBLOCK;  
           regmap := SOME map;  
           aliasF := Intmap.add map;  
           map  
246        end        end
247    
       fun comment msg = annotation(#create BasicAnnotations.COMMENT msg)  
       fun alias(v,r) = !aliasF(v,r)  
   
248     in S.STREAM     in S.STREAM
249        { beginCluster= beginCluster,        { beginCluster= beginCluster,
250          endCluster  = endCluster,          endCluster  = endCluster,
251          emit        = emitInstr,           emit         = emit,
252          defineLabel = defineLabel,          defineLabel = defineLabel,
253          entryLabel  = entryLabel,          entryLabel  = entryLabel,
254          pseudoOp    = pseudoOp,          pseudoOp    = pseudoOp,
# Line 259  Line 261 
261     end     end
262    
263  end  end
   

Legend:
Removed from v.497  
changed lines
  Added in v.498

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