Ignore:
Timestamp:
Oct 9, 2009, 4:28:17 PM (10 years ago)
Author:
gz
Message:

Merge some irrelevant (other platforms, unused) trunk changes

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/dumplisp.lisp

    r12249 r12941  
    7373                         (mode #o644)
    7474                         prepend-kernel
    75                          )
     75                         #+windows-target (application-type :console))
    7676  (declare (ignore toplevel-function error-handler application-class
    7777                   clear-clos-caches init-file impurify))
     78  #+windows-target (check-type application-type (member :console :gui))
    7879  (unless (probe-file (make-pathname :defaults nil
    7980                                     :directory (pathname-directory (translate-logical-pathname filename))))
     
    8788      (let* ((fd (open-dumplisp-file filename
    8889                                     :mode mode
    89                                      :prepend-kernel prepend-kernel)))
     90                                     :prepend-kernel prepend-kernel
     91                                     #+windows-target  #+windows-target
     92                                     :application-type application-type)))
    9093        (process-interrupt ip
    9194                           #'(lambda ()
     
    109112                                      (init-file nil init-file-p)
    110113                                      (clear-clos-caches t)
    111                                       prepend-kernel)
    112   (declare (ignore mode prepend-kernel))
     114                                      prepend-kernel
     115                                      #+windows-target application-type)
     116  (declare (ignore mode prepend-kernel #+windows-target application-type))
    113117  (when (and application-class (neq  (class-of *application*)
    114118                                     (if (symbolp application-class)
     
    189193                    header-pos))))))))))
    190194                 
    191  
    192 (defun %prepend-file (out-fd in-fd len)
     195;;; Note that Windows executable files are in what they call "PE"
     196;;; (= "Portable Executable") format, not to be confused with the "PEF"
     197;;; (= "PowerPC Executable Format" or "Preferred Executable Format")
     198;;; executable format that Apple used on Classic MacOS.
     199(defun %prepend-file (out-fd in-fd len #+windows-target application-type)
    193200  (declare (fixnum out-fd in-fd len))
    194201  (fd-lseek in-fd 0 #$SEEK_SET)
    195   (let* ((bufsize (ash 1 15)))
     202  (let* ((bufsize (ash 1 15))
     203         #+windows-target (first-buf t))
    196204    (%stack-block ((buf bufsize))
    197205      (loop
     
    201209            (if (< nread 0)
    202210              (%errno-disp nread))
    203             (let* ((nwritten (fd-write out-fd buf nread)))
     211            #+windows-target
     212            (when (shiftf first-buf nil)
     213              (let* ((application-byte (ecase application-type
     214                                         (:console #$IMAGE_SUBSYSTEM_WINDOWS_CUI)
     215                                         (:gui #$IMAGE_SUBSYSTEM_WINDOWS_GUI)))
     216                     (offset (%get-long buf (get-field-offset #>IMAGE_DOS_HEADER.e_lfanew))))
     217                (assert (< offset bufsize) () "PE header not within first ~D bytes" bufsize)
     218                (assert (= (%get-byte buf (+ offset 0)) (char-code #\P)) ()
     219                        "File does not appear to be a PE file")
     220                (assert (= (%get-byte buf (+ offset 1)) (char-code #\E)) ()
     221                        "File does not appear to be a PE file")
     222                (assert (= (%get-byte buf (+ offset 2)) 0) ()
     223                        "File does not appear to be a PE file")
     224                (assert (= (%get-byte buf (+ offset 3)) 0) ()
     225                        "File does not appear to be a PE file")
     226                ;; File is a PE file -- Windows subsystem byte goes at offset 68 in the
     227                ;;  "optional header" which appears right after the standard header (20 bytes)
     228                ;;  and the PE cookie (4 bytes)
     229                (setf (%get-byte buf (+ offset 4 (record-length #>IMAGE_FILE_HEADER) (get-field-offset #>IMAGE_OPTIONAL_HEADER.Subsystem) )) application-byte)))
     230            (let* ((nwritten (fd-write out-fd buf nread)))
    204231              (declare (fixnum nwritten))
    205232              (unless (= nwritten nread)
     
    221248
    222249
    223 (defun open-dumplisp-file (path &key (mode #o666) prepend-kernel)
     250(defun open-dumplisp-file (path &key (mode #o666) prepend-kernel
     251                           #+windows-target application-type)
    224252  (let* ((prepend-path (if prepend-kernel
    225253                         (if (eq prepend-kernel t)
     
    239267    (let* ((image-fd (fd-open filename (logior #$O_WRONLY #$O_CREAT) mode)))
    240268      (unless (>= image-fd 0) (signal-file-error image-fd filename))
     269      (when prepend-fd
     270        (%prepend-file image-fd prepend-fd prepend-len #+windows-target application-type))
    241271      (fd-chmod image-fd mode)
    242       (when prepend-fd
    243         (%prepend-file image-fd prepend-fd prepend-len))
    244272      image-fd)))
    245273
Note: See TracChangeset for help on using the changeset viewer.