libc: use central disposables mechanism to track mallocs

db4
Slava Pestov 2009-08-24 20:21:03 -05:00
parent 197a64eaae
commit 3be328056d
3 changed files with 16 additions and 18 deletions

View File

@ -4,8 +4,8 @@ destructors kernel ;
100 malloc "block" set 100 malloc "block" set
[ t ] [ "block" get mallocs key? ] unit-test [ t ] [ "block" get malloc-exists? ] unit-test
[ ] [ [ "block" get &free drop ] with-destructors ] unit-test [ ] [ [ "block" get &free drop ] with-destructors ] unit-test
[ f ] [ "block" get mallocs key? ] unit-test [ f ] [ "block" get malloc-exists? ] unit-test

View File

@ -3,7 +3,7 @@
! Copyright (C) 2007, 2008 Doug Coleman ! Copyright (C) 2007, 2008 Doug Coleman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien assocs continuations alien.destructors kernel USING: alien assocs continuations alien.destructors kernel
namespaces accessors sets summary ; namespaces accessors sets summary destructors destructors.private ;
IN: libc IN: libc
: errno ( -- int ) : errno ( -- int )
@ -26,8 +26,16 @@ IN: libc
: (realloc) ( alien size -- newalien ) : (realloc) ( alien size -- newalien )
"void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ; "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
: mallocs ( -- assoc ) ! We stick malloc-ptr instances in the global disposables set
\ mallocs [ H{ } clone ] initialize-alien ; 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> PRIVATE>
@ -39,11 +47,6 @@ M: bad-ptr summary
: check-ptr ( c-ptr -- c-ptr ) : check-ptr ( c-ptr -- c-ptr )
[ bad-ptr ] unless* ; [ bad-ptr ] unless* ;
ERROR: double-free ;
M: double-free summary
drop "Free failed since memory is not allocated" ;
ERROR: realloc-error ptr size ; ERROR: realloc-error ptr size ;
M: realloc-error summary M: realloc-error summary
@ -52,16 +55,13 @@ M: realloc-error summary
<PRIVATE <PRIVATE
: add-malloc ( alien -- alien ) : add-malloc ( alien -- alien )
dup mallocs conjoin ; dup <malloc-ptr> register-disposable ;
: delete-malloc ( alien -- ) : delete-malloc ( alien -- )
[ [ <malloc-ptr> unregister-disposable ] when* ;
mallocs delete-at*
[ drop ] [ double-free ] if
] when* ;
: malloc-exists? ( alien -- ? ) : malloc-exists? ( alien -- ? )
mallocs key? ; <malloc-ptr> disposables get key? ;
PRIVATE> PRIVATE>

View File

@ -284,8 +284,6 @@ IN: tools.deploy.shaker
"io-thread" "io.thread" lookup , "io-thread" "io.thread" lookup ,
"mallocs" "libc.private" lookup ,
"disposables" "destructors" lookup , "disposables" "destructors" lookup ,
deploy-threads? [ deploy-threads? [