From 55dc8558f0686a9d1c8e7f8025bfe373b0c35e33 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 17 Jun 2009 16:40:34 +0000 Subject: [PATCH] 1.0.29.12: nicer DX capability conditionalization * New *FEATURES*: :STACK-ALLOCATABLE-LISTS, :STACK-ALLOCATABLE-VECTORS, and :STACK-ALLOCATABLE-FIXED-OBJECTS filled in by make-config.sh. * Use them instead of #!+(or arch1 arch2 ...). --- make-config.sh | 58 +++++++++++++++++++--------------- src/code/defboot.lisp | 4 +-- src/compiler/generic/vm-ir2tran.lisp | 9 +++--- tests/dynamic-extent.impure.lisp | 34 ++++++++++---------- version.lisp-expr | 2 +- 5 files changed, 56 insertions(+), 51 deletions(-) diff --git a/make-config.sh b/make-config.sh index 491807c..34e0390 100644 --- a/make-config.sh +++ b/make-config.sh @@ -279,7 +279,9 @@ cd "$original_dir" if [ "$sbcl_arch" = "x86" ]; then printf ' :gencgc :stack-grows-downward-not-upward :c-stack-is-control-stack' >> $ltf printf ' :compare-and-swap-vops :unwind-to-frame-and-call-vop :raw-instance-init-vops' >> $ltf - printf ' :stack-allocatable-closures :alien-callbacks :cycle-counter' >> $ltf + printf ' :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf + printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf + printf ' :alien-callbacks :cycle-counter' >> $ltf case "$sbcl_os" in linux | freebsd | netbsd | openbsd | sunos | darwin | win32) printf ' :linkage-table' >> $ltf @@ -292,10 +294,13 @@ if [ "$sbcl_arch" = "x86" ]; then elif [ "$sbcl_arch" = "x86-64" ]; then printf ' :gencgc :stack-grows-downward-not-upward :c-stack-is-control-stack :linkage-table' >> $ltf printf ' :compare-and-swap-vops :unwind-to-frame-and-call-vop :raw-instance-init-vops' >> $ltf - printf ' :stack-allocatable-closures :alien-callbacks :cycle-counter' >> $ltf + printf ' :stack-allocatable-closures :stack-allocatable-vectors' >> $ltf + printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf + printf ' :alien-callbacks :cycle-counter' >> $ltf elif [ "$sbcl_arch" = "mips" ]; then printf ' :linkage-table' >> $ltf printf ' :stack-allocatable-closures' >> $ltf + printf ' :stack-allocatable-lists :stack-allocatable-fixed-objects' >> $ltf printf ' :alien-callbacks' >> $ltf # Use a little C program to try to guess the endianness. Ware # cross-compilers! @@ -303,28 +308,28 @@ elif [ "$sbcl_arch" = "mips" ]; then # FIXME: integrate to grovel-features, mayhaps $GNUMAKE -C tools-for-build determine-endianness -I ../src/runtime tools-for-build/determine-endianness >> $ltf -elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "linux" ]; then - # Use a C program to detect which kind of glibc we're building on, - # to bandage across the break in source compatibility between - # versions 2.3.1 and 2.3.2 - # - # FIXME: integrate to grovel-features, mayhaps - 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 || (echo "error running where-is-mcontext"; exit 1) -elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "darwin" ]; then - 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. - # Best we can do is complain and exit at this stage - if [ "`ulimit -s`" = "512" ]; then - echo "Your stack size limit is too small to build SBCL." - echo "See the limit(1) or ulimit(1) commands and the README file." - exit 1 +elif [ "$sbcl_arch" = "ppc"]; then + printf ' :gencgc :stack-allocatable-closures :stacka-allocatable-lists' > $ltf + printf ' :linkage-table' >> $ltf + if [ "$sbcl_os" = "linux" ]; then + # Use a C program to detect which kind of glibc we're building on, + # to bandage across the break in source compatibility between + # versions 2.3.1 and 2.3.2 + # + # FIXME: integrate to grovel-features, mayhaps + $GNUMAKE -C tools-for-build where-is-mcontext -I ../src/runtime + tools-for-build/where-is-mcontext > src/runtime/ppc-linux-mcontext.h || (echo "error running where-is-mcontext"; exit 1) + elif [ "$sbcl_os" = "darwin" ]; then + # We provide a dlopen shim, so a little lie won't hurt + printf " :os-provides-dlopen :alien-callbacks" >> $ltf + # The default stack ulimit under darwin is too small to run PURIFY. + # Best we can do is complain and exit at this stage + if [ "`ulimit -s`" = "512" ]; then + echo "Your stack size limit is too small to build SBCL." + echo "See the limit(1) or ulimit(1) commands and the README file." + exit 1 + fi fi -elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "netbsd" ]; then - printf ' :gencgc :stack-allocatable-closures :linkage-table' >> $ltf elif [ "$sbcl_arch" = "sparc" ]; then # Test the compiler in order to see if we are building on Sun # toolchain as opposed to GNU binutils, and write the appropriate @@ -334,9 +339,12 @@ elif [ "$sbcl_arch" = "sparc" ]; then if [ "$sbcl_os" = "sunos" ] || [ "$sbcl_os" = "linux" ]; then printf ' :linkage-table' >> $ltf fi - printf ' :stack-allocatable-closures' >> $ltf + printf ' :stack-allocatable-closures :stack-allocatable-lists' >> $ltf elif [ "$sbcl_arch" = "alpha" ]; then - printf ' :stack-allocatable-closures' >> $ltf + printf ' :stack-allocatable-closures :stack-allocatable-lists' >> $ltf +elif [ "$sbcl_arch" = "hppa" ]; then + printf ' :stack-allocatable-vectors :stack-allocatable-fixed-objects' >> $ltf + printf ' :stack-allocatable-lists' >> $ltf else # Nothing need be done in this case, but sh syntax wants a placeholder. echo > /dev/null diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 291d73d..13d0618 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -617,9 +617,7 @@ evaluated as a PROGN." (cons (list ,@(mapcar (lambda (x) `(cons ',(car x) ,(cadr x))) mapped-bindings)) *handler-clusters*))) - ;; KLUDGE: Only on platforms with DX FIXED-ALLOC. FIXME: Add a - ;; feature for that, so we can conditionalize on it neatly. - #!+(or hppa mips x86 x86-64) + #!+stack-allocatable-fixed-objects (declare (truly-dynamic-extent *handler-clusters*)) (progn ,form))))) diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 0f5f92e..5562c20 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -13,6 +13,7 @@ sb!vm:instance-header-widetag sb!vm:instance-pointer-lowtag nil) +#!+stack-allocatable-fixed-objects (defoptimizer (%make-structure-instance stack-allocate-result) ((&rest args) node dx) t) @@ -218,9 +219,7 @@ node block (list value-tn) (node-lvar node)))))))) ;;; Stack allocation optimizers per platform support -;;; -;;; Platforms with stack-allocatable vectors -#!+(or hppa mips x86 x86-64) +#!+stack-allocatable-vectors (progn (defoptimizer (allocate-vector stack-allocate-result) ((type length words) node dx) @@ -253,7 +252,7 @@ (annotate-1-value-lvar arg))))) ;;; ...lists -#!+(or alpha hppa mips ppc sparc x86 x86-64) +#!+stack-allocatable-lists (progn (defoptimizer (list stack-allocate-result) ((&rest args) node dx) (declare (ignore node dx)) @@ -266,7 +265,7 @@ t)) ;;; ...conses -#!+(or hppa mips x86 x86-64) +#!+stack-allocatable-fixed-objects (defoptimizer (cons stack-allocate-result) ((&rest args) node dx) (declare (ignore node dx)) t) diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp index 167acf8..521e0a4 100644 --- a/tests/dynamic-extent.impure.lisp +++ b/tests/dynamic-extent.impure.lisp @@ -503,20 +503,25 @@ (defvar *a-cons* (cons nil nil)) -#+(or x86 x86-64 alpha ppc sparc mips hppa) (progn + #+stack-allocatable-closures (assert-no-consing (dxclosure 42)) - (assert-no-consing (dxlength 1 2 3)) - (assert-no-consing (dxlength t t t t t t)) - (assert-no-consing (dxlength)) - (assert-no-consing (dxcaller 1 2 3 4 5 6 7)) - (assert-no-consing (test-nip-values)) - (assert-no-consing (test-let-var-subst1 17)) - (assert-no-consing (test-let-var-subst2 17)) - (assert-no-consing (test-lvar-subst 11)) + #+stack-allocatable-lists + (progn + (assert-no-consing (dxlength 1 2 3)) + (assert-no-consing (dxlength t t t t t t)) + (assert-no-consing (dxlength)) + (assert-no-consing (dxcaller 1 2 3 4 5 6 7)) + (assert-no-consing (test-nip-values)) + (assert-no-consing (test-let-var-subst1 17)) + (assert-no-consing (test-let-var-subst2 17)) + (assert-no-consing (test-lvar-subst 11)) + (assert-no-consing (nested-dx-lists)) + (assert-consing (nested-dx-not-used *a-cons*)) + (assert-no-consing (nested-evil-dx-used *a-cons*)) + (assert-no-consing (multiple-dx-uses))) (assert-no-consing (dx-value-cell 13)) - ;; Only for platforms with DX FIXED-ALLOC - #+(or hppa mips x86 x86-64) + #+stack-allocatable-fixed-objects (progn (assert-no-consing (cons-on-stack 42)) (assert-no-consing (make-foo1-on-stack 123)) @@ -524,8 +529,7 @@ (assert-no-consing (nested-dx-conses)) (assert-no-consing (dx-handler-bind 2)) (assert-no-consing (dx-handler-case 2))) - ;; Only for platforms with DX ALLOCATE-VECTOR - #+(or hppa mips x86 x86-64) + #+stack-allocatable-vectors (progn (assert-no-consing (force-make-array-on-stack 128)) (assert-no-consing (make-array-on-stack-1)) @@ -540,10 +544,6 @@ (#+raw-instance-init-vops assert-no-consing #-raw-instance-init-vops progn (make-foo3-on-stack)) - (assert-no-consing (nested-dx-lists)) - (assert-consing (nested-dx-not-used *a-cons*)) - (assert-no-consing (nested-evil-dx-used *a-cons*)) - (assert-no-consing (multiple-dx-uses)) ;; Not strictly DX.. (assert-no-consing (test-hash-table)) #+sb-thread diff --git a/version.lisp-expr b/version.lisp-expr index a9deb70..b61c1d3 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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".) -"1.0.29.11" +"1.0.29.12" -- 1.7.10.4