fix win32-stream read. no more win32-stream-this!

diff --git a/library/io/windows/server.factor b/library/io/windows/server.factor
index 994a0528c558350d91988932c4822ecf8e818cfc..b5f4286c6311af5d648f1f2f5fa412e403988605 100644 (file)
--- a/library/io/windows/server.factor
+++ b/library/io/windows/server.factor
@@ -8,6 +8,9 @@ USING: alien errors generic kernel kernel-internals math namespaces
 TUPLE: win32-server this ;
 TUPLE: win32-client-stream host port ;
 SYMBOL: socket
+SYMBOL: stream
+SYMBOL: timeout
+SYMBOL: cutoff
 
 : (handle-socket-error)
     WSAGetLastError [ ERROR_IO_PENDING ERROR_SUCCESS ] member?
@@ -95,12 +98,12 @@ IN: io
             buffer-ptr <alien> 0 32 32 f r> AcceptEx
             handle-socket-error!=0/f stop
         ] callcc1 pending-error drop
-        swap dup add-completion make-win32-stream <line-reader> 
+        swap dup add-completion <win32-stream> <line-reader> 
         dupd <win32-client-stream> swap buffer-free
     ] bind ;
 
 : <client> ( host port -- stream )
     client-sockaddr new-socket
     [ swap "sockaddr-in" c-size connect handle-socket-error!=0/f ] keep 
-    dup add-completion make-win32-stream <line-reader> ;
+    dup add-completion <win32-stream> <line-reader> ;
 

diff --git a/library/io/windows/stream.factor b/library/io/windows/stream.factor
index 139d516af70df6480c7a0bea82605f08b6e8c69b..451f8fb13e1e29f6cae55b1b9465cd58016da3a1 100644 (file)
--- a/library/io/windows/stream.factor
+++ b/library/io/windows/stream.factor
@@ -5,30 +5,11 @@ USING: alien generic hashtables io-internals kernel
 kernel-internals math namespaces prettyprint sequences
 io strings threads win32-api win32-io-internals ;
 
-TUPLE: win32-stream handle in-buffer out-buffer fileptr file-size timeout cutoff this ;
-
-! remove these symbols
-SYMBOL: the-hash
-SYMBOL: stream
-
-SYMBOL: handle
-SYMBOL: in-buffer
-SYMBOL: out-buffer
-SYMBOL: fileptr
-SYMBOL: file-size
-SYMBOL: timeout
-SYMBOL: cutoff
+TUPLE: win32-stream handle in-buffer out-buffer fileptr file-size timeout cutoff ;
 
 : pending-error ( len/status -- len/status )
     dup [ win32-throw-error ] unless ;
 
-: init-overlapped2 ( overlapped -- overlapped )
-    0 over set-overlapped-ext-internal
-    0 over set-overlapped-ext-internal-high
-    fileptr get dup 0 ? over set-overlapped-ext-offset
-    0 over set-overlapped-ext-offset-high
-    f over set-overlapped-ext-event ;
-
 : init-overlapped ( fileptr overlapped -- overlapped )
     0 over set-overlapped-ext-internal
     0 over set-overlapped-ext-internal-high
@@ -36,9 +17,6 @@ SYMBOL: cutoff
     0 over set-overlapped-ext-offset-high
     f over set-overlapped-ext-event ;
 
