From ca379afc74fe525fd70035546d066de5f5ec874d Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 17 Apr 2003 22:50:39 +0000 Subject: [PATCH] 0.pre8.68: Compile (COERCE FOO 'SIMPLE-VECTOR) to reasonably efficient code (no full call to %TYPEP) even when safe. made DESCRIBE work on structures again bug report for ROOM --- BUGS | 7 +++++++ src/code/profile.lisp | 11 ++++++----- src/compiler/typetran.lisp | 8 +++++++- src/pcl/braid.lisp | 2 +- tests/smoke.impure.lisp | 33 +++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 6 files changed, 55 insertions(+), 8 deletions(-) create mode 100644 tests/smoke.impure.lisp diff --git a/BUGS b/BUGS index 2b36d3f..3389897 100644 --- a/BUGS +++ b/BUGS @@ -1308,6 +1308,13 @@ WORKAROUND: (NTH-VALUE 1000 (VALUES-LIST (MAKE-LIST 1001))) takes several hours to compile. +247: "incomplete conversion of stack parameters in #-SB-THREAD code" + In 0.pre8.67/x86/nothreads, executing (ROOM) causes an error to + be signalled: + The variable SB-VM:CONTROL-STACK-END is unbound. + (When this is fixed, the ROOM entries in tests/smoke.impure.lisp + should be uncommented.) + DEFUNCT CATEGORIES OF BUGS IR1-#: These labels were used for bugs related to the old IR1 interpreter. diff --git a/src/code/profile.lisp b/src/code/profile.lisp index 1f4f793..87eab0b 100644 --- a/src/code/profile.lisp +++ b/src/code/profile.lisp @@ -98,8 +98,7 @@ ;;;; profile encapsulations -;;; Trade off space for time by handling the usual all-FIXNUM cases -;;; inline. +;;; Trade off space for time by handling the usual all-FIXNUM cases inline. (defmacro fastbig- (x y) (once-only ((x x) (y y)) `(if (and (typep ,x '(and fixnum unsigned-byte)) @@ -164,7 +163,7 @@ (aver (typep dticks 'unsigned-byte)) (aver (typep dconsing 'unsigned-byte)) (aver (typep inner-enclosed-profiles 'unsigned-byte)) - (multiple-value-prog1 + (unwind-protect (let* ((start-ticks (get-internal-ticks)) (*enclosed-ticks* 0) (*enclosed-consing* 0) @@ -172,7 +171,7 @@ (nbf0 *n-bytes-freed-or-purified*) (dynamic-usage-0 (sb-kernel:dynamic-usage))) (declare (inline pcounter-or-fixnum->integer)) - (multiple-value-prog1 + (unwind-protect (multiple-value-call encapsulated-fun (sb-c:%more-arg-values arg-context 0 @@ -191,7 +190,9 @@ (pcounter-or-fixnum->integer *enclosed-profiles*)) (let ((net-dticks (fastbig- dticks *enclosed-ticks*))) (fastbig-incf-pcounter-or-fixnum ticks net-dticks)) - (let ((net-dconsing (fastbig- dconsing *enclosed-consing*))) + (let ((net-dconsing (fastbig- dconsing + (pcounter-or-fixnum->integer + *enclosed-consing*)))) (fastbig-incf-pcounter-or-fixnum consing net-dconsing)) (fastbig-incf-pcounter-or-fixnum profiles inner-enclosed-profiles)))) diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp index 06f0de1..c538f46 100644 --- a/src/compiler/typetran.lisp +++ b/src/compiler/typetran.lisp @@ -554,7 +554,12 @@ ((csubtypep tspec (specifier-type 'float)) '(%single-float x)) ((and (csubtypep tspec (specifier-type 'simple-vector)) - (policy node (< safety 3))) + ;; Can we avoid checking for dimension issues like + ;; (COERCE FOO '(SIMPLE-VECTOR 5)) returning a + ;; vector of length 6? + (or (policy node (< safety 3)) ; no need in unsafe code + (and (array-type-p tspec) ; no need when no dimensions + (equal (array-type-dimensions tspec) '(*))))) `(if (simple-vector-p x) x (replace (make-array (length x)) x))) @@ -562,3 +567,4 @@ (t (give-up-ir1-transform))))))) + diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp index 01886b9..87fded0 100644 --- a/src/pcl/braid.lisp +++ b/src/pcl/braid.lisp @@ -547,7 +547,7 @@ :defstruct-accessor-symbol ,accessor ,@(when (fboundp accessor) `(:internal-reader-function - (structure-slotd-reader-function slotd) + ,(structure-slotd-reader-function slotd) :internal-writer-function ,(structure-slotd-writer-function slotd))) :type ,(or (structure-slotd-type slotd) t) diff --git a/tests/smoke.impure.lisp b/tests/smoke.impure.lisp new file mode 100644 index 0000000..87c96de --- /dev/null +++ b/tests/smoke.impure.lisp @@ -0,0 +1,33 @@ +;;;; rudimentary tests ("smoke tests") for miscellaneous stuff which +;;;; doesn't seem to deserve specialized files at the moment + +;;;; 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. + +(cl:in-package :cl-user) + +;;; ROOM should run without signalling an error. (bug 247) +#+nil (room) +#+nil (room t) +#+nil (room nil) + +;;; DESCRIBE should run without signalling an error. +(defstruct to-be-described a b) +(describe (make-to-be-described)) +(describe 12) +(describe "a string") +(describe 'symbolism) +(describe (find-package :cl)) +(describe '(a list)) +(describe #(a vector)) + +;;; success +(quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 229d325..bdcee79 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.pre8.67" +"0.pre8.68" -- 1.7.10.4