[sbcl] pull in upstream patches to support GENCGC
Rex Dieter
rdieter at fedoraproject.org
Thu Jun 12 15:03:04 UTC 2014
commit 52174bfdd560c47572e7964ffb11e8abedcdbd70
Author: Rex Dieter <rdieter at math.unl.edu>
Date: Thu Jun 12 10:02:29 2014 -0500
pull in upstream patches to support GENCGC
... instead of problematic cheneygc
0010-Implement-gencgc-on-ARM.patch | 342 ++++++++++++++++++++++++++++++++++++
0011-Enable-GENCGC-on-ARM.patch | 26 +++
sbcl-1.2.0-manual-cheneygc.patch | 12 --
sbcl.spec | 12 +-
4 files changed, 373 insertions(+), 19 deletions(-)
---
diff --git a/0010-Implement-gencgc-on-ARM.patch b/0010-Implement-gencgc-on-ARM.patch
new file mode 100644
index 0000000..d4c8b16
--- /dev/null
+++ b/0010-Implement-gencgc-on-ARM.patch
@@ -0,0 +1,342 @@
+From 12b8f575b2dcf6920e4f666d79b743ded9b7b189 Mon Sep 17 00:00:00 2001
+From: Stas Boukarev <stassats at gmail.com>
+Date: Wed, 28 May 2014 16:21:28 +0400
+Subject: [PATCH 010/100] Implement gencgc on ARM.
+
+---
+ src/cold/shared.lisp | 2 +-
+ src/compiler/arm/backend-parms.lisp | 13 +++++++
+ src/compiler/arm/macros.lisp | 62 +++++++++++++++++++++++++++++++--
+ src/compiler/arm/parms.lisp | 17 +++++++++-
+ src/runtime/arm-arch.c | 4 +++
+ src/runtime/arm-assem.S | 68 ++++++++++++++++++++++++++++++++++++-
+ src/runtime/gencgc.c | 3 ++
+ src/runtime/pseudo-atomic.h | 45 ++++++++++++++++++++++++
+ 8 files changed, 208 insertions(+), 6 deletions(-)
+
+diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp
+index b62c3dc..9530114 100644
+--- a/src/cold/shared.lisp
++++ b/src/cold/shared.lisp
+@@ -155,7 +155,7 @@
+ ":GENCGC and :CHENEYGC are incompatible")
+ ("(and cheneygc (not (or alpha arm hppa mips ppc sparc)))"
+ ":CHENEYGC not supported on selected architecture")
+- ("(and gencgc (not (or sparc ppc x86 x86-64)))"
++ ("(and gencgc (not (or sparc ppc x86 x86-64 arm)))"
+ ":GENCGC not supported on selected architecture")
+ ("(not (or gencgc cheneygc))"
+ "One of :GENCGC or :CHENEYGC must be enabled")
+diff --git a/src/compiler/arm/backend-parms.lisp b/src/compiler/arm/backend-parms.lisp
+index 91f299a..29c3392 100644
+--- a/src/compiler/arm/backend-parms.lisp
++++ b/src/compiler/arm/backend-parms.lisp
+@@ -8,3 +8,16 @@
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; Minumum observed value, not authoritative.
+ (setf *backend-page-bytes* 4096))
++
++;;; The size in bytes of GENCGC cards, i.e. the granularity at which
++;;; writes to old generations are logged. With mprotect-based write
++;;; barriers, this must be a multiple of the OS page size.
++(def!constant gencgc-card-bytes *backend-page-bytes*)
++;;; The minimum size of new allocation regions. While it doesn't
++;;; currently make a lot of sense to have a card size lower than
++;;; the alloc granularity, it will, once we are smarter about finding
++;;; the start of objects.
++(def!constant gencgc-alloc-granularity 0)
++;;; The minimum size at which we release address ranges to the OS.
++;;; This must be a multiple of the OS page size.
++(def!constant gencgc-release-granularity *backend-page-bytes*)
+diff --git a/src/compiler/arm/macros.lisp b/src/compiler/arm/macros.lisp
+index 8cdb7db..ef7580c 100644
+--- a/src/compiler/arm/macros.lisp
++++ b/src/compiler/arm/macros.lisp
+@@ -174,6 +174,26 @@
+ ;;; to emphasize the parallelism with PSEUDO-ATOMIC (which must
+ ;;; surround a call to ALLOCATION anyway), and to indicate that the
+ ;;; P-A FLAG-TN is also acceptable here.
++
++#!+gencgc
++(defun allocation-tramp (alloc-tn size back-label)
++ (let ((fixup (gen-label)))
++ (when (integerp size)
++ (load-immediate-word alloc-tn size))
++ (emit-word sb!assem::**current-segment** (logior #xe92d0000
++ (ash 1 (if (integerp size)
++ (tn-offset alloc-tn)
++ (tn-offset size)))
++ (ash 1 (tn-offset lr-tn))))
++ (inst load-from-label alloc-tn alloc-tn fixup)
++ (inst blx alloc-tn)
++ (emit-word sb!assem::**current-segment** (logior #xe8bd0000
++ (ash 1 (tn-offset alloc-tn))
++ (ash 1 (tn-offset lr-tn))))
++ (inst b back-label)
++ (emit-label fixup)
++ (inst word (make-fixup "alloc_tramp" :foreign))))
++
+ (defmacro allocation (result-tn size lowtag &key flag-tn
+ stack-allocate-p)
+ ;; Normal allocation to the heap.
+@@ -194,13 +214,43 @@
+ ;; stack pointer has been stored.
+ (storew null-tn ,result-tn -1 0 :ne)
+ (inst orr ,result-tn ,result-tn ,lowtag))
++ #!-gencgc
+ (t
+ (load-symbol-value ,flag-tn *allocation-pointer*)
+ (inst add ,result-tn ,flag-tn ,lowtag)
+ (if (integerp ,size)
+ (composite-immediate-instruction add ,flag-tn ,flag-tn ,size)
+ (inst add ,flag-tn ,flag-tn ,size))
+- (store-symbol-value ,flag-tn *allocation-pointer*)))))
++ (store-symbol-value ,flag-tn *allocation-pointer*))
++ #!+gencgc
++ (t
++ (let ((fixup (gen-label))
++ (alloc (gen-label))
++ (back-from-alloc (gen-label)))
++ (inst load-from-label ,flag-tn ,flag-tn FIXUP)
++ (loadw ,result-tn ,flag-tn)
++ (loadw ,flag-tn ,flag-tn 1)
++ (if (integerp ,size)
++ (composite-immediate-instruction add ,result-tn ,result-tn ,size)
++ (inst add ,result-tn ,result-tn ,size))
++ (inst cmp ,result-tn ,flag-tn)
++ (inst b :gt ALLOC)
++ (inst load-from-label ,flag-tn ,flag-tn FIXUP)
++ (storew ,result-tn ,flag-tn)
++
++ (if (integerp ,size)
++ (composite-immediate-instruction sub ,result-tn ,result-tn ,size)
++ (inst sub ,result-tn ,result-tn ,size))
++
++ (emit-label BACK-FROM-ALLOC)
++ (when ,lowtag
++ (inst orr ,result-tn ,result-tn ,lowtag))
++
++ (assemble (*elsewhere*)
++ (emit-label ALLOC)
++ (allocation-tramp ,result-tn ,size BACK-FROM-ALLOC)
++ (emit-label FIXUP)
++ (inst word (make-fixup "boxed_region" :foreign))))))))
+
+ (defmacro with-fixed-allocation ((result-tn flag-tn type-code size
+ &key (lowtag other-pointer-lowtag)
+@@ -368,6 +418,12 @@
+ OBJECTS will not be moved in memory for the duration of BODY.
+ Useful for e.g. foreign calls where another thread may trigger
+ garbage collection. This is currently implemented by disabling GC"
+- (declare (ignore objects)) ;should we eval these for side-effect?
++ #!-gencgc
++ (declare (ignore objects)) ; should we eval these for side-effect?
++ #!-gencgc
+ `(without-gcing
+- , at body))
++ , at body)
++ #!+gencgc
++ `(let ((*pinned-objects* (list* , at objects *pinned-objects*)))
++ (declare (truly-dynamic-extent *pinned-objects*))
++ , at body))
+diff --git a/src/compiler/arm/parms.lisp b/src/compiler/arm/parms.lisp
+index 674654b..d7544a7 100644
+--- a/src/compiler/arm/parms.lisp
++++ b/src/compiler/arm/parms.lisp
+@@ -94,6 +94,20 @@
+ (def!constant linkage-table-space-start #x0a000000)
+ (def!constant linkage-table-space-end #x0b000000))
+
++#!+gencgc
++(progn
++ (def!constant linkage-table-space-start #x0a000000)
++ (def!constant linkage-table-space-end #x0b000000)
++
++ (def!constant read-only-space-start #x04000000)
++ (def!constant read-only-space-end #x07ff8000)
++
++ (def!constant static-space-start #x08000000)
++ (def!constant static-space-end #x097fff00)
++
++ (def!constant dynamic-space-start #x4f000000)
++ (def!constant dynamic-space-end (!configure-dynamic-space-end)))
++
+ (def!constant linkage-table-entry-size 16)
+
+ #!+linux
+@@ -144,7 +158,8 @@
+ ;; 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*)))
++ sb!alien::*enter-alien-callback*
++ #!+gencgc *restart-lisp-function*)))
+
+ (defparameter *static-funs*
+ '(two-arg-gcd two-arg-lcm
+diff --git a/src/runtime/arm-arch.c b/src/runtime/arm-arch.c
+index 1f60f3c..3f659c3 100644
+--- a/src/runtime/arm-arch.c
++++ b/src/runtime/arm-arch.c
+@@ -63,8 +63,12 @@ boolean arch_pseudo_atomic_atomic(os_context_t *context)
+ * The foreign_function_call_active used to live at each call-site
+ * to arch_pseudo_atomic_atomic, but this seems clearer.
+ * --NS 2007-05-15 */
++#ifdef LISP_FEATURE_GENCGC
++ return SymbolValue(PSEUDO_ATOMIC_ATOMIC, 0) != NIL;
++#else
+ return (!foreign_function_call_active)
+ && (NIL != SymbolValue(PSEUDO_ATOMIC_ATOMIC,0));
++#endif
+ }
+
+ void arch_set_pseudo_atomic_interrupted(os_context_t *context)
+diff --git a/src/runtime/arm-assem.S b/src/runtime/arm-assem.S
+index 81223a6..f7d57a6 100644
+--- a/src/runtime/arm-assem.S
++++ b/src/runtime/arm-assem.S
+@@ -379,4 +379,70 @@ fun_end_breakpoint_trap:
+ .global fun_end_breakpoint_end
+ fun_end_breakpoint_end:
+
+- /* EOF */
++#ifdef LISP_FEATURE_GENCGC
++ .align
++ .global alloc_tramp
++ .type alloc_tramp, %function
++alloc_tramp:
++ stmfd sp!, {r4, r6, r12, lr}
++
++ ldr r4, =foreign_function_call_active
++ str pc, [r4]
++
++ ldr r4, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
++ add r6, r4, #8*4
++ str r6, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
++
++ @@ Create a new frame and save descriptor regs on the stack
++ @@ for the GC to see.
++ str reg_CFP, [r4, #0]
++ str reg_NULL, [r4, #4]
++ str reg_CODE, [r4, #8]
++ add r4, r4, #3*4
++ stmea r4, {r0-reg_LEXENV, r8}
++
++ ldr r0, [sp, #4*4]
++ fstmfdd sp!, {d0-d7}
++
++ mov lr, pc
++ ldr pc,=alloc
++
++ fldmfdd sp!, {d0-d7}
++ str r0, [sp, #4*4]
++ ldr r4, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
++ ldmea r4, {r0-reg_LEXENV, r8}
++ sub r4, r4, #8*4
++ str r4, STATIC_SYMBOL_VALUE(CONTROL_STACK_POINTER)
++
++ ldr r4, =foreign_function_call_active
++ mov r6, #0
++ str r6, [r4]
++
++ ldmfd sp!, {r4, r6, r12, lr}
++ bx lr
++
++ .align
++ .global fpu_save
++ .type fpu_save, %function
++fpu_save:
++ fstmiad r0, {d0-d7}
++ bx lr
++
++ .align
++ .global fpu_restore
++ .type fpu_restore, %function
++fpu_restore:
++ add r0, r0, #16
++ fldmiad r0, {d0-d7}
++ bx lr
++
++ .align
++ .global do_pending_interrupt
++ .type do_pending_interrupt, %function
++do_pending_interrupt:
++ stmfd sp!, {reg_OCFP, lr}
++ ldr reg_OCFP, =0xf0001
++ swi #0
++ ldmfd sp!, {reg_OCFP, lr}
++ bx lr
++#endif
+diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
+index bcf22a3..31ce079 100644
+--- a/src/runtime/gencgc.c
++++ b/src/runtime/gencgc.c
+@@ -484,6 +484,9 @@ write_generation_stats(FILE *file)
+ */
+ #define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2)
+ long long fpu_state[FPU_STATE_SIZE];
++#elif defined(LISP_FEATURE_ARM)
++ #define FPU_STATE_SIZE 8
++ long long fpu_state[FPU_STATE_SIZE];
+ #endif
+
+ /* This code uses the FP instructions which may be set up for Lisp
+diff --git a/src/runtime/pseudo-atomic.h b/src/runtime/pseudo-atomic.h
+index 0c2ea7f..8cce2cb 100644
+--- a/src/runtime/pseudo-atomic.h
++++ b/src/runtime/pseudo-atomic.h
+@@ -93,6 +93,51 @@ clear_pseudo_atomic_interrupted(struct thread *thread)
+
+ #undef LISPOBJ_SUFFIX
+
++#elif defined(LISP_FEATURE_ARM)
++static inline int
++get_pseudo_atomic_atomic(struct thread *thread)
++{
++ return SymbolValue(PSEUDO_ATOMIC_ATOMIC, thread) != NIL;
++}
++
++static inline void
++set_pseudo_atomic_atomic(struct thread *thread)
++{
++ SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, PSEUDO_ATOMIC_ATOMIC, thread);
++}
++
++static inline void
++clear_pseudo_atomic_atomic(struct thread *thread)
++{
++ SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, NIL, thread);
++}
++
++static inline int
++get_pseudo_atomic_interrupted(struct thread *thread)
++{
++ return SymbolValue(PSEUDO_ATOMIC_INTERRUPTED, thread) != NIL;
++}
++
++static inline void
++set_pseudo_atomic_interrupted(struct thread *thread)
++{
++ SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, MAKE_FIXNUM(0x000f0001), thread);
++}
++
++static inline void
++clear_pseudo_atomic_interrupted(struct thread *thread)
++{
++ SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, NIL, 0);
++}
++
++#define set_alloc_pointer(value) \
++ (dynamic_space_free_pointer = \
++ ((lispobj *) \
++ ((value) | (((uword_t)dynamic_space_free_pointer) & LOWTAG_MASK))))
++
++#define get_alloc_pointer() \
++ ((uword_t) dynamic_space_free_pointer & ~LOWTAG_MASK)
++
+ #elif defined(LISP_FEATURE_GENCGC)
+
+ /* FIXME: Are these async signal safe? Compiler reordering? */
+--
+1.9.3
+
diff --git a/0011-Enable-GENCGC-on-ARM.patch b/0011-Enable-GENCGC-on-ARM.patch
new file mode 100644
index 0000000..0a90775
--- /dev/null
+++ b/0011-Enable-GENCGC-on-ARM.patch
@@ -0,0 +1,26 @@
+From 5830d38a3c1936c5b38d563b4cb11c9ae414bf32 Mon Sep 17 00:00:00 2001
+From: Stas Boukarev <stassats at gmail.com>
+Date: Wed, 28 May 2014 18:19:36 +0400
+Subject: [PATCH 011/100] Enable GENCGC on ARM.
+
+---
+ NEWS | 1 +
+ make-config.sh | 2 +-
+ 2 files changed, 2 insertions(+), 1 deletion(-)
+
+diff --git a/make-config.sh b/make-config.sh
+index c12c2d2..21639fd 100755
+--- a/make-config.sh
++++ b/make-config.sh
+@@ -675,7 +675,7 @@ elif [ "$sbcl_arch" = "hppa" ]; then
+ printf ' :stack-allocatable-vectors :stack-allocatable-fixed-objects' >> $ltf
+ printf ' :stack-allocatable-lists' >> $ltf
+ elif [ "$sbcl_arch" = "arm" ]; then
+- printf ' :cheneygc :linkage-table :alien-callbacks' >> $ltf
++ printf ' :gencgc :linkage-table :alien-callbacks' >> $ltf
+ # As opposed to soft-float or FPA, we support VFP only (and
+ # possibly VFPv2 and higher only), but we'll leave the obvious
+ # hooks in for someone to add the support later.
+--
+1.9.3
+
diff --git a/sbcl.spec b/sbcl.spec
index 000f277..afd33bf 100644
--- a/sbcl.spec
+++ b/sbcl.spec
@@ -2,7 +2,7 @@
%define common_lisp_controller 1
# generate/package docs
-#define docs 1
+%define docs 1
# define to enable verbose build for debugging
#define sbcl_verbose 1
@@ -95,12 +95,13 @@ Source202: sbcl-install-clc.lisp
Patch2: sbcl-1.1.13-personality.patch
Patch3: sbcl-1.2.0-optflags.patch
Patch6: sbcl-0.9.5-verbose-build.patch
-Patch9: sbcl-1.2.0-manual-cheneygc.patch
## upstreamable patches
Patch50: sbcl-1.0.51-generate_version.patch
## upstream patches
+Patch110: 0010-Implement-gencgc-on-ARM.patch
+Patch111: 0011-Enable-GENCGC-on-ARM.patch
# %%check/tests
BuildRequires: ed
@@ -128,13 +129,10 @@ pushd sbcl-%{version}
%patch2 -p1 -b .personality
%patch3 -p1 -b .optflags
%{?sbcl_verbose:%patch6 -p1 -b .verbose-build}
-%ifarch %{arm}
-# These functions are not defined when using cheneygc,
-# only when using gcg. Arm uses cheneygc, so remove the
-# includes so we can build the docs.
-%patch9 -p1 -b .manual-cheneygc
%endif
%patch50 -p1 -b .generate_version
+%patch110 -p1 -b .0010
+%patch111 -p1 -b .0011
# fix permissions (some have eXecute bit set)
find . -name '*.c' | xargs chmod 644
More information about the scm-commits
mailing list