1 ! Copyright (C) 2004, 2005 Mackenzie Straight
2 ! Copyright (C) 2007, 2008 Slava Pestov
3 ! Copyright (C) 2007, 2008 Doug Coleman
4 ! See http://factorcode.org/license.txt for BSD license.
5 USING: alien assocs continuations destructors kernel
6 namespaces accessors sets summary ;
11 : (malloc) ( size -- alien )
12 "void*" "libc" "malloc" { "ulong" } alien-invoke ;
14 : (calloc) ( count size -- alien )
15 "void*" "libc" "calloc" { "ulong" "ulong" } alien-invoke ;
18 "void" "libc" "free" { "void*" } alien-invoke ;
20 : (realloc) ( alien size -- newalien )
21 "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
25 : mallocs ( -- assoc )
26 malloc-expiry get-global expired? [
27 -1 <alien> malloc-expiry set-global
28 H{ } clone dup \ mallocs set-global
38 drop "Memory allocation failed" ;
40 : check-ptr ( c-ptr -- c-ptr )
45 M: double-free summary
46 drop "Free failed since memory is not allocated" ;
48 ERROR: realloc-error ptr size ;
50 M: realloc-error summary
51 drop "Memory reallocation failed" ;
55 : add-malloc ( alien -- )
58 : delete-malloc ( alien -- )
61 [ double-free ] unless drop
64 : malloc-exists? ( alien -- ? )
69 : malloc ( size -- alien )
73 : calloc ( count size -- alien )
77 : realloc ( alien size -- newalien )
78 over malloc-exists? [ realloc-error ] unless
79 dupd (realloc) check-ptr
87 : memcpy ( dst src size -- )
88 "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
90 : strlen ( alien -- len )
91 "size_t" "libc" "strlen" { "char*" } alien-invoke ;
96 TUPLE: memory-destructor alien disposed ;
98 M: memory-destructor dispose* alien>> free ;
102 : &free ( alien -- alien )
103 dup f memory-destructor boa &dispose drop ; inline
105 : |free ( alien -- alien )
106 dup f memory-destructor boa |dispose drop ; inline