Win32 IO updates

diff --git a/library/bootstrap/init-stage2.factor b/library/bootstrap/init-stage2.factor
index ee8ff08ef7cd63c28c1ee72d0fb690861c6c1659..753e8ca4791242762790b1b99e3b8bf4bfbef81b 100644 (file)
--- a/library/bootstrap/init-stage2.factor
+++ b/library/bootstrap/init-stage2.factor
@@ -62,12 +62,12 @@ USE: console
 [
     warm-boot
     garbage-collection
-    init-smart-terminal
     run-user-init
     "graphical" get [
         start-console
     ] [
         "interactive" get [
+            init-smart-terminal
             print-banner listener
         ] when
     ] ifte
@@ -121,6 +121,9 @@ os "win32" = "compile" get and [
     "libc"     "msvcrt.dll"   "cdecl"   add-library
 ] when
 
+! FIXME: KLUDGE to get FFI-based IO going in Windows.
+os "win32" = [ "/library/bootstrap/win32-io.factor" run-resource ] when
+
 "Compiling system..." print
 "compile" get [ compile-all ] when
 

diff --git a/library/bootstrap/win32-io.factor b/library/bootstrap/win32-io.factor
new file mode 100644 (file)
index 0000000..fbd6fa5
--- /dev/null
+++ b/library/bootstrap/win32-io.factor
@@ -0,0 +1,60 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2003, 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: threads
+USE: compiler
+USE: io-internals
+USE: kernel
+USE: win32-io-internals
+USE: win32-api
+
+: (yield) ( -- )
+    next-thread [ 
+        call
+    ] [
+        next-io-task [
+            call
+        ] [ 
+            win32-next-io-task 
+        ] ifte*
+    ] ifte* ;
+
+IN: streams
+USE: compiler
+USE: namespaces
+USE: stdio
+USE: kernel
+USE: win32-io-internals
+USE: win32-stream
+USE: win32-api
+
+: <filecr> <win32-filecr> ;
+: <filecw> <win32-filecw> ;
+
+: init-stdio ( -- )
+    win32-init-stdio ;
+

diff --git a/library/io/win32-console.factor b/library/io/win32-console.factor
index ffaef4524f78c2af085e7604908bb10e881a65a1..d9cdd346057d094bf6bc8968d3fb88fb366cd08c 100644 (file)
--- a/library/io/win32-console.factor
+++ b/library/io/win32-console.factor
@@ -39,6 +39,7 @@ USE: generic
 USE: parser
 USE: compiler
 USE: win32-api
+USE: win32-stream
 
 TRAITS: win32-console-stream
 SYMBOL: handle
@@ -82,7 +83,7 @@ M: win32-console-stream fwrite-attr ( string style stream -- )
     ] bind ;
 
 C: win32-console-stream ( stream -- stream )
-    [ delegate set -11 GetStdHandle handle set ] extend ;
+    [ -11 GetStdHandle handle set delegate set ] extend ;
 
 global [ [ <win32-console-stream> ] smart-term-hook set ] bind
 

diff --git a/library/io/win32-io-internals.factor b/library/io/win32-io-internals.factor
index 4d668c35aeb08d4fc046cc2d4d5da6edba61e4d0..5ba9da2ddb830e82ae21b14ec166f48d3ce8f73e 100644 (file)
--- a/library/io/win32-io-internals.factor
+++ b/library/io/win32-io-internals.factor
@@ -61,11 +61,11 @@ SYMBOL: callbacks
 
 : get-access ( -- file-mode )
     "file-mode" get uncons 
-    [ GENERIC_WRITE ] [ 0 ] ifte >r
-    [ GENERIC_READ ] [ 0 ] ifte r> bitor ;
+    GENERIC_WRITE 0 ? >r
+    GENERIC_READ 0 ? r> bitor ;
 
 : get-sharemode ( -- share-mode )
