Changeset 12830


Ignore:
Timestamp:
Sep 12, 2009, 7:37:24 PM (10 years ago)
Author:
gb
Message:

Implement TRY-CONNECTING-TO-ALTCONSOLE for Cocotron.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/start.lisp

    r12676 r12830  
    161161;;; that bundle'es executable file, with its standard input/output/error
    162162;;; descriptors connected to one end of a socketpair, and connect
    163 ;;; lisp's *TERMINAL-IO* and C's stdin/stdout/stderr to the other end
     163;;; lisp's *TERMINAL-IO* and the kernel's dbgout to the other end
    164164;;; of the socket.
    165165
    166166(defun try-connecting-to-altconsole ()
    167   #-cocotron
    168167  (with-autorelease-pool
    169168      (let* ((main-bundle (#/mainBundle ns:ns-bundle))
     
    172171          (when (%null-ptr-p resource-path)
    173172            (return-from exit nil))
     173          #-windows-target
    174174          (let* ((altconsole-bundle
    175175                  (make-instance ns:ns-bundle
     
    241241                           ;; *TERMINAL-IO*.
    242242                           (ccl::add-auto-flush-stream ccl::*stdout*)
    243                            pid)))))))))))))
     243                           pid)))))))))
     244          #+windows-target
     245          (let* ((executable-path (#/stringByAppendingPathComponent:
     246                                  resource-path
     247                                  #@"WaltConsole.exe")))
     248            (unless (#/isExecutableFileAtPath:
     249                     (#/defaultManager ns:ns-file-manager)
     250                     executable-path)
     251              (return-from exit nil))
     252            (multiple-value-bind (child-in parent-out) (ccl::pipe)
     253              (multiple-value-bind (parent-in child-out) (ccl::pipe)
     254                (cond ((ccl::create-windows-process child-in child-out child-out (lisp-string-from-nsstring executable-path) nil)
     255                       (#_CloseHandle (ccl::%int-to-ptr child-in))
     256                       (#_CloseHandle (ccl::%int-to-ptr child-out))
     257                       (let* ((in-fd (#__open_osfhandle parent-in #$_O_RDONLY))
     258                              (out-fd (#__open_osfhandle parent-out 0)))
     259                         (#_SetStdHandle #$STD_INPUT_HANDLE (%int-to-ptr parent-in))
     260                         (#__dup2 in-fd 0) ; Thank god the namespace isn't polluted.
     261                         (ff-call (ccl::%kernel-import target::kernel-import-open-debug-output)
     262                                  :int out-fd
     263                                  :int)                         
     264                         (flet ((set-lisp-stream-handle (stream handle)
     265                                    (setf (ccl::ioblock-device (ccl::stream-ioblock stream t))
     266                                          handle)))
     267                           (set-lisp-stream-handle ccl::*stdin* parent-in)
     268                           (set-lisp-stream-handle ccl::*stdout* parent-out)
     269                           (ccl::add-auto-flush-stream ccl::*stdout*)
     270                           t)))))))))))
    244271                     
    245272                   
Note: See TracChangeset for help on using the changeset viewer.