libc: use central disposables mechanism to track mallocs
parent
197a64eaae
commit
3be328056d
|
@ -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
|
||||||
|
|
|
@ -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>
|
||||||
|
|
||||||
|
|
|
@ -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? [
|
||||||
|
|
Loading…
Reference in New Issue