- cmucl-cvs - mailman3.common-lisp.net

[cmucl-cvs] CMUCL commit: src/i18n/locale (cmucl.pot)
by Raymond Toy 02 Dec '10

02 Dec '10

Date: Thursday, December 2, 2010 @ 16:12:40 Author: rtoy Path: /project/cmucl/cvsroot/src/i18n/locale Modified: cmucl.pot Regenerated from current sources. -----------+ cmucl.pot | 4 ++++ 1 file changed, 4 insertions(+) Index: src/i18n/locale/cmucl.pot diff -u src/i18n/locale/cmucl.pot:1.17 src/i18n/locale/cmucl.pot:1.18 --- src/i18n/locale/cmucl.pot:1.17 Mon Nov 8 09:02:40 2010 +++ src/i18n/locale/cmucl.pot Thu Dec 2 16:12:40 2010 @@ -7763,6 +7763,10 @@ msgstr "" #: src/code/format.lisp +msgid "~~:; directive not effective in ~~:[" +msgstr "" + +#: src/code/format.lisp msgid "Must specify exactly two sections." msgstr ""

1 0

[cmucl-cvs] CMUCL commit: src/general-info (release-20c.txt)
by Raymond Toy 02 Dec '10

02 Dec '10

Date: Thursday, December 2, 2010 @ 09:26:46 Author: rtoy Path: /project/cmucl/cvsroot/src/general-info Modified: release-20c.txt Update from logs. -----------------+ release-20c.txt | 1 + 1 file changed, 1 insertion(+) Index: src/general-info/release-20c.txt diff -u src/general-info/release-20c.txt:1.12 src/general-info/release-20c.txt:1.13 --- src/general-info/release-20c.txt:1.12 Tue Nov 30 08:51:29 2010 +++ src/general-info/release-20c.txt Thu Dec 2 09:26:45 2010 @@ -26,6 +26,7 @@ Slime to do character name completion. * Changes + - ASDF2 updated to version 2.010. - COMPILE-FILE now accepts a :DECODING-ERROR argument that indicates how to handle decoding errors when reading the file. It has the same meaning and effect as the :DECODING-ERROR

1 0

[cmucl-cvs] CMUCL commit: src/tools/cross-scripts (cross-x86-osx-freebsd.lisp)
by Raymond Toy 01 Dec '10

01 Dec '10

