Add cross script for sparc

(in-package :cl-user)

;;; Rename the SPARC package and backend so that new-backend does the

;;; right thing.

(rename-package "SPARC" "OLD-SPARC" '("OLD-VM"))

(setf (c:backend-name c:*native-backend*) "OLD-SPARC")

(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-xoroshiro			; xoroshiro128+ RNG

     :cmu				; Announce this is CMUCL

     :cmu20 :cmu20a			; Current version identifier

     :modular-arith			; Modular arithmetic

     :double-double			; Double-double float support

     )

   ;; 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.

     :x86 :x86-bootstrap

     :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

     :pentium

     :long-float

     :new-random

     :random-mt19937			; MT-19937 generator

     :small))

;;; May need to add some symbols to *features* and

;;; sys::*runtime-features* as well.  This might be needed even if we

;;; have those listed above, because of the code checks for things in

;;; *features* and not in the backend-features..  So do that here.

;;; Extern-alien-name for the new backend.

(in-package :vm)

(defun extern-alien-name (name)

  (declare (type simple-string name))

  #+(and bsd (not elf))

  (concatenate 'string "_" name)

  #-(and bsd (not elf))

  name)

;; When compiling the compiler, vm:fixup-code-object and

;; vm:sanctify-for-execution are undefined.  Import these to get rid

;; of that error.

(import 'old-vm::fixup-code-object)

(import 'old-vm::sanctify-for-execution)

(export 'extern-alien-name)

(export 'fixup-code-object)

(export 'sanctify-for-execution)

(in-package :cl-user)

;;; 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:CHAR-BYTES

	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)

  )

;; Modular arith hacks.  When cross-compiling, the compiler wants to

;; constant-fold some stuff, and it needs the following functions to

;; do so.  This just gets rid of the hundreds of errors that happen.

(setf (fdefinition 'vm::ash-left-mod32) #'old-vm::ash-left-mod32)

(setf (fdefinition 'vm::lognot-mod32) #'old-vm::lognot-mod32)

;; End modular arith hacks

(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))

  name)

(export 'extern-alien-name)

(export 'fixup-code-object)

(export 'sanctify-for-execution)

(in-package :cl-user)

;;; Don't load compiler parts from the target compilation

(defparameter *load-stuff* nil)

;; Sometimes during cross-compile sparc::any-reg isn't defined during

;; cross-compile.

;;

;; hack, hack, hack: Make old-vm::any-reg the same as

;; sparc::any-reg as an SC.  Do this by adding old-vm::any-reg

;; to the hash table with the same value as sparc::any-reg.

(let ((ht (c::backend-sc-names c::*target-backend*)))

  (setf (gethash 'old-vm::any-reg ht)

	(gethash 'vm::any-reg ht)))