<indirect-pointer> -> "indirect-pointer" <c-object>

added words to win32-stream
bootstraps with latest cvs  12/29/05
cvs
Doug Coleman 2005-12-29 20:51:48 +00:00
parent 7384c159f5
commit e17c0d07dd
3 changed files with 27 additions and 7 deletions

View File

@ -104,9 +104,9 @@ C: io-callback ( -- callback )
: (wait-for-io) ( timeout -- error overlapped len )
>r completion-port get
<indirect-pointer> [ 0 swap set-indirect-pointer-value ] keep
<indirect-pointer>
<indirect-pointer>
"indirect-pointer" <c-object> [ 0 swap set-indirect-pointer-value ] keep
"indirect-pointer" <c-object>
"indirect-pointer" <c-object>
pick over r> -rot >r >r GetQueuedCompletionStatus r> r> ;
: overlapped>callback ( overlapped -- callback )

View File

@ -49,7 +49,7 @@ SYMBOL: socket
AF_INET SOCK_STREAM 0 f f WSA_FLAG_OVERLAPPED WSASocket ;
: setup-sockaddr ( port -- sockaddr )
<sockaddr-in> swap
"sockaddr-in" <c-object> swap
htons over set-sockaddr-in-port
INADDR_ANY over set-sockaddr-in-addr
AF_INET over set-sockaddr-in-family ;
@ -66,8 +66,10 @@ SYMBOL: socket
dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa ;
: extract-remote-host ( buffer -- port host )
buffer-ptr <alien> 0 32 32 <indirect-pointer> <indirect-pointer>
<indirect-pointer> dup >r <indirect-pointer>
buffer-ptr <alien> 0 32 32 "indirect-pointer" <c-object>
"indirect-pointer" <c-object>
"indirect-pointer" <c-object>
dup >r "indirect-pointer" <c-object>
GetAcceptExSockaddrs r> indirect-pointer-value <alien> sockaddr> ;
C: win32-client-stream ( buf stream -- stream )

View File

@ -122,6 +122,9 @@ M: string do-write ( str -- )
M: win32-stream stream-write ( str stream -- )
win32-stream-this [ do-write ] bind ;
M: win32-stream stream-write1 ( char stream -- )
win32-stream-this [ >fixnum do-write ] bind ;
M: win32-stream stream-read ( count stream -- str )
win32-stream-this [ dup <sbuf> swap do-read-count ] bind ;
@ -130,6 +133,15 @@ M: win32-stream stream-read1 ( stream -- str )
1 consume-input dup length 0 = [ drop f ] when first
] bind ;
M: win32-stream stream-readln ( stream -- str )
win32-stream-this [ readln ] bind ;
M: win32-stream stream-terpri
win32-stream-this [ CHAR: \n do-write ] bind ;
M: win32-stream stream-terpri*
win32-stream-this stream-terpri ;
M: win32-stream stream-flush ( stream -- )
win32-stream-this [ maybe-flush-output ] bind ;
@ -141,6 +153,9 @@ M: win32-stream stream-close ( stream -- )
out-buffer get buffer-free
] bind ;
M: win32-stream stream-format ( string style stream -- )
win32-stream-this [ drop do-write ] bind ;
M: win32-stream win32-stream-handle ( stream -- handle )
win32-stream-this [ handle get ] bind ;
@ -152,6 +167,10 @@ M: win32-stream expire ( stream -- )
timeout get [ millis cutoff get > [ handle get CancelIo ] when ] when
] bind ;
USE: inspector
M: win32-stream with-nested-stream ( quot style stream -- )
win32-stream-this [ drop stream get swap with-stream* ] bind ;
C: win32-stream ( handle -- stream )
swap [
dup f GetFileSize dup -1 = not [
@ -170,4 +189,3 @@ C: win32-stream ( handle -- stream )
: <win32-file-writer> ( path -- stream )
f t win32-open-file <win32-stream> ;