Merge branch 'master' into ppc-float-compare

db4
Joe Groff 2009-09-04 11:00:18 -05:00
commit ee38639c97
15 changed files with 195 additions and 156 deletions

View File

@ -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 }
}
] [

View File

@ -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) ] }

View File

@ -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 ;

View File

@ -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 [

View File

@ -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 ;

View File

@ -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

View File

@ -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

7
basis/io/sockets/sockets-tests.factor Normal file → Executable file
View File

@ -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

138
basis/io/sockets/sockets.factor Normal file → Executable file
View File

@ -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*>

51
basis/io/sockets/unix/unix.factor Normal file → Executable file
View File

@ -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 ] [

View File

@ -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 )
[

28
basis/io/sockets/windows/windows.factor Normal file → Executable file
View File

@ -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 ;

View File

@ -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 ;

View File

@ -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

View File

@ -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