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

Win32 IO updates

cvs
Mackenzie Straight 2004-12-27 02:40:45 +00:00
parent 54d5f7838d
commit 2701f1a34f
7 changed files with 117 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
library/bootstrap/init-stage2.factor
View File

@ -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

60
library/bootstrap/win32-io.factor Normal file
View File

@ -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 ;

3
library/io/win32-console.factor
View File

@ -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

6
library/io/win32-io-internals.factor
View File

@ -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 [

56
library/io/win32-stream.factor
View File

@ -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> ;

4
library/sdl/console.factor
View File

@ -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

8
native/win32/ffi.c
View File

@ -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