steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Preliminary win32 fixes; will refactor later

cvs
Mackenzie Straight 2005-02-07 14:46:56 +00:00
parent 700c4d8e17
commit 5259f93c29
4 changed files with 36 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
factor.vcproj
View File

@ -159,6 +159,9 @@
<File
RelativePath="native\gc.c">
</File>
<File
RelativePath=".\native\hashtable.c">
</File>
<File
RelativePath="native\image.c">
</File>
@ -418,6 +421,9 @@
<File
RelativePath="native\gc.h">
</File>
<File
RelativePath=".\native\hashtable.h">
</File>
<File
RelativePath="native\image.h">
</File>

4
library/bootstrap/win32-io.factor
View File

@ -52,8 +52,8 @@ USE: win32-io-internals
USE: win32-stream
USE: win32-api
: <filecr> <win32-filecr> ;
: <filecw> <win32-filecw> ;
: <file-reader> <win32-file-reader> ;
: <file-writer> <win32-file-writer> ;
: <server> <win32-server> ;
: init-stdio ( -- )

29
library/io/win32-server.factor
View File

@ -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 ;
: <win32-client-stream> ( buf stream -- stream )
[
buffer-ptr <alien> 0 32 32
<sockaddr-in> dup >r <indirect-pointer> <sockaddr-in> dup >r
<indirect-pointer> 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 <alien> 0 32 32
<sockaddr-in> dup >r <indirect-pointer> <sockaddr-in> dup >r
<indirect-pointer> 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 <namespace> [
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 <buffer>
[
alloc-io-task init-overlapped >r >r >r socket get r> r>

23
library/io/win32-stream.factor
View File

@ -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 <sbuf> do-read-line ] bind ;
win32-stream-this [ 80 <sbuf> do-read-line ] bind ;
M: win32-stream fread# ( count stream -- str )
[ dup <sbuf> swap do-read-count ] bind ;
win32-stream-this [ dup <sbuf> 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 <namespace> [
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 <buffer> in-buffer set
4096 <buffer> out-buffer set
0 fileptr set
] extend ;
] extend over set-win32-stream-this ;
: <win32-filecr> ( path -- stream )
: <win32-file-reader> ( path -- stream )
t f win32-open-file <win32-stream> ;
: <win32-filecw> ( path -- stream )
: <win32-file-writer> ( path -- stream )
f t win32-open-file <win32-stream> ;