Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv10377
Modified Files:
arrays.lisp
Log Message:
Improved (setf aref).
Date: Mon Mar 8 08:17:38 2004
Author: ffjeld
Index: movitz/losp/muerte/arrays.lisp
diff -u movitz/losp/muerte/arrays.lisp:1.2 movitz/losp/muerte/arrays.lisp:1.3
--- movitz/losp/muerte/arrays.lisp:1.2 Mon Jan 19 06:23:46 2004
+++ movitz/losp/muerte/arrays.lisp Mon Mar 8 08:17:38 2004
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org>
;;;; Created at: Sun Feb 11 23:14:04 2001
;;;;
-;;;; $Id: arrays.lisp,v 1.2 2004/01/19 11:23:46 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.3 2004/03/08 13:17:38 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -252,8 +252,6 @@
(:testb 7 :cl)
(:jnz '(:sub-program () (:int 60) (:jmp (:pc+ -4)))) ; not other-type
(:movzxw (:eax -2) :edx)
- (:cmpb #.(movitz::tag :vector) :dl)
- (:jne '(:sub-program () (:int 60) (:jmp (:pc+ -4)))) ; not vector-type
(:compile-form (:result-mode :ecx) index)
(:testb #.movitz::+movitz-fixnum-zmask+ :cl)
@@ -262,27 +260,64 @@
(:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
(:cmpw (:eax -4) :cx)
- (:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds
- (:testb :dh :dh) ; element-type 0?
+ (:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds
+
+ (:cmpl #.(movitz:vector-type-tag :any-t) :edx)
(:jnz 'not-any-t)
(:movl :ebx (:eax (:ecx 4) 2))
(:jmp 'done)
- not-any-t
- (:decb :dh) ; element-type 1?
+ not-any-t
+ (:cmpl #.(movitz:vector-type-tag :character) :edx)
(:jnz 'not-character)
+ (:cmpb #.(movitz:tag :character) :bl)
+ (:jnz '(:sub-program (not-character-value)
+ (:compile-form (:result-mode :ignore)
+ (error "Value not character: ~S" value))))
(:movb :bh (:eax :ecx 2))
(:jmp 'done)
- not-character
- (:decb :dh)
- (:jnz '(:sub-program (not-u8) (:int 62) (:jmp (:pc+ -4))))
- (:shll #.(cl:- 8 movitz::+movitz-fixnum-shift+) :ebx)
- (:movb :bh (:eax :ecx 2))
- (:shrl #.(cl:- 8 movitz::+movitz-fixnum-shift+) :ebx)
+ not-character
+ (:cmpl #.(movitz:vector-type-tag :u8) :edx)
+ (:jnz 'not-u8)
+ (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xff movitz:+movitz-fixnum-factor+))) :ebx)
+ (:jnz '(:sub-program (not-u8-value)
+ (:compile-form (:result-mode :ignore)
+ (error "Value not (unsigned-byte 8): ~S" value))))
+ (:shrl #.movitz:+movitz-fixnum-shift+ :ebx)
+ (:movb :bl (:eax (:ecx 1) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
+ (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx)
+ (:jmp 'done)
+
+
+ not-u8
+ (:cmpl #.(movitz:vector-type-tag :u16) :edx)
+ (:jnz 'not-u16)
+ (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffff movitz:+movitz-fixnum-factor+))) :ebx)
+ (:jnz '(:sub-program (not-u16-value)
+ (:compile-form (:result-mode :ignore)
+ (error "Value not (unsigned-byte 16): ~S" value))))
+ (:shrl #.movitz:+movitz-fixnum-shift+ :ebx)
+ (:movw :bx (:eax (:ecx 2) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
+ (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx)
+ (:jmp 'done)
- done))
+ not-u16
+ (:cmpl #.(movitz:vector-type-tag :u32) :edx)
+ (:jnz 'not-u32)
+ (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffffffff movitz:+movitz-fixnum-factor+))) :ebx)
+ (:jnz '(:sub-program (not-u32-value)
+ (:compile-form (:result-mode :ignore)
+ (error "Value not (unsigned-byte 32): ~S" value))))
+ (:shrl #.movitz:+movitz-fixnum-shift+ :ebx)
+ (:movw :bx (:eax (:ecx 4) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data)))
+ (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx)
+ (:jmp 'done)
+
+ not-u32
+ (:compile-form (:result-mode :ignore) (error "Not a vector: ~S" vector))
+ done))
;;; simple-vector accessors
