]> gitweb.factorcode.org Git - factor.git/commitdiff
libc: use central disposables mechanism to track mallocs
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 25 Aug 2009 01:21:03 +0000 (20:21 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 25 Aug 2009 01:21:03 +0000 (20:21 -0500)
basis/libc/libc-tests.factor
basis/libc/libc.factor
basis/tools/deploy/shaker/shaker.factor

index b00463127fd78f72d8bf653b6e76af0cd80fae4c..3dcebb5e7a416072303def4d803995f8d84f9c53 100644 (file)
@@ -4,8 +4,8 @@ destructors kernel ;
 \r
 100 malloc "block" set\r
 \r
-[ t ] [ "block" get mallocs key? ] unit-test\r
+[ t ] [ "block" get malloc-exists? ] unit-test\r
 \r
 [ ] [ [ "block" get &free drop ] with-destructors ] unit-test\r
 \r
-[ f ] [ "block" get mallocs key? ] unit-test\r
+[ f ] [ "block" get malloc-exists? ] unit-test\r
index 7a55b1547363f065d64a91048a5dbb776a154e6c..926a6c4ec4932cadc11d94964bcf89680abe9427 100644 (file)
@@ -3,7 +3,7 @@
 ! Copyright (C) 2007, 2008 Doug Coleman
 ! See http://factorcode.org/license.txt for BSD license.
 USING: alien assocs continuations alien.destructors kernel
-namespaces accessors sets summary ;
+namespaces accessors sets summary destructors destructors.private ;
 IN: libc
 
 : errno ( -- int )
@@ -26,8 +26,16 @@ IN: libc
 : (realloc) ( alien size -- newalien )
     "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
 
-: mallocs ( -- assoc )
-    \ mallocs [ H{ } clone ] initialize-alien ;
+! We stick malloc-ptr instances in the global disposables set
+TUPLE: malloc-ptr value continuation ;
+
+M: malloc-ptr hashcode* value>> hashcode* ;
+
+M: malloc-ptr equal?
+    over malloc-ptr? [ [ value>> ] bi@ = ] [ 2drop f ] if ;
+
+: <malloc-ptr> ( value -- malloc-ptr )
+    malloc-ptr new swap >>value ;
 
 PRIVATE>
 
@@ -39,11 +47,6 @@ M: bad-ptr summary
 : check-ptr ( c-ptr -- c-ptr )
     [ bad-ptr ] unless* ;
 
-ERROR: double-free ;
-
-M: double-free summary
-    drop "Free failed since memory is not allocated" ;
-
 ERROR: realloc-error ptr size ;
 
 M: realloc-error summary
@@ -52,16 +55,13 @@ M: realloc-error summary
 <PRIVATE
 
 : add-malloc ( alien -- alien )
-    dup mallocs conjoin ;
+    dup <malloc-ptr> register-disposable ;
 
 : delete-malloc ( alien -- )
-    [
-        mallocs delete-at*
-        [ drop ] [ double-free ] if
-    ] when* ;
+    [ <malloc-ptr> unregister-disposable ] when* ;
 
 : malloc-exists? ( alien -- ? )
-    mallocs key? ;
+    <malloc-ptr> disposables get key? ;
 
 PRIVATE>
 
index c587f842ca268d26429e88407af78cd8f86d8fd7..b24981ed8866d1d34e3a08d686a68007dfbf4424 100755 (executable)
@@ -284,8 +284,6 @@ IN: tools.deploy.shaker
 
         "io-thread" "io.thread" lookup ,
 
-        "mallocs" "libc.private" lookup ,
-
         "disposables" "destructors" lookup ,
 
         deploy-threads? [