[cmucl-cvs] CMUCL commit: src (4 files)
Raymond Toy
rtoy at common-lisp.net
Wed Nov 10 19:51:24 UTC 2010
Date: Wednesday, November 10, 2010 @ 14:51:24
Author: rtoy
Path: /project/cmucl/cvsroot/src
Added: bootfiles/20b/boot-2010-11-1-cross.lisp
Modified: code/exports.lisp compiler/backend.lisp compiler/dump.lisp
Add new slots to the backend to hold the foreign linkage space start
and entry size. Not yet used anywhere.
This change needs a cross-compile; use boot-2010-11-1-cross.lisp as
the cross-compile script.
compiler/backend.lisp:
o Add the two new slots to the backend.
compiler/dump.lisp:
o DUMP-DATA-MAYBE-BYTE-SWAPPING needs to handle (unicode) strings
o DUMP-DATA-MAYBE-BYTE-SWAPPING should not swap bytes of a string.
Genesis will make that happen.
code/exports.lisp:
o Export BACKEND-FOREIGN-LINKAGE-SPACE-START and
BACKEND-FOREIGN-LINKAGE-ENTRY-SIZE.
bootfiles/20b/boot-2010-11-1-cross.lisp:
o Cross-compile script for this change.
-----------------------------------------+
bootfiles/20b/boot-2010-11-1-cross.lisp | 10 ++++++++++
code/exports.lisp | 7 +++++--
compiler/backend.lisp | 11 +++++++++--
compiler/dump.lisp | 29 +++++++++++++++++++----------
4 files changed, 43 insertions(+), 14 deletions(-)
Index: src/bootfiles/20b/boot-2010-11-1-cross.lisp
diff -u /dev/null src/bootfiles/20b/boot-2010-11-1-cross.lisp:1.1
--- /dev/null Wed Nov 10 14:51:24 2010
+++ src/bootfiles/20b/boot-2010-11-1-cross.lisp Wed Nov 10 14:51:23 2010
@@ -0,0 +1,10 @@
+;;; Adding slots to the backend requires a cross-compile.
+;;;
+;;; Answer CLOBBER-IT for the restart about changing the size of the
+;;; backend structure.
+
+#+x86
+(load "target:tools/cross-scripts/cross-x86-x86")
+
+#+sparc
+(load "target:tools/cross-scripts/cross-sparc-sparc")
Index: src/code/exports.lisp
diff -u src/code/exports.lisp:1.301 src/code/exports.lisp:1.302
--- src/code/exports.lisp:1.301 Fri Sep 17 19:29:00 2010
+++ src/code/exports.lisp Wed Nov 10 14:51:23 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/exports.lisp,v 1.301 2010-09-17 23:29:00 rtoy Rel $")
+ "$Header: /project/cmucl/cvsroot/src/code/exports.lisp,v 1.302 2010-11-10 19:51:23 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1666,7 +1666,10 @@
"BACKEND-ASSEMBLER-RESOURCES" "BACKEND-BYTE-ORDER"
"BACKEND-DISASSEM-PARAMS" "BACKEND-FASL-FILE-IMPLEMENTATION"
"BACKEND-FASL-FILE-TYPE" "BACKEND-FASL-FILE-VERSION"
- "BACKEND-FEATURES" "BACKEND-INFO-ENVIRONMENT"
+ "BACKEND-FEATURES"
+ "BACKEND-FOREIGN-LINKAGE-SPACE-START"
+ "BACKEND-FOREIGN-LINKAGE-ENTRY-SIZE"
+ "BACKEND-INFO-ENVIRONMENT"
"BACKEND-INSTRUCTION-FLAVORS" "BACKEND-INSTRUCTION-FORMATS"
"BACKEND-NAME" "BACKEND-REGISTER-SAVE-PENALTY"
"BACKEND-SPECIAL-ARG-TYPES" "BACKEND-VERSION" "BIND" "BRANCH"
Index: src/compiler/backend.lisp
diff -u src/compiler/backend.lisp:1.35 src/compiler/backend.lisp:1.36
--- src/compiler/backend.lisp:1.35 Tue Apr 20 13:57:46 2010
+++ src/compiler/backend.lisp Wed Nov 10 14:51:24 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/backend.lisp,v 1.35 2010-04-20 17:57:46 rtoy Rel $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/backend.lisp,v 1.36 2010-11-10 19:51:24 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -26,6 +26,8 @@
backend-assembler-resources backend-special-arg-types
backend-disassem-params backend-internal-errors
backend-assembler-params backend-page-size
+ backend-foreign-linkage-space-start
+ backend-foreign-linkage-entry-size
;; The various backends need to call these support routines
def-vm-support-routine make-stack-pointer-tn primitive-type
@@ -226,7 +228,12 @@
(assembler-params nil :type t)
;; The maximum number of bytes per page on this system. Used by genesis.
- (page-size 0 :type index))
+ (page-size 0 :type index)
+
+ ;; The foreign linkage space start and size
+
+ (foreign-linkage-space-start 0 :type (unsigned-byte 32))
+ (foreign-linkage-entry-size 0 :type index))
(defprinter backend
Index: src/compiler/dump.lisp
diff -u src/compiler/dump.lisp:1.88 src/compiler/dump.lisp:1.89
--- src/compiler/dump.lisp:1.88 Tue Oct 12 17:52:44 2010
+++ src/compiler/dump.lisp Wed Nov 10 14:51:24 2010
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/dump.lisp,v 1.88 2010-10-12 21:52:44 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/dump.lisp,v 1.89 2010-11-10 19:51:24 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1634,15 +1634,24 @@
(declare (type (integer 1 #.most-positive-fixnum)
bytes-per-element)
(type unsigned-byte elements))
- (dotimes (index elements)
- (let ((element (aref data-vector index))
- (new-element 0))
- (dotimes (i bytes-per-element)
- (setf new-element
- (logior (ash new-element vm:byte-bits)
- (ldb (byte vm:byte-bits 0) element)))
- (setf element (ash element (- vm:byte-bits))))
- (setf (aref result index) new-element)))
+ (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))))
+ (dotimes (index elements)
+ (let ((element (aref data-vector index))
+ (new-element 0))
+ (dotimes (i bytes-per-element)
+ (setf new-element
+ (logior (ash new-element vm:byte-bits)
+ (ldb (byte vm:byte-bits 0) element)))
+ (setf element (ash element (- vm:byte-bits))))
+ (setf (aref result index) new-element))))
(dump-bytes result bytes file)))
(t
(let* ((elements-per-byte (/ vm:byte-bits element-size))
More information about the cmucl-cvs
mailing list