[cmucl-commit] CMUCL commit: cross-sparc-branch src/compiler/generic (new-genesis.lisp)
Raymond Toy
rtoy at common-lisp.net
Thu Nov 18 01:25:10 CET 2010
Date: Wednesday, November 17, 2010 @ 19:25:10
Author: rtoy
Path: /project/cmucl/cvsroot/src/compiler/generic
Tag: cross-sparc-branch
Modified: new-genesis.lisp
o Comment out debugging prints.
o Add some comments.
------------------+
new-genesis.lisp | 41 ++++++++++++++++++++++++++++++-----------
1 file changed, 30 insertions(+), 11 deletions(-)
Index: src/compiler/generic/new-genesis.lisp
diff -u src/compiler/generic/new-genesis.lisp:1.91.2.2 src/compiler/generic/new-genesis.lisp:1.91.2.3
--- src/compiler/generic/new-genesis.lisp:1.91.2.2 Tue Nov 16 17:01:49 2010
+++ src/compiler/generic/new-genesis.lisp Wed Nov 17 19:25:10 2010
@@ -4,7 +4,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.91.2.2 2010-11-16 22:01:49 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.91.2.3 2010-11-18 00:25:10 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -436,14 +436,17 @@
(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.
- (format t "s-t-c: len = ~d, ~S~%" len string)
- (format t " codes = ~{~X~^ ~}~%" (map 'list #'char-code string))
+ ;; 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) (maybe-byte-swap-short x))))
- (format t " new codes = ~{~X~^ ~}~%" (coerce bytes 'list))
- )
+ #+(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
@@ -1341,6 +1344,8 @@
(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*))
@@ -1353,8 +1358,12 @@
(defun cold-load-symbol (size package)
(let ((string (make-string size)))
(read-n-bytes *fasl-file* string 0 (* 2 size))
+ #+(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)))
@@ -1464,8 +1473,13 @@
(let* ((len (clone-arg))
(string (make-string len)))
(read-n-bytes *fasl-file* string 0 (* 2 len))
+ #+(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)))
@@ -1994,9 +2008,12 @@
#+unicode
(progn
(read-n-bytes *fasl-file* sym 0 (* 2 len))
- (format t "foreign-fixup: ~S~%" sym)
- (format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym))
+ #+(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)
@@ -2017,9 +2034,12 @@
#+unicode
(progn
(read-n-bytes *fasl-file* sym 0 (* 2 len))
- (format t "foreign-data-fixup: ~S~%" sym)
- (format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym))
+ #+(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)))
@@ -2484,7 +2504,6 @@
(defun linkage-info-to-core ()
(let ((result *nil-descriptor*))
(maphash #'(lambda (symbol value)
- (format t "linkage-info symbol = ~S~%" symbol)
(cold-push (allocate-cons *dynamic*
(string-to-core symbol)
(number-to-core value))
More information about the cmucl-commit
mailing list