Merge branch 'master' into ppc-float-compare
commit
ee38639c97
|
@ -89,7 +89,7 @@ IN: compiler.cfg.value-numbering.tests
|
|||
T{ ##load-reference f 1 + }
|
||||
T{ ##peek f 2 D 0 }
|
||||
T{ ##compare f 4 2 1 cc<= }
|
||||
T{ ##compare f 6 2 1 cc> }
|
||||
T{ ##compare f 6 2 1 cc/<= }
|
||||
T{ ##replace f 6 D 0 }
|
||||
}
|
||||
] [
|
||||
|
@ -109,7 +109,7 @@ IN: compiler.cfg.value-numbering.tests
|
|||
T{ ##unbox-float f 10 8 }
|
||||
T{ ##unbox-float f 11 9 }
|
||||
T{ ##compare-float f 12 10 11 cc< }
|
||||
T{ ##compare-float f 14 10 11 cc>= }
|
||||
T{ ##compare-float f 14 10 11 cc/< }
|
||||
T{ ##replace f 14 D 0 }
|
||||
}
|
||||
] [
|
||||
|
|
|
@ -501,7 +501,7 @@ M: ppc %epilogue ( n -- )
|
|||
dst \ t %load-reference
|
||||
"end" get resolve-label ; inline
|
||||
|
||||
: %boolean ( dst temp cc -- )
|
||||
:: %boolean ( dst temp cc -- )
|
||||
cc negate-cc order-cc {
|
||||
{ cc< [ dst temp \ BLT f (%boolean) ] }
|
||||
{ cc<= [ dst temp \ BLE f (%boolean) ] }
|
||||
|
|
|
@ -4,7 +4,6 @@ io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
|
|||
io.streams.c io.streams.null libc kernel math namespaces sequences
|
||||
threads windows windows.errors windows.kernel32 strings splitting
|
||||
ascii system accessors locals classes.struct combinators.short-circuit ;
|
||||
QUALIFIED: windows.winsock
|
||||
IN: io.backend.windows.nt
|
||||
|
||||
! Global variable with assoc mapping overlapped to threads
|
||||
|
@ -79,8 +78,7 @@ M: winnt io-multiplex ( us -- )
|
|||
|
||||
M: winnt init-io ( -- )
|
||||
<master-completion-port> master-completion-port set-global
|
||||
H{ } clone pending-overlapped set-global
|
||||
windows.winsock:init-winsock ;
|
||||
H{ } clone pending-overlapped set-global ;
|
||||
|
||||
ERROR: invalid-file-size n ;
|
||||
|
||||
|
|
|
@ -30,8 +30,8 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
|
|||
|
||||
: make-token-privileges ( name ? -- obj )
|
||||
"TOKEN_PRIVILEGES" <c-object>
|
||||
1 [ over set-TOKEN_PRIVILEGES-PrivilegeCount ] keep
|
||||
"LUID_AND_ATTRIBUTES" malloc-array &free
|
||||
1 over set-TOKEN_PRIVILEGES-PrivilegeCount
|
||||
"LUID_AND_ATTRIBUTES" malloc-object &free
|
||||
over set-TOKEN_PRIVILEGES-Privileges
|
||||
|
||||
swap [
|
||||
|
|
|
@ -3,8 +3,8 @@
|
|||
USING: alien alien.c-types arrays destructors io io.backend
|
||||
io.buffers io.files io.ports io.binary io.timeouts system
|
||||
strings kernel math namespaces sequences windows.errors
|
||||
windows.kernel32 windows.shell32 windows.types windows.winsock
|
||||
splitting continuations math.bitwise accessors init sets assocs
|
||||
windows.kernel32 windows.shell32 windows.types splitting
|
||||
continuations math.bitwise accessors init sets assocs
|
||||
classes.struct classes ;
|
||||
IN: io.backend.windows
|
||||
|
||||
|
@ -52,4 +52,4 @@ HOOK: add-completion io-backend ( port -- )
|
|||
|
||||
: default-security-attributes ( -- obj )
|
||||
SECURITY_ATTRIBUTES <struct>
|
||||
dup class heap-size >>nLength ;
|
||||
SECURITY_ATTRIBUTES heap-size >>nLength ;
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors kernel namespaces continuations
|
||||
destructors io debugger io.sockets sequences summary calendar
|
||||
delegate system vocabs.loader combinators present ;
|
||||
USING: accessors kernel namespaces continuations destructors io
|
||||
debugger io.sockets io.sockets.private sequences summary
|
||||
calendar delegate system vocabs.loader combinators present ;
|
||||
IN: io.sockets.secure
|
||||
|
||||
SYMBOL: secure-socket-timeout
|
||||
|
|
|
@ -1,12 +1,12 @@
|
|||
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors unix byte-arrays kernel sequences
|
||||
namespaces math math.order combinators init alien alien.c-types
|
||||
USING: accessors unix byte-arrays kernel sequences namespaces
|
||||
math math.order combinators init alien alien.c-types
|
||||
alien.strings libc continuations destructors openssl
|
||||
openssl.libcrypto openssl.libssl io io.files io.ports
|
||||
io.backend.unix io.sockets.unix io.encodings.ascii io.buffers
|
||||
io.sockets io.sockets.secure io.sockets.secure.openssl
|
||||
io.timeouts system summary fry ;
|
||||
io.sockets io.sockets.private io.sockets.secure
|
||||
io.sockets.secure.openssl io.timeouts system summary fry ;
|
||||
FROM: io.ports => shutdown ;
|
||||
IN: io.sockets.secure.unix
|
||||
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
IN: io.sockets.tests
|
||||
USING: io.sockets sequences math tools.test namespaces accessors
|
||||
kernel destructors calendar io.timeouts io.encodings.utf8 io
|
||||
concurrency.promises threads io.streams.string ;
|
||||
USING: io.sockets io.sockets.private sequences math tools.test
|
||||
namespaces accessors kernel destructors calendar io.timeouts
|
||||
io.encodings.utf8 io concurrency.promises threads
|
||||
io.streams.string ;
|
||||
|
||||
[ B{ 1 2 3 4 } ]
|
||||
[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
|
||||
|
|
|
@ -15,6 +15,8 @@ IN: io.sockets
|
|||
} cond use-vocab >>
|
||||
|
||||
! Addressing
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: protocol-family ( addrspec -- af )
|
||||
|
||||
GENERIC: sockaddr-size ( addrspec -- n )
|
||||
|
@ -37,6 +39,17 @@ GENERIC: inet-pton ( str addrspec -- data )
|
|||
|
||||
GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
|
||||
|
||||
HOOK: sockaddr-of-family os ( alien af -- sockaddr )
|
||||
|
||||
HOOK: addrspec-of-family os ( af -- addrspec )
|
||||
|
||||
PRIVATE>
|
||||
|
||||
TUPLE: abstract-inet host port ;
|
||||
|
||||
M: abstract-inet present
|
||||
[ host>> ":" ] [ port>> number>string ] bi 3append ;
|
||||
|
||||
TUPLE: local path ;
|
||||
|
||||
: <local> ( path -- addrspec )
|
||||
|
@ -44,11 +57,6 @@ TUPLE: local path ;
|
|||
|
||||
M: local present path>> "Unix domain socket: " prepend ;
|
||||
|
||||
TUPLE: abstract-inet host port ;
|
||||
|
||||
M: abstract-inet present
|
||||
[ host>> ":" ] [ port>> number>string ] bi 3append ;
|
||||
|
||||
TUPLE: inet4 < abstract-inet ;
|
||||
|
||||
C: <inet4> inet4
|
||||
|
@ -146,24 +154,10 @@ M: inet6 parse-sockaddr
|
|||
[ [ addr>> ] dip inet-ntop ]
|
||||
[ drop port>> ntohs ] 2bi <inet6> ;
|
||||
|
||||
: addrspec-of-family ( af -- addrspec )
|
||||
{
|
||||
{ AF_INET [ T{ inet4 } ] }
|
||||
{ AF_INET6 [ T{ inet6 } ] }
|
||||
{ AF_UNIX [ T{ local } ] }
|
||||
[ drop f ]
|
||||
} case ;
|
||||
|
||||
: sockaddr-of-family ( af -- addrspec )
|
||||
{
|
||||
{ AF_INET [ sockaddr-in ] }
|
||||
{ AF_INET6 [ sockaddr-in6 ] }
|
||||
{ AF_UNIX [ sockaddr-un ] }
|
||||
[ drop f ]
|
||||
} case ;
|
||||
|
||||
M: f parse-sockaddr nip ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
GENERIC: (get-local-address) ( handle remote -- sockaddr )
|
||||
|
||||
: get-local-address ( handle remote -- local )
|
||||
|
@ -198,6 +192,58 @@ M: object (client) ( remote -- client-in client-out local )
|
|||
2bi
|
||||
] with-destructors ;
|
||||
|
||||
TUPLE: server-port < port addr encoding ;
|
||||
|
||||
: check-server-port ( port -- port )
|
||||
dup check-disposed
|
||||
dup server-port? [ "Not a server port" throw ] unless ; inline
|
||||
|
||||
GENERIC: (server) ( addrspec -- handle )
|
||||
|
||||
GENERIC: (accept) ( server addrspec -- handle sockaddr )
|
||||
|
||||
TUPLE: datagram-port < port addr ;
|
||||
|
||||
HOOK: (datagram) io-backend ( addr -- datagram )
|
||||
|
||||
: check-datagram-port ( port -- port )
|
||||
dup check-disposed
|
||||
dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
|
||||
|
||||
HOOK: (receive) io-backend ( datagram -- packet addrspec )
|
||||
|
||||
: check-datagram-send ( packet addrspec port -- packet addrspec port )
|
||||
check-datagram-port
|
||||
2dup addr>> [ class ] bi@ assert=
|
||||
pick class byte-array assert= ;
|
||||
|
||||
HOOK: (send) io-backend ( packet addrspec datagram -- )
|
||||
|
||||
: addrinfo>addrspec ( addrinfo -- addrspec )
|
||||
[ [ addr>> ] [ family>> ] bi sockaddr-of-family ]
|
||||
[ family>> addrspec-of-family ] bi
|
||||
parse-sockaddr ;
|
||||
|
||||
: parse-addrinfo-list ( addrinfo -- seq )
|
||||
[ next>> dup [ addrinfo memory>struct ] when ] follow
|
||||
[ addrinfo>addrspec ] map
|
||||
sift ;
|
||||
|
||||
HOOK: addrinfo-error io-backend ( n -- )
|
||||
|
||||
: resolve-passive-host ( -- addrspecs )
|
||||
{ T{ inet6 f "::" f } T{ inet4 f "0.0.0.0" f } } [ clone ] map ;
|
||||
|
||||
: prepare-addrinfo ( -- addrinfo )
|
||||
addrinfo <struct>
|
||||
PF_UNSPEC >>family
|
||||
IPPROTO_TCP >>protocol ;
|
||||
|
||||
: fill-in-ports ( addrspecs port -- addrspecs )
|
||||
'[ _ >>port ] map ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: <client> ( remote encoding -- stream local )
|
||||
[ (client) ] dip swap [ <encoder-duplex> ] dip ;
|
||||
|
||||
|
@ -213,14 +259,6 @@ SYMBOL: remote-address
|
|||
] dip with-stream
|
||||
] with-scope ; inline
|
||||
|
||||
TUPLE: server-port < port addr encoding ;
|
||||
|
||||
: check-server-port ( port -- port )
|
||||
dup check-disposed
|
||||
dup server-port? [ "Not a server port" throw ] unless ; inline
|
||||
|
||||
GENERIC: (server) ( addrspec -- handle )
|
||||
|
||||
: <server> ( addrspec encoding -- server )
|
||||
[
|
||||
[ (server) ] keep
|
||||
|
@ -228,8 +266,6 @@ GENERIC: (server) ( addrspec -- handle )
|
|||
>>addr
|
||||
] dip >>encoding ;
|
||||
|
||||
GENERIC: (accept) ( server addrspec -- handle sockaddr )
|
||||
|
||||
: accept ( server -- client remote )
|
||||
[
|
||||
dup addr>>
|
||||
|
@ -238,10 +274,6 @@ GENERIC: (accept) ( server addrspec -- handle sockaddr )
|
|||
<ports>
|
||||
] keep encoding>> <encoder-duplex> swap ;
|
||||
|
||||
TUPLE: datagram-port < port addr ;
|
||||
|
||||
HOOK: (datagram) io-backend ( addr -- datagram )
|
||||
|
||||
: <datagram> ( addrspec -- datagram )
|
||||
[
|
||||
[ (datagram) |dispose ] keep
|
||||
|
@ -249,55 +281,19 @@ HOOK: (datagram) io-backend ( addr -- datagram )
|
|||
>>addr
|
||||
] with-destructors ;
|
||||
|
||||
: check-datagram-port ( port -- port )
|
||||
dup check-disposed
|
||||
dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
|
||||
|
||||
HOOK: (receive) io-backend ( datagram -- packet addrspec )
|
||||
|
||||
: receive ( datagram -- packet addrspec )
|
||||
check-datagram-port
|
||||
[ (receive) ] [ addr>> ] bi parse-sockaddr ;
|
||||
|
||||
: check-datagram-send ( packet addrspec port -- packet addrspec port )
|
||||
check-datagram-port
|
||||
2dup addr>> [ class ] bi@ assert=
|
||||
pick class byte-array assert= ;
|
||||
|
||||
HOOK: (send) io-backend ( packet addrspec datagram -- )
|
||||
|
||||
: send ( packet addrspec datagram -- )
|
||||
check-datagram-send (send) ;
|
||||
|
||||
: addrinfo>addrspec ( addrinfo -- addrspec )
|
||||
[ [ addr>> ] [ family>> sockaddr-of-family ] bi memory>struct ]
|
||||
[ family>> addrspec-of-family ] bi
|
||||
parse-sockaddr ;
|
||||
|
||||
: parse-addrinfo-list ( addrinfo -- seq )
|
||||
[ next>> dup [ addrinfo memory>struct ] when ] follow
|
||||
[ addrinfo>addrspec ] map
|
||||
sift ;
|
||||
|
||||
HOOK: addrinfo-error io-backend ( n -- )
|
||||
|
||||
GENERIC: resolve-host ( addrspec -- seq )
|
||||
|
||||
TUPLE: inet < abstract-inet ;
|
||||
|
||||
C: <inet> inet
|
||||
|
||||
: resolve-passive-host ( -- addrspecs )
|
||||
{ T{ inet6 f "::" f } T{ inet4 f "0.0.0.0" f } } [ clone ] map ;
|
||||
|
||||
: prepare-addrinfo ( -- addrinfo )
|
||||
addrinfo <struct>
|
||||
PF_UNSPEC >>family
|
||||
IPPROTO_TCP >>protocol ;
|
||||
|
||||
: fill-in-ports ( addrspecs port -- addrspecs )
|
||||
'[ _ >>port ] map ;
|
||||
|
||||
M: inet resolve-host
|
||||
[ port>> ] [ host>> ] bi [
|
||||
f prepare-addrinfo f <void*>
|
||||
|
|
|
@ -1,10 +1,11 @@
|
|||
! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.strings generic kernel math threads
|
||||
sequences byte-arrays io.binary io.backend.unix io.streams.duplex
|
||||
io.backend io.pathnames io.files.private io.encodings.utf8 math.parser
|
||||
continuations libc combinators system accessors destructors unix
|
||||
locals init classes.struct ;
|
||||
USING: alien alien.c-types alien.strings generic kernel math
|
||||
threads sequences byte-arrays io.binary io.backend.unix
|
||||
io.streams.duplex io.backend io.pathnames io.sockets.private
|
||||
io.files.private io.encodings.utf8 math.parser continuations
|
||||
libc combinators system accessors destructors unix locals init
|
||||
classes.struct ;
|
||||
|
||||
EXCLUDE: namespaces => bind ;
|
||||
EXCLUDE: io => read write ;
|
||||
|
@ -21,6 +22,22 @@ IN: io.sockets.unix
|
|||
M: unix addrinfo-error ( n -- )
|
||||
[ gai_strerror throw ] unless-zero ;
|
||||
|
||||
M: unix sockaddr-of-family ( alien af -- addrspec )
|
||||
{
|
||||
{ AF_INET [ sockaddr-in memory>struct ] }
|
||||
{ AF_INET6 [ sockaddr-in6 memory>struct ] }
|
||||
{ AF_UNIX [ sockaddr-un memory>struct ] }
|
||||
[ 2drop f ]
|
||||
} case ;
|
||||
|
||||
M: unix addrspec-of-family ( af -- addrspec )
|
||||
{
|
||||
{ AF_INET [ T{ inet4 } ] }
|
||||
{ AF_INET6 [ T{ inet6 } ] }
|
||||
{ AF_UNIX [ T{ local } ] }
|
||||
[ drop f ]
|
||||
} case ;
|
||||
|
||||
! Client sockets - TCP and Unix domain
|
||||
M: object (get-local-address) ( handle remote -- sockaddr )
|
||||
[ handle-fd ] dip empty-sockaddr/size <int>
|
||||
|
@ -99,19 +116,17 @@ CONSTANT: packet-size 65536
|
|||
[ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
|
||||
|
||||
:: do-receive ( port -- packet sockaddr )
|
||||
port addr>> empty-sockaddr/size [| sockaddr len |
|
||||
port handle>> handle-fd ! s
|
||||
receive-buffer get-global ! buf
|
||||
packet-size ! nbytes
|
||||
0 ! flags
|
||||
sockaddr ! from
|
||||
len <int> ! fromlen
|
||||
recvfrom dup 0 >= [
|
||||
receive-buffer get-global swap memory>byte-array sockaddr
|
||||
] [
|
||||
drop f f
|
||||
] if
|
||||
] call ;
|
||||
port addr>> empty-sockaddr/size :> len :> sockaddr
|
||||
port handle>> handle-fd ! s
|
||||
receive-buffer get-global ! buf
|
||||
packet-size ! nbytes
|
||||
0 ! flags
|
||||
sockaddr ! from
|
||||
len <int> ! fromlen
|
||||
recvfrom dup 0 >=
|
||||
[ receive-buffer get-global swap memory>byte-array sockaddr ]
|
||||
[ drop f f ]
|
||||
if ;
|
||||
|
||||
M: unix (receive) ( datagram -- packet sockaddr )
|
||||
dup do-receive dup [ [ drop ] 2dip ] [
|
||||
|
|
|
@ -1,13 +1,13 @@
|
|||
USING: alien alien.accessors alien.c-types byte-arrays
|
||||
continuations destructors io.ports io.timeouts io.sockets
|
||||
io namespaces io.streams.duplex io.backend.windows
|
||||
io.sockets.windows io.backend.windows.nt windows.winsock kernel
|
||||
libc math sequences threads system combinators accessors
|
||||
classes.struct windows.kernel32 ;
|
||||
io.sockets.private io namespaces io.streams.duplex
|
||||
io.backend.windows io.sockets.windows io.backend.windows.nt
|
||||
windows.winsock kernel libc math sequences threads system
|
||||
combinators accessors classes.struct windows.kernel32 ;
|
||||
IN: io.sockets.windows.nt
|
||||
|
||||
: malloc-int ( object -- object )
|
||||
"int" heap-size malloc [ nip ] [ 0 set-alien-signed-4 ] 2bi ; inline
|
||||
: malloc-int ( n -- alien )
|
||||
<int> malloc-byte-array ; inline
|
||||
|
||||
M: winnt WSASocket-flags ( -- DWORD )
|
||||
WSA_FLAG_OVERLAPPED ;
|
||||
|
@ -100,17 +100,20 @@ TUPLE: AcceptEx-args port
|
|||
} cleave AcceptEx drop
|
||||
winsock-error-string [ throw ] when* ; inline
|
||||
|
||||
: (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr )
|
||||
f <void*> 0 <int> f <void*> [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
|
||||
|
||||
: extract-remote-address ( AcceptEx -- sockaddr )
|
||||
{
|
||||
[ lpOutputBuffer>> ]
|
||||
[ dwReceiveDataLength>> ]
|
||||
[ dwLocalAddressLength>> ]
|
||||
[ dwRemoteAddressLength>> ]
|
||||
} cleave
|
||||
f <void*>
|
||||
0 <int>
|
||||
f <void*>
|
||||
[ 0 <int> GetAcceptExSockaddrs ] keep *void* ; inline
|
||||
[
|
||||
{
|
||||
[ lpOutputBuffer>> ]
|
||||
[ dwReceiveDataLength>> ]
|
||||
[ dwLocalAddressLength>> ]
|
||||
[ dwRemoteAddressLength>> ]
|
||||
} cleave
|
||||
(extract-remote-address)
|
||||
] [ port>> addr>> protocol-family ] bi
|
||||
sockaddr-of-family ; inline
|
||||
|
||||
M: object (accept) ( server addr -- handle sockaddr )
|
||||
[
|
||||
|
@ -160,7 +163,12 @@ TUPLE: WSARecvFrom-args port
|
|||
|
||||
: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
|
||||
[ lpBuffers>> buf>> swap memory>byte-array ]
|
||||
[ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline
|
||||
[
|
||||
[ port>> addr>> empty-sockaddr dup ]
|
||||
[ lpFrom>> ]
|
||||
[ lpFromLen>> *int ]
|
||||
tri memcpy
|
||||
] bi ; inline
|
||||
|
||||
M: winnt (receive) ( datagram -- packet addrspec )
|
||||
[
|
||||
|
|
|
@ -1,7 +1,25 @@
|
|||
USING: kernel accessors io.sockets io.backend.windows io.backend
|
||||
windows.winsock system destructors alien.c-types ;
|
||||
USING: kernel accessors io.sockets io.sockets.private
|
||||
io.backend.windows io.backend windows.winsock system destructors
|
||||
alien.c-types classes.struct combinators ;
|
||||
IN: io.sockets.windows
|
||||
|
||||
M: windows addrinfo-error ( n -- )
|
||||
winsock-return-check ;
|
||||
|
||||
M: windows sockaddr-of-family ( alien af -- addrspec )
|
||||
{
|
||||
{ AF_INET [ sockaddr-in memory>struct ] }
|
||||
{ AF_INET6 [ sockaddr-in6 memory>struct ] }
|
||||
[ 2drop f ]
|
||||
} case ;
|
||||
|
||||
M: windows addrspec-of-family ( af -- addrspec )
|
||||
{
|
||||
{ AF_INET [ T{ inet4 } ] }
|
||||
{ AF_INET6 [ T{ inet6 } ] }
|
||||
[ drop f ]
|
||||
} case ;
|
||||
|
||||
HOOK: WSASocket-flags io-backend ( -- DWORD )
|
||||
|
||||
TUPLE: win32-socket < win32-file ;
|
||||
|
@ -13,8 +31,7 @@ M: win32-socket dispose ( stream -- )
|
|||
handle>> closesocket drop ;
|
||||
|
||||
: unspecific-sockaddr/size ( addrspec -- sockaddr len )
|
||||
[ empty-sockaddr/size ] [ protocol-family ] bi
|
||||
pick set-sockaddr-in-family ;
|
||||
[ empty-sockaddr/size ] [ protocol-family ] bi pick (>>family) ;
|
||||
|
||||
: opened-socket ( handle -- win32-socket )
|
||||
<win32-socket> |dispose dup add-completion ;
|
||||
|
@ -56,6 +73,3 @@ M: object (server) ( addrspec -- handle )
|
|||
|
||||
M: windows (datagram) ( addrspec -- handle )
|
||||
[ SOCK_DGRAM server-socket ] with-destructors ;
|
||||
|
||||
M: windows addrinfo-error ( n -- )
|
||||
winsock-return-check ;
|
||||
|
|
|
@ -69,10 +69,9 @@ MACRO: match-cond ( assoc -- )
|
|||
dup length zero? not [ rest ] [ drop f ] if ;
|
||||
|
||||
: (match-first) ( seq pattern-seq -- bindings leftover/f )
|
||||
2dup [ length ] bi@ < [ 2drop f f ]
|
||||
[
|
||||
2dup shorter? [ 2drop f f ] [
|
||||
2dup length head over match
|
||||
[ nip swap ?1-tail ] [ [ rest ] dip (match-first) ] if*
|
||||
[ swap ?1-tail ] [ [ rest ] dip (match-first) ] ?if
|
||||
] if ;
|
||||
|
||||
: match-first ( seq pattern-seq -- bindings )
|
||||
|
@ -80,10 +79,7 @@ MACRO: match-cond ( assoc -- )
|
|||
|
||||
: (match-all) ( seq pattern-seq -- )
|
||||
[ nip ] [ (match-first) swap ] 2bi
|
||||
[
|
||||
, [ swap (match-all) ] [ drop ] if*
|
||||
] [ 2drop ] if* ;
|
||||
[ , [ swap (match-all) ] [ drop ] if* ] [ 2drop ] if* ;
|
||||
|
||||
: match-all ( seq pattern-seq -- bindings-seq )
|
||||
[ (match-all) ] { } make ;
|
||||
|
||||
|
|
|
@ -1,15 +1,11 @@
|
|||
! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.strings alien.syntax arrays
|
||||
byte-arrays kernel math sequences windows.types windows.kernel32
|
||||
windows.errors math.bitwise io.encodings.utf16n classes.struct
|
||||
literals windows.com.syntax ;
|
||||
byte-arrays kernel literals math sequences windows.types
|
||||
windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
|
||||
classes.struct windows.com.syntax init ;
|
||||
IN: windows.winsock
|
||||
|
||||
USE: libc
|
||||
: alien>byte-array ( alien str -- byte-array )
|
||||
heap-size dup <byte-array> [ -rot memcpy ] keep ;
|
||||
|
||||
TYPEDEF: void* SOCKET
|
||||
|
||||
: <wsadata> ( -- byte-array )
|
||||
|
@ -30,7 +26,7 @@ CONSTANT: SO_BROADCAST HEX: 20
|
|||
CONSTANT: SO_USELOOPBACK HEX: 40
|
||||
CONSTANT: SO_LINGER HEX: 80
|
||||
CONSTANT: SO_OOBINLINE HEX: 100
|
||||
CONSTANT: SO_DONTLINGER $[ SO_LINGER bitnot ]
|
||||
: SO_DONTLINGER ( -- n ) SO_LINGER bitnot ; inline
|
||||
|
||||
CONSTANT: SO_SNDBUF HEX: 1001
|
||||
CONSTANT: SO_RCVBUF HEX: 1002
|
||||
|
@ -75,7 +71,9 @@ CONSTANT: PF_INET6 23
|
|||
CONSTANT: AI_PASSIVE 1
|
||||
CONSTANT: AI_CANONNAME 2
|
||||
CONSTANT: AI_NUMERICHOST 4
|
||||
CONSTANT: AI_MASK $[ { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ]
|
||||
|
||||
: AI_MASK ( -- n )
|
||||
{ AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
|
||||
|
||||
CONSTANT: NI_NUMERICHOST 1
|
||||
CONSTANT: NI_NUMERICSERV 2
|
||||
|
@ -96,7 +94,8 @@ ALIAS: WSA_IO_PENDING ERROR_IO_PENDING
|
|||
|
||||
CONSTANT: INADDR_ANY 0
|
||||
|
||||
CONSTANT: INVALID_SOCKET $[ -1 <alien> ]
|
||||
: INVALID_SOCKET ( -- n ) -1 <alien> ; inline
|
||||
|
||||
CONSTANT: SOCKET_ERROR -1
|
||||
|
||||
CONSTANT: SD_RECV 0
|
||||
|
@ -105,10 +104,6 @@ CONSTANT: SD_BOTH 2
|
|||
|
||||
CONSTANT: SOL_SOCKET HEX: ffff
|
||||
|
||||
! TYPEDEF: uint in_addr_t
|
||||
! C-STRUCT: in_addr
|
||||
! { "in_addr_t" "s_addr" } ;
|
||||
|
||||
STRUCT: sockaddr-in
|
||||
{ family short }
|
||||
{ port ushort }
|
||||
|
@ -379,7 +374,17 @@ LIBRARY: mswsock
|
|||
|
||||
! Not in Windows CE
|
||||
FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ;
|
||||
FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, void* f, void* g, void* h ) ;
|
||||
|
||||
FUNCTION: void GetAcceptExSockaddrs (
|
||||
PVOID lpOutputBuffer,
|
||||
DWORD dwReceiveDataLength,
|
||||
DWORD dwLocalAddressLength,
|
||||
DWORD dwRemoteAddressLength,
|
||||
LPSOCKADDR* LocalSockaddr,
|
||||
LPINT LocalSockaddrLength,
|
||||
LPSOCKADDR* RemoteSockaddr,
|
||||
LPINT RemoteSockaddrLength
|
||||
) ;
|
||||
|
||||
CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
|
||||
|
||||
|
@ -431,3 +436,5 @@ CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
|
|||
|
||||
: init-winsock ( -- )
|
||||
HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
|
||||
|
||||
[ init-winsock ] "windows.winsock" add-init-hook
|
||||
|
|
|
@ -4,12 +4,16 @@ USING: alien alien.libraries alien.syntax kernel sequences words system
|
|||
combinators ;
|
||||
IN: opengl.glu
|
||||
|
||||
<<
|
||||
|
||||
os {
|
||||
{ [ dup macosx? ] [ drop ] }
|
||||
{ [ dup windows? ] [ drop ] }
|
||||
{ [ dup unix? ] [ drop "glu" "libGLU.so.1" "cdecl" add-library ] }
|
||||
} cond
|
||||
|
||||
>>
|
||||
|
||||
LIBRARY: glu
|
||||
|
||||
! These are defined as structs in glu.h, but we only ever use pointers to them
|
||||
|
|
Loading…
Reference in New Issue