diff --git a/assembly/sparc/assem-rtns.lisp b/assembly/sparc/assem-rtns.lisp index 63a2a45264b3e96c6022b218718d36e0a7d06aab..584c1c88929bd55ffcf7f8210251365fb7916ed4 100644 --- a/assembly/sparc/assem-rtns.lisp +++ b/assembly/sparc/assem-rtns.lisp @@ -5,11 +5,11 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.4 2005/02/11 21:02:32 rtoy Rel $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.5 2010/07/19 23:08:37 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.4 2005/02/11 21:02:32 rtoy Rel $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/assem-rtns.lisp,v 1.5 2010/07/19 23:08:37 rtoy Rel $ ;;; ;;; (in-package "SPARC") @@ -242,3 +242,70 @@ (inst nop)) + + +;; Assembly routines for undefined_tramp and closure_tramp + +#+assembler +(define-assembly-routine (closure-tramp-function-alignment + (:return-style :none)) + () + ;; Align to a dualword and put in the magic function header stuff so + ;; that closure-tramp looks like a normal function with a function + ;; tag. + (align vm:lowtag-bits) + (inst byte 0)) + +#+assembler +(define-assembly-routine (closure-tramp + (:return-style :none)) + () + (inst byte 0) + (inst byte 0) + (inst byte vm:function-header-type) + ;; This is supposed to be closure-tramp, not 0. + (inst word 0) + (inst word (kernel:get-lisp-obj-address nil)) + (inst word (kernel:get-lisp-obj-address nil)) + (inst word (kernel:get-lisp-obj-address nil)) + (inst word (kernel:get-lisp-obj-address nil)) + + (loadw lexenv-tn cname-tn fdefn-function-slot other-pointer-type) + (loadw code-tn lexenv-tn closure-function-slot function-pointer-type) + (inst j code-tn (- (* function-code-offset word-bytes) function-pointer-type)) + (inst nop) + ;; Make sure following routine is dual-word aligned + (align vm:lowtag-bits)) + +#+assembler +(define-assembly-routine (undefined-tramp-function-alignment + (:return-style :none)) + () + ;; Align to a dualword and put in the magic function header stuff so + ;; that closure-tramp looks like a normal function with a function + ;; tag. + (align vm:lowtag-bits) + (inst byte 0)) + +#+assembler +(define-assembly-routine (undefined-tramp + (:return-style :none)) + () + (inst byte 0) + (inst byte 0) + (inst byte vm:function-header-type) + ;; This is supposed to be undefined-tramp, not 0. + (inst word 0) + (inst word (kernel:get-lisp-obj-address nil)) + (inst word (kernel:get-lisp-obj-address nil)) + (inst word (kernel:get-lisp-obj-address nil)) + (inst word (kernel:get-lisp-obj-address nil)) + + (let ((error (generate-cerror-code nil undefined-symbol-error cname-tn))) + (inst b error) + (inst nop) + ;; I don't think we ever return from the undefined-symbol-error + ;; handler, but the assembly code did this so we'll do it too. + (loadw code-tn cname-tn fdefn-raw-addr-slot other-pointer-type) + (inst j code-tn (- (* function-code-offset word-bytes) function-pointer-type)) + (inst nop))) diff --git a/assembly/x86/assem-rtns.lisp b/assembly/x86/assem-rtns.lisp index 23861df1549dbe7119756f47150127370ba44b50..3f6a182606d0f819211e369417fde31667013ca8 100644 --- a/assembly/x86/assem-rtns.lisp +++ b/assembly/x86/assem-rtns.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/assem-rtns.lisp,v 1.8 2009/06/11 16:03:56 rtoy Rel $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/x86/assem-rtns.lisp,v 1.9 2010/07/19 23:08:37 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -274,3 +274,23 @@ (inst jmp (make-ea :byte :base block :disp (* unwind-block-entry-pc-slot word-bytes)))) + +#+assembler +(define-assembly-routine (closure-tramp + (:return-style :none)) + () + (loadw eax-tn eax-tn fdefn-function-slot other-pointer-type) + (inst jmp (make-ea :dword :base eax-tn + :disp (- (* closure-function-slot word-bytes) + function-pointer-type)))) + +#+assembler +(define-assembly-routine (undefined-tramp + (:return-style :none)) + () + (let ((error (generate-error-code nil undefined-symbol-error + (make-random-tn :kind :normal + :sc (sc-or-lose 'descriptor-reg c::*backend*) + :offset 0)))) + (inst jmp error) + (inst ret))) diff --git a/bootfiles/20a/boot-2010-07-1-cross.lisp b/bootfiles/20a/boot-2010-07-1-cross.lisp new file mode 100644 index 0000000000000000000000000000000000000000..fe193aa75d9f93fa9f32b574a1fb3d0a7054731b --- /dev/null +++ b/bootfiles/20a/boot-2010-07-1-cross.lisp @@ -0,0 +1,16 @@ +;;; Simple cross-compile file for moving closure_tramp and +;;; undefined_tramp to Lisp assembly routines. +;;; +;;; But note that to do the cross-compile using the 2010-06 binaries, +;;; we need a cross-bootstrap file. Thus, use boot-2010-07-1.lisp as +;;; the cross-bootstrap file. The cross-compile can be done as follows: +;;; +;;; src/tools/cross-build-world.sh -rl -B src/bootfiles/20a/boot-2010-07-1.lisp <target> +;;; <cross> src/bootfiles/20a/boot-2010-07-1-cross <oldlisp> <lisp options> + + +#+x86 +(load "target:tools/cross-scripts/cross-x86-x86") + +#+sparc +(load "target:tools/cross-scripts/cross-sparc-sparc") diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp index 0fdfbb91604b036093d197eff8f819a1b6a3cded..cc9f023c8bae3f4927d9d48408be80102f870edf 100644 --- a/compiler/generic/new-genesis.lisp +++ b/compiler/generic/new-genesis.lisp @@ -4,7 +4,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.89 2010/03/19 15:19:01 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.90 2010/07/19 23:08:37 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -2165,11 +2165,25 @@ ;; running lisp. Why? Because new C code may have moved these ;; addresses so we need to use the right values. We get worldbuild ;; issues if we use the old values that don't match. +#+nil (defun lookup-special-symbol (name) (or (gethash name *cold-foreign-symbol-table* nil) (lookup-foreign-symbol (vm::extern-alien-name name) #+(or sparc ppc) :data))) +(defun lookup-special-symbol (name) + (cond + #+(or sparc x86 amd64) + ((string= name "closure_tramp") + (lookup-assembler-reference 'vm::closure-tramp)) + #+(or sparc x86 amd64) + ((string= name "undefined_tramp") + (lookup-assembler-reference 'vm::undefined-tramp)) + (t + (or (gethash name *cold-foreign-symbol-table* nil) + (lookup-foreign-symbol (vm::extern-alien-name name) + #+(or sparc ppc) :data))))) + (defvar *cold-linkage-table* (make-array 8192 :adjustable t :fill-pointer 0)) (defvar *cold-foreign-hash* (make-hash-table :test #'equal)) @@ -2193,7 +2207,9 @@ #+(or sparc ppc) (progn (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 (cold-register-foreign-linkage (vm::extern-alien-name "closure_tramp") :data) )) @@ -2725,6 +2741,19 @@ (initialize-symbols) (initialize-layouts) (setf *current-init-functions-cons* *nil-descriptor*) + ;; Load the assembler-routines now since they include + ;; undefined-tramp and closure-tramp. We need the former + ;; in order to initialize the static functions and we need + ;; the latter to be able to static fset closures. + (flet ((is-assemfile (x) + (string-equal "assem" + (pathname-type x)))) + (dolist (file-name (remove-if-not #'is-assemfile file-list)) + (write-line (namestring (truename file-name))) + (cold-load file-name)) + ;; Don't load the assem files again, otherwise we'll get + ;; two copies of everything. + (setf file-list (remove-if #'is-assemfile file-list))) (initialize-static-fns) (dolist (file (if (listp file-list) file-list diff --git a/compiler/sparc/alloc.lisp b/compiler/sparc/alloc.lisp index b213685d17d1df7bebe7cd87ea7661ac8d375eb6..613c6805ce1e3cb4860848006634d0bad1b3b71a 100644 --- a/compiler/sparc/alloc.lisp +++ b/compiler/sparc/alloc.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/alloc.lisp,v 1.24 2010/03/19 15:19:01 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/alloc.lisp,v 1.25 2010/07/19 23:08:37 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -143,11 +143,8 @@ ;; For the linkage-table stuff, we need to look up the address ;; of undefined_tramp from the linkage table instead of using ;; the address directly. - (inst li temp (make-fixup (extern-alien-name "undefined_tramp") - #-linkage-table :foreign - #+linkage-table :foreign-data)) - #+linkage-table - (loadw temp temp) + (inst li temp (make-fixup 'undefined-tramp + :assembly-routine)) (storew name result fdefn-name-slot other-pointer-type) (storew null-tn result fdefn-function-slot other-pointer-type) (storew temp result fdefn-raw-addr-slot other-pointer-type)))) diff --git a/compiler/sparc/cell.lisp b/compiler/sparc/cell.lisp index f87461f5b36aa76af1f83a88121b86012c4f021f..8aedc405aff5e97077d22453b49f57b2e87d87de 100644 --- a/compiler/sparc/cell.lisp +++ b/compiler/sparc/cell.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/cell.lisp,v 1.27 2010/03/19 15:19:01 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/cell.lisp,v 1.28 2010/07/19 23:08:37 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -135,7 +135,7 @@ (:translate (setf fdefn-function)) (:args (function :scs (descriptor-reg) :target result) (fdefn :scs (descriptor-reg))) - (:temporary (:scs (interior-reg)) lip) + (:temporary (:scs (descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) type) (:results (result :scs (descriptor-reg))) (:generator 38 @@ -143,17 +143,12 @@ (load-type type function (- function-pointer-type)) (inst cmp type function-header-type) (inst b :eq normal-fn) - (inst move lip function) - ;; For the linkage-table stuff, we need to look up the address - ;; from the linkage table instead of using the address directly. - (inst li lip (make-fixup (extern-alien-name "closure_tramp") - #-linkage-table :foreign - #+linkage-table :foreign-data)) - #+linkage-table - (loadw lip lip) + (inst move temp function) + (inst li temp (make-fixup 'closure-tramp + :assembly-routine)) (emit-label normal-fn) (storew function fdefn fdefn-function-slot other-pointer-type) - (storew lip fdefn fdefn-raw-addr-slot other-pointer-type) + (storew temp fdefn fdefn-raw-addr-slot other-pointer-type) (move result function)))) (define-vop (fdefn-makunbound) @@ -164,13 +159,8 @@ (:results (result :scs (descriptor-reg))) (:generator 38 (storew null-tn fdefn fdefn-function-slot other-pointer-type) - ;; For the linkage-table stuff, we need to look up the address - ;; from the linkage table instead of using the address directly. - (inst li temp (make-fixup (extern-alien-name "undefined_tramp") - #-linkage-table :foreign - #+linkage-table :foreign-data)) - #+linkage-table - (loadw temp temp) + (inst li temp (make-fixup 'undefined-tramp + :assembly-routine)) (storew temp fdefn fdefn-raw-addr-slot other-pointer-type) (move result fdefn))) diff --git a/compiler/sparc/vm.lisp b/compiler/sparc/vm.lisp index 587f07d10f80949a20c6f528c1c0e5ef14a00f9c..46d9b867c2babb303f15f4b74bdb56d2319872c2 100644 --- a/compiler/sparc/vm.lisp +++ b/compiler/sparc/vm.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/vm.lisp,v 1.26 2006/06/30 18:41:32 rtoy Rel $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/vm.lisp,v 1.27 2010/07/19 23:08:37 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -387,6 +387,8 @@ (defregtn nsp any-reg) (defregtn gtemp any-reg) +(defregtn lexenv descriptor-reg) +(defregtn cname descriptor-reg) ;;; Immediate-Constant-SC -- Interface diff --git a/compiler/x86/alloc.lisp b/compiler/x86/alloc.lisp index 23472b6bc11927835b69b734a3564ae59969bb17..6d7f19831447b4be426610a71de27ab59227c1eb 100644 --- a/compiler/x86/alloc.lisp +++ b/compiler/x86/alloc.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.14 2010/03/19 15:19:01 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/alloc.lisp,v 1.15 2010/07/19 23:08:37 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -162,6 +162,7 @@ (storew nil-value result code-debug-info-slot other-pointer-type))) +#+nil (define-vop (make-fdefn) (:policy :fast-safe) (:translate make-fdefn) @@ -175,6 +176,19 @@ (storew (make-fixup (extern-alien-name "undefined_tramp") :foreign) result fdefn-raw-addr-slot other-pointer-type)))) +(define-vop (make-fdefn) + (:policy :fast-safe) + (:translate make-fdefn) + (:args (name :scs (descriptor-reg) :to :eval)) + (:results (result :scs (descriptor-reg) :from :argument)) + (:node-var node) + (:generator 37 + (with-fixed-allocation (result fdefn-type fdefn-size node) + (storew name result fdefn-name-slot other-pointer-type) + (storew nil-value result fdefn-function-slot other-pointer-type) + (storew (make-fixup 'undefined-tramp :assembly-routine) + result fdefn-raw-addr-slot other-pointer-type)))) + (define-vop (make-closure) (:args (function :to :save :scs (descriptor-reg))) diff --git a/compiler/x86/cell.lisp b/compiler/x86/cell.lisp index 339571f20e31bd56c17d9099e873b59abf1bb41c..3633a70dcea28d35ec13b64d94cfeec9dcdef61d 100644 --- a/compiler/x86/cell.lisp +++ b/compiler/x86/cell.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.16 2010/03/19 15:19:01 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/cell.lisp,v 1.17 2010/07/19 23:08:37 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -169,6 +169,7 @@ (let ((err-lab (generate-error-code vop undefined-symbol-error object))) (inst jmp :e err-lab)))) +#+nil (define-vop (set-fdefn-function) (:policy :fast-safe) (:translate (setf fdefn-function)) @@ -191,6 +192,29 @@ (storew raw fdefn fdefn-raw-addr-slot other-pointer-type) (move result function))) +(define-vop (set-fdefn-function) + (:policy :fast-safe) + (:translate (setf fdefn-function)) + (:args (function :scs (descriptor-reg) :target result) + (fdefn :scs (descriptor-reg))) + (:temporary (:sc unsigned-reg) raw) + (:temporary (:sc byte-reg) type) + (:results (result :scs (descriptor-reg))) + (:generator 38 + (load-type type function (- function-pointer-type)) + (inst lea raw + (make-ea :byte :base function + :disp (- (* function-code-offset word-bytes) + function-pointer-type))) + (inst cmp type function-header-type) + (inst jmp :e normal-fn) + (inst lea raw (make-fixup 'closure-tramp :assembly-routine)) + NORMAL-FN + (storew function fdefn fdefn-function-slot other-pointer-type) + (storew raw fdefn fdefn-raw-addr-slot other-pointer-type) + (move result function))) + +#+nil (define-vop (fdefn-makunbound) (:policy :fast-safe) (:translate fdefn-makunbound) @@ -202,6 +226,17 @@ fdefn fdefn-raw-addr-slot other-pointer-type) (move result fdefn))) +(define-vop (fdefn-makunbound) + (:policy :fast-safe) + (:translate fdefn-makunbound) + (:args (fdefn :scs (descriptor-reg) :target result)) + (:results (result :scs (descriptor-reg))) + (:generator 38 + (storew nil-value fdefn fdefn-function-slot other-pointer-type) + (storew (make-fixup 'undefined-tramp :assembly-routine) + fdefn fdefn-raw-addr-slot other-pointer-type) + (move result fdefn))) + ;;;; Binding and Unbinding. diff --git a/lisp/gencgc.c b/lisp/gencgc.c index 11703d9ca1d6d617ad5d9054075edd5ea62e4a6f..b71645f94d381dd2de7fecbb2339083afcd18c0a 100644 --- a/lisp/gencgc.c +++ b/lisp/gencgc.c @@ -7,7 +7,7 @@ * * Douglas Crosher, 1996, 1997, 1998, 1999. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.107 2010/04/01 14:05:45 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.108 2010/07/19 23:08:37 rtoy Exp $ * */ @@ -670,6 +670,9 @@ print_generation_stats(int verbose) #define SSE_STATE_SIZE ((512+16)/4) int fpu_state[FPU_STATE_SIZE]; int sse_state[SSE_STATE_SIZE]; + + extern void sse_save(void *); + extern void sse_restore(void *); #elif defined(sparc) /* * 32 (single-precision) FP registers, and the FP state register. @@ -2019,13 +2022,17 @@ signal_space_p(lispobj obj) #endif } -#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) +#if (defined(DARWIN) && defined(__ppc__)) /* * The assembly code defines these as functions, so we make them * functions. We only care about their addresses anyway. */ extern char closure_tramp(); extern char undefined_tramp(); +#elif defined(sparc) +/* closure tramp and undefined tramp are Lisp assembly routines */ +#elif (defined(i386) || defined(__x86_64)) +/* undefined tramp are Lisp assembly routines */ #else extern int undefined_tramp; #endif @@ -2576,72 +2583,123 @@ scavenge(void *start_obj, long nwords) static int boxed_registers[] = BOXED_REGISTERS; +/* The GC has a notion of an "interior pointer" register, an unboxed + * register that typically contains a pointer to inside an object + * referenced by another pointer. The most obvious of these is the + * program counter, although many compiler backends define a "Lisp + * Interior Pointer" register known as reg_LIP, and various CPU + * architectures have other registers that also partake of the + * interior-pointer nature. As the code for pairing an interior + * pointer value up with its "base" register, and fixing it up after + * scavenging is complete is horribly repetitive, a few macros paper + * over the monotony. --AB, 2010-Jul-14 */ + +#define INTERIOR_POINTER_VARS(name) \ + unsigned long name; \ + unsigned long name##_offset; \ + int name##_register_pair + +#define PAIR_INTERIOR_POINTER(name, accessor) \ + name = accessor; \ + pair_interior_pointer(context, name, \ + &name##_offset, \ + &name##_register_pair) + +/* + * Do we need to check if the register we're fixing up is in the + * from-space? + */ +#define FIXUP_INTERIOR_POINTER(name, accessor) \ + do { \ + if (name##_register_pair >= 0) { \ + accessor = \ + SC_REG(context, name##_register_pair) \ + + name##_offset; \ + } \ + } while (0) + + +static void +pair_interior_pointer(os_context_t *context, unsigned long pointer, + unsigned long *saved_offset, int *register_pair) +{ + int i; + + /* + * I (RLT) think this is trying to find the boxed register that is + * closest to the LIP address, without going past it. Usually, it's + * reg_CODE or reg_LRA. But sometimes, nothing can be found. + */ + *saved_offset = 0x7FFFFFFF; + *register_pair = -1; + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { + unsigned long reg; + long offset; + int index; + + index = boxed_registers[i]; + reg = SC_REG(context, index); + + /* An interior pointer is never relative to a non-pointer + * register (an oversight in the original implementation). + * The simplest argument for why this is true is to consider + * the fixnum that happens by coincide to be the word-index in + * memory of the header for some object plus two. This is + * happenstance would cause the register containing the fixnum + * to be selected as the register_pair if the interior pointer + * is to anywhere after the first two words of the object. + * The fixnum won't be changed during GC, but the object might + * move, thus destroying the interior pointer. --AB, + * 2010-Jul-14 */ + + if (Pointerp(reg) && (PTR(reg) <= pointer)) { + offset = pointer - reg; + if (offset < *saved_offset) { + *saved_offset = offset; + *register_pair = index; + } + } + } +} + + static void scavenge_interrupt_context(os_context_t * context) { int i; - unsigned long pc_code_offset; + INTERIOR_POINTER_VARS(pc); #ifdef reg_LIP - unsigned long lip; - unsigned long lip_offset; - int lip_register_pair; + INTERIOR_POINTER_VARS(lip); #endif #ifdef reg_LR - unsigned long lr_code_offset; + INTERIOR_POINTER_VARS(lr); #endif #ifdef reg_CTR - unsigned long ctr_code_offset; + INTERIOR_POINTER_VARS(ctr); #endif #ifdef SC_NPC - unsigned long npc_code_offset; + INTERIOR_POINTER_VARS(npc); #endif #ifdef reg_LIP - /* Find the LIP's register pair and calculate it's offset */ - /* before we scavenge the context. */ - - /* - * I (RLT) think this is trying to find the boxed register that is - * closest to the LIP address, without going past it. Usually, it's - * reg_CODE or reg_LRA. But sometimes, nothing can be found. - */ - lip = SC_REG(context, reg_LIP); - lip_offset = 0x7FFFFFFF; - lip_register_pair = -1; - for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { - unsigned long reg; - long offset; - int index; - - index = boxed_registers[i]; - reg = SC_REG(context, index); - if (Pointerp(reg) && PTR(reg) <= lip) { - offset = lip - reg; - if (offset < lip_offset) { - lip_offset = offset; - lip_register_pair = index; - } - } - } + PAIR_INTERIOR_POINTER(lip, SC_REG(context, reg_LIP)); #endif /* reg_LIP */ - /* - * Compute the PC's offset from the start of the CODE - * register. - */ - pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE); + PAIR_INTERIOR_POINTER(pc, SC_PC(context)); + #ifdef SC_NPC - npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE); -#endif /* SC_NPC */ + PAIR_INTERIOR_POINTER(npc, SC_NPC(context)); +#endif #ifdef reg_LR - lr_code_offset = SC_REG(context, reg_LR) - SC_REG(context, reg_CODE); -#endif + PAIR_INTERIOR_POINTER(pc, SC_REG(context, reg_LR)); +#endif + #ifdef reg_CTR - ctr_code_offset = SC_REG(context, reg_CTR) - SC_REG(context, reg_CODE); + PAIR_INTERIOR_POINTER(pc, SC_REG(context, reg_CTR)); #endif - + /* Scanvenge all boxed registers in the context. */ for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { int index; @@ -2655,43 +2713,27 @@ scavenge_interrupt_context(os_context_t * context) scavenge(&(SC_REG(context, index)), 1); } -#ifdef reg_LIP - /* Fix the LIP */ - /* - * But what happens if lip_register_pair is -1? SC_REG on Solaris - * (see solaris_register_address in solaris-os.c) will return - * &context->uc_mcontext.gregs[2]. But gregs[2] is REG_nPC. Is - * that what we really want? My guess is that that is not what we - * want, so if lip_register_pair is -1, we don't touch reg_LIP at - * all. But maybe it doesn't really matter if LIP is trashed? + * Now that the scavenging is done, repair the various interior + * pointers. */ - if (lip_register_pair >= 0) { - SC_REG(context, reg_LIP) = - SC_REG(context, lip_register_pair) + lip_offset; - } -#endif /* reg_LIP */ +#ifdef reg_LIP + FIXUP_INTERIOR_POINTER(lip, SC_REG(context, reg_LIP)); +#endif + + FIXUP_INTERIOR_POINTER(pc, SC_PC(context)); - /* Fix the PC if it was in from space */ - if (from_space_p(SC_PC(context))) { - SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset; - } #ifdef SC_NPC - if (from_space_p(SC_NPC(context))) { - SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset; - } -#endif /* SC_NPC */ + FIXUP_INTERIOR_POINTER(npc, SC_NPC(context)); +#endif #ifdef reg_LR - if (from_space_p(SC_REG(context, reg_LR))) { - SC_REG(context, reg_LR) = SC_REG(context, reg_CODE) + lr_code_offset; - } -#endif + FIXUP_INTERIOR_POINTER(lr, SC_REG(context, reg_LR)); +#endif + #ifdef reg_CTR - if (from_space_p(SC_REG(context, reg_CTR))) { - SC_REG(context, reg_CTR) = SC_REG(context, reg_CODE) + ctr_code_offset; - } -#endif + FIXUP_INTERIOR_POINTER(ctr, SC_REG(context, reg_CTR)); +#endif } void @@ -6837,20 +6879,24 @@ verify_space(lispobj * start, size_t words) #endif } else { /* Verify that it points to another valid space */ - if (!to_readonly_space && !to_static_space && -#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) - !((thing == (int) &closure_tramp) || - (thing == (int) &undefined_tramp)) + if (!to_readonly_space && !to_static_space +#if (defined(DARWIN) && defined(__ppc__)) + + && !((thing == (int) &closure_tramp) || + (thing == (int) &undefined_tramp)) +#elif defined(sparc) || defined(i386) || defined(__x86_64) + /* Nothing for since these are Lisp assembly routines */ #else - thing != (int) &undefined_tramp + && thing != (int) &undefined_tramp #endif ) { +#if !(defined(sparc) || defined(i386) || defined(__x86_64)) fprintf(stderr, "*** Ptr %lx @ %lx sees Junk (undefined_tramp = %lx)", (unsigned long) thing, (unsigned long) start, (unsigned long) &undefined_tramp); - -#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) +#endif +#if (defined(DARWIN) && defined(__ppc__)) fprintf(stderr, " (closure_tramp = %lx)", (unsigned long) &closure_tramp); #endif diff --git a/lisp/sparc-assem.S b/lisp/sparc-assem.S index ad3b2648aea7e93ce5cc979fe16ca917cdba6f9f..1bb4f9115e05ab7467e4d5b4807e760b3a9dd230 100644 --- a/lisp/sparc-assem.S +++ b/lisp/sparc-assem.S @@ -269,7 +269,12 @@ _call_into_c: SET_SIZE(_call_into_c) - +#if 0 +/* undefined_tramp and closure_tramp are now Lisp assembly routines. + * so we don't need these anymore. Leave them here for a bit so + * we can look at the "real" versions for a while. But eventually, + * remove these. + */ .global _undefined_tramp FUNCDEF(_undefined_tramp) .align 8 @@ -318,7 +323,7 @@ _closure_tramp: jmp reg_CODE+FUNCTION_CODE_OFFSET nop SET_SIZE(_closure_tramp) - +#endif /* diff --git a/lisp/x86-assem.S b/lisp/x86-assem.S index f1c1e3d37d63fccdc796221c7239b514677d6539..46233ef0514d55388dfe45970ef7d24c89c12a33 100644 --- a/lisp/x86-assem.S +++ b/lisp/x86-assem.S @@ -1,6 +1,6 @@ ### x86-assem.S -*- Mode: Asm; -*- /** - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.33 2010/04/01 14:05:45 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-assem.S,v 1.34 2010/07/19 23:08:37 rtoy Rel $ * * Authors: Paul F. Werkowski <pw@snoopy.mv.com> * Douglas T. Crosher @@ -286,7 +286,14 @@ FUNCDEF(sse_restore) ENDFUNC(sse_restore) +#if 0 /* + * These are now implemented as Lisp assembly routines. We leave + * these here for the time being until we're sure the assembly + * routines are working as expected. + */ + + /* * The undefined-function trampoline. */ FUNCDEF(undefined_tramp) @@ -308,6 +315,8 @@ FUNCDEF(closure_tramp) jmp *CLOSURE_FUNCTION_OFFSET(%eax) ENDFUNC(closure_tramp) +#endif + /* * Function-end breakpoint magic. */ diff --git a/tools/cross-build-world.sh b/tools/cross-build-world.sh index 019ca581bdce8a00ff07db317a9263ea9f088c03..79ba037bdd1ad824eab849a8e5df26af6742bb5b 100755 --- a/tools/cross-build-world.sh +++ b/tools/cross-build-world.sh @@ -1,7 +1,7 @@ #!/bin/sh usage() { - echo "cross-build-world.sh [-crl] target-dir cross-dir cross-compiler-script [build-binary [flags]]" + echo "cross-build-world.sh [-crl] [-B file] target-dir cross-dir cross-compiler-script [build-binary [flags]]" echo " -c Clean target and cross directories before compiling" echo " -r Recompile lisp runtime" echo " -l Load cross-compiled kernel to make a new lisp kernel"