From: Christophe Rhodes Date: Fri, 7 Mar 2003 12:15:12 +0000 (+0000) Subject: 0.7.13.17: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=40bf78b47ea89b15698adb9c550efa4cbacafeb7;p=sbcl.git 0.7.13.17: Merge mini backend-refactor, motivated by APD's *CHECK-CONSISTENCY*/non-local-exit observations ... OAOOize MAKE-DYNAMIC-SPACE-TNS VM support routine Also add tests for documentation in the presence of generalized function names that should have been merged before but were forgotten (sorry). --- diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 26cbf1c..5f25b0c 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -511,6 +511,7 @@ ("src/compiler/target/alloc") ("src/compiler/target/call") ("src/compiler/target/nlx") + ("src/compiler/generic/late-nlx") ("src/compiler/target/show") ("src/compiler/target/array" ;; KLUDGE: Compiling this file for X86 raises alarming warnings of diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 78b17cb..a151110 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -2,10 +2,9 @@ ;;;; the specifications of target packages, except for a few things ;;;; which are handled elsewhere by other mechanisms: -;;;; * the creation of the trivial SB-SLOT-ACCESSOR-NAME package -;;;; * any SHADOWing and nickname hackery +;;;; * any SHADOWing and nickname hackery; ;;;; * the standard, non-SBCL-specific packages COMMON-LISP, -;;;; COMMON-LISP-USER, and KEYWORD +;;;; COMMON-LISP-USER, and KEYWORD. ;;;; ;;;; The packages are named SB!FOO here and elsewhere in ;;;; cross-compilation, in order to avoid collision with possible diff --git a/src/compiler/alpha/nlx.lisp b/src/compiler/alpha/nlx.lisp index a293dda..2e414f2 100644 --- a/src/compiler/alpha/nlx.lisp +++ b/src/compiler/alpha/nlx.lisp @@ -34,14 +34,6 @@ ;;;; before sbcl-0.7.0), then this would be the place to restore the ;;;; top pointers. -;;; Return a list of TNs that can be used to snapshot the dynamic -;;; state for use with the SAVE- and RESTORE-DYNAMIC-ENVIRONMENT VOPs. -(!def-vm-support-routine make-dynamic-state-tns () - (list (make-normal-tn *backend-t-primitive-type*) - (make-normal-tn *backend-t-primitive-type*) - (make-normal-tn *backend-t-primitive-type*) - (make-normal-tn *backend-t-primitive-type*))) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (nfp :scs (descriptor-reg)) diff --git a/src/compiler/generic/late-nlx.lisp b/src/compiler/generic/late-nlx.lisp new file mode 100644 index 0000000..4f6b31a --- /dev/null +++ b/src/compiler/generic/late-nlx.lisp @@ -0,0 +1,26 @@ +;;;; some help for the definition of generic non-local exit + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + +(in-package "SB!VM") + +;;; Return a list of TNs that can be used to snapshot the dynamic +;;; state for use with the SAVE- and RESTORE-DYNAMIC-ENVIRONMENT VOPs. +(!def-vm-support-routine make-dynamic-state-tns () + (make-n-tns #.(let ((nsave + (sb!c::vop-info-num-results + (template-or-lose 'save-dynamic-state))) + (nrestore + (sb!c::vop-info-num-args + (template-or-lose 'restore-dynamic-state)))) + (aver (= nsave nrestore)) + nsave) + *backend-t-primitive-type*)) + diff --git a/src/compiler/hppa/nlx.lisp b/src/compiler/hppa/nlx.lisp index 745cd6a..558a156 100644 --- a/src/compiler/hppa/nlx.lisp +++ b/src/compiler/hppa/nlx.lisp @@ -21,12 +21,6 @@ ;;; were any additional stacks, then this would be the place to restore the top ;;; pointers. - -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-DYNAMIC-ENVIRONMENT VOPs. -(!def-vm-support-routine make-dynamic-state-tns () - (make-n-tns 4 *backend-t-primitive-type*)) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (nfp :scs (descriptor-reg)) diff --git a/src/compiler/mips/nlx.lisp b/src/compiler/mips/nlx.lisp index 03c8a64..cb58be0 100644 --- a/src/compiler/mips/nlx.lisp +++ b/src/compiler/mips/nlx.lisp @@ -21,12 +21,6 @@ ;;; were any additional stacks, then this would be the place to restore the top ;;; pointers. - -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-DYNAMIC-ENVIRONMENT VOPs. -(!def-vm-support-routine make-dynamic-state-tns () - (make-n-tns 4 *backend-t-primitive-type*)) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (nfp :scs (descriptor-reg)) diff --git a/src/compiler/ppc/nlx.lisp b/src/compiler/ppc/nlx.lisp index b69a533..b1815a6 100644 --- a/src/compiler/ppc/nlx.lisp +++ b/src/compiler/ppc/nlx.lisp @@ -22,12 +22,6 @@ ;;; additional stacks, then this would be the place to restore the top ;;; pointers. - -;;; Return a list of TNs that can be used to snapshot the dynamic state for -;;; use with the Save/Restore-DYNAMIC-ENVIRONMENT VOPs. -(!def-vm-support-routine make-dynamic-state-tns () - (make-n-tns 4 *backend-t-primitive-type*)) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (nfp :scs (descriptor-reg)) diff --git a/src/compiler/sparc/nlx.lisp b/src/compiler/sparc/nlx.lisp index 4553b66..c761d32 100644 --- a/src/compiler/sparc/nlx.lisp +++ b/src/compiler/sparc/nlx.lisp @@ -33,12 +33,6 @@ ;;; additional stacks, then this would be the place to restore the top ;;; pointers. - -;;; Return a list of TNs that can be used to snapshot the dynamic -;;; state for use with the Save/Restore-Dynamic-Environment VOPs. -(!def-vm-support-routine make-dynamic-state-tns () - (make-n-tns 4 *backend-t-primitive-type*)) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (nfp :scs (descriptor-reg)) diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index 79e9ab2..d220ffe 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -40,11 +40,6 @@ ;;;; ;;;; We don't need to save the BSP, because that is handled automatically. -;;; Return a list of TNs that can be used to snapshot the dynamic -;;; state for use with the SAVE- and RESTORE-DYNAMIC-ENVIRONMENT VOPs. -(!def-vm-support-routine make-dynamic-state-tns () - (make-n-tns 2 *backend-t-primitive-type*)) - (define-vop (save-dynamic-state) (:results (catch :scs (descriptor-reg)) (alien-stack :scs (descriptor-reg))) diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp new file mode 100644 index 0000000..2bd37ce --- /dev/null +++ b/tests/interface.impure.lisp @@ -0,0 +1,41 @@ +;;;; tests for problems in the interface presented to the user/programmer + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(load "assertoid.lisp") +(use-package "ASSERTOID") + +(defun (setf foo) (x) + "(setf foo) documentation" + x) + +(assert (string= (documentation '(setf foo) 'function) + "(setf foo) documentation")) +(assert (string= (documentation #'(setf foo) 'function) + "(setf foo) documentation")) + +(defun (sb-pcl::class-predicate foo) (x) + "(class-predicate foo) documentation" + x) + +(assert (string= (documentation '(setf foo) 'function) + "(setf foo) documentation")) +(assert (string= (documentation #'(setf foo) 'function) + "(setf foo) documentation")) +(assert (string= (documentation '(sb-pcl::class-predicate foo) 'function) + "(class-predicate foo) documentation")) +(assert (string= (documentation #'(sb-pcl::class-predicate foo) 'function) + "(class-predicate foo) documentation")) + + +;;;; success +(sb-ext:quit :unix-code 104) diff --git a/version.lisp-expr b/version.lisp-expr index 6118e0d..6a50335 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.13.16" +"0.7.13.17"