[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Wed Mar 31 18:33:52 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv14420
Modified Files:
memref.lisp
Log Message:
Smarted up memref considerably.
Date: Wed Mar 31 13:33:52 2004
Author: ffjeld
Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.6 movitz/losp/muerte/memref.lisp:1.7
--- movitz/losp/muerte/memref.lisp:1.6 Wed Mar 31 11:49:23 2004
+++ movitz/losp/muerte/memref.lisp Wed Mar 31 13:33:52 2004
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Tue Mar 6 21:25:49 2001
;;;;
-;;;; $Id: memref.lisp,v 1.6 2004/03/31 16:49:23 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.7 2004/03/31 18:33:52 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -30,13 +30,13 @@
(define-compiler-macro memref (&whole form object offset index type &environment env)
;;; (assert (typep offset '(integer 0 0)) (offset)
;;; (error "memref offset not supported."))
- (if (not (movitz:movitz-constantp type))
+ (if (not (movitz:movitz-constantp type env))
form
(labels ((extract-constant-delta (form)
"Try to extract at compile-time an integer offset from form."
(cond
((movitz:movitz-constantp form env)
- (let ((x (movitz::eval-form form env)))
+ (let ((x (movitz:movitz-eval form env)))
(check-type x integer)
(values x 0)))
((not (consp form))
@@ -49,7 +49,7 @@
(2 (values 0 (second form)))
(t (loop with x = 0 and f = nil for sub-form in (cdr form)
as sub-value = (when (movitz:movitz-constantp sub-form env)
- (movitz::eval-form sub-form env))
+ (movitz:movitz-eval sub-form env))
do (if (integerp sub-value)
(incf x sub-value)
(push sub-form f))
@@ -66,37 +66,46 @@
(warn "o: ~S, co: ~S, i: ~S, ci: ~S"
offset constant-offset
index constant-index)
- (let ((type (movitz::eval-form type env)))
+ (let ((type (movitz:movitz-eval type env)))
(case type
(:unsigned-byte8
- `(with-inline-assembly (:returns :untagged-fixnum-eax)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:popl :eax) ; object
- (:addl :ecx :ebx) ; index += offset
- (:sarl #.movitz::+movitz-fixnum-shift+ :ebx)
- (:movzxb (:eax :ebx ,(offset-by 1)) :eax)))
+ (cond
+ ((and (eq 0 offset) (eq 0 index))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-form (:result-mode :eax) ,object)
+ (:movzxb (:eax ,(offset-by 1)) :ecx)))
+ ((eq 0 offset)
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:eax :ecx) ,object ,index)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)))
+ (t (let ((object-var (gensym "memref-object-")))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:addl :ebx :ecx) ; index += offset
+ (:sarl ,movitz::+movitz-fixnum-shift+ :ecx)
+ (:movzxb (:eax :ecx ,(offset-by 1)) :ecx)))))))
(:unsigned-byte16
- `(with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:eax :ebx) ,offset ,index)
- (:sarl #.(cl:1- movitz::+movitz-fixnum-shift+) :ebx)
- (:sarl #.movitz::+movitz-fixnum-shift+ :eax)
- (:addl :eax :ebx)
- (:popl :eax) ; object
- (:movzxw (:eax :ebx ,(offset-by 2)) :ecx)))
- (:unsigned-byte32
- (assert (= 2 movitz::+movitz-fixnum-shift+))
- (let ((overflow (gensym "overflow-")))
+ (cond
+ ((and (eq 0 offset) (eq 0 index))
`(with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:sarl #.movitz::+movitz-fixnum-shift+ :ecx)
- (:addl :ebx :ecx)
- (:popl :eax) ; object
- (:movl (:eax :ecx ,(offset-by 4)) :ecx)
- (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx)
- (:jg '(:sub-program (,overflow) (:int 4))))))
+ (:compile-form (:result-mode :eax) ,object)
+ (:movzxw (:eax ,(offset-by 2)) :ecx)))
+ ((eq 0 offset)
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:eax :ecx) ,object ,index)
+ (:sarl ,(1- movitz:+movitz-fixnum-shift+) :ecx)
+ (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)))
+ (t (let ((object-var (gensym "memref-object-")))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:leal (:ecx (:ebx 2)) :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:sarl #.movitz::+movitz-fixnum-shift+ :ecx)
+ (:movzxw (:eax :ecx ,(offset-by 2)) :ecx)))))))
(:unsigned-byte29+3
;; Two values: the 29 upper bits as unsigned integer,
;; and secondly the lower 3 bits as unsigned.
@@ -133,7 +142,7 @@
(:movl 2 :ecx)
(:stc)))
(:character
- (when (eq 0 index) (warn "zero char index!"))
+ (when (eq 0 index) (warn "memref zero char index!"))
(cond
((eq 0 offset)
`(with-inline-assembly (:returns :eax)
@@ -142,15 +151,41 @@
(:movb #.(movitz:tag :character) :al)
(:sarl #.movitz::+movitz-fixnum-shift+ :ebx) ; scale index
(:movb (:ecx :ebx ,(offset-by 1)) :ah)))
- (t `(with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:ecx :ebx) ,offset ,index)
- (:addl :ecx :ebx)
- (:xorl :eax :eax)
- (:movb #.(movitz:tag :character) :al)
- (:popl :ecx) ; pop object
- (:sarl #.movitz::+movitz-fixnum-shift+ :ebx) ; scale offset+index
- (:movb (:ebx :ecx ,(offset-by 1)) :ah)))))
+ (t (let ((object-var (gensym "memref-object-")))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:addl :ebx :ecx)
+ (:xorl :eax :eax)
+ (:movb #.(movitz:tag :character) :al)
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (:sarl #.movitz::+movitz-fixnum-shift+ :ecx) ; scale offset+index
+ (:movb (:ebx :ecx ,(offset-by 1)) :ah)))))))
+ (:unsigned-byte32
+ (assert (= 4 movitz::+movitz-fixnum-factor+))
+ (cond
+ ((and (eq 0 offset) (eq 0 index))
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-form (:result-mode :eax) ,object)
+ (:movl (:eax ,(offset-by 4)) :ecx)
+ (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx)
+ (:jg '(:sub-program () (:int 4)))))
+ ((eq 0 offset)
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:eax :ecx) ,object ,index)
+ (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+ (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx)
+ (:jg '(:sub-program () (:int 4)))))
+ (t (let ((object-var (gensym "memref-object-")))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:sarl #.movitz::+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:addl :ebx :ecx)
+ (:movl (:eax :ecx ,(offset-by 4)) :ecx)
+ (:cmpl ,movitz::+movitz-most-positive-fixnum+ :ecx)
+ (:jg '(:sub-program () (:int 4)))))))))
(:lisp
(cond
((and (eq 0 index) (eq 0 offset))
@@ -163,14 +198,17 @@
,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
`((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
(:movl (:eax :ecx ,(offset-by 4)) :eax)))
- (t `(with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :push) ,object)
- (:compile-two-forms (:untagged-fixnum-eax :ecx) ,offset ,index)
- ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
- `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
- (:addl :ecx :eax)
- (:popl :ebx) ; pop object
- (:movl (:eax :ebx ,(offset-by 4)) :eax)))))
+ (t (assert (not (movitz:movitz-constantp offset env)))
+ (assert (not (movitz:movitz-constantp index env)))
+ (let ((object-var (gensym "memref-object-")))
+ (assert (= 4 movitz:+movitz-fixnum-factor+))
+ `(let ((,object-var ,object))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:ecx :ebx) ,offset ,index)
+ (:shrl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:addl :ebx :ecx)
+ (:movl (:eax :ecx ,(offset-by 4)) :eax)))))))
(t (error "Unknown memref type: ~S" (movitz::eval-form type nil nil))
form)))))))))
More information about the Movitz-cvs
mailing list