Strip out C I/O if native I/O enabled

db4
Slava Pestov 2008-10-02 03:38:36 -05:00
parent 15eaf33ee8
commit 2e48915f9c
7 changed files with 53 additions and 35 deletions

View File

@ -17,10 +17,12 @@ IN: io.sockets
! Addressing ! Addressing
GENERIC: protocol-family ( addrspec -- af ) GENERIC: protocol-family ( addrspec -- af )
GENERIC: sockaddr-type ( addrspec -- type ) GENERIC: sockaddr-size ( addrspec -- n )
GENERIC: make-sockaddr ( addrspec -- sockaddr ) GENERIC: make-sockaddr ( addrspec -- sockaddr )
GENERIC: empty-sockaddr ( addrspec -- sockaddr )
GENERIC: address-size ( addrspec -- n ) GENERIC: address-size ( addrspec -- n )
GENERIC: inet-ntop ( data addrspec -- str ) GENERIC: inet-ntop ( data addrspec -- str )
@ -28,10 +30,10 @@ GENERIC: inet-ntop ( data addrspec -- str )
GENERIC: inet-pton ( str addrspec -- data ) GENERIC: inet-pton ( str addrspec -- data )
: make-sockaddr/size ( addrspec -- sockaddr size ) : make-sockaddr/size ( addrspec -- sockaddr size )
[ make-sockaddr ] [ sockaddr-type heap-size ] bi ; [ make-sockaddr ] [ sockaddr-size ] bi ;
: empty-sockaddr/size ( addrspec -- sockaddr size ) : empty-sockaddr/size ( addrspec -- sockaddr size )
sockaddr-type [ <c-object> ] [ heap-size ] bi ; [ empty-sockaddr ] [ sockaddr-size ] bi ;
GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec ) GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
@ -74,7 +76,9 @@ M: inet4 address-size drop 4 ;
M: inet4 protocol-family drop PF_INET ; M: inet4 protocol-family drop PF_INET ;
M: inet4 sockaddr-type drop "sockaddr-in" c-type ; M: inet4 sockaddr-size drop "sockaddr-in" heap-size ;
M: inet4 empty-sockaddr drop "sockaddr-in" <c-object> ;
M: inet4 make-sockaddr ( inet -- sockaddr ) M: inet4 make-sockaddr ( inet -- sockaddr )
"sockaddr-in" <c-object> "sockaddr-in" <c-object>
@ -128,7 +132,9 @@ M: inet6 address-size drop 16 ;
M: inet6 protocol-family drop PF_INET6 ; M: inet6 protocol-family drop PF_INET6 ;
M: inet6 sockaddr-type drop "sockaddr-in6" c-type ; M: inet6 sockaddr-size drop "sockaddr-in6" heap-size ;
M: inet6 empty-sockaddr drop "sockaddr-in6" <c-object> ;
M: inet6 make-sockaddr ( inet -- sockaddr ) M: inet6 make-sockaddr ( inet -- sockaddr )
"sockaddr-in6" <c-object> "sockaddr-in6" <c-object>

View File

@ -139,7 +139,9 @@ M: unix (send) ( packet addrspec datagram -- )
! Unix domain sockets ! Unix domain sockets
M: local protocol-family drop PF_UNIX ; M: local protocol-family drop PF_UNIX ;
M: local sockaddr-type drop "sockaddr-un" c-type ; M: local sockaddr-size drop "sockaddr-un" heap-size ;
M: local empty-sockaddr drop "sockaddr-un" <c-object> ;
M: local make-sockaddr M: local make-sockaddr
path>> (normalize-path) path>> (normalize-path)

View File

@ -1,9 +1,9 @@
USING: alien alien.c-types arrays assocs combinators USING: alien alien.c-types arrays assocs combinators
continuations destructors io io.backend io.ports io.timeouts continuations destructors io io.backend io.ports io.timeouts
io.windows io.windows.files libc kernel math namespaces io.windows io.windows.files io.files io.buffers io.streams.c
sequences threads windows windows.errors windows.kernel32 libc kernel math namespaces sequences threads windows
strings splitting io.files io.buffers qualified ascii system windows.errors windows.kernel32 strings splitting qualified
accessors locals ; ascii system accessors locals ;
QUALIFIED: windows.winsock QUALIFIED: windows.winsock
IN: io.windows.nt.backend IN: io.windows.nt.backend
@ -120,3 +120,5 @@ M: winnt (wait-to-read) ( port -- )
[ finish-read ] [ finish-read ]
tri tri
] with-destructors ; ] with-destructors ;
M: winnt (init-stdio) init-c-stdio ;

View File

