From af86726405b365421fd354ec8115efc6a69e35cf Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Fri, 22 Aug 2003 13:22:16 +0000 Subject: [PATCH] Merge sparc_gencgc_branch that adds support for gencgc for Solaris. --- assembly/sparc/array.lisp | 16 +- code/sparc-svr4-vm.lisp | 5 +- compiler/sparc/alloc.lisp | 17 +- compiler/sparc/array.lisp | 5 +- compiler/sparc/macros.lisp | 60 ++++- compiler/sparc/parms.lisp | 16 +- lisp/Config.sun4_solaris_gcc | 13 +- lisp/gencgc.c | 416 +++++++++++++++++++++++++++++------ lisp/gencgc.h | 8 +- lisp/purify.c | 13 +- lisp/save.c | 13 +- lisp/solaris-os.c | 43 +++- lisp/sparc-arch.c | 177 ++++++++++++++- lisp/sparc-assem.S | 114 +++++++++- 14 files changed, 810 insertions(+), 106 deletions(-) diff --git a/assembly/sparc/array.lisp b/assembly/sparc/array.lisp index 1bbbd9094..d4c01d6d8 100644 --- a/assembly/sparc/array.lisp +++ b/assembly/sparc/array.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/array.lisp,v 1.7 2003/08/03 11:27:50 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/array.lisp,v 1.8 2003/08/22 13:20:02 toy Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/array.lisp,v 1.7 2003/08/03 11:27:50 gerd Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/sparc/array.lisp,v 1.8 2003/08/22 13:20:02 toy Exp $ ;;; ;;; This file contains the support routines for arrays and vectors. ;;; @@ -30,11 +30,18 @@ (:res result descriptor-reg a0-offset) (:temp ndescr non-descriptor-reg nl0-offset) + (:temp gc-temp non-descriptor-reg nl1-offset) (:temp vector descriptor-reg a3-offset)) (pseudo-atomic () (inst add ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes)) - (inst andn ndescr 7) - (allocation vector ndescr other-pointer-type) + (inst andn ndescr vm:lowtag-mask) + (allocation vector ndescr other-pointer-type :temp-tn gc-temp) + #+gencgc + (progn + ;; ndescr points to one word past the end of the allocated + ;; space. Fill the last word with a zero. + (inst add ndescr vector) + (storew zero-tn ndescr -1 vm:other-pointer-type)) (inst srl ndescr type vm:word-shift) (storew ndescr vector 0 vm:other-pointer-type) (storew length vector vm:vector-length-slot vm:other-pointer-type)) @@ -46,6 +53,7 @@ ;; the zero-byte of the string is. Look at the deftransform for ;; make-array in array-tran.lisp. For strings we always allocate ;; enough space to hold the zero-byte. + #-gencgc (storew zero-tn alloc-tn -1) (move result vector)) diff --git a/code/sparc-svr4-vm.lisp b/code/sparc-svr4-vm.lisp index e09fe3cd2..4e1e6d0ae 100644 --- a/code/sparc-svr4-vm.lisp +++ b/code/sparc-svr4-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/code/sparc-svr4-vm.lisp,v 1.6 2003/04/01 21:19:24 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-svr4-vm.lisp,v 1.7 2003/08/22 13:20:03 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -401,3 +401,6 @@ (when (< entry (lisp::foreign-linkage-symbols)) (lisp::foreign-linkage-entry entry))))) ) + +;;; Enable/Disable scavenging of the read-only space. +(defvar *scavenge-read-only-space* nil) diff --git a/compiler/sparc/alloc.lisp b/compiler/sparc/alloc.lisp index f8f649019..5a761b607 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.15 2003/08/06 21:12:07 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/alloc.lisp,v 1.16 2003/08/22 13:20:03 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -47,7 +47,7 @@ (let* ((cons-cells (if star (1- num) num)) (alloc (* (pad-data-block cons-size) cons-cells))) (pseudo-atomic () - (allocation res alloc list-pointer-type) + (allocation res alloc list-pointer-type :temp-tn temp) (move ptr res) (dotimes (i (1- cons-cells)) (storew (maybe-load (tn-ref-tn things)) ptr @@ -82,6 +82,7 @@ (:temporary (:scs (non-descriptor-reg)) size) (:temporary (:scs (any-reg) :from (:argument 0)) boxed) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed) + ;;(:temporary (:scs (any-reg)) gc-temp) (:generator 100 (inst add boxed boxed-arg (fixnumize (1+ code-trace-table-offset-slot))) (inst and boxed (lognot lowtag-mask)) @@ -89,11 +90,9 @@ (inst add unboxed lowtag-mask) (inst and unboxed (lognot lowtag-mask)) (pseudo-atomic () - ;; Note: we don't have to subtract off the 4 that was added by - ;; pseudo-atomic, because oring in other-pointer-type just adds - ;; it right back. + ;; Figure out how much space we really need and allocate it. (inst add size boxed unboxed) - (allocation result size other-pointer-type) + (allocation result size other-pointer-type :temp-tn ndescr) (inst sll ndescr boxed (- type-bits word-shift)) (inst or ndescr code-header-type) (storew ndescr result 0 other-pointer-type) @@ -161,7 +160,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:generator 4 (pseudo-atomic () - (allocation result (pad-data-block words) lowtag) + (allocation result (pad-data-block words) lowtag :temp-tn temp) (when type (inst li temp (logior (ash (1- words) type-bits) type)) (storew temp result 0 lowtag))))) @@ -173,7 +172,7 @@ (:ignore name) (:results (result :scs (descriptor-reg))) (:temporary (:scs (any-reg)) bytes header) - (:temporary (:scs (descriptor-reg)) temp) + (:temporary (:scs (any-reg)) temp) (:generator 6 (inst add bytes extra (* (1+ words) word-bytes)) (inst sll header bytes (- type-bits 2)) @@ -182,5 +181,5 @@ (pseudo-atomic () ;; Need to be careful if the lowtag and the pseudo-atomic flag ;; are not compatible - (allocation result bytes lowtag) + (allocation result bytes lowtag :temp-tn temp) (storew header result 0 lowtag)))) diff --git a/compiler/sparc/array.lisp b/compiler/sparc/array.lisp index 49cc2140d..4dcd79e9c 100644 --- a/compiler/sparc/array.lisp +++ b/compiler/sparc/array.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/array.lisp,v 1.28 2003/08/03 11:27:46 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/array.lisp,v 1.29 2003/08/22 13:20:03 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -28,12 +28,13 @@ (:arg-types tagged-num tagged-num) (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header) (:temporary (:scs (non-descriptor-reg)) ndescr) + (:temporary (:scs (non-descriptor-reg)) gc-temp) ; gencgc (:results (result :scs (descriptor-reg))) (:generator 0 (pseudo-atomic () (inst add ndescr rank (* (1+ array-dimensions-offset) vm:word-bytes)) (inst andn ndescr 4) - (allocation header ndescr other-pointer-type) + (allocation header ndescr other-pointer-type :temp-tn gc-temp) (inst add ndescr rank (fixnumize (1- vm:array-dimensions-offset))) (inst sll ndescr ndescr vm:type-bits) (inst or ndescr ndescr type) diff --git a/compiler/sparc/macros.lisp b/compiler/sparc/macros.lisp index 2e1f46eb6..7a0586506 100644 --- a/compiler/sparc/macros.lisp +++ b/compiler/sparc/macros.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/compiler/sparc/macros.lisp,v 1.20 2003/08/06 19:00:12 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.21 2003/08/22 13:20:03 toy Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.20 2003/08/06 19:00:12 gerd Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/macros.lisp,v 1.21 2003/08/22 13:20:03 toy Exp $ ;;; ;;; This file contains various useful macros for generating SPARC code. ;;; @@ -200,6 +200,11 @@ ;; that the appropriate compiler policy can be used, and TEMP-TN, ;; which is needed for work-space. TEMP-TN MUST be a non-descriptor ;; reg. +;; +;; If generational GC is enabled, you MUST supply a value for TEMP-TN +;; because a temp register is needed to do inline allocation. +;; TEMP-TN, in this case, can be any register, since it holds a +;; double-word aligned address (essentially a fixnum). (defmacro allocation (result-tn size lowtag &key stack-p node temp-tn) ;; We assume we're in a pseudo-atomic so the pseudo-atomic bit is ;; set. If the lowtag also has a 1 bit in the same position, we're all @@ -217,6 +222,7 @@ (inst andn ,temp-tn #.(1- (expt 2 lowtag-bits))) (inst or ,result-tn ,temp-tn ,lowtag) (inst add csp-tn ,temp-tn ,size)) + #-gencgc (t ;; Normal allocation to the heap. (if (logbitp (1- lowtag-bits) ,lowtag) @@ -226,7 +232,52 @@ (progn (inst andn ,result-tn alloc-tn lowtag-mask) (inst or ,result-tn ,lowtag) - (inst add alloc-tn ,size)))))) + (inst add alloc-tn ,size)))) + #+gencgc + (t + ;; The OR instruction MUST come just before the TRAP + ;; instruction, because the C code depends on this to figure + ;; out what to do. + (without-scheduling () + (let ((done (gen-label)) + (full-alloc (gen-label))) + ;; See if we can do an inline allocation. The updated + ;; free pointer should not point past the end of the + ;; current region. If it does, a full alloc needs to be + ;; done. + (load-symbol-value ,result-tn *current-region-free-pointer*) + (load-symbol-value ,temp-tn *current-region-end-addr*) + (inst add ,result-tn ,size) + ;; Do we need to round up? I hope not because result-tn + ;; is descriptor! + + ;;(inst add ,result-tn vm:lowtag-mask) + ;;(inst andn ,result-tn vm:lowtag-mask) + + ;; result-tn points to the new end of region. Did we go + ;; past the actual end of the region? If so, we need a + ;; full alloc. + (inst cmp ,result-tn ,temp-tn) + (inst b :gt full-alloc #+sparc-v9 :pn) + (inst nop) + ;; Inline allocation worked, so update the free pointer + ;; and go. Should really do a swap instruction here to + ;; swap memory with a register. + (load-symbol-value ,temp-tn *current-region-free-pointer*) + (store-symbol-value ,result-tn *current-region-free-pointer*) + (inst b done) + (move ,result-tn ,temp-tn) + + (emit-label full-alloc) + ;; Full alloc via trap to the C allocator. Tell the + ;; allocator what the result-tn and size are, using the + ;; OR instruction. Then trap to the allocator. + (inst or zero-tn ,result-tn ,size) + (inst t :t allocation-trap) + + (emit-label done) + ;; Set lowtag appropriately + (inst or ,result-tn ,lowtag)))))) (defmacro with-fixed-allocation ((result-tn temp-tn type-code size) @@ -239,7 +290,8 @@ (once-only ((result-tn result-tn) (temp-tn temp-tn) (type-code type-code) (size size)) `(pseudo-atomic () - (allocation ,result-tn (pad-data-block ,size) other-pointer-type) + (allocation ,result-tn (pad-data-block ,size) other-pointer-type + #+gencgc :temp-tn #+gencgc ,temp-tn) (inst li ,temp-tn (logior (ash (1- ,size) type-bits) ,type-code)) (storew ,temp-tn ,result-tn 0 other-pointer-type) ,@body))) diff --git a/compiler/sparc/parms.lisp b/compiler/sparc/parms.lisp index eab6d1e50..e8a0bf99e 100644 --- a/compiler/sparc/parms.lisp +++ b/compiler/sparc/parms.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/parms.lisp,v 1.41 2003/05/29 22:03:01 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.42 2003/08/22 13:20:03 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -289,6 +289,14 @@ lisp::*cmucl-lib* lisp::*cmucl-core-path* + ;; Gencgc + #+gencgc + *current-region-free-pointer* + #+gencgc + *current-region-end-addr* + #+gencgc + *scavenge-read-only-space* + ;; Some spare static symbols. Useful for adding another static ;; symbol without having to do a cross-compile. Just rename one ;; of these to the desired name. @@ -330,3 +338,9 @@ ;;;; are only used in an illtrap instruction, not the trap ;;;; instruction. This needs to be coordinated with the C code. (defconstant pseudo-atomic-trap 16) + +;;;; Allocation trap number. +;;;; +;;;; This is the trap number to use when we need to allocate memory. +;;;; This must match the C runtime code +(defconstant allocation-trap 31) diff --git a/lisp/Config.sun4_solaris_gcc b/lisp/Config.sun4_solaris_gcc index 125c59cd9..33a144416 100644 --- a/lisp/Config.sun4_solaris_gcc +++ b/lisp/Config.sun4_solaris_gcc @@ -28,7 +28,10 @@ AS_V8PLUS = -Wa,-xarch=v8plus LINKAGE = -DLINKAGE_TABLE -CPPFLAGS = -I. -I$(PATH1) -I/usr/openwin/include -I/usr/include/X11 -DSOLARIS -DSOLARIS25 -DSVR4 $(CC_V8PLUS) $(LINKAGE) +# Enable support for generational GC +GENCGC = -DGENCGC + +CPPFLAGS = -I. -I$(PATH1) -I/usr/openwin/include -I/usr/include/X11 -DSOLARIS -DSOLARIS25 -DSVR4 $(CC_V8PLUS) $(LINKAGE) $(GENCGC) CC = gcc -O CPP = gcc -E @@ -36,7 +39,7 @@ CFLAGS = -g $(AS_V8PLUS) # Needed for sys/asm_linkage.h and sparc-assem.S (at least in 2.3) # Note that the sys/asm_linkage.h braindamage breaks make depend -ASFLAGS = -g -traditional-cpp +ASFLAGS = -g -traditional-cpp $(AS_V8PLUS) DEPEND_FLAGS = -traditional-cpp NM = $(PATH1)/solaris-nm ASSEM_SRC = sparc-assem.S @@ -49,3 +52,9 @@ ARCH_SRC = sparc-arch.c OS_SRC = solaris-os.c os-common.c undefineds.c elf.c OS_LINK_FLAGS= OS_LIBS= -lsocket -lnsl -ldl + +# Use this with generational GC +GC_SRC = gencgc.c + +# Use this when not using generational GC +# GC_SRC = gc.c diff --git a/lisp/gencgc.c b/lisp/gencgc.c index 384df346e..11f43bb7f 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.32 2003/03/27 12:42:10 gerd Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.33 2003/08/22 13:20:03 toy Exp $ * */ @@ -28,7 +28,39 @@ #define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \ __FILE__, __LINE__) -#if 0 +#if defined(i386) +#define set_alloc_pointer(value) SetSymbolValue(ALLOCATION_POINTER, value) +#define get_alloc_pointer() SymbolValue(ALLOCATION_POINTER) +#define get_binding_stack_pointer() SymbolValue(BINDING_STACK_POINTER) +#define get_pseudo_atomic_atomic() SymbolValue(PSEUDO_ATOMIC_ATOMIC) +#define set_pseudo_atomic_atomic() SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); +#define clr_pseudo_atomic_atomic() SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1)); +#define get_pseudo_atomic_interrupted() SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) +#define clr_pseudo_atomic_interrupted() SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0)) +#elif defined(sparc) +#define set_alloc_pointer(value) (current_dynamic_space_free_pointer = (value)) +#define get_alloc_pointer() (current_dynamic_space_free_pointer) +#define get_binding_stack_pointer() (current_binding_stack_pointer) +#define get_pseudo_atomic_atomic() \ + ((unsigned long)current_dynamic_space_free_pointer & 4) +#define set_pseudo_atomic_atomic() \ + (current_dynamic_space_free_pointer \ + = (lispobj*) ((unsigned long)current_dynamic_space_free_pointer | 4)) +#define clr_pseudo_atomic_atomic() \ + (current_dynamic_space_free_pointer \ + = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~4)) +#define get_pseudo_atomic_interrupted() ((unsigned long) current_dynamic_space_free_pointer & 1) +#define clr_pseudo_atomic_interrupted() \ + (current_dynamic_space_free_pointer \ + = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~1)) +#else +#endif + +/* + * Leave the gc_asserts enabled on sparc for a while yet until this + * stabilizes. + */ +#if defined(sparc) #define gc_assert(ex) do { \ if (!(ex)) gc_abort(); \ } while (0) @@ -71,7 +103,9 @@ boolean enable_page_protection = TRUE; int verify_gens = NUM_GENERATIONS; /* - * Enable a pre-scan verify of generation 0 before it's GCed. + * Enable a pre-scan verify of generation 0 before it's GCed. (This + * makes GC very, very slow, so don't enable this unless you really + * need it!) */ boolean pre_verify_gen_0 = FALSE; @@ -88,7 +122,7 @@ boolean verify_dynamic_code_check = FALSE; /* * Enable the checking of code objects for fixup errors after they are - * transported. + * transported. (Only used for x86.) */ boolean check_code_fixups = FALSE; @@ -403,14 +437,26 @@ static double gen_av_mem_age(int gen) void print_generation_stats(int verbose) { int i, gens; - int fpu_state[27]; +#if defined(i386) +#define FPU_STATE_SIZE 27 + int fpu_state[FPU_STATE_SIZE]; +#elif defined(sparc) + /* + * 32 (single-precision) FP registers, and the FP state register. + * But Sparc V9 has 32 double-precision registers (equivalent to 64 + * single-precision, but can't be accessed), so we leave enough room + * for that. + */ +#define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2) + long long fpu_state[FPU_STATE_SIZE]; +#endif /* * This code uses the FP instructions which may be setup for Lisp so * they need to the saved and reset for C. */ fpu_save(fpu_state); - + /* Number of generations to print out. */ if (verbose) gens = NUM_GENERATIONS + 1; @@ -757,9 +803,9 @@ static void gc_alloc_new_region(int nbytes, int unboxed, /* Bump up the last_free_page */ if (last_page + 1 > last_free_page) { last_free_page = last_page + 1; - SetSymbolValue(ALLOCATION_POINTER, - (lispobj) ((char *) heap_base + - PAGE_SIZE * last_free_page)); + set_alloc_pointer((lispobj) ((char *) heap_base + + PAGE_SIZE * last_free_page)); + } } @@ -938,7 +984,7 @@ void gc_alloc_update_page_tables(int unboxed, */ while (more) { #if 0 - fprintf(stderr, "+") + fprintf(stderr, "+"); #endif gc_assert(PAGE_ALLOCATED(next_page)); gc_assert(PAGE_UNBOXED_VAL(next_page) == unboxed); @@ -1241,9 +1287,8 @@ static void *gc_alloc_large(int nbytes, int unboxed, /* Bump up the last_free_page */ if (last_page + 1 > last_free_page) { last_free_page = last_page + 1; - SetSymbolValue(ALLOCATION_POINTER, - (lispobj) ((char *) heap_base + - PAGE_SIZE * last_free_page)); + set_alloc_pointer((lispobj) ((char *) heap_base + + PAGE_SIZE * last_free_page)); } return (void *) (page_address(first_page) + orig_first_page_bytes_used); @@ -1936,10 +1981,133 @@ static void scavenge(lispobj *start, long nwords) gc_assert(nwords == 0); } + +#ifndef i386 +/* Scavenging Interrupt Contexts */ + +static int boxed_registers[] = BOXED_REGISTERS; + +static void scavenge_interrupt_context(struct sigcontext *context) +{ + int i; +#ifdef reg_LIP + unsigned long lip; + unsigned long lip_offset; + int lip_register_pair; +#endif + unsigned long pc_code_offset; +#ifdef SC_NPC + unsigned long npc_code_offset; +#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; + } + } + } +#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); +#ifdef SC_NPC + npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE); +#endif /* SC_NPC */ + + /* Scanvenge all boxed registers in the context. */ + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) + { + int index; + lispobj foo; + + index = boxed_registers[i]; + foo = SC_REG(context,index); + scavenge((lispobj *) &foo, 1); + SC_REG(context,index) = foo; + + scavenge((lispobj *) &(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? + */ + if (lip_register_pair >= 0) + { + SC_REG(context, reg_LIP) = + SC_REG(context, lip_register_pair) + lip_offset; + } +#endif /* reg_LIP */ + + /* 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 */ +} + +void scavenge_interrupt_contexts(void) +{ + int i, index; + struct sigcontext *context; + + index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)); + +#if defined(DEBUG_PRINT_CONTEXT_INDEX) + printf("Number of active contexts: %d\n", index); +#endif + + for (i = 0; i < index; i++) + { + context = lisp_interrupt_contexts[i]; + scavenge_interrupt_context(context); + } +} +#endif /* Code and Code-Related Objects */ +/* + * Aargh! Why is SPARC so different here? What is the advantage of + * making it different from all the other ports? + */ +#ifdef sparc +#define RAW_ADDR_OFFSET 0 +#else #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer) +#endif static lispobj trans_function_header(lispobj object); static lispobj trans_boxed(lispobj object); @@ -2042,6 +2210,7 @@ static int scav_function_pointer(lispobj *where, lispobj object) } #endif +#ifdef i386 /* * Scan a x86 compiled code objected, looking for possible fixups that * have been missed after a move. @@ -2340,6 +2509,7 @@ static void apply_code_fixups(struct code *old_code, struct code *new_code) if (check_code_fixups) sniff_code_object(new_code, displacement); } +#endif static struct code * trans_code(struct code *code) { @@ -2356,7 +2526,10 @@ static struct code * trans_code(struct code *code) /* If object has already been transported, just return pointer */ if (*(lispobj *) code == 0x01) - return (struct code*) (((lispobj *) code)[1]); + { + return (struct code*) (((lispobj *) code)[1]); + } + gc_assert(TypeOf(code->header) == type_CodeHeader); @@ -2424,7 +2597,15 @@ static struct code * trans_code(struct code *code) #if 0 sniff_code_object(new_code, displacement); #endif +#ifdef i386 apply_code_fixups(code, new_code); +#else + /* From gc.c */ +#ifndef MACH + os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words), + ncode_words * sizeof(int)); +#endif +#endif return new_code; } @@ -2504,13 +2685,12 @@ static lispobj trans_return_pc_header(lispobj object) unsigned long offset; struct code *code, *ncode; - fprintf(stderr, "*** trans_return_pc_header: will this work?\n"); - return_pc = (struct function *) PTR(object); offset = HeaderValue(return_pc->header) * 4; /* Transport the whole code object */ code = (struct code *) ((unsigned long) return_pc - offset); + ncode = trans_code(code); return ((lispobj) ncode + offset) | type_OtherPointer; @@ -2833,16 +3013,16 @@ static int scav_boxed(lispobj *where, lispobj object) static lispobj trans_boxed(lispobj object) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) PTR(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return copy_object(object, length); + return copy_object(object, length); } static lispobj trans_boxed_large(lispobj object) @@ -3311,9 +3491,10 @@ scav_hash_vector (lispobj *where, lispobj object) length. The first value is the symbol :empty, the first key is a reference to the hash-table containing the key/value vector. (See hash-new.lisp, MAKE-HASH-TABLE.) */ - + kv_length = fixnum_value (where[1]); kv_vector = where + 2; + scavenge (kv_vector, 2); gc_assert (Pointerp (kv_vector[0])); @@ -3323,7 +3504,30 @@ scav_hash_vector (lispobj *where, lispobj object) hash_table = (struct hash_table *) PTR (hash_table_obj); empty_symbol = kv_vector[1]; + /* + * For some reason, the following GC assert doesn't always hold true + * on Sparc/gencgc. I (RLT) don't know why that is. So turn it off + * for now. I leave these printfs here so I can see it happening, + * just in case. + */ +#ifdef sparc + if (where != (lispobj *) PTR (hash_table->table)) + { + fprintf(stderr, "Hash table invariant failed during scavenging!\n"); + fprintf(stderr, " *** where = %lx\n", where); + fprintf(stderr, " *** hash_table = %lx\n", hash_table); + fprintf(stderr, " *** hash_table->table = %lx\n", PTR(hash_table->table)); +#if 0 + reset_printer(); + print(object); + abort(); +#endif + } +#endif + +#ifndef sparc gc_assert (where == (lispobj *) PTR (hash_table->table)); +#endif gc_assert (TypeOf (hash_table->instance_header) == type_InstanceHeader); gc_assert (TypeOf (*(lispobj *) PTR (empty_symbol)) == type_SymbolHeader); @@ -4079,9 +4283,11 @@ static void gc_init_tables(void) scavtab[type_ComplexVector] = scav_boxed; scavtab[type_ComplexArray] = scav_boxed; scavtab[type_CodeHeader] = scav_code_header; - /*scavtab[type_FunctionHeader] = scav_function_header;*/ - /*scavtab[type_ClosureFunctionHeader] = scav_function_header;*/ - /*scavtab[type_ReturnPcHeader] = scav_return_pc_header;*/ +#ifndef i386 + scavtab[type_FunctionHeader] = scav_function_header; + scavtab[type_ClosureFunctionHeader] = scav_function_header; + scavtab[type_ReturnPcHeader] = scav_return_pc_header; +#endif #ifdef i386 scavtab[type_ClosureHeader] = scav_closure_header; scavtab[type_FuncallableInstanceHeader] = scav_closure_header; @@ -4102,7 +4308,16 @@ static void gc_init_tables(void) scavtab[type_UnboundMarker] = scav_immediate; scavtab[type_WeakPointer] = scav_weak_pointer; scavtab[type_InstanceHeader] = scav_boxed; + /* + * Note: on the sparc we don't have to do anything special for + * fdefns, cause the raw-addr has a function lowtag. + */ +#ifndef sparc scavtab[type_Fdefn] = scav_fdefn; +#else + scavtab[type_Fdefn] = scav_boxed; +#endif + scavtab[type_ScavengerHook] = scav_scavenger_hook; /* Transport Other Table */ @@ -5387,7 +5602,11 @@ static void unprotect_oldspace(void) * generation. Bytes_allocated and the generation bytes_allocated * counter are updated. The number of bytes freed is returned. */ +#ifdef i386 extern void i586_bzero(void *addr, int nbytes); +#else +#define i586_bzero(addr, nbytes) memset(addr, 0, nbytes) +#endif static int free_oldspace(void) { int bytes_freed = 0; @@ -5483,7 +5702,11 @@ static void print_ptr(lispobj *addr) *(addr + 1), *(addr + 2), *(addr + 3), *(addr + 4)); } +#ifdef sparc +extern char closure_tramp; +#else extern int undefined_tramp; +#endif static void verify_space(lispobj*start, size_t words) { @@ -5542,14 +5765,28 @@ static void verify_space(lispobj*start, size_t words) print_ptr(start); } #endif - } else + } else { /* Verify that it points to another valid space */ - if (!to_readonly_space && !to_static_space - && thing != (int) &undefined_tramp) { - fprintf(stderr, "*** Ptr %lx @ %lx sees Junk\n", - (unsigned long) thing, (unsigned long) start); - print_ptr(start); - } + if (!to_readonly_space && !to_static_space && +#if defined(sparc) + thing != (int) &closure_tramp +#else + thing != (int) &undefined_tramp +#endif + ) + { + fprintf(stderr, "*** Ptr %lx @ %lx sees Junk (undefined_tramp = %lx)\n", + (unsigned long) thing, (unsigned long) start, +#if defined(sparc) + (unsigned long) &closure_tramp +#else + (unsigned long) &undefined_tramp +#endif + ); + print_ptr(start); + } + } + } else if (thing & 0x3) /* Skip fixnums */ switch(TypeOf(*start)) { @@ -5694,7 +5931,7 @@ static void verify_gc(void) (lispobj*) SymbolValue(STATIC_SPACE_FREE_POINTER) - (lispobj*) static_space; int binding_stack_size = - (lispobj*) SymbolValue(BINDING_STACK_POINTER) + (lispobj*) get_binding_stack_pointer() - (lispobj*) BINDING_STACK_START; verify_space((lispobj*) READ_ONLY_SPACE_START, read_only_space_size); @@ -5896,6 +6133,7 @@ static void garbage_collect_generation(int generation, int raise) */ unprotect_oldspace(); +#ifdef i386 /* Scavenge the stacks conservative roots. */ { lispobj **ptr; @@ -5903,6 +6141,8 @@ static void garbage_collect_generation(int generation, int raise) ptr > (lispobj **) &raise; ptr--) preserve_pointer(*ptr); } +#endif + #ifdef CONTROL_STACKS scavenge_thread_stacks(); #endif @@ -5911,6 +6151,13 @@ static void garbage_collect_generation(int generation, int raise) int num_dont_move_pages = count_dont_move_pages(); fprintf(stderr, "Non-movable pages due to conservative pointers = %d, %d bytes\n", num_dont_move_pages, PAGE_SIZE * num_dont_move_pages); +#ifndef i386 + /* + * There shouldn't be any non-movable pages because we don't have + * any conservative pointers! + */ + gc_assert(num_dont_move_pages == 0); +#endif } /* Scavenge all the rest of the roots. */ @@ -5920,17 +6167,55 @@ static void garbage_collect_generation(int generation, int raise) * care to avoid SIG_DFL, SIG_IGN. */ +#ifndef i386 + /* + * If not x86, scavenge the interrupt context(s) and the control + * stack. + */ +#ifdef PRINTNOISE + printf("Scavenging interrupt contexts ...\n"); +#endif + scavenge_interrupt_contexts(); +#ifdef PRINTNOISE + printf("Scavenging interrupt handlers (%d bytes) ...\n", + sizeof(interrupt_handlers)); +#endif + scavenge((lispobj *) interrupt_handlers, + sizeof(interrupt_handlers) / sizeof(lispobj)); + { + unsigned long control_stack_size; + + control_stack_size = current_control_stack_pointer - control_stack; +#ifdef PRINTNOISE + printf("Scavenging the control stack (%d bytes) ...\n", + control_stack_size * sizeof(lispobj)); +#endif + scavenge(control_stack, control_stack_size); +#ifdef PRINTNOISE + printf("Done scavenging the control stack.\n"); +#endif + } + +#else /* x86 */ for (i = 0; i < NSIG; i++) { union interrupt_handler handler = interrupt_handlers[i]; if (handler.c != (void (*) (HANDLER_ARGS)) SIG_IGN && handler.c != (void (*) (HANDLER_ARGS)) SIG_DFL) scavenge((lispobj *) (interrupt_handlers + i), 1); } - +#endif + +#ifdef PRINTNOISE + printf("Scavenging the binding stack (%d bytes) ...\n", + ((lispobj *) get_binding_stack_pointer() - binding_stack) * sizeof(lispobj)); +#endif /* Scavenge the binding stack. */ scavenge(binding_stack, - (lispobj *) SymbolValue(BINDING_STACK_POINTER) - binding_stack); + (lispobj *) get_binding_stack_pointer() - binding_stack); +#ifdef PRINTNOISE + printf("Done scavenging the binding stack.\n"); +#endif /* * Scavenge the scavenge_hooks in case this refers to a hook added * in a prior generation GC. From here on the scavenger_hook will @@ -5938,7 +6223,13 @@ static void garbage_collect_generation(int generation, int raise) * doing here. */ +#ifdef PRINTNOISE + printf("Scavenging the scavenger hooks ...\n"); +#endif scavenge((lispobj *) &scavenger_hooks, 1); +#ifdef PRINTNOISE + printf("Done scavenging the scavenger hooks.\n"); +#endif if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { read_only_space_size = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER) @@ -5978,7 +6269,7 @@ static void garbage_collect_generation(int generation, int raise) */ { int old_bytes_allocated = bytes_allocated; - int bytes_allocated; + int bytes_allocated_diff; /* Start with a full scavenge */ scavenge_newspace_generation_one_scan(new_space); @@ -5989,11 +6280,11 @@ static void garbage_collect_generation(int generation, int raise) gc_alloc_update_page_tables(0, &boxed_region); gc_alloc_update_page_tables(1, &unboxed_region); - bytes_allocated = bytes_allocated - old_bytes_allocated; + bytes_allocated_diff = bytes_allocated - old_bytes_allocated; - if (bytes_allocated != 0) - fprintf(stderr, "*** rescan of new_space allocated % more bytes?\n", - bytes_allocated); + if (bytes_allocated_diff != 0) + fprintf(stderr, "*** rescan of new_space allocated %d more bytes? (%ld vs %ld)\n", + bytes_allocated_diff, old_bytes_allocated, bytes_allocated); } #endif @@ -6047,7 +6338,7 @@ static void garbage_collect_generation(int generation, int raise) } /* Update last_free_page then ALLOCATION_POINTER */ -void update_x86_dynamic_space_free_pointer(void) +void update_dynamic_space_free_pointer(void) { int last_page = -1; int i; @@ -6058,8 +6349,7 @@ void update_x86_dynamic_space_free_pointer(void) last_free_page = last_page + 1; - SetSymbolValue(ALLOCATION_POINTER, - (lispobj) ((char *) heap_base + PAGE_SIZE * last_free_page)); + set_alloc_pointer((lispobj) ((char *) heap_base + PAGE_SIZE * last_free_page)); } @@ -6188,7 +6478,7 @@ void collect_garbage(unsigned last_gen) gc_assert(boxed_region.free_pointer - boxed_region.start_addr == 0); gc_alloc_generation = 0; - update_x86_dynamic_space_free_pointer(); + update_dynamic_space_free_pointer(); SetSymbolValue(CURRENT_REGION_FREE_POINTER, (lispobj) boxed_region.free_pointer); SetSymbolValue(CURRENT_REGION_END_ADDR, (lispobj) boxed_region.end_addr); @@ -6301,8 +6591,9 @@ void gc_free_heap(void) unboxed_region.end_addr = page_address(0); last_free_page = 0; - SetSymbolValue(ALLOCATION_POINTER, (lispobj) heap_base); + set_alloc_pointer((lispobj) heap_base); + SetSymbolValue(CURRENT_REGION_FREE_POINTER, (lispobj) boxed_region.free_pointer); SetSymbolValue(CURRENT_REGION_END_ADDR, (lispobj) boxed_region.end_addr); @@ -6395,7 +6686,7 @@ void gencgc_pickup_dynamic(void) { int page = 0; int addr = DYNAMIC_0_SPACE_START; - int alloc_ptr = SymbolValue(ALLOCATION_POINTER); + int alloc_ptr = get_alloc_pointer(); /* Initialise the first region. */ do { @@ -6443,7 +6734,8 @@ void do_pending_interrupt(void); int alloc_entered = 0; -char *alloc(int nbytes) +char * +alloc(int nbytes) { /* Check for alignment allocation problems. */ gc_assert(((unsigned) SymbolValue(CURRENT_REGION_FREE_POINTER) & 0x7) == 0 @@ -6451,7 +6743,7 @@ char *alloc(int nbytes) bytes_allocated_sum += nbytes; - if (SymbolValue(PSEUDO_ATOMIC_ATOMIC)) { + if (get_pseudo_atomic_atomic()) { /* Already within a pseudo atomic. */ void *new_free_pointer; @@ -6475,14 +6767,14 @@ char *alloc(int nbytes) auto_gc_trigger *= 2; alloc_entered--; /* Exit the pseudo atomic */ - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0) + clr_pseudo_atomic_atomic(); + if (get_pseudo_atomic_interrupted() != 0) /* Handle any interrupts that occurred during gc_alloc */ do_pending_interrupt(); funcall0(SymbolFunction(MAYBE_GC)); /* Re-enter the pseudo atomic. */ - SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0)); - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1)); + clr_pseudo_atomic_interrupted(); + set_pseudo_atomic_atomic(); goto retry1; } /* Call gc_alloc */ @@ -6512,8 +6804,8 @@ char *alloc(int nbytes) retry2: /* At least wrap this allocation in a pseudo atomic to prevent gc_alloc from being re-entered. */ - SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0)); - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1)); + clr_pseudo_atomic_interrupted(); + set_pseudo_atomic_atomic(); if (alloc_entered++) fprintf(stderr,"* Alloc re-entered\n"); @@ -6527,8 +6819,8 @@ char *alloc(int nbytes) SetSymbolValue(CURRENT_REGION_FREE_POINTER, (lispobj) new_free_pointer); alloc_entered--; - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED)) { + clr_pseudo_atomic_atomic(); + if (get_pseudo_atomic_interrupted()) { /* Handle any interrupts that occurred during gc_alloc */ do_pending_interrupt(); goto retry2; @@ -6541,8 +6833,8 @@ char *alloc(int nbytes) auto_gc_trigger *= 2; alloc_entered--; /* Exit the pseudo atomic */ - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0) + clr_pseudo_atomic_atomic(); + if (get_pseudo_atomic_interrupted() != 0) /* Handle any interrupts that occurred during gc_alloc */ do_pending_interrupt(); funcall0(SymbolFunction(MAYBE_GC)); @@ -6556,8 +6848,8 @@ char *alloc(int nbytes) SetSymbolValue(CURRENT_REGION_END_ADDR, (lispobj) boxed_region.end_addr); alloc_entered--; - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0) { + clr_pseudo_atomic_atomic(); + if (get_pseudo_atomic_interrupted() != 0) { /* Handle any interrupts that occurred during gc_alloc */ do_pending_interrupt(); goto retry2; diff --git a/lisp/gencgc.h b/lisp/gencgc.h index e1dab261c..9e8bdc80c 100644 --- a/lisp/gencgc.h +++ b/lisp/gencgc.h @@ -7,7 +7,7 @@ * * Douglas Crosher, 1996, 1997. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.h,v 1.7 2002/08/27 22:18:32 moore Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.h,v 1.8 2003/08/22 13:20:03 toy Exp $ * */ @@ -124,7 +124,11 @@ struct page { * write protected. */ +#if defined(i386) #define PAGE_SIZE 4096 +#else +#define PAGE_SIZE 8192 +#endif extern unsigned dynamic_space_pages; extern struct page *page_table; @@ -151,7 +155,9 @@ extern struct alloc_region unboxed_region; void gencgc_pickup_dynamic(void); +#ifdef i386 void sniff_code_object(struct code *code, unsigned displacement); +#endif lispobj *search_dynamic_space(lispobj *pointer); void update_x86_dynamic_space_free_pointer(void); diff --git a/lisp/purify.c b/lisp/purify.c index d97c10397..c967b0bc2 100644 --- a/lisp/purify.c +++ b/lisp/purify.c @@ -10,7 +10,7 @@ and x86/GENCGC stack scavenging, by Douglas Crosher, 1996, 1997, 1998. - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.22 2003/01/23 21:05:39 toy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.23 2003/08/22 13:20:03 toy Exp $ */ #include <stdio.h> @@ -209,7 +209,7 @@ carefully_pscav_stack(lispobj*lowaddr, lispobj*base) } #endif -#ifdef GENCGC +#if defined(GENCGC) && defined(i386) /* * Enhanced x86/GENCGC stack scavenging by Douglas Crosher. * @@ -703,7 +703,7 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) /* It will be 0 or the unbound-marker if there are no fixups, and will be an other-pointer to a vector if it is valid. */ if ((fixups==0) || (fixups==type_UnboundMarker) || !Pointerp(fixups)) { -#ifdef GENCGC +#if defined(GENCGC) && defined(i386) /* Check for a possible errors. */ sniff_code_object(new_code,displacement); #endif @@ -748,7 +748,7 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) /* No longer need the fixups. */ new_code->constants[0] = 0; -#ifdef GENCGC +#if defined(GENCGC) && defined(x86) /* Check for possible errors. */ sniff_code_object(new_code,displacement); #endif @@ -1428,8 +1428,11 @@ int purify(lispobj static_roots, lispobj read_only_roots) #endif #ifdef GENCGC +#ifdef i386 gc_assert(control_stack_end > ((&read_only_roots)+1)); setup_i386_stack_scav(((&static_roots)-2), control_stack_end); +#elif defined(sparc) +#endif #endif pscav(&static_roots, 1, FALSE); @@ -1563,7 +1566,7 @@ int purify(lispobj static_roots, lispobj read_only_roots) SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj) read_only_free); SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj) static_free); -#if !defined(ibmrt) && !defined(i386) +#if !defined(ibmrt) && !defined(i386) && !(defined(sparc) && defined(GENCGC)) current_dynamic_space_free_pointer = current_dynamic_space; #else #if defined(WANT_CGC) && defined(X86_CGC_ACTIVE_P) diff --git a/lisp/save.c b/lisp/save.c index 1bdf22a56..c8cb1b0e7 100644 --- a/lisp/save.c +++ b/lisp/save.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.c,v 1.7 2000/10/27 19:25:56 dtc Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.c,v 1.8 2003/08/22 13:20:03 toy 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. @@ -132,16 +132,17 @@ boolean save(char *filename, lispobj init_function) (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); output_space(file, STATIC_SPACE_ID, static_space, (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER)); -#ifdef reg_ALLOC - output_space(file, DYNAMIC_SPACE_ID, current_dynamic_space, - current_dynamic_space_free_pointer); -#else #ifdef GENCGC /* Flush the current_region updating the tables. */ gc_alloc_update_page_tables(0,&boxed_region); gc_alloc_update_page_tables(1,&unboxed_region); - update_x86_dynamic_space_free_pointer(); + update_dynamic_space_free_pointer(); #endif + +#ifdef reg_ALLOC + output_space(file, DYNAMIC_SPACE_ID, current_dynamic_space, + current_dynamic_space_free_pointer); +#else output_space(file, DYNAMIC_SPACE_ID, current_dynamic_space, (lispobj *)SymbolValue(ALLOCATION_POINTER)); #endif diff --git a/lisp/solaris-os.c b/lisp/solaris-os.c index 64b1e9139..83e5075fd 100644 --- a/lisp/solaris-os.c +++ b/lisp/solaris-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/solaris-os.c,v 1.8 2003/07/19 14:10:16 emarsden Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/solaris-os.c,v 1.9 2003/08/22 13:20:03 toy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -27,6 +27,11 @@ #include <dlfcn.h> +#if defined(GENCGC) +#include "lisp.h" +#include "gencgc.h" +#endif + #define OS_PROTERR SEGV_ACCERR #define OS_MAPERR SEGV_MAPERR #define OS_HASERRNO(code) ((code)->si_errno != 0) @@ -198,6 +203,41 @@ valid_addr(os_vm_address_t addr) /* * Running into the gc trigger page will end up here... */ +#if defined(GENCGC) +void segv_handler(HANDLER_ARGS) +{ + caddr_t addr = code->si_addr; + int page_index; + + SAVE_CONTEXT(); + + page_index = find_page_index((void *) addr); + +#ifdef RED_ZONE_HIT + if (os_control_stack_overflow (addr, context)) + return; +#endif + + /* check if the fault is within the dynamic space. */ + if (page_index != -1) { + /* Un-protect the page */ + + /* The page should have been marked write protected */ + if (!PAGE_WRITE_PROTECTED(page_index)) + fprintf(stderr, "*** Sigsegv in page not marked as write protected\n"); + os_protect((void*)page_address(page_index), PAGE_SIZE, OS_VM_PROT_ALL); + page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; + page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; + + return; + } + + /* a *real* protection fault */ + fprintf(stderr, "segv_handler: Real protection violation: 0x%08x\n", + addr); + interrupt_handle_now(signal, code, context); +} +#else void segv_handler(HANDLER_ARGS) { @@ -217,6 +257,7 @@ segv_handler(HANDLER_ARGS) interrupt_handle_now(signal,code,context); } } +#endif void os_install_interrupt_handlers() diff --git a/lisp/sparc-arch.c b/lisp/sparc-arch.c index 35f7ef462..f887aecd9 100644 --- a/lisp/sparc-arch.c +++ b/lisp/sparc-arch.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-arch.c,v 1.12 2002/10/24 20:39:00 toy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-arch.c,v 1.13 2003/08/22 13:20:03 toy 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. @@ -147,10 +147,44 @@ void arch_do_displaced_inst(struct sigcontext *scp, #endif } +/* + * Look at the instruction at address PC and see if it's a trap + * instruction with an immediate value. If so, set trapno to the trap + * number, and return non-zero. If it's not a trap instruction, + * return 0. + */ +boolean trap_inst_p(unsigned int* pc, int* trapno) +{ + unsigned int trap_inst; + + trap_inst = *pc; + + if (((trap_inst >> 30) == 2) + && (((trap_inst >> 19) & 0x3f) == 0x3a) + && (((trap_inst >> 14) & 0x1f) == reg_ZERO) + && (((trap_inst >> 13) & 1) == 1)) + { + /* + * Got a trap instruction with immediate trap value. + * Get the value and return. + */ + *trapno = (trap_inst & 0x3f); + + return 1; + } + else + { + *trapno = -1; + return 0; + } +} + + static int pseudo_atomic_trap_p(struct sigcontext *context) { unsigned int* pc; unsigned int badinst; + int trapno; int result; @@ -163,11 +197,7 @@ static int pseudo_atomic_trap_p(struct sigcontext *context) * to make sure this instruction was a trap instruction with rs1 = 0 * and a software trap number (immediate value) of 16. */ - if (((badinst >> 30) == 2) - && (((badinst >> 19) & 0x3f) == 0x3a) - && (((badinst >> 14) & 0x1f) == reg_ZERO) - && (((badinst >> 13) & 1) == 1) - && ((badinst & 0x3f) == trap_PseudoAtomic)) + if (trap_inst_p(pc, &trapno) && (trapno == trap_PseudoAtomic)) { unsigned int previnst; previnst = pc[-1]; @@ -191,6 +221,130 @@ static int pseudo_atomic_trap_p(struct sigcontext *context) return result; } +#ifdef GENCGC +/* + * Return non-zero if the instruction is a trap 31 instruction + */ + +boolean allocation_trap_p(struct sigcontext *context) +{ + int result; + unsigned int* pc; + unsigned int or_inst; + int trapno; + + result = 0; + + /* + * Make sure this is a trap 31 instruction preceeded by an OR + * instruction. + */ + + pc = SC_PC(context); + + if (trap_inst_p(pc, &trapno) && (trapno == 31)) + { + /* Got the trap. Is it preceeded by an OR instruction? */ + or_inst = pc[-1]; + if (((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 2)) + { + result = 1; + } + else + { + fprintf(stderr, "Whoa!!! Got an allocation trap not preceeded by an OR inst: 0x%08x!\n", + or_inst); + } + } + + return result; +} +#endif + +#if 0 +/* Pop the stack frame that build_fake_control_stack_frame makes */ +static void pop_fake_control_stack_frame(struct sigcontext *context) +{ + current_control_frame_pointer = (lispobj*) SC_REG(context, reg_CFP); + SC_REG(context, reg_OCFP) = current_control_frame_pointer[0]; + SC_REG(context, reg_CODE) = current_control_frame_pointer[1]; + SC_REG(context, reg_CSP) = SC_REG(context, reg_CFP); + SC_REG(context, reg_CFP) = SC_REG(context, reg_OCFP); +} +#endif + +#ifdef GENCGC +void handle_allocation_trap(struct sigcontext *context) +{ + unsigned int* pc; + unsigned int or_inst; + int rs1; + int size; + int immed; + int context_index; + boolean were_in_lisp; + char* memory; + + pc = (unsigned int*) SC_PC(context); + or_inst = pc[-1]; + + /* + * The instruction before this trap instruction had better be an OR + * instruction! + */ + + /* + * An OR instruction. RS1 is the register we want to allocate to. + * RS2 (or an immediate) is the size. + */ + + rs1 = (or_inst >> 14) & 0x1f; + + immed = (or_inst >> 13) & 1; + + if (immed == 1) + { + size = or_inst & 0x1fff; + } + else + { + size = or_inst & 0x1f; + size = SC_REG(context, size); + } + + /* + * I don't think it's possible for us NOT to be in lisp when we get + * here. Remove this later? + */ + were_in_lisp = !foreign_function_call_active; + + if (were_in_lisp) + { + fake_foreign_function_call(context); + } + else + { + fprintf(stderr, "**** Whoa! allocation trap and we weren't in lisp!\n"); + } + + /* + * Allocate some memory, store the memory address in rs1. + */ + +#if 0 + fprintf(stderr, "Alloc %d to %s\n", size, lisp_register_names[rs1]); +#endif + + memory = alloc(size); + SC_REG(context, rs1) = memory; + + if (were_in_lisp) + { + undo_fake_foreign_function_call(context); + } + +} +#endif /* * How to identify an illegal instruction trap and a trap instruction @@ -278,7 +432,16 @@ static void sigill_handler(HANDLER_ARGS) arch_skip_instruction(context); interrupt_handle_pending(context); } - else +#ifdef GENCGC + else if (allocation_trap_p(context)) + { + /* An allocation trap. Call the trap handler and then skip + this instruction */ + handle_allocation_trap(context); + arch_skip_instruction(context); + } +#endif + else { interrupt_internal_error(signal, code, context, FALSE); } diff --git a/lisp/sparc-assem.S b/lisp/sparc-assem.S index 38ae96b05..190eb9f60 100644 --- a/lisp/sparc-assem.S +++ b/lisp/sparc-assem.S @@ -17,6 +17,12 @@ #define _function_end_breakpoint_guts function_end_breakpoint_guts #define _call_into_c call_into_c #define _flush_icache flush_icache +#define _do_pending_interrupt do_pending_interrupt +#ifdef GENCGC +/*#define _collect_garbage collect_garbage*/ +#define _fpu_save fpu_save +#define _fpu_restore fpu_restore +#endif #ifdef LINKAGE_TABLE #define _resolve_linkage_tramp resolve_linkage_tramp #define _lazy_resolve_linkage lazy_resolve_linkage @@ -357,6 +363,14 @@ _flush_icache: nop SET_SIZE(_flush_icache) + .global _do_pending_interrupt + FUNCDEF(_do_pending_interrupt) +_do_pending_interrupt: + unimp trap_PendingInterrupt + retl + nop + SET_SIZE(_do_pending_interrupt) + #ifdef LINKAGE_TABLE /* * Call into C code to resolve a linkage entry. @@ -442,7 +456,105 @@ _undefined_foreign_symbol_trap: .align 4 #endif - +/* + * Save the FPU state. %o0 contains a pointer to where we can + * store our state. + */ + +/* + * Note we only save the 16 double-float registers (which saves + * the 32 single-float values too, I think). If we're compiling for + * a sparc v9, the Lisp code can actually use all 32 double-float + * registers. For later. + */ + .global _fpu_save + FUNCDEF(_fpu_save) +_fpu_save: + std %f0, [%o0 + 4*0] + std %f2, [%o0 + 4*2] + std %f4, [%o0 + 4*4] + std %f6, [%o0 + 4*6] + std %f8, [%o0 + 4*8] + std %f10, [%o0 + 4*10] + std %f12, [%o0 + 4*12] + std %f14, [%o0 + 4*14] + std %f16, [%o0 + 4*16] + std %f18, [%o0 + 4*18] + std %f20, [%o0 + 4*20] + std %f22, [%o0 + 4*22] + std %f24, [%o0 + 4*24] + std %f26, [%o0 + 4*26] + std %f28, [%o0 + 4*28] + std %f30, [%o0 + 4*30] +#ifdef FEATURE_SPARC_V9 + std %f32, [%o0 + 4*32] + std %f34, [%o0 + 4*34] + std %f36, [%o0 + 4*36] + std %f38, [%o0 + 4*38] + std %f40, [%o0 + 4*40] + std %f42, [%o0 + 4*42] + std %f44, [%o0 + 4*44] + std %f46, [%o0 + 4*46] + std %f48, [%o0 + 4*48] + std %f50, [%o0 + 4*50] + std %f52, [%o0 + 4*52] + std %f54, [%o0 + 4*54] + std %f56, [%o0 + 4*56] + std %f58, [%o0 + 4*58] + std %f60, [%o0 + 4*60] + std %f62, [%o0 + 4*62] + st %fsr, [%o0 + 4*64] +#else + st %fsr, [%o0 + 4*32] +#endif + retl + nop + SET_SIZE(_fpu_save) + + .global _fpu_restore + FUNCDEF(_fpu_restore) +_fpu_restore: + ldd [%o0 + 4*0], %f0 + ldd [%o0 + 4*2], %f2 + ldd [%o0 + 4*4], %f4 + ldd [%o0 + 4*6], %f6 + ldd [%o0 + 4*8], %f8 + ldd [%o0 + 4*10], %f10 + ldd [%o0 + 4*12], %f12 + ldd [%o0 + 4*14], %f14 + ldd [%o0 + 4*16], %f16 + ldd [%o0 + 4*18], %f18 + ldd [%o0 + 4*20], %f20 + ldd [%o0 + 4*22], %f22 + ldd [%o0 + 4*24], %f24 + ldd [%o0 + 4*26], %f26 + ldd [%o0 + 4*28], %f28 + ldd [%o0 + 4*30], %f30 +#ifdef FEATURE_SPARC_V9 + ldd [%o0 + 4*32], %f32 + ldd [%o0 + 4*34], %f34 + ldd [%o0 + 4*36], %f36 + ldd [%o0 + 4*38], %f38 + ldd [%o0 + 4*40], %f40 + ldd [%o0 + 4*42], %f42 + ldd [%o0 + 4*44], %f44 + ldd [%o0 + 4*46], %f46 + ldd [%o0 + 4*48], %f48 + ldd [%o0 + 4*50], %f50 + ldd [%o0 + 4*52], %f52 + ldd [%o0 + 4*54], %f54 + ldd [%o0 + 4*56], %f56 + ldd [%o0 + 4*58], %f58 + ldd [%o0 + 4*60], %f60 + ldd [%o0 + 4*62], %f62 + ld [%o0 + 4*64], %fsr +#else + ld [%o0 + 4*32], %fsr +#endif + retl + nop + SET_SIZE(_fpu_restore) + #ifndef SOLARIS /****************************************************************\ -- GitLab