Date: Wednesday, December 1, 2010 @ 08:55:25 Author: rtoy Path: /project/cmucl/cvsroot/src/tools/cross-scripts Added: cross-x86-osx-freebsd.lisp Initial version of script to cross-compile from x86 OSX to x86 FreeBSD. ----------------------------+ cross-x86-osx-freebsd.lisp | 228 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 228 insertions(+) Index: src/tools/cross-scripts/cross-x86-osx-freebsd.lisp diff -u /dev/null src/tools/cross-scripts/cross-x86-osx-freebsd.lisp:1.1 --- /dev/null Wed Dec 1 08:55:25 2010 +++ src/tools/cross-scripts/cross-x86-osx-freebsd.lisp Wed Dec 1 08:55:25 2010 @@ -0,0 +1,228 @@ +;; Basic cross-compile script for cross-compiling from x86 on darwin +;; (Mac OS X) to x86 on FreeBSD. This is a basic x86-to-x86 +;; cross-compile, except we tweek the features and misfeatures to +;; match the FreeBSD features. + +(in-package :cl-user) + +;;; Rename the X86 package and backend so that new-backend does the +;;; right thing. +(rename-package "X86" "OLD-X86" '("OLD-VM")) +(setf (c:backend-name c:*native-backend*) "OLD-X86") + +(c::new-backend "X86" + ;; Features to add here. These are just examples. You may not + ;; need to list anything here. We list them here anyway as a + ;; record of typical features for all x86 ports. + '(:x86 + :i486 + :pentium + :stack-checking ; Catches stack overflow + :heap-overflow-check ; Catches heap overflows + :relative-package-names ; relative package names + :mp ; multiprocessing + :gencgc ; Generational GC + :conservative-float-type + :complex-fp-vops + :hash-new + :random-mt19937 + :cmu :cmu20 :cmu20b ; Version features + :double-double ; double-double float support + :linkage-table + + :freebsd :bsd :elf + ;; The :sse2 and :x87 features will get set by the compiling + ;; lisp, so don't set it here! + ) + ;; Features to remove from current *features* here. Normally don't + ;; need to list anything here unless you are trying to remove a + ;; feature. + '(:x86-bootstrap + ;; :alpha :osf1 :mips + :propagate-fun-type :propagate-float-type :constrain-float-type + ;; :openbsd :freebsd :glibc2 :linux + :mach-o :darwin + :long-float :new-random :small)) + +;;; Compile the new backend. +(pushnew :bootstrap *features*) +(pushnew :building-cross-compiler *features*) + +;; Make fixup-code-object and sanctify-for-execution in the VM package +;; be the same as the original. Needed to get rid of a compiler error +;; in generic/core.lisp. (This halts cross-compilations if the +;; compiling lisp uses the -batch flag. +(import 'old-vm::fixup-code-object "VM") +(import 'old-vm::sanctify-for-execution "VM") +(export 'vm::fixup-code-object "VM") +(export 'vm::sanctify-for-execution "VM") + +(load "target:tools/comcom") + +;;; Load the new backend. +(setf (search-list "c:") + '("target:compiler/")) +(setf (search-list "vm:") + '("c:x86/" "c:generic/")) +(setf (search-list "assem:") + '("target:assembly/" "target:assembly/x86/")) + +;; Load the backend of the compiler. + +(in-package "C") + +(load "vm:vm-macs") +(load "vm:parms") +(load "vm:objdef") +(load "vm:interr") +(load "assem:support") + +(load "target:compiler/srctran") +(load "vm:vm-typetran") +(load "target:compiler/float-tran") +(load "target:compiler/saptran") + +(load "vm:macros") +(load "vm:utils") + +(load "vm:vm") +(load "vm:insts") +(load "vm:primtype") +(load "vm:move") +(load "vm:sap") +(when (target-featurep :sse2) + (load "vm:sse2-sap")) +(load "vm:system") +(load "vm:char") +(if (target-featurep :sse2) + (load "vm:float-sse2") + (load "vm:float")) + +(load "vm:memory") +(load "vm:static-fn") +(load "vm:arith") +(load "vm:cell") +(load "vm:subprim") +(load "vm:debug") +(load "vm:c-call") +(if (target-featurep :sse2) + (load "vm:sse2-c-call") + (load "vm:x87-c-call")) + +(load "vm:print") +(load "vm:alloc") +(load "vm:call") +(load "vm:nlx") +(load "vm:values") +;; These need to be loaded before array because array wants to use +;; some vops as templates. +(load (if (target-featurep :sse2) + "vm:sse2-array" + "vm:x87-array")) +(load "vm:array") +(load "vm:pred") +(load "vm:type-vops") + +(load "assem:assem-rtns") + +(load "assem:array") +(load "assem:arith") +(load "assem:alloc") + +(load "c:pseudo-vops") + +(check-move-function-consistency) + +(load "vm:new-genesis") + +;;; OK, the cross compiler backend is loaded. + +(setf *features* (remove :building-cross-compiler *features*)) + +;;; Info environment hacks. +(macrolet ((frob (&rest syms) + `(progn ,@(mapcar #'(lambda (sym) + `(defconstant ,sym + (symbol-value + (find-symbol ,(symbol-name sym) + :vm)))) + syms)))) + (frob OLD-VM:BYTE-BITS OLD-VM:WORD-BITS + OLD-VM:CHAR-BITS + #+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE + #+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-BIT-VECTOR-TYPE + OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE + OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET + OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE + OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE + OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE + OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE + ) + #+double-double + (frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE)) + +;; Modular arith hacks +(setf (fdefinition 'vm::ash-left-mod32) #'old-vm::ash-left-mod32) +(setf (fdefinition 'vm::lognot-mod32) #'old-vm::lognot-mod32) +;; End arith hacks + +(let ((function (symbol-function 'kernel:error-number-or-lose))) + (let ((*info-environment* (c:backend-info-environment c:*target-backend*))) + (setf (symbol-function 'kernel:error-number-or-lose) function) + (setf (info function kind 'kernel:error-number-or-lose) :function) + (setf (info function where-from 'kernel:error-number-or-lose) :defined))) + +(defun fix-class (name) + (let* ((new-value (find-class name)) + (new-layout (kernel::%class-layout new-value)) + (new-cell (kernel::find-class-cell name)) + (*info-environment* (c:backend-info-environment c:*target-backend*))) + (remhash name kernel::*forward-referenced-layouts*) + (kernel::%note-type-defined name) + (setf (info type kind name) :instance) + (setf (info type class name) new-cell) + (setf (info type compiler-layout name) new-layout) + new-value)) +(fix-class 'c::vop-parse) +(fix-class 'c::operand-parse) + +#+random-mt19937 +(declaim (notinline kernel:random-chunk)) + +(setf c:*backend* c:*target-backend*) + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + name) +(export 'extern-alien-name) +(in-package :cl-user) + +;;; Don't load compiler parts from the target compilation + +(defparameter *load-stuff* nil) + +;; hack, hack, hack: Make old-vm::any-reg the same as +;; x86::any-reg as an SC. Do this by adding old-vm::any-reg +;; to the hash table with the same value as x86::any-reg. +(let ((ht (c::backend-sc-names c::*target-backend*))) + (setf (gethash 'old-vm::any-reg ht) + (gethash 'vm::any-reg ht)))

1 0

[cmucl-cvs] CMUCL commit: src/general-info (release-20c.txt)
by Raymond Toy 30 Nov '10

30 Nov '10

Date: Tuesday, November 30, 2010 @ 08:51:29 Author: rtoy Path: /project/cmucl/cvsroot/src/general-info Modified: release-20c.txt Clarify entry on realpart/imagpart bug. It's an x86-only problem, and only happens in some situations. -----------------+ release-20c.txt | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) Index: src/general-info/release-20c.txt diff -u src/general-info/release-20c.txt:1.11 src/general-info/release-20c.txt:1.12 --- src/general-info/release-20c.txt:1.11 Mon Nov 29 23:18:43 2010 +++ src/general-info/release-20c.txt Tue Nov 30 08:51:29 2010 @@ -66,8 +66,9 @@ Previously, it skipped over non-BMP codepoints. This also requires a fix in %COMPOSE to handle non-BMP codepoints correctly. The normalization test now passes. - - REALPART and IMAGPART no longer incorrectly returns 0 instead of - the correct part of a complex number. + - On x86, REALPART and IMAGPART no longer incorrectly returns 0 + instead of the correct part of a complex number in some + situations. - The command line parser now correctly handles the case where "--" is the first command option. - build.sh was accidenally loading the site-init file, but it

1 0

[cmucl-cvs] CMUCL commit: src/general-info (release-20c.txt)
by Raymond Toy 30 Nov '10

30 Nov '10

Date: Monday, November 29, 2010 @ 23:18:43 Author: rtoy Path: /project/cmucl/cvsroot/src/general-info Modified: release-20c.txt Update from commits. -----------------+ release-20c.txt | 2 ++ 1 file changed, 2 insertions(+) Index: src/general-info/release-20c.txt diff -u src/general-info/release-20c.txt:1.10 src/general-info/release-20c.txt:1.11 --- src/general-info/release-20c.txt:1.10 Tue Nov 16 14:27:39 2010 +++ src/general-info/release-20c.txt Mon Nov 29 23:18:43 2010 @@ -81,6 +81,8 @@ returned because GET-BEST-AUTHORIZATION was looking for the hostname. - FORMAT signals an warning if ~:; is used inside ~:[. + - SET-SYSTEM-EXTERNAL-FORMAT was not actually setting the filename + encoding if given. * Trac Tickets:

1 0

[cmucl-cvs] CMUCL commit: src/code (extfmts.lisp)
by Raymond Toy 30 Nov '10

30 Nov '10

Date: Monday, November 29, 2010 @ 23:09:42 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: extfmts.lisp o *FILENAME-ENCODING* was never getting set. Fix that. (From Paul Foley.) o While we're here, canonicalize *FILENAME-ENCODING* using the actual external format name. --------------+ extfmts.lisp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) Index: src/code/extfmts.lisp diff -u src/code/extfmts.lisp:1.41 src/code/extfmts.lisp:1.42 --- src/code/extfmts.lisp:1.41 Tue Sep 7 22:58:06 2010 +++ src/code/extfmts.lisp Mon Nov 29 23:09:42 2010 @@ -5,7 +5,7 @@ ;;; domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.41 2010-09-08 02:58:06 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/extfmts.lisp,v 1.42 2010-11-30 04:09:42 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1102,11 +1102,12 @@ (when filenames (unless (find-external-format filenames) (error (intl:gettext "Can't find external-format ~S.") filenames)) + (setq filenames (ef-name (find-external-format filenames))) (when (and unix::*filename-encoding* (not (eq unix::*filename-encoding* filenames))) (cerror (intl:gettext "Change it anyway.") - (intl:gettext "The external-format for encoding filenames is already set.")) - (setq unix::*filename-encoding* filenames))) + (intl:gettext "The external-format for encoding filenames is already set."))) + (setq unix::*filename-encoding* filenames)) t)

1 0

[cmucl-cvs] CMUCL commit: cross-sparc-branch src/compiler/sparc (parms.lisp)
by Raymond Toy 20 Nov '10

20 Nov '10

Date: Saturday, November 20, 2010 @ 10:45:05 Author: rtoy Path: /project/cmucl/cvsroot/src/compiler/sparc Tag: cross-sparc-branch Modified: parms.lisp Set up TARGET-FOREIGN-LINKAGE-SPACE-START and TARGET-FOREIGN-LINKAGE-ENTRY-SIZE from the backend values. ------------+ parms.lisp | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) Index: src/compiler/sparc/parms.lisp diff -u src/compiler/sparc/parms.lisp:1.61.6.1 src/compiler/sparc/parms.lisp:1.61.6.2 --- src/compiler/sparc/parms.lisp:1.61.6.1 Tue Nov 16 12:29:34 2010 +++ src/compiler/sparc/parms.lisp Sat Nov 20 10:45:05 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/sparc/parms.lisp,v 1.61.6.1 2010-11-16 17:29:34 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/sparc/parms.lisp,v 1.61.6.2 2010-11-20 15:45:05 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -48,8 +48,11 @@ #+mach 4096 #+sunos 8192) (setf (c::backend-foreign-linkage-space-start *target-backend*) + ;; This better match the value in sparc-validate.h! #x0f800000 (c::backend-foreign-linkage-entry-size *target-backend*) + ;; This better agree with what sparc-arch.c thinks it is! Right now, + ;; it's 4 instructions, so 16 bytes. 16) ); eval-when @@ -217,11 +220,10 @@ (defconstant target-static-space-start #x28000000) (defconstant target-dynamic-space-start #x40000000) -;; This better match the value in sparc-validate.h! -(defconstant target-foreign-linkage-space-start #x0f800000) -;; This better agree with what sparc-arch.c thinks it is! Right now, -;; it's 4 instructions, so 16 bytes. -(defconstant target-foreign-linkage-entry-size 16) +(defconstant target-foreign-linkage-space-start + (c:backend-foreign-linkage-space-start *target-backend*)) +(defconstant target-foreign-linkage-entry-size + (c:backend-foreign-linkage-entry-size *target-backend*)) ;;;; Other random constants.

1 0

[cmucl-cvs] CMUCL commit: cross-sparc-branch src/compiler/generic (new-genesis.lisp)
by Raymond Toy 18 Nov '10

18 Nov '10

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

1 0

[cmucl-cvs] CMUCL commit: cross-sparc-branch src/compiler/x86 (parms.lisp)
by Raymond Toy 18 Nov '10

18 Nov '10

Date: Wednesday, November 17, 2010 @ 19:24:02 Author: rtoy Path: /project/cmucl/cvsroot/src/compiler/x86 Tag: cross-sparc-branch Modified: parms.lisp Set up TARGET-FOREIGN-LINKAGE-SPACE-START and TARGET-FOREIGN-LINKAGE-ENTRY-SIZE from the backend values. ------------+ parms.lisp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) Index: src/compiler/x86/parms.lisp diff -u src/compiler/x86/parms.lisp:1.40.6.1 src/compiler/x86/parms.lisp:1.40.6.2 --- src/compiler/x86/parms.lisp:1.40.6.1 Tue Nov 16 12:29:35 2010 +++ src/compiler/x86/parms.lisp Wed Nov 17 19:24:02 2010 @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group(a)cs.cmu.edu. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/x86/parms.lisp,v 1.40.6.1 2010-11-16 17:29:35 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/x86/parms.lisp,v 1.40.6.2 2010-11-18 00:24:02 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -219,9 +219,9 @@ #+linux #x58100000 #-linux #x48000000) (defconstant target-foreign-linkage-space-start - #+linux #x58000000 - #-linux #xB0000000) -(defconstant target-foreign-linkage-entry-size 8) ;In bytes. Duh. + (c:backend-foreign-linkage-space-start *target-backend*)) +(defconstant target-foreign-linkage-entry-size + (c:backend-foreign-linkage-entry-size *target-backend*)) ;In bytes. Duh. ;;; Given that NIL is the first thing allocated in static space, we ;;; know its value at compile time:

