[Sbcl-commits] CVS: sbcl/src/compiler/generic genesis.lisp, 1.148, 1.149

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv9019/src/compiler/generic

Modified Files:
	genesis.lisp 
Log Message:
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.


Index: genesis.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/genesis.lisp,v
retrieving revision 1.148
retrieving revision 1.149
diff -u -d -r1.148 -r1.149
--- genesis.lisp	3 Feb 2009 04:17:47 -0000	1.148
+++ genesis.lisp	22 Mar 2009 21:34:29 -0000	1.149
@@ -1656,7 +1656,7 @@
    (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 @@
           (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)