[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Mon Oct 11 13:52:13 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv30496
Modified Files:
arrays.lisp
Log Message:
Changed the signature of memref and (setf memref) to use keywords also
for the index and type arguments.
Date: Mon Oct 11 15:52:12 2004
Author: ffjeld
Index: movitz/losp/muerte/arrays.lisp
diff -u movitz/losp/muerte/arrays.lisp:1.44 movitz/losp/muerte/arrays.lisp:1.45
--- movitz/losp/muerte/arrays.lisp:1.44 Fri Sep 24 11:31:19 2004
+++ movitz/losp/muerte/arrays.lisp Mon Oct 11 15:52:12 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.44 2004/09/24 09:31:19 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.45 2004/10/11 13:52:12 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -22,8 +22,8 @@
(in-package muerte)
(defun vector-element-type (object)
- (memref object #.(bt:slot-offset 'movitz::movitz-basic-vector 'movitz::element-type) 0
- :unsigned-byte8))
+ (memref object (movitz-type-slot-offset 'movitz-basic-vector 'element-type)
+ :type :unsigned-byte8))
(defmacro vector-double-dispatch ((s1 s2) &rest clauses)
(flet ((make-double-dispatch-value (et1 et2)
@@ -43,14 +43,13 @@
forms))))))
(define-compiler-macro vector-element-type (object)
- `(memref ,object 0
- ,(bt:slot-offset 'movitz::movitz-basic-vector 'movitz::element-type)
- :unsigned-byte8))
+ `(memref ,object (movitz-type-slot-offset 'movitz-basic-vector 'element-type)
+ :type :unsigned-byte8))
(defun (setf vector-element-type) (numeric-element-type vector)
(check-type vector vector)
- (setf (memref vector #.(bt:slot-offset 'movitz::movitz-basic-vector 'movitz::element-type) 0
- :unsigned-byte8)
+ (setf (memref vector (movitz-type-slot-offset 'movitz-basic-vector 'element-type)
+ :type :unsigned-byte8)
numeric-element-type))
(defun array-element-type (array)
@@ -114,15 +113,16 @@
(etypecase array
((simple-array * 1)
(assert (zerop axis-number))
- (movitz-accessor array movitz-basic-vector num-elements))))
+ (memref array (movitz-type-slot-offset 'movitz-basic-vector 'num-elements)))))
(defun array-dimensions (array)
(check-type array array)
1)
(defun shrink-vector (vector new-size)
- (setf-movitz-accessor (vector movitz-basic-vector num-elements) new-size)
- vector)
+ (check-type vector vector)
+ (setf (memref vector (movitz-type-slot-offset 'movitz-basic-vector 'num-elements))
+ new-size))
(define-compiler-macro %basic-vector-has-fill-pointer-p (vector)
"Does the basic-vector have a fill-pointer?"
@@ -155,29 +155,21 @@
(defun copy-vector (vector)
(check-type vector vector)
- (ecase (vector-element-type vector)
- (#.(bt:enum-value 'movitz::movitz-vector-element-type :any-t)
- (%shallow-copy-object
- vector
- (+ 2 (movitz-accessor vector movitz-basic-vector num-elements))))
- (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32)
- (%shallow-copy-non-pointer-object
- vector
- (+ 2 (movitz-accessor vector movitz-basic-vector num-elements))))
- ((#.(bt:enum-value 'movitz::movitz-vector-element-type :character)
- #.(bt:enum-value 'movitz::movitz-vector-element-type :u8)
- #.(bt:enum-value 'movitz::movitz-vector-element-type :code))
- (%shallow-copy-non-pointer-object
- vector
- (+ 2 (truncate (+ 3 (movitz-accessor vector movitz-basic-vector num-elements)) 4))))
- (#.(bt:enum-value 'movitz::movitz-vector-element-type :u16)
- (%shallow-copy-non-pointer-object
- vector
- (+ 2 (truncate (+ 1 (movitz-accessor vector movitz-basic-vector num-elements)) 2))))
- (#.(bt:enum-value 'movitz::movitz-vector-element-type :bit)
- (%shallow-copy-non-pointer-object
- vector
- (+ 2 (truncate (+ 31 (movitz-accessor vector movitz-basic-vector num-elements)) 32))))))
+ (let ((length (the fixnum
+ (memref vector (movitz-type-slot-offset 'movitz-basic-vector 'num-elements)))))
+ (ecase (vector-element-type vector)
+ (#.(bt:enum-value 'movitz::movitz-vector-element-type :any-t)
+ (%shallow-copy-object vector (+ 2 length)))
+ (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32)
+ (%shallow-copy-non-pointer-object vector (+ 2 length)))
+ ((#.(bt:enum-value 'movitz::movitz-vector-element-type :character)
+ #.(bt:enum-value 'movitz::movitz-vector-element-type :u8)
+ #.(bt:enum-value 'movitz::movitz-vector-element-type :code))
+ (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 3 length) 4))))
+ (#.(bt:enum-value 'movitz::movitz-vector-element-type :u16)
+ (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 1 length) 2))))
+ (#.(bt:enum-value 'movitz::movitz-vector-element-type :bit)
+ (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 31 length) 32)))))))
(defun (setf fill-pointer) (new-fill-pointer vector)
(etypecase vector
@@ -298,8 +290,7 @@
(error "Index ~D is beyond vector length ~D."
index
(memref array
- ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)
- 0 :lisp)))))
+ (movitz-type-slot-offset 'movitz-basic-vector 'num-elements))))))
(:jmp (:esi (:ecx 4) 'basic-vector-dispatcher
,(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0)))
@@ -454,10 +445,10 @@
;;; simple-vector accessors
(define-compiler-macro svref%unsafe (simple-vector index)
- `(memref ,simple-vector 2 ,index :lisp))
+ `(memref ,simple-vector 2 :index ,index))
(define-compiler-macro (setf svref%unsafe) (value simple-vector index)
- `(setf (memref ,simple-vector 2 ,index :lisp) ,value))
+ `(setf (memref ,simple-vector 2 :index ,index) ,value))
(defun svref%unsafe (simple-vector index)
;; (compiler-macro-call svref%unsafe simple-vector index))
@@ -522,16 +513,16 @@
(defun char (string index)
(check-type string string)
(assert (below index (array-dimension string 0)))
- (memref string 2 index :character))
+ (memref string 2 :index index :type :character))
(defun (setf char) (value string index)
(assert (below index (array-dimension string 0)))
- (setf (memref string 2 index :character) value))
+ (setf (memref string 2 :index index :type :character) value))
(defun schar (string index)
(check-type string string)
(assert (below index (length string)))
- (memref string 2 index :character))
+ (memref string 2 :index index :type :character))
(defun (setf schar) (value string index)
(check-type string string)
@@ -539,13 +530,13 @@
(setf (aref string index) value))
(define-compiler-macro char%unsafe (string index)
- `(memref ,string 2 ,index :character))
+ `(memref ,string 2 :index ,index :type :character))
(defun char%unsafe (string index)
(char%unsafe string index))
(define-compiler-macro (setf char%unsafe) (value string index)
- `(setf (memref ,string 2 ,index :character) ,value))
+ `(setf (memref ,string 2 :index ,index :type :character) ,value))
(defun (setf char%unsafe) (value string index)
(setf (char%unsafe string index) value))
@@ -553,13 +544,13 @@
;;; u8 accessors
(define-compiler-macro u8ref%unsafe (vector index)
- `(memref ,vector 2 ,index :unsigned-byte8))
+ `(memref ,vector 2 :index ,index :type :unsigned-byte8))
(defun u8ref%unsafe (vector index)
(u8ref%unsafe vector index))
(define-compiler-macro (setf u8ref%unsafe) (value vector index)
- `(setf (memref ,vector 2 ,index :unsigned-byte8) ,value))
+ `(setf (memref ,vector 2 :index ,index :type :unsigned-byte8) ,value))
(defun (setf u8ref%unsafe) (value vector index)
(setf (u8ref%unsafe vector index) value))
@@ -567,7 +558,7 @@
;;; u32 accessors
(define-compiler-macro u32ref%unsafe (vector index)
- `(memref ,vector 2 ,index :unsigned-byte32))
+ `(memref ,vector 2 :index ,index :type :unsigned-byte32))
(defun u32ref%unsafe (vector index)
(compiler-macro-call u32ref%unsafe vector index))
@@ -576,7 +567,7 @@
(let ((var (gensym "setf-u32ref-value-")))
;; Use var so as to avoid re-boxing of the u32 value.
`(let ((,var ,value))
- (setf (memref ,vector 2 ,index :unsigned-byte32) ,var)
+ (setf (memref ,vector 2 :index ,index :type :unsigned-byte32) ,var)
,var)))
(defun (setf u32ref%unsafe) (value vector index)
More information about the Movitz-cvs
mailing list