;;;
;;; Cross-compiler x86 to x86, allowing incompatible changes to the
;;; native code generation.
;;;
(in-package "USER")

;;; Setup the path for the cross compiler.
(setf (ext:search-list "trunk:")
      '("/home/cracauer/work/cvs-cmucl-work/"))
(setf (ext:search-list "crabuild:")
      '("/home/cracauer/work/cvs-work/prg/cmucl-build/"))
(setf (ext:search-list "target:")
      '("trunk:cross/"		; object dir
	"trunk:src/"		; source dir
	))
(setf (ext:search-list "src:")
      '("crabuild:"
	"trunk:p86/"
	"trunk:src/"))

(load "target:tools/setup" :if-source-newer :load-source)
(comf "target:tools/setup" :load t)

(setf *interactive* nil)
(setf *gc-verbose* nil)

;;; Rename the X86 package and backend so that new-backend does the
;;; right thing.
(rename-package "X86" "OLD-X86")
(setf (c:backend-name c:*native-backend*) "OLD-X86")

;#+nil
(c::new-backend "X86"
   '(:x86 :x86-bootstrap :new-assembler :gencgc :random-mt19937
     :hash-new :i486 :bsd :FreeBSD)
   '(:alpha :osf1 :sparc :mips :sunos :new-random :pentium))
;;; FreeBSD to Linux cross compile.
#+nil
(c::new-backend "X86"
   '(:x86 :x86-bootstrap :new-assembler :gencgc :random-mt19937
     :hash-new :i486 :linux)
   '(:bsd :FreeBSD :mp :cgc :pentium :random-df :random-lfsr113
     :random-acarry-skip :random-acarrypc))

;;; 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 "USER")

;;; Compile the new backend.
(pushnew :bootstrap *features*)
(load "target:tools/comcom")

;;; Load the new backend.
(setf (search-list "c:")
      '("target:compiler/"))
(setf (search-list "vm:")
      '("c:x86/" "c:generic/"))
(setf (search-list "assem:")
      '("target:assembly/" "target:assembly/x86/"))
;;; Note: may need to add extra files to load to loadbackend, perhaps
;;; float-tran and srctran; try to follow the order in comcom as this
;;; is often important.
(load "cross-loadbackend")
(load "vm:new-genesis")

;;; OK, the cross compiler backend is loaded.

;;; Setup the path for the new build.
(setf (search-list "target:")		; files for the new compiler
      '("trunk:build/freebsd/"
	"trunk:p86/"
	"trunk:src/"))

;;; Info environment hacks.
(macrolet ((frob (&rest syms)
	     `(progn ,@(mapcar #'(lambda (sym)
				   `(defconstant ,sym
				      (symbol-value
				       (find-symbol ,(symbol-name sym)
						    :vm))))
			       syms))))
  (frob OLD-X86:BYTE-BITS OLD-X86:WORD-BITS
	#+long-float OLD-X86:SIMPLE-ARRAY-LONG-FLOAT-TYPE 
	OLD-X86:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE 
	OLD-X86:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE
	#+long-float OLD-X86:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE 
	OLD-X86:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE 
	OLD-X86:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE
	OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE 
	OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE
	OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE 
	OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE 
	OLD-X86:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE 
	OLD-X86:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE 
	OLD-X86:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE
	OLD-X86:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE 
	OLD-X86:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE
	OLD-X86:SIMPLE-BIT-VECTOR-TYPE
	OLD-X86:SIMPLE-STRING-TYPE OLD-X86:SIMPLE-VECTOR-TYPE 
	OLD-X86:SIMPLE-ARRAY-TYPE OLD-X86:VECTOR-DATA-OFFSET))

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

;;; Ready to build.
(pushnew :bootstrap *features*)
(load "target:tools/worldcom")
(load "target:tools/comcom")
(load "target:tools/worldbuild")