1 ;;;; This file contains Win32 support routines that SBCL needs to
2 ;;;; implement itself, in addition to those that apply to Win32 in
3 ;;;; unix.lisp. In theory, some of these functions might someday be
4 ;;;; useful to the end user.
6 ;;;; This software is part of the SBCL system. See the README file for
9 ;;;; This software is derived from the CMU CL system, which was
10 ;;;; written at Carnegie Mellon University and released into the
11 ;;;; public domain. The software is in the public domain and is
12 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
13 ;;;; files for more information.
15 (in-package "SB!WIN32")
17 ;;; Alien definitions for commonly used Win32 types. Woe unto whoever
18 ;;; tries to untangle this someday for 64-bit Windows.
19 (define-alien-type int-ptr long)
20 (define-alien-type handle int-ptr)
21 (define-alien-type dword unsigned-long)
22 (define-alien-type bool int)
24 ;;; HANDLEs are actually pointers, but an invalid handle is -1 cast
26 (defconstant invalid-handle -1)
30 ;;; Retrieve the calling thread's last-error code value. The
31 ;;; last-error code is maintained on a per-thread basis.
32 (define-alien-routine ("GetLastError@0" get-last-error) dword)
34 ;;; Flag constants for FORMAT-MESSAGE.
35 (defconstant format-message-from-system #x1000)
37 ;;; Format an error message based on a lookup table. See MSDN for the
38 ;;; full meaning of the all options---most are not used when getting
39 ;;; system error codes.
40 (define-alien-routine ("FormatMessageA@28" format-message) dword
51 ;;; Get the operating system handle for a C file descriptor. Returns
52 ;;; INVALID-HANDLE on failure.
53 (define-alien-routine ("_get_osfhandle" get-osfhandle) handle
56 ;;; Read data from a file handle into a buffer. This may be used
57 ;;; synchronously or with "overlapped" (asynchronous) I/O.
58 (define-alien-routine ("ReadFile@20" read-file) bool
62 (bytes-read (* dword))
65 ;;; Write data from a buffer to a file handle. This may be used
66 ;;; synchronously or with "overlapped" (asynchronous) I/O.
67 (define-alien-routine ("WriteFile@20" write-file) bool
70 (bytes-to-write dword)
71 (bytes-written (* dword))
74 ;;; Copy data from a named or anonymous pipe into a buffer without
75 ;;; removing it from the pipe. BUFFER, BYTES-READ, BYTES-AVAIL, and
76 ;;; BYTES-LEFT-THIS-MESSAGE may be NULL if no data is to be read.
77 ;;; Return TRUE on success, FALSE on failure.
78 (define-alien-routine ("PeekNamedPipe@24" peek-named-pipe) bool
82 (bytes-read (* dword))
83 (bytes-avail (* dword))
84 (bytes-left-this-message (* dword)))
86 ;;; Flush the console input buffer if HANDLE is a console handle.
87 ;;; Returns true on success, false if the handle does not refer to a
89 (define-alien-routine ("FlushConsoleInputBuffer@4" flush-console-input-buffer) bool
92 ;;; Read data from the console input buffer without removing it,
93 ;;; without blocking. Buffer should be large enough for LENGTH *
94 ;;; INPUT-RECORD-SIZE bytes.
95 (define-alien-routine ("PeekConsoleInputA@16" peek-console-input) bool
101 ;;; Listen for input on a Windows file handle. Unlike UNIX, there
102 ;;; isn't a unified interface to do this---we have to know what sort
103 ;;; of handle we have. Of course, there's no way to actually
104 ;;; introspect it, so we have to try various things until we find
105 ;;; something that works. Returns true if there could be input
106 ;;; available, or false if there is not.
107 (defun handle-listen (handle)
108 (with-alien ((avail dword)
109 (buf (array char #.input-record-size)))
110 (unless (zerop (peek-named-pipe handle nil 0 nil (addr avail) nil))
111 (return-from handle-listen (plusp avail)))
113 (unless (zerop (peek-console-input handle (cast buf (* t)) input-record-size (addr avail)))
114 (return-from handle-listen (plusp avail)))
116 ;; FIXME-SOCKETS: Try again here with WSAEventSelect in case
117 ;; HANDLE is a socket.
120 ;;; Listen for input on a C runtime file handle. Returns true if
121 ;;; there could be input available, or false if there is not.
122 (defun fd-listen (fd)
123 (let ((handle (get-osfhandle fd)))
125 (handle-listen handle)
128 ;;; Clear all available input from a file handle.
129 (defun handle-clear-input (handle)
130 (flush-console-input-buffer handle)
131 (with-alien ((buf (array char 1024))
134 (unless (handle-listen handle)
136 (when (zerop (read-file handle (cast buf (* t)) 1024 (addr count) nil))
141 ;;; Clear all available input from a C runtime file handle.
142 (defun fd-clear-input (fd)
143 (let ((handle (get-osfhandle fd)))
145 (handle-clear-input handle))))
147 ;;;; System Functions
149 ;;; Sleep for MILLISECONDS milliseconds.
150 (define-alien-routine ("Sleep@4" millisleep) void
151 (milliseconds dword))