Date: Tuesday, November 16, 2010 @ 17:01:50 Author: rtoy Path: /project/cmucl/cvsroot/src/compiler/generic Tag: cross-sparc-branch Modified: new-genesis.lisp Don't need to do the weird stuff in cold-register-foreign-linkage and make-cold-linkage-vector anymore because I forgot to byte-swap the foreign-fixup stuff. o Add optional length parameter to MAYBE-BYTE-SWAP-STRING so we don't print out the entire string if we're not using it all. o Don't need to do the weird byte-swap in make-cold-linkage-vector. o Remove debugging print from make-cold-linkage-vector. o Swap bytes if necessary in fop-foreign-fixup and fop-foreign-data-fixup. o Remove optional swap-p parameter from cold-register-foreign-linkage because it's not needed anymore. o No need to supply swap-p parameter when registering "call_into_c". ------------------+ new-genesis.lisp | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) Index: src/compiler/generic/new-genesis.lisp diff -u src/compiler/generic/new-genesis.lisp:1.91.2.1 src/compiler/generic/new-genesis.lisp:1.91.2.2 --- src/compiler/generic/new-genesis.lisp:1.91.2.1 Tue Nov 16 12:29:34 2010 +++ src/compiler/generic/new-genesis.lisp Tue Nov 16 17:01:49 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.1 2010-11-16 17:29:34 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.91.2.2 2010-11-16 22:01:49 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1341,10 +1341,10 @@ (logior (ash (ldb (byte 8 0) n) 8) (ldb (byte 8 8) n))) -(defun maybe-byte-swap-string (s) +(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 (length s)) + (dotimes (k len) (let ((code (char-code (aref s k)))) (setf (aref s k) (code-char (swap-16 code)))))) s) @@ -1611,9 +1611,6 @@ do (write-indexed data-vec (+ i vm:vector-data-offset) (etypecase vec-elem (string - (format t "make-cold-linkage-vector: string = ~{~X~^ ~}~%" - (map 'list #'char-code vec-elem)) - (maybe-byte-swap-string vec-elem) (string-to-core vec-elem)) (number (number-to-core vec-elem)) @@ -1995,8 +1992,12 @@ #-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)) + (format t "foreign-fixup: ~S~%" sym) + (format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym)) + (maybe-byte-swap-string sym) + (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))) @@ -2014,8 +2015,12 @@ #-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)) + (format t "foreign-data-fixup: ~S~%" sym) + (format t " codes: ~{~X~^ ~}~%" (map 'list #'char-code sym)) + (maybe-byte-swap-string sym) + (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)) @@ -2213,10 +2218,8 @@ (defvar *cold-foreign-hash* (make-hash-table :test #'equal)) #+linkage-table -(defun cold-register-foreign-linkage (sym type &optional (swap-p nil)) - (let ((entry-num (register-foreign-linkage (if swap-p - (maybe-byte-swap-string (copy-seq sym)) - sym) +(defun cold-register-foreign-linkage (sym type) + (let ((entry-num (register-foreign-linkage sym type *cold-linkage-table* *cold-foreign-hash*))) @@ -2233,7 +2236,7 @@ (cold-register-foreign-linkage "resolve_linkage_tramp" :code) #+(or sparc ppc) (progn - (cold-register-foreign-linkage (vm::extern-alien-name "call_into_c") :code t) + (cold-register-foreign-linkage (vm::extern-alien-name "call_into_c") :code) #-sparc (cold-register-foreign-linkage (vm::extern-alien-name "undefined_tramp") :data) #-sparc