diff --git a/compiler/dump.lisp b/compiler/dump.lisp
index b42d4a8d6bb3c316b1fad1b70a2f474dc5fd97f5..124d6dc886b73ba587be81e4c644e5d730a8ec4c 100644
--- a/compiler/dump.lisp
+++ b/compiler/dump.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.89 2010/11/10 19:51:24 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.90 2010/12/04 17:32:34 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1635,14 +1635,16 @@
 			  bytes-per-element)
 		    (type unsigned-byte elements))
 	   (if (stringp data-vector)
-	       ;; Don't swap string bytes.  We get here only if we're
-	       ;; cross-compiling from one arch to a different endian
-	       ;; arch.  To be able to load the fasls, we need to keep
-	       ;; strings in the native format.  When genesis is done,
-	       ;; genesis will swap string bytes when creating the
-	       ;; core so that the bytes are in the correct order.
-	       (dotimes (index elements)
-		 (setf (aref result index) (char-code (aref data-vector index))))
+	       (progn
+		 ;;(format t "reverse string data: ~S~%" data-vector)
+		 #+(or)
+		 (dotimes (index elements)
+		   (let ((c (char-code (aref data-vector index))))
+		     (setf (aref result index) c)))
+		 (dotimes (index elements)
+		   (let ((c (char-code (aref data-vector index))))
+		     (setf (aref result index) (logior (ash (ldb (byte 8 0) c) 8)
+						       (ldb (byte 8 8) c))))))
 	       (dotimes (index elements)
 		 (let ((element (aref data-vector index))
 		       (new-element 0))
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index 767d4d8fbb336b16f11fff8eef51f93d8255df32..2eafbd61fb39330f0483a40608c21de1ac7dd67b 100644
--- a/compiler/generic/new-genesis.lisp
+++ b/compiler/generic/new-genesis.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.91 2010/11/11 21:48:24 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.92 2010/12/04 17:32:34 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -431,16 +431,22 @@
 				      vm:simple-string-type))
 	 (bytes (make-array (1+ len) :element-type '(unsigned-byte 16))))
     (write-indexed des vm:vector-length-slot (make-fixnum-descriptor len))
-    ;;(format t "s-t-c: len = ~d, ~S~%" len string)
+    
     (dotimes (k len)
       (setf (aref bytes k) (logand #xffff (char-code (aref string k)))))
     (unless (eq (c:backend-byte-order c:*backend*)
 		(c:backend-byte-order c:*native-backend*))
-      ;; Swap byte order of unicode strings.
+      ;; Swap byte order of unicode strings if the backend and
+      ;; native-backend have different endianness.
+      #+(or)
+      (progn
+	(format t "s-t-c: len = ~d, ~S~%" len string)
+	(format t "     codes = ~{~X~^ ~}~%" (map 'list #'char-code string)))
       (dotimes (k len)
 	(let ((x (aref bytes k)))
-	  (setf (aref bytes k) (+ (ldb (byte 8 8) x)
-				  (ash (ldb (byte 8 0) x) 8))))))
+	  (setf (aref bytes k) (maybe-byte-swap-short x))))
+      #+(or)
+      (format t " new codes = ~{~X~^ ~}~%" (coerce bytes 'list)))
     (copy-to-system-area bytes (* vm:vector-data-offset
 				   ;; the word size of the native backend which
 				   ;; may be different from the target backend
@@ -1324,7 +1330,7 @@
 
 #+unicode
 (defmacro load-char-code ()
-  (ecase (c::backend-byte-order c::*native-backend*)
+  (ecase (c::backend-byte-order c::*backend*)
     (:little-endian
      `(code-char (+ (read-arg 1)
 		    (ash (read-arg 1) 8))))
@@ -1332,13 +1338,33 @@
      `(code-char (+ (ash (read-arg 1) 8)
 		    (read-arg 1))))))
 
+(declaim (inline swap-16))
+(defun swap-16 (n)
+  (declare (type (unsigned-byte 16) n))
+  (logior (ash (ldb (byte 8 0) n) 8)
+	  (ldb (byte 8 8) n)))
+
+;; Destructively byte swap a string, if the backend and the native
+;; backend have different endianness.
+(defun maybe-byte-swap-string (s &optional (len (length s)))
+  (unless (eq (c:backend-byte-order c:*backend*)
+	      (c:backend-byte-order c:*native-backend*))
+    (dotimes (k len)
+      (let ((code (char-code (aref s k))))
+	(setf (aref s k) (code-char (swap-16 code))))))
+  s)
+	  
 #+unicode
 (defun cold-load-symbol (size package)
   (let ((string (make-string size)))
-    #+nil
     (read-n-bytes *fasl-file* string 0 (* 2 size))
-    (dotimes (k size)
-      (setf (aref string k) (load-char-code)))
+    #+(or)
+    (format t "pre swap cold-load-symbol: ~S to package ~S~%" string package)
+    ;; Make the string have the correct byte order for the native
+    ;; backend.
+    (maybe-byte-swap-string string)
+    #+(or)
+    (format t "post swap cold-load-symbol: ~S to package ~S~%" string package)
     (cold-intern (intern string package) package)))
 
 (clone-cold-fop (fop-symbol-save)
@@ -1378,10 +1404,8 @@
 		(fop-uninterned-small-symbol-save)
   (let* ((size (clone-arg))
 	 (name (make-string size)))
-    #+nil
-    (read-n-bytes *fasl-file* name 0 size)
-    (dotimes (k size)
-      (setf (aref name k) (load-char-code)))
+    (read-n-bytes *fasl-file* name 0 (* 2 size))
+    (maybe-byte-swap-string name)
     (let ((symbol (allocate-symbol name)))
       (push-table symbol))))
 
@@ -1448,10 +1472,15 @@
 		(fop-small-string)
   (let* ((len (clone-arg))
 	 (string (make-string len)))
-    #+nil
     (read-n-bytes *fasl-file* string 0 (* 2 len))
-    (dotimes (k len)
-      (setf (aref string k) (load-char-code)))
+    #+(or)
+    (format t "pre fop-string result  = ~{~X~^ ~}~%" (map 'list #'char-code string))
+    ;; Make the string have the correct byte order for the native
+    ;; backend.  (This wouldn't be needed if string-to-core had an
+    ;; option to
+    (maybe-byte-swap-string string)
+    #+(or)
+    (format t "post fop-string result = ~{~X~^ ~}~%" (map 'list #'char-code string))
     (string-to-core string)))
 
 (clone-cold-fop (fop-vector)
@@ -1977,8 +2006,15 @@
     #-unicode
     (read-n-bytes *fasl-file* sym 0 len)
     #+unicode
-    (dotimes (k len)
-      (setf (aref sym k) (load-char-code)))
+    (progn
+      (read-n-bytes *fasl-file* sym 0 (* 2 len))
+      #+(or)
+      (progn
+	(format t "foreign-fixup: ~S~%" sym)
+	(format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym)))
+      (maybe-byte-swap-string sym)
+      #+(or)
+      (format t " swaps: ~S~%" sym))
     (let ((offset (read-arg 4))
 	  (value #+linkage-table (cold-register-foreign-linkage sym :code)
 		 #-linkage-table (lookup-foreign-symbol sym)))
@@ -1996,8 +2032,15 @@
     #-unicode
     (read-n-bytes *fasl-file* sym 0 len)
     #+unicode
-    (dotimes (k len)
-      (setf (aref sym k) (load-char-code)))
+    (progn
+      (read-n-bytes *fasl-file* sym 0 (* 2 len))
+      #+(or)
+      (progn
+	(format t "foreign-data-fixup: ~S~%" sym)
+	(format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym)))
+      (maybe-byte-swap-string sym)
+      #+(or)
+      (format t " swaps: ~{~X~^ ~}~%" (map 'list #'char-code sym)))
     (let ((offset (read-arg 4))
 	  (value (cold-register-foreign-linkage sym :data)))
       (do-cold-fixup code-object offset value kind))
@@ -2200,8 +2243,8 @@
 					     type
 					     *cold-linkage-table*
 					     *cold-foreign-hash*)))
-    (+ vm:target-foreign-linkage-space-start
-       (* entry-num vm:target-foreign-linkage-entry-size))))
+    (+ (c:backend-foreign-linkage-space-start c:*backend*)
+       (* entry-num (c:backend-foreign-linkage-entry-size c:*backend*)))))
 
 #+linkage-table
 (defun init-foreign-linkage ()
diff --git a/compiler/ppc/parms.lisp b/compiler/ppc/parms.lisp
index a9ac0e705260c3fff4e0bb30720b0f250e79d967..b2f3ba0911a7bcc3884c6503d54c7669a29645f8 100644
--- a/compiler/ppc/parms.lisp
+++ b/compiler/ppc/parms.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.19 2009/06/11 16:04:00 rtoy Rel $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.20 2010/12/04 17:32:34 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -37,6 +37,11 @@
 (setf (backend-byte-order *target-backend*) :big-endian)
 (setf (backend-page-size *target-backend*) 4096)
 
+(setf (c::backend-foreign-linkage-space-start *target-backend*)
+      #x17000000
+      (c::backend-foreign-linkage-entry-size *target-backend*)
+      32)
+
 ); eval-when
 
 (pushnew :new-assembler *features*)
diff --git a/compiler/sparc/parms.lisp b/compiler/sparc/parms.lisp
index cd4bd5a51326ca82fce521f43f9f2033f015622b..ac331a3f8c437040a6920d66a6fe6764b7535804 100644
--- a/compiler/sparc/parms.lisp
+++ b/compiler/sparc/parms.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.61 2010/04/19 18:21:31 rtoy Rel $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.62 2010/12/04 17:32:34 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -47,6 +47,13 @@
 (setf (backend-page-size *target-backend*)
       #+mach 4096 #+sunos 8192)
 
+(setf (c::backend-foreign-linkage-space-start *target-backend*)
+      ;; This better match the value in sparc-validate.h!
+      #x0f800000
+      (c::backend-foreign-linkage-entry-size *target-backend*)
+      ;; This better agree with what sparc-arch.c thinks it is!  Right now,
+      ;; it's 4 instructions, so 16 bytes.
+      16)
 ); eval-when
 
 (pushnew :new-assembler *features*)
@@ -213,11 +220,10 @@
 (defconstant target-static-space-start    #x28000000)
 (defconstant target-dynamic-space-start   #x40000000)
 
-;; This better match the value in sparc-validate.h!
-(defconstant target-foreign-linkage-space-start #x0f800000)
-;; This better agree with what sparc-arch.c thinks it is!  Right now,
-;; it's 4 instructions, so 16 bytes.
-(defconstant target-foreign-linkage-entry-size 16)
+(defconstant target-foreign-linkage-space-start
+  (c:backend-foreign-linkage-space-start *target-backend*))
+(defconstant target-foreign-linkage-entry-size
+  (c:backend-foreign-linkage-entry-size *target-backend*))
 
 
 ;;;; Other random constants.
diff --git a/compiler/x86/parms.lisp b/compiler/x86/parms.lisp
index 1192ed1fef1c19cb1239969dc35014c1a2c59202..bfff6f61d808879bafc0252ed2d6128dfb82fb43 100644
--- a/compiler/x86/parms.lisp
+++ b/compiler/x86/parms.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.40 2010/07/14 13:14:53 rtoy Rel $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/parms.lisp,v 1.41 2010/12/04 17:32:34 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -62,6 +62,12 @@
 |#
 
 (setf (backend-page-size *target-backend*) 4096)
+
+(setf (c::backend-foreign-linkage-space-start *target-backend*)
+      #+linux #x58000000
+      #-linux #xB0000000
+      (c::backend-foreign-linkage-entry-size *target-backend*)
+      8)
 ); eval-when
 
 
@@ -213,9 +219,9 @@
   #+linux #x58100000
   #-linux #x48000000)
 (defconstant target-foreign-linkage-space-start
-  #+linux #x58000000
-  #-linux #xB0000000)
-(defconstant target-foreign-linkage-entry-size 8) ;In bytes.  Duh.
+  (c:backend-foreign-linkage-space-start *target-backend*))
+(defconstant target-foreign-linkage-entry-size
+  (c:backend-foreign-linkage-entry-size *target-backend*)) ;In bytes.  Duh.
 
 ;;; Given that NIL is the first thing allocated in static space, we
 ;;; know its value at compile time:
diff --git a/lisp/os-common.c b/lisp/os-common.c
index d27c7ddcb260c84e158eefec2ff2ea5fec055327..925f2c6c6bde328771d98f8df628451d8b9f1803 100644
--- a/lisp/os-common.c
+++ b/lisp/os-common.c
@@ -1,6 +1,6 @@
 /*
 
- $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.31 2010/02/01 19:27:07 rtoy Rel $
+ $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.32 2010/12/04 17:32:34 rtoy Exp $
 
  This code was written as part of the CMU Common Lisp project at
  Carnegie Mellon University, and has been placed in the public domain.
@@ -195,6 +195,23 @@ os_foreign_linkage_init(void)
 	 */
 
         convert_lisp_string(c_symbol_name, symbol_name->data, (symbol_name->length >> 2));
+
+#if 0
+        fprintf(stderr, "i =%2d:  %s\n", i, c_symbol_name);
+        {
+            int k;
+            unsigned short int* wide_string;
+                
+            fprintf(stderr, "  symbol_name->data = ");
+
+            wide_string = (unsigned short int *) symbol_name->data;
+                
+            for (k = 0; k < (symbol_name->length >> 2); ++k) {
+                fprintf(stderr, "%4x ", wide_string[k]);
+            }
+            fprintf(stderr, "\n");
+        }
+#endif        
 	if (i == 0) {
 #if defined(sparc)
 	    if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, "call_into_c")) {
@@ -226,6 +243,20 @@ os_foreign_linkage_init(void)
 	    void *target_addr = os_dlsym(c_symbol_name, NIL);
 
 	    if (!target_addr) {
+#if 0
+                int k;
+                unsigned short int* wide_string;
+                
+                fprintf(stderr, "c_symbol_name = `%s'\n", c_symbol_name);
+                fprintf(stderr, "symbol_name->data = \n");
+
+                wide_string = (unsigned short int *) symbol_name->data;
+                
+                for (k = 0; k < (symbol_name->length >> 2); ++k) {
+                    fprintf(stderr, "%4x ", wide_string[k]);
+                }
+                fprintf(stderr, "\n");
+#endif                
 		lose("%s is not defined.\n",  c_symbol_name);
 	    }
 	    arch_make_linkage_entry(i / LINKAGE_DATA_ENTRY_SIZE, target_addr,
diff --git a/tools/cross-scripts/cross-x86-sparc.lisp b/tools/cross-scripts/cross-x86-sparc.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..fbe573c1f632cadf3cc656368b910ef2030de29d
--- /dev/null
+++ b/tools/cross-scripts/cross-x86-sparc.lisp
@@ -0,0 +1,377 @@
+;;; Cross-compile script to build a sparc core using x86 as the
+;;; compiling system.  This needs work!
+
+(in-package :cl-user)
+
+;;; Rename the X86 package and backend so that new-backend does the
+;;; right thing.
+(rename-package "X86" "OLD-X86" '("OLD-VM"))
+(setf (c:backend-name c:*native-backend*) "OLD-X86")
+
+(c::new-backend "SPARC"
+   ;; Features to add here
+   '(:sparc
+     :sparc-v9				; For Ultrasparc processors
+     :complex-fp-vops			; Some slightly faster FP vops on complex numbers
+     :linkage-table
+     :stack-checking			; Throw error if we run out of stack
+     :heap-overflow-check		; Throw error if we run out of
+					; heap (This requires gencgc!)
+     :gencgc				; Generational GC
+     :relative-package-names		; Relative package names from Allegro
+     :conservative-float-type
+     :hash-new
+     :random-mt19937			; MT-19937 generator
+     :cmu				; Announce this is CMUCL
+     :cmu20 :cmu20b			; Current version identifier
+     :modular-arith			; Modular arithmetic
+     :double-double			; Double-double float support
+     :executable
+     
+     :solaris
+     :svr4
+     :sun4
+     :sunos
+     :unix
+     )
+   ;; Features to remove from current *features* here
+   '(:sparc-v8 :sparc-v7		; Choose only one of :sparc-v7, :sparc-v8, :sparc-v9
+     ;; Other architectures we aren't using.  Particularly important
+     ;; to get rid of sse2 and x87 so we don't accidentally try to
+     ;; compile the x87/sse2 float support on sparc, which won't work.
+     :x86 :x86-bootstrap :sse2 :x87 :i486
+     :alpha :osf1 :mips
+     ;; Really old stuff that should have been removed long ago.
+     :propagate-fun-type :propagate-float-type :constrain-float-type
+     ;; Other OSes were not using
+     :openbsd :freebsd :glibc2 :linux :mach-o :darwin :bsd
+     
+     :pentium
+     :long-float
+     :new-random
+     :small
+     :mp))
+
+;;; Changes needed to bootstrap cross-compiling from x86 to sparc
+
+;; Set up the linkage space stuff appropriately for sparc.
+(setf (c::backend-foreign-linkage-space-start c::*target-backend*)
+      #x0f800000
+      (c::backend-foreign-linkage-entry-size c::*target-backend*)
+      16)
+
+(in-package "LISP")
+;; We need the the fops because the cross-compiled fasl file is in
+;; big-endian order for sparc.  When we read in a string, we need to
+;; convert the big-endian string to little-endian for x86 so we can
+;; process the symbols and such as expected.
+(progn
+(defun maybe-swap-string (f name &optional (len (length name)))
+  (declare (ignorable f))
+  (unless (eq (c:backend-byte-order c:*backend*)
+	      (c:backend-byte-order c:*native-backend*))
+    (dotimes (k len)
+      (let ((code (char-code (aref name k))))
+	(setf (aref name k)
+	      (code-char (logior (ash (ldb (byte 8 0) code) 8)
+				 (ldb (byte 8 8) code))))))
+    ;;(format t "~S: new name = ~S~%" f (subseq name 0 len))
+    name))
+
+(macrolet ((frob (name code name-size package)
+	     (let ((n-package (gensym "PACKAGE-"))
+		   (n-size (gensym "SIZE-"))
+		   (n-buffer (gensym "BUFFER-"))
+		   (k (gensym "IDX-")))
+	       `(define-fop (,name ,code)
+		  (prepare-for-fast-read-byte *fasl-file*
+		    (let ((,n-package ,package)
+			  (,n-size (fast-read-u-integer ,name-size)))
+		      (when (> ,n-size *load-symbol-buffer-size*)
+			(setq *load-symbol-buffer*
+			      (make-string (setq *load-symbol-buffer-size*
+						 (* ,n-size 2)))))
+		      (done-with-fast-read-byte)
+		      (let ((,n-buffer *load-symbol-buffer*))
+			(read-n-bytes *fasl-file* ,n-buffer 0
+				      (* old-vm:char-bytes ,n-size))
+			(maybe-swap-string ',name ,n-buffer ,n-size)
+			(push-table (intern* ,n-buffer ,n-size ,n-package)))))))))
+  (frob fop-symbol-save 6 4 *package*)
+  (frob fop-small-symbol-save 7 1 *package*)
+  (frob fop-lisp-symbol-save 75 4 *lisp-package*)
+  (frob fop-lisp-small-symbol-save 76 1 *lisp-package*)
+  (frob fop-keyword-symbol-save 77 4 *keyword-package*)
+  (frob fop-keyword-small-symbol-save 78 1 *keyword-package*)
+
+  (frob fop-symbol-in-package-save 8 4
+    (svref *current-fop-table* (fast-read-u-integer 4)))
+  (frob fop-small-symbol-in-package-save 9 1
+    (svref *current-fop-table* (fast-read-u-integer 4)))
+  (frob fop-symbol-in-byte-package-save 10 4
+    (svref *current-fop-table* (fast-read-u-integer 1)))
+  (frob fop-small-symbol-in-byte-package-save 11 1
+    (svref *current-fop-table* (fast-read-u-integer 1))))
+
+(define-fop (fop-package 14)
+  (let ((name (pop-stack)))
+    ;;(format t "xfop-package: ~{~X~^ ~}~%" (map 'list #'char-code name))
+    (or (find-package name)
+	(error (intl:gettext "The package ~S does not exist.") name))))
+
+(clone-fop (fop-string 37)
+	   (fop-small-string 38)
+  (let* ((arg (clone-arg))
+	 (res (make-string arg)))
+    (read-n-bytes *fasl-file* res 0
+		  (* old-vm:char-bytes arg))
+    (maybe-swap-string 'fop-string res)
+    res))
+
+#+unicode
+(defun cold-load-symbol (size package)
+  (let ((string (make-string size)))
+    (read-n-bytes *fasl-file* string 0 (* 2 size))
+    ;;(format t "xpre swap cold-load-symbol: ~S to package ~S~%" string package)
+    (maybe-swap-string 'cold-load-symbol string)
+    ;;(format t "xpost swap cold-load-symbol: ~S to package ~S~%" string package)
+    (cold-intern (intern string package) package)))
+)
+
+
+;;; End changes needed to bootstrap cross-compiling from x86 to sparc
+
+;;; Extern-alien-name for the new backend.
+(in-package :vm)
+(defun extern-alien-name (name)
+  (declare (type simple-string name))
+  ;;(format t "extern-alien-name: ~S~%" name)
+  ;;(lisp::maybe-swap-string 'extern-alien-name (copy-seq name))
+  name)
+(export 'extern-alien-name)
+#+(or)
+(defun fixup-code-object (code offset fixup kind)
+  (declare (type index offset))
+  (unless (zerop (rem offset vm::word-bytes))
+    (error (intl:gettext "Unaligned instruction?  offset=#x~X.") offset))
+  (system:without-gcing
+   (let ((sap (truly-the system-area-pointer
+			 (%primitive c::code-instructions code))))
+     (ecase kind
+       (:call
+	(error (intl:gettext "Can't deal with CALL fixups, yet.")))
+       (:sethi
+	(setf (ldb (byte 22 0) (sap-ref-32 sap offset))
+	      (ldb (byte 22 10) fixup)))
+       (:add
+	(setf (ldb (byte 10 0) (sap-ref-32 sap offset))
+	      (ldb (byte 10 0) fixup)))))))
+(export 'fixup-code-object)
+#+(or)
+(defun sanctify-for-execution (component)
+  (without-gcing
+    (alien-funcall (extern-alien "os_flush_icache"
+				 (function void
+					   system-area-pointer
+					   unsigned-long))
+		   (code-instructions component)
+		   (* (code-header-ref component code-code-size-slot)
+		      word-bytes)))
+  nil)
+(export 'sanctify-for-execution)
+
+;;; Compile the new backend.
+(pushnew :bootstrap *features*)
+(pushnew :building-cross-compiler *features*)
+(load "target:tools/comcom")
+
+;;; Load the new backend.
+(setf (search-list "c:")
+      '("target:compiler/"))
+(setf (search-list "vm:")
+      '("c:sparc/" "c:generic/"))
+(setf (search-list "assem:")
+      '("target:assembly/" "target:assembly/sparc/"))
+
+;; Load the backend of the compiler.
+
+(in-package "C")
+
+(load "vm:vm-macs")
+(load "vm:parms")
+(load "vm:objdef")
+(load "vm:interr")
+(load "assem:support")
+
+(load "target:compiler/srctran")
+(load "vm:vm-typetran")
+(load "target:compiler/float-tran")
+(load "target:compiler/saptran")
+
+(load "vm:macros")
+(load "vm:utils")
+
+(load "vm:vm")
+(load "vm:insts")
+(load "vm:primtype")
+(load "vm:move")
+(load "vm:sap")
+(load "vm:system")
+(load "vm:char")
+(load "vm:float")
+
+(load "vm:memory")
+(load "vm:static-fn")
+(load "vm:arith")
+(load "vm:cell")
+(load "vm:subprim")
+(load "vm:debug")
+(load "vm:c-call")
+(load "vm:print")
+(load "vm:alloc")
+(load "vm:call")
+(load "vm:nlx")
+(load "vm:values")
+(load "vm:array")
+(load "vm:pred")
+(load "vm:type-vops")
+
+(load "assem:assem-rtns")
+
+(load "assem:array")
+(load "assem:arith")
+(load "assem:alloc")
+
+(load "c:pseudo-vops")
+
+(check-move-function-consistency)
+
+(load "vm:new-genesis")
+
+;;; OK, the cross compiler backend is loaded.
+
+(setf *features* (remove :building-cross-compiler *features*))
+
+;;; Info environment hacks.
+(macrolet ((frob (&rest syms)
+	     `(progn ,@(mapcar #'(lambda (sym)
+				   `(defconstant ,sym
+				      (symbol-value
+				       (find-symbol ,(symbol-name sym)
+						    :vm))))
+			       syms))))
+  (frob OLD-VM:BYTE-BITS OLD-VM:WORD-BITS
+	OLD-VM:CHAR-BITS
+	OLD-VM:LOWTAG-BITS
+	#+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE 
+	OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE 
+	OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE
+	#+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE 
+	OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE 
+	OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE
+	OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE 
+	OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE
+	OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE 
+	OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE 
+	OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE 
+	OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE 
+	OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE
+	OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE 
+	OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE
+	OLD-VM:SIMPLE-BIT-VECTOR-TYPE
+	OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE 
+	OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET
+	OLD-VM:DOUBLE-FLOAT-DIGITS
+	old-vm:single-float-digits
+	OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE
+	OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX
+	OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE
+	OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE
+	OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX
+	OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE
+	)
+  #+double-double
+  (frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE
+	OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE)
+  )
+
+(let ((function (symbol-function 'kernel:error-number-or-lose)))
+  (let ((*info-environment* (c:backend-info-environment c:*target-backend*)))
+    (setf (symbol-function 'kernel:error-number-or-lose) function)
+    (setf (info function kind 'kernel:error-number-or-lose) :function)
+    (setf (info function where-from 'kernel:error-number-or-lose) :defined)))
+
+(defun fix-class (name)
+  (let* ((new-value (find-class name))
+	 (new-layout (kernel::%class-layout new-value))
+	 (new-cell (kernel::find-class-cell name))
+	 (*info-environment* (c:backend-info-environment c:*target-backend*)))
+    (remhash name kernel::*forward-referenced-layouts*)
+    (kernel::%note-type-defined name)
+    (setf (info type kind name) :instance)
+    (setf (info type class name) new-cell)
+    (setf (info type compiler-layout name) new-layout)
+    new-value))
+(fix-class 'c::vop-parse)
+(fix-class 'c::operand-parse)
+
+#+random-mt19937
+(declaim (notinline kernel:random-chunk))
+
+(setf c:*backend* c:*target-backend*)
+
+;;; Extern-alien-name for the new backend.
+(in-package :vm)
+(defun extern-alien-name (name)
+  (declare (type simple-string name))
+  ;;(format t "extern-alien-name: ~S~%" name)
+  ;;(lisp::maybe-swap-string 'extern-alien-name (copy-seq name))
+  name)
+(export 'extern-alien-name)
+#+(or)
+(defun fixup-code-object (code offset fixup kind)
+  (declare (type index offset))
+  (unless (zerop (rem offset vm::word-bytes))
+    (error (intl:gettext "Unaligned instruction?  offset=#x~X.") offset))
+  (system:without-gcing
+   (let ((sap (truly-the system-area-pointer
+			 (%primitive c::code-instructions code))))
+     (ecase kind
+       (:call
+	(error (intl:gettext "Can't deal with CALL fixups, yet.")))
+       (:sethi
+	(setf (ldb (byte 22 0) (sap-ref-32 sap offset))
+	      (ldb (byte 22 10) fixup)))
+       (:add
+	(setf (ldb (byte 10 0) (sap-ref-32 sap offset))
+	      (ldb (byte 10 0) fixup)))))))
+(export 'fixup-code-object)
+#+(or)
+(defun sanctify-for-execution (component)
+  (without-gcing
+    (alien-funcall (extern-alien "os_flush_icache"
+				 (function void
+					   system-area-pointer
+					   unsigned-long))
+		   (code-instructions component)
+		   (* (code-header-ref component code-code-size-slot)
+		      word-bytes)))
+  nil)
+(export 'sanctify-for-execution)
+
+(in-package :cl-user)
+
+;;; Don't load compiler parts from the target compilation
+
+(defparameter *load-stuff* nil)
+
+;; hack, hack, hack: Make old-x86::any-reg the same as
+;; x86::any-reg as an SC.  Do this by adding old-x86::any-reg
+;; to the hash table with the same value as x86::any-reg.
+     
+(let ((ht (c::backend-sc-names c::*target-backend*)))
+  (setf (gethash 'old-vm::any-reg ht)
+	(gethash 'vm::any-reg ht)))
+
+
+;;(pushnew :debug *features*)