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

Clean up some of Dan's code after merge

db4
Slava Pestov 2008-03-06 15:58:05 -06:00
parent d95231cc43
commit 549a7538c7
13 changed files with 92 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
core/bootstrap/primitives.factor
View File

@ -623,6 +623,7 @@ builtins get num-tags get tail f union-class define-class
{ "fopen" "io.streams.c" }
{ "fgetc" "io.streams.c" }
{ "fread" "io.streams.c" }
{ "fputc" "io.streams.c" }
{ "fwrite" "io.streams.c" }
{ "fflush" "io.streams.c" }
{ "fclose" "io.streams.c" }

2
core/inference/known-words/known-words.factor
View File

@ -538,6 +538,8 @@ set-primitive-effect
\ fwrite { string alien } { } <effect> set-primitive-effect
\ fputc { object alien } { } <effect> set-primitive-effect
\ fread { integer string } { object } <effect> set-primitive-effect
\ fflush { alien } { } <effect> set-primitive-effect

9
core/io/io-tests.factor Normal file → Executable file
View File

@ -1,5 +1,6 @@
USING: arrays io io.files kernel math parser strings system
tools.test words namespaces io.encodings.ascii io.encodings.binary ;
tools.test words namespaces io.encodings.latin1
io.encodings.binary ;
IN: io.tests
[ f ] [
@ -8,7 +9,7 @@ IN: io.tests
] unit-test
: <resource-reader> ( resource -- stream )
resource-path binary <file-reader> ;
resource-path latin1 <file-reader> ;
[
"This is a line.\rThis is another line.\r"
@ -31,10 +32,10 @@ IN: io.tests
! [ ] [ "123" write 9000 CHAR: x <string> write flush ] unit-test
[ "" ] [
[
"/core/io/test/binary.txt" <resource-reader>
[ 0.2 read ] with-stream
] unit-test
] must-fail
[
{

4
core/io/streams/c/c-tests.factor
View File

@ -1,4 +1,5 @@
USING: tools.test io.files io io.streams.c io.encodings.ascii ;
USING: tools.test io.files io io.streams.c
io.encodings.ascii strings ;
IN: io.streams.c.tests
[ "hello world" ] [
@ -7,4 +8,5 @@ IN: io.streams.c.tests
] with-file-writer
"test.txt" temp-file "rb" fopen <c-reader> contents
>string
] unit-test

17
core/io/streams/c/c.factor
View File

@ -1,9 +1,8 @@
! Copyright (C) 2004, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel kernel.private namespaces io io.encodings
strings sequences math generic threads.private classes
io.backend io.streams.duplex io.files continuations
io.encodings.utf8 ;
sequences math generic threads.private classes io.backend
io.streams.duplex io.files continuations byte-arrays ;
IN: io.streams.c
TUPLE: c-writer handle ;
@ -11,10 +10,10 @@ TUPLE: c-writer handle ;
C: <c-writer> c-writer
M: c-writer stream-write1
>r 1string r> stream-write ;
c-writer-handle fputc ;
M: c-writer stream-write
>r >string r> c-writer-handle fwrite ;
c-writer-handle fwrite ;
M: c-writer stream-flush
c-writer-handle fflush ;
@ -27,7 +26,7 @@ TUPLE: c-reader handle ;
C: <c-reader> c-reader
M: c-reader stream-read
>r >fixnum r> c-reader-handle fread ;
c-reader-handle fread ;
M: c-reader stream-read-partial
stream-read ;
@ -43,7 +42,7 @@ M: c-reader stream-read1
] if ;
M: c-reader stream-read-until
[ swap read-until-loop ] "" make swap
[ swap read-until-loop ] B{ } make swap
over empty? over not and [ 2drop f f ] when ;
M: c-reader dispose
@ -76,4 +75,6 @@ M: object (file-appender)
#! print stuff from contexts where the I/O system would
#! otherwise not work (tools.deploy.shaker, the I/O
#! multiplexer thread).
"\r\n" append stdout-handle fwrite stdout-handle fflush ;
"\r\n" append >byte-array
stdout-handle fwrite
stdout-handle fflush ;

4
extra/http/server/server.factor
View File

@ -4,7 +4,7 @@ USING: assocs kernel namespaces io io.timeouts strings splitting
threads http sequences prettyprint io.server logging calendar
new-slots html.elements accessors math.parser combinators.lib
vocabs.loader debugger html continuations random combinators
destructors ;
destructors io.encodings.latin1 ;
IN: http.server
GENERIC: call-responder ( request path responder -- response )
@ -165,7 +165,7 @@ LOG: httpd-hit NOTICE
: httpd ( port -- )
internet-server "http.server"
binary [ handle-client ] with-server ;
latin1 [ handle-client ] with-server ;
: httpd-main ( -- ) 8888 httpd ;

22
extra/io/nonblocking/nonblocking.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license.
IN: io.nonblocking
USING: math kernel io sequences io.buffers io.timeouts generic
sbufs system io.streams.duplex io.encodings
byte-vectors system io.streams.duplex io.encodings
io.backend continuations debugger classes byte-arrays namespaces
splitting dlists assocs io.encodings.binary ;
@ -71,7 +71,7 @@ GENERIC: (wait-to-read) ( port -- )
M: input-port stream-read1
dup wait-to-read1 [ buffer-pop ] unless-eof ;
: read-step ( count port -- string/f )
: read-step ( count port -- byte-array/f )
[ wait-to-read ] 2keep
[ dupd buffer> ] unless-eof nip ;
@ -90,10 +90,10 @@ M: input-port stream-read
>r 0 max >fixnum r>
2dup read-step dup [
pick over length > [
pick <sbuf>
pick <byte-vector>
[ push-all ] keep
[ read-loop ] keep
"" like
B{ } like
] [
2nip
] if
@ -101,7 +101,7 @@ M: input-port stream-read
2nip
] if ;
: read-until-step ( separators port -- string/f separator/f )
: read-until-step ( separators port -- byte-array/f separator/f )
dup wait-to-read1
dup port-eof? [
f swap set-port-eof? drop f f
@ -109,7 +109,7 @@ M: input-port stream-read
buffer-until
] if ;
: read-until-loop ( seps port sbuf -- separator/f )
: read-until-loop ( seps port byte-vector -- separator/f )
2over read-until-step over [
>r over push-all r> dup [
>r 3drop r>
@ -120,18 +120,20 @@ M: input-port stream-read
>r 2drop 2drop r>
] if ;
M: input-port stream-read-until ( seps port -- str/f sep/f )
M: input-port stream-read-until ( seps port -- byte-array/f sep/f )
2dup read-until-step dup [
>r 2nip r>
] [
over [
drop >sbuf [ read-until-loop ] keep "" like swap
drop >byte-vector
[ read-until-loop ] keep
B{ } like swap
] [
>r 2nip r>
] if
] if ;
M: input-port stream-read-partial ( max stream -- string/f )
M: input-port stream-read-partial ( max stream -- byte-array/f )
>r 0 max >fixnum r> read-step ;
: can-write? ( len writer -- ? )
@ -169,7 +171,7 @@ M: port dispose
[ dup port-type >r closed over set-port-type r> close-port ]
if ;
TUPLE: server-port addr client encoding ;
TUPLE: server-port addr client client-addr encoding ;
: <server-port> ( handle addr encoding -- server )
rot f server-port <port>

8
extra/io/sockets/sockets.factor
View File

@ -33,17 +33,19 @@ M: array client* [ (client) 2array ] attempt-all first2 ;
M: object client* (client) ;
: <client> ( addrspec encoding -- stream )
over client* rot <encoder-duplex> <client-stream> ;
>r client* r> <encoder-duplex> ;
HOOK: (server) io-backend ( addrspec -- handle )
: <server> ( addrspec encoding -- server )
>r [ (server) ] keep r> <server-port> ;
HOOK: (accept) io-backend ( server -- stream-in stream-out )
HOOK: (accept) io-backend ( server -- addrspec handle )
: accept ( server -- client )
[ (accept) ] keep server-port-encoding <encoder-duplex> ;
[ (accept) dup <reader&writer> ] keep
server-port-encoding <encoder-duplex>
<client-stream> ;
HOOK: <datagram> io-backend ( addrspec -- datagram )

16
extra/io/unix/sockets/sockets.factor
View File

@ -42,7 +42,7 @@ M: connect-task do-io-task
: wait-to-connect ( port -- )
[ <connect-task> add-io-task ] with-port-continuation drop ;
M: unix-io (client) ( addrspec -- stream )
M: unix-io (client) ( addrspec -- client-in client-out )
dup make-sockaddr/size >r >r
protocol-family SOCK_STREAM socket-fd
dup r> r> connect
@ -71,10 +71,10 @@ TUPLE: accept-task ;
dup <c-object> [ swap heap-size <int> accept ] keep ; inline
: do-accept ( port fd sockaddr -- )
rot [
server-port-addr parse-sockaddr
swap dup <reader&writer> <duplex-stream> <client-stream>
] keep set-server-port-client ;
rot
[ server-port-addr parse-sockaddr ] keep
[ set-server-port-client-addr ] keep
set-server-port-client ;
M: accept-task do-io-task
io-task-port dup accept-sockaddr
@ -95,13 +95,13 @@ M: unix-io (server) ( addrspec -- handle )
SOCK_STREAM server-fd
dup 10 listen zero? [ dup close (io-error) ] unless ;
M: unix-io (accept) ( server -- client-in client-out )
M: unix-io (accept) ( server -- addrspec handle )
#! Wait for a client connection.
dup check-server-port
dup wait-to-accept
dup pending-error
server-port-client
{ duplex-stream-in duplex-stream-out } get-slots ;
dup server-port-client-addr
swap server-port-client ;
! Datagram sockets - UDP and Unix domain
M: unix-io <datagram>

29
extra/io/windows/nt/sockets/sockets.factor
View File

@ -45,13 +45,12 @@ TUPLE: ConnectEx-args port
"stdcall" alien-indirect drop
winsock-error-string [ throw ] when* ;
: connect-continuation ( ConnectEx -- )
dup ConnectEx-args-lpOverlapped*
swap ConnectEx-args-port duplex-stream-in
[ save-callback ] 2keep
: connect-continuation ( ConnectEx port -- )
>r ConnectEx-args-lpOverlapped* r>
2dup save-callback
get-overlapped-result drop ;
M: windows-nt-io (client) ( addrspec -- duplex-stream )
M: windows-nt-io (client) ( addrspec -- client-in client-out )
[
\ ConnectEx-args construct-empty
over make-sockaddr/size pick init-connect
@ -61,14 +60,8 @@ M: windows-nt-io (client) ( addrspec -- duplex-stream )
dup ConnectEx-args-s* INADDR_ANY roll bind-socket
dup (ConnectEx)
dup ConnectEx-args-s* <win32-socket>
dup <reader&writer> <duplex-stream>
over set-ConnectEx-args-port
dup connect-continuation
ConnectEx-args-port
[ duplex-stream-in pending-error ] keep
[ duplex-stream-out pending-error ] keep
dup ConnectEx-args-s* <win32-socket> dup <reader&writer>
>r [ connect-continuation ] keep [ pending-error ] keep r>
] with-destructors ;
TUPLE: AcceptEx-args port
@ -118,17 +111,15 @@ TUPLE: AcceptEx-args port
] keep *void*
] keep AcceptEx-args-port server-port-addr parse-sockaddr ;
: accept-continuation ( AcceptEx -- client )
: accept-continuation ( AcceptEx -- addrspec client )
[ make-accept-continuation ] keep
[ check-accept-error ] keep
[ extract-remote-host ] keep
! addrspec AcceptEx
[
AcceptEx-args-sAcceptSocket* add-completion
] keep
[ AcceptEx-args-sAcceptSocket* add-completion ] keep
AcceptEx-args-sAcceptSocket* <win32-socket> ;
M: windows-nt-io (accept) ( server -- client-in client-out )
M: windows-nt-io (accept) ( server -- addrspec handle )
[
[
dup check-server-port
@ -137,8 +128,6 @@ M: windows-nt-io (accept) ( server -- client-in client-out )
[ ((accept)) ] keep
[ accept-continuation ] keep
AcceptEx-args-port pending-error
dup duplex-stream-in pending-error
dup duplex-stream-out pending-error
] with-timeout
] with-destructors ;

