\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
! 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 )
: (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>
: 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
<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>