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 /sml/branches/primop-branch/src/MLRISC/ra/getreg.sml
ViewVC logotype

Annotation of /sml/branches/primop-branch/src/MLRISC/ra/getreg.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/ra/getreg.sml

1 : monnier 245 (* getreg.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     (** A simple round robin register allocator **)
8 :     signature GETREG =
9 :     sig
10 :     exception GetReg
11 :     val getreg : {pref:int list, proh:int list} -> int
12 :     val reset : unit -> unit
13 :     end
14 :    
15 :    
16 :     functor GetReg(val nRegs : int
17 :     val available : int list) : GETREG =
18 :     struct
19 :     exception GetReg
20 :     val allRegs = Array.array(nRegs,false)
21 :    
22 :     fun restore regs =
23 :     app(fn r => Array.update(allRegs,r,true)) regs
24 :    
25 :     fun prohibit regs =
26 :     app(fn r => Array.update(allRegs,r,false)) regs
27 :    
28 :     fun find n = let
29 :     fun search n = if Array.sub(allRegs,n) then n else search(n+1)
30 :     in
31 :     (if Array.sub(allRegs,n) then n else find (n+1))
32 :     handle _ => search 0
33 :     end
34 :    
35 :     val lastReg = ref 0
36 :    
37 :     fun reset () = lastReg:=0
38 :    
39 :     val _ = restore available
40 :    
41 :     fun checkPreferred [] = NONE
42 :     | checkPreferred(x::xs) =
43 :     if Array.sub(allRegs,x) then SOME x else checkPreferred xs
44 :    
45 :     fun getreg{pref,proh} = let
46 :     val _ = prohibit proh
47 :     in
48 :     case checkPreferred pref
49 :     of NONE => let
50 :     val found =
51 :     find(!lastReg) handle _ => (restore proh; raise GetReg)
52 :     in
53 :     found before (lastReg := (found+1)mod nRegs;
54 :     restore proh)
55 :     end
56 :     | SOME found => found before restore proh
57 :     end
58 :     end
59 :    
60 :    
61 :    
62 :    
63 :     (*
64 :     * $Log: getreg.sml,v $
65 :     * Revision 1.1.1.1 1998/04/08 18:39:02 george
66 :     * Version 110.5
67 :     *
68 :     *)

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