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

[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

[cmucl-cvs] CMUCL commit: cross-sparc-branch src/lisp (os-common.c)
by Raymond Toy 16 Nov '10

16 Nov '10

Date: Tuesday, November 16, 2010 @ 17:06:31 Author: rtoy Path: /project/cmucl/cvsroot/src/lisp Tag: cross-sparc-branch Modified: os-common.c Add some debugging prints, but not activated. -------------+ os-common.c | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) Index: src/lisp/os-common.c diff -u src/lisp/os-common.c:1.31 src/lisp/os-common.c:1.31.10.1 --- src/lisp/os-common.c:1.31 Mon Feb 1 14:27:07 2010 +++ src/lisp/os-common.c Tue Nov 16 17:06:29 2010 @@ -1,6 +1,6 @@ /* - $Header: /project/cmucl/cvsroot/src/lisp/os-common.c,v 1.31 2010-02-01 19:27:07 rtoy Rel $ + $Header: /project/cmucl/cvsroot/src/lisp/os-common.c,v 1.31.10.1 2010-11-16 22:06:29 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -195,6 +195,23 @@ */ convert_lisp_string(c_symbol_name, symbol_name->data, (symbol_name->length >> 2)); + +#if 0 + fprintf(stderr, "i =%2d: %s\n", i, c_symbol_name); + { + int k; + unsigned short int* wide_string; + + fprintf(stderr, " symbol_name->data = "); + + wide_string = (unsigned short int *) symbol_name->data; + + for (k = 0; k < (symbol_name->length >> 2); ++k) { + fprintf(stderr, "%4x ", wide_string[k]); + } + fprintf(stderr, "\n"); + } +#endif if (i == 0) { #if defined(sparc) if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, "call_into_c")) { @@ -226,6 +243,20 @@ void *target_addr = os_dlsym(c_symbol_name, NIL); if (!target_addr) { +#if 0 + int k; + unsigned short int* wide_string; + + fprintf(stderr, "c_symbol_name = `%s'\n", c_symbol_name); + fprintf(stderr, "symbol_name->data = \n"); + + wide_string = (unsigned short int *) symbol_name->data; + + for (k = 0; k < (symbol_name->length >> 2); ++k) { + fprintf(stderr, "%4x ", wide_string[k]); + } + fprintf(stderr, "\n"); +#endif lose("%s is not defined.\n", c_symbol_name); } arch_make_linkage_entry(i / LINKAGE_DATA_ENTRY_SIZE, target_addr,

1 0

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

16 Nov '10

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

1 0

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

16 Nov '10

Date: Tuesday, November 16, 2010 @ 14:27:39 Author: rtoy Path: /project/cmucl/cvsroot/src/general-info Modified: release-20c.txt Update from logs. -----------------+ release-20c.txt | 13 +++++++++++++ 1 file changed, 13 insertions(+) Index: src/general-info/release-20c.txt diff -u src/general-info/release-20c.txt:1.9 src/general-info/release-20c.txt:1.10 --- src/general-info/release-20c.txt:1.9 Tue Nov 2 14:31:33 2010 +++ src/general-info/release-20c.txt Tue Nov 16 14:27:39 2010 @@ -43,6 +43,8 @@ needs to create. - Add src/tools/build-all.sh to automate building all of the variants (x87/sse2, unicode/8-bit). + - LISP::ENUMERATE-MATCHES had a keyword arg named + :VERIFY-EXISTANCE. This has been changed to :VERIFY-EXISTENCE. * ANSI compliance fixes: - Fixes for signaling errors with READ-CHAR and READ-BYTE @@ -68,6 +70,17 @@ the correct part of a complex number. - 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 + shouldn't. + - On sparc, the vops to add a float to a complex were broken, + resulting in a complex number with the float as realpart and + garbage for the imaginary part. This is now fixed. + - XLIB::GET-BEST-AUTHORIZATION will now return authorization data + if the protocol is :local, if the xauth file contains just + "localhost/unix:0". Previously, no authorization data was + returned because GET-BEST-AUTHORIZATION was looking for the + hostname. + - FORMAT signals an warning if ~:; is used inside ~:[. * Trac Tickets:

1 0

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

16 Nov '10

