Date: Thursday, November 11, 2010 @ 16:48:24 Author: rtoy Path: /project/cmucl/cvsroot/src/compiler/generic
Modified: new-genesis.lisp
When storing strings to the core file, swap the bytes of Unicode strings if the byte order of the backend and the native backend are different.
------------------+ new-genesis.lisp | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-)
Index: src/compiler/generic/new-genesis.lisp diff -u src/compiler/generic/new-genesis.lisp:1.90 src/compiler/generic/new-genesis.lisp:1.91 --- src/compiler/generic/new-genesis.lisp:1.90 Mon Jul 19 19:08:37 2010 +++ src/compiler/generic/new-genesis.lisp Thu Nov 11 16:48:24 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.90 2010-07-19 23:08:37 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.91 2010-11-11 21:48:24 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -434,6 +434,13 @@ ;;(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. + (dotimes (k len) + (let ((x (aref bytes k))) + (setf (aref bytes k) (+ (ldb (byte 8 8) x) + (ash (ldb (byte 8 0) x) 8)))))) (copy-to-system-area bytes (* vm:vector-data-offset ;; the word size of the native backend which ;; may be different from the target backend