-: update-file-pointer2 ( whence -- )
-    file-size get [ fileptr [ + ] change ] [ drop ] if ;
-
 : update-file-pointer ( whence stream -- )
     dup win32-stream-file-size [
         [ win32-stream-fileptr + ] keep set-win32-stream-fileptr
@@ -50,30 +28,40 @@ SYMBOL: cutoff
     dup win32-stream-timeout
     [ millis + swap set-win32-stream-cutoff ] [ drop ] if* ;
 
-: update-timeout2 ( stream -- )
-    timeout get [ millis + cutoff set ] when* ;
+: >string-or-f ( sbuf -- str-or-? )
+    dup length zero? [ drop f ] [ >string ] if ;
 
 ! Read
-: fill-input ( -- )
-    update-timeout2 [
-        stream get alloc-io-callback init-overlapped2 >r
-        handle get in-buffer get [ buffer@ ] keep 
-        buffer-capacity file-size get [ fileptr get - min ] when*
-        f r>
-        ReadFile [ handle-io-error ] unless stop
-    ] callcc1 pending-error
-    dup in-buffer get n>buffer update-file-pointer2 ;
-
-: consume-input ( count buffer -- str ) 
-    dup buffer-length zero? [ fill-input ] when
+USE: errors
+: fill-input ( stream -- )
+    dup update-timeout
+    dup unit
+    [
+        [ alloc-io-callback ] keep
+        win32-stream-fileptr swap init-overlapped >r
+    ] append
+    over win32-stream-handle unit append
+    over win32-stream-in-buffer unit append
+    [
+        [ buffer@ ] keep 
+        buffer-capacity
+    ] append
+    over win32-stream-file-size unit append
+    over win32-stream-fileptr [ - min ] curry
+    [ when* f r> ReadFile [ handle-io-error ] unless stop ]
+    curry append
+    callcc1 pending-error
+    [ over win32-stream-in-buffer n>buffer ] keep
+    swap update-file-pointer ;
+
+: consume-input ( count stream -- str ) 
+    dup win32-stream-in-buffer buffer-length zero? [ dup fill-input ] when
+    win32-stream-in-buffer
     [ buffer-size min ] keep
     [ buffer-first-n ] 2keep
     buffer-consume ;
 
-: >string-or-f ( sbuf -- str-or-? )
-    dup length zero? [ drop f ] [ >string ] if ;
-
-: do-read-count ( buffer sbuf count -- str )
+: do-read-count ( stream sbuf count -- str )
     #! Keep reading until count is reached or until stream end (f is returned)
     dup zero? [ 
         drop >string nip
@@ -82,13 +70,12 @@ SYMBOL: cutoff
         dup empty? [
             2drop >string-or-f nip
         ] [
-            rot [ nappend ] 2keep
-            >r length - r> swap do-read-count
+            swapd over >r nappend r>
+            [ length - ] keep swap do-read-count
         ] if
     ] if ;
 
 ! Write
-USE: errors
 : flush-output ( stream -- ) 
     dup update-timeout 
     dup unit
@@ -134,53 +121,38 @@ M: win32-stream stream-close ( stream -- )
     win32-stream-out-buffer buffer-free ;
 
 M: win32-stream stream-read1 ( stream -- ch/f )
-    win32-stream-this [
-        1 in-buffer get consume-input >string-or-f first
-    ] bind ;
-
+    >r 1 r> consume-input >string-or-f first ;
 M: win32-stream stream-read ( n stream -- str/f )
-    win32-stream-this [ dup <sbuf> swap in-buffer get do-read-count ] bind ;
-
-M: win32-stream stream-read ( n stream -- str/f )
-    win32-stream-this [ dup <sbuf> swap in-buffer get do-read-count ] bind ;
-
+    >r [ <sbuf> ] keep r> -rot do-read-count ;
 
 M: win32-stream stream-flush ( stream -- ) maybe-flush-output ;
 M: win32-stream stream-write1 ( ch stream -- ) >r >fixnum r> do-write ;
 M: win32-stream stream-write ( str stream -- ) do-write ;
 
 M: win32-stream set-timeout ( n stream -- ) set-win32-stream-timeout ;
-M: win32-stream expire ( stream -- )
-    win32-stream-this [
-        timeout get [ millis cutoff get > [ handle get CancelIo ] when ] when
-    ] bind ;
 
-: make-win32-stream ( handle -- stream )
+M: win32-stream expire ( stream -- )
+    dup win32-stream-timeout
     [
-        dup f GetFileSize dup -1 = not [
-            file-size set
-        ] [ drop f file-size set ] if
-        handle set 
-        4096 <buffer> in-buffer set 
-        4096 <buffer> out-buffer set
-        0 fileptr set 
-    ] make-hash
-    the-hash set
-    handle the-hash get hash
-    in-buffer the-hash get hash
-    out-buffer the-hash get hash
-    fileptr the-hash get hash
-    file-size the-hash get hash
-    f 0 the-hash get
-    <win32-stream> dup stream set ;
+        millis over win32-stream-cutoff >
+        [ win32-stream-handle CancelIo ] [ drop ] if
+    ] [
+        drop
+    ] if ;
+
+C: win32-stream ( handle -- stream )
+    [ set-win32-stream-handle ] keep
+    4096 <buffer> swap [ set-win32-stream-in-buffer ] keep
+    4096 <buffer> swap [ set-win32-stream-out-buffer ] keep
+    0 swap [ set-win32-stream-fileptr ] keep
+    dup win32-stream-handle f GetFileSize dup -1 = [ drop f ] when
+        swap [ set-win32-stream-file-size ] keep
+    0 swap [ set-win32-stream-timeout ] keep
+    0 swap [ set-win32-stream-cutoff ] keep ;
 
 : <win32-file-reader> ( path -- stream )
-    t f win32-open-file make-win32-stream <line-reader> ;
+    t f win32-open-file <win32-stream> <line-reader> ;
 
 : <win32-file-writer> ( path -- stream )
-    f t win32-open-file make-win32-stream <plain-writer> ;
+    f t win32-open-file <win32-stream> <plain-writer> ;
 
-IN: scratchpad
-: gg
-    "omgomg.txt" <file-writer> [ "zomg" write ] with-stream ;
-