alien tweaks

cvs
Slava Pestov 2005-09-03 18:48:25 +00:00
parent 8b842cc543
commit b0b5f4f79d
10 changed files with 23 additions and 20 deletions

View File

@ -6,10 +6,6 @@ namespaces parser ;
UNION: c-ptr byte-array alien displaced-alien ;
: NULL ( -- null )
#! C null value.
0 <alien> ;
M: alien hashcode ( obj -- n )
alien-address >fixnum ;

View File

@ -140,7 +140,7 @@ GENERIC: task-container ( task -- vector )
: init-fdsets ( -- read write except )
read-fdset get [ read-tasks get init-fdset ] keep
write-fdset get [ write-tasks get init-fdset ] keep
NULL ;
f ;
: io-multiplex ( timeout -- )
>r FD_SETSIZE init-fdsets r> make-timeval select drop

View File

@ -23,7 +23,7 @@ END-STRUCT
: make-timeval ( ms -- timeval )
dup -1 = [
drop NULL
drop f
] [
1000 /mod 1000 *
<timeval>

View File

@ -70,8 +70,8 @@ CONSTANT: WAIT_TIMEOUT 258 ;
: win32-error-message ( id -- string )
4096 <buffer> dup >r >r >r
FORMAT_MESSAGE_FROM_SYSTEM NULL r>
LANG_NEUTRAL SUBLANG_DEFAULT MAKELANGID r> buffer-ptr <alien> 4096 NULL
FORMAT_MESSAGE_FROM_SYSTEM f r>
LANG_NEUTRAL SUBLANG_DEFAULT MAKELANGID r> buffer-ptr <alien> 4096 f
FormatMessage r> 2dup buffer-reset nip dup buffer-contents
swap buffer-free ;

View File

@ -47,7 +47,7 @@ GENERIC: expire
GetLastError expected-error? [ drop f ] unless ;
: add-completion ( handle -- )
completion-port get NULL 1 CreateIoCompletionPort drop ;
completion-port get f 1 CreateIoCompletionPort drop ;
: get-access ( -- file-mode )
"file-mode" get uncons
@ -67,7 +67,7 @@ GENERIC: expire
: win32-open-file ( file r w -- handle )
[
cons "file-mode" set
get-access get-sharemode NULL get-create FILE_FLAG_OVERLAPPED NULL
get-access get-sharemode f get-create FILE_FLAG_OVERLAPPED f
CreateFile dup INVALID_HANDLE_VALUE = [ win32-throw-error ] when
dup add-completion
] with-scope ;
@ -125,7 +125,7 @@ C: io-callback ( -- callback )
rot [ queue-error ] unless ;
: win32-init-stdio ( -- )
INVALID_HANDLE_VALUE NULL NULL 1 CreateIoCompletionPort
INVALID_HANDLE_VALUE f f 1 CreateIoCompletionPort
completion-port set
<io-queue> io-queue set ;

View File

@ -46,7 +46,7 @@ SYMBOL: socket
] unless ;
: new-socket ( -- socket )
AF_INET SOCK_STREAM 0 NULL NULL WSA_FLAG_OVERLAPPED WSASocket ;
AF_INET SOCK_STREAM 0 f f WSA_FLAG_OVERLAPPED WSASocket ;
: setup-sockaddr ( port -- sockaddr )
<sockaddr-in> swap
@ -110,7 +110,7 @@ IN: io
[
stream get alloc-io-callback init-overlapped
>r >r >r socket get r> r>
buffer-ptr <alien> 0 32 32 NULL r> AcceptEx
buffer-ptr <alien> 0 32 32 f r> AcceptEx
[ handle-socket-error ] unless stop
] callcc1 pending-error drop
swap dup add-completion <win32-stream> <line-reader>

View File

@ -49,7 +49,7 @@ SYMBOL: cutoff
0 over set-overlapped-ext-internal-high
fileptr get dup 0 ? over set-overlapped-ext-offset
0 over set-overlapped-ext-offset-high
NULL over set-overlapped-ext-event ;
f over set-overlapped-ext-event ;
: update-file-pointer ( whence -- )
file-size get [ fileptr [ + ] change ] [ drop ] ifte ;
@ -61,7 +61,7 @@ SYMBOL: cutoff
update-timeout [
stream get alloc-io-callback init-overlapped >r
handle get out-buffer get [ buffer@ ] keep buffer-length
NULL r> WriteFile [ handle-io-error ] unless stop
f r> WriteFile [ handle-io-error ] unless stop
] callcc1 pending-error
dup update-file-pointer
@ -89,7 +89,7 @@ M: string do-write ( str -- )
stream get alloc-io-callback init-overlapped >r
handle get in-buffer get [ buffer@ ] keep
buffer-capacity file-size get [ fileptr get - min ] when*
NULL r>
f r>
ReadFile [ handle-io-error ] unless stop
] callcc1 pending-error
@ -157,7 +157,7 @@ M: win32-stream expire ( stream -- )
C: win32-stream ( handle -- stream )
swap [
dup NULL GetFileSize dup -1 = not [
dup f GetFileSize dup -1 = not [
file-size set
] [ drop f file-size set ] ifte
handle set

View File

@ -13,7 +13,7 @@ void primitive_expired(void)
drepl(F);
}
INLINE void* alien_offset(CELL object)
void* alien_offset(CELL object)
{
ALIEN *alien;
F_ARRAY *array;
@ -32,6 +32,8 @@ INLINE void* alien_offset(CELL object)
case DISPLACED_ALIEN_TYPE:
d = untag_displaced_alien_fast(object);
return alien_offset(d->alien) + d->displacement;
case F_TYPE:
return NULL;
default:
type_error(ALIEN_TYPE,object);
return (void*)-1; /* can't happen */

View File

@ -25,6 +25,8 @@ void primitive_alien(void);
void primitive_displaced_alien(void);
void primitive_alien_address(void);
void* alien_offset(CELL object);
void fixup_alien(ALIEN* alien);
void fixup_displaced_alien(DISPLACED_ALIEN* d);
void collect_displaced_alien(DISPLACED_ALIEN* d);

View File

@ -150,10 +150,13 @@ char *to_c_string_unchecked(F_STRING *s)
}
/* FFI calls this */
char *unbox_c_string(void)
char* unbox_c_string(void)
{
CELL str = dpop();
return (str ? to_c_string(untag_string(str)) : NULL);
if(type_of(str) == STRING_TYPE)
return to_c_string(untag_string(str));
else
return (char*)alien_offset(str);
}
/* FFI calls this */