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