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