Date: Tuesday, November 16, 2010 @ 14:15:38 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: format.lisp Signal a warning if ~:[ directive includes ~:;. From a message by Didier Verna, cmucl-imp, 2010-11-11. -------------+ format.lisp | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) Index: src/code/format.lisp diff -u src/code/format.lisp:1.96 src/code/format.lisp:1.97 --- src/code/format.lisp:1.96 Tue Apr 20 13:57:44 2010 +++ src/code/format.lisp Tue Nov 16 14:15:38 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/format.lisp,v 1.96 2010-04-20 17:57:44 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/format.lisp,v 1.97 2010-11-16 19:15:38 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2384,9 +2384,13 @@ (expand-maybe-conditional (car sublists))))) (if colonp (if (= (length sublists) 2) - (expand-bind-defaults () params - (expand-true-false-conditional (car sublists) - (cadr sublists))) + (progn + (when last-semi-with-colon-p + (error 'format-error + :complaint (intl:gettext "~~:; directive not effective in ~~:["))) + (expand-bind-defaults () params + (expand-true-false-conditional (car sublists) + (cadr sublists)))) (error 'format-error :complaint (intl:gettext "Must specify exactly two sections.")))

1 0

[cmucl-cvs] CMUCL commit: src/clx (display.lisp)
by Raymond Toy 16 Nov '10

16 Nov '10

Date: Tuesday, November 16, 2010 @ 14:13:56 Author: rtoy Path: /project/cmucl/cvsroot/src/clx Modified: display.lisp GET-BEST-AUTHORIZATION wasn't handling the case of a :local connection where the xauth file only contained one entry for localhost/unix:0. When the protocol is :local, we explicitly check for localhost. Previously, the host-address was converted the hostname, which isn't "localhost". --------------+ display.lisp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) Index: src/clx/display.lisp diff -u src/clx/display.lisp:1.15 src/clx/display.lisp:1.16 --- src/clx/display.lisp:1.15 Mon Jul 13 09:54:35 2009 +++ src/clx/display.lisp Tue Nov 16 14:13:55 2010 @@ -19,7 +19,7 @@ ;;; #+cmu -(ext:file-comment "$Id: display.lisp,v 1.15 2009-07-13 13:54:35 rtoy Rel $") +(ext:file-comment "$Id: display.lisp,v 1.16 2010-11-16 19:13:55 rtoy Exp $") (in-package :xlib) @@ -117,7 +117,9 @@ (read-xauth-entry stream) (unless family (return)) (when (and (eql family protocol) - (equal host-address address) + (or (equal host-address address) + (and (eql family :local) + (equal address "localhost"))) (= number display) (let ((pos1 (position name *known-authorizations* :test #'string=)))

1 0

[cmucl-cvs] CMUCL commit: cross-sparc-branch src (6 files)
by Raymond Toy 16 Nov '10

16 Nov '10

Date: Tuesday, November 16, 2010 @ 12:29:35 Author: rtoy Path: /project/cmucl/cvsroot/src Tag: cross-sparc-branch Added: tools/cross-scripts/cross-x86-sparc.lisp Modified: compiler/dump.lisp compiler/generic/new-genesis.lisp compiler/ppc/parms.lisp compiler/sparc/parms.lisp compiler/x86/parms.lisp First cut at getting a cross-compile (Unicode) from x86 to sparc. This needs more work, but the cross-compile does produce a sparc core where the repl works. But currently that sparc core cannot rebuild cmucl. To do this, a version of cmucl from the HEAD branch needs to be created to add the new slots to the backend. Then a new x86 build needs to be done using these sources. Finally, a cross-compile can be done using cross-x86-sparc.lisp as the cross-compile script. compiler/dump.lisp: o I think we actually do need to swap the string bytes when dumping strings to a fasl because the fasl will eventually get loaded by the target system, and the codes need to be in the correct byte order. compiler/generic/new-genesis.lisp: o LOAD-CHAR-CODE should test against C:*BACKEND*, not C:*NATIVE-BACKEND*. o Add MAYBE-BYTE-SWAP-STRING to swap the bytes of the character codes if the *backend* and *native-backend* have different endianness. o Swap the strings read from a fasl. The fasl should have strings in the target endianness, but when we cold-load them, we need the native endianness. (I think). This means swapping bytes in COLD-LOAD-SYMBOL, FOP-UNINTERNED-SYMBOL-SAVE, FOP-UNINTERNED-SMALL-SYMBOL-SAVE, FOP-STRING, FOP-SMALL-STRING. o In MAKE-COLD-LINKAGE-VECTOR, byte swap the string before we store the string to the core. The string in the linkage vector already has the correct endianness, and string-to-core will swap the bytes. (Not sure why the linkage string ares this way, though. This is a hack.) o Add optional swap-p paramter to COLD-REGISTER-FOREIGN-LINKAGE to enable byte swapping of the symbol string. This is a hack to get "call_into_c" into the correct byte order for the target and MAKE-COLD-LINKAGE-VECTOR. o Use the backend foreign-linkage-space-start and foreign-linkage-entry-size for COLD-REGISTER-FOREIGN-LINKAGE. This prevents the wrong addresses leaking into the target. (Previously, the values form the native backend were getting used, which wreaks havoc on the target since the addresses are not even close.) compiler/ppc/parms.lisp: o Set up the backend-foreign-linkage-space-start and backend-foreign-linkage-entry-size with the correct values. compiler/sparc/parms.lisp: o Set up the backend-foreign-linkage-space-start and backend-foreign-linkage-entry-size with the correct values. compiler/x86/parms.lisp: o Set up the backend-foreign-linkage-space-start and backend-foreign-linkage-entry-size with the correct values. tools/cross-scripts/cross-x86-sparc.lisp: o New cross-compile script to do an x86 to sparc cross-compile. Needs work. ------------------------------------------+ compiler/dump.lisp | 20 - compiler/generic/new-genesis.lisp | 61 +++- compiler/ppc/parms.lisp | 7 compiler/sparc/parms.lisp | 6 compiler/x86/parms.lisp | 8 tools/cross-scripts/cross-x86-sparc.lisp | 369 +++++++++++++++++++++++++++++ 6 files changed, 439 insertions(+), 32 deletions(-) Index: src/compiler/dump.lisp diff -u src/compiler/dump.lisp:1.89 src/compiler/dump.lisp:1.89.2.1 --- src/compiler/dump.lisp:1.89 Wed Nov 10 14:51:24 2010 +++ src/compiler/dump.lisp Tue Nov 16 12:29:34 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/dump.lisp,v 1.89 2010-11-10 19:51:24 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/dump.lisp,v 1.89.2.1 2010-11-16 17:29:34 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1635,14 +1635,16 @@ bytes-per-element) (type unsigned-byte elements)) (if (stringp data-vector) - ;; Don't swap string bytes. We get here only if we're - ;; cross-compiling from one arch to a different endian - ;; arch. To be able to load the fasls, we need to keep - ;; strings in the native format. When genesis is done, - ;; genesis will swap string bytes when creating the - ;; core so that the bytes are in the correct order. - (dotimes (index elements) - (setf (aref result index) (char-code (aref data-vector index)))) + (progn + ;;(format t "reverse string data: ~S~%" data-vector) + #+(or) + (dotimes (index elements) + (let ((c (char-code (aref data-vector index)))) + (setf (aref result index) c))) + (dotimes (index elements) + (let ((c (char-code (aref data-vector index)))) + (setf (aref result index) (logior (ash (ldb (byte 8 0) c) 8) + (ldb (byte 8 8) c)))))) (dotimes (index elements) (let ((element (aref data-vector index)) (new-element 0)) Index: src/compiler/generic/new-genesis.lisp diff -u src/compiler/generic/new-genesis.lisp:1.91 src/compiler/generic/new-genesis.lisp:1.91.2.1 --- src/compiler/generic/new-genesis.lisp:1.91 Thu Nov 11 16:48:24 2010 +++ src/compiler/generic/new-genesis.lisp Tue Nov 16 12:29:34 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 2010-11-11 21:48:24 rtoy Exp $") + "$Header: /project/cmucl/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.91.2.1 2010-11-16 17:29:34 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -431,16 +431,19 @@ vm:simple-string-type)) (bytes (make-array (1+ len) :element-type '(unsigned-byte 16)))) (write-indexed des vm:vector-length-slot (make-fixnum-descriptor len)) - ;;(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. + (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) (+ (ldb (byte 8 8) x) - (ash (ldb (byte 8 0) x) 8)))))) + (setf (aref bytes k) (maybe-byte-swap-short x)))) + (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 @@ -1324,7 +1327,7 @@ #+unicode (defmacro load-char-code () - (ecase (c::backend-byte-order c::*native-backend*) + (ecase (c::backend-byte-order c::*backend*) (:little-endian `(code-char (+ (read-arg 1) (ash (read-arg 1) 8)))) @@ -1332,13 +1335,27 @@ `(code-char (+ (ash (read-arg 1) 8) (read-arg 1)))))) +(declaim (inline swap-16)) +(defun swap-16 (n) + (declare (type (unsigned-byte 16) n)) + (logior (ash (ldb (byte 8 0) n) 8) + (ldb (byte 8 8) n))) + +(defun maybe-byte-swap-string (s) + (unless (eq (c:backend-byte-order c:*backend*) + (c:backend-byte-order c:*native-backend*)) + (dotimes (k (length s)) + (let ((code (char-code (aref s k)))) + (setf (aref s k) (code-char (swap-16 code)))))) + s) + #+unicode (defun cold-load-symbol (size package) (let ((string (make-string size))) - #+nil (read-n-bytes *fasl-file* string 0 (* 2 size)) - (dotimes (k size) - (setf (aref string k) (load-char-code))) + (format t "pre swap cold-load-symbol: ~S to package ~S~%" string package) + (maybe-byte-swap-string string) + (format t "post swap cold-load-symbol: ~S to package ~S~%" string package) (cold-intern (intern string package) package))) (clone-cold-fop (fop-symbol-save) @@ -1378,10 +1395,8 @@ (fop-uninterned-small-symbol-save) (let* ((size (clone-arg)) (name (make-string size))) - #+nil - (read-n-bytes *fasl-file* name 0 size) - (dotimes (k size) - (setf (aref name k) (load-char-code))) + (read-n-bytes *fasl-file* name 0 (* 2 size)) + (maybe-byte-swap-string name) (let ((symbol (allocate-symbol name))) (push-table symbol)))) @@ -1448,10 +1463,10 @@ (fop-small-string) (let* ((len (clone-arg)) (string (make-string len))) - #+nil (read-n-bytes *fasl-file* string 0 (* 2 len)) - (dotimes (k len) - (setf (aref string k) (load-char-code))) + (format t "pre fop-string result = ~{~X~^ ~}~%" (map 'list #'char-code string)) + (maybe-byte-swap-string string) + (format t "post fop-string result = ~{~X~^ ~}~%" (map 'list #'char-code string)) (string-to-core string))) (clone-cold-fop (fop-vector) @@ -1596,6 +1611,9 @@ 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)) @@ -2195,13 +2213,15 @@ (defvar *cold-foreign-hash* (make-hash-table :test #'equal)) #+linkage-table -(defun cold-register-foreign-linkage (sym type) - (let ((entry-num (register-foreign-linkage sym +(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) type *cold-linkage-table* *cold-foreign-hash*))) - (+ vm:target-foreign-linkage-space-start - (* entry-num vm:target-foreign-linkage-entry-size)))) + (+ (c:backend-foreign-linkage-space-start c:*backend*) + (* entry-num (c:backend-foreign-linkage-entry-size c:*backend*))))) #+linkage-table (defun init-foreign-linkage () @@ -2213,7 +2233,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) + (cold-register-foreign-linkage (vm::extern-alien-name "call_into_c") :code t) #-sparc (cold-register-foreign-linkage (vm::extern-alien-name "undefined_tramp") :data) #-sparc @@ -2461,6 +2481,7 @@ (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)) Index: src/compiler/ppc/parms.lisp diff -u src/compiler/ppc/parms.lisp:1.19 src/compiler/ppc/parms.lisp:1.19.20.1 --- src/compiler/ppc/parms.lisp:1.19 Thu Jun 11 12:04:00 2009 +++ src/compiler/ppc/parms.lisp Tue Nov 16 12:29:34 2010 @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group(a)cs.cmu.edu. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/compiler/ppc/parms.lisp,v 1.19 2009-06-11 16:04:00 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/compiler/ppc/parms.lisp,v 1.19.20.1 2010-11-16 17:29:34 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -37,6 +37,11 @@ (setf (backend-byte-order *target-backend*) :big-endian) (setf (backend-page-size *target-backend*) 4096) +(setf (c::backend-foreign-linkage-space-start *target-backend*) + #x17000000 + (c::backend-foreign-linkage-entry-size *target-backend*) + 32) + ); eval-when (pushnew :new-assembler *features*) Index: src/compiler/sparc/parms.lisp diff -u src/compiler/sparc/parms.lisp:1.61 src/compiler/sparc/parms.lisp:1.61.6.1 --- src/compiler/sparc/parms.lisp:1.61 Mon Apr 19 14:21:31 2010 +++ src/compiler/sparc/parms.lisp Tue Nov 16 12:29:34 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 2010-04-19 18:21:31 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/compiler/sparc/parms.lisp,v 1.61.6.1 2010-11-16 17:29:34 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -47,6 +47,10 @@ (setf (backend-page-size *target-backend*) #+mach 4096 #+sunos 8192) +(setf (c::backend-foreign-linkage-space-start *target-backend*) + #x0f800000 + (c::backend-foreign-linkage-entry-size *target-backend*) + 16) ); eval-when (pushnew :new-assembler *features*) Index: src/compiler/x86/parms.lisp diff -u src/compiler/x86/parms.lisp:1.40 src/compiler/x86/parms.lisp:1.40.6.1 --- src/compiler/x86/parms.lisp:1.40 Wed Jul 14 09:14:53 2010 +++ src/compiler/x86/parms.lisp Tue Nov 16 12:29:35 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 2010-07-14 13:14:53 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/compiler/x86/parms.lisp,v 1.40.6.1 2010-11-16 17:29:35 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -62,6 +62,12 @@ |# (setf (backend-page-size *target-backend*) 4096) + +(setf (c::backend-foreign-linkage-space-start *target-backend*) + #+linux #x58000000 + #-linux #xB0000000 + (c::backend-foreign-linkage-entry-size *target-backend*) + 8) ); eval-when Index: src/tools/cross-scripts/cross-x86-sparc.lisp diff -u /dev/null src/tools/cross-scripts/cross-x86-sparc.lisp:1.1.2.1 --- /dev/null Tue Nov 16 12:29:35 2010 +++ src/tools/cross-scripts/cross-x86-sparc.lisp Tue Nov 16 12:29:35 2010 @@ -0,0 +1,369 @@ +;;; Cross-compile script to build a sparc 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 +;;; right thing. +(rename-package "X86" "OLD-X86" '("OLD-VM")) +(setf (c:backend-name c:*native-backend*) "OLD-X86") + +(c::new-backend "SPARC" + ;; Features to add here + '(:sparc + :sparc-v9 ; For Ultrasparc processors + :complex-fp-vops ; Some slightly faster FP vops on complex numbers + :linkage-table + :stack-checking ; Throw error if we run out of stack + :heap-overflow-check ; Throw error if we run out of + ; heap (This requires gencgc!) + :gencgc ; Generational GC + :relative-package-names ; Relative package names from Allegro + :conservative-float-type + :hash-new + :random-mt19937 ; MT-19937 generator + :cmu ; Announce this is CMUCL + :cmu20 :cmu20b ; Current version identifier + :modular-arith ; Modular arithmetic + :double-double ; Double-double float support + :executable + + :solaris + :svr4 + :sun4 + :sunos + :unix + ) + ;; 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 + :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)) + +;;; Changes needed to bootstrap cross-compiling from x86 to 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") +(progn +(defun maybe-swap-string (f name &optional (len (length name))) + (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 name) + 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 2))))) + (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)) + ;; Byte swap 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-byte-swap-string string) + (format t "xpost swap cold-load-symbol: ~S to package ~S~%" string package) + (cold-intern (intern string package) package))) +) + + +;;; End changes needed to bootstrap cross-compiling from x86 to sparc + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + ;;(format t "extern-alien-name: ~S~%" name) + ;;(lisp::maybe-swap-string 'extern-alien-name (copy-seq name)) + name) +(export 'extern-alien-name) +#+(or) +(defun fixup-code-object (code offset fixup kind) + (declare (type index offset)) + (unless (zerop (rem offset vm::word-bytes)) + (error (intl:gettext "Unaligned instruction? offset=#x~X.") offset)) + (system:without-gcing + (let ((sap (truly-the system-area-pointer + (%primitive c::code-instructions code)))) + (ecase kind + (:call + (error (intl:gettext "Can't deal with CALL fixups, yet."))) + (:sethi + (setf (ldb (byte 22 0) (sap-ref-32 sap offset)) + (ldb (byte 22 10) fixup))) + (:add + (setf (ldb (byte 10 0) (sap-ref-32 sap offset)) + (ldb (byte 10 0) fixup))))))) +(export 'fixup-code-object) +#+(or) +(defun sanctify-for-execution (component) + (without-gcing + (alien-funcall (extern-alien "os_flush_icache" + (function void + system-area-pointer + unsigned-long)) + (code-instructions component) + (* (code-header-ref component code-code-size-slot) + word-bytes))) + nil) +(export 'sanctify-for-execution) + +;;; Compile the new backend. +(pushnew :bootstrap *features*) +(pushnew :building-cross-compiler *features*) +(load "target:tools/comcom") + +;;; Load the new backend. +(setf (search-list "c:") + '("target:compiler/")) +(setf (search-list "vm:") + '("c:sparc/" "c:generic/")) +(setf (search-list "assem:") + '("target:assembly/" "target:assembly/sparc/")) + +;; 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") +(load "vm:system") +(load "vm:char") +(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") +(load "vm:print") +(load "vm:alloc") +(load "vm:call") +(load "vm:nlx") +(load "vm:values") +(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 + OLD-VM:LOWTAG-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-DIGITS + old-vm:single-float-digits + 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) + ) + +(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)) + ;;(format t "extern-alien-name: ~S~%" name) + ;;(lisp::maybe-swap-string 'extern-alien-name (copy-seq name)) + name) +(export 'extern-alien-name) +#+(or) +(defun fixup-code-object (code offset fixup kind) + (declare (type index offset)) + (unless (zerop (rem offset vm::word-bytes)) + (error (intl:gettext "Unaligned instruction? offset=#x~X.") offset)) + (system:without-gcing + (let ((sap (truly-the system-area-pointer + (%primitive c::code-instructions code)))) + (ecase kind + (:call + (error (intl:gettext "Can't deal with CALL fixups, yet."))) + (:sethi + (setf (ldb (byte 22 0) (sap-ref-32 sap offset)) + (ldb (byte 22 10) fixup))) + (:add + (setf (ldb (byte 10 0) (sap-ref-32 sap offset)) + (ldb (byte 10 0) fixup))))))) +(export 'fixup-code-object) +#+(or) +(defun sanctify-for-execution (component) + (without-gcing + (alien-funcall (extern-alien "os_flush_icache" + (function void + system-area-pointer + unsigned-long)) + (code-instructions component) + (* (code-header-ref component code-code-size-slot) + word-bytes))) + nil) +(export 'sanctify-for-execution) + +(in-package :cl-user) + +;;; Don't load compiler parts from the target compilation + +(defparameter *load-stuff* nil) + +;; hack, hack, hack: Make old-x86::any-reg the same as +;; x86::any-reg as an SC. Do this by adding old-x86::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))) + + +;;(pushnew :debug *features*)

1 0

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

12 Nov '10

Date: Friday, November 12, 2010 @ 11:53:17 Author: rtoy Path: /project/cmucl/cvsroot/src/code Modified: unix.lisp Fix padding for stat64. st-pad2 was the wrong size to pad st-size to a 64-bit boundary. Add st-pad3 to make sure st-blocks is on a 64-bit boundary. Only a problem when cross-compiling from a different arch. The native compile correctly padded the fields. -----------+ unix.lisp | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) Index: src/code/unix.lisp diff -u src/code/unix.lisp:1.130 src/code/unix.lisp:1.131 --- src/code/unix.lisp:1.130 Tue Apr 20 13:57:45 2010 +++ src/code/unix.lisp Fri Nov 12 11:53:17 2010 @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /project/cmucl/cvsroot/src/code/unix.lisp,v 1.130 2010-04-20 17:57:45 rtoy Rel $") + "$Header: /project/cmucl/cvsroot/src/code/unix.lisp,v 1.131 2010-11-12 16:53:17 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -567,19 +567,20 @@ (def-alien-type nil (struct stat64 (st-dev dev-t) - (st-pad1 (array long 3)) + (st-pad1 (array long 3)) ; Pad so ino is 64-bit aligned (st-ino ino64-t) (st-mode unsigned-long) (st-nlink short) (st-uid uid-t) (st-gid gid-t) (st-rdev dev-t) - (st-pad2 (array long 2)) + (st-pad2 (array long 3)) ; Pad so size is 64-bit aligned (st-size off64-t) (st-atime (struct timestruc-t)) (st-mtime (struct timestruc-t)) (st-ctime (struct timestruc-t)) (st-blksize long) + (st-pad3 (array long 1)) ; Pad so blocks is 64-bit aligned (st-blocks blkcnt64-t) (st-fstype (array char 16)) (st-pad4 (array long 8))))

1 0