1 ! Copyright (C) 2004, 2005 Mackenzie Straight
2 ! Copyright (C) 2007, 2010 Slava Pestov
3 ! Copyright (C) 2007, 2008 Doug Coleman
4 ! See http://factorcode.org/license.txt for BSD license.
5 USING: accessors alien alien.c-types alien.destructors alien.syntax assocs
6 combinators continuations destructors destructors.private kernel math
7 namespaces prettyprint sequences sets summary system vocabs vocabs.parser ;
10 HOOK: strerror os ( errno -- str )
12 ! For libc.linux, libc.windows, libc.macosx...
13 << "libc." os unparse append require >>
20 FUNCTION-ALIAS: set-errno
21 void set_err_no ( int err-no ) ;
26 : preserve-errno ( quot -- )
27 errno [ call ] dip set-errno ; inline
31 FUNCTION-ALIAS: (malloc)
32 void* malloc ( size_t size ) ;
34 FUNCTION-ALIAS: (calloc)
35 void* calloc ( size_t count, size_t size ) ;
37 FUNCTION-ALIAS: (free)
38 void free ( void* alien ) ;
40 FUNCTION-ALIAS: (realloc)
41 void* realloc ( void* alien, size_t size ) ;
43 FUNCTION-ALIAS: strerror_unsafe
44 char* strerror ( int errno ) ;
46 ! Add a default strerror even though it's not threadsafe
47 M: object strerror strerror_unsafe ;
49 FUNCTION: int strerror_r ( int errno, char* buf, size_t buflen ) ;
51 ERROR: libc-error errno message ;
53 : (io-error) ( -- * ) errno dup strerror libc-error ;
55 : io-error ( n -- ) 0 < [ (io-error) ] when ;
59 ! We stick malloc-ptr instances in the global disposables set
60 TUPLE: malloc-ptr value continuation ;
62 M: malloc-ptr hashcode* value>> hashcode* ;
65 over malloc-ptr? [ [ value>> ] same? ] [ 2drop f ] if ;
67 : <malloc-ptr> ( value -- malloc-ptr )
68 malloc-ptr new swap >>value ;
75 drop "Memory allocation failed" ;
77 : check-ptr ( c-ptr -- c-ptr )
80 ERROR: realloc-error ptr size ;
82 M: realloc-error summary
83 drop "Memory reallocation failed" ;
87 : add-malloc ( alien -- alien )
88 dup <malloc-ptr> register-disposable ;
90 : delete-malloc ( alien -- )
91 [ <malloc-ptr> unregister-disposable ] when* ;
93 : malloc-exists? ( alien -- ? )
94 <malloc-ptr> disposables get in? ;
98 : malloc ( size -- alien )
99 (malloc) check-ptr add-malloc ;
101 : calloc ( count size -- alien )
102 (calloc) check-ptr add-malloc ;
104 : realloc ( alien size -- newalien )
106 over malloc-exists? [ realloc-error ] unless
107 [ drop ] [ (realloc) check-ptr ] 2bi
108 [ delete-malloc ] [ add-malloc ] bi* ;
111 >c-ptr [ delete-malloc ] [ (free) ] bi ;
113 FUNCTION: void memset ( void* buf, int char, size_t size ) ;
115 FUNCTION: void memcpy ( void* dst, void* src, ulong size ) ;
117 FUNCTION: int memcmp ( void* a, void* b, ulong size ) ;
119 : memory= ( a b size -- ? ) memcmp 0 = ; inline
121 FUNCTION: size_t strlen ( c-string alien ) ;
123 FUNCTION: int system ( c-string command ) ;
128 ! For strerror on Unix all platforms
129 << os windows? [ "libc.unix" require ] unless >>