! Copyright (C) 2004, 2005 Mackenzie Straight
-! Copyright (C) 2007, 2009 Slava Pestov
+! Copyright (C) 2007, 2010 Slava Pestov
! Copyright (C) 2007, 2008 Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types assocs continuations alien.destructors kernel
-namespaces accessors sets summary destructors destructors.private ;
+USING: accessors alien alien.c-types alien.destructors
+alien.syntax destructors destructors.private kernel math
+namespaces sequences sets summary system vocabs ;
IN: libc
-: errno ( -- int )
- int "factor" "err_no" { } alien-invoke ;
+HOOK: strerror os ( errno -- str )
+
+LIBRARY: factor
+
+FUNCTION-ALIAS: errno
+ int err_no ( )
+
+FUNCTION-ALIAS: set-errno
+ void set_err_no ( int err-no )
: clear-errno ( -- )
- void "factor" "clear_err_no" { } alien-invoke ;
+ 0 set-errno ;
-<PRIVATE
+: preserve-errno ( quot -- )
+ errno [ call ] dip set-errno ; inline
+
+LIBRARY: libc
+
+FUNCTION-ALIAS: (malloc)
+ void* malloc ( size_t size )
+
+FUNCTION-ALIAS: (calloc)
+ void* calloc ( size_t count, size_t size )
+
+FUNCTION-ALIAS: (free)
+ void free ( void* alien )
+
+FUNCTION-ALIAS: (realloc)
+ void* realloc ( void* alien, size_t size )
-: (malloc) ( size -- alien )
- void* "libc" "malloc" { ulong } alien-invoke ;
+FUNCTION-ALIAS: strerror_unsafe
+ char* strerror ( int errno )
-: (calloc) ( count size -- alien )
- void* "libc" "calloc" { ulong ulong } alien-invoke ;
+! Add a default strerror even though it's not threadsafe
+M: object strerror strerror_unsafe ;
-: (free) ( alien -- )
- void "libc" "free" { void* } alien-invoke ;
+ERROR: libc-error errno message ;
-: (realloc) ( alien size -- newalien )
- void* "libc" "realloc" { void* ulong } alien-invoke ;
+: (throw-errno) ( errno -- * ) dup strerror libc-error ;
+
+: throw-errno ( -- * ) errno (throw-errno) ;
+
+: io-error ( n -- ) 0 < [ throw-errno ] when ;
+
+<PRIVATE
! 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 ;
+ over malloc-ptr? [ [ value>> ] same? ] [ 2drop f ] if ;
: <malloc-ptr> ( value -- malloc-ptr )
malloc-ptr new swap >>value ;
[ <malloc-ptr> unregister-disposable ] when* ;
: malloc-exists? ( alien -- ? )
- <malloc-ptr> disposables get key? ;
+ <malloc-ptr> disposables get in? ;
PRIVATE>
: free ( alien -- )
>c-ptr [ delete-malloc ] [ (free) ] bi ;
-: memcpy ( dst src size -- )
- void "libc" "memcpy" { void* void* ulong } alien-invoke ;
+FUNCTION: void memset ( void* buf, int char, size_t size )
-: memcmp ( a b size -- cmp )
- int "libc" "memcmp" { void* void* ulong } alien-invoke ;
+FUNCTION: void memcpy ( void* dst, void* src, ulong size )
-: memory= ( a b size -- ? )
- memcmp 0 = ;
+FUNCTION: void memmove ( void* dst, void* src, ulong size )
-: strlen ( alien -- len )
- size_t "libc" "strlen" { char* } alien-invoke ;
+FUNCTION: int memcmp ( void* a, void* b, ulong size )
+
+: memory= ( a b size -- ? ) memcmp 0 = ; inline
+
+FUNCTION: size_t strlen ( c-string alien )
+
+FUNCTION: int system ( c-string command )
DESTRUCTOR: free
+
+! For libc.linux, libc.windows, libc.macosx...
+<< "libc." os name>> append require >>