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

SCM Repository

[smlnj] Annotation of /MLRISC/trunk/instructions/shuffle.sml
ViewVC logotype

Annotation of /MLRISC/trunk/instructions/shuffle.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 889 - (view) (download)
Original Path: sml/trunk/src/MLRISC/instructions/shuffle.sml

1 : monnier 247 (* shuffle.sml -- implements the parallel copy instruction as a sequence
2 : monnier 411 * of moves.
3 : monnier 247 *
4 :     * COPYRIGHT (c) 1996 Bell Laboratories.
5 :     *
6 :     *)
7 :    
8 :    
9 :     functor Shuffle(I : INSTRUCTIONS) :
10 :     sig
11 :     val shuffle :
12 :     {mvInstr : {dst:I.ea, src:I.ea} -> I.instruction list,
13 : george 889 ea : CellsBasis.cell -> I.ea}
14 : monnier 247 ->
15 : leunga 744 {tmp : I.ea option,
16 : george 889 dst : CellsBasis.cell list,
17 :     src : CellsBasis.cell list}
18 : monnier 247 -> I.instruction list
19 :     end =
20 :     struct
21 : leunga 744 structure C = I.C
22 : monnier 247
23 : george 889 datatype obj = TEMP | CELL of CellsBasis.cell
24 : leunga 744
25 : george 889 fun equal (r1, r2) = CellsBasis.sameColor(r1,r2)
26 : leunga 744
27 :     fun equalObj (TEMP, TEMP) = true
28 :     | equalObj (CELL u, CELL v) = equal(u, v)
29 :     | equalObj _ = false
30 :    
31 :     fun shuffle{mvInstr, ea} {tmp, dst, src} = let
32 : leunga 579 fun mv{dst, src, instrs} = List.revAppend(mvInstr{dst=dst,src=src}, instrs)
33 : leunga 744
34 : leunga 641 fun valOf(SOME x) = x
35 :     | valOf NONE = raise Option
36 : monnier 247
37 : leunga 744 fun opnd dst = case dst of
38 :     TEMP => valOf tmp
39 :     | CELL dst => ea dst
40 :    
41 : monnier 247 (* perform unconstrained moves *)
42 :     fun loop((p as (rd,rs))::rest, changed, used, done, instrs) =
43 : leunga 744 if List.exists (fn r => equalObj(r, rd)) used then
44 : monnier 247 loop(rest, changed, used, p::done, instrs)
45 : monnier 411 else loop(rest, true, used, done,
46 : leunga 579 mv{dst=opnd rd, src=opnd rs, instrs=instrs})
47 : monnier 247 | loop([], changed, _, done, instrs) = (changed, done, instrs)
48 :    
49 :     fun cycle([], instrs) = instrs
50 :     | cycle(moves, instrs) =
51 :     (case loop(moves, false, map #2 moves, [], instrs)
52 :     of (_, [], instrs) => instrs
53 :     | (true, acc, instrs) => cycle(acc, instrs)
54 :     | (false, (rd,rs)::acc, instrs) => let
55 : leunga 744 fun rename(p as (a,b)) =
56 :     if equalObj(rd, b) then (a, TEMP) else p
57 : monnier 247 val acc' = (rd, rs) :: map rename acc
58 : leunga 641 val instrs' = mv{dst=valOf tmp,src=opnd rd,instrs=instrs}
59 : monnier 247 val (_, acc'', instrs'') =
60 :     loop(acc', false, map #2 acc', [], instrs')
61 :     in cycle(acc'', instrs'')
62 :     end
63 :     (*esac*))
64 :    
65 :     (* remove moves that have been coalesced. *)
66 : leunga 744 fun rmvCoalesced(rd::rds, rs::rss, mvs) =
67 :     if equal(rd, rs) then rmvCoalesced(rds, rss, mvs)
68 :     else rmvCoalesced(rds, rss, (CELL rd, CELL rs)::mvs)
69 : leunga 579 | rmvCoalesced([], [], mvs) = mvs
70 :     in rev (cycle (rmvCoalesced(dst, src, []), []))
71 : monnier 247 end
72 :     end
73 :    

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