[movitz-cvs] CVS movitz/losp/muerte
ffjeld
ffjeld at common-lisp.net
Sun Apr 8 15:52:33 UTC 2007
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv16794
Modified Files:
arrays.lisp
Log Message:
Fixed a stupid bug in (setf fill-pointer) which made make-array fail
on vectors of length between #x1000 and #x4000.
--- /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp 2007/04/07 20:18:20 1.62
+++ /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp 2007/04/08 15:52:33 1.63
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Sun Feb 11 23:14:04 2001
;;;;
-;;;; $Id: arrays.lisp,v 1.62 2007/04/07 20:18:20 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.63 2007/04/08 15:52:33 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -157,7 +157,7 @@
"Does the basic-vector have a fill-pointer?"
`(with-inline-assembly (:returns :boolean-zf=1)
(:compile-form (:result-mode :eax) ,vector)
- (:testl ,(logxor #xffffffff (1- (expt 2 14)))
+ (:testl ,(logxor #xffffffff (* movitz:+movitz-fixnum-factor+ (1- (expt 2 14))))
(:eax ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)))))
(define-compiler-macro %basic-vector-fill-pointer (vector)
@@ -232,7 +232,8 @@
(:jnz 'illegal-fill-pointer)
(:movl (:ebx (:offset movitz-basic-vector num-elements))
:ecx)
- (:testl ,(logxor #xffffffff (1- (expt 2 14))) :ecx)
+ (:testl ,(logxor #xffffffff (* movitz:+movitz-fixnum-factor+ (1- (expt 2 14))))
+ :ecx)
(:jnz '(:sub-program ()
(:compile-form (:result-mode :ignore)
(error "Vector has no fill-pointer."))))
@@ -1099,6 +1100,7 @@
(do-it))))
(cond
((integerp fill-pointer)
+ (warn "sfp len: ~s" (array-dimension array 0))
(setf (fill-pointer array) fill-pointer))
((or (eq t fill-pointer)
(array-has-fill-pointer-p array))
More information about the Movitz-cvs
mailing list