logging and unix socket fixes

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
 

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 )
+    <int-box> [ set-int-box-i ] keep ;

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 -- )
-    <server> "http-server" set [
-        httpd-loop
-    ] [
-        "http-server" get stream-close rethrow
-    ] catch ;
+    [
+        <server> "http-server" set [
+            httpd-loop
+        ] [
+            "http-server" get stream-close rethrow
+        ] catch
+    ] with-logging ;
 
 : stop-httpd ( -- )
     #! Stop the server.

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 <file-writer> 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 <file-writer> 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 ;

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 ;
 

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 ;
 

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 <buffer> r> set-delegate ] keep
+    [
+        >r dup 0 > [ <buffer> ] [ 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> ;
 
 : >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
 : <fd-stream> ( 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.

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 ;

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. */

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
 }

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
 }