0.9.9.36:
authorChristophe Rhodes <csr21@cam.ac.uk>
Tue, 21 Feb 2006 22:59:29 +0000 (22:59 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Tue, 21 Feb 2006 22:59:29 +0000 (22:59 +0000)
Merge Cyrus Harmon's 7th gencgc merge candidate
... with the addition of idempotent implementations of
arch_clear_pseudo_atomic_interrupted() for
sparc, mips, alpha and hppa.  (the last three completely
untested).
... many, many changes, most of which are documented in
doc/internals-notes/GENCGC-PORTING-NOTES

(This commit may break horribly.  Please read, please test)

42 files changed:
CREDITS
NEWS
doc/internals-notes/GENCGC-PORTING-NOTES [new file with mode: 0644]
make-config.sh
package-data-list.lisp-expr
src/assembly/ppc/arith.lisp
src/assembly/ppc/array.lisp
src/code/ppc-vm.lisp
src/compiler/generic/genesis.lisp
src/compiler/ppc/alloc.lisp
src/compiler/ppc/array.lisp
src/compiler/ppc/c-call.lisp
src/compiler/ppc/call.lisp
src/compiler/ppc/insts.lisp
src/compiler/ppc/macros.lisp
src/compiler/ppc/move.lisp
src/compiler/ppc/parms.lisp
src/runtime/Config.ppc-darwin
src/runtime/Config.ppc-linux
src/runtime/alloc.c
src/runtime/alpha-arch.c
src/runtime/arch.h
src/runtime/bsd-os.c
src/runtime/cheneygc.c
src/runtime/gc-common.c
src/runtime/gc-internal.h
src/runtime/gc.h
src/runtime/gencgc.c
src/runtime/globals.c
src/runtime/globals.h
src/runtime/hppa-arch.c
src/runtime/interrupt.c
src/runtime/mips-arch.c
src/runtime/parse.c
src/runtime/ppc-arch.c
src/runtime/ppc-assem.S
src/runtime/ppc-darwin-spacelist.h
src/runtime/ppc-lispregs.h
src/runtime/purify.c
src/runtime/save.c
src/runtime/sparc-arch.c
version.lisp-expr

diff --git a/CREDITS b/CREDITS
index 4a730a0..1f707f8 100644 (file)
--- a/CREDITS
+++ b/CREDITS
@@ -588,7 +588,9 @@ Bruno Haible:
   primordial CMUCL.
 
 Cyrus Harmon:
   primordial CMUCL.
 
 Cyrus Harmon:
-  He fixed many PPC FFI and callback bugs.
+  He fixed many PPC FFI and callback bugs.  He ported Raymond Toy's
+  work on the generational garbage collector for PPC to Linux, finding
+  and fixing other SBCL bugs in the process.
 
 Matthias Hoelzl:
   He reported and fixed COMPILE's misbehavior on macros.
 
 Matthias Hoelzl:
   He reported and fixed COMPILE's misbehavior on macros.
diff --git a/NEWS b/NEWS
index fa06808..a309ef7 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -4,12 +4,16 @@ changes in sbcl-0.9.10 relative to sbcl-0.9.9:
     be used for bundling the runtime and the core file into one 
     executable binary. This feature is not currently supported on all SBCL
     platforms.  (thanks to James Bielman and NIIMI Satoshi)
     be used for bundling the runtime and the core file into one 
     executable binary. This feature is not currently supported on all SBCL
     platforms.  (thanks to James Bielman and NIIMI Satoshi)
+  * new feature: a generational or ephemeral garbage collector is now
+    the default on the PowerPC platform (both Linux and Darwin).  The
+    old Cheney (stop and copy) collector is a build-time option.
+    (thanks to Cyrus Harmon, after Raymond Toy)
   * minor incompatible change: the method by which SBCL finds its
     contributed modules has changed; it no longer relies on symbolic
     links from an $SBCL_HOME/systems directory, but searches directly
     in the subdirectories of $SBCL_HOME.
   * enhancement: the dynamic heap size on the Linux/PPC platform is
   * minor incompatible change: the method by which SBCL finds its
     contributed modules has changed; it no longer relies on symbolic
     links from an $SBCL_HOME/systems directory, but searches directly
     in the subdirectories of $SBCL_HOME.
   * enhancement: the dynamic heap size on the Linux/PPC platform is
-    markedly larger.
+    markedly larger, even using the older Cheney garbage collector.
   * fixed bug #399: full call to DATA-VECTOR-REF in accesses to
     certain complicated string types.  (reported by Gary King)
   * fixed bug: STRING-TO-OCTETS and OCTETS-TO-STRING did not convert
   * fixed bug #399: full call to DATA-VECTOR-REF in accesses to
     certain complicated string types.  (reported by Gary King)
   * fixed bug: STRING-TO-OCTETS and OCTETS-TO-STRING did not convert
diff --git a/doc/internals-notes/GENCGC-PORTING-NOTES b/doc/internals-notes/GENCGC-PORTING-NOTES
new file mode 100644 (file)
index 0000000..badadaa
--- /dev/null
@@ -0,0 +1,639 @@
+
+====================================================
+OPEN GENGC BUGS
+====================================================
+
+7. OPEN. This isn't really a GENGC bug, but, for completeness, we
+   should fix ppc-vm.lisp so that the fixup can take an offset a la
+   x86-64. This was done in generic.lisp, but needs corresponding
+   changes in pcc-vm.lisp
+
+====================================================
+CLOSED GENGC BUGS
+====================================================
+
+1. FIXED. Occasional inline allocation failures? I'm guessing that's
+   what we're seeing here. Certain operations take a long time and
+   involve a lot kernel_task CPU activity. It's possible that this is
+   just I/O, but I don't think so. This seems to have gotten worse
+   recently. Changing the allocation macro to not use a fixup with an
+   offset fixes this.
+
+2. FIXED. Purify fails. Running the core-test.sh test causes a BUS
+   ERROR. The problem was that calling alien-callbacks loaded from a
+   saved core was failing. See note in
+   c-call.lisp/alien-assembler-callback-wrapper for details.
+
+3. FIXED! cons-madly test (gc.impure.lisp) fails and
+   drops into LDB. My hunch is that this is related to the
+   allocation/moving of large objects in gencgc.c.
+
+4. FIXED. PPC/Linux gencgc fails with a BUS ERROR (SIGSEGV maybe?)
+   after the first GC.
+
+5. FIXED. sb-md5 and cltl2 often (but not always) fail to build out of
+   contrib. Latest gencgc fixes seem to have fixed this. Keep an eye
+   out for it though. I think the allocation macro fixup changes fixed
+   this one.
+
+6. FIXED. finalize-test.sh fails. finalizers weren't being run
+   properly. removed #ifdef LISP_FEATURE_X86[_64] in
+   gencgc.c/scav_weak_pointer and now things seem to work.
+
+8. NOT A BUG. In insts.lisp, we do a lis/addi to load the address of a
+   fixup. This should really be lis/ori, but the ori instruction
+   doesn't deal with fixups. This should be fixed, but doesn't seem to
+   be rearing its ugly head at the moment. This is wrong. The fixup
+   deals with adjusting the high word such that the the lis/addi
+   sequence functions correctly here.
+
+9. FIXED. x86-64 builds busted. they build ok, but then can't do a
+   full rebuild of themselves. They die after the first purify.
+   GENCGC_RUNS_1 works, GENCGC_CANDIDATE_1 breaks. Wrongly #ifdef'ed
+   out an os_zero call in purify.c. Restoring this fixes things.
+
+
+
+====================================================
+CVS tag: ALLOCATION_CLEANUP_1
+====================================================
+
+File: src/assembly/ppc/arith.lisp
+================
+
+* Fixed allocation for CONS-BIGNUM. Note that we now always cons 2 words
+  instead of trying to fit into 1 word first
+
+File: src/compiler/ppc/alloc.lisp
+================
+
+* Fixed vop for list-or-list*. Uses the allocation macro instead of
+  setting alloc-tn directly. Note that the (relatively) recent dynamic
+  extent support should still work here. In this case, we directly
+  allocate this by adjusting csp-tn.
+
+* Fixed vop for make-closure. See note above. Dynamic extent should
+  still work.
+
+* TODO: [FUTURE] add stack allocation to the allocate macro.
+
+File: src/compiler/ppc/macros.lisp
+
+* Added allocation macro. Note that this is using king nato's version
+  and may not do everything we need to do for GENCGC.
+
+* with-fixed-allocation changes. Now takes a keyword argument (:lowtag
+  other-pointer-lowtag). Removed restriction on having a non-empty
+  body as we can use this macro just for allocating data. Now uses the
+  allocation macro instead of adjusting alloc-tn directly.
+
+* Removed the :extra keyword argument from pseudo-atomic. Don't use
+  this for allocating memory anymore! Removed the corresponding gensym
+  and let. This is still King Nato's pseudo-atomic. At some point we
+  should better understand the differences between rtoy's version and
+  king nato's version.
+
+
+File: move.lisp
+===============
+
+* move-from-unsigned vop now uses with-fixed allocation instead of
+  setting alloc-tn directly. We always allocate two words now instead
+  of trying to get away with one first.
+
+
+====================================================
+CVS tag: ALLOCATION_CLEANUP_2
+====================================================
+
+File: src/assembly/ppc/array.lisp
+=============================
+
+* Fixed allocate-vector assembly-routine to use allocate macro instead
+  of adjusting alloc-tn directly.
+
+File: src/compiler/ppc/array.lisp
+=============================
+
+* make-array-header vop now uses allocation macro instead of setting
+  alloc-tn directly
+
+File: src/compiler/ppc/call.lisp
+============================
+
+* listify-rest-args now uses the allocation macro instead of adjusting
+  alloc-tn directly.  For dynamic extent args, we still allocate
+  directly by adjusting csp-tn. We should implement stack allocation
+  in the allocation macro.
+
+
+====================================================
+CVS tag: BUILD_CLEANUP_1
+====================================================
+
+File: src/code/ppc-vm.lisp
+
+* Add flag disabling scavenging of read-only space (to be used later)
+
+File: src/compiler/ppc/parms.lisp
+
+* Add gencgc-page-size variable. Currently 4096. Bump to 32k later.
+
+* Added dynamic-space-start and dynamic-space-end constants for linux
+  and darwin #!+gencgc. Conditionalized dynamic-0 and dynamic-1
+  constants for#!-gencgc.
+
+* Added *restart-lisp-function*, *current-region-end-addr* and
+  *scavenge-read-only-space* static-symbols.
+
+File: src/runtime/Config.ppc-darwin
+
+* Make GC_SRC shell commands that search for LISP_FEATURE_GENCGC in
+  genesis/config.h and set GC_SRC to gencgc.c or cheneygc.c as
+  appropriate
+
+File: src/runtime/Config.ppc-linux
+
+* Make GC_SRC shell commands that search for LISP_FEATURE_GENCGC in
+  genesis/config.h and set GC_SRC to gencgc.c or cheneygc.c as
+  appropriate
+
+====================================================
+CVS tag: GENCGC_PREP_1
+====================================================
+
+File: src/runtime/arch.h
+
+* Moved extern fpu_save and fpu_restore defintions here
+
+File: src/runtime/cheneygc.c
+
+* removed static scavenge_interrupt_contexts prototype
+
+File: gc-common.c
+
+* Instead of #ifndef LISP_FEATURE_SPARC for scav_fdefn, use
+  defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
+* Instead of #ifndef LISP_FEATURE_GENCGC for scav_fun_header and
+  scav_return_pc_header scavtab entries, use #if
+  !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+
+* set scav_tab[FDEFN_WIDETAG] to scav_fdefn on X86 and X86_64 and
+  scav_boxed for everything else.
+
+File: gc-internal.h
+
+* added prototype for scavenge_interrupt_contexts
+
+====================================================
+CVS tag: GENCGC_PREP_2
+====================================================
+
+File: gc-common.c
+
+* Reverted gc-common.c changes from GENCGC_PREP_1. The problem was
+  that I was mimicing rtoy's FDEFN changes for PPC, superficially,
+  without changing the underlying code. He changed the way fdefn's
+  work on ppc to look more like they do on SPARC. I think we can get
+  away with leaving this alone, at least for now.
+
+File: ppc-arch.c
+
+* Moved PSEUDO_ATOMIC_INTERRUPTED_BIAS to ppc-arch.h
+
+File: ppc-arch.h
+
+* Moved PSEUDO_ATOMIC_INTERRUPTED_BIAS to ppc-arch.h
+
+File: ppc-assem.S
+
+* Added do_pending_interrupt, fpu_save and fpu_restore.
+
+File: ppc-darwin-spacelist.h
+
+* Adjust spaces for #+gencgc and #-gencgc
+
+File: purify.c
+
+* #ifdef LISP_FEATURE_GENCGC -> X86{_64}
+
+File: gencgc.c
+
+* Remove fpu_save and fpu_restore prototypes
+
+====================================================
+CVS tag: GENCGC_PREP_3
+====================================================
+
+File: src/runtime/gc.h
+
+* Added xxx_pseudo_atomic_xxx and xxx_alloc_pointer #defines
+
+File: src/runtime/alloc.c
+
+* Start using xxx_pseudo_atomic_xxx
+
+====================================================
+CVS tag: GENCGC_PREP_4
+====================================================
+
+File: src/runtime/globals.c
+
+* Cleaning up GENCGC/X86[_64] ifdefs
+
+File: src/runtime/globals.h
+
+* Cleaning up GENCGC/X86[_64] ifdefs
+
+File: src/runtime/parse.c
+
+* Use get_alloc_pointer instead of arch specific ways of doing so
+
+====================================================
+CVS tag: PSEUDO_ATOMIC_REG_ALLOC
+====================================================
+
+File: compiler/ppc/macros.lisp
+
+* Pseudo-atomic now uses bits 3 and 1 of reg_ALLOC insetead of using
+  reg_NL3 for the interrutped part.
+
+File: src/runtime/gc.h
+
+* Pseudo-atomic now uses bits 3 and 1 of reg_ALLOC insetead of using
+  reg_NL3 for the interrutped part.
+
+File: src/runtime/ppc-arch.c
+
+* Pseudo-atomic now uses bits 3 and 1 of reg_ALLOC insetead of using
+  reg_NL3 for the interrutped part.
+
+* Brought the allocation trap stuff along, but this is untested.
+
+File: src/runtime/ppc-assem.S
+
+* Pseudo-atomic now uses bits 3 and 1 of reg_ALLOC insetead of using
+  reg_NL3 for the interrutped part.
+
+====================================================
+CVS tag: GENCGC_BUILDS_1
+====================================================
+
+File: src/runtime/gencgc.c
+
+* The big kahuna...
+
+* Ok, lots of little changes to get things working. Had to fix up the
+  allocation macro, the uses of it, etc... 
+
+
+====================================================
+CVS tag: GENCGC_RUNS_1
+====================================================
+
+* Ok, it runs now, but we seem to trap on every allocation. Trying to
+  figure out why. Works -gencgc/ppc and works on x86-64.
+
+====================================================
+CVS tag: GENCGC_RUNS_INLINE_ALLOCATION_1
+====================================================
+
+File: src/compiler/generic/genesis.lisp
+
+* do-cold-fixup now looks at the SI portion of PPC instructions in :ha
+  and :l fixups and uses these as offsets in calculating the address.
+
+File: src/compiler/ppc/insts.lisp
+
+* in define-d-si-instruction we now stick the fikup-offset into the si
+  portion of the opcode instead of always using 0. This allows us to
+  pass this information on to do-cold-fixup in genesis.lisp.
+
+File: src/compiler/ppc/macros.lisp
+
+* gencgc allocation macro now uses fixups to boxed_region.free_pointer
+  and boxed_region.end_addr to get these values instead of pulling
+  them out of registers. This removes the need to keep these registers
+  in sync with the C struct values. And it is more like what we will
+  eventually need to do if we ever do PPC threads.
+
+File: src/runtime/gc.h
+
+* removed set_current_region_free, get_current_free, and
+  set_current_region_end.
+
+File: src/runtime/gencgc.c
+
+* In gc_alloc_new_region, use page_address(last_page) + PAGE_BYTES to
+  get the end_addr instead of start_addr + bytes_found.
+
+* removed set_current_region_end calls.
+
+File: src/runtime/ppc-arch.c
+
+* include gencgc-alloc-region.h
+
+* look back 3 instructions instead of 2 to match the new allocation
+  macro
+
+* added end_addr variable for debugging.
+
+* no longer adjust dynamic_space_free_pointer
+
+====================================================
+CVS TAG: GENCGC_MOSTLY_WORKING_1
+====================================================
+
+* Making purify and loading callbacks from cores work for ppc/gengc.
+
+* Remove *scavenge-read-only-space*
+
+File: src/compiler/ppc/c-call.lisp
+
+* Fixed alien-callback-assembler-wrapper to get the address for
+  enter-alien-callback from the symbol-value slot of
+  SB-ALIEN::*ENTER-ALIEN-CALLBACK* to ensure that this works even if
+  the GC moves ENTER-ALIEN-CALLBACK. Thanks to JES for the suggestion
+  on the fix. callback.impure.lisp now passes.
+
+File: src/runtime/gencgc.c
+
+* Removed #ifdef LISP_FEATURE_X86[_64] in
+  gengcc.c/scav_weak_pointer. Definitely some OOAO violations here,
+  but now finalize.test.sh passes.
+
+====================================================
+CVS TAG: GENCGC_MOSTLY_WORKING_2
+====================================================
+
+* New allocation macro. Seems to make things better.
+
+====================================================
+CVS TAG: GENCGC_MOSTLY_WORKING_3
+====================================================
+
+* Trying to undo damage done along the way. Lots of little
+  changes. Please document these in the morning.
+
+====================================================
+CVS TAG: This stuff never got tagged. I backed it out before I tagged
+         it.
+====================================================
+
+* Added ARCH_HAS_CTR_REGISTER and friends. Now we fixup the CTR in
+  scavenge_interrupt_context. Whoops. Backed this out as it seemed to
+  be messing things up.
+
+====================================================
+CVS TAG: GENCGC_ALL_TESTS_PASSED
+====================================================
+
+File: src/runtime/gc.h
+
+* set_alloc_pointer now just sets the high bits and leaves the p-a
+  flags alone.
+
+File: src/runtime/interrupt.c
+
+* interrupt_handle_pending clears the p-a-interrupted flag
+
+* undo_fake_foreign_function_call doesn't zap the p-a bits in
+  reg_ALLOC
+
+File: src/runtime/ppc-arch.c
+
+* handle_allocation_trap doesn't zap the p-a bits in reg_ALLOC
+
+====================================================
+CVS TAG: GENCGC_ALL_0_9_9_27_MERGE
+====================================================
+
+* Forward ported to 0.9.9.27
+
+====================================================
+CVS TAG: GENCGC_CANDIDATE_1
+====================================================
+
+File: src/runtime/ppc-assem.S
+
+* Massive props to Xophe for finding this. For a long time now, we had
+  been using lis, addi to load the address of NIL. Turns out this
+  fails when the high bit of the low word is set. I have no idea how
+  we missed this for so long, but changing the instruction sequence to
+  lis, ori fixes the problem of linux/ppc gencgc not working.
+
+File: src/runtime/ppc-arch.c
+
+* Turn off the address checking in arch_get_bad_addr. The pointer
+  arithmetic was wrong and was causing problems. We don't really need
+  this check (right?).
+
+File: src/code/toplevel.lisp
+
+* Fix the way we compute the end-of-stack in scrub-control-stack.
+
+File: src/runtime/bsd-os.c
+
+* Use arch_get_bad_addr to get fault address
+
+====================================================
+CVS TAG: GENCGC_SBCL_0_9_9_34_MERGE
+====================================================
+
+* Forward ported to 0.9.9.34
+
+====================================================
+CVS TAG: GENCGC_CANDIDATE_2
+====================================================
+
+File: src/compiler/ppc/macros.lisp
+
+* cleaned up comments for allocation macro
+
+* removed commented code that used to throw an error for empty
+  allocation macro body. Now we call this for its side effect of
+  allocating memory
+
+File: src/compiler/ppc/parms.lisp
+
+* gencgc-page-size -> 4096
+
+* added pseudo-atomic-interrupted-flag and pseudo-atomic-flag
+
+File: src/runtime/alloc.c
+
+* clr_pseudo_atomic -> clear_pseudo_atomic
+
+File: src/runtime/gc.h
+
+* clr_pseudo_atomic -> clear_pseudo_atomic
+
+* PSEUDO_ATOMIC_[INTERRUPTED_]VALUE -> flag_PseudoAtomic[Interrupted]
+
+File: src/runtime/interrupt.c
+
+* clr_pseudo_atomic -> clear_pseudo_atomic
+
+File: src/runtime/ppc-arch.c
+
+* whitespace fix
+
+File: package-data-list.lisp-expr
+
+* added PSEUDO-ATOMIC-INTERRUPTED-FLAG and PSEUDO-ATOMIC-FLAG to sb-vm
+  exports
+
+====================================================
+CVS TAG: GENCGC_SBCL_0_9_9_35_MERGE
+====================================================
+
+* Forward parted to 0.9.9.35
+
+====================================================
+CVS TAG: GENCGC_CANDIDATE_3
+====================================================
+
+NOTE: This includes the fix for the problem where x86-64 couldn't
+build itself. I erroneously removed an os_zero in purify.c. This has
+been restored.
+
+File: src/runtime/purify.c
+
+* remove ifndef GENCGC check around os_zero call
+* undo recent change to add back in a bit setting the
+  dynamic_space_free_pointer on x86[_64]. I don't think we need this
+
+File: src/runtime/parse.c
+
+* dunamic_space_free_ptr -> dynamic_space_free_pointer
+
+File: src/runtime/ppc-arch.c
+
+* Fixing comment text in allocation_trap_p
+* arch_clr_pseudo_atomic_interrupted ->
+    arch_clear_pseudo_atomic_interrupted
+
+File: src/runtime/gc-common.c
+
+* restore workaround behvaior for !GENCGC, not !X86[_64]
+
+* whitespace fix
+
+File :src/runtime/gencgc.c
+
+* undoing gratuitous spacing changes and fixing whitespace
+* remove bogus comment
+
+====================================================
+CVS TAG: GENCGC_CANDIDATE_4
+====================================================
+
+File: src/runtime/purify.c
+
+* Use dynamic_space_purify_pointer instead of
+  dynamic_space_free_pointer to mark the end of the dynamic_space
+  that we purify
+* call gc_free_heap in purify when using GENCGC
+
+File: src/runtime/interrupt.c
+
+clear_psuedo_atomic_interrupted -> arch_clear_pseudo_atomic_interrupted
+
+====================================================
+CVS TAG: GENCGC_CANDIDATE_5
+** Note: not tagged, but patch made
+====================================================
+
+File: src/runtime/assembly/ppc/array.lisp
+
+* cleaning up comment
+
+File: src/code/ppc-vm.lisp
+
+* removed unused commented-out chunk
+
+File: src/compiler/generic/genesis.lisp
+
+* Added FIXME about ppc offset fixups only being half-done
+
+File: src/compiler/ppc/c-call.lisp
+
+* Comment cleanup
+
+File: src/compiler/ppc/macros.lisp
+
+* Allocation macro comment cleanup
+
+File: src/runtime/gc.h
+
+* Whitespace
+
+* #ifdef GENCGC for the p_a macros
+
+File: src/runtime/gencgc.c
+
+* whitespace
+
+* removed bogus comment
+
+* restore gc_assert for alignment check on PPC
+
+File: src/runtime/globals.h
+
+* updated comment about dyanmic_space_free_pointer
+
+File: src/runtime/interrupt.c
+
+* whitespace
+
+File: src/runtime/ppc-arch.c
+
+* Remove pc checking stuff
+
+* remove SIGILL handling and adjust comment
+
+* whitespace
+
+* updated comment aboud dynamic_space_free_pointer
+
+File: src/runtime/ppc-arch.h
+
+* removed bogus comment
+
+File: src/runtime/ppc-darwin-spacelist.h
+
+* removed extraneous space
+
+====================================================
+CVS TAG: GENCGC_CANDIDATE_6
+====================================================
+
+File: src/runtime/ppc-arch.c
+
+* Removed enable_some_signals and call to it. We don't need these
+  signals on when we call alloc, but CMUCL does.
+
+File: src/runtime/alloc.c
+
+* Put in Xophe's fix against GC moving a newly pointer from moving out
+  from under us when we handle a pending interrupt. If the C stack is
+  not scavenged during GC, result needs to be protected against not
+  being referred to by any roots, so we push it onto the lisp control
+  stack, and read it back off after any potential GC has finished
+====================================================
+CVS TAG: GENCGC_CANDIDATE_7
+====================================================
+
+* Fix mismatched } and #endif in bsd-os.c/memory_fault_handler
+
+====================================================
+Untagged Changes
+====================================================
+
+
+====================================================
+Uncommited Changes
+====================================================
+
index d4feae3..c117245 100644 (file)
@@ -281,11 +281,11 @@ elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "linux" ]; then
     # versions 2.3.1 and 2.3.2
     #
     # FIXME: integrate to grovel-features., maypahps
     # versions 2.3.1 and 2.3.2
     #
     # FIXME: integrate to grovel-features., maypahps
