diff --git a/factor.vcproj b/factor.vcproj
index 6726f24b2c..c5e34b7093 100644
--- a/factor.vcproj
+++ b/factor.vcproj
@@ -159,6 +159,9 @@
+
+
@@ -418,6 +421,9 @@
+
+
diff --git a/library/bootstrap/win32-io.factor b/library/bootstrap/win32-io.factor
index 2cfe934d43..30dff56dc9 100644
--- a/library/bootstrap/win32-io.factor
+++ b/library/bootstrap/win32-io.factor
@@ -52,8 +52,8 @@ USE: win32-io-internals
USE: win32-stream
USE: win32-api
-: ;
-: ;
+: ;
+: ;
: ;
: init-stdio ( -- )
diff --git a/library/io/win32-server.factor b/library/io/win32-server.factor
index 67b7ff4b83..59311659c1 100644
--- a/library/io/win32-server.factor
+++ b/library/io/win32-server.factor
@@ -43,7 +43,8 @@ USE: unparser
USE: win32-api
USE: win32-io-internals
-TRAITS: win32-server
+TUPLE: win32-server this ;
+TUPLE: win32-client-stream delegate host ;
SYMBOL: winsock
SYMBOL: socket
@@ -76,27 +77,29 @@ SYMBOL: socket
: listen-socket ( socket -- )
20 wsa-listen 0 = [ handle-socket-error ] unless ;
-: ( buf stream -- stream )
- [
- buffer-ptr 0 32 32
- dup >r dup >r
- GetAcceptExSockaddrs r> r> drop
- dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa
- [ , ":" , unparse , ] make-string "client" set
- ] extend ;
+C: win32-client-stream ( buf stream -- stream )
+ [ set-win32-client-stream-delegate ] keep >r
+ buffer-ptr 0 32 32
+ dup >r dup >r
+ GetAcceptExSockaddrs r> r> drop
+ dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa
+ [ , ":" , unparse , ] make-string
+ r> [ set-win32-client-stream-host ] keep ;
+
+M: win32-client-stream client-stream-host win32-client-stream-host ;
C: win32-server ( port -- server )
- [
+ swap [
maybe-init-winsock new-socket swap over bind-socket dup listen-socket
dup add-completion
socket set
- ] extend ;
+ ] extend over set-win32-server-this ;
M: win32-server fclose ( server -- )
- [ socket get CloseHandle drop ] bind ;
+ win32-server-this [ socket get CloseHandle drop ] bind ;
M: win32-server accept ( server -- client )
- [
+ win32-server-this [
new-socket 64
[
alloc-io-task init-overlapped >r >r >r socket get r> r>
diff --git a/library/io/win32-stream.factor b/library/io/win32-stream.factor
index 3b8406abc1..a5edb9be70 100644
--- a/library/io/win32-stream.factor
+++ b/library/io/win32-stream.factor
@@ -42,7 +42,8 @@ USE: threads
USE: win32-api
USE: win32-io-internals
-TRAITS: win32-stream
+TUPLE: win32-stream this ;
+! handle in-buffer out-buffer fileptr file-size ;
GENERIC: win32-stream-handle
GENERIC: do-write
@@ -140,22 +141,22 @@ M: string do-write ( str -- )
] ifte ;
M: win32-stream fwrite-attr ( str style stream -- )
- nip [ do-write ] bind ;
+ win32-stream-this nip [ do-write ] bind ;
M: win32-stream freadln ( stream -- str )
- [ 80 do-read-line ] bind ;
+ win32-stream-this [ 80 do-read-line ] bind ;
M: win32-stream fread# ( count stream -- str )
- [ dup swap do-read-count ] bind ;
+ win32-stream-this [ dup swap do-read-count ] bind ;
M: win32-stream fflush ( stream -- )
- [ maybe-flush-output ] bind ;
+ win32-stream-this [ maybe-flush-output ] bind ;
M: win32-stream fauto-flush ( stream -- )
drop ;
M: win32-stream fclose ( stream -- )
- [
+ win32-stream-this [
maybe-flush-output
handle get CloseHandle drop
in-buffer get buffer-free
@@ -163,10 +164,10 @@ M: win32-stream fclose ( stream -- )
] bind ;
M: win32-stream win32-stream-handle ( stream -- handle )
- [ handle get ] bind ;
+ win32-stream-this [ handle get ] bind ;
C: win32-stream ( handle -- stream )
- [
+ swap [
dup NULL GetFileSize dup -1 = not [
file-size set
] [ drop f file-size set ] ifte
@@ -174,12 +175,12 @@ C: win32-stream ( handle -- stream )
4096 in-buffer set
4096 out-buffer set
0 fileptr set
- ] extend ;
+ ] extend over set-win32-stream-this ;
-: ( path -- stream )
+: ( path -- stream )
t f win32-open-file ;
-: ( path -- stream )
+: ( path -- stream )
f t win32-open-file ;