[MLton-commit] r5265

[Vesa Karvonen]

Using union PtrIntObj in the PtrIntObj of PtrCache.  This saves a cons per
unused object.

----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/misc-util/unstable/mk-int-obj-cache.fun
U   mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache.sml

----------------------------------------------------------------------

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/mk-int-obj-cache.fun
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/mk-int-obj-cache.fun	2007-02-19 14:43:54 UTC (rev 5264)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/mk-int-obj-cache.fun	2007-02-19 16:47:48 UTC (rev 5265)
@@ -40,7 +40,7 @@
         ; update c (n, SOME {key = k, value = v})
         ; (k, v)
        end)
-      handle e => (Key.set k ~1 ; Key.discard k ; raise e)
+      handle e => (Key.discard k ; raise e)
    end
 
    fun put c = #1 o putWith c o const
@@ -59,11 +59,8 @@
       val r = sub c n
    in
       if i<0 orelse n<i orelse #key (sub c i) <> k then raise NotFound else ()
-    ; Key.set k ~1 ; Key.discard k
-    ; update c (i, SOME r)
-    ; Key.set (#key r) i
-    ; update c (n, NONE)
-    ; st#size c n
+    ; Key.discard k ; update c (i, SOME r) ; Key.set (#key r) i
+    ; update c (n, NONE) ; st#size c n
     ; if n*4 < cap c then realloc c (cap c div 2) else ()
    end
    fun use c k = get c k before rem c k

Modified: mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache.sml
===================================================================
--- mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache.sml	2007-02-19 14:43:54 UTC (rev 5264)
+++ mltonlib/trunk/com/ssh/misc-util/unstable/ptr-cache.sml	2007-02-19 16:47:48 UTC (rev 5265)
@@ -6,27 +6,44 @@
 
 local
    structure PtrIntObj = struct
+      (* XXX Simplify *)
       type t = C.voidptr
       local
          val nUsed = ref 0
          val nUnused = ref 0
-         val unused = ref []
+         val unused = ref C.Ptr.null'
+         fun value k = U_PtrIntObj.f_value' (C.Ptr.|*! k)
+         fun next k = U_PtrIntObj.f_next' (C.Ptr.|*! k)
+         fun pop () = let
+            val k = !unused
+         in
+            if C.Ptr.isNull' k
+            then NONE
+            else SOME k before (unused := C.Get.ptr' (next (!unused))
+                              ; nUnused -= 1)
+         end
       in
-         fun set k = C.Ptr.|*! (C.Ptr.cast' k) <\ C.Set.sint'
+         fun set k v = C.Set.sint' (value (C.Ptr.cast' k), v)
+         fun get k = C.Get.sint' (value (C.Ptr.cast' k))
          fun new v = let
-            val k = case List.pop unused of
-                       SOME k => (nUnused -= 1 ; k)
-                     | NONE => C.Ptr.inject' (C.Ptr.|&! (C.new' C.S.sint))
+            val k =
+                C.Ptr.inject'
+                   (case pop () of
+                       SOME k => k
+                     | NONE => C.Ptr.|&! (C.new' U_PtrIntObj.size))
          in
             nUsed += 1 ; set k v ; k
          end
-         fun discard k =
-             (List.push (unused, k) ; nUnused += 1 ; nUsed -= 1
-            ; while !nUsed < !nUnused do
-                 case List.pop unused of
-                    NONE => raise Fail "bug"
-                  | SOME k => (nUnused -= 1 ; C.free' k))
-         val get = C.Get.sint' o C.Ptr.|*! o C.Ptr.cast'
+         fun discard k = let
+            val k = C.Ptr.cast' k
+         in
+            C.Set.ptr' (next k, !unused) ; unused := k
+          ; nUnused += 1 ; nUsed -= 1
+          ; while !nUsed < !nUnused do
+               case pop () of
+                  NONE => raise Fail "bug"
+                | SOME k => C.free' k
+         end
       end
    end
 in