-    printf ' :stack-allocatable-closures :linkage-table' >> $ltf
+    printf ' :gencgc :stack-allocatable-closures :linkage-table' >> $ltf
     $GNUMAKE -C tools-for-build where-is-mcontext -I src/runtime
     tools-for-build/where-is-mcontext > src/runtime/ppc-linux-mcontext.h
 elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "darwin" ]; then
     $GNUMAKE -C tools-for-build where-is-mcontext -I src/runtime
     tools-for-build/where-is-mcontext > src/runtime/ppc-linux-mcontext.h
 elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "darwin" ]; then
-    printf ' :stack-allocatable-closures' >> $ltf
+    printf ' :gencgc :stack-allocatable-closures' >> $ltf
     # We provide a dlopen shim, so a little lie won't hurt
     printf " :os-provides-dlopen :linkage-table :alien-callbacks" >> $ltf
     # The default stack ulimit under darwin is too small to run PURIFY.
     # We provide a dlopen shim, so a little lie won't hurt
     printf " :os-provides-dlopen :linkage-table :alien-callbacks" >> $ltf
     # The default stack ulimit under darwin is too small to run PURIFY.
index c266fa7..b5e0026 100644 (file)
@@ -2167,6 +2167,8 @@ structure representations"
                "FUNCALLABLE-INSTANCE-LAYOUT-SLOT"
                "FUNCALLABLE-INSTANCE-LEXENV-SLOT"
                "GENCGC-PAGE-SIZE"
                "FUNCALLABLE-INSTANCE-LAYOUT-SLOT"
                "FUNCALLABLE-INSTANCE-LEXENV-SLOT"
                "GENCGC-PAGE-SIZE"
+               #!+ppc "PSEUDO-ATOMIC-INTERRUPTED-FLAG"
+               #!+ppc "PSEUDO-ATOMIC-FLAG"
                "GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER"
                "IMMEDIATE-CHARACTER-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER"
                "IMMEDIATE-SC-NUMBER" "*INITIAL-DYNAMIC-SPACE-FREE-POINTER*"
                "GENESIS" "HALT-TRAP" "IGNORE-ME-SC-NUMBER"
                "IMMEDIATE-CHARACTER-SC-NUMBER" "IMMEDIATE-SAP-SC-NUMBER"
                "IMMEDIATE-SC-NUMBER" "*INITIAL-DYNAMIC-SPACE-FREE-POINTER*"
index ea9fc11..fd5fad9 100644 (file)
 
   CONS-BIGNUM
   ;; Allocate a BIGNUM for the result.
 
   CONS-BIGNUM
   ;; Allocate a BIGNUM for the result.
-  (pseudo-atomic (pa-flag :extra (pad-data-block (1+ bignum-digits-offset)))
+  (with-fixed-allocation (res pa-flag temp bignum-widetag
+                              (+ bignum-digits-offset 2))
     (let ((one-word (gen-label)))
     (let ((one-word (gen-label)))
-      (inst ori res alloc-tn other-pointer-lowtag)
       ;; We start out assuming that we need one word.  Is that correct?
       (inst srawi temp lo 31)
       (inst xor. temp temp hi)
       (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
       (inst beq one-word)
       ;; We start out assuming that we need one word.  Is that correct?
       (inst srawi temp lo 31)
       (inst xor. temp temp hi)
       (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
       (inst beq one-word)
-      ;; Nope, we need two, so allocate the additional space.
-      (inst addi alloc-tn alloc-tn (- (pad-data-block (+ 2 bignum-digits-offset))
-                                      (pad-data-block (1+ bignum-digits-offset))))
       (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
       (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
       (emit-label one-word)
       (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
       (storew hi res (1+ bignum-digits-offset) other-pointer-lowtag)
       (emit-label one-word)
index e94fa84..e59c3c0 100644 (file)
 
      (:temp ndescr non-descriptor-reg nl0-offset)
      (:temp pa-flag non-descriptor-reg nl3-offset)
 
      (: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)
+     (:temp temp non-descriptor-reg nl2-offset))
   (pseudo-atomic (pa-flag)
   (pseudo-atomic (pa-flag)
-    (inst ori vector alloc-tn other-pointer-lowtag)
     ;; boxed words == unboxed bytes
     (inst addi ndescr words (* (1+ vector-data-offset) n-word-bytes))
     (inst clrrwi ndescr ndescr n-lowtag-bits)
     ;; boxed words == unboxed bytes
     (inst addi ndescr words (* (1+ vector-data-offset) n-word-bytes))
     (inst clrrwi ndescr ndescr n-lowtag-bits)
-    (inst add alloc-tn alloc-tn ndescr)
+    (allocation vector ndescr other-pointer-lowtag
+                :temp-tn temp
+                :flag-tn pa-flag)
     (inst srwi ndescr type word-shift)
     (storew ndescr vector 0 other-pointer-lowtag)
     (storew length vector vector-length-slot other-pointer-lowtag))
   ;; This makes sure the zero byte at the end of a string is paged in so
   ;; the kernel doesn't bitch if we pass it the string.
     (inst srwi ndescr type word-shift)
     (storew ndescr vector 0 other-pointer-lowtag)
     (storew length vector vector-length-slot other-pointer-lowtag))
   ;; This makes sure the zero byte at the end of a string is paged in so
   ;; the kernel doesn't bitch if we pass it the string.
-  (storew zero-tn alloc-tn 0)
+  ;;
+  ;; rtoy says to turn this off as it causes problems with CMUCL.
+  ;;
+  ;; I don't think we need to do this anymore. It looks like this
+  ;; inherited from the SPARC port and does not seem to be
+  ;; necessary. Turning this on worked at some point, but I have not
+  ;; tested with the final GENGC-related changes. CLH 20060221
+  ;;
+  ;;  (storew zero-tn alloc-tn 0)
   (move result vector))
   (move result vector))
-
index ce78355..c5f7b19 100644 (file)
                 (sc-offsets (sb!c:read-var-integer vector index)))
                (values error-number (sc-offsets))))))
 
                 (sc-offsets (sb!c:read-var-integer vector index)))
                (values error-number (sc-offsets))))))
 
-
-
index 803b7af..a381dfd 100644 (file)
@@ -1765,20 +1765,29 @@ core and return a descriptor to it."
                 (logior (mask-field (byte 16 16)
                                     (bvref-32 gspace-bytes gspace-byte-offset))
                         (ldb (byte 16 0) value))))))
                 (logior (mask-field (byte 16 16)
                                     (bvref-32 gspace-bytes gspace-byte-offset))
                         (ldb (byte 16 0) value))))))
