Skip to content
Snippets Groups Projects
Commit 3cd77bef authored by rtoy's avatar rtoy
Browse files

Support cross-compiling from x86 to sparc, unicode. Also fixes some

bugs with dumping unicode strings to fasls on a different endian
architecture.  Combined with cross-x86-sparc.lisp, this will
successfully cross-compile from x86 (OSX) to sparc (Solaris).  The
result won't, unfortunately, built itself, but if the callback support
is commented out, the build is successful.  This new build can then be
successfully used to do another build that includes callback support.
don't know what is causing this issue.

compiler/dump.lisp:
o DUMP-DATA-MAYBE-BYTE-SWAPPING needs to byte-swap unicode (16-bit)
  strings.

compiler/generic/new-genesis.lisp:
o STRING-TO-CORE needs to swap the byte order of unicode strings if
  the backend and native backend have different endianness.
o LOAD-CHAR-CODE should load characters based on the backend, not
  native-backend.  (This not used anymore, though?)
o Add new function byte-swap the char codes of a unicode string.
o COLD-LOAD-SYMBOL calls MAYBE-BYTE-SWAP-STRING
o FOP-UNINTERNED-SYMBOL-SAVE, FOP-UNINTERNED-SMALL-SYMBOL-SAVE,
  FOP-STRING, FOP-SMALL-STRING, FOP-FOREIGN-FIXUP,
  and FOP-FOREIGN-DATA-FIXUP need to call MAYBE-BYTE-SWAP-STRING for
  unicode strings.

compiler/ppc/parms.lisp:
compiler/sparc/parms.lisp:
compiler/x86/parms.lisp:
o Initialize backend foreign-linkage space start and entry size
  appropriately.  The target versions are initialized from the backend
  values now too.


lisp/os-common.c:
o Some debugging stuff for foreign linkage data to print out symbol
  names.  Currently ifdef'ed out.
parent 4f4cd1aa
No related branches found
No related tags found
No related merge requests found
......@@ -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))
......
......@@ -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 ()
......
......@@ -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*)
......
......@@ -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.
......
......@@ -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:
......
/*
$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,
......
;;; 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*)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment