Strip out C I/O if native I/O enabled
parent
15eaf33ee8
commit
2e48915f9c
|
@ -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>
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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 ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 -- )
|
||||||
|
|
Loading…
Reference in New Issue