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 2126 - (view) (download)

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 :     fun opnd dst = case dst of
35 : george 1009 TEMP => Option.valOf tmp
36 : leunga 744 | CELL dst => ea dst
37 :    
38 : monnier 247 (* perform unconstrained moves *)
39 :     fun loop((p as (rd,rs))::rest, changed, used, done, instrs) =
40 : leunga 744 if List.exists (fn r => equalObj(r, rd)) used then
41 : monnier 247 loop(rest, changed, used, p::done, instrs)
42 : monnier 411 else loop(rest, true, used, done,
43 : leunga 579 mv{dst=opnd rd, src=opnd rs, instrs=instrs})
44 : monnier 247 | loop([], changed, _, done, instrs) = (changed, done, instrs)
45 :    
46 :     fun cycle([], instrs) = instrs
47 :     | cycle(moves, instrs) =
48 :     (case loop(moves, false, map #2 moves, [], instrs)
49 :     of (_, [], instrs) => instrs
50 :     | (true, acc, instrs) => cycle(acc, instrs)
51 :     | (false, (rd,rs)::acc, instrs) => let
52 : leunga 744 fun rename(p as (a,b)) =
53 :     if equalObj(rd, b) then (a, TEMP) else p
54 : monnier 247 val acc' = (rd, rs) :: map rename acc
55 : george 1009 val instrs' = mv{dst=Option.valOf tmp, src=opnd rd, instrs=instrs}
56 : monnier 247 val (_, acc'', instrs'') =
57 :     loop(acc', false, map #2 acc', [], instrs')
58 :     in cycle(acc'', instrs'')
59 :     end
60 :     (*esac*))
61 :    
62 :     (* remove moves that have been coalesced. *)
63 : mblume 1334 val rmvCoalesced =
64 :     ListPair.foldl (fn (rd, rs, mvs) =>
65 :     if equal (rd, rs) then mvs
66 :     else (CELL rd, CELL rs) :: mvs) []
67 :     in rev (cycle (rmvCoalesced(dst, src), []))
68 : monnier 247 end
69 :     end
70 :    

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