steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up stack shuffling in libc

db4
Slava Pestov 2009-01-17 20:10:56 -06:00
parent 9a69ee2f0a
commit abd4a82f9f
1 changed files with 8 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
basis/libc/libc.factor
View File

@ -52,13 +52,13 @@ M: realloc-error summary
<PRIVATE <PRIVATE
: add-malloc ( alien -- ) : add-malloc ( alien -- alien )
mallocs conjoin ; dup mallocs conjoin ;
: delete-malloc ( alien -- ) : delete-malloc ( alien -- )
[ [
mallocs delete-at* mallocs delete-at*
[ double-free ] unless drop [ drop ] [ double-free ] if
] when* ; ] when* ;
: malloc-exists? ( alien -- ? ) : malloc-exists? ( alien -- ? )
@ -67,22 +67,18 @@ M: realloc-error summary
PRIVATE> PRIVATE>
: malloc ( size -- alien ) : malloc ( size -- alien )
(malloc) check-ptr (malloc) check-ptr add-malloc ;
dup add-malloc ;
: calloc ( count size -- alien ) : calloc ( count size -- alien )
(calloc) check-ptr (calloc) check-ptr add-malloc ;
dup add-malloc ;
: realloc ( alien size -- newalien ) : realloc ( alien size -- newalien )
over malloc-exists? [ realloc-error ] unless over malloc-exists? [ realloc-error ] unless
dupd (realloc) check-ptr [ drop ] [ (realloc) check-ptr ] 2bi
swap delete-malloc [ delete-malloc ] [ add-malloc ] bi* ;
dup add-malloc ;
: free ( alien -- ) : free ( alien -- )
dup delete-malloc [ delete-malloc ] [ (free) ] bi ;
(free) ;
: memcpy ( dst src size -- ) : memcpy ( dst src size -- )
"void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ; "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;