[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Thu Jul 8 15:28:53 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv26827
Modified Files:
arrays.lisp
Log Message:
Implemented bit-vectors.
Date: Thu Jul 8 08:28:52 2004
Author: ffjeld
Index: movitz/losp/muerte/arrays.lisp
diff -u movitz/losp/muerte/arrays.lisp:1.31 movitz/losp/muerte/arrays.lisp:1.32
--- movitz/losp/muerte/arrays.lisp:1.31 Thu Jul 8 04:30:14 2004
+++ movitz/losp/muerte/arrays.lisp Thu Jul 8 08:28:52 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.31 2004/07/08 11:30:14 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.32 2004/07/08 15:28:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -205,7 +205,13 @@
((do-it ()
`(with-inline-assembly (:returns :eax)
(:declare-label-set basic-vector-dispatcher
- (any-t character u8 unknown u32 unknown code unknown))
+ ,(print (loop with x = (make-list 8 :initial-element 'unknown)
+ for et in '(:any-t :character :u8 :u32 :code :bit)
+ do (setf (elt x (bt:enum-value
+ 'movitz::movitz-vector-element-type
+ et))
+ et)
+ finally (return x))))
(:compile-two-forms (:eax :ebx) array index)
(:movl (:eax ,movitz:+other-type-offset+) :ecx)
(:cmpb ,(movitz:tag :basic-vector) :cl)
@@ -231,19 +237,19 @@
,(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0)))
(() () '(:sub-program (unknown) (:int 100)))
- u32
+ :u32
(:movl (:eax :ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data))
:ecx)
(:call-global-constant box-u32-ecx)
(:jmp 'return)
- u8 code
+ :u8 :code
(:movl :ebx :ecx)
(:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
(:movzxb (:eax :ecx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data))
:ecx)
(:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax)
(:jmp 'return)
- character
+ :character
(:movl :ebx :ecx)
(:movl :eax :ebx)
(:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
@@ -251,7 +257,16 @@
(:movb (:ebx :ecx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data))
:ah)
(:jmp 'return)
- any-t
+ :bit
+ (:movl :ebx :ecx)
+ (:movl :eax :ebx)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:xorl :eax :eax)
+ (:btl :ecx (:ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)))
+ (:jnc 'return)
+ (:addl ,movitz:+movitz-fixnum-factor+ :eax)
+ (:jmp 'return)
+ :any-t
(:movl (:eax :ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data))
:eax)
return)))
@@ -274,13 +289,18 @@
(:testb 7 :cl)
(:jnz '(:sub-program (not-a-vector)
(:compile-form (:result-mode :ignore)
- (error "Not a vector: ~S" vector))))
+ (error "Not a vector: ~S." vector))))
(:movl (:ebx ,movitz:+other-type-offset+) :ecx)
(:andl #xffff :ecx)
(:testb ,movitz:+movitz-fixnum-zmask+ :dl)
(:jnz '(:sub-program (not-an-index)
(:compile-form (:result-mode :ignore)
- (error "Not a vector index: ~S" index))))
+ (error "Not a vector index: ~S." index))))
+ (:cmpl (:ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements))
+ :edx)
+ (:jnc '(:sub-program (illegal-index)
+ (:compile-form (:result-mode :ignore)
+ (error "Index ~S out of range." index))))
;; t?
(:cmpl ,(movitz:basic-vector-type-tag :any-t) :ecx)
(:jne 'not-any-t-vector)
@@ -317,6 +337,7 @@
(:jmp 'return)
not-u8-vector
+ ;; u32?
(:cmpl ,(movitz:basic-vector-type-tag :u32) :ecx)
(:jne 'not-u32-vector)
(:call-global-constant unbox-u32)
@@ -325,6 +346,26 @@
(:jmp 'return)
not-u32-vector
+ ;; bit?
+ (:cmpl ,(movitz:basic-vector-type-tag :bit) :ecx)
+ (:jne 'not-u8-vector)
+ (:testl ,(logxor #xffffffff (* #x1 movitz:+movitz-fixnum-factor+))
+ :eax)
+ (:jne '(:sub-program (not-a-bit)
+ (:compile-form (:result-mode :ignore)
+ (error "Not a bit: ~S" value))))
+ (:movl :edx :ecx)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+
+ (:testl :eax :eax)
+ (:jnz 'set-one-bit)
+ (:btrl :ecx (:ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)))
+ (:jmp 'return)
+ set-one-bit
+ (:btsl :ecx (:ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)))
+ (:jmp 'return)
+
+ not-bit-vector
(:compile-form (:result-mode :ignore)
(error "Not a vector: ~S" vector))
return)
@@ -554,11 +595,11 @@
(replace array initial-contents)))
array))
-(defun make-basic-vector%u8 (dimensions fill-pointer initial-element initial-contents)
- (let ((array (malloc-data-words (truncate (+ dimensions 3) 4))))
+(defun make-basic-vector%u8 (length fill-pointer initial-element initial-contents)
+ (let ((array (malloc-data-words (truncate (+ length 3) 4))))
(setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)
0 :lisp)
- dimensions)
+ length)
(setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::type)
0 :unsigned-byte32)
#.(movitz:basic-vector-type-tag :u8))
@@ -566,16 +607,38 @@
(fill-pointer
(setf (fill-pointer array) fill-pointer))
((array-has-fill-pointer-p array)
- (setf (fill-pointer array) dimensions)))
+ (setf (fill-pointer array) length)))
(cond
(initial-element
(check-type initial-element (unsigned-byte 8))
- (dotimes (i dimensions)
+ (dotimes (i length)
(setf (u8ref%unsafe array i) initial-element)))
(initial-contents
(replace array initial-contents)))
array))
+(defun make-basic-vector%bit (length fill-pointer initial-element initial-contents)
+ (let ((array (malloc-data-words (truncate (+ length 31) 32))))
+ (setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)
+ 0 :lisp)
+ length)
+ (setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::type)
+ 0 :unsigned-byte32)
+ #.(movitz:basic-vector-type-tag :bit))
+ (cond
+ (fill-pointer
+ (setf (fill-pointer array) 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 length)
+ (setf (aref array i) initial-element)))
+ (initial-contents
+ (replace array initial-contents)))
+ array))
+
(defun make-basic-vector%code (dimensions fill-pointer initial-element initial-contents)
(let ((array (malloc-data-words (truncate (+ dimensions 3) 4))))
(setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)
@@ -631,6 +694,8 @@
;; These should be replaced by subtypep sometime.
((eq element-type 'character)
(make-basic-vector%character dimensions fill-pointer initial-element initial-contents))
+ ((member element-type '(bit (unsigned-byte 1)) :test #'equal)
+ (make-basic-vector%bit dimensions fill-pointer initial-element initial-contents))
((member element-type '(u8 (unsigned-byte 8)) :test #'equal)
(make-basic-vector%u8 dimensions fill-pointer initial-element initial-contents))
((member element-type '(u32 (unsigned-byte 32)) :test #'equal)
More information about the Movitz-cvs
mailing list