From ce8d55de55c26673c07c985bc21db14c2e2652b5 Mon Sep 17 00:00:00 2001 From: Raymond Toy <rtoy@google.com> Date: Wed, 1 Feb 2012 09:13:24 -0800 Subject: [PATCH] Move common unicode fasl fops from the main ppc and sparc cross scripts to its own file so that they can be shared. --- .../cross-unicode-big-endian.lisp | 93 +++++++++++++ .../cross-scripts/cross-x86-ppc-darwin.lisp | 122 ++++-------------- src/tools/cross-scripts/cross-x86-sparc.lisp | 81 +----------- 3 files changed, 121 insertions(+), 175 deletions(-) create mode 100644 src/tools/cross-scripts/cross-unicode-big-endian.lisp diff --git a/src/tools/cross-scripts/cross-unicode-big-endian.lisp b/src/tools/cross-scripts/cross-unicode-big-endian.lisp new file mode 100644 index 000000000..74fffbb58 --- /dev/null +++ b/src/tools/cross-scripts/cross-unicode-big-endian.lisp @@ -0,0 +1,93 @@ +;; Common parts for cross-compiling from a little-ending machine to a +;; big-endian machine like sparc or ppc. Basically, we need to adjust +;; the fops that deal with strings (like symbols and strings). The +;; strings in the fasls are written in the target byte order, but the +;; compiling system (little-endian) needs to be able to read them back +;; in correctly to create kernel.core. + +(in-package "VM") +;; Define char-bytes. Don't know why this isn't defined for the new +;; backend on sparc and ppc. +(defconstant char-bytes #+unicode 2 #-unicode 1) +(export 'char-bytes) +(in-package "CL-USER") + +(in-package "LISP") +;; We need the the fops if the cross-compiled fasl file is in +;; big-endian order. When we read in a string, we need to +;; convert the big-endian string to little-endian for x86 so we can +;; process the symbols and such as expected. +#+unicode +(progn +(defun maybe-swap-string (f name &optional (len (length name))) + (declare (ignorable f)) + (unless (eq (c:backend-byte-order c:*backend*) + (c:backend-byte-order c:*native-backend*)) + (dotimes (k len) + (let ((code (char-code (aref name k)))) + (setf (aref name k) + (code-char (logior (ash (ldb (byte 8 0) code) 8) + (ldb (byte 8 8) code)))))) + ;;(format t "~S: new name = ~S~%" f (subseq name 0 len)) + name)) + +(macrolet ((frob (name code name-size package) + (let ((n-package (gensym "PACKAGE-")) + (n-size (gensym "SIZE-")) + (n-buffer (gensym "BUFFER-")) + (k (gensym "IDX-"))) + `(define-fop (,name ,code) + (prepare-for-fast-read-byte *fasl-file* + (let ((,n-package ,package) + (,n-size (fast-read-u-integer ,name-size))) + (when (> ,n-size *load-symbol-buffer-size*) + (setq *load-symbol-buffer* + (make-string (setq *load-symbol-buffer-size* + (* ,n-size vm:char-bytes))))) + (done-with-fast-read-byte) + (let ((,n-buffer *load-symbol-buffer*)) + (read-n-bytes *fasl-file* ,n-buffer 0 + (* old-vm:char-bytes ,n-size)) + (maybe-swap-string ',name ,n-buffer ,n-size) + (push-table (intern* ,n-buffer ,n-size ,n-package))))))))) + (frob fop-symbol-save 6 4 *package*) + (frob fop-small-symbol-save 7 1 *package*) + (frob fop-lisp-symbol-save 75 4 *lisp-package*) + (frob fop-lisp-small-symbol-save 76 1 *lisp-package*) + (frob fop-keyword-symbol-save 77 4 *keyword-package*) + (frob fop-keyword-small-symbol-save 78 1 *keyword-package*) + + (frob fop-symbol-in-package-save 8 4 + (svref *current-fop-table* (fast-read-u-integer 4))) + (frob fop-small-symbol-in-package-save 9 1 + (svref *current-fop-table* (fast-read-u-integer 4))) + (frob fop-symbol-in-byte-package-save 10 4 + (svref *current-fop-table* (fast-read-u-integer 1))) + (frob fop-small-symbol-in-byte-package-save 11 1 + (svref *current-fop-table* (fast-read-u-integer 1)))) + +(define-fop (fop-package 14) + (let ((name (pop-stack))) + ;;(format t "xfop-package: ~{~X~^ ~}~%" (map 'list #'char-code name)) + (or (find-package name) + (error (intl:gettext "The package ~S does not exist.") name)))) + +(clone-fop (fop-string 37) + (fop-small-string 38) + (let* ((arg (clone-arg)) + (res (make-string arg))) + (read-n-bytes *fasl-file* res 0 + (* old-vm:char-bytes arg)) + (maybe-swap-string 'fop-string res) + res)) + +#+unicode +(defun cold-load-symbol (size package) + (let ((string (make-string size))) + (read-n-bytes *fasl-file* string 0 (* 2 size)) + ;;(format t "xpre swap cold-load-symbol: ~S to package ~S~%" string package) + (maybe-swap-string 'cold-load-symbol string) + ;;(format t "xpost swap cold-load-symbol: ~S to package ~S~%" string package) + (cold-intern (intern string package) package))) +) + diff --git a/src/tools/cross-scripts/cross-x86-ppc-darwin.lisp b/src/tools/cross-scripts/cross-x86-ppc-darwin.lisp index 054116316..0d492de2c 100644 --- a/src/tools/cross-scripts/cross-x86-ppc-darwin.lisp +++ b/src/tools/cross-scripts/cross-x86-ppc-darwin.lisp @@ -1,3 +1,6 @@ +;;; Cross-compile script to build a ppc core using x86 as the +;;; compiling system. This needs work! + (in-package :cl-user) ;;; Rename the X86 package and backend so that new-backend does the @@ -9,32 +12,35 @@ ;; Features to add here '(:ppc :conservative-float-type - :hash-new :random-mt19937 - :darwin :bsd - :cmu :cmu20 :cmu20a - :gencgc + :hash-new + :random-mt19937 ; MT-19937 rng + :darwin ; Darwin OS (Mac OS X) + :bsd ; We're a BSD-type OS + :cmu ; Announce this is CMUCL + :cmu20 :cmu20a ; (Mostly) current version identifier + :gencgc ; Generational GC is supported on ppc. :relative-package-names - :modular-arith - :double-double + :modular-arith ; Modular arithmetic + :double-double ; Double-double float support :linkage-table ) ;; Features to remove from current *features* here '( ;; Other architectures we aren't using. Particularly important ;; to get rid of sse2 and x87 so we don't accidentally try to - ;; compile the x87/sse2 float support on sparc, which won't work. - :x86 :x86-bootstrap :sse2 :x87 :i486 + ;; compile the x87/sse2 float support on ppc, which won't work. + :x86 :x86-bootstrap :sse2 :x87 :i486 :pentium :alpha :osf1 :mips ;; Really old stuff that should have been removed long ago. :propagate-fun-type :propagate-float-type :constrain-float-type ;; Other OSes were not using :openbsd :freebsd :glibc2 :linux :mach-o :darwin :bsd - :pentium + :long-float - :new-random - :small - :mp + :new-random ; The rng before mt-19937 + :small ; Don't build small(er) cores on ppc. + :mp ; No multi-processing on ppc. ;; ppc currently doesn't support these. :executable :heap-overflow-check @@ -43,13 +49,6 @@ ;;; Changes needed to bootstrap cross-compiling from x86 to ppc -;; ppc doesn't have these features yet. Remove them. It is a bug in -;; cross-compiling that these features leak through to the target. -(setf *features* (remove :executable *features*)) -(setf *features* (remove :heap-overflow-check *features*)) -(setf *features* (remove :stack-checking *features*)) -(setf *features* (remove :complex-fp-vops *features*)) - ;; Set up the linkage space stuff appropriately for ppc. #+nil (setf (c::backend-foreign-linkage-space-start c::*target-backend*) @@ -57,86 +56,15 @@ (c::backend-foreign-linkage-entry-size c::*target-backend*) 32) -(in-package "LISP") -;; We need the the fops because the cross-compiled fasl file is in -;; big-endian order for sparc. When we read in a string, we need to -;; convert the big-endian string to little-endian for x86 so we can -;; process the symbols and such as expected. - -#+unicode -(progn -(defconstant ppc::char-bytes 2) -(defun maybe-swap-string (f name &optional (len (length name))) - (declare (ignorable f)) - (unless (eq (c:backend-byte-order c:*backend*) - (c:backend-byte-order c:*native-backend*)) - (dotimes (k len) - (let ((code (char-code (aref name k)))) - (setf (aref name k) - (code-char (logior (ash (ldb (byte 8 0) code) 8) - (ldb (byte 8 8) code)))))) - ;;(format t "~S: new name = ~S~%" f (subseq name 0 len)) - name)) - -(macrolet ((frob (name code name-size package) - (let ((n-package (gensym "PACKAGE-")) - (n-size (gensym "SIZE-")) - (n-buffer (gensym "BUFFER-")) - (k (gensym "IDX-"))) - `(define-fop (,name ,code) - (prepare-for-fast-read-byte *fasl-file* - (let ((,n-package ,package) - (,n-size (fast-read-u-integer ,name-size))) - (when (> ,n-size *load-symbol-buffer-size*) - (setq *load-symbol-buffer* - (make-string (setq *load-symbol-buffer-size* - (* ,n-size vm::char-bytes))))) - (done-with-fast-read-byte) - (let ((,n-buffer *load-symbol-buffer*)) - (read-n-bytes *fasl-file* ,n-buffer 0 - (* old-vm:char-bytes ,n-size)) - (maybe-swap-string ',name ,n-buffer ,n-size) - (push-table (intern* ,n-buffer ,n-size ,n-package))))))))) - (frob fop-symbol-save 6 4 *package*) - (frob fop-small-symbol-save 7 1 *package*) - (frob fop-lisp-symbol-save 75 4 *lisp-package*) - (frob fop-lisp-small-symbol-save 76 1 *lisp-package*) - (frob fop-keyword-symbol-save 77 4 *keyword-package*) - (frob fop-keyword-small-symbol-save 78 1 *keyword-package*) - - (frob fop-symbol-in-package-save 8 4 - (svref *current-fop-table* (fast-read-u-integer 4))) - (frob fop-small-symbol-in-package-save 9 1 - (svref *current-fop-table* (fast-read-u-integer 4))) - (frob fop-symbol-in-byte-package-save 10 4 - (svref *current-fop-table* (fast-read-u-integer 1))) - (frob fop-small-symbol-in-byte-package-save 11 1 - (svref *current-fop-table* (fast-read-u-integer 1)))) - -(define-fop (fop-package 14) - (let ((name (pop-stack))) - ;;(format t "xfop-package: ~{~X~^ ~}~%" (map 'list #'char-code name)) - (or (find-package name) - (error (intl:gettext "The package ~S does not exist.") name)))) - -(clone-fop (fop-string 37) - (fop-small-string 38) - (let* ((arg (clone-arg)) - (res (make-string arg))) - (read-n-bytes *fasl-file* res 0 - (* old-vm:char-bytes arg)) - (maybe-swap-string 'fop-string res) - res)) +(in-package "PPC") +(defconstant char-bytes #+unicode 2 #-unicode 1) +(export 'char-bytes) +(in-package "CL-USER") +;; Get new fops so we can process fasls with big-endian unicode +;; strings on our little-endian compiling system. #+unicode -(defun cold-load-symbol (size package) - (let ((string (make-string size))) - (read-n-bytes *fasl-file* string 0 (* 2 size)) - ;;(format t "xpre swap cold-load-symbol: ~S to package ~S~%" string package) - (maybe-swap-string 'cold-load-symbol string) - ;;(format t "xpost swap cold-load-symbol: ~S to package ~S~%" string package) - (cold-intern (intern string package) package))) -) +(load "target:tools/cross-scripts/cross-unicode-big-endian.lisp") ;;; End changes needed to bootstrap cross-compiling from x86 to ppc diff --git a/src/tools/cross-scripts/cross-x86-sparc.lisp b/src/tools/cross-scripts/cross-x86-sparc.lisp index 21202f577..0e6dfbd54 100644 --- a/src/tools/cross-scripts/cross-x86-sparc.lisp +++ b/src/tools/cross-scripts/cross-x86-sparc.lisp @@ -60,85 +60,10 @@ (c::backend-foreign-linkage-entry-size c::*target-backend*) 16) -(in-package "LISP") -;; We need the the fops because the cross-compiled fasl file is in -;; big-endian order for sparc. When we read in a string, we need to -;; convert the big-endian string to little-endian for x86 so we can -;; process the symbols and such as expected. +;; Get new fops so we can process fasls with big-endian unicode +;; strings on our little-endian compiling system. #+unicode -(progn -(defun maybe-swap-string (f name &optional (len (length name))) - (declare (ignorable f)) - (unless (eq (c:backend-byte-order c:*backend*) - (c:backend-byte-order c:*native-backend*)) - (dotimes (k len) - (let ((code (char-code (aref name k)))) - (setf (aref name k) - (code-char (logior (ash (ldb (byte 8 0) code) 8) - (ldb (byte 8 8) code)))))) - ;;(format t "~S: new name = ~S~%" f (subseq name 0 len)) - name)) - -(macrolet ((frob (name code name-size package) - (let ((n-package (gensym "PACKAGE-")) - (n-size (gensym "SIZE-")) - (n-buffer (gensym "BUFFER-")) - (k (gensym "IDX-"))) - `(define-fop (,name ,code) - (prepare-for-fast-read-byte *fasl-file* - (let ((,n-package ,package) - (,n-size (fast-read-u-integer ,name-size))) - (when (> ,n-size *load-symbol-buffer-size*) - (setq *load-symbol-buffer* - (make-string (setq *load-symbol-buffer-size* - (* ,n-size vm:char-bytes))))) - (done-with-fast-read-byte) - (let ((,n-buffer *load-symbol-buffer*)) - (read-n-bytes *fasl-file* ,n-buffer 0 - (* old-vm:char-bytes ,n-size)) - (maybe-swap-string ',name ,n-buffer ,n-size) - (push-table (intern* ,n-buffer ,n-size ,n-package))))))))) - (frob fop-symbol-save 6 4 *package*) - (frob fop-small-symbol-save 7 1 *package*) - (frob fop-lisp-symbol-save 75 4 *lisp-package*) - (frob fop-lisp-small-symbol-save 76 1 *lisp-package*) - (frob fop-keyword-symbol-save 77 4 *keyword-package*) - (frob fop-keyword-small-symbol-save 78 1 *keyword-package*) - - (frob fop-symbol-in-package-save 8 4 - (svref *current-fop-table* (fast-read-u-integer 4))) - (frob fop-small-symbol-in-package-save 9 1 - (svref *current-fop-table* (fast-read-u-integer 4))) - (frob fop-symbol-in-byte-package-save 10 4 - (svref *current-fop-table* (fast-read-u-integer 1))) - (frob fop-small-symbol-in-byte-package-save 11 1 - (svref *current-fop-table* (fast-read-u-integer 1)))) - -(define-fop (fop-package 14) - (let ((name (pop-stack))) - ;;(format t "xfop-package: ~{~X~^ ~}~%" (map 'list #'char-code name)) - (or (find-package name) - (error (intl:gettext "The package ~S does not exist.") name)))) - -(clone-fop (fop-string 37) - (fop-small-string 38) - (let* ((arg (clone-arg)) - (res (make-string arg))) - (read-n-bytes *fasl-file* res 0 - (* old-vm:char-bytes arg)) - (maybe-swap-string 'fop-string res) - res)) - -#+unicode -(defun cold-load-symbol (size package) - (let ((string (make-string size))) - (read-n-bytes *fasl-file* string 0 (* 2 size)) - ;;(format t "xpre swap cold-load-symbol: ~S to package ~S~%" string package) - (maybe-swap-string 'cold-load-symbol string) - ;;(format t "xpost swap cold-load-symbol: ~S to package ~S~%" string package) - (cold-intern (intern string package) package))) -) - +(load "target:tools/cross-scripts/cross-unicode-big-endian.lisp") ;;; End changes needed to bootstrap cross-compiling from x86 to sparc -- GitLab