1.0.26.14: minor portability fixes
authorChristophe Rhodes <csr21@cantab.net>
Sun, 22 Mar 2009 21:34:28 +0000 (21:34 +0000)
committerChristophe Rhodes <csr21@cantab.net>
Sun, 22 Mar 2009 21:34:28 +0000 (21:34 +0000)
Motivated by restarting work on a repeatable-xc-fasl project,
somewhat delayed by Real Life matters...
... use an explicit TYPE declaration for defined types;
... don't redefine host functions when building fasls from the
xc;
... catch one egregiously bad case of a dead clause in TYPECASE
(more lurk);
... don't use host symbols in genesis;
... define a total order for emitting constants.h.
Now clisp on my machine, with the current phase of the moon,
gets as far as dumping the cold core.  More Work Needed.

src/code/defstruct.lisp
src/code/print.lisp
src/compiler/constraint.lisp
src/compiler/early-c.lisp
src/compiler/generic/genesis.lisp
src/compiler/ir2opt.lisp
src/compiler/seqtran.lisp
version.lisp-expr

index ec8162f..6b6cd19 100644 (file)
   ;; included in that length to guarantee proper alignment of raw double float
   ;; slots, necessary for (at least) the SPARC backend.
   (let ((layout-length (dd-layout-length dd)))
-    (declare (index layout-length))
+    (declare (type index layout-length))
     (+ layout-length (mod (1+ layout-length) 2))))
 
 ;;; This is called when we are about to define a structure class. It
index 7240bf8..84f557a 100644 (file)
         (output-float object stream))
        (ratio
         (output-ratio object stream))
-       (ratio
-        (output-ratio object stream))
        (complex
         (output-complex object stream))))
     (character
index 1233220..de2beec 100644 (file)
       ret))
 
   (defun %conset-grow (conset new-size)
-    (declare (index new-size))
+    (declare (type index new-size))
     (setf (conset-vector conset)
           (replace (the simple-bit-vector
                      (make-array
 
   (declaim (inline conset-grow))
   (defun conset-grow (conset new-size)
-    (declare (index new-size))
+    (declare (type index new-size))
     (when (< (length (conset-vector conset)) new-size)
       (%conset-grow conset new-size))
     (values))
index 877d2c8..05fe744 100644 (file)
@@ -194,7 +194,7 @@ the stack without triggering overflow protection.")
 (defvar *debug-name-sharp*)
 (defvar *debug-name-ellipsis*)
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun dump-debug-name-marker (marker &optional env)
     (declare (ignore env))
     (cond ((eq marker *debug-name-sharp*)
index 95be9b3..07e0fc3 100644 (file)
@@ -1656,7 +1656,7 @@ core and return a descriptor to it."
    (lambda (code-object-address fixup-offsets)
      (let ((fixup-vector
             (allocate-vector-object
-             *dynamic* sb-vm:n-word-bits (length fixup-offsets)
+             *dynamic* sb!vm:n-word-bits (length fixup-offsets)
              sb!vm:simple-array-unsigned-byte-32-widetag)))
        (do ((index sb!vm:vector-data-offset (1+ index))
             (fixups fixup-offsets (cdr fixups)))
@@ -2790,7 +2790,9 @@ core and return a descriptor to it."
           (sort constants
                 (lambda (const1 const2)
                   (if (= (second const1) (second const2))
-                      (< (third const1) (third const2))
+                      (if (= (third const1) (third const2))
+                          (string< (first const1) (first const2))
+                          (< (third const1) (third const2)))
                       (< (second const1) (second const2))))))
     (let ((prev-priority (second (car constants))))
       (dolist (const constants)
index 9919074..6c0e764 100644 (file)
     (maybe-convert-one-cmov 2block)))
 
 (defun delete-unused-ir2-blocks (component)
-  (declare (component component))
+  (declare (type component component))
   (let ((live-2blocks (make-hash-table)))
     (labels ((mark-2block (2block)
                (declare (type ir2-block 2block))
index 531a2ef..3255973 100644 (file)
 ;;; you tweak it, make sure that you compare the disassembly, if not the
 ;;; performance of, the functions implementing string streams
 ;;; (e.g. SB!IMPL::STRING-OUCH).
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun make-replace-transform (saetp sequence-type1 sequence-type2)
     `(deftransform replace ((seq1 seq2 &key (start1 0) (start2 0) end1 end2)
                             (,sequence-type1 ,sequence-type2 &rest t)
index 76f2ec0..03710c9 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.26.13"
+"1.0.26.14"