[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Mon Mar 8 14:26:13 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv20499
Modified Files:
arrays.lisp
Log Message:
Minor fixes to aref and (setf aref).
Date: Mon Mar 8 09:26:13 2004
Author: ffjeld
Index: movitz/losp/muerte/arrays.lisp
diff -u movitz/losp/muerte/arrays.lisp:1.3 movitz/losp/muerte/arrays.lisp:1.4
--- movitz/losp/muerte/arrays.lisp:1.3 Mon Mar 8 08:17:38 2004
+++ movitz/losp/muerte/arrays.lisp Mon Mar 8 09:26:13 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.3 2004/03/08 13:17:38 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.4 2004/03/08 14:26:13 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -183,141 +183,163 @@
done))
-(defun aref (vector index)
- (with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) vector)
- (:compile-form (:result-mode :ebx) index)
- (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx)
- (:testb #.movitz::+movitz-fixnum-zmask+ :bl)
- (:jnz '(:sub-program (not-fixnum) (:int 107))) ; index not fixnum
- (:andl #.(cl:ash #x000ffff movitz::+movitz-fixnum-shift+) :ebx)
- (:testb 7 :cl)
- (:jnz '(:sub-program () (:int 60))) ; not other-type
- (:shrl #.movitz::+movitz-fixnum-shift+ :ebx)
- (:movw (:eax -2) :cx)
- (:cmpb #.(movitz::tag :vector) :cl)
- (:jne '(:sub-program () (:int 60) (:jmp (:pc+ -4)))) ; not vector-type
- (:cmpw (:eax -4) :bx)
- (:jae '(:sub-program ()
- (:movzxw :bx :eax)
- (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds
- (:testb :ch :ch) ; element-type 0?
- (:jnz 'not-any-t)
- (:movl (:eax (:ebx 4) 2) :eax)
- (:jmp 'done)
-
- not-any-t
- (:decb :ch) ; element-type 1?
- (:jnz 'not-character)
- (:movb (:eax :ebx 2) :bl)
- (:xorl :eax :eax)
- (:movb :bl :ah)
- (:movb #.(movitz::tag :character) :al) ; character
- (:jmp 'done)
-
- not-character
- (:decb :ch)
- (:jnz 'not-u8)
- (:movzxb (:eax :ebx 2) :eax) ; u8
- (:shll #.movitz::+movitz-fixnum-shift+ :eax)
- (:jmp 'done)
-
- not-u8
- (:decb :ch)
- (:jnz 'not-u16)
- (:movzxw (:eax (:ebx 2) 2) :eax) ; u16
- (:jmp 'done)
-
- not-u16
- (:decb :ch)
- (:jnz 'not-u32)
- (:movl (:eax (:ebx 4) 2) :ecx) ; u32
- (:cmpl #.movitz::+movitz-most-positive-fixnum+ :ecx)
- (:jg '(:sub-program (:overflowing-u32)
- (:int 107)))
- (:leal ((:ecx #.movitz::+movitz-fixnum-factor+)) :eax)
- (:jmp 'done)
-
- not-u32
- (:int 107)
-
- done))
-
-(defun (setf aref) (value vector index)
- (with-inline-assembly (:returns :ebx)
- (:compile-form (:result-mode :ebx) value)
- (:compile-form (:result-mode :eax) vector)
-
- (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx)
- (:testb 7 :cl)
- (:jnz '(:sub-program () (:int 60) (:jmp (:pc+ -4)))) ; not other-type
- (:movzxw (:eax -2) :edx)
-
- (:compile-form (:result-mode :ecx) index)
- (:testb #.movitz::+movitz-fixnum-zmask+ :cl)
- (:jnz '(:sub-program () (:int 107))) ; index not fixnum
- (:andl #.(cl:ash #xffff movitz::+movitz-fixnum-shift+) :ecx)
- (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
-
- (:cmpw (:eax -4) :cx)
- (: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
- (: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
- (: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)
-
- 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))
+(defun aref (vector &rest subscripts)
+ (numargs-case
+ (2 (vector index)
+ (with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :eax) vector)
+ (:compile-form (:result-mode :ebx) index)
+ (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx)
+ (:testb #.movitz::+movitz-fixnum-zmask+ :bl)
+ (:jnz '(:sub-program (not-fixnum) (:int 107))) ; index not fixnum
+ (:andl #.(cl:ash #x000ffff movitz::+movitz-fixnum-shift+) :ebx)
+
+ (:testb 7 :cl)
+ (:jnz '(:sub-program ()
+ (:compile-form (:result-mode :ignore)
+ (error "Not a vector: ~S" vector))))
+
+;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ebx)
+ (:movzxw (:eax -2) :ecx)
+
+ (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :bx)
+ (:jae '(:sub-program ()
+ (:compile-form (:result-mode :ignore)
+ (error "Index ~D out of bounds ~D." index (length vector)))))
+
+ (:cmpl #.(movitz:vector-type-tag :any-t) :ecx)
+ (:jne 'not-any-t)
+ (:movl (:eax :ebx 2) :eax)
+ (:jmp 'done)
+
+ not-any-t
+ (:cmpl #.(movitz:vector-type-tag :character) :ecx)
+ (:jne 'not-character)
+ (:shrl #.movitz::+movitz-fixnum-shift+ :ebx)
+ (:movb (:eax :ebx 2) :bl)
+ (:xorl :eax :eax)
+ (:movb :bl :ah)
+ (:movb #.(movitz::tag :character) :al) ; character
+ (:jmp 'done)
+
+ not-character
+ (:cmpl #.(movitz:vector-type-tag :u8) :ecx)
+ (:jne 'not-u8)
+ (:shrl #.movitz::+movitz-fixnum-shift+ :ebx)
+ (:movzxb (:eax :ebx 2) :eax) ; u8
+ (:shll #.movitz::+movitz-fixnum-shift+ :eax)
+ (:jmp 'done)
+
+ not-u8
+ (:cmpl #.(movitz:vector-type-tag :u16) :ecx)
+ (:je 'not-u16)
+ (:shrl #.(cl:1- movitz::+movitz-fixnum-shift+) :ebx)
+ (:movzxw (:eax :ebx 2) :eax) ; u16
+ (:jmp 'done)
+
+ not-u16
+ (:cmpl #.(movitz:vector-type-tag :u32) :ecx)
+ (:je 'not-u32)
+ (:movl (:eax :ebx 2) :ecx) ; u32
+ (:cmpl #.movitz::+movitz-most-positive-fixnum+ :ecx)
+ (:jg '(:sub-program (:overflowing-u32)
+ (:int 107)))
+ (:leal ((:ecx #.movitz::+movitz-fixnum-factor+)) :eax)
+ (:jmp 'done)
+
+ not-u32
+ (:compile-form (:result-mode :ignore)
+ (error "Not a vector: ~S" vector))
+
+ done))
+ (t (vector &rest subscripts)
+ (declare (dynamic-extent subscripts)
+ (ignore vector subscripts))
+ (error "Multi-dimensional arrays not implemented."))))
+
+(defun (setf aref) (value vector &rest subscripts)
+ (numargs-case
+ (3 (value vector index)
+ (with-inline-assembly (:returns :ebx)
+ (:compile-form (:result-mode :ebx) value)
+ (:compile-form (:result-mode :eax) vector)
+
+ (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx)
+ (:testb 7 :cl)
+ (:jnz '(:sub-program ()
+ (:compile-form (:result-mode :ignore)
+ (error "Not a vector: ~S" vector))))
+ (:movzxw (:eax -2) :edx)
+
+ (:compile-form (:result-mode :ecx) index)
+ (:testb #.movitz::+movitz-fixnum-zmask+ :cl)
+ (:jnz '(:sub-program () (:int 107))) ; index not fixnum
+ (:andl #.(cl:ash #xffff movitz::+movitz-fixnum-shift+) :ecx)
+ (:shrl #.movitz::+movitz-fixnum-shift+ :ecx)
+
+ (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :cx)
+ (: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
+ (: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
+ (: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)
+
+ 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))
+ (t (value vector &rest subscripts)
+ (declare (dynamic-extent subscripts)
+ (ignore value vector subscripts))
+ (error "Multi-dimensional arrays not implemented."))))
;;; simple-vector accessors
@@ -329,7 +351,9 @@
`(setf (memref ,simple-vector 2 ,index :lisp) ,value))
(defun svref%unsafe (simple-vector index)
- (svref%unsafe simple-vector index))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) simple-vector index)
+ (:movl (:eax :ebx #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data)) :eax)))
(defun (setf svref%unsafe) (value simple-vector index)
(setf (svref%unsafe simple-vector index) value))
@@ -447,10 +471,6 @@
(values #'u8ref%unsafe #'(setf u8ref%unsafe)))
(#.(bt:enum-value 'movitz::movitz-vector-element-type :u32)
(values #'u32ref%unsafe #'(setf u32ref%unsafe)))
-;;; (#.(bt:enum-value 'movitz::movitz-vector-element-type :u16)
-;;; '(unsigned-byte 16))
-;;; (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32)
-;;; '(unsigned-byte 32))
(t (warn "don't know about vector's element-type: ~S" vector)
(values #'aref #'(setf aref)))))
More information about the Movitz-cvs
mailing list