File: getreg2.sml

package info (click to toggle)
mlton 20210117%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 58,464 kB
  • sloc: ansic: 27,682; sh: 4,455; asm: 3,569; lisp: 2,879; makefile: 2,347; perl: 1,169; python: 191; pascal: 68; javascript: 7
file content (47 lines) | stat: -rw-r--r-- 1,308 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
(* getreg2.sml
 *
 * COPYRIGHT (c) 1996 Bell Laboratories.
 *
 *)

(** A simple first come/first serve register allocator **)
functor GetReg2(val first : int  (* start from ``first'' *)
                val nRegs : int  (* n registers *)
	        val available : int list) : GETREG =
struct
  exception GetReg
  val size = first+nRegs
  val allRegs = Array.array(size,false)
  val preferred = Array.array(size,~1)

  fun reset () = Array.modify(fn _ => ~1) preferred

  val _ = app (fn r => Array.update(allRegs,r,true)) available

  fun getreg{pref,stamp:int,proh} = 
  let (* use preferred registers whenever possible *)
      fun checkPreferred [] = find(first)
        | checkPreferred(r::rs) = 
           if Array.sub(proh,r) <> stamp andalso 
              Array.sub(allRegs,r) then r 
           else checkPreferred rs

      and find(start) =
          let val limit = Array.length allRegs
              fun search r = 
              if Array.sub(proh,r) <> stamp andalso
                 Array.sub(allRegs,r) then r 
              else let val r = r+1
                   in  if r >= limit then raise GetReg else search r
                   end
          in  search start
          end
  in  checkPreferred pref end

  fun getpair{pref,stamp:int,proh} = raise GetReg (* unimplemented *)

end