Changeset 12941


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

Merge some irrelevant (other platforms, unused) trunk changes

Location:
branches/working-0711/ccl
Files:
1 deleted
6 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
  • branches/working-0711/ccl/lib/ffi-darwinppc64.lisp

    r12694 r12941  
    508508                                          ,fp-args-ptr
    509509                                          ,(* 8 (1- fp-arg-num))))))))))))))
    510                 (let* ((pair (list name (next-scalar-arg argtype))))
     510                (let* ((form (next-scalar-arg argtype)))
    511511                  (when name
    512                     (lets name))))
     512                    (lets (list name form)))))
    513513              #+nil
    514514              (when (or (typep argtype 'foreign-pointer-type)
  • branches/working-0711/ccl/lib/numbers.lisp

    r11101 r12941  
    4747        (ccl:set-fpu-mode :division-by-zero division-by-zero))))
    4848
    49 
     49(defconstant double-float-nan
     50  #.(let ((invalid (get-fpu-mode :invalid)))
     51      (unwind-protect
     52           (progn
     53             (set-fpu-mode :invalid nil)
     54             (+ double-float-positive-infinity double-float-negative-infinity))
     55        (set-fpu-mode :invalid invalid))))
    5056
    5157(defun parse-float (str len off) 
     
    109115         (nan
    110116          (return-from parse-float
    111             (let* ((invalid (ccl:get-fpu-mode :invalid)))
    112             (unwind-protect
    113                 (progn
    114                   (ccl:set-fpu-mode :invalid nil)
    115                   (coerce
    116                    ;; we could also have used a double-float-nan
    117                    ;; variable binding here:
    118                    (+ double-float-positive-infinity
    119                       double-float-positive-infinity)
    120                    type))
    121               (ccl:set-fpu-mode :invalid invalid)))))
     117            (coerce double-float-nan type)))
    122118         (expt (setq expt (%i+ expt (* esign eexp))))
    123119         (t (return-from parse-float nil)))))
  • branches/working-0711/ccl/library/chud-metering.lisp

    r12243 r12941  
    163163#+ppc-target
    164164(defun identify-functions-with-pure-code ()
    165   (ccl:purify)
     165  (ccl::purify)
    166166  (multiple-value-bind (pure-low pure-high)
    167167                                 
  • branches/working-0711/ccl/library/jp-encode.lisp

    r12410 r12941  
    1771317713
    1771417714
    17715 (defmacro define-jp-encoding (name document max-units-per-char
     17715(defmacro define-jp-encoding (name docstring aliases max-units-per-char
    1771617716                              from-ucs
    1771717717                              to-ucs
     
    1771917719                              length-by-1st-unit)
    1772017720  `(define-character-encoding ,name
    17721        ,document
     17721       ,docstring
     17722     :aliases ,aliases
    1772217723     :native-endianness nil
    1772317724     :max-units-per-char ,max-units-per-char
     
    1790917910
    1791017911
    17911 (define-jp-encoding :eucjp
     17912(define-jp-encoding :euc-jp
    1791217913    "An 8-bit, variable-length character encoding in which
    1791317914character code points in the range #x00-#x7f can be encoded in a
    1791417915single octet; characters with larger code values can be encoded
    1791517916in 2 to 3 bytes."
     17917  '(:eucjp)
    1791617918  3
    1791717919  ucs-to-eucjp
     
    1792717929        (t 1)))
    1792817930
    17929 (define-jp-encoding :cp932
     17931(define-jp-encoding :windows-31j
    1793017932    "An 8-bit, variable-length character encoding in which
    1793117933character code points in the range #x00-#x7f can be encoded in a
    1793217934single octet; characters with larger code values can be encoded
    1793317935in 2 bytes."
     17936  '(:cp932 :csWindows31J)
    1793417937  2
    1793517938  ucs-to-cp932
  • branches/working-0711/ccl/library/openmcl-gtk-support.lisp

    r5834 r12941  
    2424
    2525(eval-when (:compile-toplevel :execute)
    26   (use-interface-dir :GTK))
     26  (use-interface-dir :GTK2))
    2727
    2828(eval-when (:compile-toplevel :load-toplevel :execute)
    29   ;; I don't know why it's necessary to explicitly open
    30   ;; libgdk.so (which transitively opens half a dozen
    31   ;; other libraries), while opening libgtk.so by itself
    32   ;; would complain about unresolved symbols from libgdk.
    33   (dolist (lib '("libgdk.so" "libgtk.so"))
    34     (open-shared-library lib)))
     29  (open-shared-library "libgnomeui-2.so"))
    3530
    3631
Note: See TracChangeset for help on using the changeset viewer.