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

Diff of /sml/trunk/src/MLRISC/flowgraph/cfg.sml

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

revision 1155, Wed Mar 20 20:52:51 2002 UTC revision 1156, Thu Mar 21 22:01:11 2002 UTC
# Line 19  Line 19 
19      structure P = Asm.S.P      structure P = Asm.S.P
20      structure C = I.C      structure C = I.C
21      structure G = Graph      structure G = Graph
     structure A = Annotations  
22      structure S = Asm.S      structure S = Asm.S
23        structure A = Array
24        structure H = IntHashTable
25    
26      type weight = real      type weight = real
27    
# Line 100  Line 101 
101            end            end
102      fun insns(BLOCK{insns, ...}) = insns      fun insns(BLOCK{insns, ...}) = insns
103      fun freq(BLOCK{freq, ...}) = freq      fun freq(BLOCK{freq, ...}) = freq
104        fun edgeFreq(_,_,EDGE{w, ...}) = w
105        fun sumEdgeFreqs es = foldr (fn (e,w) => !(edgeFreq e) + w) 0.0 es
106    
107      fun newBlock'(id,kind,insns,freq) =      fun newBlock'(id,kind,insns,freq) =
108          BLOCK{ id          = id,          BLOCK{ id          = id,
# Line 269  Line 272 
272          jmp          jmp
273      end      end
274    
275    
276      exception Can'tMerge
277      exception NotFound
278    
279       fun labelOf(G.GRAPH cfg) node = defineLabel(#node_info cfg node)
280    
281       fun copyEdge(EDGE{a,w,k}) = EDGE{a=ref(!a),w=ref(!w),k=k}
282    
283       (*=====================================================================
284        *
285        *  Check whether block i must preceed block j in any linear layout.
286        *  This may be true if i falls through to j (transitively)
287        *
288        *=====================================================================*)
289       fun mustPreceed (G.GRAPH cfg) (i,j) =
290       let val visited = H.mkTable(23,NotFound)
291           fun chase [] = false
292             | chase((u,v,EDGE{k=(FALLSTHRU|BRANCH false),...})::_) =
293               if H.inDomain visited u then false
294               else u = i orelse (H.insert visited (u,true); chase(#in_edges cfg u))
295             | chase(_::es) = chase es
296       in  i = j orelse chase(#in_edges cfg j)
297       end
298    
299       (*=====================================================================
300        *
301        *  Predicates on nodes and edges
302        *
303        *=====================================================================*)
304       fun isMerge (G.GRAPH cfg) node = length(#in_edges cfg node) > 1
305       fun isSplit (G.GRAPH cfg) node = length(#out_edges cfg node) > 1
306    (*
307       fun hasSideExits (G.GRAPH cfg) node =
308             List.exists (fn (_,_,EDGE{k=SIDEEXIT _,...}) => true
309                           | _ => false) (#out_edges cfg node)
310    *)
311       fun hasSideExits _ _ = false
312       fun isCriticalEdge CFG (_,_,EDGE{k=ENTRY,...}) = false
313         | isCriticalEdge CFG (_,_,EDGE{k=EXIT,...}) = false
314         | isCriticalEdge CFG (i,j,_) = isSplit CFG i andalso isMerge CFG j
315    
316       (*=====================================================================
317        *
318        *  Update the label of the branch instruction in a certain block
319        *  to be consistent with the control flow edges.  This doesn't work
320        *  on hyperblocks!!!
321        *
322        *=====================================================================*)
323       fun updateJumpLabel(CFG as G.GRAPH cfg) =
324       let val labelOf = labelOf CFG
325           fun update node =
326           case #node_info cfg node of
327              BLOCK{insns=ref [],...} => ()
328           |  BLOCK{kind=START,...} => ()
329           |  BLOCK{kind=STOP,...} => ()
330           |  BLOCK{insns=insns as ref(jmp::rest),...} =>
331                 (case #out_edges cfg node of
332                    [] => ()
333                 |  [(_,_,EDGE{k=(ENTRY | EXIT),...})] => ()
334                 |  [(i,j,_)] =>
335                      if InsnProps.instrKind jmp = InsnProps.IK_JUMP then
336                           insns := InsnProps.setJumpTarget(jmp,labelOf j)::rest
337                      else ()
338                 |  [(_,i,EDGE{k=BRANCH x,...}),
339                     (_,j,EDGE{k=BRANCH y,...})] =>
340                      let val (no,yes) = if x then (j,i) else (i,j)
341                      in  insns :=
342                            InsnProps.setBranchTargets{i=jmp,
343                                    f=labelOf no,t=labelOf yes}::rest
344                      end
345                 |  es =>
346                      let fun gt ((_,_,EDGE{k=SWITCH i,...}),
347                                  (_,_,EDGE{k=SWITCH j,...})) = i > j
348                            | gt _ = error "gt"
349                          val es = ListMergeSort.sort gt es
350                          val labels = map (fn (_,j,_) => labelOf j) es
351                      in  error "updateJumpLabel"
352                      end
353                 )
354       in  update
355       end
356    
357       (*=====================================================================
358        *
359        *  Merge a control flow edge i -> j.
360        *  Raise Can't Merge if it is illegal.
361        *  After merging blocks i and j will become block i.
362        *
363        *=====================================================================*)
364       fun mergeEdge (CFG as G.GRAPH cfg) (i,j,e as EDGE{w,k,...}) =
365       let val _ = case k of
366                      (ENTRY | EXIT) => raise Can'tMerge
367                   |  _ => ()
368           val _ = case (#out_edges cfg i,#in_edges cfg j) of
369                      ([(_,j',_)],[(i',_,_)]) =>
370                         if j' <> j orelse i' <> i then raise Can'tMerge
371                         else ()
372                   |  _ => raise Can'tMerge
373           val _ = if mustPreceed CFG (i,j) then raise Can'tMerge else ()
374           val BLOCK{align=d2,insns=i2,annotations=a2,...} = #node_info cfg j
375           val _  = case !d2 of SOME _ => () | _ => raise Can'tMerge
376           val BLOCK{align=d1,insns=i1,annotations=a1,...} = #node_info cfg i
377              (* If both blocks have annotations then don't merge them.
378               * But instead, just try to removed the jump instruction instead.
379               *)
380           val canMerge = case (!a1, !a2) of
381                     (_::_, _::_) => false
382                   | _ => true
383           val insns1 = case !i1 of
384                          [] => []
385                        | insns as jmp::rest =>
386                            if InsnProps.instrKind jmp = InsnProps.IK_JUMP
387                            then rest else insns
388       in  if canMerge then
389            (i1 := !i2 @ insns1;
390             a1 := !a1 @ !a2;
391             #set_out_edges cfg
392               (i,map (fn (_,j',e) => (i,j',e)) (#out_edges cfg j));
393             #remove_node cfg j;
394             updateJumpLabel CFG i
395            )
396           else (* Just eliminate the jump instruction at the end *)
397             (i1 := insns1;
398              #set_out_edges cfg
399                (i,map (fn (i,j,EDGE{w,a,...}) =>
400                      (i,j,EDGE{k=FALLSTHRU,w=w,a=a}))
401                         (#out_edges cfg i))
402             );
403           true
404       end handle Can'tMerge => false
405    
406       (*=====================================================================
407        *
408        *  Eliminate the jump at the end of a basic block if feasible
409        *
410        *=====================================================================*)
411       fun eliminateJump (CFG as G.GRAPH cfg) i =
412           (case #out_edges cfg i of
413              [e as (i,j,EDGE{k,w,a})] =>
414                (case fallsThruFrom(CFG,j) of
415                    SOME _ => false
416                 |  NONE =>
417                    if mustPreceed CFG (j,i) then false
418                    else
419                    let val BLOCK{insns,...} = #node_info cfg i
420                        val BLOCK{align,...}  = #node_info cfg j
421                    in  case (!align,!insns) of
422                          (NONE,jmp::rest) =>
423                           if InsnProps.instrKind jmp = InsnProps.IK_JUMP then
424                            (insns := rest;
425                             removeEdge CFG e;
426                             #add_edge cfg (i,j,EDGE{k=FALLSTHRU,w=w,a=a});
427                             true
428                            )
429                           else false
430                        |  _ => false
431                    end
432                )
433           |  _ => false
434           )
435    
436       (*=====================================================================
437        *
438        *  Insert a jump at the end of a basic block if feasible
439        *
440        *=====================================================================*)
441       fun insertJump (CFG as G.GRAPH cfg) i =
442           (case #out_edges cfg i of
443               [e as (i,j,EDGE{k=FALLSTHRU,w,a,...})] =>
444                  let val BLOCK{insns,...} = #node_info cfg i
445                  in  insns := InsnProps.jump(labelOf CFG j) :: !insns;
446                      removeEdge CFG e;
447                      #add_edge cfg (i,j,EDGE{k=JUMP,w=w,a=a});
448                      true
449                  end
450            |  _ => false
451           )
452    
453    
454       (*=====================================================================
455        *
456        *  Split a group of control flow edge.
457        *
458        *=====================================================================*)
459       fun splitEdges (CFG as G.GRAPH cfg) {groups=[], jump} = []
460         | splitEdges (CFG as G.GRAPH cfg) {groups as ((first,_)::_), jump} =
461       let (* target of all the edges *)
462           val j = let val (_,j,_) = hd first in j end
463    
464           fun process([], freq, new) = new
465             | process((edges, insns)::groups, freq, new) =
466           let
467               val freq = sumEdgeFreqs edges + freq (* freq of new block *)
468    
469               (* should we place a jump in the new block? *)
470               fun scan([], jump) = jump
471                 | scan((u,v,_)::es, jump) =
472                   (if v <> j then error "splitEdge: bad edge" else ();
473                    scan(es, jump orelse u = v orelse
474                             (case fallsThruFrom(CFG, v) of
475                               NONE => false
476                             | SOME u' => u <> u'
477                             ))
478                   )
479    
480               val jump = scan(edges, jump)
481    
482               (* if it is not the last group then no jumps are needed *)
483               val jump = case groups of
484                            [] => jump
485                          | _ => false
486    
487               val insns = ref(if jump then InsnProps.jump(labelOf CFG j)::insns
488                                       else insns)
489               val k = #new_id cfg () (* new block id *)
490               val node_k =
491                   BLOCK{id=k, kind=NORMAL,
492                         freq= ref freq, align=ref NONE, labels = ref [],
493                         insns=insns, annotations=ref []}
494               val kind = if jump then JUMP else FALLSTHRU
495               val edgeinfo_k = EDGE{w=ref freq,a=ref [],k=kind}
496           in  app (removeEdge CFG) edges;
497               app (fn (i,_,e) => #add_edge cfg (i,k,e)) edges;
498               #add_node cfg (k,node_k);
499               process(groups, freq, (k, node_k, edgeinfo_k)::new)
500           end
501    
502           val new = process(groups, 0.0, [])
503    
504           (* Add the edges on the chain *)
505           fun postprocess([], j, new) = new
506             | postprocess((k, node_k, edgeinfo_k)::rest, j, new) =
507               let val edge = (k, j, edgeinfo_k)
508               in  #add_edge cfg edge;
509                   postprocess(rest, k, ((k,node_k),edge)::new)
510               end
511    
512           val new = postprocess(new, j, [])
513    
514       in  (* Update the labels on the groups *)
515           app (fn (es, _) => app (fn (i,_,_) => updateJumpLabel CFG i) es) groups;
516           new
517       end
518    
519       (*=====================================================================
520        *
521        *  Split all critical edges in the CFG
522        *
523        *=====================================================================*)
524       fun splitAllCriticalEdges (CFG as G.GRAPH cfg) =
525       let val hasChanged = ref false
526       in  #forall_edges cfg
527             (fn e => if isCriticalEdge CFG e then
528               (splitEdges CFG {groups=[([e],[])],jump=false};
529                hasChanged := true)
530                else ());
531           if !hasChanged then changed CFG else ()
532       end
533    
534       (*=====================================================================
535        *
536        *  Tail duplicate a region until there are no side entry edges
537        *  entering into the region.  Return the set of new edges and nodes
538        *
539        *=====================================================================*)
540       fun tailDuplicate (CFG as G.GRAPH cfg : cfg)
541                         {subgraph=G.GRAPH subgraph : cfg,root} =
542       let
543           val blockMap = H.mkTable(10,NotFound)
544           val _ = print("[root "^Int.toString root^"]\n")
545    
546           fun duplicate v =
547               H.lookup blockMap v handle NotFound =>
548               let val w  = #new_id cfg ()
549                   val w' = copyBlock(w,#node_info cfg v)
550               in  #add_node cfg (w,w');
551                   H.insert blockMap (v,(w,w'));
552                   app (#add_edge cfg)
553                       (map (fn (i,j,e) => (w,j,copyEdge e)) (#out_edges cfg v));
554                   updateJumpLabel CFG w;
555                   (w,w')
556               end
557    
558           fun process((n,_)::rest,ns,Ns,Es) =
559                process(rest,collect(#entry_edges subgraph n,ns),Ns,Es)
560             | process([],ns,Ns,Es) = dupl(ns,Ns,Es,false)
561    
562           and collect([],ns) = ns
563             | collect((i,_,_)::es,ns) = collect(es,if i = root then ns else i::ns)
564    
565           and dupl([],Ns,Es,changed) = (Ns,Es,changed)
566             | dupl(n::ns,Ns,Es,changed) =
567                  redirect(#out_edges cfg n,ns,Ns,Es,changed)
568    
569           and redirect([],ns,Ns,Es,changed) = dupl(ns,Ns,Es,changed)
570             | redirect((u,v,e)::es,ns,Ns,Es,changed) =
571                if v <> root andalso
572                   #has_edge cfg (u,v) andalso
573                   #has_node subgraph v andalso
574                   not(#has_edge subgraph (u,v)) then
575                   (*
576                    * u -> v is a side entry edge, duplicate v
577                    *)
578                let val _ = print("[tail duplicating "^Int.toString u^" -> "^
579                                  Int.toString v^"]\n")
580                    val (w,w') = duplicate v
581                in  removeEdge CFG (u,v,e);
582                    #add_edge cfg (u,w,e);
583                    updateJumpLabel CFG u;
584                    redirect(es,w::ns,(w,w')::Ns,(u,w,e)::Es,true)
585                end
586                else redirect(es,ns,Ns,Es,changed)
587    
588           fun iter(Ns,Es) =
589               let val (Ns,Es,hasChanged) = process(#nodes subgraph (),[],Ns,Es)
590               in  if hasChanged then (changed CFG; iter(Ns,Es))
591                   else {nodes=Ns,edges=Es}
592               end
593    
594       in  iter([],[])
595       end
596    
597    
598       (*=====================================================================
599        *
600        *  Remove unreachable code in the CFG
601        *
602        *=====================================================================*)
603       fun removeUnreachableCode(CFG as G.GRAPH cfg) =
604       let val N = #capacity cfg ()
605           val visited = A.array(N,false)
606           fun mark n = if A.sub(visited,n) then ()
607                        else (A.update(visited,n,true); app mark (#succ cfg n))
608           val hasChanged = ref false
609           fun remove(b,BLOCK{align,insns,...}) =
610               if A.sub(visited,b) then ()
611               else
612               (hasChanged :=true;
613                case #in_edges cfg b of
614                  [] => #remove_node cfg b
615                |  _  => (insns := []; #set_out_edges cfg (b,[]))
616               )
617       in  app mark (#entries cfg ());
618           #forall_nodes cfg remove;
619           if !hasChanged then changed CFG else ()
620       end
621    
622    
623       (*=====================================================================
624        *
625        *  Merge all edges in the CFG.
626        *  Merge higher frequency edges first
627        *
628        *=====================================================================*)
629       fun mergeAllEdges(CFG as G.GRAPH cfg) =
630       let val mergeEdge = mergeEdge CFG
631           fun higherFreq((_,_,EDGE{w=x,...}),(_,_,EDGE{w=y,...}))= !x < !y
632           fun mergeAll([],changed) = changed
633             | mergeAll(e::es,changed) = mergeAll(es,mergeEdge e orelse changed)
634           (* note: sort expects the gt operator and sorts in ascending order *)
635           val hasChanged = mergeAll(ListMergeSort.sort higherFreq (#edges cfg ()),
636                                     false)
637       in  if hasChanged then changed CFG else ()
638       end
639    
640     (*========================================================================     (*========================================================================
641      *      *
642      *  Miscellaneous      *  Miscellaneous

Legend:
Removed from v.1155  
changed lines
  Added in v.1156

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