Permalink
Browse files

0.7.10.30:

        Fixed bug 232, shown by Paul Dietz' test suite.
  • Loading branch information...
1 parent 9c7b863 commit caf8bb05a82659e688c125b418783bc8a3bd2be8 Alexey Dejneka committed Dec 22, 2002
Showing with 102 additions and 34 deletions.
  1. +8 −16 BUGS
  2. +2 −0 NEWS
  3. +65 −0 OPTIMIZATIONS
  4. +15 −15 src/code/loop.lisp
  5. +3 −2 tests/compiler-1.impure-cload.lisp
  6. +8 −0 tests/loop.pure.lisp
  7. +1 −1 version.lisp-expr
View
24 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-#:
View
2 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.
View
@@ -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]<t35[AL]
+ MOV #<TN t33[CL]>, #<TN t30[S2]>
+ MOV BYTE PTR [EDI+EAX+1], #<TN t33[CL]>
+ MOV #<TN t35[AL]>, #<TN t33[CL]>
+ MOV #<TN t34[S2]>, #<TN t35[AL]>
+
+* The value of DATA-VECTOR-SET is not used, so there is no need in the
+ last two moves.
+
+* And why two moves?
View
@@ -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
@@ -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)))
View
@@ -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)))
View
@@ -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"

0 comments on commit caf8bb0

Please sign in to comment.