[cmucl-commit] CMUCL commit: cross-sparc-branch src/compiler/generic (new-genesis.lisp)

[Raymond Toy]

    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