basis/windows/winsock/winsock.factor

   1 ! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types alien.data alien.syntax
   4 byte-arrays classes.struct grouping init kernel literals math
   5 math.parser sequences system vocabs.parser windows.com.syntax
   6 windows.errors windows.kernel32 windows.types ;
   7 IN: windows.winsock
   8
   9 <<
  10 ! Some differences between Win32 and Win64
  11 cpu x86.64? "windows.winsock.64" "windows.winsock.32" ? use-vocab
  12 >>
  13
  14 TYPEDEF: int* SOCKET
  15
  16 : <wsadata> ( -- byte-array )
  17     0x190 <byte-array> ;
  18
  19 CONSTANT: SOCK_STREAM    1
  20 CONSTANT: SOCK_DGRAM     2
  21 CONSTANT: SOCK_RAW       3
  22 CONSTANT: SOCK_RDM       4
  23 CONSTANT: SOCK_SEQPACKET 5
  24
  25 CONSTANT: SO_DEBUG       0x1
  26 CONSTANT: SO_ACCEPTCONN  0x2
  27 CONSTANT: SO_REUSEADDR   0x4
  28 CONSTANT: SO_KEEPALIVE   0x8
  29 CONSTANT: SO_DONTROUTE   0x10
  30 CONSTANT: SO_BROADCAST   0x20
  31 CONSTANT: SO_USELOOPBACK 0x40
  32 CONSTANT: SO_LINGER      0x80
  33 CONSTANT: SO_OOBINLINE   0x100
  34 : SO_DONTLINGER ( -- n ) SO_LINGER bitnot ; inline
  35
  36 CONSTANT: SO_SNDBUF     0x1001
  37 CONSTANT: SO_RCVBUF     0x1002
  38 CONSTANT: SO_SNDLOWAT   0x1003
  39 CONSTANT: SO_RCVLOWAT   0x1004
  40 CONSTANT: SO_SNDTIMEO   0x1005
  41 CONSTANT: SO_RCVTIMEO   0x1006
  42 CONSTANT: SO_ERROR      0x1007
  43 CONSTANT: SO_TYPE       0x1008
  44
  45 CONSTANT: TCP_NODELAY   0x1
  46
  47 CONSTANT: AF_UNSPEC      0
  48 CONSTANT: AF_UNIX        1
  49 CONSTANT: AF_INET        2
  50 CONSTANT: AF_IMPLINK     3
  51 CONSTANT: AF_PUP         4
  52 CONSTANT: AF_CHAOS       5
  53 CONSTANT: AF_NS          6
  54 CONSTANT: AF_ISO         7
  55 ALIAS: AF_OSI    AF_ISO
  56 CONSTANT: AF_ECMA        8
  57 CONSTANT: AF_DATAKIT     9
  58 CONSTANT: AF_CCITT      10
  59 CONSTANT: AF_SNA        11
  60 CONSTANT: AF_DECnet     12
  61 CONSTANT: AF_DLI        13
  62 CONSTANT: AF_LAT        14
  63 CONSTANT: AF_HYLINK     15
  64 CONSTANT: AF_APPLETALK  16
  65 CONSTANT: AF_NETBIOS    17
  66 CONSTANT: AF_MAX        18
  67 CONSTANT: AF_INET6      23
  68 CONSTANT: AF_IRDA       26
  69 CONSTANT: AF_BTM        32
  70
  71 CONSTANT: PF_UNSPEC      0
  72 CONSTANT: PF_LOCAL       1
  73 CONSTANT: PF_INET        2
  74 CONSTANT: PF_INET6      23
  75
  76 CONSTANT: AI_PASSIVE        0x0001
  77 CONSTANT: AI_CANONNAME      0x0002
  78 CONSTANT: AI_NUMERICHOST    0x0004
  79 CONSTANT: AI_ALL            0x0100
  80 CONSTANT: AI_ADDRCONFIG     0x0400
  81
  82 CONSTANT: AI_MASK flags{ AI_PASSIVE AI_CANONNAME AI_NUMERICHOST }
  83
  84 CONSTANT: NI_NUMERICHOST 1
  85 CONSTANT: NI_NUMERICSERV 2
  86
  87 CONSTANT: IPPROTO_IP        0           ! Dummy protocol for TCP.
  88 CONSTANT: IPPROTO_ICMP      1           ! Internet Control Message Protocol.
  89 CONSTANT: IPPROTO_IGMP      2           ! Internet Group Management Protocol. */
  90 CONSTANT: IPPROTO_IPIP      4           ! IPIP tunnels (older KA9Q tunnels use 94).
  91 CONSTANT: IPPROTO_TCP       6           ! Transmission Control Protocol.
  92 CONSTANT: IPPROTO_EGP       8           ! Exterior Gateway Protocol.
  93 CONSTANT: IPPROTO_PUP      12           ! PUP protocol.
  94 CONSTANT: IPPROTO_UDP      17           ! User Datagram Protocol.
  95 CONSTANT: IPPROTO_IDP      22           ! XNS IDP protocol.
  96 CONSTANT: IPPROTO_TP       29           ! SO Transport Protocol Class 4.
  97 CONSTANT: IPPROTO_DCCP     33           ! Datagram Congestion Control Protocol.
  98 CONSTANT: IPPROTO_IPV6     41           ! IPv6 header.
  99 CONSTANT: IPPROTO_RSVP     46           ! Reservation Protocol.
 100 CONSTANT: IPPROTO_GRE      47           ! General Routing Encapsulation.
 101 CONSTANT: IPPROTO_ESP      50           ! encapsulating security payload.
 102 CONSTANT: IPPROTO_AH       51           ! authentication header.
 103 CONSTANT: IPPROTO_MTP      92           ! Multicast Transport Protocol.
 104 CONSTANT: IPPROTO_BEETPH   94           ! IP option pseudo header for BEET.
 105 CONSTANT: IPPROTO_ENCAP    98           ! Encapsulation Header.
 106 CONSTANT: IPPROTO_PIM     103           ! Protocol Independent Multicast.
 107 CONSTANT: IPPROTO_COMP    108           ! Compression Header Protocol.
 108 CONSTANT: IPPROTO_RM      113           ! Reliable Multicast aka PGM
 109 CONSTANT: IPPROTO_SCTP    132           ! Stream Control Transmission Protocol.
 110 CONSTANT: IPPROTO_UDPLITE 136           ! UDP-Lite protocol.
 111 CONSTANT: IPPROTO_MPLS    137           ! MPLS in IP.
 112 CONSTANT: IPPROTO_RAW     255           ! Raw IP packets.
 113
 114 CONSTANT: FIOASYNC      0x8004667d
 115 CONSTANT: FIONBIO       0x8004667e
 116 CONSTANT: FIONREAD      0x4004667f
 117
 118 CONSTANT: IP_OPTIONS 1
 119 CONSTANT: IP_HDRINCL 2
 120 CONSTANT: IP_TOS 3
 121 CONSTANT: IP_TTL 4
 122 CONSTANT: IP_MULTICAST_IF 9
 123 CONSTANT: IP_MULTICAST_TTL 10
 124 CONSTANT: IP_MULTICAST_LOOP 11
 125 CONSTANT: IP_ADD_MEMBERSHIP 12
 126 CONSTANT: IP_DROP_MEMBERSHIP 13
 127 CONSTANT: IP_DONTFRAGMENT 14
 128 CONSTANT: IP_ADD_SOURCE_MEMBERSHIP 15
 129 CONSTANT: IP_DROP_SOURCE_MEMBERSHIP 16
 130 CONSTANT: IP_BLOCK_SOURCE 17
 131 CONSTANT: IP_UNBLOCK_SOURCE 18
 132 CONSTANT: IP_PKTINFO 19
 133 CONSTANT: IP_RECEIVE_BROADCAST 22
 134
 135
 136 CONSTANT: WSA_FLAG_OVERLAPPED 1
 137 ALIAS: WSA_WAIT_EVENT_0 WAIT_OBJECT_0
 138 ALIAS: WSA_MAXIMUM_WAIT_EVENTS MAXIMUM_WAIT_OBJECTS
 139 CONSTANT: WSA_INVALID_EVENT f
 140 CONSTANT: WSA_WAIT_FAILED -1
 141 ALIAS: WSA_WAIT_IO_COMPLETION WAIT_IO_COMPLETION
 142 ALIAS: WSA_WAIT_TIMEOUT WAIT_TIMEOUT
 143 ALIAS: WSA_INFINITE INFINITE
 144 ALIAS: WSA_IO_PENDING ERROR_IO_PENDING
 145
 146 CONSTANT: INADDR_ANY 0
 147
 148 : INVALID_SOCKET ( -- n ) -1 <alien> ; inline
 149
 150 : SOCKET_ERROR ( -- n ) -1 ; inline
 151
 152 CONSTANT: SD_RECV 0
 153 CONSTANT: SD_SEND 1
 154 CONSTANT: SD_BOTH 2
 155
 156 CONSTANT: SOL_SOCKET 0xffff
 157
 158 C-TYPE: sockaddr
 159
 160 STRUCT: sockaddr-in
 161     { family short }
 162     { port ushort }
 163     { addr uint }
 164     { pad char[8] } ;
 165
 166 STRUCT: sockaddr-in6
 167     { family uchar }
 168     { port ushort }
 169     { flowinfo uint }
 170     { addr uchar[16] }
 171     { scopeid uint } ;
 172
 173 STRUCT: hostent
 174     { name c-string }
 175     { aliases void* }
 176     { addrtype short }
 177     { length short }
 178     { addr-list void* } ;
 179
 180 STRUCT: protoent
 181     { name c-string }
 182     { aliases void* }
 183     { proto short } ;
 184
 185 STRUCT: addrinfo
 186     { flags int }
 187     { family int }
 188     { socktype int }
 189     { protocol int }
 190     { addrlen size_t }
 191     { canonname c-string }
 192     { addr sockaddr* }
 193     { next addrinfo* } ;
 194
 195 STRUCT: timeval
 196     { sec long }
 197     { usec long } ;
 198
 199 GENERIC: sockaddr>ip ( sockaddr -- string )
 200
 201 M: sockaddr-in sockaddr>ip
 202     addr>> uint <ref> [ number>string ] { } map-as "." join ;
 203
 204 M: sockaddr-in6 sockaddr>ip
 205     addr>> [ >hex ] { } map-as 2 group [ concat ] map ":" join ;
 206
 207 STRUCT: fd_set
 208     { fd_count uint }
 209     { fd_array SOCKET[64] } ;
 210
 211 LIBRARY: winsock
 212
 213 FUNCTION: int setsockopt ( SOCKET s, int level, int optname, c-string optval, int optlen )
 214 FUNCTION: int ioctlsocket ( SOCKET s, long cmd, ulong* *argp )
 215
 216 FUNCTION: ushort htons ( ushort n )
 217 FUNCTION: ushort ntohs ( ushort n )
 218 FUNCTION: int bind ( SOCKET socket, sockaddr-in* sockaddr, int len )
 219 FUNCTION: int listen ( SOCKET socket, int backlog )
 220 FUNCTION: c-string inet_ntoa ( int in-addr )
 221 FUNCTION: int getaddrinfo ( c-string nodename,
 222                             c-string servername,
 223                             addrinfo* hints,
 224                             addrinfo** res )
 225
 226 FUNCTION: void freeaddrinfo ( addrinfo* ai )
 227
 228
 229 FUNCTION: hostent* gethostbyname ( c-string name )
 230 FUNCTION: int gethostname ( c-string name, int len )
 231 FUNCTION: SOCKET socket ( int domain, int type, int protocol )
 232 FUNCTION: int connect ( SOCKET socket, sockaddr-in* sockaddr, int addrlen )
 233 FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout )
 234 FUNCTION: int closesocket ( SOCKET s )
 235 FUNCTION: int shutdown ( SOCKET s, int how )
 236 FUNCTION: int send ( SOCKET s, c-string buf, int len, int flags )
 237 FUNCTION: int recv ( SOCKET s, c-string buf, int len, int flags )
 238
 239 FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen )
 240 FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen )
 241
 242 FUNCTION: protoent* getprotobyname ( c-string name )
 243
 244 FUNCTION: servent* getservbyname ( c-string name, c-string prot )
 245 FUNCTION: servent* getservbyport ( int port, c-string prot )
 246
 247 TYPEDEF: uint SERVICETYPE
 248 TYPEDEF: void* LPWSADATA
 249 TYPEDEF: OVERLAPPED WSAOVERLAPPED
 250 TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
 251 TYPEDEF: uint GROUP
 252 TYPEDEF: void* LPCONDITIONPROC
 253 TYPEDEF: HANDLE WSAEVENT
 254 TYPEDEF: LPHANDLE LPWSAEVENT
 255 TYPEDEF: sockaddr* LPSOCKADDR
 256
 257 STRUCT: FLOWSPEC
 258     { TokenRate          uint        }
 259     { TokenBucketSize    uint        }
 260     { PeakBandwidth      uint        }
 261     { Latency            uint        }
 262     { DelayVariation     uint        }
 263     { ServiceType        SERVICETYPE }
 264     { MaxSduSize         uint        }
 265     { MinimumPolicedSize uint        } ;
 266 TYPEDEF: FLOWSPEC* PFLOWSPEC
 267 TYPEDEF: FLOWSPEC* LPFLOWSPEC
 268
 269 STRUCT: WSABUF
 270     { len ulong }
 271     { buf void* } ;
 272 TYPEDEF: WSABUF* LPWSABUF
 273
 274 STRUCT: QOS
 275     { SendingFlowspec FLOWSPEC }
 276     { ReceivingFlowspec FLOWSPEC }
 277     { ProviderSpecific WSABUF } ;
 278 TYPEDEF: QOS* LPQOS
 279
 280 CONSTANT: MAX_PROTOCOL_CHAIN 7
 281
 282 STRUCT: WSAPROTOCOLCHAIN
 283     { ChainLen int }
 284     { ChainEntries { DWORD 7 } } ;
 285     ! { ChainEntries { DWORD MAX_PROTOCOL_CHAIN } } ;
 286 TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
 287
 288 CONSTANT: WSAPROTOCOL_LEN 255
 289
 290 STRUCT: WSAPROTOCOL_INFOW
 291     { dwServiceFlags1 DWORD }
 292     { dwServiceFlags2 DWORD }
 293     { dwServiceFlags3 DWORD }
 294     { dwServiceFlags4 DWORD }
 295     { dwProviderFlags DWORD }
 296     { ProviderId GUID }
 297     { dwCatalogEntryId DWORD }
 298     { ProtocolChain WSAPROTOCOLCHAIN }
 299     { iVersion int }
 300     { iAddressFamily int }
 301     { iMaxSockAddr int }
 302     { iMinSockAddr int }
 303     { iSocketType int }
 304     { iProtocol int }
 305     { iProtocolMaxOffset int }
 306     { iNetworkByteOrder int }
 307     { iSecurityScheme int }
 308     { dwMessageSize DWORD }
 309     { dwProviderReserved DWORD }
 310     { szProtocol { WCHAR 256 } } ;
 311     ! { szProtocol[WSAPROTOCOL_LEN+1] { WCHAR 256 } } ;
 312 TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFOW
 313 TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFOW
 314 TYPEDEF: WSAPROTOCOL_INFOW WSAPROTOCOL_INFO
 315 TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFO
 316 TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFO
 317
 318
 319 STRUCT: WSANAMESPACE_INFOW
 320     { NSProviderId   GUID    }
 321     { dwNameSpace    DWORD   }
 322     { fActive        BOOL    }
 323     { dwVersion      DWORD   }
 324     { lpszIdentifier LPWSTR  } ;
 325 TYPEDEF: WSANAMESPACE_INFOW* PWSANAMESPACE_INFOW
 326 TYPEDEF: WSANAMESPACE_INFOW* LPWSANAMESPACE_INFOW
 327 TYPEDEF: WSANAMESPACE_INFOW WSANAMESPACE_INFO
 328 TYPEDEF: WSANAMESPACE_INFO* PWSANAMESPACE_INFO
 329 TYPEDEF: WSANAMESPACE_INFO* LPWSANAMESPACE_INFO
 330
 331 CONSTANT: FD_MAX_EVENTS 10
 332
 333 STRUCT: WSANETWORKEVENTS
 334     { lNetworkEvents long }
 335     { iErrorCode { int FD_MAX_EVENTS } } ;
 336 TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS
 337 TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS
 338
 339 ! STRUCT: WSAOVERLAPPED
 340     ! { Internal DWORD }
 341     ! { InternalHigh DWORD }
 342     ! { Offset DWORD }
 343     ! { OffsetHigh DWORD }
 344     ! { hEvent WSAEVENT }
 345     ! { bytesTransferred DWORD } ;
 346 ! TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
 347
 348 FUNCTION: SOCKET WSAAccept ( SOCKET s,
 349                              sockaddr* addr,
 350                              LPINT addrlen,
 351                              LPCONDITIONPROC lpfnCondition,
 352                              DWORD dwCallbackData )
 353
 354 ! FUNCTION: INT WSAAddressToString ( LPSOCKADDR lpsaAddress, DWORD dwAddressLength, LPWSAPROTOCOL_INFO lpProtocolInfo, LPTSTR lpszAddressString, LPDWORD lpdwAddressStringLength ) ;
 355
 356 FUNCTION: int WSACleanup ( )
 357 FUNCTION: BOOL WSACloseEvent ( WSAEVENT hEvent )
 358
 359 FUNCTION: int WSAConnect ( SOCKET s,
 360                            sockaddr* name,
 361                            int namelen,
 362                            LPWSABUF lpCallerData,
 363                            LPWSABUF lpCalleeData,
 364                            LPQOS lpSQOS,
 365                            LPQOS lpGQOS )
 366 FUNCTION: WSAEVENT WSACreateEvent ( )
 367 ! FUNCTION: INT WSAEnumNameSpaceProviders ( LPDWORD lpdwBufferLength, LPWSANAMESPACE_INFO lpnspBuffer ) ;
 368 FUNCTION: int WSAEnumNetworkEvents ( SOCKET s,
 369                                      WSAEVENT hEventObject,
 370                                      LPWSANETWORKEVENTS lpNetworkEvents )
 371 ! FUNCTION: int WSAEnumProtocols ( LPINT lpiProtocols, LPWSAPROTOCOL_INFO lpProtocolBuffer, LPDWORD lpwdBufferLength ) ;
 372
 373 FUNCTION: int WSAEventSelect ( SOCKET s,
 374                                WSAEVENT hEventObject,
 375                                long lNetworkEvents )
 376 FUNCTION: int WSAGetLastError ( )
 377 FUNCTION: BOOL WSAGetOverlappedResult ( SOCKET s,
 378                                         LPWSAOVERLAPPED lpOverlapped,
 379                                         LPDWORD lpcbTransfer,
 380                                         BOOL fWait,
 381                                         LPDWORD lpdwFlags )
 382
 383 TYPEDEF: void* LPWSAOVERLAPPED_COMPLETION_ROUTINE
 384 FUNCTION: int WSAIoctl ( SOCKET s,
 385                          DWORD dwIoControlCode,
 386                          LPVOID lpvInBuffer,
 387                          DWORD cbInBuffer,
 388                          LPVOID lpvOutBuffer,
 389                          DWORD cbOutBuffer,
 390                          LPDWORD lpcbBytesReturned,
 391                          LPWSAOVERLAPPED lpOverlapped,
 392                          LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine )
 393
 394 FUNCTION: int WSARecv ( SOCKET s,
 395                         LPWSABUF lpBuffers,
 396                         DWORD dwBufferCount,
 397                         LPDWORD lpNumberOfBytesRecvd,
 398                         LPDWORD lpFlags,
 399                         LPWSAOVERLAPPED lpOverlapped,
 400                         LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine )
 401
 402 FUNCTION: int WSARecvFrom ( SOCKET s,
 403                             LPWSABUF lpBuffers,
 404                             DWORD dwBufferCount,
 405                             LPDWORD lpNumberOfBytesRecvd,
 406                             LPDWORD lpFlags,
 407                             sockaddr* lpFrom,
 408                             LPINT lpFromlen,
 409                             LPWSAOVERLAPPED lpOverlapped,
 410                             LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine )
 411
 412 FUNCTION: BOOL WSAResetEvent ( WSAEVENT hEvent )
 413 FUNCTION: int WSASend ( SOCKET s,
 414                         LPWSABUF lpBuffers,
 415                         DWORD dwBufferCount,
 416                         LPDWORD lpNumberOfBytesSent,
 417                         LPDWORD lpFlags,
 418                         LPWSAOVERLAPPED lpOverlapped,
 419                  LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine )
 420
 421 FUNCTION: int WSASendTo ( SOCKET s,
 422                           LPWSABUF lpBuffers,
 423                           DWORD dwBufferCount,
 424                           LPDWORD lpNumberOfBytesSent,
 425                           DWORD dwFlags,
 426                           sockaddr* lpTo,
 427                           int iToLen,
 428                           LPWSAOVERLAPPED lpOverlapped,
 429   LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine )
 430
 431 FUNCTION: int WSAStartup ( WORD version,  LPWSADATA out-data )
 432
 433 FUNCTION: SOCKET WSASocketW ( int af,
 434                              int type,
 435                              int protocol,
 436                              LPWSAPROTOCOL_INFOW lpProtocolInfo,
 437                              GROUP g,
 438                              DWORD flags )
 439 ALIAS: WSASocket WSASocketW
 440
 441 FUNCTION: DWORD WSAWaitForMultipleEvents ( DWORD cEvents,
 442                                            WSAEVENT* lphEvents,
 443                                            BOOL fWaitAll,
 444                                            DWORD dwTimeout,
 445                                            BOOL fAlertable )
 446
 447
 448 LIBRARY: mswsock
 449
 450 FUNCTION: int AcceptEx ( SOCKET listen,
 451                          SOCKET accept,
 452                          PVOID out-buf,
 453                          DWORD recv-len,
 454                          DWORD addr-len,
 455                          DWORD remote-len,
 456                          LPDWORD out-len,
 457                          LPOVERLAPPED overlapped )
 458
 459 FUNCTION: void GetAcceptExSockaddrs (
 460   PVOID lpOutputBuffer,
 461   DWORD dwReceiveDataLength,
 462   DWORD dwLocalAddressLength,
 463   DWORD dwRemoteAddressLength,
 464   LPSOCKADDR* LocalSockaddr,
 465   LPINT LocalSockaddrLength,
 466   LPSOCKADDR* RemoteSockaddr,
 467   LPINT RemoteSockaddrLength
 468 )
 469
 470 CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
 471
 472 CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
 473
 474 ERROR: winsock-exception n string ;
 475
 476 : winsock-expected-error? ( n -- ? )
 477     ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
 478
 479 : (maybe-winsock-exception) ( n -- winsock-exception/f )
 480     ! ! WSAStartup returns the error code 'n' directly
 481     dup winsock-expected-error?
 482     [ drop f ] [ [ ] [ n>win32-error-string ] bi \ winsock-exception boa ] if ;
 483
 484 : maybe-winsock-exception ( -- winsock-exception/f )
 485     WSAGetLastError (maybe-winsock-exception) ;
 486
 487 : winsock-error ( -- )
 488     maybe-winsock-exception [ throw ] when* ;
 489
 490 : (winsock-error) ( n -- * )
 491     [ ] [ n>win32-error-string ] bi winsock-exception ;
 492
 493 : throw-winsock-error ( -- * )
 494     WSAGetLastError (winsock-error) ;
 495
 496 : winsock-error=0/f ( n/f -- )
 497     { 0 f } member? [ winsock-error ] when ;
 498
 499 : winsock-error!=0/f ( n/f -- )
 500     { 0 f } member? [ winsock-error ] unless ;
 501
 502 ! WSAStartup and WSACleanup return the error code directly
 503 : winsock-return-check ( n/f -- )
 504     dup { 0 f } member? [
 505         drop
 506     ] [
 507         [ ] [ n>win32-error-string ] bi winsock-exception
 508     ] if ;
 509
 510 : socket-error* ( n -- )
 511     SOCKET_ERROR = [
 512         WSAGetLastError
 513         dup WSA_IO_PENDING = [
 514             drop
 515         ] [
 516             (maybe-winsock-exception) throw
 517         ] if
 518     ] when ;
 519
 520 : socket-error ( n -- )
 521     SOCKET_ERROR = [ winsock-error ] when ;
 522
 523 : init-winsock ( -- )
 524     0x0202 <wsadata> WSAStartup winsock-return-check ;
 525
 526 : shutdown-winsock ( -- ) WSACleanup winsock-return-check ;
 527
 528 STARTUP-HOOK: init-winsock
 529 SHUTDOWN-HOOK: shutdown-winsock