diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index a5ae63bd84..00c998b40f 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,9 +1,8 @@ + allot refactoring: -- os-windows.c error_message &co - inline float allocation needs a gc check - alien invoke, callback need a gc check -- last-index miscompiles +- make sure alien>ZZZ-string is safe on byte arrays + ui: diff --git a/library/io/windows/errors.factor b/library/io/windows/errors.factor index 2368bcae1a..d5edd71901 100644 --- a/library/io/windows/errors.factor +++ b/library/io/windows/errors.factor @@ -16,14 +16,7 @@ USING: alien errors io-internals kernel math parser sequences words ; : FORMAT_MESSAGE_ARGUMENT_ARRAY HEX: 00002000 ; inline : FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF ; inline -: MAKELANGID ( primary sub -- lang ) - 10 shift bitor ; +: MAKELANGID ( primary sub -- lang ) 10 shift bitor ; : LANG_NEUTRAL 0 ; inline : SUBLANG_DEFAULT 1 ; inline - -FUNCTION: char* error_message ( DWORD id ) ; - -: win32-throw-error ( -- * ) - GetLastError error_message throw ; - diff --git a/library/io/windows/io-internals.factor b/library/io/windows/io-internals.factor index 5433520a91..1766bc1db3 100644 --- a/library/io/windows/io-internals.factor +++ b/library/io/windows/io-internals.factor @@ -17,7 +17,7 @@ TUPLE: io-callback overlapped quotation stream ; ] member? ; : handle-io-error ( -- ) - GetLastError expected-error? [ win32-throw-error ] unless ; + GetLastError expected-error? [ win32-error ] unless ; : queue-error ( len/status -- len/status ) GetLastError expected-error? [ drop f ] unless ; @@ -44,7 +44,8 @@ TUPLE: io-callback overlapped quotation stream ; [ 2array "file-mode" set get-access get-sharemode f get-create FILE_FLAG_OVERLAPPED f - CreateFile dup INVALID_HANDLE_VALUE = [ win32-throw-error ] when + CreateFile dup INVALID_HANDLE_VALUE = + [ win32-error ] when dup add-completion ] with-scope ; diff --git a/library/io/windows/stream.factor b/library/io/windows/stream.factor index cb27fba9b2..1dc7346357 100644 --- a/library/io/windows/stream.factor +++ b/library/io/windows/stream.factor @@ -137,7 +137,7 @@ M: win32-stream-reader stream-read1 ( stream -- ch/f ) M: win32-stream-reader stream-close ( stream -- ) dup win32-stream-reader-in buffer-free - win32-stream-handle CloseHandle 0 = [ win32-throw-error ] when ; + win32-stream-handle CloseHandle win32-error=0 ; M: win32-stream-writer stream-flush ( stream -- ) maybe-flush-output ; M: win32-stream-writer stream-write1 ( ch stream -- ) >r >fixnum r> do-write ; @@ -145,13 +145,13 @@ M: win32-stream-writer stream-write ( str stream -- ) do-write ; M: win32-stream-writer stream-close ( stream -- ) dup maybe-flush-output dup win32-stream-writer-out buffer-free - win32-stream-handle CloseHandle 0 = [ win32-throw-error ] when ; + win32-stream-handle CloseHandle win32-error=0 ; M: win32-stream set-timeout ( n stream -- ) set-win32-stream-timeout ; : expire ( stream -- ) dup win32-stream-timeout millis pick win32-stream-cutoff > and [ - win32-stream-handle CancelIo [ win32-throw-error ] unless + win32-stream-handle CancelIo [ win32-error ] unless ] [ drop ] if ; @@ -193,5 +193,4 @@ M: win32-duplex-stream stream-close ( stream -- ) dup duplex-stream-out win32-stream-writer-out buffer-free dup duplex-stream-in win32-stream-reader-in buffer-free duplex-stream-in - win32-stream-handle CloseHandle drop ; ! 0 = [ win32-throw-error ] when ; - + win32-stream-handle CloseHandle drop ; diff --git a/library/ui/windows/clipboard.factor b/library/ui/windows/clipboard.factor index 6548916ec7..9cbb6f6858 100644 --- a/library/ui/windows/clipboard.factor +++ b/library/ui/windows/clipboard.factor @@ -38,10 +38,7 @@ IN: win32 dup GlobalLock rot [ string>char-alien ] keep length memcpy dup GlobalUnlock drop - CF_TEXT swap SetClipboardData 0 = [ - win32-error - "SetClipboardData failed" throw - ] when + CF_TEXT swap SetClipboardData 0 = [ win32-error ] when CloseClipboard drop ; TUPLE: pasteboard ; diff --git a/library/windows/kernel32.factor b/library/windows/kernel32.factor index a1e136a7ed..96bca669eb 100644 --- a/library/windows/kernel32.factor +++ b/library/windows/kernel32.factor @@ -608,7 +608,7 @@ FUNCTION: BOOL IsProcessorFeaturePresent ( DWORD ProcessorFeature ) ; ! FUNCTION: LocalCompact ! FUNCTION: LocalFileTimeToFileTime ! FUNCTION: LocalFlags -! FUNCTION: LocalFree +FUNCTION: HLOCAL LocalFree ( HLOCAL hMem ) ; ! FUNCTION: LocalHandle ! FUNCTION: LocalLock ! FUNCTION: LocalReAlloc diff --git a/library/windows/utils.factor b/library/windows/utils.factor index fbc63ed968..19030f0021 100644 --- a/library/windows/utils.factor +++ b/library/windows/utils.factor @@ -1,13 +1,20 @@ ! Copyright (C) 2005, 2006 Doug Coleman. -! See http://factor.sf.net/license.txt for BSD license. +! See http://factorcode.org/license.txt for BSD license. USING: alien errors io kernel math namespaces parser prettyprint words ; IN: win32-api -: (win32-error) ( id -- string ) - #! In f.exe - "char*" f "error_message" [ "int" ] alien-invoke ; +! You must LocalFree the return value! +FUNCTION: void* error_message ( DWORD id ) ; -: win32-error ( -- ) GetLastError dup 0 = [ (win32-error) throw ] unless drop ; +: win32-error ( -- ) + GetLastError dup zero? [ + drop + ] [ + error_message + dup alien>char-string + swap LocalFree drop + throw + ] if ; : win32-error=0 zero? [ win32-error ] when ; : win32-error>0 0 > [ win32-error ] when ; @@ -19,4 +26,3 @@ IN: win32-api : msgbox ( str -- ) f swap "DebugMsg" MB_OK MessageBox drop ; - diff --git a/vm/compiler.c b/vm/compiler.c index 2a35631054..b429cae187 100644 --- a/vm/compiler.c +++ b/vm/compiler.c @@ -261,7 +261,6 @@ void primitive_add_compiled_block(void) executable */ void primitive_finalize_compile(void) { - gc_off = true; F_ARRAY *array = untag_array(dpop()); /* set word XT's */ @@ -282,5 +281,4 @@ void primitive_finalize_compile(void) CELL xt = to_cell(get(AREF(pair,1))); iterate_code_heap_step(xt_to_compiled(xt),finalize_code_block); } - gc_off = false; } diff --git a/vm/io.c b/vm/io.c index ddf8104a83..f576583ca2 100644 --- a/vm/io.c +++ b/vm/io.c @@ -1,8 +1,8 @@ #include "factor.h" -/* This function is used by FFI I/O. Accessing the errno global is -too troublesome... on some libc's its a funky macro that reads -thread-local storage. */ +/* This function is used by FFI I/O. Accessing the errno global directly is +not portable, since on some libc's errno is not a global but a funky macro that +reads thread-local storage. */ int err_no(void) { return errno; diff --git a/vm/os-windows.c b/vm/os-windows.c index 2120baca18..47ba4f8143 100644 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -1,22 +1,15 @@ #include "factor.h" -/* frees memory allocated by win32 api calls */ -char *buffer_to_char_string(char *buffer) -{ - int capacity = strlen(buffer); - F_STRING *_c_str = allot_c_string(capacity,sizeof(u8)) / CHARS + 1); - u8 *c_str = (u8*)(_c_str + 1); - strcpy(c_str, buffer); - LocalFree(buffer); - return (char*)c_str; -} - F_STRING *get_error_message() { DWORD id = GetLastError(); - return from_char_string(error_message(id)); + char *msg = error_message(id); + F_STRING *string = from_char_string(msg); + LocalFree(msg); + return string; } +/* You must LocalFree() the return value! */ char *error_message(DWORD id) { char *buffer; @@ -36,15 +29,15 @@ char *error_message(DWORD id) while(index >= 0 && isspace(buffer[index])) buffer[index--] = 0; - return buffer_to_char_string(buffer); + return buffer; } s64 current_millis(void) { FILETIME t; GetSystemTimeAsFileTime(&t); - return (((s64)t.dwLowDateTime | (s64)t.dwHighDateTime<<32) - EPOCH_OFFSET) - / 10000; + return (((s64)t.dwLowDateTime | (s64)t.dwHighDateTime<<32) + - EPOCH_OFFSET) / 10000; } void ffi_dlopen (DLL *dll, bool error)