1 0

[cmucl-cvs] CMUCL commit: cross-sparc-branch src/tools/cross-scripts (cross-x86-sparc.lisp)
by Raymond Toy 18 Nov '10

18 Nov '10

Date: Wednesday, November 17, 2010 @ 19:22:33 Author: rtoy Path: /project/cmucl/cvsroot/src/tools/cross-scripts Tag: cross-sparc-branch Modified: cross-x86-sparc.lisp o Need to remove the :i486 feature from x86. (Include :pentium too?) o Add comments. o Comment out debugging prints. ----------------------+ cross-x86-sparc.lisp | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) Index: src/tools/cross-scripts/cross-x86-sparc.lisp diff -u src/tools/cross-scripts/cross-x86-sparc.lisp:1.1.2.1 src/tools/cross-scripts/cross-x86-sparc.lisp:1.1.2.2 --- src/tools/cross-scripts/cross-x86-sparc.lisp:1.1.2.1 Tue Nov 16 12:29:35 2010 +++ src/tools/cross-scripts/cross-x86-sparc.lisp Wed Nov 17 19:22:33 2010 @@ -36,8 +36,10 @@ ) ;; Features to remove from current *features* here '(:sparc-v8 :sparc-v7 ; Choose only one of :sparc-v7, :sparc-v8, :sparc-v9 - ;; Other architectures we aren't using. - :x86 :x86-bootstrap :sse2 :x87 + ;; 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 :alpha :osf1 :mips ;; Really old stuff that should have been removed long ago. :propagate-fun-type :propagate-float-type :constrain-float-type @@ -51,14 +53,21 @@ :mp)) ;;; Changes needed to bootstrap cross-compiling from x86 to sparc + +;; Set up the linkage space stuff appropriately for sparc. (setf (c::backend-foreign-linkage-space-start c::*target-backend*) #x0f800000 (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. (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) @@ -66,7 +75,7 @@ (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 name) + ;;(format t "~S: new name = ~S~%" f (subseq name 0 len)) name)) (macrolet ((frob (name code name-size package) @@ -106,8 +115,7 @@ (define-fop (fop-package 14) (let ((name (pop-stack))) - (format t "xfop-package: ~{~X~^ ~}~%" (map 'list #'char-code name)) - ;; Byte swap name + ;;(format t "xfop-package: ~{~X~^ ~}~%" (map 'list #'char-code name)) (or (find-package name) (error (intl:gettext "The package ~S does not exist.") name)))) @@ -124,9 +132,9 @@ (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-byte-swap-string string) - (format t "xpost swap cold-load-symbol: ~S to package ~S~%" string package) + ;;(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))) )

1 0