Cleaning up windows code

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:
 

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 )
+: MAKELANGID ( primary sub -- lang ) 10 shift bitor ;
-    10 shift bitor ;
 
 : LANG_NEUTRAL 0 ; inline
 : SUBLANG_DEFAULT 1 ; inline
-
-FUNCTION: char* error_message ( DWORD id ) ;
-
-: win32-throw-error ( -- * )
-    GetLastError error_message throw ;
-

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 ;
 

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

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 = [
+    CF_TEXT swap SetClipboardData 0 = [ win32-error ] when
-        win32-error
-        "SetClipboardData failed" throw
-    ] when
     CloseClipboard drop ;
 
 TUPLE: pasteboard ;

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

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 )
+! You must LocalFree the return value!
-    #! In f.exe
+FUNCTION: void* error_message ( DWORD id ) ;
-    "char*" f "error_message" [ "int" ] alien-invoke ;
 
-: 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 ;
-

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

vm/io.c

@@ -1,8 +1,8 @@
 #include "factor.h"
 
-/* This function is used by FFI I/O. Accessing the errno global is
+/* This function is used by FFI I/O. Accessing the errno global directly is
-too troublesome... on some libc's its a funky macro that reads
+not portable, since on some libc's errno is not a global but a funky macro that
-thread-local storage. */
+reads thread-local storage. */
 int err_no(void)
 {
 	return errno;

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)
+	return (((s64)t.dwLowDateTime | (s64)t.dwHighDateTime<<32)
-		/ 10000;
+		- EPOCH_OFFSET) / 10000;
 }
 
 void ffi_dlopen (DLL *dll, bool error)