From a0a198faba322eccaf947862b59946aed99b2347 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 8 Feb 2002 14:11:09 +0000 Subject: [PATCH] 0.7.1.15: merged patch: APD "bug 132" sbcl-devel 2002-02-02 tweaked Config.x86-linux as per Stig E Sandoe "Callbacks from C to SBCL" sbcl-devel 2002-02-03 --- BUGS | 14 -------------- src/code/run-program.lisp | 2 +- src/compiler/ctype.lisp | 10 ++++++++++ src/compiler/ir2tran.lisp | 2 ++ src/compiler/x86/nlx.lisp | 2 +- src/pcl/defclass.lisp | 12 +++++++----- src/runtime/Config.x86-linux | 11 ++++++++++- tests/compiler.impure.lisp | 7 +++++++ 8 files changed, 38 insertions(+), 22 deletions(-) diff --git a/BUGS b/BUGS index 8ee4891..a4ec52f 100644 --- a/BUGS +++ b/BUGS @@ -1061,20 +1061,6 @@ WORKAROUND: arguments in FLET/LABELS: it might be an old Python bug which is only exercised by the new arrangement of the SBCL compiler.) -132: - Trying to compile - (DEFUN FOO () (CATCH 0 (PRINT 1331))) - gives an error - # is not valid as the second argument to VOP: - SB-C:MAKE-CATCH-BLOCK, - since the TN's primitive type SB-VM::POSITIVE-FIXNUM doesn't allow - any of the SCs allowed by the operand restriction: - (SB-VM::DESCRIPTOR-REG) - The (CATCH 0 ...) construct is bad style (because of unportability - of EQ testing of numbers) but it is legal, and shouldn't cause an - internal compiler error. (This error occurs in sbcl-0.6.13 and in - 0.pre7.86.flaky7.14.) - 135: Ideally, uninterning a symbol would allow it, and its associated FDEFINITION and PROCLAIM data, to be reclaimed by the GC. However, diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 286fdc6..fc02f3e 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -50,7 +50,7 @@ "Return the Unix environment (\"man environ\") as a list of SIMPLE-STRINGs." (c-strings->string-list (wrapped-environ))) -;;; Convert as best we can from a SBCL representation of a Unix +;;; Convert as best we can from an SBCL representation of a Unix ;;; environment to a CMU CL representation. ;;; ;;; * (UNIX-ENVIRONMENT-CMUCL-FROM-SBCL '("Bletch=fub" "Noggin" "YES=No!")) diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp index 34d69f0..3fb91d1 100644 --- a/src/compiler/ctype.lisp +++ b/src/compiler/ctype.lisp @@ -759,3 +759,13 @@ (dolist (ref (leaf-refs var)) (derive-node-type ref type))))) t)))))) + +(defun check-catch-tag-type (tag) + (declare (type continuation tag)) + (let ((ctype (continuation-type tag))) + (when (csubtypep ctype (specifier-type '(or number character))) + (compiler-style-warn "~@" + (continuation-source tag) + (type-specifier (continuation-type tag)))))) diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 7e42924..1c3ed43 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -1370,6 +1370,7 @@ (defun ir2-convert-throw (node block) (declare (type mv-combination node) (type ir2-block block)) (let ((args (basic-combination-args node))) + (check-catch-tag-type (first args)) (vop* throw node block ((continuation-tn node block (first args)) (reference-tn-list @@ -1430,6 +1431,7 @@ ;;; Set up the unwind block for these guys. (defoptimizer (%catch ir2-convert) ((info-cont tag) node block) + (check-catch-tag-type tag) (emit-nlx-start node block (continuation-value info-cont) tag)) (defoptimizer (%unwind-protect ir2-convert) ((info-cont cleanup) node block) (emit-nlx-start node block (continuation-value info-cont) nil)) diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index 2550896..c382da7 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -92,7 +92,7 @@ ;;; tag, and link the block into the CURRENT-CATCH list (define-vop (make-catch-block) (:args (tn) - (tag :scs (descriptor-reg) :to (:result 1))) + (tag :scs (any-reg descriptor-reg) :to (:result 1))) (:info entry-label) (:results (block :scs (any-reg))) (:temporary (:sc descriptor-reg) temp) diff --git a/src/pcl/defclass.lisp b/src/pcl/defclass.lisp index ba280ee..a0f3cd3 100644 --- a/src/pcl/defclass.lisp +++ b/src/pcl/defclass.lisp @@ -116,10 +116,12 @@ (eval-when (:compile-toplevel :load-toplevel :execute) ,defclass-form))) `(progn - ;; By telling the type system at compile time about - ;; the existence of a class named NAME, we can avoid - ;; various bogus warnings about "type isn't defined yet". - ,(when (and + ;; By telling the type system at compile time about + ;; the existence of a class named NAME, we can avoid + ;; various bogus warnings about "type isn't defined yet" + ;; for code elsewhere in the same file which uses + ;; the name of the type. + ,(when (and ;; But it's not so important to get rid of ;; "not defined yet" warnings during ;; bootstrapping, and machinery like @@ -143,7 +145,7 @@ ;; Later, INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS is ;; called by way of LOAD-DEFCLASS (calling ;; ENSURE-CLASS-USING-CLASS) to establish the 'real' - ;; type predicate. + ;; type predicate. (inform-type-system-about-std-class ',name))) ,defclass-form)))))))) diff --git a/src/runtime/Config.x86-linux b/src/runtime/Config.x86-linux index 380f897..85ecf3b 100644 --- a/src/runtime/Config.x86-linux +++ b/src/runtime/Config.x86-linux @@ -11,7 +11,16 @@ ASSEM_SRC = x86-assem.S ldso-stubs.S ARCH_SRC = x86-arch.c OS_SRC = linux-os.c x86-linux-os.c os-common.c -OS_LINK_FLAGS = +# The "--Wl --export-dynamic" flags are here to help people +# experimenting with callbacks from C to SBCL, by allowing linkage to +# SBCL src/runtime/*.c symbols from C. Work on this is good, but it's +# definitely bleeding edge and not particularly stable. In particular, +# not only are the workarounds for the GC relocating Lisp code and +# data unstable, but even the basic calling convention might end up +# being unstable. Unless you want to do some masochistic maintenance +# work when new releases of SBCL come out, please don't try to build +# real code on this until a coherent stable interface has been added! +OS_LINK_FLAGS = -Wl --export-dynamic OS_LIBS = -ldl GC_SRC = gencgc.c diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 7caa057..44943e2 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -52,5 +52,12 @@ (setq x nil)))) (when (and (digs) (digs)) x)))) +;;; Bug 132: The compiler used to fail to compile INTEGER-valued CATCH +;;; tags. This was fixed by Alexey Dejneka in sbcl-0.7.1.14. (They're +;;; still a bad idea because tags are compared with EQ, but now it's a +;;; compiler warning instead of a failure to compile.) +(defun foo () + (catch 0 (print 1331))) + ;;; success (quit :unix-status 104) -- 1.7.10.4