From 0b39d68b05ef669f812a6bf570126505d931bf96 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Tue, 10 Jun 2003 06:48:57 +0000 Subject: [PATCH] 0.8.0.57: * Signal a style warning when DECLAIM is met in a declaration position; * Don't join blocks if the separating continuation's dest is CRETURN; * DO-USES: in the restart mode stop iterations when the block is deleted under us. --- BUGS | 83 +------------------------------------- src/code/parse-body.lisp | 7 +++- src/compiler/ir1opt.lisp | 3 +- src/compiler/macros.lisp | 3 +- tests/compiler.impure-cload.lisp | 56 +++++++++++++++++++++++++ version.lisp-expr | 2 +- 6 files changed, 69 insertions(+), 85 deletions(-) create mode 100644 tests/compiler.impure-cload.lisp diff --git a/BUGS b/BUGS index ab82a20..ebfa99b 100644 --- a/BUGS +++ b/BUGS @@ -566,22 +566,6 @@ WORKAROUND: under OpenBSD 2.9 on my X86 laptop. Do be patient when you try it: it took more than two minutes (but less than five) for me. -144: - (This was once known as IR1-4, but it lived on even after the - IR1 interpreter went to the big bit bucket in the sky.) - The system accepts DECLAIM in most places where DECLARE would be - accepted, without even issuing a warning. ANSI allows this, but since - it's fairly easy to mistype DECLAIM instead of DECLARE, and the - meaning is rather different, and it's unlikely that the user - has a good reason for doing DECLAIM not at top level, it would be - good to issue a STYLE-WARNING when this happens. A possible - fix would be to issue STYLE-WARNINGs for DECLAIMs not at top level, - or perhaps to issue STYLE-WARNINGs for any EVAL-WHEN not at top level. - [This is considered an IR1-interpreter-related bug because until - EVAL-WHEN is rewritten, which won't happen until after the IR1 - interpreter is gone, the system's notion of what's a top-level form - and what's not will remain too confused to fix this problem.] - 145: ANSI allows types `(COMPLEX ,FOO) to use very hairy values for FOO, e.g. (COMPLEX (AND REAL (SATISFIES ODDP))). The old CMU CL @@ -636,7 +620,6 @@ WORKAROUND: (due to reordering of the compiler this example is compiled successfully by 0.7.14, but the bug probably remains) - (possibly exercised by bug 254 test case) 162: (reported by Robert E. Brown 2002-04-16) @@ -1113,70 +1096,8 @@ WORKAROUND: does not cause a warning. (BTW: old SBCL issued a warning, but for a function, which was never called!) -253: "type checking is embedded THEs" - Compiler cannot perform type checking in - - (let () (list (the fixnum (the unsigned-byte (eval -1))))) - - (fixed in 0.8.0.34) - -254: (possibly bug 148 in a new guise) - In sbcl-0.8.0.52, COMPILE-FILE on - (cl:in-package :cl-user) - (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1))) - (defstruct foo - (uhw2 nil :type (or package null))) - (macrolet ((defprojection (variant &key lexpr eexpr) - (let () - `(defmethod uu ((foo foo)) - (let ((uhw2 (foo.uhw2 bar))) - (let () - (u-flunt uhw2 - (baz (funcall ,lexpr south east 1))))))))) - (defprojection h - :lexpr (lambda (south east sched) - (flet ((bd (x) (bref x sched))) - (let ((avecname (gafp))) - (declare (type (vector t) avecname)) - (multiple-value-prog1 - (progn - (setf (avec.count avecname) (length rest)) - (setf (aref avecname 0) (bd (h south))) - (setf (aref avecname 1) (bd (h east))) - (stub avecname)) - (paip avecname))))) - :eexpr (lambda (south east)))) - fails with - debugger invoked on condition of type TYPE-ERROR: - The value NIL is not of type SB-C::NODE. - -255: - In sbcl-0.8.0.52, COMPILE-FILE on - (cl:in-package :cl-user) - (declaim (optimize (safety 3) (debug 2) (speed 2) (space 1))) - (defvar *1*) - (defvar *2*) - (defstruct v a b) - (defstruct w) - (defstruct yam (v nil :type (or v null))) - (defstruct un u) - (defstruct (bod (:include un)) bo) - (defstruct (bad (:include bod)) ba) - (declaim (ftype (function ((or w bad) (or w bad)) (values)) %ufm)) - (defun %ufm (base bound) (froj base bound *1*) (values)) - (declaim (ftype (function ((vector t)) (or w bad)) %pu)) - (defun %pu (pds) *2*) - (defun uu (yam) - (let ((v (yam-v az))) - (%ufm v - (flet ((project (x) (frob x 0))) - (let ((avecname *1*)) - (multiple-value-prog1 - (progn (%pu avecname)) - (frob))))))) - fails with - failed AVER: - "(AND (EQ (CONTINUATION-KIND START) INSIDE-BLOCK) (NOT (BLOCK-DELETE-P BLOCK)))" +255: + (fixed in 0.8.0.57) DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/src/code/parse-body.lisp b/src/code/parse-body.lisp index 8a1ed02..f19db1c 100644 --- a/src/code/parse-body.lisp +++ b/src/code/parse-body.lisp @@ -50,7 +50,12 @@ t))))) (declaration-p (x) (if (consp x) - (eq (car x) 'declare)))) + (let ((name (car x))) + (if (eq name 'declaim) + (progn (style-warn + "DECLAIM is met where DECLARE is expected.") + nil) + (eq name 'declare)))))) (tagbody :again (if forms diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 3f83536..08c20ad 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -411,7 +411,8 @@ (join-blocks block next)) t) ((and (null (block-start-uses next)) - (not (exit-p (continuation-dest last-cont))) + (not (typep (continuation-dest last-cont) + '(or exit creturn))) (null (continuation-lexenv-uses last-cont))) (assert (null (find-uses next-cont))) (when (continuation-dest last-cont) diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index 1dd4bbc..ecc3d9e 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -616,7 +616,8 @@ (declare (type node ,node-var)) ,@body (when ,(if restart-p - `(eq ,node-var (block-last ,n-block)) + `(or (eq ,node-var (block-last ,n-block)) + (block-delete-p ,n-block)) `(eq ,cont-var ,n-last-cont)) (return nil)))))) ;;; like DO-NODES, only iterating in reverse order diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp new file mode 100644 index 0000000..2e8011f --- /dev/null +++ b/tests/compiler.impure-cload.lisp @@ -0,0 +1,56 @@ +;;; bug 254: compiler falure +(defpackage :bug254 (:use :cl)) +(in-package :bug254) +(declaim (optimize (safety 3) (debug 2) (speed 2) (space 1))) +(defstruct foo + (uhw2 nil :type (or package null))) +(macrolet ((defprojection (variant &key lexpr eexpr) + (let () + `(defmethod uu ((foo foo)) + (let ((uhw2 (foo.uhw2 bar))) + (let () + (u-flunt uhw2 + (baz (funcall ,lexpr south east 1))))))))) + (defprojection h + :lexpr (lambda (south east sched) + (flet ((bd (x) (bref x sched))) + (let ((avecname (gafp))) + (declare (type (vector t) avecname)) + (multiple-value-prog1 + (progn + (setf (avec.count avecname) (length rest)) + (setf (aref avecname 0) (bd (h south))) + (setf (aref avecname 1) (bd (h east))) + (stub avecname)) + (paip avecname))))) + :eexpr (lambda (south east)))) +(delete-package :bug254) + +;;; bug 255 +(defpackage :bug255 (:use :cl)) +(in-package :bug255) +(declaim (optimize (safety 3) (debug 2) (speed 2) (space 1))) +(defvar *1*) +(defvar *2*) +(defstruct v a b) +(defstruct w) +(defstruct yam (v nil :type (or v null))) +(defstruct un u) +(defstruct (bod (:include un)) bo) +(defstruct (bad (:include bod)) ba) +(declaim (ftype (function ((or w bad) (or w bad)) (values)) %ufm)) +(defun %ufm (base bound) (froj base bound *1*) (values)) +(declaim (ftype (function ((vector t)) (or w bad)) %pu)) +(defun %pu (pds) *2*) +(defun uu (yam) + (let ((v (yam-v az))) + (%ufm v + (flet ((project (x) (frob x 0))) + (let ((avecname *1*)) + (multiple-value-prog1 + (progn (%pu avecname)) + (frob))))))) +(delete-package :bug255) + + +(sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 324a40b..52221cc 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".) -"0.8.0.56" +"0.8.0.57" -- 1.7.10.4