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 /MLRISC/trunk/staged-allocation/staged-allocation-fn.sml
ViewVC logotype

Diff of /MLRISC/trunk/staged-allocation/staged-allocation-fn.sml

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

revision 2347, Tue Mar 6 22:21:29 2007 UTC revision 2348, Wed Mar 7 19:32:18 2007 UTC
# Line 1  Line 1 
1  (* staged-allocation-fn.sml  (* staged-allocation-fn.sml
2   *   *
3     * This code implements the Staged Allocation technique for calling conventions.
4     * You can find the POPL06 paper describing this technique at
5     * http://www.eecs.harvard.edu/~nr/pubs/staged-abstract.html
6   *   *
7   *)   *)
8    
# Line 45  Line 48 
48           | PAD of counter           | PAD of counter
49           | ALIGN_TO of (width -> width)           | ALIGN_TO of (width -> width)
50    
51    type stepper_fn = (str * slot) -> (str * location_info list)    type stepper_fn = (str * slot) -> (str * location_info)
52    
53    val memSize = 8    val memSize = 8
54    
# Line 92  Line 95 
95    
96    fun init cs = foldl (fn (c, str) => insStr (str, c, 0)) Str.empty cs    fun init cs = foldl (fn (c, str) => insStr (str, c, 0)) Str.empty cs
97    
98    fun allocate ([], str, ls) _ = (str, ls)    fun allocate ([], str, locs) _ = (str, locs)
99      | allocate (OVERFLOW {counter, blockDirection=UP, maxAlign} :: ss, str, ls)      | allocate (OVERFLOW {counter, blockDirection=UP, maxAlign} :: ss, str, locs)
100                 (w, k, al)                 (w, k, al)
101        =        =
102        if divides (maxAlign, al) andalso divides (w, memSize)        if (*divides (maxAlign, al) andalso*) divides (w, memSize)
103        then        then
104            let val n = findStr (str, counter)            let val n = findStr (str, counter)
105            in            in
106                (insStr (str, counter, n + toMemSize w), (w, BLOCK_OFFSET n, k)  :: ls)                (insStr (str, counter, n + toMemSize w), (w, BLOCK_OFFSET n, k) :: locs)
107            end            end
108        else raise StagedAlloc        else raise StagedAlloc
109      | allocate (OVERFLOW {counter, blockDirection=DOWN, maxAlign} :: ss, str, ls)      | allocate (OVERFLOW {counter, blockDirection=DOWN, maxAlign} :: ss, str, locs)
110                 (w, k, al)                 (w, k, al)
111        =        =
112        if divides (maxAlign, al) andalso divides (w, memSize)        if divides (maxAlign, al) andalso divides (w, memSize)
# Line 111  Line 114 
114            let val n = findStr (str, counter)            let val n = findStr (str, counter)
115                val n' = n + toMemSize w                val n' = n + toMemSize w
116            in            in
117                (insStr (str, counter, n'), (w, BLOCK_OFFSET (~n'), k) :: ls)                (insStr (str, counter, n'), (w, BLOCK_OFFSET (~n'), k) :: locs)
118            end            end
119        else raise StagedAlloc        else raise StagedAlloc
120      | allocate (WIDEN f :: ss, str, ls) (w, k, al) =      | allocate (WIDEN f :: ss, str, locs) (w, k, al) =
121        if w <= (f w) then        if w <= (f w) then
122            let val (str', (_, l, _) :: ls') = allocate (ss, str, ls) (f w, k, al)            let val (str', (_, l, _) :: _) = allocate (ss, str, locs) (f w, k, al)
123                val l' = NARROW (l, w, k)                val l' = NARROW (l, w, k)
124            in            in
125                (str', (w, l', k) :: ls)                (str', (w, l', k) :: locs)
126            end            end
127        else allocate (ss, str, ls) (f w, k, al)        else allocate (ss, str, locs) (f w, k, al)
128      | allocate (CHOICE cs :: ss, str, ls) (w, k, al) =      | allocate (CHOICE cs :: ss, str, locs) (w, k, al) =
129        let fun choose [] = raise StagedAlloc        let fun choose [] = raise StagedAlloc
130              | choose ((p, c) :: cs) =              | choose ((p, c) :: cs) =
131                if (p (w, k, al)) then c else choose cs                if (p (w, k, al)) then c else choose cs
132            val c = choose cs            val c = choose cs
133        in        in
134            allocate (c :: ss, str, ls) (w, k, al)            allocate (c :: ss, str, locs) (w, k, al)
135        end        end
136      | allocate (REGS_BY_ARGS (c, rs) :: ss, str, ls) (w, k, al) =      | allocate (REGS_BY_ARGS (c, rs) :: ss, str, locs) (w, k, al) =
137        let val n = findStr (str, c)        let val n = findStr (str, c)
138            val rs' = drop (n, rs)            val rs' = drop (n, rs)
139        in        in
140            (case rs'            (case rs'
141              of [] => allocate (ss, str, ls) (w, k, al)              of [] => allocate (ss, str, locs) (w, k, al)
142               | r :: _ => if (regWidth r) = w               | r :: _ => if (regWidth r) = w
143                         then (str, (w, REG r, k) :: ls)                         then (str, (w, REG r, k) :: locs)
144                         else raise StagedAlloc                         else raise StagedAlloc
145            (* esac *))            (* esac *))
146        end        end
147      | allocate (REGS_BY_BITS (c, rs) :: ss, str, ls) (w, k, al) =      | allocate (REGS_BY_BITS (c, rs) :: ss, str, locs) (w, k, al) =
148        let val n = findStr (str, c)        let val n = findStr (str, c)
149            val rs' = dropBits (n, rs)            val rs' = dropBits (n, rs)
150        in        in
151            (case rs'            (case rs'
152              of [] => (* insufficient bits *)              of [] => (* insufficient bits *)
153                 allocate (ss, str, ls) (w, k, al)                 allocate (ss, str, locs) (w, k, al)
154               | r :: _ =>               | r :: _ =>
155                 if ((regWidth r) = w)                 if ((regWidth r) = w)
156                 then (* the arg fits into the regs *)                 then (* the arg fits into the regs *)
157                     (str, (w, REG r, k) :: ls)                     (str, (w, REG r, k) :: locs)
158                 else (* some of the arg's bits fit into the regs *)                 else (* some of the arg's bits fit into the regs *)
159                     let val lWidth = regWidth r                     let val lWidth = regWidth r
160                         val str' = insStr (str, c, n + lWidth)                         val str' = insStr (str, c, n + lWidth)
161                         val l = REG r                         val l = REG r
162                         val (str', (_, l', _) :: ls) =                         val (str', (_, l', _) :: _) =
163                             allocate (REGS_BY_BITS (c, rs) :: ss, str', ls)                             allocate (REGS_BY_BITS (c, rs) :: ss, str', locs)
164                                      (w - lWidth, k, al)                                      (w - lWidth, k, al)
165                         val l'' = COMBINE (l, l')                         val l'' = COMBINE (l, l')
166                         val n' = findStr (str', c)                         val n' = findStr (str', c)
167                     in                     in
168                         (insStr (str', c, n' - lWidth), (w, l'', k) :: ls)                         (insStr (str', c, n' - lWidth), (w, l'', k) :: locs)
169                     end                     end
170            (* esac *))            (* esac *))
171        end        end
172      | allocate (SEQ ss' :: ss, str, ls) (w, k, al) =      | allocate (SEQ ss' :: ss, str, locs) (w, k, al) =
173        allocate (ss' @ ss, str, ls) (w, k, al)        allocate (ss' @ ss, str, locs) (w, k, al)
174      | allocate (BITCOUNTER c :: ss, str, ls) (w, k, al) =      | allocate (BITCOUNTER c :: ss, str, locs) (w, k, al) =
175        let val (str', ls') = allocate (ss, str, ls) (w, k, al)        let val (str', locs') = allocate (ss, str, locs) (w, k, al)
176            val n = findStr (str', c)            val n = findStr (str', c)
177        in        in
178            (insStr (str', c, n + w), ls')            (insStr (str', c, n + w), locs')
179        end        end
180      | allocate (PAD c :: ss, str, ls) (w, k, al) =      | allocate (PAD c :: ss, str, locs) (w, k, al) =
181        let val n = findStr (str, c)        let val n = findStr (str, c)
182            val n' = roundUp (n, al * memSize)            val n' = roundUp (n, al * memSize)
183        in        in
184            (insStr (str, c, n'), ls)            (insStr (str, c, n'), locs)
185        end        end
186      | allocate (ALIGN_TO f :: ss, str, ls) (w, k, al) =      | allocate (ALIGN_TO f :: ss, str, locs) (w, k, al) =
187        allocate (ss, str, ls) (w, k, f w)        allocate (ss, str, locs) (w, k, f w)
188      | allocate (ARGCOUNTER c :: ss, str, ls) (w, k, al) =      | allocate (ARGCOUNTER c :: ss, str, locs) (w, k, al) =
189        let val (str', ls') = allocate (ss, str, ls) (w, k, al)        let val (str', locs') = allocate (ss, str, locs) (w, k, al)
190            val n = findStr (str', c)            val n = findStr (str', c)
191        in        in
192            (insStr (str, c, n + 1), ls')            (insStr (str', c, n + 1), locs')
193        end (* allocate *)        end (* allocate *)
194    
195      (* staging returns only a single location at present *)
196    fun mkStep stages (str, slot) =    fun mkStep stages (str, slot) =
197        let val (str, ls) = allocate (stages, str, []) slot        (case allocate (stages, str, []) slot
198        in          of (str, [l]) => (str, l)
199            (str, rev ls)           | _ => raise StagedAlloc
200        end (* mkStep *)        (* esac *))
201    
202    fun process {counters, stages} slots =    fun process {counters, stages} slots = raise Fail ""
203        let val str0 = init counters  (*      let val str0 = init counters
204            val step = mkStep stages            val step = mkStep stages
205            fun processSlot (slot, (str, lss)) =            fun processSlot (slot, (str, lss)) =
206                let val (str, ls) = step (str, slot)                let val (str, ls) = step (str, slot)
# Line 207  Line 211 
211        in        in
212            resetCounter ();            resetCounter ();
213            rev lss            rev lss
214        end (* process *)        end (* process *) *)
215    
216  end (* StagedAllocationFn *)  end (* StagedAllocationFn *)

Legend:
Removed from v.2347  
changed lines
  Added in v.2348

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