-    FILE_SHARE_READ FILE_SHARE_WRITE bitor FILE_SHARE_DELETE bitor ;
+     FILE_SHARE_READ FILE_SHARE_WRITE bitor ;
 
 : get-create ( -- creation-disposition )
     "file-mode" get uncons [

diff --git a/library/io/win32-stream.factor b/library/io/win32-stream.factor
index c50219bc2dbc96a6f32c28a216bc57a7daea12f4..fd30f49d2f2f5d010de71751f9327e41e4a47471 100644 (file)
--- a/library/io/win32-stream.factor
+++ b/library/io/win32-stream.factor
@@ -43,6 +43,7 @@ USE: win32-api
 USE: win32-io-internals
 
 TRAITS: win32-stream
+GENERIC: win32-stream-handle
 
 SYMBOL: handle
 SYMBOL: in-buffer
@@ -58,19 +59,22 @@ SYMBOL: file-size
     0 over set-overlapped-ext-event ;
 
 : update-file-pointer ( whence -- )
-    file-size get [ fileptr [ + ] change ] when ;
+    file-size get [ fileptr [ + ] change ] [ drop ] ifte ;
 
 : flush-output ( -- ) 
     [
         alloc-io-task init-overlapped >r
         handle get out-buffer get [ buffer-pos ] keep buffer-length
-        NULL r> WriteFile [ handle-io-error ] unless win32-next-io-task
+        NULL r> WriteFile [ handle-io-error ] unless (yield)
     ] callcc1
 
-    dup out-buffer get [ buffer-consume ] keep 
-    swap namespace update-file-pointer
+    dup update-file-pointer
+    out-buffer get [ buffer-consume ] keep 
     buffer-length 0 > [ flush-output ] when ;
 
+: maybe-flush-output ( -- )
+    out-buffer get buffer-length 0 > [ flush-output ] when ;
+
 : do-write ( str -- )
     dup str-length out-buffer get buffer-capacity <= [
         out-buffer get buffer-append
@@ -86,11 +90,10 @@ SYMBOL: file-size
         handle get in-buffer get [ buffer-pos ] keep 
         buffer-capacity file-size get [ fileptr get - min ] when*
         NULL r>
-        ReadFile [ handle-io-error ] unless win32-next-io-task
+        ReadFile [ handle-io-error ] unless (yield)
     ] callcc1
 
-    dup in-buffer get buffer-fill
-    namespace update-file-pointer ;
+    dup in-buffer get buffer-fill update-file-pointer ;
 
 : consume-input ( count -- str ) 
     in-buffer get buffer-length 0 = [ fill-input ] when
@@ -98,41 +101,68 @@ SYMBOL: file-size
     dup in-buffer get buffer-first-n
     swap in-buffer get buffer-consume ;
 
+: sbuf>str-or-f ( sbuf -- str-or-? )
+    dup sbuf-length 0 > [ sbuf>str ] [ drop f ] ifte ;
+
 : do-read-count ( sbuf count -- str )
     dup 0 = [ 
         drop sbuf>str 
     ] [
         dup consume-input
         dup str-length dup 0 = [
-            3drop dup sbuf-length 0 > [ sbuf>str ] [ drop f ] ifte
+            3drop sbuf>str-or-f
         ] [
             >r swap r> - >r swap [ sbuf-append ] keep r> do-read-count
         ] ifte
     ] ifte ;
 
+: peek-input ( -- str )
+    1 in-buffer get buffer-first-n ;
+
+: do-read-line ( sbuf -- str )
+    1 consume-input dup str-length 0 = [ drop sbuf>str-or-f ] [
+        dup "\r" = [
+            peek-input "\n" = [ 1 consume-input drop ] when 
+            drop sbuf>str
+        ] [ 
+            dup "\n" = [
+                peek-input "\r" = [ 1 consume-input drop ] when 
+                drop sbuf>str
+            ] [
+                over sbuf-append do-read-line 
+            ] ifte
+        ] ifte
+    ] ifte ;
+
 M: win32-stream fwrite-attr ( str style stream -- )
     nip [ do-write ] bind ;
 
 M: win32-stream freadln ( stream -- str )
-    drop f ;
+    [ 80 <sbuf> do-read-line ] bind ;
 
 M: win32-stream fread# ( count stream -- str )
     [ dup <sbuf> swap do-read-count ] bind ;
 
 M: win32-stream fflush ( stream -- )
-    [ flush-output ] bind ;
+    [ maybe-flush-output ] bind ;
+
+M: win32-stream fauto-flush ( stream -- )
+    drop ;
 
 M: win32-stream fclose ( stream -- )
     [
-        flush-output
+        maybe-flush-output
         handle get CloseHandle drop 
         in-buffer get buffer-free 
         out-buffer get buffer-free
     ] bind ;
 
+M: win32-stream win32-stream-handle ( stream -- handle )
+    [ handle get ] bind ;
+
 C: win32-stream ( handle -- stream )
     [
-        dup NULL GetFileSize dup INVALID_FILE_SIZE = not [
+        dup NULL GetFileSize dup -1 = not [
             file-size set
         ] [ drop f file-size set ] ifte
         handle set 
@@ -146,3 +176,5 @@ C: win32-stream ( handle -- stream )
 
 : <win32-filecw> ( path -- stream )
     f t win32-open-file <win32-stream> ;
+
+

diff --git a/library/sdl/console.factor b/library/sdl/console.factor
index dd4e560086907616d1497b638981927f58faf949..aac1b589037e37649166e83d18b6ae29e67659ca 100644 (file)
--- a/library/sdl/console.factor
+++ b/library/sdl/console.factor
@@ -241,7 +241,7 @@ M: alien handle-event ( event -- ? )
     SDL_EnableKeyRepeat drop ;
 
 : console-loop ( -- )
-    yield check-event [ console-loop ] when ;
+    check-event [ console-loop ] when ;
 
 : console-quit ( -- )
     redraw-continuation off
@@ -261,7 +261,7 @@ SYMBOL: escape-continuation
 
         [
             console get swap <console-stream>
-            [ [ print-banner listener ] in-thread ] with-stream
+            [ print-banner listener ] with-stream
             SDL_Quit
             ( return from start-console word )
             escape-continuation get call

diff --git a/native/win32/ffi.c b/native/win32/ffi.c
index c03679707a65a941882ae31c337b249edb11f73a..d5700da5334aa69e2d9a8685c58726b9ddb81311 100644 (file)
--- a/native/win32/ffi.c
+++ b/native/win32/ffi.c
@@ -1,20 +1,16 @@
 #include "../factor.h"
 
-DLL *ffi_dlopen (F_STRING *path)
+void ffi_dlopen (DLL *dll)
 {
 #ifdef FFI
        HMODULE module;
-       DLL *dll;
 
-       module = LoadLibrary(to_c_string(path));
+       module = LoadLibrary(to_c_string(untag_string(dll->path)));
 
        if (!module)
                general_error(ERROR_FFI, tag_object(last_error()));
 
-       dll = allot_object(DLL_TYPE, sizeof(DLL));
        dll->dll = module;
-
-       return dll;
 #else
        general_error(ERROR_FFI_DISABLED, F);
 #endif