From caf8bb05a82659e688c125b418783bc8a3bd2be8 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sun, 22 Dec 2002 14:19:52 +0000 Subject: [PATCH] 0.7.10.30: Fixed bug 232, shown by Paul Dietz' test suite. --- BUGS | 24 +++++-------- NEWS | 2 ++ OPTIMIZATIONS | 65 ++++++++++++++++++++++++++++++++++++ src/code/loop.lisp | 30 ++++++++--------- tests/compiler-1.impure-cload.lisp | 5 +-- tests/loop.pure.lisp | 8 +++++ version.lisp-expr | 2 +- 7 files changed, 102 insertions(+), 34 deletions(-) create mode 100644 OPTIMIZATIONS diff --git a/BUGS b/BUGS index 4cbbbb8..0fb8f69 100644 --- a/BUGS +++ b/BUGS @@ -1190,22 +1190,14 @@ WORKAROUND: 229: (subtypep 'function '(function)) => nil, t. -231: "SETQ does not correctly check the type of a variable being set" - (reported by Robert E. Brown sbcl-devel 2002-12-19) - in sbcl-0.7.10.19, - (DEFUN FOO (X) - (DECLARE (OPTIMIZE SAFETY) (TYPE (INTEGER 0 8) X)) - (INCF X)) - (FOO 8) - returns 9, rather than (as in CMUCL) signalling an error. Replacing - (INCF X) by (SETQ X (+ X 1)) causes a TYPE-ERROR to be signalled. Or - (defun bar (x y) - (declare (type (integer 0 8) x)) - (setq x y) - x) - Then (BAR 7 9) returns 9. - - (fixed in 0.7.10.28) +232: + (shown by Paul Dietz' test suite) + + (loop for v fixnum being each hash-key in ...) + + in 0.7.10.29 signals an error "NIL is not of type FIXNUM". + (fixed in 0.7.10.30) + DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/NEWS b/NEWS index 02200a7..6496715 100644 --- a/NEWS +++ b/NEWS @@ -1468,6 +1468,8 @@ changes in sbcl-0.7.11 relative to sbcl-0.7.10: of the slot symbol, rather than using the current package ((:CONC-NAME "") continues to intern the slot's name in the current package); + ** LOOP with a typed iteration variable over a hashtable now + signals a type error iff it should; * incremented fasl file version number, because of the incompatible change to the DEFSTRUCT-DESCRIPTION structure, and again because of the new implementation of DEFINE-COMPILER-MACRO. diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS new file mode 100644 index 0000000..bb50f42 --- /dev/null +++ b/OPTIMIZATIONS @@ -0,0 +1,65 @@ +(defun mysl (s) + (declare (simple-string s)) + (declare (optimize (speed 3) (safety 0) (debug 0))) + (let ((c 0)) + (declare (fixnum c)) + (dotimes (i (length s)) + (when (eql (aref s i) #\1) + (incf c))) + c)) + +* On X86 I is represented as a tagged integer. + +* EQL uses "CMP reg,reg" instead of "CMP reg,im". This causes + allocation of extra register and extra move. + +* Unnecessary move: + 3: SLOT S!11[EDX] {SB-C::VECTOR-LENGTH 1 7} => t23[EAX] + 4: MOVE t23[EAX] => t24[EBX] + +-------------------------------------------------------------------------------- +(defun quux (v) + (declare (optimize (speed 3) (safety 0) (space 2) (debug 0))) + (declare (type (simple-array double-float 1) v)) + (let ((s 0d0)) + (declare (type double-float s)) + (dotimes (i (length v)) + (setq s (+ s (aref v i)))) + s)) + +* Python does not combine + with AREF, so generates extra move and + allocates a register. + +* On X86 Python thinks that all FP registers are directly accessible + and emits costy MOVE ... => FR1. + +-------------------------------------------------------------------------------- +(defun bar (n) + (declare (optimize (speed 3) (safety 0) (space 2)) + (type fixnum n)) + (let ((v (make-list n))) + (setq v (make-array n)) + (length v))) + +* IR1 does not optimize away (MAKE-LIST N). + +* IR1 thinks that the type of V in (LENGTH V) is (OR LIST SIMPLE-VECTOR), not + SIMPLE-VECTOR. +-------------------------------------------------------------------------------- +(defun bar (v1 v2) + (declare (optimize (speed 3) (safety 0) (space 2)) + (type (simple-array base-char 1) v1 v2)) + (dotimes (i (length v1)) + (setf (aref v2 i) (aref v1 i)))) + +VOP DATA-VECTOR-SET/SIMPLE-STRING V2!14[EDI] t32[EAX] t30[S2]>t33[CL] + => t34[S2], # + MOV BYTE PTR [EDI+EAX+1], # + MOV #, # + MOV #, # + +* The value of DATA-VECTOR-SET is not used, so there is no need in the + last two moves. + +* And why two moves? diff --git a/src/code/loop.lisp b/src/code/loop.lisp index 23d714e..43962bd 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -1852,22 +1852,22 @@ code to be loaded. (:hash-value (setq key-var (and other-p other-var) val-var variable))) (push `(with-hash-table-iterator (,next-fn ,ht-var)) *loop-wrappers*) - (when (consp key-var) - (setq post-steps - `(,key-var ,(setq key-var (gensym "LOOP-HASH-KEY-TEMP-")) - ,@post-steps)) - (push `(,key-var nil) bindings)) - (when (consp val-var) - (setq post-steps - `(,val-var ,(setq val-var (gensym "LOOP-HASH-VAL-TEMP-")) - ,@post-steps)) - (push `(,val-var nil) bindings)) - `(,bindings ;bindings - () ;prologue - () ;pre-test - () ;parallel steps + (when (or (consp key-var) data-type) + (setq post-steps + `(,key-var ,(setq key-var (gensym "LOOP-HASH-KEY-TEMP-")) + ,@post-steps)) + (push `(,key-var nil) bindings)) + (when (or (consp val-var) data-type) + (setq post-steps + `(,val-var ,(setq val-var (gensym "LOOP-HASH-VAL-TEMP-")) + ,@post-steps)) + (push `(,val-var nil) bindings)) + `(,bindings ;bindings + () ;prologue + () ;pre-test + () ;parallel steps (not (multiple-value-setq (,dummy-predicate-var ,key-var ,val-var) - (,next-fn))) ;post-test + (,next-fn))) ;post-test ,post-steps))))) (defun loop-package-symbols-iteration-path (variable data-type prep-phrases diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index 8bc82bf..4d5b104 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -14,8 +14,9 @@ (cl:in-package :cl-user) -(load "assertoid") -(use-package "ASSERTOID") +(eval-when (:compile-toplevel :load-toplevel :execute) + (load "assertoid") + (use-package "ASSERTOID")) (declaim (optimize (debug 3) (speed 2) (space 1))) diff --git a/tests/loop.pure.lisp b/tests/loop.pure.lisp index 278fa4c..95933d4 100644 --- a/tests/loop.pure.lisp +++ b/tests/loop.pure.lisp @@ -171,3 +171,11 @@ collect it and collect it) '(a z b z c z d z)))) + +(let ((ht (make-hash-table))) + (setf (gethash 1 ht) 3) + (setf (gethash 7 ht) 15) + (assert (= (loop for v fixnum being each hash-key in ht sum v) 8)) + (assert (= (loop for v fixnum being each hash-value in ht sum v) 18)) + (assert (raises-error? (loop for v float being each hash-value in ht sum v) + type-error))) diff --git a/version.lisp-expr b/version.lisp-expr index 881182a..c8ff92b 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.10.29" +"0.7.10.30" -- 1.7.10.4