diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 5e330c68f6..947ad2f140 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -21,8 +21,6 @@ + ffi: - char* struct members -- if a boxer triggers GC, already-pushed addresses might become - invalid! - box/unbox_signed/unsigned_8 - ffi unicode strings: null char security hole - utf16 string boxing @@ -88,6 +86,7 @@ - generational gc - doc comments of generics - proper ordering for classes +- M: object should not inhibit delegation + i/o: @@ -97,14 +96,12 @@ GENERIC: set-style ( style stream -- ) GENERIC: stream-write GENERIC: stream-write-char -- linux/ppc and mac os x ffi +- mac os x ffi - stream server can hang because of exception handler limitations - better i/o scheduler - add a socket timeout -- get sockets working - renumber types appopriately - linux? freebsd? words, linux i/o stuff -- clean up errors - implement fcopy - unify unparse and prettyprint diff --git a/library/alien/structs.factor b/library/alien/structs.factor index d1d144efbc..ff5fe835d1 100644 --- a/library/alien/structs.factor +++ b/library/alien/structs.factor @@ -79,3 +79,10 @@ math namespaces parser strings words ; : END-UNION ( max -- ) define-struct-type ; parsing + +BEGIN-STRUCT: int-box + FIELD: int i +END-STRUCT + +: box-int ( n -- box ) + [ set-int-box-i ] keep ; diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor index 65bb7fe833..c18cf915db 100644 --- a/library/httpd/httpd.factor +++ b/library/httpd/httpd.factor @@ -47,8 +47,8 @@ stdio streams strings threads url-encoding ; : httpd-client ( socket -- ) [ - [ - stdio get log-client read-line [ parse-request ] when* + dup log-client [ + read-line [ parse-request ] when* ] with-stream ] try ; @@ -58,11 +58,13 @@ stdio streams strings threads url-encoding ; : httpd-loop ( -- ) httpd-connection httpd-loop ; : httpd ( port -- ) - "http-server" set [ - httpd-loop - ] [ - "http-server" get stream-close rethrow - ] catch ; + [ + "http-server" set [ + httpd-loop + ] [ + "http-server" get stream-close rethrow + ] catch + ] with-logging ; : stop-httpd ( -- ) #! Stop the server. diff --git a/library/io/logging.factor b/library/io/logging.factor index 14f2e1558d..d61498f441 100644 --- a/library/io/logging.factor +++ b/library/io/logging.factor @@ -8,24 +8,26 @@ SYMBOL: log-stream : log ( msg -- ) #! Log a message to the log stream, either stdio or a file. - log-stream get dup [ - tuck stream-print stream-flush + log-stream get [ + [ stream-print ] keep stream-flush ] [ - 2drop - ] ifte ; - -: with-logging ( file quot -- ) - #! Calls to log inside quot will output to a file. - [ swap log-stream set call ] with-scope ; - -! Helpful words. + print flush + ] ifte* ; : log-error ( error -- ) "Error: " swap cat2 log ; : log-client ( client-stream -- ) [ "Accepted connection from " % - ( dup ) client-stream-host % - ! CHAR: : , - ! client-stream-port unparse % + dup client-stream-host % + CHAR: : , + client-stream-port unparse % ] make-string log ; + +: with-log-file ( file quot -- ) + #! Calls to log inside quot will output to a file. + [ swap log-stream set call ] with-scope ; + +: with-logging ( quot -- ) + #! Calls to log inside quot will output to stdio. + [ stdio get log-stream set call ] with-scope ; diff --git a/library/sdl/sdl-ttf.factor b/library/sdl/sdl-ttf.factor index 67cb7b48fc..281c113c41 100644 --- a/library/sdl/sdl-ttf.factor +++ b/library/sdl/sdl-ttf.factor @@ -53,10 +53,6 @@ USE: alien : TTF_FontFaceStyleName ( font -- n ) "char*" "sdl-ttf" "TTF_FontFaceStyleName" [ "void*" ] alien-invoke ; -BEGIN-STRUCT: int-box - FIELD: int i -END-STRUCT - : TTF_SizeUNICODE ( font text w h -- ? ) "bool" "sdl-ttf" "TTF_SizeUNICODE" [ "void*" "ushort*" "int-box*" "int-box*" ] alien-invoke ; diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index a03ffa7d40..44338947cb 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -7,13 +7,6 @@ parser prettyprint stdio streams strings unparser vectors words ; : expired-error. ( obj -- ) "Object did not survive image save/load: " write . ; -: io-task-twice-error. ( obj -- ) - "Attempting to perform two simultaneous I/O operations on " - write . ; - -: no-io-tasks-error. ( obj -- ) - "No I/O tasks" print ; - : undefined-word-error. ( obj -- ) "Undefined word: " write . ; @@ -45,15 +38,9 @@ parser prettyprint stdio streams strings unparser vectors words ; : c-string-error. ( obj -- ) "Cannot convert to C string: " write . ; -: ffi-disabled-error. ( obj -- ) - drop "Recompile Factor with #define FFI." print ; - : ffi-error. ( obj -- ) "FFI: " write print ; -: port-closed-error. ( obj -- ) - "Port closed: " write . ; - : heap-scan-error. ( obj -- ) "Cannot do next-object outside begin/end-scan" write drop ; @@ -64,9 +51,6 @@ M: kernel-error error. ( error -- ) #! Kernel errors are indexed by integers. cdr uncons car swap { expired-error. - io-task-twice-error. - no-io-tasks-error. - f io-error. undefined-word-error. type-check-error. @@ -75,9 +59,7 @@ M: kernel-error error. ( error -- ) signal-error. negative-array-size-error. c-string-error. - ffi-disabled-error. ffi-error. - port-closed-error. heap-scan-error. } vector-nth execute ; diff --git a/library/unix/io.factor b/library/unix/io.factor index c4dfb0f9f2..a3a3115054 100644 --- a/library/unix/io.factor +++ b/library/unix/io.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: io-internals USING: errors generic hashtables kernel lists math -sequences stdio streams strings threads unix-internals vectors ; +sequences streams strings threads unix-internals vectors ; ! We want namespaces::bind to shadow the bind system call from ! unix-internals @@ -20,9 +20,14 @@ USING: namespaces ; TUPLE: port handle buffer error ; C: port ( handle buffer -- port ) - [ >r r> set-delegate ] keep + [ + >r dup 0 > [ ] [ drop f ] ifte r> set-delegate + ] keep [ >r dup init-handle r> set-port-handle ] keep ; +M: port stream-close ( port -- ) + dup port-handle close buffer-free ; + : buffered-port 8192 ; : >port< dup port-handle swap delegate ; @@ -118,8 +123,6 @@ C: reader ( handle -- reader ) "reader not ready" throw ] ifte ; -M: reader stream-close ( stream -- ) port-handle close ; - ! Reading lines : read-line-loop ( line buffer -- ? ) dup buffer-length 0 = [ @@ -311,7 +314,7 @@ M: writer stream-write-attr ( string style writer -- ) nip >r dup string? [ ch>string ] unless r> blocking-write ; M: writer stream-close ( stream -- ) - dup stream-flush dup port-handle close buffer-free ; + dup stream-flush delegate stream-close ; ! Make a duplex stream for reading/writing a pair of fds : ( infd outfd flush? -- stream ) @@ -337,6 +340,8 @@ M: writer stream-close ( stream -- ) 2drop f ] ifte ; +USE: stdio + : init-io ( -- ) #! Should only be called on startup. Calling this at any #! other time can have unintended consequences. diff --git a/library/unix/syscalls.factor b/library/unix/syscalls.factor index 11f5af694c..f91a1ee966 100644 --- a/library/unix/syscalls.factor +++ b/library/unix/syscalls.factor @@ -176,7 +176,7 @@ END-STRUCT "int" "libc" "listen" [ "int" "int" ] alien-invoke ; : accept ( s sockaddr socklen -- n ) - "int" "libc" "accept" [ "int" "sockaddr-in*" "socklen_t" ] alien-invoke ; + "int" "libc" "accept" [ "int" "sockaddr-in*" "int-box*" ] alien-invoke ; : inet-ntoa ( sockaddr -- string ) "char*" "libc" "inet_ntoa" [ "in_addr_t" ] alien-invoke ; diff --git a/native/error.h b/native/error.h index 7de1bca149..ac91238132 100644 --- a/native/error.h +++ b/native/error.h @@ -1,19 +1,14 @@ #define ERROR_EXPIRED (0<<3) -#define ERROR_IO_TASK_TWICE (1<<3) -#define ERROR_IO_TASK_NONE (2<<3) -#define ERROR_INCOMPATIBLE_PORT (3<<3) -#define ERROR_IO (4<<3) -#define ERROR_UNDEFINED_WORD (5<<3) -#define ERROR_TYPE (6<<3) -#define ERROR_RANGE (7<<3) -#define ERROR_FLOAT_FORMAT (8<<3) -#define ERROR_SIGNAL (9<<3) -#define ERROR_NEGATIVE_ARRAY_SIZE (10<<3) -#define ERROR_C_STRING (11<<3) -#define ERROR_FFI_DISABLED (12<<3) -#define ERROR_FFI (13<<3) -#define ERROR_CLOSED (14<<3) -#define ERROR_HEAP_SCAN (15<<3) +#define ERROR_IO (1<<3) +#define ERROR_UNDEFINED_WORD (2<<3) +#define ERROR_TYPE (3<<3) +#define ERROR_RANGE (4<<3) +#define ERROR_FLOAT_FORMAT (5<<3) +#define ERROR_SIGNAL (6<<3) +#define ERROR_NEGATIVE_ARRAY_SIZE (7<<3) +#define ERROR_C_STRING (8<<3) +#define ERROR_FFI (9<<3) +#define ERROR_HEAP_SCAN (10<<3) /* When throw_error throws an error, it sets this global and longjmps back to the top-level. */ diff --git a/native/unix/ffi.c b/native/unix/ffi.c index 54bc5e1b11..72c7b97a7b 100644 --- a/native/unix/ffi.c +++ b/native/unix/ffi.c @@ -2,7 +2,6 @@ void ffi_dlopen(DLL* dll) { -#ifdef FFI void* dllptr; dllptr = dlopen(to_c_string(untag_string(dll->path)), RTLD_LAZY); @@ -14,14 +13,10 @@ void ffi_dlopen(DLL* dll) } dll->dll = dllptr; -#else - general_error(ERROR_FFI_DISABLED,F); -#endif } void *ffi_dlsym(DLL *dll, F_STRING *symbol) { -#ifdef FFI void* sym = dlsym(dll ? dll->dll : NULL, to_c_string(symbol)); if(sym == NULL) { @@ -29,22 +24,15 @@ void *ffi_dlsym(DLL *dll, F_STRING *symbol) from_c_string(dlerror()))); } return sym; -#else - general_error(ERROR_FFI_DISABLED,F); -#endif } void ffi_dlclose(DLL *dll) { -#ifdef FFI if(dlclose(dll->dll) == -1) { general_error(ERROR_FFI,tag_object( from_c_string(dlerror()))); } dll->dll = NULL; -#else - general_error(ERROR_FFI_DISABLED,F); -#endif } diff --git a/native/win32/ffi.c b/native/win32/ffi.c index b438431d95..c6a0a2a63e 100644 --- a/native/win32/ffi.c +++ b/native/win32/ffi.c @@ -2,7 +2,6 @@ void ffi_dlopen (DLL *dll) { -#ifdef FFI HMODULE module; char *path = to_c_string(untag_string(dll->path)); @@ -12,14 +11,10 @@ void ffi_dlopen (DLL *dll) general_error(ERROR_FFI, tag_object(last_error())); dll->dll = module; -#else - general_error(ERROR_FFI_DISABLED, F); -#endif } void *ffi_dlsym (DLL *dll, F_STRING *symbol) { -#ifdef FFI void *sym = GetProcAddress(dll ? (HMODULE)dll->dll : GetModuleHandle(NULL), to_c_string(symbol)); @@ -27,17 +22,10 @@ void *ffi_dlsym (DLL *dll, F_STRING *symbol) general_error(ERROR_FFI, tag_object(last_error())); return sym; -#else - general_error(ERROR_FFI_DISABLED, F); -#endif } void ffi_dlclose (DLL *dll) { -#ifdef FFI FreeLibrary((HMODULE)dll->dll); dll->dll = NULL; -#else - general_error(ERROR_FFI_DISABLED, F); -#endif } \ No newline at end of file