1 ! Copyright (C) 2004, 2005 Mackenzie Straight
2 ! Copyright (C) 2007, 2009 Slava Pestov
3 ! Copyright (C) 2007, 2008 Doug Coleman
4 ! See http://factorcode.org/license.txt for BSD license.
5 USING: alien assocs continuations alien.destructors kernel
6 namespaces accessors sets summary destructors destructors.private ;
10 "int" "factor" "err_no" { } alien-invoke ;
13 "void" "factor" "clear_err_no" { } alien-invoke ;
17 : (malloc) ( size -- alien )
18 "void*" "libc" "malloc" { "ulong" } alien-invoke ;
20 : (calloc) ( count size -- alien )
21 "void*" "libc" "calloc" { "ulong" "ulong" } alien-invoke ;
24 "void" "libc" "free" { "void*" } alien-invoke ;
26 : (realloc) ( alien size -- newalien )
27 "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
29 ! We stick malloc-ptr instances in the global disposables set
30 TUPLE: malloc-ptr value continuation ;
32 M: malloc-ptr hashcode* value>> hashcode* ;
35 over malloc-ptr? [ [ value>> ] bi@ = ] [ 2drop f ] if ;
37 : <malloc-ptr> ( value -- malloc-ptr )
38 malloc-ptr new swap >>value ;
45 drop "Memory allocation failed" ;
47 : check-ptr ( c-ptr -- c-ptr )
50 ERROR: realloc-error ptr size ;
52 M: realloc-error summary
53 drop "Memory reallocation failed" ;
57 : add-malloc ( alien -- alien )
58 dup <malloc-ptr> register-disposable ;
60 : delete-malloc ( alien -- )
61 [ <malloc-ptr> unregister-disposable ] when* ;
63 : malloc-exists? ( alien -- ? )
64 <malloc-ptr> disposables get key? ;
68 : malloc ( size -- alien )
69 (malloc) check-ptr add-malloc ;
71 : calloc ( count size -- alien )
72 (calloc) check-ptr add-malloc ;
74 : realloc ( alien size -- newalien )
76 over malloc-exists? [ realloc-error ] unless
77 [ drop ] [ (realloc) check-ptr ] 2bi
78 [ delete-malloc ] [ add-malloc ] bi* ;
81 >c-ptr [ delete-malloc ] [ (free) ] bi ;
83 : memcpy ( dst src size -- )
84 "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
86 : memcmp ( a b size -- cmp )
87 "int" "libc" "memcmp" { "void*" "void*" "ulong" } alien-invoke ;
89 : memory= ( a b size -- ? )
92 : strlen ( alien -- len )
93 "size_t" "libc" "strlen" { "char*" } alien-invoke ;