<indirect-pointer> -> "indirect-pointer" <c-object>
added words to win32-stream bootstraps with latest cvs 12/29/05cvs
parent
7384c159f5
commit
e17c0d07dd
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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> ;
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue