Changeset 15108


Ignore:
Timestamp:
Dec 4, 2011, 9:16:45 PM (8 years ago)
Author:
gb
Message:

On Windows, if one or both of the standard input/output handles
is a null pointer (as can happen in a GUI application), redirect
standard I/O to the Windows null device.

(Untested, since we're currently keeping .xib files instead of
.nibs in svn, and have no way of producing .nibs natively on Windows).

Location:
trunk/source
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-boot-2.lisp

    r15105 r15108  
    9999(defglobal *interactive-streams-initialized* nil)
    100100
     101#+windows-target
     102(progn
     103
     104
     105(defun validate-standard-io-handles ()
     106  (let* ((in (#_GetStdHandle #$STD_INPUT_HANDLE))
     107         (out (#_GetStdHandle #$STD_OUTPUT_HANDLE)))
     108    (when (or (%null-ptr-p in)
     109              (%null-ptr-p out))
     110      (let* ((nulldevice (open-null-device)))
     111        (when nulldevice
     112          (when (%null-ptr-p in)
     113            (#_SetStdHandle #$STD_INPUT_HANDLE nulldevice))
     114          (when (%null-ptr-p out)
     115            (#_SetStdHandle #$STD_OUTPUT_HANDLE nulldevice)
     116            (ff-call (ccl::%kernel-import target::kernel-import-open-debug-output)
     117                     :int (%ptr-to-int nulldevice)
     118                     :int)))))))
     119)
     120
    101121(defun initialize-interactive-streams ()
    102122  (let* ((encoding (lookup-character-encoding *terminal-character-encoding-name*))
    103123         (encoding-name (if encoding (character-encoding-name encoding))))
     124    #+windows-target (validate-standard-io-handles)
    104125    (setq *stdin* (make-fd-stream #-windows-target 0
    105126                                  #+windows-target (%ptr-to-int
  • trunk/source/lib/misc.lisp

    r15027 r15108  
    16201620        (setq vector data)))
    16211621    (%parse-signed-integer vector start end)))
     1622
     1623#+windows-target
     1624(defun open-null-device ()
     1625  (rlet ((sa #>SECURITY_ATTRIBUTES
     1626           #>nLength (record-length #>SECURITY_ATTRIBUTES)
     1627           #>lpSecurityDescriptor +null-ptr+
     1628           #>bInheritHandle #$TRUE))
     1629    (with-filename-cstrs ((name "\\Device\\Null"))
     1630      (let* ((handle (#_CreateFileW name
     1631                                    (logior #$GENERIC_READ #$GENERIC_WRITE)
     1632                                    (logior #$FILE_SHARE_READ #$FILE_SHARE_WRITE)
     1633                                    sa
     1634                                    #$OPEN_EXISTING
     1635                                    #$FILE_ATTRIBUTE_NORMAL
     1636                                    +null-ptr+)))
     1637        (unless (eql handle #$INVALID_HANDLE_VALUE)
     1638          handle)))))
Note: See TracChangeset for help on using the changeset viewer.