@ -71,7 +71,7 @@ TUPLE: AcceptEx-args port
dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ; dwLocalAddressLength dwRemoteAddressLength lpdwBytesReceived lpOverlapped ;
: init-accept-buffer ( addr AcceptEx -- ) : init-accept-buffer ( addr AcceptEx -- )
swap sockaddr-type heap-size 16 + swap sockaddr-size 16 +
[ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi [ >>dwLocalAddressLength ] [ >>dwRemoteAddressLength ] bi
dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer dup dwLocalAddressLength>> 2 * malloc &free >>lpOutputBuffer
drop ; inline drop ; inline
@ -135,7 +135,7 @@ TUPLE: WSARecvFrom-args port
WSARecvFrom-args new WSARecvFrom-args new
swap >>port swap >>port
dup port>> handle>> handle>> >>s dup port>> handle>> handle>> >>s
dup port>> addr>> sockaddr-type heap-size dup port>> addr>> sockaddr-size
[ malloc &free >>lpFrom ] [ malloc &free >>lpFrom ]
[ malloc-int &free >>lpFromLen ] bi [ malloc-int &free >>lpFromLen ] bi
make-receive-buffer >>lpBuffers make-receive-buffer >>lpBuffers

View File

@ -1,19 +1,18 @@
! Copyright (C) 2007, 2008 Slava Pestov. ! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors qualified io.streams.c init fry namespaces make USING: accessors qualified io.backend io.streams.c init fry
assocs kernel parser lexer strings.parser tools.deploy.config namespaces make assocs kernel parser lexer strings.parser
vocabs sequences words words.private memory kernel.private tools.deploy.config vocabs sequences words words.private memory
continuations io prettyprint vocabs.loader debugger system kernel.private continuations io prettyprint vocabs.loader
strings sets vectors quotations byte-arrays sorting ; debugger system strings sets vectors quotations byte-arrays
sorting compiler.units definitions ;
QUALIFIED: bootstrap.stage2 QUALIFIED: bootstrap.stage2
QUALIFIED: classes QUALIFIED: classes
QUALIFIED: command-line QUALIFIED: command-line
QUALIFIED: compiler.errors.private QUALIFIED: compiler.errors.private
QUALIFIED: compiler.units
QUALIFIED: continuations QUALIFIED: continuations
QUALIFIED: definitions QUALIFIED: definitions
QUALIFIED: init QUALIFIED: init
QUALIFIED: io.backend
QUALIFIED: io.thread QUALIFIED: io.thread
QUALIFIED: layouts QUALIFIED: layouts
QUALIFIED: listener QUALIFIED: listener
@ -198,11 +197,6 @@ IN: tools.deploy.shaker
strip-word-names? [ dup strip-word-names ] when strip-word-names? [ dup strip-word-names ] when
2drop ; 2drop ;
: strip-recompile-hook ( -- )
[ [ f ] { } map>assoc ]
compiler.units:recompile-hook
set-global ;
: strip-vocab-globals ( except names -- words ) : strip-vocab-globals ( except names -- words )
[ child-vocabs [ words ] map concat ] map concat swap diff ; [ child-vocabs [ words ] map concat ] map concat swap diff ;
@ -233,7 +227,7 @@ IN: tools.deploy.shaker
"initial-thread" "threads" lookup , "initial-thread" "threads" lookup ,
] unless ] unless
strip-io? [ io.backend:io-backend , ] when strip-io? [ io-backend , ] when
{ } { { } {
"alarms" "alarms"
@ -260,9 +254,9 @@ IN: tools.deploy.shaker
command-line:main-vocab-hook command-line:main-vocab-hook
compiled-crossref compiled-crossref
compiled-generic-crossref compiled-generic-crossref
compiler.units:recompile-hook recompile-hook
compiler.units:update-tuples-hook update-tuples-hook
compiler.units:definition-observers definition-observers
definitions:crossref definitions:crossref
interactive-vocabs interactive-vocabs
layouts:num-tags layouts:num-tags
@ -326,6 +320,14 @@ IN: tools.deploy.shaker
21 setenv 21 setenv
] [ drop ] if ; ] [ drop ] if ;
: strip-c-io ( -- )
deploy-io get 2 = [
[
c-io-backend forget
"io.streams.c" forget-vocab
] with-compilation-unit
] unless ;
: compress ( pred string -- ) : compress ( pred string -- )
"Compressing " prepend show "Compressing " prepend show
instances instances
@ -362,10 +364,10 @@ SYMBOL: deploy-vocab
set-boot-quot ; set-boot-quot ;
: strip ( -- ) : strip ( -- )
strip-c-io
strip-libc strip-libc
strip-cocoa strip-cocoa
strip-debugger strip-debugger
strip-recompile-hook
strip-init-hooks strip-init-hooks
deploy-vocab get vocab-main set-boot-quot* deploy-vocab get vocab-main set-boot-quot*
stripped-word-props >r stripped-word-props >r

View File

@ -6,6 +6,10 @@ IN: io.backend
SYMBOL: io-backend SYMBOL: io-backend
SINGLETON: c-io-backend
c-io-backend io-backend set-global
HOOK: init-io io-backend ( -- ) HOOK: init-io io-backend ( -- )
HOOK: (init-stdio) io-backend ( -- stdin stdout stderr ) HOOK: (init-stdio) io-backend ( -- stdin stdout stderr )

View File

@ -54,26 +54,28 @@ M: c-reader stream-read-until
M: c-reader dispose* M: c-reader dispose*
handle>> fclose ; handle>> fclose ;
M: object init-io ; M: c-io-backend init-io ;
: stdin-handle 11 getenv ; : stdin-handle 11 getenv ;
: stdout-handle 12 getenv ; : stdout-handle 12 getenv ;
: stderr-handle 61 getenv ; : stderr-handle 61 getenv ;
M: object (init-stdio) : init-c-stdio ( -- stdin stdout stderr )
stdin-handle <c-reader> stdin-handle <c-reader>
stdout-handle <c-writer> stdout-handle <c-writer>
stderr-handle <c-writer> ; stderr-handle <c-writer> ;
M: object io-multiplex 60 60 * 1000 * or (sleep) ; M: c-io-backend (init-stdio) init-c-stdio ;
M: object (file-reader) M: c-io-backend io-multiplex 60 60 * 1000 * or (sleep) ;
M: c-io-backend (file-reader)
"rb" fopen <c-reader> ; "rb" fopen <c-reader> ;
M: object (file-writer) M: c-io-backend (file-writer)
"wb" fopen <c-writer> ; "wb" fopen <c-writer> ;
M: object (file-appender) M: c-io-backend (file-appender)
"ab" fopen <c-writer> ; "ab" fopen <c-writer> ;
: show ( msg -- ) : show ( msg -- )