+       ;; FIXME: PowerPC Fixups are not fully implemented. The bit
+       ;; here starts to set things up to work properly, but there
+       ;; needs to be corresponding code in ppc-vm.lisp
        (:ppc
        (:ppc
-       (ecase kind
-         (:ba
-          (setf (bvref-32 gspace-bytes gspace-byte-offset)
-                (dpb (ash value -2) (byte 24 2)
-                     (bvref-32 gspace-bytes gspace-byte-offset))))
-         (:ha
-          (let* ((h (ldb (byte 16 16) value))
-                 (l (ldb (byte 16 0) value)))
-            (setf (bvref-16 gspace-bytes (+ gspace-byte-offset 2))
-                  (if (logbitp 15 l) (ldb (byte 16 0) (1+ h)) h))))
-         (:l
-          (setf (bvref-16 gspace-bytes (+ gspace-byte-offset 2))
-                (ldb (byte 16 0) value)))))
+        (ecase kind
+          (:ba
+           (setf (bvref-32 gspace-bytes gspace-byte-offset)
+                 (dpb (ash value -2) (byte 24 2)
+                      (bvref-32 gspace-bytes gspace-byte-offset))))
+          (:ha
+           (let* ((un-fixed-up (bvref-16 gspace-bytes
+                                         (+ gspace-byte-offset 2)))
+                  (fixed-up (+ un-fixed-up value))
+                  (h (ldb (byte 16 16) fixed-up))
+                  (l (ldb (byte 16 0) fixed-up)))
+             (setf (bvref-16 gspace-bytes (+ gspace-byte-offset 2))
+                   (if (logbitp 15 l) (ldb (byte 16 0) (1+ h)) h))))
+          (:l
+           (let* ((un-fixed-up (bvref-16 gspace-bytes
+                                         (+ gspace-byte-offset 2)))
+                  (fixed-up (+ un-fixed-up value)))
+             (setf (bvref-16 gspace-bytes (+ gspace-byte-offset 2))
+                   (ldb (byte 16 0) fixed-up))))))
       (:sparc
        (ecase kind
          (:call
       (:sparc
        (ecase kind
          (:call
index 29be679..4f83b44 100644 (file)
   (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
               res)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
               res)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
+  (:temporary (:scs (non-descriptor-reg)) alloc-temp)
   (:info num)
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :safe)
   (:node-var node)
   (:info num)
   (:results (result :scs (descriptor-reg)))
   (:variant-vars star)
   (:policy :safe)
   (:node-var node)
+  #!-gencgc (:ignore alloc-temp)
   (:generator 0
     (cond ((zerop num)
            (move result null-tn))
   (:generator 0
     (cond ((zerop num)
            (move result null-tn))
              (let* ((dx-p (node-stack-allocate-p node))
                     (cons-cells (if star (1- num) num))
                     (alloc (* (pad-data-block cons-size) cons-cells)))
              (let* ((dx-p (node-stack-allocate-p node))
                     (cons-cells (if star (1- num) num))
                     (alloc (* (pad-data-block cons-size) cons-cells)))
-               (pseudo-atomic (pa-flag :extra (if dx-p 0 alloc))
-                 (let ((allocation-area-tn (if dx-p csp-tn alloc-tn)))
-                   (when dx-p
-                     (align-csp res))
-                   (inst clrrwi res allocation-area-tn n-lowtag-bits)
-                   (inst ori res res list-pointer-lowtag)
-                   (when dx-p
-                     (inst addi csp-tn csp-tn alloc)))
+               (pseudo-atomic (pa-flag)
+                 (if dx-p
+                     (progn
+                       (align-csp res)
+                       (inst clrrwi res csp-tn n-lowtag-bits)
+                       (inst ori res res list-pointer-lowtag)
+                       (inst addi csp-tn csp-tn alloc))
+                     (allocation res alloc list-pointer-lowtag :temp-tn alloc-temp
+                                 :flag-tn pa-flag))
                  (move ptr res)
                  (dotimes (i (1- cons-cells))
                    (storew (maybe-load (tn-ref-tn things)) ptr
                  (move ptr res)
                  (dotimes (i (1- cons-cells))
                    (storew (maybe-load (tn-ref-tn things)) ptr
@@ -86,6 +89,7 @@
          (unboxed-arg :scs (any-reg)))
   (:results (result :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) ndescr)
          (unboxed-arg :scs (any-reg)))
   (:results (result :scs (descriptor-reg)))
   (:temporary (:scs (non-descriptor-reg)) ndescr)
+  (:temporary (:scs (non-descriptor-reg)) size)
   (:temporary (:scs (any-reg) :from (:argument 0)) boxed)
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:temporary (:scs (any-reg) :from (:argument 0)) boxed)
   (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
       ;; Note: we don't have to subtract off the 4 that was added by
       ;; pseudo-atomic, because oring in other-pointer-lowtag just adds
       ;; it right back.
       ;; Note: we don't have to subtract off the 4 that was added by
       ;; pseudo-atomic, because oring in other-pointer-lowtag just adds
       ;; it right back.
-      (inst ori result alloc-tn other-pointer-lowtag)
-      (inst add alloc-tn alloc-tn boxed)
-      (inst add alloc-tn alloc-tn unboxed)
+      (inst add size boxed unboxed)
+      (allocation result size other-pointer-lowtag :temp-tn ndescr :flag-tn pa-flag)
       (inst slwi ndescr boxed (- n-widetag-bits word-shift))
       (inst ori ndescr ndescr code-header-widetag)
       (storew ndescr result 0 other-pointer-lowtag)
       (inst slwi ndescr boxed (- n-widetag-bits word-shift))
       (inst ori ndescr ndescr code-header-widetag)
       (storew ndescr result 0 other-pointer-lowtag)
   (:results (result :scs (descriptor-reg)))
   (:generator 10
     (let* ((size (+ length closure-info-offset))
   (:results (result :scs (descriptor-reg)))
   (:generator 10
     (let* ((size (+ length closure-info-offset))
-           (alloc-size (pad-data-block size))
-           (allocation-area-tn (if stack-allocate-p csp-tn alloc-tn)))
-      (pseudo-atomic (pa-flag :extra (if stack-allocate-p 0 alloc-size))
-        (when stack-allocate-p
-          (align-csp result))
-        (inst clrrwi. result allocation-area-tn n-lowtag-bits)
-        (when stack-allocate-p
-          (inst addi csp-tn csp-tn alloc-size))
-        (inst ori result result fun-pointer-lowtag)
-        (inst lr temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag))
-        (storew temp result 0 fun-pointer-lowtag)))
-    ;(inst lis temp (ash 18 10))
-    ;(storew temp result closure-jump-insn-slot function-pointer-type)
-    (storew result result closure-self-slot fun-pointer-lowtag)
-    (storew function result closure-fun-slot fun-pointer-lowtag)))
+           (alloc-size (pad-data-block size)))
+      (pseudo-atomic (pa-flag)
+        (if stack-allocate-p
+            (progn
+              (align-csp result)
+              (inst clrrwi. result csp-tn n-lowtag-bits)
+              (inst addi csp-tn csp-tn alloc-size)
+              (inst ori result result fun-pointer-lowtag)
+              (inst lr temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag)))
+            (progn
+              (allocation result (pad-data-block size)
+                          fun-pointer-lowtag :temp-tn temp :flag-tn pa-flag)
+              (inst lr temp (logior (ash (1- size) n-widetag-bits) closure-header-widetag))))
+        ;;; should this be closure-fun-slot instead of 0?
+        (storew temp result 0 fun-pointer-lowtag)
+        (storew result result closure-self-slot fun-pointer-lowtag)
+        (storew function result closure-fun-slot fun-pointer-lowtag)))))
 
 ;;; The compiler likes to be able to directly make value cells.
 ;;;
 
 ;;; The compiler likes to be able to directly make value cells.
 ;;;
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:generator 4
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:generator 4
-    (pseudo-atomic (pa-flag :extra (pad-data-block words))
-      (cond ((logbitp 2 lowtag)
-             (inst ori result alloc-tn lowtag))
-            (t
-             (inst clrrwi result alloc-tn n-lowtag-bits)
-             (inst ori result  result lowtag)))
-      (when type
-        (inst lr temp (logior (ash (1- words) n-widetag-bits) type))
-        (storew temp result 0 lowtag)))))
+    (with-fixed-allocation (result pa-flag temp type words :lowtag lowtag)
+      )))
 
 (define-vop (var-alloc)
   (:args (extra :scs (any-reg)))
   (:arg-types positive-fixnum)
   (:info name words type lowtag)
 
 (define-vop (var-alloc)
   (:args (extra :scs (any-reg)))
   (:arg-types positive-fixnum)
   (:info name words type lowtag)
-  (:ignore name)
+  (:ignore name #!-gencgc temp)
   (:results (result :scs (descriptor-reg)))
   (:temporary (:scs (any-reg)) bytes)
   (:temporary (:scs (non-descriptor-reg)) header)
   (: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) n-word-bytes))
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:generator 6
     (inst addi bytes extra (* (1+ words) n-word-bytes))
     (inst addi header header (+ (ash -2 n-widetag-bits) type))
     (inst clrrwi bytes bytes n-lowtag-bits)
     (pseudo-atomic (pa-flag)
     (inst addi header header (+ (ash -2 n-widetag-bits) type))
     (inst clrrwi bytes bytes n-lowtag-bits)
     (pseudo-atomic (pa-flag)
-      (cond ((logbitp 2 lowtag)
-             (inst ori result alloc-tn lowtag))
-            (t
-             (inst clrrwi result alloc-tn n-lowtag-bits)
-             (inst ori result result lowtag)))
-      (storew header result 0 lowtag)
-      (inst add alloc-tn alloc-tn bytes))))
+      (allocation result bytes lowtag :temp-tn temp :flag-tn pa-flag)
+      (storew header result 0 lowtag))))
index 456a546..6e0aca3 100644 (file)
   (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:temporary (:scs (non-descriptor-reg)) ndescr)
   (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header)
   (:temporary (:sc non-descriptor-reg :offset nl3-offset) pa-flag)
   (:temporary (:scs (non-descriptor-reg)) ndescr)
+  (:temporary (:scs (non-descriptor-reg)) gc-temp)
+  #!-gencgc (:ignore gc-temp)
   (:results (result :scs (descriptor-reg)))
   (:generator 0
     (pseudo-atomic (pa-flag)
   (:results (result :scs (descriptor-reg)))
   (:generator 0
     (pseudo-atomic (pa-flag)
-      (inst ori header alloc-tn other-pointer-lowtag)
       (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes))
       (inst clrrwi ndescr ndescr n-lowtag-bits)
       (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes))
       (inst clrrwi ndescr ndescr n-lowtag-bits)
-      (inst add alloc-tn alloc-tn ndescr)
+      (allocation header ndescr other-pointer-lowtag
+                  :temp-tn gc-temp
+                  :flag-tn pa-flag)
       (inst addi ndescr rank (fixnumize (1- array-dimensions-offset)))
       (inst slwi ndescr ndescr n-widetag-bits)
       (inst or ndescr ndescr type)
       (inst addi ndescr rank (fixnumize (1- array-dimensions-offset)))
       (inst slwi ndescr ndescr n-widetag-bits)
       (inst or ndescr ndescr type)
index a218792..be7be0e 100644 (file)
                          (inst lis reg high)
                          (inst ori reg reg low))))
                 ;; Setup the args
                          (inst lis reg high)
                          (inst ori reg reg low))))
                 ;; Setup the args
