[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Fri May 21 09:41:59 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv26318
Modified Files:
arrays.lisp
Log Message:
The layout of heap objects has been changed such that the type-code is
now the "first" byte in the object.
Date: Fri May 21 05:41:58 2004
Author: ffjeld
Index: movitz/losp/muerte/arrays.lisp
diff -u movitz/losp/muerte/arrays.lisp:1.19 movitz/losp/muerte/arrays.lisp:1.20
--- movitz/losp/muerte/arrays.lisp:1.19 Thu May 20 13:41:46 2004
+++ movitz/losp/muerte/arrays.lisp Fri May 21 05:41:58 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.19 2004/05/20 17:41:46 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.20 2004/05/21 09:41:58 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -186,69 +186,72 @@
(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))))
+ (macrolet
+ ((do-it ()
+ `(with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :eax) vector)
+ (:compile-form (:result-mode :ebx) index)
+ (:leal (:eax ,(- (movitz:tag :other))) :ecx)
+ (:testb ,movitz::+movitz-fixnum-zmask+ :bl)
+ (:jnz '(:sub-program (not-fixnum) (:int 107))) ; index not fixnum
+ (:andl ,(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)))))
+ (:shrl ,movitz:+movitz-fixnum-shift+ :ebx)
+ (:movzxw (:eax ,movitz:+other-type-offset+) :ecx)
- (:cmpl #.(movitz:vector-type-tag :any-t) :ecx)
- (:jne 'not-any-t)
- (:movl (:eax (:ebx 4) 2) :eax)
- (:jmp 'done)
-
- not-any-t
- (:cmpl #.(movitz:vector-type-tag :character) :ecx)
- (:jne 'not-character)
- (:movb (:eax :ebx 2) :bl)
- (:xorl :eax :eax)
- (:movb :bl :ah)
- (:movb #.(movitz::tag :character) :al) ; character
- (:jmp 'done)
+ (: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 4) 2) :eax)
+ (:jmp 'done)
+
+ not-any-t
+ (:cmpl #.(movitz:vector-type-tag :character) :ecx)
+ (:jne 'not-character)
+ (: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)
- (:movzxb (:eax :ebx 2) :eax) ; u8
- (:shll #.movitz::+movitz-fixnum-shift+ :eax)
- (:jmp 'done)
+ not-character
+ (:cmpl #.(movitz:vector-type-tag :u8) :ecx)
+ (:jne 'not-u8)
+ (:movzxb (:eax :ebx 2) :eax) ; u8
+ (:shll #.movitz::+movitz-fixnum-shift+ :eax)
+ (:jmp 'done)
- not-u8
- (:cmpl #.(movitz:vector-type-tag :u16) :ecx)
- (:jne 'not-u16)
- (:movzxw (:eax (:ebx 2) 2) :eax) ; u16
- (:jmp 'done)
-
- not-u16
- (:cmpl #.(movitz:vector-type-tag :u32) :ecx)
- (:jne '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
- (:compile-form (:result-mode :ignore)
- (error "Not a vector: ~S" vector))
+ not-u8
+ (:cmpl #.(movitz:vector-type-tag :u16) :ecx)
+ (:jne 'not-u16)
+ (:movzxw (:eax (:ebx 2) 2) :eax) ; u16
+ (:jmp 'done)
+
+ not-u16
+ (:cmpl ,(movitz:vector-type-tag :u32) :ecx)
+ (:jne '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
+ (:compile-form (:result-mode :ignore)
+ (error "Not a vector: ~S" vector))
- done))
+ done)))
+ (do-it)))
(t (vector &rest subscripts)
(declare (ignore vector subscripts))
(error "Multi-dimensional arrays not implemented."))))
@@ -256,82 +259,85 @@
(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)
+ (macrolet
+ ((do-it ()
+ `(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 ,movitz:+other-type-offset+) :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)
+ (: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-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)
- (:movl :ebx (: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))
+ 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)
+ (:movl :ebx (: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)))
+ (do-it)))
(t (value vector &rest subscripts)
(declare (ignore value vector subscripts))
(error "Multi-dimensional arrays not implemented."))))
More information about the Movitz-cvs
mailing list