From 46a4f4826f302fef2e9bfc9055e15f4433e05d98 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 18 Jan 2006 15:21:26 +0000 Subject: [PATCH] Merge ppc_gencgc_branch to HEAD. --- assembly/ppc/array.lisp | 10 +- code/ppc-vm.lisp | 4 +- compiler/ppc/alloc.lisp | 13 ++- compiler/ppc/array.lisp | 4 +- compiler/ppc/call.lisp | 4 +- compiler/ppc/insts.lisp | 6 +- compiler/ppc/macros.lisp | 63 +++++++++-- compiler/ppc/parms.lisp | 7 +- lisp/Config.ppc_darwin | 11 +- lisp/Darwin-os.c | 49 ++++---- lisp/gencgc.c | 106 ++++++++++++++---- lisp/gencgc.h | 16 ++- lisp/ppc-arch.c | 236 ++++++++++++++++++++++++++++++++++++++- lisp/ppc-assem.S | 80 +++++++++++++ lisp/ppc-validate.h | 14 ++- lisp/purify.c | 4 +- 16 files changed, 545 insertions(+), 82 deletions(-) diff --git a/assembly/ppc/array.lisp b/assembly/ppc/array.lisp index fdec7a2a9..41ae22566 100644 --- a/assembly/ppc/array.lisp +++ b/assembly/ppc/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.6 2005/04/22 02:28:57 rtoy Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/ppc/array.lisp,v 1.7 2006/01/18 15:21:26 rtoy Exp $ ;;; ;;; This file contains the support routines for arrays and vectors. ;;; @@ -29,11 +29,15 @@ (:temp ndescr non-descriptor-reg nl0-offset) (:temp pa-flag non-descriptor-reg nl3-offset) - (:temp vector descriptor-reg a3-offset)) + (:temp vector descriptor-reg a3-offset) + #+gencgc + (:temp temp non-descriptor-reg nl2-offset)) (pseudo-atomic (pa-flag) (inst addi ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes)) (inst clrrwi ndescr ndescr lowtag-bits) - (allocation vector ndescr other-pointer-type) + (allocation vector ndescr other-pointer-type + #+gencgc :temp-tn #+gencgc temp + #+gencgc :flag-tn #+gencgc pa-flag) (inst srwi ndescr type vm:word-shift) (storew ndescr vector 0 vm:other-pointer-type) (storew length vector vm:vector-length-slot vm:other-pointer-type)) diff --git a/code/ppc-vm.lisp b/code/ppc-vm.lisp index a532c362b..19a279e32 100644 --- a/code/ppc-vm.lisp +++ b/code/ppc-vm.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ppc-vm.lisp,v 1.5 2005/02/06 19:43:13 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/ppc-vm.lisp,v 1.6 2006/01/18 15:21:26 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -345,3 +345,5 @@ word-bytes))) nil) +;;; Enable/Disable scavenging of the read-only space. +(defvar *scavenge-read-only-space* nil) diff --git a/compiler/ppc/alloc.lisp b/compiler/ppc/alloc.lisp index ec36e13d1..64b2b9a23 100644 --- a/compiler/ppc/alloc.lisp +++ b/compiler/ppc/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/ppc/alloc.lisp,v 1.13 2005/06/15 03:13:51 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/alloc.lisp,v 1.14 2006/01/18 15:21:26 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -66,7 +66,8 @@ (let* ((cons-cells (if star (1- num) num)) (alloc (* (pad-data-block cons-size) cons-cells))) (pseudo-atomic (pa-flag) - (allocation res alloc list-pointer-type :temp-tn alloc-temp) + (allocation res alloc list-pointer-type :temp-tn alloc-temp + :flag-tn pa-flag) (move ptr res) (dotimes (i (1- cons-cells)) (storew (maybe-load (tn-ref-tn things)) ptr @@ -113,7 +114,7 @@ ;; pseudo-atomic, because oring in other-pointer-type just adds ;; it right back. (inst add size boxed unboxed) - (allocation result size other-pointer-type :temp-tn ndescr) + (allocation result size other-pointer-type :temp-tn ndescr :flag-tn pa-flag) (inst slwi ndescr boxed (- type-bits word-shift)) (inst ori ndescr ndescr code-header-type) (storew ndescr result 0 other-pointer-type) @@ -155,7 +156,8 @@ (let ((size (+ length closure-info-offset))) (pseudo-atomic (pa-flag) - (allocation result (pad-data-block size) function-pointer-type :temp-tn temp) + (allocation result (pad-data-block size) function-pointer-type + :temp-tn temp :flag-tn pa-flag) (inst lr temp (logior (ash (1- size) type-bits) closure-header-type)) (storew temp result 0 function-pointer-type))) (storew function result closure-function-slot function-pointer-type))) @@ -201,6 +203,7 @@ (:results (result :scs (descriptor-reg))) (:temporary (:scs (any-reg)) bytes) (:temporary (:scs (non-descriptor-reg)) header) + (:temporary (:scs (non-descriptor-reg)) temp) (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag) (:generator 6 (inst addi bytes extra (* (1+ words) word-bytes)) @@ -208,5 +211,5 @@ (inst addi header header (+ (ash -2 type-bits) type)) (inst clrrwi bytes bytes lowtag-bits) (pseudo-atomic (pa-flag) - (allocation result bytes lowtag :temp-tn temp) + (allocation result bytes lowtag :temp-tn temp :flag-tn pa-flag) (storew header result 0 lowtag)))) diff --git a/compiler/ppc/array.lisp b/compiler/ppc/array.lisp index 77b9e93af..94824c4cd 100644 --- a/compiler/ppc/array.lisp +++ b/compiler/ppc/array.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/ppc/array.lisp,v 1.5 2004/08/08 11:15:12 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/array.lisp,v 1.6 2006/01/18 15:21:26 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -35,7 +35,7 @@ (pseudo-atomic (pa-flag) (inst addi ndescr rank (* (1+ array-dimensions-offset) vm:word-bytes)) (inst clrrwi ndescr ndescr lowtag-bits) - (allocation header ndescr other-pointer-type :temp-tn gc-temp) + (allocation header ndescr other-pointer-type :temp-tn gc-temp :flag-tn pa-flag) (inst addi ndescr rank (fixnumize (1- vm:array-dimensions-offset))) (inst slwi ndescr ndescr vm:type-bits) (inst or ndescr ndescr type) diff --git a/compiler/ppc/call.lisp b/compiler/ppc/call.lisp index 8ede70c1c..1e0c99bbd 100644 --- a/compiler/ppc/call.lisp +++ b/compiler/ppc/call.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/ppc/call.lisp,v 1.10 2005/12/14 02:38:13 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/call.lisp,v 1.11 2006/01/18 15:21:26 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1164,7 +1164,7 @@ default-value-8 (assemble () ;; Allocate a cons (2 words) for each item. (inst slwi temp count 1) - (allocation result temp list-pointer-type :temp-tn dst) + (allocation result temp list-pointer-type :temp-tn dst :flag-tn pa-flag) (move dst result) (inst b enter) diff --git a/compiler/ppc/insts.lisp b/compiler/ppc/insts.lisp index a0b099693..83a049f90 100644 --- a/compiler/ppc/insts.lisp +++ b/compiler/ppc/insts.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/ppc/insts.lisp,v 1.15 2005/09/29 03:10:14 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/insts.lisp,v 1.16 2006/01/18 15:21:26 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -695,8 +695,8 @@ about function addresses and register values.") (def-ppc-iformat (x-20 '(:name :tab frt ", " ra ", " rb)) frt ra rb (xo xo21-30)) -(def-ppc-iformat (x-21 '(:name :tab frt ", " rb)) - frt rb (xo xo21-30) rc) +(def-ppc-iformat (x-21 '(:name :tab frt ", " frb)) + frt frb (xo xo21-30) rc) (def-ppc-iformat (x-22 '(:name :tab frt)) frt (xo xo21-30) rc) diff --git a/compiler/ppc/macros.lisp b/compiler/ppc/macros.lisp index 80cd434a8..368b6c22b 100644 --- a/compiler/ppc/macros.lisp +++ b/compiler/ppc/macros.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/macros.lisp,v 1.10 2005/06/19 02:46:02 rtoy Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/macros.lisp,v 1.11 2006/01/18 15:21:26 rtoy Exp $ ;;; ;;; This file contains various useful macros for generating PC code. ;;; @@ -153,9 +153,13 @@ ;; applied. The amount of space to be allocated is SIZE bytes (which ;; must be a multiple of the lisp object size). ;; -(defmacro allocation (result-tn size lowtag &key stack-p temp-tn) - (declare (ignore stack-p temp-tn)) +(defmacro allocation (result-tn size lowtag &key stack-p temp-tn flag-tn) + (declare (ignore stack-p) + #-gencgc + (ignore temp-tn flag-tn)) (let ((alloc-size (gensym))) + #-gencgc + (progn `(let ((,alloc-size ,size)) (if (logbitp (1- lowtag-bits) ,lowtag) (progn @@ -165,7 +169,40 @@ (inst ori ,result-tn ,result-tn ,lowtag))) (if (numberp ,alloc-size) (inst addi alloc-tn alloc-tn ,alloc-size) - (inst add alloc-tn alloc-tn ,alloc-size))))) + (inst add alloc-tn alloc-tn ,alloc-size)))) + #+gencgc + `(progn + ;; Make temp-tn be the size + (cond ((numberp ,size) + (inst lr ,temp-tn ,size)) + (t + (move ,temp-tn ,size))) + + ;; Get the end of the current allocation region. + (load-symbol-value ,flag-tn *current-region-end-addr*) + ;; The object starts exactly where alloc-tn is, minus an tag + ;; bits, etc. + + ;; CAUTION: The C code depends on the exact order of + ;; instructions here. In particular, one instructions before + ;; the TW instruction must be an ADD or ADDI instruction, so it + ;; can figure out the size of the desired allocation. + (without-scheduling () + ;; Now make result-tn point at the end of the object, to + ;; figure out if we overflowed the current region. + (inst add alloc-tn alloc-tn ,temp-tn) + (inst clrrwi ,result-tn alloc-tn lowtag-bits) + ;; result-tn points to the new end of the region. Did we go past + ;; the actual end of the region? If so, we need a full alloc. + ;; The C code depends on this exact form of instruction. If + ;; either changes, you have to change the other appropriately! + (inst tw :lge ,result-tn ,flag-tn)) + + ;; At this point, result-tn points at the end of the object. + ;; Adjust to point to the beginning. + (inst sub ,result-tn ,result-tn ,temp-tn) + ;; Set the lowtag appropriately + (inst ori ,result-tn ,result-tn ,lowtag)))) (defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size &key (lowtag other-pointer-type)) @@ -180,7 +217,8 @@ (lowtag lowtag) (flag-tn flag-tn)) `(pseudo-atomic (,flag-tn) (allocation ,result-tn (pad-data-block ,size) ,lowtag - :temp-tn temp-tn) + :temp-tn ,temp-tn + :flag-tn ,flag-tn) (when ,type-code (inst lr ,temp-tn (logior (ash (1- ,size) type-bits) ,type-code)) (storew ,temp-tn ,result-tn 0 ,lowtag)) @@ -462,20 +500,23 @@ (defmacro pseudo-atomic ((flag-tn &key (extra 0)) &rest forms) (let ((n-extra (gensym))) `(let ((,n-extra ,extra)) + ;; We're depending on extra being zero here and, currently, no + ;; sets extra. We should enforce it later on. (without-scheduling () ;; Extra debugging stuff: #+debug (progn (inst andi. ,flag-tn alloc-tn 7) (inst twi :ne ,flag-tn 0)) - (inst addi alloc-tn alloc-tn 4)) + (inst ori alloc-tn alloc-tn 4)) ,@forms (without-scheduling () - ;; Remove PA bit - (inst subi alloc-tn alloc-tn 4) - ;; Now test to see if the pseudo-atomic interrupted bit is set. - (inst andi. ,flag-tn alloc-tn 1) - (inst twi :ne ,flag-tn 0)) + ;; Remove PA bit + (inst li ,flag-tn -5) + (inst and alloc-tn alloc-tn ,flag-tn) + ;; Now test to see if the pseudo-atomic interrupted bit is set. + (inst andi. ,flag-tn alloc-tn 1) + (inst twi :ne ,flag-tn 0)) #+debug (progn (inst andi. ,flag-tn alloc-tn 7) diff --git a/compiler/ppc/parms.lisp b/compiler/ppc/parms.lisp index 8f3f5eed2..cafad62b1 100644 --- a/compiler/ppc/parms.lisp +++ b/compiler/ppc/parms.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/ppc/parms.lisp,v 1.9 2005/02/06 19:43:15 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.10 2006/01/18 15:21:26 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -242,6 +242,11 @@ #+linkage-table lisp::*linkage-table-data* + #+gencgc + *current-region-end-addr* + #+gencgc + *scavenge-read-only-space* + ;; Spare symbols. Rename these when you need to add some static ;; symbols and don't want to do a cross-compile. spare-9 diff --git a/lisp/Config.ppc_darwin b/lisp/Config.ppc_darwin index ea1b576a4..b1b11c0db 100644 --- a/lisp/Config.ppc_darwin +++ b/lisp/Config.ppc_darwin @@ -17,8 +17,14 @@ ifdef FEATURE_LINKAGE_TABLE LINKAGE = -DLINKAGE_TABLE endif -CFLAGS = -g -O3 -no-cpp-precomp -DDARWIN -Dppc $(LINKAGE) -ASFLAGS = -traditional -g -O3 -no-cpp-precomp -DDARWIN -Dppc $(LINKAGE) +# Enable support for generational GC +ifdef FEATURE_GENCGC +GENCGC = -DGENCGC +GC_SRC = gencgc.c +endif + +CFLAGS = -g -O3 -no-cpp-precomp -DDARWIN -Dppc $(LINKAGE) $(GENCGC) +ASFLAGS = -traditional -g -O3 -no-cpp-precomp -DDARWIN -Dppc $(LINKAGE) $(GENCGC) UNDEFSYMPATTERN = -Xlinker -u -Xlinker & ASSEM_SRC = ppc-assem.S linux-stubs.S @@ -32,7 +38,6 @@ OS_SRC = ppc-darwin-dlshim.c os-common.c Darwin-os.c OS_LINK_FLAGS = -g -dynamic -Wl,-sectcreate,CMUCLRO,core,/dev/null -Wl,-segaddr,CMUCLRO,0x01000000 -Wl,-seg1addr,0x1a000000 OS_LIBS = -lSystem -lc -lm -GC_SRC = gc.c all: adjustlisp adjustlisp: lisp darwin-lispadjuster ./darwin-lispadjuster lisp diff --git a/lisp/Darwin-os.c b/lisp/Darwin-os.c index b38cad025..8f0ba1e9e 100644 --- a/lisp/Darwin-os.c +++ b/lisp/Darwin-os.c @@ -14,7 +14,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for Darwin by Pierre R. Mai, 2003. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.5 2005/09/15 18:26:50 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.6 2006/01/18 15:21:26 rtoy Exp $ * */ @@ -29,6 +29,9 @@ #include "interrupt.h" #include "lispregs.h" #include "internals.h" +#ifdef GENCGC +#include "gencgc.h" +#endif #include <sys/types.h> #include <signal.h> @@ -292,7 +295,9 @@ valid_addr(os_vm_address_t addr) if (in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) || in_range_p(addr, STATIC_SPACE_START, STATIC_SPACE_SIZE) || in_range_p(addr, DYNAMIC_0_SPACE_START, dynamic_space_size) +#ifndef GENCGC || in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size) +#endif || in_range_p(addr, CONTROL_STACK_START, CONTROL_STACK_SIZE) || in_range_p(addr, BINDING_STACK_START, BINDING_STACK_SIZE)) return TRUE; @@ -301,17 +306,30 @@ valid_addr(os_vm_address_t addr) static void -sigsegv_handler(HANDLER_ARGS) +sigbus_handler(HANDLER_ARGS) { -#if defined GENCGC +#if defined(GENCGC) caddr_t fault_addr = code->si_addr; int page_index = find_page_index((void *) fault_addr); +#endif + + SAVE_CONTEXT(); -#if SIGSEGV_VERBOSE + DPRINTF(0, (stderr, "sigbus:\n")); + DPRINTF(0, (stderr, " PC = %p\n", SC_PC(context))); + DPRINTF(0, (stderr, " ALLOC-TN = %p\n", SC_REG(context, reg_ALLOC))); + DPRINTF(0, (stderr, " CODE-TN = %p\n", SC_REG(context, reg_CODE))); + DPRINTF(0, (stderr, " LRA-TN = %p\n", SC_REG(context, reg_LRA))); + DPRINTF(0, (stderr, " CFP-TN = %p\n", SC_REG(context, reg_CFP))); + DPRINTF(0, (stderr, " FDEFN-TN = %p\n", SC_REG(context, reg_FDEFN))); + DPRINTF(0, (stderr, " foreign_function_call = %d\n", foreign_function_call_active)); + +#if defined(GENCGC) +#if defined(SIGSEGV_VERBOSE) fprintf(stderr, "Signal %d, fault_addr=%x, page_index=%d:\n", signal, fault_addr, page_index); #endif - + /* Check if the fault is within the dynamic space. */ if (page_index != -1) { /* Un-protect the page */ @@ -321,7 +339,7 @@ sigsegv_handler(HANDLER_ARGS) fprintf(stderr, "*** Sigsegv in page not marked as write protected\n"); - os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); + os_protect(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; @@ -329,24 +347,9 @@ sigsegv_handler(HANDLER_ARGS) } #endif - SAVE_CONTEXT(); - - DPRINTF(0, (stderr, "sigsegv:\n")); - if (!interrupt_maybe_gc(signal, code, context)) - interrupt_handle_now(signal, code, context); - - /* Work around G5 bug; fix courtesy gbyers via chandler */ - sigreturn(context); -} - -static void -sigbus_handler(HANDLER_ARGS) -{ - SAVE_CONTEXT(); - - DPRINTF(0, (stderr, "sigbus:\n")); - if (!interrupt_maybe_gc(signal, code, context)) + if (!interrupt_maybe_gc(signal, code, context)) { interrupt_handle_now(signal, code, context); + } /* Work around G5 bug; fix courtesy gbyers via chandler */ sigreturn(context); diff --git a/lisp/gencgc.c b/lisp/gencgc.c index 3be1b015f..fc807ad13 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.66 2005/09/15 18:26:51 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.67 2006/01/18 15:21:26 rtoy Exp $ * */ @@ -26,6 +26,7 @@ #include "interr.h" #include "gencgc.h" + #define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \ __FILE__, __LINE__) @@ -100,13 +101,49 @@ #define set_current_region_end(value) \ SetSymbolValue(CURRENT_REGION_END_ADDR, (value)) +#elif defined(DARWIN) +#ifndef pseudo_atomic_InterruptedValue +#define pseudo_atomic_InterruptedValue 1 +#endif +#ifndef pseudo_atomic_Value +#define pseudo_atomic_Value 4 +#endif + +#define set_alloc_pointer(value) +#define get_alloc_pointer() \ + ((unsigned long) current_dynamic_space_free_pointer & ~lowtag_Mask) +#define get_binding_stack_pointer() \ + (current_binding_stack_pointer) +#define get_pseudo_atomic_atomic() \ + ((unsigned long)current_dynamic_space_free_pointer & pseudo_atomic_Value) +#define set_pseudo_atomic_atomic() \ + (current_dynamic_space_free_pointer \ + = (lispobj*) ((unsigned long)current_dynamic_space_free_pointer | pseudo_atomic_Value)) +#define clr_pseudo_atomic_atomic() \ + (current_dynamic_space_free_pointer \ + = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_Value)) +#define get_pseudo_atomic_interrupted() \ + ((unsigned long) current_dynamic_space_free_pointer & pseudo_atomic_InterruptedValue) +#define clr_pseudo_atomic_interrupted() \ + (current_dynamic_space_free_pointer \ + = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_InterruptedValue)) + +#define set_current_region_free(value) \ + current_dynamic_space_free_pointer = (lispobj*)((value) | ((long)current_dynamic_space_free_pointer & lowtag_Mask)) + +#define get_current_region_free() \ + ((long)current_dynamic_space_free_pointer & (~(lowtag_Mask))) + +#define set_current_region_end(value) \ + SetSymbolValue(CURRENT_REGION_END_ADDR, (value)) + #else #error gencgc is not supported on this platform #endif /* Define for activating assertions. */ -#if 0 +#if defined(DARWIN) #define GC_ASSERTIONS 1 #endif @@ -119,6 +156,7 @@ static void *invalid_stack_start, *invalid_stack_end; static inline void check_escaped_stack_object(lispobj * where, lispobj obj) { +#ifndef DARWIN void *p; if (Pointerp(obj) @@ -168,6 +206,7 @@ check_escaped_stack_object(lispobj * where, lispobj obj) (unsigned long) obj, where, space ? space : "Unknown space"); } +#endif } #endif /* GC_ASSERTIONS */ @@ -219,7 +258,11 @@ boolean pre_verify_gen_0 = FALSE; /* * Enable checking for bad pointers after gc_free_heap called from purify. */ +#if defined(DARWIN) +boolean verify_after_free_heap = TRUE; +#else boolean verify_after_free_heap = FALSE; +#endif /* * Enable the printing of a note when code objects are found in the @@ -247,15 +290,23 @@ boolean gencgc_unmap_zero = TRUE; /* * Enable checking that newly allocated regions are zero filled. */ +#if defined(DARWIN) +boolean gencgc_zero_check = TRUE; +boolean gencgc_enable_verify_zero_fill = TRUE; +#else boolean gencgc_zero_check = FALSE; - boolean gencgc_enable_verify_zero_fill = FALSE; +#endif /* * Enable checking that free pages are zero filled during gc_free_heap * called after purify. */ +#if defined(DARWIN) +boolean gencgc_zero_check_during_free_heap = TRUE; +#else boolean gencgc_zero_check_during_free_heap = FALSE; +#endif /* * The minimum size for a large object. @@ -577,14 +628,19 @@ print_generation_stats(int verbose) */ #define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2) long long fpu_state[FPU_STATE_SIZE]; +#elif defined(DARWIN) +#define FPU_STATE_SIZE 32 + 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; @@ -2337,7 +2393,7 @@ scavenge_interrupt_contexts(void) * Aargh! Why is SPARC so different here? What is the advantage of * making it different from all the other ports? */ -#ifdef sparc +#if defined(sparc) || defined(DARWIN) #define RAW_ADDR_OFFSET 0 #else #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer) @@ -3366,8 +3422,8 @@ size_boxed(lispobj * where) return length; } -/* Not needed on sparc because the raw_addr has a function lowtag */ -#ifndef sparc +/* Not needed on sparc and ppc because the raw_addr has a function lowtag */ +#if !(defined(sparc) || defined(DARWIN)) static int scav_fdefn(lispobj * where, lispobj object) { @@ -3809,7 +3865,7 @@ scav_hash_vector(lispobj * where, lispobj object) * true. It appears that it just happens not to be true when we're * scavenging the hash vector. I don't know why. */ -#if 0 && defined(sparc) +#if (0 && defined(sparc)) if (where != (lispobj *) PTR(hash_table->table)) { fprintf(stderr, "Hash table invariant failed during scavenging!\n"); fprintf(stderr, " *** where = %lx\n", where); @@ -3819,7 +3875,7 @@ scav_hash_vector(lispobj * where, lispobj object) } #endif -#ifndef sparc +#if !(defined(sparc) || defined(DARWIN)) gc_assert(where == (lispobj *) PTR(hash_table->table)); #endif gc_assert(TypeOf(hash_table->instance_header) == type_InstanceHeader); @@ -4518,10 +4574,10 @@ gc_init_tables(void) 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. + * Note: for sparc and ppc we don't have to do anything special + * for fdefns, cause the raw-addr has a function lowtag. */ -#ifndef sparc +#if !(defined(sparc) || defined(DARWIN)) scavtab[type_Fdefn] = scav_fdefn; #else scavtab[type_Fdefn] = scav_boxed; @@ -4783,7 +4839,7 @@ search_dynamic_space(lispobj * pointer) return search_space(start, pointer + 2 - start, pointer); } -#if defined(i386) || defined(__x86_64) +#if defined(DARWIN) || defined(i386) || defined(__x86_64) static int valid_dynamic_space_pointer(lispobj * pointer) { @@ -5141,7 +5197,7 @@ maybe_adjust_large_object(lispobj * where) * tables updated. * * Only needed on x86 because GC is conservative there. Not needed on - * sparc because GC is precise, not conservative. + * sparc or ppc because GC is precise, not conservative. */ #if (defined(i386) || defined(__x86_64)) static void @@ -5964,8 +6020,11 @@ print_ptr(lispobj * addr) *(addr + 2), *(addr + 3), *(addr + 4)); } -#ifdef sparc +#if defined(sparc) extern char closure_tramp; +#elif defined(DARWIN) +extern char closure_tramp; +extern char undefined_tramp; #else extern int undefined_tramp; #endif @@ -6028,7 +6087,7 @@ verify_space(lispobj * start, size_t words) * Does it point to a plausible object? This check slows it * down a lot. */ -#if 0 +#if defined(DARWIN) if (!valid_dynamic_space_pointer((lispobj *) thing)) { fprintf(stderr, "*** Ptr %x to invalid object %x\n", thing, start); @@ -6040,16 +6099,21 @@ verify_space(lispobj * start, size_t words) if (!to_readonly_space && !to_static_space && #if defined(sparc) thing != (int) &closure_tramp +#elif defined(DARWIN) + !((thing == (int) &closure_tramp) || + (thing == (int) &undefined_tramp)) #else thing != (int) &undefined_tramp #endif ) { fprintf(stderr, - "*** Ptr %lx @ %lx sees Junk (undefined_tramp = %lx)\n", + "*** Ptr %lx @ %lx sees Junk (%s = %lx)\n", (unsigned long) thing, (unsigned long) start, #if defined(sparc) + "closure_tramp", (unsigned long) &closure_tramp #else + "undefined_tramp", (unsigned long) &undefined_tramp #endif ); @@ -6795,10 +6859,10 @@ collect_garbage(unsigned last_gen) gc_assert(boxed_region.free_pointer - boxed_region.start_addr == 0); gc_alloc_generation = 0; - /* Sparc doesn't need this because the dynamic space free pointer is - the same as the current region free pointer, which is updated by - the allocation routines appropriately. */ -#if !defined(sparc) + /* Sparc and ppc don't need this because the dynamic space free + pointer is the same as the current region free pointer, which + is updated by the allocation routines appropriately. */ +#if !(defined(sparc) || defined(DARWIN)) update_dynamic_space_free_pointer(); #endif @@ -7065,7 +7129,7 @@ void do_pending_interrupt(void); char * alloc(int nbytes) { -#ifndef sparc +#if !(defined(sparc) || defined(DARWIN)) /* * *current-region-free-pointer* is the same as alloc-tn (= * current_dynamic_space_free_pointer) and therefore contains the diff --git a/lisp/gencgc.h b/lisp/gencgc.h index 87028783e..8d3a515c2 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.12 2005/09/15 18:26:51 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.h,v 1.13 2006/01/18 15:21:26 rtoy Exp $ * */ @@ -126,16 +126,26 @@ struct page { #if defined(i386) #define PAGE_SIZE 4096 -#else +#elif defined(sparc) /* * For sparc, the minimum page size (physical page size) is 8K. - * However, some experimments indicate that this gives worse + * However, some experiments indicate that this gives worse * performance in some cases than the non-gencgc version. By upping * the page size to 32K, we are as good as before, so let us use a 32K * page size. (I'm assuming the gain is because we do the kernel * allocation trap less often.) */ #define PAGE_SIZE (4*8192) +#elif defined(DARWIN) +/* + * The physical page size is 4K. Like sparc, this appears to be + * somewhat slow (but need to verify that), so let's make the page + * size 32K so we hit the allocation trap less often. + */ +/*#define PAGE_SIZE 4096*/ +/*#define PAGE_SIZE (2*4096)*/ +#define PAGE_SIZE (4*4096) +/*#define PAGE_SIZE (8*4096)*/ #endif extern unsigned dynamic_space_pages; diff --git a/lisp/ppc-arch.c b/lisp/ppc-arch.c index 9ccd18551..b95fe1094 100644 --- a/lisp/ppc-arch.c +++ b/lisp/ppc-arch.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.6 2005/12/17 16:29:13 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.7 2006/01/18 15:21:26 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. @@ -160,6 +160,228 @@ arch_do_displaced_inst(os_context_t * scp, unsigned long orig_inst) sigreturn(scp); } +#ifdef GENCGC +/* + * Return non-zero if the current instruction is an allocation trap + */ +static int +allocation_trap_p(os_context_t * context) +{ + int result; + unsigned int *pc; + unsigned inst; + unsigned opcode; + unsigned src; + unsigned dst; + + result = 0; + + /* + * First, the instruction has to be a TWLGE temp, NL3, which as the + * format. + * | 6| 5| 5 | 5 | 10|1| width + * |31|5 |dst|src| 4|0| field + */ + pc = (unsigned int *) SC_PC(context); + inst = *pc; + +#if 0 + fprintf(stderr, "allocation_trap_p at %p: inst = 0x%08x\n", pc, inst); +#endif + + opcode = inst >> 26; + src = (inst >> 11) & 0x1f; + dst = (inst >> 16) & 0x1f; + if ((opcode == 31) && (src == reg_NL3) && (5 == ((inst >> 21) & 0x1f)) + && (4 == ((inst >> 1) & 0x3ff))) { + /* + * We got the instruction. Now, look back to make sure it was + * proceeded by what we expected. 2 instructions back should be + * an ADD or ADDI instruction. + */ + unsigned int add_inst; + + add_inst = pc[-2]; +#if 0 + fprintf(stderr, " add inst at %p: inst = 0x%08x\n", + pc - 2, add_inst); +#endif + opcode = add_inst >> 26; + if ((opcode == 31) && (266 == ((add_inst >> 1) & 0x1ff))) { + return 1; + } else if ((opcode == 14)) { + return 1; + } else { + fprintf(stderr, + "Whoa! Got allocation trap not preceeded by an ADD or ADDI instruction: 0x%08x\n", + add_inst); + } + } + return 0; +} + +/* + * Use this function to enable the minimum number of signals we need + * when our trap handler needs to call Lisp code that might cons. For + * consing to work with gencgc, we need to be able to trap the SIGILL + * signal to perform allocation. + */ +void +enable_some_signals() +{ + sigset_t sigs; + +#if 0 + fprintf(stderr, "Enabling some signals\n"); +#endif +#if 0 + sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); +#else + sigemptyset(&sigs); + sigaddset(&sigs, SIGILL); + sigaddset(&sigs, SIGBUS); + sigprocmask(SIG_UNBLOCK, &sigs, NULL); +#endif +#if 0 + fprintf(stderr, "Some signals enabled\n"); +#endif +} + +void +handle_allocation_trap(os_context_t * context) +{ + unsigned int *pc; + unsigned int inst; + unsigned int or_inst; + unsigned int target; + unsigned int opcode; + int size; + int immed; + boolean were_in_lisp; + char *memory; + sigset_t block; + + target = 0; + size = 0; + +#if 0 + fprintf(stderr, "In handle_allocation_trap\n"); +#endif + /* + * 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"); + } + + /* + * Look at current instruction: TWNE temp, NL3. We're here because + * temp > NL3 and temp is the end of the allocation, and NL3 is + * current-region-end-addr. + * + * We need to adjust temp and alloc-tn. + */ + + pc = (unsigned int *) SC_PC(context); + inst = pc[0]; + target = (inst >> 16) & 0x1f; + +#if 0 + fprintf(stderr, "handle_allocation_trap at %p:\n", pc); + fprintf(stderr, " trap inst = 0x%08x\n", inst); + fprintf(stderr, " target reg = %s\n", lisp_register_names[target]); +#endif + /* + * Go back and look at the add/addi instruction. The second src arg + * is the size of the allocation. Get it and call alloc to allocate + * new space. + */ + inst = pc[-2]; + opcode = inst >> 26; +#if 0 + fprintf(stderr, " add inst = 0x%08x, opcode = %d\n", inst, opcode); +#endif + if (opcode == 14) { + /* + * ADDI temp-tn, alloc-tn, size + * + * Extract the size + */ + size = (inst & 0xffff); + } else if (opcode == 31) { + /* + * ADD temp-tn, alloc-tn, size-tn + * + * Extract the size + */ + int reg; + + reg = (inst >> 11) & 0x1f; +#if 0 + fprintf(stderr, " add, reg = %s\n", lisp_register_names[reg]); +#endif + size = SC_REG(context, reg); + } +#if 0 + fprintf(stderr, "Alloc %d to %s\n", size, lisp_register_names[target]); +#endif + + /* + * Well, maybe not. sigill_handler probably shouldn't be unblocking + * all signals. So, let's enable just the signals we need. Since + * alloc might call GC, we need to have SIGILL enabled so we can do + * allocation. Do we need more? + */ + enable_some_signals(); + +#if 0 + fprintf(stderr, "Ready to alloc\n"); + fprintf(stderr, "free_pointer = 0x%08x\n", + current_dynamic_space_free_pointer); +#endif + /* + * alloc-tn was incremented by size. Need to decrement it by size to restore it's original value. + */ + current_dynamic_space_free_pointer = + (lispobj *) ((long) current_dynamic_space_free_pointer - size); +#if 0 + fprintf(stderr, "free_pointer = 0x%08x new\n", + current_dynamic_space_free_pointer); +#endif + + memory = (char *) alloc(size); + +#if 0 + fprintf(stderr, "alloc returned %p\n", memory); + fprintf(stderr, "free_pointer = 0x%08x\n", + current_dynamic_space_free_pointer); +#endif + + /* + * The allocation macro wants the result to point to the end of the + * object! + */ + memory += size; +#if 0 + fprintf(stderr, "object end at %p\n", memory); +#endif + SC_REG(context, target) = (unsigned long) memory; + SC_REG(context, reg_ALLOC) = + (unsigned long) current_dynamic_space_free_pointer; + + if (were_in_lisp) { + undo_fake_foreign_function_call(context); + } + + +} +#endif + static void sigill_handler(HANDLER_ARGS) { @@ -193,6 +415,18 @@ sigill_handler(HANDLER_ARGS) return; } + /* Is this an allocation trap? */ +#ifdef GENCGC + if (allocation_trap_p(context)) { + handle_allocation_trap(context); + arch_skip_instruction(context); +#ifdef DARWIN + sigreturn(context); +#endif + return; + } +#endif + if ((opcode >> 16) == ((3 << 10) | (6 << 5))) { /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */ int trap = opcode & 0x1f, extra = (opcode >> 5) & 0x1f; diff --git a/lisp/ppc-assem.S b/lisp/ppc-assem.S index 1dd732836..7152c4b53 100644 --- a/lisp/ppc-assem.S +++ b/lisp/ppc-assem.S @@ -491,6 +491,11 @@ _function_end_breakpoint_end: blr SET_SIZE(ppc_flush_cache_line) + GFUNCDEF(do_pending_interrupt) + twllei reg_ZERO, trap_PendingInterrupt + blr + SET_SIZE(do_pending_interrupt) + #ifdef LINKAGE_TABLE /* * Call into C code to resolve a linkage entry. @@ -641,3 +646,78 @@ _function_end_breakpoint_end: .align 4 #endif + +#ifdef GENCGC + .globl _fpu_save + GFUNCDEF(fpu_save) + stfd f1, 0(r3) + stfd f2, 8(r3) + stfd f3, 16(r3) + stfd f4, 24(r3) + stfd f5, 32(r3) + stfd f6, 40(r3) + stfd f7, 48(r3) + stfd f8, 56(r3) + stfd f9, 64(r3) + stfd f10, 72(r3) + stfd f11, 80(r3) + stfd f12, 88(r3) + stfd f13, 96(r3) + stfd f14, 104(r3) + stfd f15, 112(r3) + stfd f16, 120(r3) + stfd f17, 128(r3) + stfd f18, 136(r3) + stfd f19, 144(r3) + stfd f20, 152(r3) + stfd f21, 160(r3) + stfd f22, 168(r3) + stfd f23, 176(r3) + stfd f24, 184(r3) + stfd f25, 192(r3) + stfd f26, 200(r3) + stfd f27, 208(r3) + stfd f28, 216(r3) + stfd f29, 224(r3) + stfd f30, 232(r3) + stfd f31, 240(r3) + blr + SET_SIZE(fpu_save) + + .globl _fpu_restore + GFUNCDEF(fpu_restore) + lfd f1, 0(r3) + lfd f2, 8(r3) + lfd f3, 16(r3) + lfd f4, 24(r3) + lfd f5, 32(r3) + lfd f6, 40(r3) + lfd f7, 48(r3) + lfd f8, 56(r3) + lfd f9, 64(r3) + lfd f10, 72(r3) + lfd f11, 80(r3) + lfd f12, 88(r3) + lfd f13, 96(r3) + lfd f14, 104(r3) + lfd f15, 112(r3) + lfd f16, 120(r3) + lfd f17, 128(r3) + lfd f18, 136(r3) + lfd f19, 144(r3) + lfd f20, 152(r3) + lfd f21, 160(r3) + lfd f22, 168(r3) + lfd f23, 176(r3) + lfd f24, 184(r3) + lfd f25, 192(r3) + lfd f26, 200(r3) + lfd f27, 208(r3) + lfd f28, 216(r3) + lfd f29, 224(r3) + lfd f30, 232(r3) + lfd f31, 240(r3) + + SET_SIZE(fpu_restore) + +#endif \ No newline at end of file diff --git a/lisp/ppc-validate.h b/lisp/ppc-validate.h index 1c321c3e9..d395a0b8f 100644 --- a/lisp/ppc-validate.h +++ b/lisp/ppc-validate.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-validate.h,v 1.6 2005/09/15 18:26:52 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-validate.h,v 1.7 2006/01/18 15:21:26 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. @@ -45,6 +45,7 @@ #define CONTROL_STACK_START (0x30000000) #define CONTROL_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ +#define CONTROL_STACK_END (CONTROL_STACK_START + CONTROL_STACK_SIZE) #define BINDING_STACK_START (0x38000000) #define BINDING_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ @@ -63,8 +64,19 @@ #define DEFAULT_DYNAMIC_SPACE_SIZE (0x08000000) /* 128 MB */ #define DYNAMIC_0_SPACE_START (0x40000000) +/* This isn't used with GENCGC */ #define DYNAMIC_1_SPACE_START (0x60000000) + +/* The maximum dynamic space we can allocate */ +#ifndef GENCGC #define DYNAMIC_SPACE_SIZE (0x1fff0000) /* 512 MB, almost */ +#else +/* + * For GENCGC, we can use both dynamic spaces (because they are + * contiguous) so we get double the heap size. + */ +#define DYNAMIC_SPACE_SIZE (0x3fff0000) /* 1GB, almost */ +#endif #if 0 #define HOLES {0x04ff8000, 0x06ff8000, 0x0aff8000, 0x1fff8000} diff --git a/lisp/purify.c b/lisp/purify.c index 819a695dc..f18237a9c 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.35 2005/12/11 18:30:51 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.36 2006/01/18 15:21:26 rtoy Exp $ */ #include <stdio.h> @@ -1705,7 +1705,7 @@ 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) && !defined(__x86_64) && !(defined(sparc) && defined(GENCGC)) +#if !defined(ibmrt) && !defined(i386) && !defined(__x86_64) && !((defined(sparc) || defined(DARWIN)) && defined(GENCGC)) current_dynamic_space_free_pointer = current_dynamic_space; #else #if defined(WANT_CGC) && defined(X86_CGC_ACTIVE_P) -- GitLab