From: Christophe Rhodes <csr21@cantab.net>
Date: Sun, 22 Mar 2009 21:34:28 +0000 (+0000)
Subject: 1.0.26.14: minor portability fixes
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=da5a7ccd58c2bf3c5287a11fb41e01403e5745e8;p=sbcl.git

1.0.26.14: minor portability fixes
	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.
---

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index ec8162f..6b6cd19 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -1243,7 +1243,7 @@
   ;; 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
diff --git a/src/code/print.lisp b/src/code/print.lisp
index 7240bf8..84f557a 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -447,8 +447,6 @@
         (output-float object stream))
        (ratio
         (output-ratio object stream))
-       (ratio
-        (output-ratio object stream))
        (complex
         (output-complex object stream))))
     (character
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 1233220..de2beec 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -203,7 +203,7 @@
       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
@@ -215,7 +215,7 @@
 
   (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))
diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp
index 877d2c8..05fe744 100644
--- a/src/compiler/early-c.lisp
+++ b/src/compiler/early-c.lisp
@@ -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*)
diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index 95be9b3..07e0fc3 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -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)
diff --git a/src/compiler/ir2opt.lisp b/src/compiler/ir2opt.lisp
index 9919074..6c0e764 100644
--- a/src/compiler/ir2opt.lisp
+++ b/src/compiler/ir2opt.lisp
@@ -181,7 +181,7 @@
     (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))
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 531a2ef..3255973 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -676,7 +676,7 @@
 ;;; 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)
diff --git a/version.lisp-expr b/version.lisp-expr
index 76f2ec0..03710c9 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -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"