From 87abad4ebb8a587b06e197a1f7dbfd08aacea3d3 Mon Sep 17 00:00:00 2001 From: erg Date: Mon, 14 Aug 2006 22:43:19 +0000 Subject: [PATCH] fix some win32 error handling in native io --- library/io/windows/errors.factor | 35 +++++++++----------------- library/io/windows/io-last.factor | 3 ++- library/io/windows/server.factor | 42 +++++++++++++++---------------- library/io/windows/winsock.factor | 10 +++++--- 4 files changed, 41 insertions(+), 49 deletions(-) diff --git a/library/io/windows/errors.factor b/library/io/windows/errors.factor index a9d0517767..be612e2af2 100644 --- a/library/io/windows/errors.factor +++ b/library/io/windows/errors.factor @@ -1,40 +1,29 @@ ! Copyright (C) 2004 Mackenzie Straight. IN: win32-api -USE: errors -USE: kernel -USE: io-internals -USE: math -USE: parser -USE: alien -USE: words -USE: sequences +USING: alien errors io-internals kernel math parser sequences words ; : ERROR_SUCCESS 0 ; inline : ERROR_HANDLE_EOF 38 ; inline : ERROR_IO_PENDING 997 ; inline : WAIT_TIMEOUT 258 ; inline -: FORMAT_MESSAGE_ALLOCATE_BUFFER HEX: 00000100 ; -: FORMAT_MESSAGE_IGNORE_INSERTS HEX: 00000200 ; -: FORMAT_MESSAGE_FROM_STRING HEX: 00000400 ; -: FORMAT_MESSAGE_FROM_HMODULE HEX: 00000800 ; -: FORMAT_MESSAGE_FROM_SYSTEM HEX: 00001000 ; -: FORMAT_MESSAGE_ARGUMENT_ARRAY HEX: 00002000 ; -: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF ; +: FORMAT_MESSAGE_ALLOCATE_BUFFER HEX: 00000100 ; inline +: FORMAT_MESSAGE_IGNORE_INSERTS HEX: 00000200 ; inline +: FORMAT_MESSAGE_FROM_STRING HEX: 00000400 ; inline +: FORMAT_MESSAGE_FROM_HMODULE HEX: 00000800 ; inline +: FORMAT_MESSAGE_FROM_SYSTEM HEX: 00001000 ; inline +: FORMAT_MESSAGE_ARGUMENT_ARRAY HEX: 00002000 ; inline +: FORMAT_MESSAGE_MAX_WIDTH_MASK HEX: 000000FF ; inline : MAKELANGID ( primary sub -- lang ) 10 shift bitor ; -: LANG_NEUTRAL 0 ; -: SUBLANG_DEFAULT 1 ; +: LANG_NEUTRAL 0 ; inline +: SUBLANG_DEFAULT 1 ; inline -: GetLastError ( -- int ) - "int" "kernel32" "GetLastError" [ ] alien-invoke ; - -: win32-error-message ( id -- string ) - "char*" f "error_message" [ "int" ] alien-invoke ; +FUNCTION: char* error_message ( DWORD id ) ; : win32-throw-error ( -- ) - GetLastError win32-error-message throw ; + GetLastError error_message throw ; diff --git a/library/io/windows/io-last.factor b/library/io/windows/io-last.factor index 1522d6cd5e..1af2fe4d64 100644 --- a/library/io/windows/io-last.factor +++ b/library/io/windows/io-last.factor @@ -16,5 +16,6 @@ IN: io-internals swap [ schedule-thread-with ] [ drop ] if* ; : init-io ( -- ) - win32-init-stdio ; + win32-init-stdio + init-winsock ; diff --git a/library/io/windows/server.factor b/library/io/windows/server.factor index a5c9ba5d77..8f5ddff1fd 100644 --- a/library/io/windows/server.factor +++ b/library/io/windows/server.factor @@ -7,23 +7,25 @@ USING: alien errors generic kernel kernel-internals math namespaces TUPLE: win32-server this ; TUPLE: win32-client-stream host port ; -SYMBOL: winsock SYMBOL: socket -: maybe-init-winsock ( -- ) - winsock get [ - HEX: 0202 WSAStartup drop winsock on - ] unless ; +: (handle-socket-error) + WSAGetLastError [ ERROR_IO_PENDING ERROR_SUCCESS ] member? + [ WSAGetLastError error_message throw ] unless ; + +: handle-socket-error!=0/f ( int -- ) + [ 0 f ] member? [ (handle-socket-error) ] unless ; + +: handle-socket-error=0/f ( int -- ) + [ 0 f ] member? [ (handle-socket-error) ] when ; + +: init-winsock ( -- ) + HEX: 0202 WSAStartup handle-socket-error!=0/f ; -: handle-socket-error ( -- ) - WSAGetLastError [ - ERROR_IO_PENDING ERROR_SUCCESS - ] member? [ - WSAGetLastError win32-error-message throw - ] unless ; : new-socket ( -- socket ) - AF_INET SOCK_STREAM 0 f f WSA_FLAG_OVERLAPPED WSASocket ; + AF_INET SOCK_STREAM 0 f f WSA_FLAG_OVERLAPPED + WSASocket dup INVALID_SOCKET = [ (handle-socket-error) ] when ; : setup-sockaddr ( port -- sockaddr ) "sockaddr-in" swap @@ -32,12 +34,10 @@ SYMBOL: socket AF_INET over set-sockaddr-in-family ; : bind-socket ( port socket -- ) - swap setup-sockaddr "sockaddr-in" c-size wsa-bind zero? [ - handle-socket-error - ] unless ; + swap setup-sockaddr "sockaddr-in" c-size wsa-bind handle-socket-error!=0/f ; : listen-socket ( socket -- ) - 20 wsa-listen zero? [ handle-socket-error ] unless ; + 20 wsa-listen handle-socket-error!=0/f ; : sockaddr> ( sockaddr -- port host ) dup sockaddr-in-port ntohs swap sockaddr-in-addr inet-ntoa ; @@ -59,7 +59,7 @@ M: win32-client-stream client-stream-port win32-client-stream-port ; C: win32-server ( port -- server ) swap [ - maybe-init-winsock new-socket swap over bind-socket dup listen-socket + new-socket swap over bind-socket dup listen-socket dup add-completion socket set dup stream set @@ -78,7 +78,7 @@ M: win32-server expire ( -- ) : client-sockaddr ( host port -- sockaddr ) setup-sockaddr [ - >r gethostbyname handle-socket-error hostent-addr + >r gethostbyname dup handle-socket-error=0/f hostent-addr r> set-sockaddr-in-addr ] keep ; @@ -90,14 +90,14 @@ IN: io stream get alloc-io-callback init-overlapped >r >r >r socket get r> r> buffer-ptr 0 32 32 f r> AcceptEx - [ handle-socket-error ] unless stop + handle-socket-error!=0/f stop ] callcc1 pending-error drop swap dup add-completion dupd swap buffer-free ] bind ; : ( host port -- stream ) - maybe-init-winsock client-sockaddr new-socket - [ swap "sockaddr-in" c-size connect drop handle-socket-error ] keep + client-sockaddr new-socket + [ swap "sockaddr-in" c-size connect handle-socket-error!=0/f ] keep dup add-completion ; diff --git a/library/io/windows/winsock.factor b/library/io/windows/winsock.factor index f030cc7b47..d53fd81f31 100644 --- a/library/io/windows/winsock.factor +++ b/library/io/windows/winsock.factor @@ -9,10 +9,12 @@ USE: arrays : HEX: 190 ; -: AF_INET 2 ; -: SOCK_STREAM 1 ; -: WSA_FLAG_OVERLAPPED 1 ; -: INADDR_ANY 0 ; +: AF_INET 2 ; inline +: SOCK_STREAM 1 ; inline +: WSA_FLAG_OVERLAPPED 1 ; inline +: INADDR_ANY 0 ; inline + +: INVALID_SOCKET -1 ; inline BEGIN-STRUCT: sockaddr-in FIELD: short family