Skip to content

Commit

Permalink
1.0.29.12: nicer DX capability conditionalization
Browse files Browse the repository at this point in the history
 * 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 ...).
  • Loading branch information
nikodemus committed Jun 17, 2009
1 parent 4c4620d commit 55dc855
Show file tree
Hide file tree
Showing 5 changed files with 56 additions and 51 deletions.
58 changes: 33 additions & 25 deletions make-config.sh
Expand Up @@ -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
Expand All @@ -292,39 +294,42 @@ 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!
#
# 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
Expand All @@ -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
Expand Down
4 changes: 1 addition & 3 deletions src/code/defboot.lisp
Expand Up @@ -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)))))

Expand Down
9 changes: 4 additions & 5 deletions src/compiler/generic/vm-ir2tran.lisp
Expand Up @@ -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)

Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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))
Expand All @@ -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)
34 changes: 17 additions & 17 deletions tests/dynamic-extent.impure.lisp
Expand Up @@ -503,29 +503,33 @@

(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))
(assert-no-consing (nested-good 42))
(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))
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion version.lisp-expr
Expand Up @@ -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"

0 comments on commit 55dc855

Please sign in to comment.