[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Nov 23 19:30:29 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv19556
Modified Files:
arrays.lisp
Log Message:
Fixed the array constructors to deal correctly with :fill-pointer t.
Date: Tue Nov 23 20:30:24 2004
Author: ffjeld
Index: movitz/losp/muerte/arrays.lisp
diff -u movitz/losp/muerte/arrays.lisp:1.47 movitz/losp/muerte/arrays.lisp:1.48
--- movitz/losp/muerte/arrays.lisp:1.47 Sun Nov 7 22:07:59 2004
+++ movitz/losp/muerte/arrays.lisp Tue Nov 23 20:30:23 2004
@@ -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.47 2004/11/07 21:07:59 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.48 2004/11/23 19:30:23 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -632,144 +632,149 @@
`(funcall%unsafe ,writer ,store-var , at args)
`(funcall%unsafe ,reader , at args))))
-(defun make-basic-vector%character (dimension fill-pointer initial-element initial-contents)
- (check-type dimension (and fixnum (integer 0 *)))
- (let* ((words (+ 2 (truncate (+ dimension 3) 4)))
+(defun make-basic-vector%character (length fill-pointer initial-element initial-contents)
+ (check-type length (and fixnum (integer 0 *)))
+ (let* ((words (+ 2 (truncate (+ length 3) 4)))
(array (macrolet
((do-it ()
`(with-non-pointer-allocation-assembly (words :fixed-size-p t
:object-register :eax)
- (:load-lexical (:lexical-binding dimension) :ecx)
+ (:load-lexical (:lexical-binding length) :ecx)
(:movl ,(movitz:basic-vector-type-tag :character)
(:eax (:offset movitz-basic-vector type)))
(:movl :ecx (:eax (:offset movitz-basic-vector num-elements))))))
(do-it))))
(cond
- (fill-pointer
+ ((integerp fill-pointer)
(setf (fill-pointer array) fill-pointer))
- ((array-has-fill-pointer-p array)
- (setf (fill-pointer array) dimension)))
+ ((or (eq t fill-pointer)
+ (array-has-fill-pointer-p array))
+ (setf (fill-pointer array) length)))
(cond
(initial-element
(check-type initial-element character)
- (dotimes (i dimension)
+ (dotimes (i length)
(setf (char array i) initial-element)))
(initial-contents
(replace array initial-contents)))
array))
-(defun make-basic-vector%u32 (dimension fill-pointer initial-element initial-contents)
- (check-type dimension (and fixnum (integer 0 *)))
- (let* ((words (+ 2 dimension))
+(defun make-basic-vector%u32 (length fill-pointer initial-element initial-contents)
+ (check-type length (and fixnum (integer 0 *)))
+ (let* ((words (+ 2 length))
(array (macrolet
((do-it ()
`(with-non-pointer-allocation-assembly (words :fixed-size-p t
:object-register :eax)
- (:load-lexical (:lexical-binding dimension) :ecx)
+ (:load-lexical (:lexical-binding length) :ecx)
(:movl ,(movitz:basic-vector-type-tag :u32)
(:eax (:offset movitz-basic-vector type)))
(:movl :ecx (:eax (:offset movitz-basic-vector num-elements))))))
(do-it))))
(cond
- (fill-pointer
+ ((integerp fill-pointer)
(setf (fill-pointer array) fill-pointer))
- ((array-has-fill-pointer-p array)
- (setf (fill-pointer array) dimension)))
+ ((or (eq t fill-pointer)
+ (array-has-fill-pointer-p array))
+ (setf (fill-pointer array) length)))
(cond
(initial-element
;; (check-type initial-element (unsigned-byte 32))
- (dotimes (i dimension)
+ (dotimes (i length)
(setf (u32ref%unsafe array i) initial-element)))
(initial-contents
(replace array initial-contents)))
array))
-(defun make-basic-vector%u8 (dimension fill-pointer initial-element initial-contents)
- (check-type dimension (and fixnum (integer 0 *)))
- (let* ((words (+ 2 (truncate (+ dimension 3) 4)))
+(defun make-basic-vector%u8 (length fill-pointer initial-element initial-contents)
+ (check-type length (and fixnum (integer 0 *)))
+ (let* ((words (+ 2 (truncate (+ length 3) 4)))
(array (macrolet
((do-it ()
`(with-non-pointer-allocation-assembly (words :fixed-size-p t
:object-register :eax)
- (:load-lexical (:lexical-binding dimension) :ecx)
+ (:load-lexical (:lexical-binding length) :ecx)
(:movl ,(movitz:basic-vector-type-tag :u8)
(:eax (:offset movitz-basic-vector type)))
(:movl :ecx (:eax (:offset movitz-basic-vector num-elements))))))
(do-it))))
(cond
- (fill-pointer
+ ((integerp fill-pointer)
(setf (fill-pointer array) fill-pointer))
- ((array-has-fill-pointer-p array)
- (setf (fill-pointer array) dimension)))
+ ((or (eq t fill-pointer)
+ (array-has-fill-pointer-p array))
+ (setf (fill-pointer array) length)))
(cond
(initial-element
(check-type initial-element (unsigned-byte 8))
- (dotimes (i dimension)
+ (dotimes (i length)
(setf (u8ref%unsafe array i) initial-element)))
(initial-contents
(replace array initial-contents)))
array))
-(defun make-basic-vector%bit (dimension fill-pointer initial-element initial-contents)
- (check-type dimension (and fixnum (integer 0 *)))
- (let* ((words (+ 2 (truncate (+ dimension 31) 32)))
+(defun make-basic-vector%bit (length fill-pointer initial-element initial-contents)
+ (check-type length (and fixnum (integer 0 *)))
+ (let* ((words (+ 2 (truncate (+ length 31) 32)))
(array (macrolet
((do-it ()
`(with-non-pointer-allocation-assembly (words :fixed-size-p t
:object-register :eax)
- (:load-lexical (:lexical-binding dimension) :ecx)
+ (:load-lexical (:lexical-binding length) :ecx)
(:movl ,(movitz:basic-vector-type-tag :bit)
(:eax (:offset movitz-basic-vector type)))
(:movl :ecx (:eax (:offset movitz-basic-vector num-elements))))))
(do-it))))
(cond
- (fill-pointer
+ ((integerp fill-pointer)
(setf (fill-pointer array) fill-pointer))
- ((array-has-fill-pointer-p array)
- (setf (fill-pointer array) dimension)))
+ ((or (eq t fill-pointer)
+ (array-has-fill-pointer-p array))
+ (setf (fill-pointer array) length)))
(cond
(initial-element
(check-type initial-element bit)
- (dotimes (i dimension)
+ (dotimes (i length)
(setf (aref array i) initial-element)))
(initial-contents
(replace array initial-contents)))
array))
-(defun make-basic-vector%code (dimension fill-pointer initial-element initial-contents)
- (check-type dimension (and fixnum (integer 0 *)))
- (let* ((words (+ 2 (truncate (+ dimension 3) 4)))
+(defun make-basic-vector%code (length fill-pointer initial-element initial-contents)
+ (check-type length (and fixnum (integer 0 *)))
+ (let* ((words (+ 2 (truncate (+ length 3) 4)))
(array (macrolet
((do-it ()
`(with-non-pointer-allocation-assembly (words :fixed-size-p t
:object-register :eax)
- (:load-lexical (:lexical-binding dimension) :ecx)
+ (:load-lexical (:lexical-binding length) :ecx)
(:movl ,(movitz:basic-vector-type-tag :code)
(:eax (:offset movitz-basic-vector type)))
(:movl :ecx (:eax (:offset movitz-basic-vector num-elements))))))
(do-it))))
(cond
- (fill-pointer
+ ((integerp fill-pointer)
(setf (fill-pointer array) fill-pointer))
- ((array-has-fill-pointer-p array)
- (setf (fill-pointer array) dimension)))
+ ((or (eq t fill-pointer)
+ (array-has-fill-pointer-p array))
+ (setf (fill-pointer array) length)))
(cond
(initial-element
(check-type initial-element (unsigned-byte 8))
- (dotimes (i dimension)
+ (dotimes (i length)
(setf (u8ref%unsafe array i) initial-element)))
(initial-contents
(replace array initial-contents)))
array))
-(defun make-basic-vector%t (dimension fill-pointer initial-element initial-contents)
- (check-type dimension (and fixnum (integer 0 *)))
- (let* ((words (+ 2 dimension))
+(defun make-basic-vector%t (length fill-pointer initial-element initial-contents)
+ (check-type length (and fixnum (integer 0 *)))
+ (let* ((words (+ 2 length))
(array (macrolet
((do-it ()
`(with-allocation-assembly (words :fixed-size-p t
:object-register :eax)
- (:load-lexical (:lexical-binding dimension) :ecx)
+ (:load-lexical (:lexical-binding length) :ecx)
(:movl ,(movitz:basic-vector-type-tag :any-t)
(:eax (:offset movitz-basic-vector type)))
(:movl :ecx (:eax (:offset movitz-basic-vector num-elements)))
@@ -785,17 +790,14 @@
)))
(do-it))))
(cond
- (fill-pointer
+ ((integerp fill-pointer)
(setf (fill-pointer array) fill-pointer))
- ((array-has-fill-pointer-p array)
- (setf (fill-pointer array) dimension)))
+ ((or (eq t fill-pointer)
+ (array-has-fill-pointer-p array))
+ (setf (fill-pointer array) length)))
(cond
(initial-contents
- (replace array initial-contents))
- #+ignore
- (initial-element
- (dotimes (i dimension)
- (setf (svref%unsafe array i) initial-element))))
+ (replace array initial-contents)))
array))
(defun make-array (dimensions &key element-type initial-element initial-contents adjustable
More information about the Movitz-cvs
mailing list