-                (load-address-into arg1 (get-lisp-obj-address #'enter-alien-callback))
+
+                ;; CLH 2006/02/10 -Following JES' logic in
+                ;; x86-64/c-call.lisp, we need to access
+                ;; ENTER-ALIEN-CALLBACK through the symbol-value slot
+                ;; of SB-ALIEN::*ENTER-ALIEN-CALLBACK* to ensure that
+                ;; it works if GC moves ENTER-ALIEN-CALLBACK.
+                ;;
+                ;; old way:
+                ;; (load-address-into arg1 (get-lisp-obj-address #'enter-alien-callback))
+
+                ;; new way:
+                ;; (load-symbol arg1 'sb!alien::*enter-alien-callback*)
+                ;;
+                ;; whoops: can't use load-symbol here as null-tn might
+                ;; not be loaded with the proper value as we are
+                ;; coming in from C code. Use nil-value constant
+                ;; instead, following the logic in x86-64/c-call.lisp.
+                (load-address-into arg1 (+ nil-value (static-symbol-offset
+                                                      'sb!alien::*enter-alien-callback*)))
+                (loadw arg1 arg1 symbol-value-slot other-pointer-lowtag)
+
                 (inst li arg2 (fixnumize index))
                 (inst addi arg3 sp n-foreign-linkage-area-bytes)
                 ;; FIXME: This was (- (* RETURN-AREA-SIZE N-WORD-BYTES)), while
                 (inst li arg2 (fixnumize index))
                 (inst addi arg3 sp n-foreign-linkage-area-bytes)
                 ;; FIXME: This was (- (* RETURN-AREA-SIZE N-WORD-BYTES)), while
index ece3e57..8468f3f 100644 (file)
@@ -1043,9 +1043,11 @@ default-value-8
 
       (emit-label loop)
       ;; *--dst = *--src, --count
 
       (emit-label loop)
       ;; *--dst = *--src, --count
+      (inst addi src src (- n-word-bytes))
       (inst addic. count count (- (fixnumize 1)))
       (inst addic. count count (- (fixnumize 1)))
-      (inst lwzu temp src (- n-word-bytes))
-      (inst stwu temp dst (- n-word-bytes))
+      (loadw temp src)
+      (inst addi dst dst (- n-word-bytes))
+      (storew temp dst)
       (inst bgt loop)
 
       (emit-label do-regs)
       (inst bgt loop)
 
       (emit-label do-regs)
@@ -1090,8 +1092,7 @@ default-value-8
     (let* ((enter (gen-label))
            (loop (gen-label))
            (done (gen-label))
     (let* ((enter (gen-label))
            (loop (gen-label))
            (done (gen-label))
-           (dx-p (node-stack-allocate-p node))
-           (alloc-area-tn (if dx-p csp-tn alloc-tn)))
+           (dx-p (node-stack-allocate-p node)))
       (move context context-arg)
       (move count count-arg)
       ;; Check to see if there are any arguments.
       (move context context-arg)
       (move count count-arg)
       ;; Check to see if there are any arguments.
@@ -1101,14 +1102,21 @@ default-value-8
 
     ;; We need to do this atomically.
     (pseudo-atomic (pa-flag)
 
     ;; We need to do this atomically.
     (pseudo-atomic (pa-flag)
-      (when dx-p
-        (align-csp temp))
       ;; Allocate a cons (2 words) for each item.
       ;; Allocate a cons (2 words) for each item.
-      (inst clrrwi result alloc-area-tn n-lowtag-bits)
-      (inst ori result result list-pointer-lowtag)
-      (move dst result)
-      (inst slwi temp count 1)
-      (inst add alloc-area-tn alloc-area-tn temp)
+      (if dx-p
+          (progn
+            (align-csp temp)
+            (inst clrrwi result csp-tn n-lowtag-bits)
+            (inst ori result result list-pointer-lowtag)
+            (move dst result)
+            (inst slwi temp count 1)
+            (inst add csp-tn csp-tn temp))
+          (progn
+            (inst slwi temp count 1)
+            (allocation result temp list-pointer-lowtag
+                        :temp-tn dst
+                        :flag-tn pa-flag)
+            (move dst result)))
       (inst b enter)
 
       ;; Compute the next cons and store it in the current one.
       (inst b enter)
 
       ;; Compute the next cons and store it in the current one.
index 4bbf5f4..14563c0 100644 (file)
                     (when (typep si 'fixup)
                       (ecase ,fixup
                         ((:ha :l) (note-fixup segment ,fixup si)))
                     (when (typep si 'fixup)
                       (ecase ,fixup
                         ((:ha :l) (note-fixup segment ,fixup si)))
-                      (setq si 0))
+                      (setq si (or (fixup-offset si) 0)))
                     (emit-d-form-inst segment ,op (reg-tn-encoding rt) (reg-tn-encoding ra) si)))))
 
            (define-d-rs-ui-instruction (name op &key (cost 1) other-dependencies)
                     (emit-d-form-inst segment ,op (reg-tn-encoding rt) (reg-tn-encoding ra) si)))))
 
            (define-d-rs-ui-instruction (name op &key (cost 1) other-dependencies)
index 41df39a..4a5d2dc 100644 (file)
 
 \f
 ;;;; Storage allocation:
 
 \f
 ;;;; Storage allocation:
-(defmacro with-fixed-allocation ((result-tn flag-tn temp-tn type-code size)
+
+;;; This is the main mechanism for allocating memory in the lisp heap.
+;;;
+;;; The allocated space is stored in RESULT-TN with the lowtag LOWTAG
+;;; applied.  The amount of space to be allocated is SIZE bytes (which
+;;; must be a multiple of the lisp object size).
+;;;
+;;; On other platforms (Non-PPC), if STACK-P is given, then allocation
+;;; occurs on the control stack (for dynamic-extent).  In this case,
+;;; you MUST also specify NODE, so 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. FIXME: This is not yet
+;;; implemented on PPC. We should implement this and replace the
+;;; inline stack-based allocation that presently occurs in the
+;;; VOPs. The stack-p argument is ignored on PPC.
+;;;
+;;; 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 flag-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
+  ;; set.  Otherwise, we need to zap out the lowtag from alloc-tn, and
+  ;; then or in the lowtag.
+  ;; Normal allocation to the heap.
+  (declare (ignore stack-p node)
+           #!-gencgc
+           (ignore temp-tn flag-tn))
+    #!-gencgc
+    (let ((alloc-size (gensym)))
+      `(let ((,alloc-size ,size))
+         (if (logbitp (1- n-lowtag-bits) ,lowtag)
+             (progn
+               (inst ori ,result-tn alloc-tn ,lowtag))
+             (progn
+               (inst clrrwi ,result-tn alloc-tn n-lowtag-bits)
+               (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))))
+    #!+gencgc
+    (let ((fix-addr (gensym))
+          (inline-alloc (gensym)))
+      `(let ((,fix-addr (gen-label))
+             (,inline-alloc (gen-label)))
+         ;; Make temp-tn be the size
+         (cond ((numberp ,size)
+                (inst lr ,temp-tn ,size))
+               (t
+                (move ,temp-tn ,size)))
+
+         (inst lr ,flag-tn (make-fixup "boxed_region" :foreign))
+         (inst lwz ,result-tn ,flag-tn 0)
+
+         ;; we can optimize this to only use one fixup here, once we get
+         ;; it working
+         ;; (inst lr ,flag-tn (make-fixup "boxed_region" :foreign 4))
+         ;; (inst lwz ,flag-tn ,flag-tn 0)
+         (inst lwz ,flag-tn ,flag-tn 4)
+
+         (without-scheduling ()
+           ;; CAUTION: The C code depends on the exact order of
+           ;; instructions here.  In particular, three instructions before
+           ;; the TW instruction must be an ADD or ADDI instruction, so it
+           ;; can figure out the size of the desired allocation.
+           ;; Now make result-tn point at the end of the object, to
+           ;; figure out if we overflowed the current region.
+           (inst add ,result-tn ,result-tn ,temp-tn)
+           ;; 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 cmpw ,result-tn ,flag-tn)
+
+           (inst bng ,inline-alloc)
+           (inst tw :lge ,result-tn ,flag-tn))
+         (inst b ,fix-addr)
+
+         (emit-label ,inline-alloc)
+         (inst lr ,flag-tn (make-fixup "boxed_region" :foreign))
+         (inst stw ,result-tn ,flag-tn 0)
+
+         (emit-label ,fix-addr)
+         ;; 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-lowtag))
                                  &body body)
   "Do stuff to allocate an other-pointer object of fixed Size with a single
   word header having the specified Type-Code.  The result is placed in
   Result-TN, and Temp-TN is a non-descriptor temp (which may be randomly used
   by the body.)  The body is placed inside the PSEUDO-ATOMIC, and presumably
   initializes the object."
                                  &body body)
   "Do stuff to allocate an other-pointer object of fixed Size with a single
   word header having the specified Type-Code.  The result is placed in
   Result-TN, and Temp-TN is a non-descriptor temp (which may be randomly used
   by the body.)  The body is placed inside the PSEUDO-ATOMIC, and presumably
   initializes the object."
-  (unless body
-    (bug "empty &body in WITH-FIXED-ALLOCATION"))
   (once-only ((result-tn result-tn) (temp-tn temp-tn) (flag-tn flag-tn)
   (once-only ((result-tn result-tn) (temp-tn temp-tn) (flag-tn flag-tn)
-              (type-code type-code) (size size))
-    `(pseudo-atomic (,flag-tn :extra (pad-data-block ,size))
-       (inst ori ,result-tn alloc-tn other-pointer-lowtag)
-       (inst lr ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code))
-       (storew ,temp-tn ,result-tn 0 other-pointer-lowtag)
+              (type-code type-code) (size size) (lowtag lowtag))
+    `(pseudo-atomic (,flag-tn)
+       (allocation ,result-tn (pad-data-block ,size) ,lowtag
+                   :temp-tn ,temp-tn
+                   :flag-tn ,flag-tn)
+       (when ,type-code
+         (inst lr ,temp-tn (logior (ash (1- ,size) n-widetag-bits) ,type-code))
+         (storew ,temp-tn ,result-tn 0 ,lowtag))
        ,@body)))
 
 (defun align-csp (temp)
        ,@body)))
 
 (defun align-csp (temp)
 ;;; aligns ALLOC-TN again and (b) makes ALLOC-TN go negative. We then
 ;;; trap if ALLOC-TN's negative (handling the deferred interrupt) and
 ;;; using FLAG-TN - minus the large constant - to correct ALLOC-TN.
 ;;; aligns ALLOC-TN again and (b) makes ALLOC-TN go negative. We then
 ;;; trap if ALLOC-TN's negative (handling the deferred interrupt) and
 ;;; using FLAG-TN - minus the large constant - to correct ALLOC-TN.
-(defmacro pseudo-atomic ((flag-tn &key (extra 0)) &body forms)
-  (let ((n-extra (gensym)))
-    `(let ((,n-extra ,extra))
-       (without-scheduling ()
-        ;; Extra debugging stuff:
-        #+debug
-        (progn
-          (inst andi. ,flag-tn alloc-tn 7)
-          (inst twi :ne ,flag-tn 0))
-        (inst lr ,flag-tn (- ,n-extra 4))
-        (inst addi alloc-tn alloc-tn 4))
-      ,@forms
-      (without-scheduling ()
-       (inst add alloc-tn alloc-tn ,flag-tn)
-       (inst twi :lt alloc-tn 0))
-      #+debug
-      (progn
-        (inst andi. ,flag-tn alloc-tn 7)
-        (inst twi :ne ,flag-tn 0)))))
-
+(defmacro pseudo-atomic ((flag-tn) &body forms)
+  `(progn
+     (without-scheduling ()
+       ;; Extra debugging stuff:
+       #+debug
+       (progn
+         (inst andi. ,flag-tn alloc-tn 7)
+         (inst twi :ne ,flag-tn 0))
+       (inst ori alloc-tn alloc-tn 4))
+     ,@forms
+     (without-scheduling ()
+       (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)
+       (inst twi :ne ,flag-tn 0))))
 
 
 
 
 
 
index 21f330f..b410c4c 100644 (file)
   (:generator 20
     (move x arg)
     (let ((done (gen-label))
   (:generator 20
     (move x arg)
     (let ((done (gen-label))
-          (one-word (gen-label))
-          (initial-alloc (pad-data-block (1+ bignum-digits-offset))))
+          (one-word (gen-label)))
       (inst srawi. temp x 29)
       (inst slwi y x 2)
       (inst beq done)
 
       (inst srawi. temp x 29)
       (inst slwi y x 2)
       (inst beq done)
 
-      (pseudo-atomic (pa-flag :extra initial-alloc)
+      (with-fixed-allocation
+          (y pa-flag temp bignum-widetag (+ 2 bignum-digits-offset))
         (inst cmpwi x 0)
         (inst cmpwi x 0)
-        (inst ori y alloc-tn other-pointer-lowtag)
         (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
         (inst bge one-word)
         (inst li temp (logior (ash 1 n-widetag-bits) bignum-widetag))
         (inst bge one-word)
-        (inst addi alloc-tn alloc-tn
-              (- (pad-data-block (+ bignum-digits-offset 2))
-                 (pad-data-block (+ bignum-digits-offset 1))))
         (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
         (emit-label one-word)
         (storew temp y 0 other-pointer-lowtag)
         (inst li temp (logior (ash 2 n-widetag-bits) bignum-widetag))
         (emit-label one-word)
         (storew temp y 0 other-pointer-lowtag)
index 26d2e32..fce1a51 100644 (file)
 (def!constant n-byte-bits 8)
 
 
 (def!constant n-byte-bits 8)
 
 
+;;; The size in bytes of the GENCGC pages. Should be a multiple of the
+;;; architecture code size.
+(def!constant gencgc-page-size 4096)
+
+;;; flags for the generational garbage collector
+(def!constant pseudo-atomic-interrupted-flag 1)
+(def!constant pseudo-atomic-flag 4)
+
 (def!constant float-sign-shift 31)
 
 (def!constant single-float-bias 126)
 (def!constant float-sign-shift 31)
 
 (def!constant single-float-bias 126)
 
 #!+linux
 (progn
 
 #!+linux
 (progn
-  (def!constant dynamic-0-space-start #x50000000)
-  (def!constant dynamic-0-space-end   #x67fff000)
-  (def!constant dynamic-1-space-start #x68000000)
-  (def!constant dynamic-1-space-end   #x7ffff000)
+  #!+gencgc
+  (progn
+    (def!constant dynamic-space-start #x50000000)
+    (def!constant dynamic-space-end   #x7ffff000))
+  #!-gencgc
+  (progn
+    (def!constant dynamic-0-space-start #x50000000)
+    (def!constant dynamic-0-space-end   #x67fff000)
+    (def!constant dynamic-1-space-start #x68000000)
+    (def!constant dynamic-1-space-end   #x7ffff000))
 
   (def!constant linkage-table-space-start #x0a000000)
   (def!constant linkage-table-space-end   #x0b000000)
 
   (def!constant linkage-table-space-start #x0a000000)
   (def!constant linkage-table-space-end   #x0b000000)
 
 #!+darwin
 (progn
 
 #!+darwin
 (progn
-  ;;; nothing _seems_ to be using these addresses
-  (def!constant dynamic-0-space-start #x10000000)
-  (def!constant dynamic-0-space-end   #x3ffff000)
-  (def!constant dynamic-1-space-start #x40000000)
-  (def!constant dynamic-1-space-end   #x6ffff000)
+  #!+gencgc
+  (progn
+    (def!constant dynamic-space-start #x10000000)
+    (def!constant dynamic-space-end   #x6ffff000))
+  #!-gencgc
+  (progn
+    (def!constant dynamic-0-space-start #x10000000)
+    (def!constant dynamic-0-space-end   #x3ffff000)
+
+    (def!constant dynamic-1-space-start #x40000000)
+    (def!constant dynamic-1-space-end   #x6ffff000))
+
 
   (def!constant linkage-table-space-start #x0a000000)
   (def!constant linkage-table-space-end   #x0b000000)
 
   (def!constant linkage-table-space-start #x0a000000)
   (def!constant linkage-table-space-end   #x0b000000)
     sb!unix::*interrupts-enabled*
     sb!unix::*interrupt-pending*
     *gc-inhibit*
     sb!unix::*interrupts-enabled*
     sb!unix::*interrupt-pending*
     *gc-inhibit*
-    *gc-pending*))
+    *gc-pending*
+
+    *restart-lisp-function*
+
+    ;; CLH: 20060210 Taken from x86-64/parms.lisp per JES' suggestion
+    ;; Needed for callbacks to work across saving cores. see
+    ;; ALIEN-CALLBACK-ASSEMBLER-WRAPPER in c-call.lisp for gory
+    ;; details.
+    sb!alien::*enter-alien-callback*))
 
 (defparameter *static-funs*
   '(length
 
 (defparameter *static-funs*
   '(length
index 2dfdbc9..f9a1db3 100644 (file)
@@ -28,7 +28,10 @@ CPPFLAGS += -no-cpp-precomp
 # out of this range.
 LINKFLAGS += -dynamic `cat ppc-darwin-link-flags` -twolevel_namespace -bind_at_load
 
 # out of this range.
 LINKFLAGS += -dynamic `cat ppc-darwin-link-flags` -twolevel_namespace -bind_at_load
 
-GC_SRC = cheneygc.c
+GC_SRC = $(shell if grep LISP_FEATURE_GENCGC genesis/config.h \
+                      > /dev/null 2>&1; \
+                   then echo "gencgc.c"; \
+                   else echo "cheneygc.c" ; fi)
 
 OS_CLEAN_FILES += ppc-darwin-mkrospace ppc-darwin-fix-rospace ppc-darwin-link-flags
 
 
 OS_CLEAN_FILES += ppc-darwin-mkrospace ppc-darwin-fix-rospace ppc-darwin-link-flags
 
index a2c5a17..cce5c4c 100644 (file)
@@ -19,7 +19,10 @@ ARCH_SRC = ppc-arch.c
 OS_SRC = linux-os.c ppc-linux-os.c
 OS_LIBS = -ldl
 
 OS_SRC = linux-os.c ppc-linux-os.c
 OS_LIBS = -ldl
 
-GC_SRC = cheneygc.c
+GC_SRC = $(shell if grep LISP_FEATURE_GENCGC genesis/config.h \
+                      > /dev/null 2>&1; \
+                   then echo "gencgc.c"; \
+                   else echo "cheneygc.c" ; fi)
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
 
 # Nothing to do for after-grovel-headers.
 .PHONY: after-grovel-headers
index 8296947..e10634d 100644 (file)
@@ -43,15 +43,33 @@ pa_alloc(int bytes)
     struct thread *th = arch_os_get_current_thread();
 
     /* FIXME: OOAO violation: see arch_pseudo_* */
     struct thread *th = arch_os_get_current_thread();
 
     /* FIXME: OOAO violation: see arch_pseudo_* */
-    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),th);
-    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1),th);
+    clear_pseudo_atomic_interrupted(th);
+    set_pseudo_atomic_atomic(th);
     result = alloc(bytes);
     result = alloc(bytes);
-    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0),th);
-    if (fixnum_value(SymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th)))
-        /* Even if we gc at this point, the new allocation will be
-         * protected from being moved, because result is on the c stack
-         * and points to it. */
+    clear_pseudo_atomic_atomic(th);
+
+    if (get_pseudo_atomic_interrupted(th)) {
+        /* WARNING KLUDGE FIXME: pa_alloc() is not pseudo-atomic on
+         * anything but x86[-64]. maybe_defer_handler doesn't defer
+         * interrupts if foreign_function_call_active
+         *
+         * If the C stack is not scavenged during GC, result needs to
+         * be protected against not being referred to by any roots, so
+         * we push it onto the lisp control stack, and read it back
+         * off after any potential GC has finished */
+#ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+#ifdef LISP_FEATURE_STACK_GROWS_DOWNARD_NOT_UPWARD
+#error "!C_STACK_IS_CONTROL_STACK and STACK_GROWS_DOWNWARD_NOT_UPWARD is not supported"
+#endif
+        current_control_stack_pointer += 1;
+        *current_control_stack_pointer = result;
+#endif
         do_pending_interrupt();
         do_pending_interrupt();
+#ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+        result = *current_control_stack_pointer;
+        current_control_stack_pointer -= 1;
+#endif
+    }
 #else
     /* FIXME: this is not pseudo atomic at all, but is called only from
      * interrupt safe places like interrupt handlers. MG - 2005-08-09 */
 #else
     /* FIXME: this is not pseudo atomic at all, but is called only from
      * interrupt safe places like interrupt handlers. MG - 2005-08-09 */
index 339ff80..91878cd 100644 (file)
@@ -115,6 +115,11 @@ void arch_set_pseudo_atomic_interrupted(os_context_t *context)
     *os_context_register_addr(context,reg_ALLOC) |=  (1L<<63);
 }
 
     *os_context_register_addr(context,reg_ALLOC) |=  (1L<<63);
 }
 
+void arch_clear_pseudo_atomic_interrupted(os_context_t *context)
+{
+    *os_context_register_addr(context, reg_ALLOC) &= ~(1L<<63);
+}
+
 unsigned int arch_install_breakpoint(void *pc)
 {
     unsigned int *ptr = (unsigned int *)pc;
 unsigned int arch_install_breakpoint(void *pc)
 {
     unsigned int *ptr = (unsigned int *)pc;
index 147bd0f..d94656b 100644 (file)
@@ -43,4 +43,7 @@ extern lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1,
                         lispobj arg2);
 extern lispobj *component_ptr_from_pc(lispobj *pc);
 
                         lispobj arg2);
 extern lispobj *component_ptr_from_pc(lispobj *pc);
 
+extern void fpu_save(void *);
+extern void fpu_restore(void *);
+
 #endif /* __ARCH_H__ */
 #endif /* __ARCH_H__ */
index 7e9d51f..9b496c3 100644 (file)
@@ -188,25 +188,25 @@ is_valid_lisp_addr(os_vm_address_t addr)
 static void
 memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context)
 {
 static void
 memory_fault_handler(int signal, siginfo_t *siginfo, void *void_context)
 {
-    /* The way that we extract low level information like the fault
-     * address is not specified by POSIX. */
-#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
-    void *fault_addr = siginfo->si_addr;
-#elif defined LISP_FEATURE_DARWIN
-    void *fault_addr = siginfo->si_addr;
-#else
-#error unsupported BSD variant
-#endif
-
     os_context_t *context = arch_os_get_context(&void_context);
     os_context_t *context = arch_os_get_context(&void_context);
+    void *fault_addr = arch_get_bad_addr(signal, siginfo, context);
+
     if (!gencgc_handle_wp_violation(fault_addr))
     if (!gencgc_handle_wp_violation(fault_addr))
-        if(!handle_guard_page_triggered(context,fault_addr))
+        if(!handle_guard_page_triggered(context,fault_addr)) {
 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
             arrange_return_to_lisp_function(context, SymbolFunction(MEMORY_FAULT_ERROR));
 #else
 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
             arrange_return_to_lisp_function(context, SymbolFunction(MEMORY_FAULT_ERROR));
 #else
-            interrupt_handle_now(signal, siginfo, context);
+            if (!interrupt_maybe_gc_int(signal, siginfo, context)) {
+                interrupt_handle_now(signal, siginfo, context);
+            }
+#if defined(LISP_FEATURE_DARWIN)
+            /* Work around G5 bug; fix courtesy gbyers */
+            DARWIN_FIX_CONTEXT(context);
 #endif
 #endif
+#endif
+        }
 }
 }
+
 void
 os_install_interrupt_handlers(void)
 {
 void
 os_install_interrupt_handlers(void)
 {
index 68c8004..60bd5af 100644 (file)
@@ -47,7 +47,6 @@ lispobj *new_space;
 lispobj *new_space_free_pointer;
 
 static void scavenge_newspace(void);
 lispobj *new_space_free_pointer;
 
 static void scavenge_newspace(void);
-static void scavenge_interrupt_contexts(void);
 
 extern unsigned long bytes_consed_between_gcs;
 
 
 extern unsigned long bytes_consed_between_gcs;
 
index cdbefd4..992e365 100644 (file)
@@ -187,8 +187,8 @@ scavenge(lispobj *start, long n_words)
                 (scavtab[widetag_of(object)])(object_ptr, object);
         }
     }
                 (scavtab[widetag_of(object)])(object_ptr, object);
         }
     }
-    gc_assert_verbose(object_ptr == end, "Final object pointer %p, end %p\n",
-                      object_ptr, end);
+    gc_assert_verbose(object_ptr == end, "Final object pointer %p, start %p, end %p\n",
+                      object_ptr, start, end);
 }
 
 static lispobj trans_fun_header(lispobj object); /* forward decls */
 }
 
 static lispobj trans_fun_header(lispobj object); /* forward decls */
@@ -320,8 +320,12 @@ trans_code(struct code *code)
     os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
                     ncode_words * sizeof(long));
 
     os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
                     ncode_words * sizeof(long));
 
+#endif
+
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     gencgc_apply_code_fixups(code, new_code);
 #endif
     gencgc_apply_code_fixups(code, new_code);
 #endif
+
     return new_code;
 }
 
     return new_code;
 }
 
@@ -698,7 +702,7 @@ size_boxed(lispobj *where)
 
 /* Note: on the sparc we don't have to do anything special for fdefns, */
 /* 'cause the raw-addr has a function lowtag. */
 
 /* Note: on the sparc we don't have to do anything special for fdefns, */
 /* 'cause the raw-addr has a function lowtag. */
-#ifndef LISP_FEATURE_SPARC
+#if !defined(LISP_FEATURE_SPARC)
 static long
 scav_fdefn(lispobj *where, lispobj object)
 {
 static long
 scav_fdefn(lispobj *where, lispobj object)
 {
@@ -1715,7 +1719,7 @@ gc_init_tables(void)
     scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
     scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
     scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
     scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
     scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
     scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
-#ifndef LISP_FEATURE_GENCGC     /* FIXME ..._X86 ? */
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
     scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
     scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
 #endif
     scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
     scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
 #endif
@@ -1733,7 +1737,7 @@ gc_init_tables(void)
     scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
     scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
     scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
     scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
     scavtab[NO_TLS_VALUE_MARKER_WIDETAG] = scav_immediate;
     scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
-#ifdef LISP_FEATURE_SPARC
+#if defined(LISP_FEATURE_SPARC)
     scavtab[FDEFN_WIDETAG] = scav_boxed;
 #else
     scavtab[FDEFN_WIDETAG] = scav_fdefn;
     scavtab[FDEFN_WIDETAG] = scav_boxed;
 #else
     scavtab[FDEFN_WIDETAG] = scav_fdefn;
index f04bf6e..6645871 100644 (file)
@@ -69,7 +69,11 @@ NWORDS(unsigned long x, unsigned long n_bits)
  * for SPARC users in that bit
  */
 
  * for SPARC users in that bit
  */
 
+#if defined(LISP_FEATURE_SPARC)
+#define FUN_RAW_ADDR_OFFSET 0
+#else
 #define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG)
 #define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG)
+#endif
 
 /* values for the *_alloc_* parameters */
 #define FREE_PAGE_FLAG 0
 
 /* values for the *_alloc_* parameters */
 #define FREE_PAGE_FLAG 0
@@ -90,6 +94,7 @@ extern long (*sizetab[256])(lispobj *where);
 extern struct weak_pointer *weak_pointers; /* in gc-common.c */
 
 extern void scavenge(lispobj *start, long n_words);
 extern struct weak_pointer *weak_pointers; /* in gc-common.c */
 
 extern void scavenge(lispobj *start, long n_words);
+extern void scavenge_interrupt_contexts(void);
 extern void scan_weak_pointers(void);
 
 lispobj  copy_large_unboxed_object(lispobj object, long nwords);
 extern void scan_weak_pointers(void);
 
 lispobj  copy_large_unboxed_object(lispobj object, long nwords);
index 90e94bf..2929013 100644 (file)
@@ -33,4 +33,54 @@ extern int maybe_gc_pending;
 
 #include "fixnump.h"
 
 
 #include "fixnump.h"
 
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
+#define set_alloc_pointer(value)                \
+    SetSymbolValue(ALLOCATION_POINTER, value, 0)
+#define get_alloc_pointer()                     \
+    SymbolValue(ALLOCATION_POINTER, 0)
+#define get_binding_stack_pointer(thread)       \
+    SymbolValue(BINDING_STACK_POINTER, thread)
+#define get_pseudo_atomic_atomic(thread)        \
+    SymbolValue(PSEUDO_ATOMIC_ATOMIC, thread)
+#define set_pseudo_atomic_atomic(thread)                                \
+    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1), thread);
+#define clear_pseudo_atomic_atomic(thread)                      \
+    SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0), thread);
+#define get_pseudo_atomic_interrupted(thread)                   \
+    fixnum_value(SymbolValue(PSEUDO_ATOMIC_INTERRUPTED, thread))
+#define clear_pseudo_atomic_interrupted(thread)                         \
+    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0), thread)
+#define set_pseudo_atomic_interrupted(thread)                           \
+    SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1), thread)
+
+#elif defined(LISP_FEATURE_PPC) && defined(LISP_FEATURE_GENCGC)
+
+#define set_alloc_pointer(value) \
+    (dynamic_space_free_pointer =                                       \
+     (value) | (((unsigned long)dynamic_space_free_pointer) & LOWTAG_MASK))
+
+#define get_alloc_pointer()                                     \
+    ((unsigned long) dynamic_space_free_pointer & ~LOWTAG_MASK)
+#define get_binding_stack_pointer(thread)       \
+    (current_binding_stack_pointer)
+#define get_pseudo_atomic_atomic(thread)                                \
+    ((unsigned long)dynamic_space_free_pointer & flag_PseudoAtomic)
+#define set_pseudo_atomic_atomic(thread)                                \
+    (dynamic_space_free_pointer                                         \
+     = (lispobj*) ((unsigned long)dynamic_space_free_pointer | flag_PseudoAtomic))
+#define clear_pseudo_atomic_atomic(thread)                              \
+    (dynamic_space_free_pointer                                         \
+     = (lispobj*) ((unsigned long) dynamic_space_free_pointer & ~flag_PseudoAtomic))
+#define get_pseudo_atomic_interrupted(thread)                           \
+    ((unsigned long) dynamic_space_free_pointer & flag_PseudoAtomicInterrupted)
+#define clear_pseudo_atomic_interrupted(thread)                         \
+    (dynamic_space_free_pointer                                         \
+     = (lispobj*) ((unsigned long) dynamic_space_free_pointer & ~flag_PseudoAtomicInterrupted))
+#define set_pseudo_atomic_interrupted(thread)                           \
+    (dynamic_space_free_pointer                                         \
+     = (lispobj*) ((unsigned long) dynamic_space_free_pointer | flag_PseudoAtomicInterrupted))
+
+#endif
+
 #endif /* _GC_H_ */
 #endif /* _GC_H_ */
index 837ada6..596ebba 100644 (file)
@@ -348,15 +348,20 @@ gen_av_mem_age(generation_index_t gen)
         / ((double)generations[gen].bytes_allocated);
 }
 
         / ((double)generations[gen].bytes_allocated);
 }
 
-void fpu_save(int *);           /* defined in x86-assem.S */
-void fpu_restore(int *);        /* defined in x86-assem.S */
 /* The verbose argument controls how much to print: 0 for normal
  * level of detail; 1 for debugging. */
 static void
 print_generation_stats(int verbose) /* FIXME: should take FILE argument */
 {
     generation_index_t i, gens;
 /* The verbose argument controls how much to print: 0 for normal
  * level of detail; 1 for debugging. */
 static void
 print_generation_stats(int verbose) /* FIXME: should take FILE argument */
 {
     generation_index_t i, gens;
-    int fpu_state[27];
+
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+#define FPU_STATE_SIZE 27
+    int fpu_state[FPU_STATE_SIZE];
+#elif defined(LISP_FEATURE_PPC)
+#define FPU_STATE_SIZE 32
+    long long fpu_state[FPU_STATE_SIZE];
+#endif
 
     /* This code uses the FP instructions which may be set up for Lisp
      * so they need to be saved and reset for C. */
 
     /* This code uses the FP instructions which may be set up for Lisp
      * so they need to be saved and reset for C. */
@@ -370,7 +375,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */
 
     /* Print the heap stats. */
     fprintf(stderr,
 
     /* Print the heap stats. */
     fprintf(stderr,
-            "   Gen Boxed Unboxed LB   LUB  !move  Alloc  Waste   Trig    WP  GCs Mem-age\n");
+            " Gen StaPg UbSta LaSta LUbSt Boxed Unboxed LB   LUB  !move  Alloc  Waste   Trig    WP  GCs Mem-age\n");
 
     for (i = 0; i < gens; i++) {
         page_index_t j;
 
     for (i = 0; i < gens; i++) {
         page_index_t j;
@@ -405,8 +410,12 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */
         gc_assert(generations[i].bytes_allocated
                   == count_generation_bytes_allocated(i));
         fprintf(stderr,
         gc_assert(generations[i].bytes_allocated
                   == count_generation_bytes_allocated(i));
         fprintf(stderr,
-                "   %1d: %5ld %5ld %5ld %5ld %5ld %8ld %5ld %8ld %4ld %3d %7.4f\n",
+                "   %1d: %5ld %5ld %5ld %5ld %5ld %5ld %5ld %5ld %8ld %5ld %8ld %4ld %3d %7.4f\n",
                 i,
                 i,
+                generations[i].alloc_start_page,
+                generations[i].alloc_unboxed_start_page,
+                generations[i].alloc_large_start_page,
+                generations[i].alloc_large_unboxed_start_page,
                 boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,
                 pinned_cnt,
                 generations[i].bytes_allocated,
                 boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,
                 pinned_cnt,
                 generations[i].bytes_allocated,
@@ -423,7 +432,9 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */
 }
 \f
 
 }
 \f
 
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 void fast_bzero(void*, size_t); /* in <arch>-assem.S */
 void fast_bzero(void*, size_t); /* in <arch>-assem.S */
+#endif
 
 /* Zero the pages from START to END (inclusive), but use mmap/munmap instead
  * if zeroing it ourselves, i.e. in practice give the memory back to the
 
 /* Zero the pages from START to END (inclusive), but use mmap/munmap instead
  * if zeroing it ourselves, i.e. in practice give the memory back to the
@@ -456,7 +467,12 @@ zero_pages(page_index_t start, page_index_t end) {
     if (start > end)
       return;
 
     if (start > end)
       return;
 
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     fast_bzero(page_address(start), PAGE_BYTES*(1+end-start));
     fast_bzero(page_address(start), PAGE_BYTES*(1+end-start));
+#else
+    bzero(page_address(start), PAGE_BYTES*(1+end-start));
+#endif
+
 }
 
 /* Zero the pages from START to END (inclusive), except for those
 }
 
 /* Zero the pages from START to END (inclusive), except for those
@@ -633,9 +649,8 @@ gc_alloc_new_region(long nbytes, int unboxed, struct alloc_region *alloc_region)
     /* Bump up last_free_page. */
     if (last_page+1 > last_free_page) {
         last_free_page = last_page+1;
     /* Bump up last_free_page. */
     if (last_page+1 > last_free_page) {
         last_free_page = last_page+1;
-        SetSymbolValue(ALLOCATION_POINTER,
-                       (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),
-                       0);
+        /* do we only want to call this on special occasions? like for boxed_region? */
+        set_alloc_pointer((lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES));
     }
     thread_mutex_unlock(&free_pages_lock);
 
     }
     thread_mutex_unlock(&free_pages_lock);
 
@@ -1010,8 +1025,7 @@ gc_alloc_large(long nbytes, int unboxed, struct alloc_region *alloc_region)
     /* Bump up last_free_page */
     if (last_page+1 > last_free_page) {
         last_free_page = last_page+1;
     /* Bump up last_free_page */
     if (last_page+1 > last_free_page) {
         last_free_page = last_page+1;
-        SetSymbolValue(ALLOCATION_POINTER,
-                       (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),0);
+        set_alloc_pointer((lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES));
     }
     thread_mutex_unlock(&free_pages_lock);
 
     }
     thread_mutex_unlock(&free_pages_lock);
 
@@ -1804,6 +1818,8 @@ trans_unboxed_large(lispobj object)
 /* FIXME: What does this mean? */
 int gencgc_hash = 1;
 
 /* FIXME: What does this mean? */
 int gencgc_hash = 1;
 
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
 static long
 scav_vector(lispobj *where, lispobj object)
 {
 static long
 scav_vector(lispobj *where, lispobj object)
 {
@@ -2010,6 +2026,19 @@ scav_vector(lispobj *where, lispobj object)
     return (CEILING(kv_length + 2, 2));
 }
 
     return (CEILING(kv_length + 2, 2));
 }
 
+#else
+
+static long
+scav_vector(lispobj *where, lispobj object)
+{
+    if (HeaderValue(object) == subtype_VectorValidHashing) {
+        *where =
+            (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
+    }
+    return 1;
+}
+
+#endif
 
 \f
 /*
 
 \f
 /*
@@ -2371,6 +2400,8 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
     return 1;
 }
 
     return 1;
 }
 
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
 /* Adjust large bignum and vector objects. This will adjust the
  * allocated region if the size has shrunk, and move unboxed objects
  * into unboxed pages. The pages are not promoted here, and the
 /* Adjust large bignum and vector objects. This will adjust the
  * allocated region if the size has shrunk, and move unboxed objects
  * into unboxed pages. The pages are not promoted here, and the
@@ -2545,6 +2576,8 @@ maybe_adjust_large_object(lispobj *where)
     return;
 }
 
     return;
 }
 
+#endif
+
 /* Take a possible pointer to a Lisp object and mark its page in the
  * page_table so that it will not be relocated during a GC.
  *
 /* Take a possible pointer to a Lisp object and mark its page in the
  * page_table so that it will not be relocated during a GC.
  *
@@ -2557,6 +2590,9 @@ maybe_adjust_large_object(lispobj *where)
  *
  * It is also assumed that the current gc_alloc() region has been
  * flushed and the tables updated. */
  *
  * It is also assumed that the current gc_alloc() region has been
  * flushed and the tables updated. */
+
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
 static void
 preserve_pointer(void *addr)
 {
 static void
 preserve_pointer(void *addr)
 {
@@ -2672,6 +2708,9 @@ preserve_pointer(void *addr)
     /* Check that the page is now static. */
     gc_assert(page_table[addr_page_index].dont_move != 0);
 }
     /* Check that the page is now static. */
     gc_assert(page_table[addr_page_index].dont_move != 0);
 }
+
+#endif
+
 \f
 /* If the given page is not write-protected, then scan it for pointers
  * to younger generations or the top temp. generation, if no
 \f
 /* If the given page is not write-protected, then scan it for pointers
  * to younger generations or the top temp. generation, if no
@@ -3193,7 +3232,12 @@ print_ptr(lispobj *addr)
 }
 #endif
 
 }
 #endif
 
-extern long undefined_tramp;
+#if defined(LISP_FEATURE_PPC)
+extern int closure_tramp;
+extern int undefined_tramp;
+#else
+extern int undefined_tramp;
+#endif
 
 static void
 verify_space(lispobj *start, size_t words)
 
 static void
 verify_space(lispobj *start, size_t words)
@@ -3249,8 +3293,14 @@ verify_space(lispobj *start, size_t words)
                 */
             } else {
                 /* Verify that it points to another valid space. */
                 */
             } else {
                 /* Verify that it points to another valid space. */
-                if (!to_readonly_space && !to_static_space
-                    && (thing != (unsigned long)&undefined_tramp)) {
+                if (!to_readonly_space && !to_static_space &&
+#if defined(LISP_FEATURE_PPC)
+                    !((thing == &closure_tramp) ||
+                      (thing == &undefined_tramp))
+#else
+                    thing != (unsigned long)&undefined_tramp
+#endif
+                    ) {
                     lose("Ptr %x @ %x sees junk.\n", thing, start);
                 }
             }
                     lose("Ptr %x @ %x sees junk.\n", thing, start);
                 }
             }
@@ -3435,6 +3485,10 @@ verify_space(lispobj *start, size_t words)
                     break;
 
                 default:
                     break;
 
                 default:
+                    FSHOW((stderr,
+                           "/Unhandled widetag 0x%x at 0x%x\n",
+                           widetag_of(*start), start));
+                    fflush(stderr);
                     gc_abort();
                 }
             }
                     gc_abort();
                 }
             }
@@ -3462,7 +3516,7 @@ verify_gc(void)
     struct thread *th;
     for_each_thread(th) {
     long binding_stack_size =
     struct thread *th;
     for_each_thread(th) {
     long binding_stack_size =
-            (lispobj*)SymbolValue(BINDING_STACK_POINTER,th)
+        (lispobj*)get_binding_stack_pointer(th)
             - (lispobj*)th->binding_stack_start;
         verify_space(th->binding_stack_start, binding_stack_size);
     }
             - (lispobj*)th->binding_stack_start;
         verify_space(th->binding_stack_start, binding_stack_size);
     }
@@ -3611,6 +3665,158 @@ write_protect_generation_pages(generation_index_t generation)
     }
 }
 
     }
 }
 
+static void
+scavenge_control_stack()
+{
+    unsigned long control_stack_size;
+
+    /* This is going to be a big problem when we try to port threads
+     * to PPC... CLH */
+    struct thread *th = arch_os_get_current_thread();
+    lispobj *control_stack =
+        (lispobj *)(th->control_stack_start);
+
+    control_stack_size = current_control_stack_pointer - control_stack;
+    scavenge(control_stack, control_stack_size);
+}
+
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+/* Scavenging Interrupt Contexts */
+
+static int boxed_registers[] = BOXED_REGISTERS;
+
+static void
+scavenge_interrupt_context(os_context_t * context)
+{
+    int i;
+
+#ifdef reg_LIP
+    unsigned long lip;
+    unsigned long lip_offset;
+    int lip_register_pair;
+#endif
+    unsigned long pc_code_offset;
+
+#ifdef ARCH_HAS_LINK_REGISTER
+    unsigned long lr_code_offset;
+#endif
+#ifdef ARCH_HAS_NPC_REGISTER
+    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 = *os_context_register_addr(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 = *os_context_register_addr(context, index);
+        if ((reg & ~((1L<<N_LOWTAG_BITS)-1)) <= 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 = *os_context_pc_addr(context) - *os_context_register_addr(context, reg_CODE);
+#ifdef ARCH_HAS_NPC_REGISTER
+    npc_code_offset = *os_context_npc_addr(context) - *os_context_register_addr(context, reg_CODE);
+#endif /* ARCH_HAS_NPC_REGISTER */
+
+#ifdef ARCH_HAS_LINK_REGISTER
+    lr_code_offset =
+        *os_context_lr_addr(context) -
+        *os_context_register_addr(context, reg_CODE);
+#endif
+
+    /* 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 = *os_context_register_addr(context, index);
+        scavenge(&foo, 1);
+        *os_context_register_addr(context, index) = foo;
+
+        scavenge((lispobj*) &(*os_context_register_addr(context, index)), 1);
+    }
+
+#ifdef reg_LIP
+    /* Fix the LIP */
+
+    /*
+     * But what happens if lip_register_pair is -1?  *os_context_register_addr 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) {
+        *os_context_register_addr(context, reg_LIP) =
+            *os_context_register_addr(context, lip_register_pair) + lip_offset;
+    }
+#endif /* reg_LIP */
+
+    /* Fix the PC if it was in from space */
+    if (from_space_p(*os_context_pc_addr(context)))
+        *os_context_pc_addr(context) = *os_context_register_addr(context, reg_CODE) + pc_code_offset;
+
+#ifdef ARCH_HAS_LINK_REGISTER
+    /* Fix the LR ditto; important if we're being called from
+     * an assembly routine that expects to return using blr, otherwise
+     * harmless */
+    if (from_space_p(*os_context_lr_addr(context)))
+        *os_context_lr_addr(context) =
+            *os_context_register_addr(context, reg_CODE) + lr_code_offset;
+#endif
+
+#ifdef ARCH_HAS_NPC_REGISTER
+    if (from_space_p(*os_context_npc_addr(context)))
+        *os_context_npc_addr(context) = *os_context_register_addr(context, reg_CODE) + npc_code_offset;
+#endif /* ARCH_HAS_NPC_REGISTER */
+}
+
+void
+scavenge_interrupt_contexts(void)
+{
+    int i, index;
+    os_context_t *context;
+
+    struct thread *th=arch_os_get_current_thread();
+
+    index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,0));
+
+#if defined(DEBUG_PRINT_CONTEXT_INDEX)
+    printf("Number of active contexts: %d\n", index);
+#endif
+
+    for (i = 0; i < index; i++) {
+        context = th->interrupt_contexts[i];
+        scavenge_interrupt_context(context);
+    }
+}
+
+#endif
+
 /* Garbage collect a generation. If raise is 0 then the remains of the
  * generation are not raised to the next generation. */
 static void
 /* Garbage collect a generation. If raise is 0 then the remains of the
  * generation are not raised to the next generation. */
 static void
@@ -3679,6 +3885,7 @@ garbage_collect_generation(generation_index_t generation, int raise)
      * initiates GC.  If you ever call GC from inside an altstack
      * handler, you will lose. */
 
      * initiates GC.  If you ever call GC from inside an altstack
      * handler, you will lose. */
 
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     /* And if we're saving a core, there's no point in being conservative. */
     if (conservative_stack) {
         for_each_thread(th) {
     /* And if we're saving a core, there's no point in being conservative. */
     if (conservative_stack) {
         for_each_thread(th) {
@@ -3713,6 +3920,8 @@ garbage_collect_generation(generation_index_t generation, int raise)
             }
         }
     }
             }
         }
     }
+#endif
+
 #ifdef QSHOW
     if (gencgc_verbose > 1) {
         long num_dont_move_pages = count_dont_move_pages();
 #ifdef QSHOW
     if (gencgc_verbose > 1) {
         long num_dont_move_pages = count_dont_move_pages();
@@ -3725,6 +3934,15 @@ garbage_collect_generation(generation_index_t generation, int raise)
 
     /* Scavenge all the rest of the roots. */
 
 
     /* Scavenge all the rest of the roots. */
 
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+    /*
+     * If not x86, we need to scavenge the interrupt context(s) and the
+     * control stack.
+     */
+    scavenge_interrupt_contexts();
+    scavenge_control_stack();
+#endif
+
     /* Scavenge the Lisp functions of the interrupt handlers, taking
      * care to avoid SIG_DFL and SIG_IGN. */
     for (i = 0; i < NSIG; i++) {
     /* Scavenge the Lisp functions of the interrupt handlers, taking
      * care to avoid SIG_DFL and SIG_IGN. */
     for (i = 0; i < NSIG; i++) {
@@ -3738,7 +3956,7 @@ garbage_collect_generation(generation_index_t generation, int raise)
     {
         struct thread *th;
         for_each_thread(th) {
     {
         struct thread *th;
         for_each_thread(th) {
-            long len= (lispobj *)SymbolValue(BINDING_STACK_POINTER,th) -
+            long len= (lispobj *)get_binding_stack_pointer(th) -
                 th->binding_stack_start;
             scavenge((lispobj *) th->binding_stack_start,len);
 #ifdef LISP_FEATURE_SB_THREAD
                 th->binding_stack_start;
             scavenge((lispobj *) th->binding_stack_start,len);
 #ifdef LISP_FEATURE_SB_THREAD
@@ -3876,8 +4094,7 @@ update_dynamic_space_free_pointer(void)
 
     last_free_page = last_page+1;
 
 
     last_free_page = last_page+1;
 
-    SetSymbolValue(ALLOCATION_POINTER,
-                   (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),0);
+    set_alloc_pointer((lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES));
     return 0; /* dummy value: return something ... */
 }
 
     return 0; /* dummy value: return something ... */
 }
 
@@ -4028,7 +4245,9 @@ collect_garbage(generation_index_t last_gen)
     /* Save the high-water mark before updating last_free_page */
     if (last_free_page > high_water_mark)
         high_water_mark = last_free_page;
     /* Save the high-water mark before updating last_free_page */
     if (last_free_page > high_water_mark)
         high_water_mark = last_free_page;
+
     update_dynamic_space_free_pointer();
     update_dynamic_space_free_pointer();
+
     auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
     if(gencgc_verbose)
         fprintf(stderr,"Next gc when %ld bytes have been consed\n",
     auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
     if(gencgc_verbose)
         fprintf(stderr,"Next gc when %ld bytes have been consed\n",
@@ -4130,7 +4349,7 @@ gc_free_heap(void)
     gc_set_region_empty(&unboxed_region);
 
     last_free_page = 0;
     gc_set_region_empty(&unboxed_region);
 
     last_free_page = 0;
-    SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base),0);
+    set_alloc_pointer((lispobj)((char *)heap_base));
 
     if (verify_after_free_heap) {
         /* Check whether purify has left any bad pointers. */
 
     if (verify_after_free_heap) {
         /* Check whether purify has left any bad pointers. */
@@ -4199,7 +4418,7 @@ static void
 gencgc_pickup_dynamic(void)
 {
     page_index_t page = 0;
 gencgc_pickup_dynamic(void)
 {
     page_index_t page = 0;
-    long alloc_ptr = SymbolValue(ALLOCATION_POINTER,0);
+    long alloc_ptr = get_alloc_pointer();
     lispobj *prev=(lispobj *)page_address(page);
     generation_index_t gen = PSEUDO_STATIC_GENERATION;
 
     lispobj *prev=(lispobj *)page_address(page);
     generation_index_t gen = PSEUDO_STATIC_GENERATION;
 
@@ -4266,16 +4485,18 @@ alloc(long nbytes)
     void *new_obj;
     void *new_free_pointer;
     gc_assert(nbytes>0);
     void *new_obj;
     void *new_free_pointer;
     gc_assert(nbytes>0);
+
     /* Check for alignment allocation problems. */
     gc_assert((((unsigned long)region->free_pointer & LOWTAG_MASK) == 0)
               && ((nbytes & LOWTAG_MASK) == 0));
     /* Check for alignment allocation problems. */
     gc_assert((((unsigned long)region->free_pointer & LOWTAG_MASK) == 0)
               && ((nbytes & LOWTAG_MASK) == 0));
+
 #if 0
     if(all_threads)
         /* there are a few places in the C code that allocate data in the
          * heap before Lisp starts.  This is before interrupts are enabled,
          * so we don't need to check for pseudo-atomic */
 #ifdef LISP_FEATURE_SB_THREAD
 #if 0
     if(all_threads)
         /* there are a few places in the C code that allocate data in the
          * heap before Lisp starts.  This is before interrupts are enabled,
          * so we don't need to check for pseudo-atomic */
 #ifdef LISP_FEATURE_SB_THREAD
-        if(!SymbolValue(PSEUDO_ATOMIC_ATOMIC,th)) {
+        if(!get_psuedo_atomic_atomic(th)) {
             register u32 fs;
             fprintf(stderr, "fatal error in thread 0x%x, tid=%ld\n",
                     th,th->os_thread);
             register u32 fs;
             fprintf(stderr, "fatal error in thread 0x%x, tid=%ld\n",
                     th,th->os_thread);
@@ -4285,7 +4506,7 @@ alloc(long nbytes)
             lose("If you see this message before 2004.01.31, mail details to sbcl-devel\n");
         }
 #else
             lose("If you see this message before 2004.01.31, mail details to sbcl-devel\n");
         }
 #else
-    gc_assert(SymbolValue(PSEUDO_ATOMIC_ATOMIC,th));
+    gc_assert(get_pseudo_atomic_atomic(th));
 #endif
 #endif
 
 #endif
 #endif
 
@@ -4301,7 +4522,7 @@ alloc(long nbytes)
      * we should GC in the near future
      */
     if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) {
      * we should GC in the near future
      */
     if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) {
-        gc_assert(fixnum_value(SymbolValue(PSEUDO_ATOMIC_ATOMIC,thread)));
+        gc_assert(get_pseudo_atomic_atomic(thread));
         /* Don't flood the system with interrupts if the need to gc is
          * already noted. This can happen for example when SUB-GC
          * allocates or after a gc triggered in a WITHOUT-GCING. */
         /* Don't flood the system with interrupts if the need to gc is
          * already noted. This can happen for example when SUB-GC
          * allocates or after a gc triggered in a WITHOUT-GCING. */
@@ -4310,7 +4531,7 @@ alloc(long nbytes)
              * section */
             SetSymbolValue(GC_PENDING,T,thread);
             if (SymbolValue(GC_INHIBIT,thread) == NIL)
              * section */
             SetSymbolValue(GC_PENDING,T,thread);
             if (SymbolValue(GC_INHIBIT,thread) == NIL)
-                arch_set_pseudo_atomic_interrupted(0);
+              set_pseudo_atomic_interrupted(0);
         }
     }
     new_obj = gc_alloc_with_region(nbytes,0,region,0);
         }
     }
     new_obj = gc_alloc_with_region(nbytes,0,region,0);
@@ -4368,7 +4589,8 @@ gencgc_handle_wp_violation(void* fault_addr)
              * does this test after the first one has already set wp=0
              */
             if(page_table[page_index].write_protected_cleared != 1)
              * does this test after the first one has already set wp=0
              */
             if(page_table[page_index].write_protected_cleared != 1)
-                lose("fault in heap page not marked as write-protected\n");
+                lose("fault in heap page %d not marked as write-protected\nboxed_region.first_page: %d, boxed_region.last_page %d\n",
+                     page_index, boxed_region.first_page, boxed_region.last_page);
         }
         /* Don't worry, we can handle it. */
         return 1;
         }
         /* Don't worry, we can handle it. */
         return 1;
index 6c9f88a..3d0139a 100644 (file)
@@ -32,7 +32,7 @@ lispobj *current_binding_stack_pointer;
 
 /* ALLOCATION_POINTER is x86 or RT.  Anyone want to do an RT port?   */
 
 
 /* ALLOCATION_POINTER is x86 or RT.  Anyone want to do an RT port?   */
 
-#ifndef ALLOCATION_POINTER
+# if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
 /* The Object Formerly Known As current_dynamic_space_free_pointer */
 lispobj *dynamic_space_free_pointer;
 #endif
 /* The Object Formerly Known As current_dynamic_space_free_pointer */
 lispobj *dynamic_space_free_pointer;
 #endif
index 71f3085..4ffd653 100644 (file)
@@ -34,9 +34,18 @@ extern lispobj *current_control_frame_pointer;
 extern lispobj *current_binding_stack_pointer;
 # endif
 
 extern lispobj *current_binding_stack_pointer;
 # endif
 
-# ifndef LISP_FEATURE_GENCGC
-/* Beware! gencgc has also a (non-global) dynamic_space_free_pointer. */
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+/* This is unused on X86 and X86_64, but is used as the global
+ *  allocation pointer by the cheney GC, and, in some instances, as
+ *  the global allocation pointer on PPC/GENCGC. This should probably
+ *  be cleaned up such that it only needs to exist on cheney. At the
+ *  moment, it is also used by the GENCGC, to hold the pseudo_atomic
+ *  bits, and is tightly coupled to reg_ALLOC by the assembly
+ *  routines. */
 extern lispobj *dynamic_space_free_pointer;
 extern lispobj *dynamic_space_free_pointer;
+#endif
+
+# ifndef LISP_FEATURE_GENCGC
 extern lispobj *current_auto_gc_trigger;
 # endif
 
 extern lispobj *current_auto_gc_trigger;
 # endif
 
index 5f81f5e..3d1d934 100644 (file)
@@ -85,6 +85,12 @@ void arch_set_pseudo_atomic_interrupted(os_context_t *context)
     *os_context_register_addr(context,reg_ALLOC) |=  1;
 }
 
     *os_context_register_addr(context,reg_ALLOC) |=  1;
 }
 
+/* FIXME: untested */
+void arch_clear_pseudo_atomic_interrupted(os_context_t *context)
+{
+    *os_context_register_addr(context,reg_ALLOC) &= ~1;
+}
+
 void arch_skip_instruction(os_context_t *context)
 {
     ((char *) *os_context_pc_addr(context)) = ((char *) *os_context_npc_addr(context));
 void arch_skip_instruction(os_context_t *context)
 {
     ((char *) *os_context_pc_addr(context)) = ((char *) *os_context_npc_addr(context));
index eca23aa..2344a26 100644 (file)
@@ -254,6 +254,7 @@ fake_foreign_function_call(os_context_t *context)
     dynamic_space_free_pointer =
         (lispobj *)(unsigned long)
             (*os_context_register_addr(context, reg_ALLOC));
     dynamic_space_free_pointer =
         (lispobj *)(unsigned long)
             (*os_context_register_addr(context, reg_ALLOC));
+    /* fprintf(stderr,"dynamic_space_free_pointer: %p\n", dynamic_space_free_pointer); */
 #if defined(LISP_FEATURE_ALPHA)
     if ((long)dynamic_space_free_pointer & 1) {
         lose("dead in fake_foreign_function_call, context = %x\n", context);
 #if defined(LISP_FEATURE_ALPHA)
     if ((long)dynamic_space_free_pointer & 1) {
         lose("dead in fake_foreign_function_call, context = %x\n", context);
@@ -305,7 +306,13 @@ undo_fake_foreign_function_call(os_context_t *context)
 #ifdef reg_ALLOC
     /* Put the dynamic space free pointer back into the context. */
     *os_context_register_addr(context, reg_ALLOC) =
 #ifdef reg_ALLOC
     /* Put the dynamic space free pointer back into the context. */
     *os_context_register_addr(context, reg_ALLOC) =
-        (unsigned long) dynamic_space_free_pointer;
+        (unsigned long) dynamic_space_free_pointer
+        | (*os_context_register_addr(context, reg_ALLOC)
+           & LOWTAG_MASK);
+    /*
+      ((unsigned long)(*os_context_register_addr(context, reg_ALLOC)) & ~LOWTAG_MASK)
+      | ((unsigned long) dynamic_space_free_pointer & LOWTAG_MASK);
+    */
 #endif
 }
 
 #endif
 }
 
@@ -360,11 +367,13 @@ interrupt_handle_pending(os_context_t *context)
     thread=arch_os_get_current_thread();
     data=thread->interrupt_data;
 
     thread=arch_os_get_current_thread();
     data=thread->interrupt_data;
 
-#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     /* If pseudo_atomic_interrupted is set then the interrupt is going
      * to be handled now, ergo it's safe to clear it. */
     /* If pseudo_atomic_interrupted is set then the interrupt is going
      * to be handled now, ergo it's safe to clear it. */
+
+    /* CLH: 20060220 FIXME This sould probably be arch_clear_p_a_i but
+     * the behavior of arch_clear_p_a_i and clear_p_a_i are slightly
+     * different on PPC. */
     arch_clear_pseudo_atomic_interrupted(context);
     arch_clear_pseudo_atomic_interrupted(context);
-#endif
 
     if (SymbolValue(GC_INHIBIT,thread)==NIL) {
 #ifdef LISP_FEATURE_SB_THREAD
 
     if (SymbolValue(GC_INHIBIT,thread)==NIL) {
 #ifdef LISP_FEATURE_SB_THREAD
index 8722021..0cb689c 100644 (file)
@@ -274,6 +274,12 @@ arch_set_pseudo_atomic_interrupted(os_context_t *context)
     *os_context_register_addr(context, reg_NL4) |= -1LL<<31;
 }
 
     *os_context_register_addr(context, reg_NL4) |= -1LL<<31;
 }
 
+void
+arch_clear_pseudo_atomic_interrupted(os_context_t *context)
+{
+    *os_context_register_addr(context, reg_NL4) &= ~(-1LL<<31);
+}
+
 unsigned int
 arch_install_breakpoint(void *pc)
 {
 unsigned int
 arch_install_breakpoint(void *pc)
 {
@@ -397,8 +403,7 @@ sigtrap_handler(int signal, siginfo_t *info, void *void_context)
         break;
 
     case 0x10:
         break;
 
     case 0x10:
-        /* Clear the pseudo-atomic flag. */
-        *os_context_register_addr(context, reg_NL4) &= ~(-1LL<<31);
+       arch_clear_pseudo_atomic_interrupted(context)
         arch_skip_instruction(context);
         interrupt_handle_pending(context);
         return;
         arch_skip_instruction(context);
         interrupt_handle_pending(context);
         return;
index a74b11f..954bb0b 100644 (file)
@@ -259,13 +259,14 @@ static boolean lookup_symbol(char *name, lispobj *result)
     }
 
     /* Search dynamic space. */
     }
 
     /* Search dynamic space. */
-#ifndef LISP_FEATURE_GENCGC
+#if defined(LISP_FEATURE_GENCGC)
+    headerptr = (lispobj *)DYNAMIC_SPACE_START;
+    count = (lispobj *)get_alloc_pointer() - headerptr;
+#else
     headerptr = (lispobj *)current_dynamic_space;
     count = dynamic_space_free_pointer - headerptr;
     headerptr = (lispobj *)current_dynamic_space;
     count = dynamic_space_free_pointer - headerptr;
-#else
-    headerptr = (lispobj *)DYNAMIC_SPACE_START;
-    count = ((lispobj *)SymbolValue(ALLOCATION_POINTER,0)) - headerptr;
 #endif
 #endif
+
     if (search_for_symbol(name, &headerptr, &count)) {
         *result = make_lispobj(headerptr, OTHER_POINTER_LOWTAG);
         return 1;
     if (search_for_symbol(name, &headerptr, &count)) {
         *result = make_lispobj(headerptr, OTHER_POINTER_LOWTAG);
         return 1;
index 56fefd0..6554971 100644 (file)
 #include "interrupt.h"
 #include "interr.h"
 
 #include "interrupt.h"
 #include "interr.h"
 
+#if defined(LISP_FEATURE_GENCGC)
+#include "gencgc-alloc-region.h"
+#endif
+
   /* The header files may not define PT_DAR/PT_DSISR.  This definition
      is correct for all versions of ppc linux >= 2.0.30
 
   /* The header files may not define PT_DAR/PT_DSISR.  This definition
      is correct for all versions of ppc linux >= 2.0.30
 
@@ -37,20 +41,9 @@ void arch_init() {
 os_vm_address_t
 arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context)
 {
 os_vm_address_t
 arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context)
 {
-    unsigned int *pc =  (unsigned int *)(*os_context_pc_addr(context));
+    unsigned long pc =  (unsigned long)(*os_context_pc_addr(context));
     os_vm_address_t addr;
 
     os_vm_address_t addr;
 
-
-    /* Make sure it's not the pc thats bogus, and that it was lisp code */
-    /* that caused the fault. */
-    if ((((unsigned long)pc) & 3) != 0 ||
-        ((pc < READ_ONLY_SPACE_START ||
-          pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) &&
-         ((lispobj *)pc < current_dynamic_space ||
-          (lispobj *)pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE)))
-        return 0;
-
-
     addr = (os_vm_address_t) (*os_context_register_addr(context,PT_DAR));
     return addr;
 }
     addr = (os_vm_address_t) (*os_context_register_addr(context,PT_DAR));
     return addr;
 }
@@ -77,13 +70,16 @@ arch_pseudo_atomic_atomic(os_context_t *context)
     return ((*os_context_register_addr(context,reg_ALLOC)) & 4);
 }
 
     return ((*os_context_register_addr(context,reg_ALLOC)) & 4);
 }
 
-#define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000
-
 void
 arch_set_pseudo_atomic_interrupted(os_context_t *context)
 {
 void
 arch_set_pseudo_atomic_interrupted(os_context_t *context)
 {
-    *os_context_register_addr(context,reg_NL3)
-        += PSEUDO_ATOMIC_INTERRUPTED_BIAS;
+    *os_context_register_addr(context,reg_ALLOC) |= 1;
+}
+
+void
+arch_clear_pseudo_atomic_interrupted(os_context_t *context)
+{
+    *os_context_register_addr(context,reg_ALLOC) &= ~1;
 }
 
 unsigned int
 }
 
 unsigned int
@@ -138,25 +134,263 @@ arch_do_displaced_inst(os_context_t *context,unsigned int orig_inst)
     skipped_break_addr = pc;
 }
 
     skipped_break_addr = pc;
 }
 
+#ifdef LISP_FEATURE_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 has the
+     * format.
+     * | 6| 5| 5 | 5 | 10|1|  width
+     * |31|5 |dst|src|  4|0|  field
+     */
+    pc = (unsigned int *) (*os_context_pc_addr(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[-3];
+#if 0
+        fprintf(stderr, "   add inst at %p:  inst = 0x%08x\n",
+                pc - 3, 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 but could not find ADD or ADDI instruction: 0x%08x in the proper place\n",
+                    add_inst);
+        }
+    }
+    return 0;
+}
+
+extern struct alloc_region boxed_region;
+
+void
+handle_allocation_trap(os_context_t * context)
+{
+    unsigned int *pc;
+    unsigned int inst;
+    unsigned int or_inst;
+    unsigned int target, target_ptr, end_addr;
+    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 *) (*os_context_pc_addr(context));
+    inst = pc[0];
+    end_addr = (inst >> 11) & 0x1f;
+    target = (inst >> 16) & 0x1f;
+
+    target_ptr = *os_context_register_addr(context, target);
+
+#if 0
+    fprintf(stderr, "handle_allocation_trap at %p:\n", pc);
+    fprintf(stderr, "boxed_region.free_pointer: %p\n", boxed_region.free_pointer);
+    fprintf(stderr, "boxed_region.end_addr: %p\n", boxed_region.end_addr);
+    fprintf(stderr, "target reg: %d, end_addr reg: %d\n", target, end_addr);
+    fprintf(stderr, "target: %x\n", *os_context_register_addr(context, target));
+    fprintf(stderr, "end_addr: %x\n", *os_context_register_addr(context, end_addr));
+#endif
+
+#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[-3];
+    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 = *os_context_register_addr(context, reg);
+
+    }
+
+#if 0
+    fprintf(stderr, "Alloc %d to %s\n", size, lisp_register_names[target]);
+#endif
+
+#if INLINE_ALLOC_DEBUG
+    if ((((unsigned long)boxed_region.end_addr + size) / PAGE_SIZE) ==
+        (((unsigned long)boxed_region.end_addr) / PAGE_SIZE)) {
+      fprintf(stderr,"*** possibly bogus trap allocation of %d bytes at %p\n",
+              size, target_ptr);
+      fprintf(stderr, "    dynamic_space_free_pointer: %p, boxed_region.end_addr %p\n",
+              dynamic_space_free_pointer, boxed_region.end_addr);
+    }
+#endif
+
+#if 0
+    fprintf(stderr, "Ready to alloc\n");
+    fprintf(stderr, "free_pointer = 0x%08x\n",
+            dynamic_space_free_pointer);
+#endif
+
+    /*
+     * alloc-tn was incremented by size.  Need to decrement it by size
+     * to restore its original value. This is not true on GENCGC
+     * anymore. d_s_f_p and reg_alloc get out of sync, but the p_a
+     * bits stay intact and we set it to the proper value when it
+     * needs to be. Keep this comment here for the moment in case
+     * somebody tries to figure out what happened here.
+     */
+    /*    dynamic_space_free_pointer =
+        (lispobj *) ((long) dynamic_space_free_pointer - size);
+    */
+#if 0
+    fprintf(stderr, "free_pointer = 0x%08x new\n",
+            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",
+            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
+
+    *os_context_register_addr(context, target) = (unsigned long) memory;
+    *os_context_register_addr(context, reg_ALLOC) =
+      (unsigned long) dynamic_space_free_pointer
+      | (*os_context_register_addr(context, reg_ALLOC)
+         & LOWTAG_MASK);
+
+    if (were_in_lisp) {
+        undo_fake_foreign_function_call(context);
+    }
+
+
+}
+#endif
+
+
 static void
 sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
 {
     unsigned int code;
 static void
 sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
 {
     unsigned int code;
+
 #ifdef LISP_FEATURE_LINUX
     os_restore_fp_control(context);
 #endif
     code=*((u32 *)(*os_context_pc_addr(context)));
 #ifdef LISP_FEATURE_LINUX
     os_restore_fp_control(context);
 #endif
     code=*((u32 *)(*os_context_pc_addr(context)));
-    if (code == ((3 << 26) | (16 << 21) | (reg_ALLOC << 16))) {
-        /* twlti reg_ALLOC,0 - check for deferred interrupt */
-        *os_context_register_addr(context,reg_ALLOC)
-            -= PSEUDO_ATOMIC_INTERRUPTED_BIAS;
+    if (code == ((3 << 26) | (0x18 << 21) | (reg_NL3 << 16))) {
+        arch_clear_pseudo_atomic_interrupted(context);
         arch_skip_instruction(context);
         /* interrupt or GC was requested in PA; now we're done with the
            PA section we may as well get around to it */
         interrupt_handle_pending(context);
         return;
         arch_skip_instruction(context);
         /* interrupt or GC was requested in PA; now we're done with the
            PA section we may as well get around to it */
         interrupt_handle_pending(context);
         return;
+    }
 
 
+#ifdef LISP_FEATURE_GENCGC
+    /* Is this an allocation trap? */
+    if (allocation_trap_p(context)) {
+        handle_allocation_trap(context);
+        arch_skip_instruction(context);
+#ifdef LISP_FEATURE_DARWIN
+        DARWIN_FIX_CONTEXT(context);
+#endif
+        return;
     }
     }
+#endif
+
     if ((code >> 16) == ((3 << 10) | (6 << 5))) {
         /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */
         int trap = code & 0x1f;
     if ((code >> 16) == ((3 << 10) | (6 << 5))) {
         /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */
         int trap = code & 0x1f;
index b4c79af..c760abb 100644 (file)
@@ -311,7 +311,6 @@ x:
 #endif
        /* Turn on pseudo-atomic */
 
 #endif
        /* Turn on pseudo-atomic */
 
-       li reg_NL3,-4
        li reg_ALLOC,4
        store(reg_ZERO,reg_NL4,CSYMBOL(foreign_function_call_active))
        load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
        li reg_ALLOC,4
        store(reg_ZERO,reg_NL4,CSYMBOL(foreign_function_call_active))
        load(reg_NL4,CSYMBOL(dynamic_space_free_pointer))
@@ -321,8 +320,9 @@ x:
        load(reg_OCFP,CSYMBOL(current_control_frame_pointer))
 
        /* No longer atomic, and check for interrupt */
        load(reg_OCFP,CSYMBOL(current_control_frame_pointer))
 
        /* No longer atomic, and check for interrupt */
-       add reg_ALLOC,reg_ALLOC,reg_NL3
-       twlti reg_ALLOC,0
+       andi. reg_NL3, reg_ALLOC, 1
+       subi reg_ALLOC,reg_ALLOC,4
+       twnei reg_NL3, 0
 
        /* Pass in the arguments */
 
 
        /* Pass in the arguments */
 
@@ -363,7 +363,6 @@ lra:
        mr REG(3),reg_A0
 
        /* Turn on  pseudo-atomic */
        mr REG(3),reg_A0
 
        /* Turn on  pseudo-atomic */
-       li reg_NL3,-4
        la reg_ALLOC,4(reg_ALLOC)
 
        /* Store lisp state */
        la reg_ALLOC,4(reg_ALLOC)
 
        /* Store lisp state */
@@ -380,9 +379,10 @@ lra:
        store(reg_NL1,reg_NL2,CSYMBOL(foreign_function_call_active))
 
        /* Check for interrupt */
        store(reg_NL1,reg_NL2,CSYMBOL(foreign_function_call_active))
 
        /* Check for interrupt */
-       add reg_ALLOC,reg_ALLOC,reg_NL3
-       twlti reg_ALLOC,0
-
+       andi. reg_NL3, reg_ALLOC, 1
+       subi reg_ALLOC, reg_ALLOC, 4
+       twnei reg_NL3,0
+       
        /* Back to C */
        C_FULL_EPILOG
        blr
        /* Back to C */
        C_FULL_EPILOG
        blr
@@ -411,7 +411,6 @@ lra:
        mr reg_NARGS,reg_NL3
 
        /* Turn on pseudo-atomic */
        mr reg_NARGS,reg_NL3
 
        /* Turn on pseudo-atomic */
-       li reg_NL3,-4
        la reg_ALLOC,4(reg_ALLOC)
 
        /* Convert the return address to an offset and save it on the stack. */
        la reg_ALLOC,4(reg_ALLOC)
 
        /* Convert the return address to an offset and save it on the stack. */
@@ -432,8 +431,10 @@ lra:
        store(reg_CSP,reg_CFUNC,CSYMBOL(foreign_function_call_active))
        /* load(reg_POLL,saver2) */
        /* Disable pseudo-atomic; check pending interrupt */
        store(reg_CSP,reg_CFUNC,CSYMBOL(foreign_function_call_active))
        /* load(reg_POLL,saver2) */
        /* Disable pseudo-atomic; check pending interrupt */
-       add reg_ALLOC,reg_ALLOC,reg_NL3
-       twlti reg_ALLOC,0
+       andi. reg_NL3, reg_ALLOC, 1
+       subi reg_ALLOC, reg_ALLOC, 4
+       twnei reg_NL3, 0
+
        mr reg_NL3,reg_NARGS
 
 #ifdef LISP_FEATURE_DARWIN
        mr reg_NL3,reg_NARGS
 
 #ifdef LISP_FEATURE_DARWIN
@@ -474,7 +475,7 @@ lra:
        li reg_LIP,0
 
        /* Atomic ... */
        li reg_LIP,0
 
        /* Atomic ... */
-       li reg_NL3,-4
+        li reg_NL3,-4        
        li reg_ALLOC,4
 
        /* No long in foreign function call. */
        li reg_ALLOC,4
 
        /* No long in foreign function call. */
@@ -497,8 +498,10 @@ lra:
        la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
 
        /* No longer atomic */
        la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
 
        /* No longer atomic */
-       add reg_ALLOC,reg_ALLOC,reg_NL3
-       twlti reg_ALLOC,0
+       andi. reg_NL3, reg_ALLOC, 1
+       subi reg_ALLOC, reg_ALLOC, 4
+       twnei reg_NL3, 0
+
        mtlr reg_LIP
        
        /* Reset the lisp stack. */
        mtlr reg_LIP
        
        /* Reset the lisp stack. */
@@ -579,3 +582,82 @@ CSYMBOL(closure_tramp):
        blr
        SET_SIZE(ppc_flush_cache_line)
 
        blr
        SET_SIZE(ppc_flush_cache_line)
 
+        GFUNCDEF(do_pending_interrupt)
+       twllei  reg_ZERO, trap_PendingInterrupt
+       blr
+/* King Nato's branch has a nop here. Do we need this? */
+       SET_SIZE(do_pending_interrupt)
+       
+#if defined LISP_FEATURE_GENCGC
+
+        GFUNCDEF(fpu_save)
+        stfd   FREG(1), 0(REG(3))
+       stfd    FREG(2), 8(REG(3))
+       stfd    FREG(3), 16(REG(3))
+       stfd    FREG(4), 24(REG(3))
+       stfd    FREG(5), 32(REG(3))
+       stfd    FREG(6), 40(REG(3))
+       stfd    FREG(7), 48(REG(3))
+       stfd    FREG(8), 56(REG(3))
+       stfd    FREG(9), 64(REG(3))
+       stfd    FREG(10), 72(REG(3))
+       stfd    FREG(11), 80(REG(3))
+       stfd    FREG(12), 88(REG(3))
+       stfd    FREG(13), 96(REG(3))
+       stfd    FREG(14), 104(REG(3))
+       stfd    FREG(15), 112(REG(3))
+       stfd    FREG(16), 120(REG(3))
+       stfd    FREG(17), 128(REG(3))
+       stfd    FREG(18), 136(REG(3))
+       stfd    FREG(19), 144(REG(3))
+       stfd    FREG(20), 152(REG(3))
+       stfd    FREG(21), 160(REG(3))
+       stfd    FREG(22), 168(REG(3))
+       stfd    FREG(23), 176(REG(3))
+       stfd    FREG(24), 184(REG(3))
+       stfd    FREG(25), 192(REG(3))
+       stfd    FREG(26), 200(REG(3))
+       stfd    FREG(27), 208(REG(3))
+       stfd    FREG(28), 216(REG(3))
+       stfd    FREG(29), 224(REG(3))
+       stfd    FREG(30), 232(REG(3))
+       stfd    FREG(31), 240(REG(3))
+       blr
+       SET_SIZE(fpu_save)
+       
+       GFUNCDEF(fpu_restore)
+       lfd     FREG(1), 0(REG(3))
+       lfd     FREG(2), 8(REG(3))
+       lfd     FREG(3), 16(REG(3))
+       lfd     FREG(4), 24(REG(3))
+       lfd     FREG(5), 32(REG(3))
+       lfd     FREG(6), 40(REG(3))
+       lfd     FREG(7), 48(REG(3))
+       lfd     FREG(8), 56(REG(3))
+       lfd     FREG(9), 64(REG(3))
+       lfd     FREG(10), 72(REG(3))
+       lfd     FREG(11), 80(REG(3))
+       lfd     FREG(12), 88(REG(3))
+       lfd     FREG(13), 96(REG(3))
+       lfd     FREG(14), 104(REG(3))
+       lfd     FREG(15), 112(REG(3))
+       lfd     FREG(16), 120(REG(3))
+       lfd     FREG(17), 128(REG(3))
+       lfd     FREG(18), 136(REG(3))
+       lfd     FREG(19), 144(REG(3))
+       lfd     FREG(20), 152(REG(3))
+       lfd     FREG(21), 160(REG(3))
+       lfd     FREG(22), 168(REG(3))
+       lfd     FREG(23), 176(REG(3))
+       lfd     FREG(24), 184(REG(3))
+       lfd     FREG(25), 192(REG(3))
+       lfd     FREG(26), 200(REG(3))
+       lfd     FREG(27), 208(REG(3))
+       lfd     FREG(28), 216(REG(3))
+       lfd     FREG(29), 224(REG(3))
+       lfd     FREG(30), 232(REG(3))
+       lfd     FREG(31), 240(REG(3))
+        blr
+       SET_SIZE(fpu_restore)
+       
+#endif 
index e8b2f39..c1a3026 100644 (file)
@@ -1,16 +1,30 @@
 #ifndef PPC_DARWIN_SPACELIST_H
 #define PPC_DARWIN_SPACELIST_H
 
 #ifndef PPC_DARWIN_SPACELIST_H
 #define PPC_DARWIN_SPACELIST_H
 
+#if defined(LISP_FEATURE_GENCGC)
+#define N_SEGMENTS_TO_PRODUCE 4
+#else
 #define N_SEGMENTS_TO_PRODUCE 5
 #define N_SEGMENTS_TO_PRODUCE 5
+#endif
 
 unsigned int space_start_locations[N_SEGMENTS_TO_PRODUCE] =
 
 unsigned int space_start_locations[N_SEGMENTS_TO_PRODUCE] =
-  { READ_ONLY_SPACE_START, STATIC_SPACE_START, DYNAMIC_0_SPACE_START, DYNAMIC_1_SPACE_START, LINKAGE_TABLE_SPACE_START};
+  { READ_ONLY_SPACE_START, STATIC_SPACE_START,
+#if defined(LISP_FEATURE_GENCGC)
+    DYNAMIC_SPACE_START,
+#else
+    DYNAMIC_0_SPACE_START, DYNAMIC_1_SPACE_START,
+#endif
+    LINKAGE_TABLE_SPACE_START};
 
 unsigned int space_sizes[N_SEGMENTS_TO_PRODUCE] =
   { READ_ONLY_SPACE_END - READ_ONLY_SPACE_START,
     STATIC_SPACE_END - STATIC_SPACE_START,
 
 unsigned int space_sizes[N_SEGMENTS_TO_PRODUCE] =
   { READ_ONLY_SPACE_END - READ_ONLY_SPACE_START,
     STATIC_SPACE_END - STATIC_SPACE_START,
+#if defined(LISP_FEATURE_GENCGC)
+    DYNAMIC_SPACE_END - DYNAMIC_SPACE_START,
+#else
     DYNAMIC_0_SPACE_END - DYNAMIC_0_SPACE_START,
     DYNAMIC_1_SPACE_END - DYNAMIC_1_SPACE_START,
     DYNAMIC_0_SPACE_END - DYNAMIC_0_SPACE_START,
     DYNAMIC_1_SPACE_END - DYNAMIC_1_SPACE_START,
+#endif
     LINKAGE_TABLE_SPACE_END - LINKAGE_TABLE_SPACE_START};
 
 #endif
     LINKAGE_TABLE_SPACE_END - LINKAGE_TABLE_SPACE_START};
 
 #endif
index ee81a57..9681253 100644 (file)
@@ -1,11 +1,14 @@
 #if defined LISP_FEATURE_DARWIN
 #if defined LANGUAGE_ASSEMBLY
 #define REG(num) r##num
 #if defined LISP_FEATURE_DARWIN
 #if defined LANGUAGE_ASSEMBLY
 #define REG(num) r##num
+#define FREG(num) f##num
 #else
 #define REG(num) num
 #else
 #define REG(num) num
+#define FREG(num) num
 #endif
 #else
 #define REG(num) num
 #endif
 #else
 #define REG(num) num
+#define FREG(num) num
 #endif
 
 #define NREGS 32
 #endif
 
 #define NREGS 32
index ba07c21..bedbfd7 100644 (file)
 
 #define PRINTNOISE
 
 
 #define PRINTNOISE
 
-#if defined(LISP_FEATURE_GENCGC)
-/* this is another artifact of the poor integration between gencgc and
- * the rest of the runtime: on cheney gc there is a global
- * dynamic_space_free_pointer which is valid whenever foreign function
- * call is active, but in gencgc there's no such variable and we have
- * to keep our own
- */
-static lispobj *dynamic_space_free_pointer;
-#endif
-
 extern unsigned long bytes_consed_between_gcs;
 
 extern unsigned long bytes_consed_between_gcs;
 
+static lispobj *dynamic_space_purify_pointer;
+
 \f
 /* These hold the original end of the read_only and static spaces so
  * we can tell what are forwarding pointers. */
 \f
 /* These hold the original end of the read_only and static spaces so
  * we can tell what are forwarding pointers. */
@@ -102,12 +94,12 @@ dynamic_pointer_p(lispobj ptr)
 #ifndef LISP_FEATURE_GENCGC
     return (ptr >= (lispobj)current_dynamic_space
             &&
 #ifndef LISP_FEATURE_GENCGC
     return (ptr >= (lispobj)current_dynamic_space
             &&
-            ptr < (lispobj)dynamic_space_free_pointer);
+            ptr < (lispobj)dynamic_space_purify_pointer);
 #else
     /* Be more conservative, and remember, this is a maybe. */
     return (ptr >= (lispobj)DYNAMIC_SPACE_START
             &&
 #else
     /* Be more conservative, and remember, this is a maybe. */
     return (ptr >= (lispobj)DYNAMIC_SPACE_START
             &&
-            ptr < (lispobj)dynamic_space_free_pointer);
+            ptr < (lispobj)dynamic_space_purify_pointer);
 #endif
 }
 
 #endif
 }
 
@@ -1453,8 +1445,14 @@ purify(lispobj static_roots, lispobj read_only_roots)
     }
 
 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
     }
 
 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
-    dynamic_space_free_pointer =
+    dynamic_space_purify_pointer =
       (lispobj*)SymbolValue(ALLOCATION_POINTER,0);
       (lispobj*)SymbolValue(ALLOCATION_POINTER,0);
+#else
+#if defined(LISP_FEATURE_GENCGC)
+    dynamic_space_purify_pointer = get_alloc_pointer();
+#else
+    dynamic_space_purify_pointer = dynamic_space_free_pointer;
+#endif
 #endif
 
     read_only_end = read_only_free =
 #endif
 
     read_only_end = read_only_free =
@@ -1597,15 +1595,11 @@ purify(lispobj static_roots, lispobj read_only_roots)
     SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0);
     SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0);
 
     SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0);
     SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0);
 
-#if !defined(ALLOCATION_POINTER)
-    dynamic_space_free_pointer = current_dynamic_space;
-    set_auto_gc_trigger(bytes_consed_between_gcs);
-#else
 #if defined LISP_FEATURE_GENCGC
     gc_free_heap();
 #else
 #if defined LISP_FEATURE_GENCGC
     gc_free_heap();
 #else
-#error unsupported case /* in CMU CL, was "ibmrt using GC" */
-#endif
+    dynamic_space_free_pointer = current_dynamic_space;
+    set_auto_gc_trigger(bytes_consed_between_gcs);
 #endif
 
     /* Blast away instruction cache */
 #endif
 
     /* Blast away instruction cache */
index 9273ce1..f6742c3 100644 (file)
@@ -166,18 +166,26 @@ save_to_filehandle(FILE *file, char *filename, lispobj init_function,
                  (lispobj *)STATIC_SPACE_START,
                  (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
                  core_start_pos);
                  (lispobj *)STATIC_SPACE_START,
                  (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0),
                  core_start_pos);
+#ifdef LISP_FEATURE_GENCGC
+    /* Flush the current_region, updating the tables. */
+    gc_alloc_update_all_page_tables();
+    update_dynamic_space_free_pointer();
+#endif
 #ifdef reg_ALLOC
 #ifdef reg_ALLOC
+#ifdef LISP_FEATURE_GENCGC
     output_space(file,
                  DYNAMIC_CORE_SPACE_ID,
     output_space(file,
                  DYNAMIC_CORE_SPACE_ID,
-                 (lispobj *)current_dynamic_space,
+                 (lispobj *)DYNAMIC_SPACE_START,
                  dynamic_space_free_pointer,
                  core_start_pos);
 #else
                  dynamic_space_free_pointer,
                  core_start_pos);
 #else
-#ifdef LISP_FEATURE_GENCGC
-    /* Flush the current_region, updating the tables. */
-    gc_alloc_update_all_page_tables();
-    update_dynamic_space_free_pointer();
+    output_space(file,
+                 DYNAMIC_CORE_SPACE_ID,
+                 (lispobj *)current_dynamic_space,
+                 dynamic_space_free_pointer,
+                 core_start_pos);
 #endif
 #endif
+#else
     output_space(file,
                  DYNAMIC_CORE_SPACE_ID,
                  (lispobj *)DYNAMIC_SPACE_START,
     output_space(file,
                  DYNAMIC_CORE_SPACE_ID,
                  (lispobj *)DYNAMIC_SPACE_START,
index f941eae..22d2403 100644 (file)
@@ -105,6 +105,11 @@ void arch_set_pseudo_atomic_interrupted(os_context_t *context)
     *os_context_register_addr(context,reg_ALLOC) |=  1;
 }
 
     *os_context_register_addr(context,reg_ALLOC) |=  1;
 }
 
+void arch_clear_pseudo_atomic_interrupted(os_context_t *context)
+{
+    *os_context_register_addr(context,reg_ALLOC) &= ~1;
+}
+
 unsigned int arch_install_breakpoint(void *pc)
 {
     unsigned int *ptr = (unsigned int *)pc;
 unsigned int arch_install_breakpoint(void *pc)
 {
     unsigned int *ptr = (unsigned int *)pc;
@@ -266,7 +271,7 @@ static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context)
                to fixup up alloc-tn to remove the interrupted flag,
                skip over the trap instruction, and then handle the
                pending interrupt(s). */
                to fixup up alloc-tn to remove the interrupted flag,
                skip over the trap instruction, and then handle the
                pending interrupt(s). */
-            *os_context_register_addr(context, reg_ALLOC) &= ~7;
+           arch_clear_pseudo_atomic_interrupted(context);
             arch_skip_instruction(context);
             interrupt_handle_pending(context);
         }
             arch_skip_instruction(context);
             interrupt_handle_pending(context);
         }
@@ -314,6 +319,8 @@ static void sigemt_handler(int signal, siginfo_t *siginfo, void *void_context)
             result = op1 - op2;
         else
             result = op1 + op2;
             result = op1 - op2;
         else
             result = op1 + op2;
+       /* KLUDGE: this & ~7 is a little bit magical but basically
+          clears pseudo_atomic bits if any */
         *os_context_register_addr(context, reg_ALLOC) = result & ~7;
         arch_skip_instruction(context);
         interrupt_handle_pending(context);
         *os_context_register_addr(context, reg_ALLOC) = result & ~7;
         arch_skip_instruction(context);
         interrupt_handle_pending(context);
index 80d476f..047b3ac 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.9.35"
+"0.9.9.36"