39
vm/io.c
View File

@ -102,21 +102,46 @@ DEFINE_PRIMITIVE(fread)
}
else
{
dpush(tag_object(memory_to_char_string(
(char *)(buf + 1),c)));
if(c != size)
{
REGISTER_UNTAGGED(buf);
F_BYTE_ARRAY *new_buf = allot_byte_array(c);
UNREGISTER_UNTAGGED(buf);
memcpy(new_buf + 1, buf + 1,c);
buf = new_buf;
}
dpush(tag_object(buf));
break;
}
}
}
DEFINE_PRIMITIVE(fputc)
{
FILE *file = unbox_alien();
F_FIXNUM ch = to_fixnum(dpop());
for(;;)
{
if(fputc(ch,file) == EOF)
{
io_error();
/* Still here? EINTR */
}
else
break;
}
}
DEFINE_PRIMITIVE(fwrite)
{
FILE* file = unbox_alien();
F_STRING* text = untag_string(dpop());
F_FIXNUM length = untag_fixnum_fast(text->length);
char* string = to_char_string(text,false);
FILE *file = unbox_alien();
F_BYTE_ARRAY *text = untag_byte_array(dpop());
F_FIXNUM length = array_capacity(text);
char *string = (char *)(text + 1);
if(string_capacity(text) == 0)
if(length == 0)
return;
for(;;)

5
vm/io.h
View File

@ -3,11 +3,12 @@ void io_error(void);
int err_no(void);
DECLARE_PRIMITIVE(fopen);
DECLARE_PRIMITIVE(fgetc);
DECLARE_PRIMITIVE(fread);
DECLARE_PRIMITIVE(fputc);
DECLARE_PRIMITIVE(fwrite);
DECLARE_PRIMITIVE(fflush);
DECLARE_PRIMITIVE(fclose);
DECLARE_PRIMITIVE(fgetc);
DECLARE_PRIMITIVE(fread);
/* Platform specific primitives */
DECLARE_PRIMITIVE(open_file);

1
vm/primitives.c
View File

@ -162,6 +162,7 @@ void *primitives[] = {
primitive_fopen,
primitive_fgetc,
primitive_fread,
primitive_fputc,
primitive_fwrite,
primitive_fflush,
primitive_fclose,