use radix literals

[factor.git] / basis / windows / errors / errors.factor

diff --git a/basis/windows/errors/errors.factor b/basis/windows/errors/errors.factor
old mode 100644 (file)
new mode 100755 (executable)
index 8bdbb9f..6d8f0e2
--- a/basis/windows/errors/errors.factor
+++ b/basis/windows/errors/errors.factor
@@ -1,9 +1,17 @@
-USING: alien.c-types kernel locals math math.bitwise
+USING: alien.data kernel locals math math.bitwise
 windows.kernel32 sequences byte-arrays unicode.categories
 io.encodings.string io.encodings.utf16n alien.strings
-arrays literals ;
+arrays literals windows.types specialized-arrays
+math.parser ;
+SPECIALIZED-ARRAY: TCHAR
 IN: windows.errors
 
+CONSTANT: APPLICATION_ERROR_MASK       0x20000000
+CONSTANT: ERROR_SEVERITY_SUCCESS       0x00000000
+CONSTANT: ERROR_SEVERITY_INFORMATIONAL 0x40000000
+CONSTANT: ERROR_SEVERITY_WARNING       0x80000000
+CONSTANT: ERROR_SEVERITY_ERROR         0xC0000000
+
 CONSTANT: ERROR_SUCCESS                               0
 CONSTANT: ERROR_INVALID_FUNCTION                      1
 CONSTANT: ERROR_FILE_NOT_FOUND                        2
@@ -685,35 +693,38 @@ CONSTANT: SUBLANG_NEUTRAL 0
 CONSTANT: LANG_NEUTRAL 0
 CONSTANT: SUBLANG_DEFAULT 1
 
-CONSTANT: FORMAT_MESSAGE_ALLOCATE_BUFFER  HEX: 00000100
-CONSTANT: FORMAT_MESSAGE_IGNORE_INSERTS   HEX: 00000200
-CONSTANT: FORMAT_MESSAGE_FROM_STRING      HEX: 00000400
-CONSTANT: FORMAT_MESSAGE_FROM_HMODULE     HEX: 00000800
-CONSTANT: FORMAT_MESSAGE_FROM_SYSTEM      HEX: 00001000
-CONSTANT: FORMAT_MESSAGE_ARGUMENT_ARRAY   HEX: 00002000
-CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK   HEX: 000000FF
+CONSTANT: FORMAT_MESSAGE_ALLOCATE_BUFFER  0x00000100
+CONSTANT: FORMAT_MESSAGE_IGNORE_INSERTS   0x00000200
+CONSTANT: FORMAT_MESSAGE_FROM_STRING      0x00000400
+CONSTANT: FORMAT_MESSAGE_FROM_HMODULE     0x00000800
+CONSTANT: FORMAT_MESSAGE_FROM_SYSTEM      0x00001000
+CONSTANT: FORMAT_MESSAGE_ARGUMENT_ARRAY   0x00002000
+CONSTANT: FORMAT_MESSAGE_MAX_WIDTH_MASK   0x000000FF
 
 : make-lang-id ( lang1 lang2 -- n )
     10 shift bitor ; inline
 
-ERROR: error-message-failed id ;
 :: n>win32-error-string ( id -- string )
-    {
+    flags{
         FORMAT_MESSAGE_FROM_SYSTEM
         FORMAT_MESSAGE_ARGUMENT_ARRAY
-    } flags
+    }
     f
     id
     LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
-    32768 [ "TCHAR" <c-array> ] keep 
-    f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
-    utf16n alien>string [ blank? ] trim ;
+    32768 [ TCHAR <c-array> ] [ ] bi
+    f pick [ FormatMessage ] dip
+    swap zero?
+    [ drop "Unknown error 0x" id 0xffff,ffff bitand >hex append ]
+    [ utf16n alien>string [ blank? ] trim ] if ;
 
 : win32-error-string ( -- str )
     GetLastError n>win32-error-string ;
 
+ERROR: windows-error n string ;
+
 : (win32-error) ( n -- )
-    [ win32-error-string throw ] unless-zero ;
+    [ dup win32-error-string windows-error ] unless-zero ;
 
 : win32-error ( -- )
     GetLastError (win32-error) ;
@@ -723,10 +734,18 @@ ERROR: error-message-failed id ;
 : win32-error<0 ( n -- ) 0 < [ win32-error ] when ;
 : win32-error<>0 ( n -- ) zero? [ win32-error ] unless ;
 
-: invalid-handle? ( handle -- )
-    INVALID_HANDLE_VALUE = [
-        win32-error-string throw
-    ] when ;
+: n>win32-error-check ( n -- )
+    dup ERROR_SUCCESS = [
+        drop
+    ] [
+        dup n>win32-error-string windows-error
+    ] if ;
+    
+: throw-win32-error ( -- * )
+    win32-error-string throw ;
+
+: check-invalid-handle ( handle -- handle )
+    dup INVALID_HANDLE_VALUE = [ throw-win32-error ] when ;
 
 CONSTANT: expected-io-errors
     ${
@@ -743,7 +762,7 @@ CONSTANT: expected-io-errors
     dup expected-io-error? [
         drop
     ] [
-        win32-error-string throw
+        throw-win32-error
     ] if ;
 
 : io-error ( return-value -- )