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