[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Aug 10 12:58:28 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv32225/losp/muerte
Modified Files:
memref.lisp
Log Message:
Add some support for *compiler-nonlocal-lispval-{read,write}-segment-prefix*.
Date: Tue Aug 10 05:58:28 2004
Author: ffjeld
Index: movitz/losp/muerte/memref.lisp
diff -u movitz/losp/muerte/memref.lisp:1.24 movitz/losp/muerte/memref.lisp:1.25
--- movitz/losp/muerte/memref.lisp:1.24 Mon Aug 9 07:39:41 2004
+++ movitz/losp/muerte/memref.lisp Tue Aug 10 05:58:28 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.24 2004/08/09 14:39:41 ffjeld Exp $
+;;;; $Id: memref.lisp,v 1.25 2004/08/10 12:58:28 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -18,8 +18,10 @@
(in-package muerte)
-(define-compiler-macro memref (&whole form object offset index type &environment env)
- (if (not (movitz:movitz-constantp type env))
+(define-compiler-macro memref (&whole form object offset index type &key (localp nil)
+ &environment env)
+ (if (or (not (movitz:movitz-constantp type env))
+ (not (movitz:movitz-constantp localp env)))
form
(labels ((sub-extract-constant-delta (form)
"Try to extract at compile-time an integer offset from form."
@@ -220,32 +222,36 @@
(:addl :ebx :ecx)
(:movl (:eax :ecx ,(offset-by 4)) :ecx)))))))
(:lisp
- (cond
- ((and (eql 0 index) (eql 0 offset))
- `(with-inline-assembly (:returns :register)
- (:compile-form (:result-mode :register) ,object)
- (:movl ((:result-register) ,(offset-by 4)) (:result-register))))
- ((eql 0 offset)
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ecx) ,object ,index)
- ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
- `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
- (:movl (:eax :ecx ,(offset-by 4)) :eax)))
- ((eql 0 index)
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,offset)
- (:movl (:eax :ecx ,(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)
- (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
- (:load-lexical (:lexical-binding ,object-var) :eax)
- (:addl :ebx :ecx)
- (:movl (:eax :ecx ,(offset-by 4)) :eax)))))))
+ (let* ((localp (movitz:movitz-eval localp env))
+ (prefixes (if localp
+ nil
+ movitz:*compiler-nonlocal-lispval-read-segment-prefix*)))
+ (cond
+ ((and (eql 0 index) (eql 0 offset))
+ `(with-inline-assembly (:returns :register)
+ (:compile-form (:result-mode :register) ,object)
+ (,prefixes :movl ((:result-register) ,(offset-by 4)) (:result-register))))
+ ((eql 0 offset)
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ecx) ,object ,index)
+ ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
+ `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ecx))
+ (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax)))
+ ((eql 0 index)
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object ,offset)
+ (,prefixes :movl (:eax :ecx ,(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)
+ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)
+ (:load-lexical (:lexical-binding ,object-var) :eax)
+ (:addl :ebx :ecx)
+ (,prefixes :movl (:eax :ecx ,(offset-by 4)) :eax))))))))
(:code-vector
;; A code-vector is like a normal lisp word pointer,
;; except it's known to point to a code-vector, and
@@ -297,8 +303,10 @@
(:signed-byte30+2 (memref object offset index :signed-byte30+2))
(:unsigned-byte29+3 (memref object offset index :unsigned-byte29+3))))
-(define-compiler-macro (setf memref) (&whole form &environment env value object offset index type)
- (if (not (movitz:movitz-constantp type env))
+(define-compiler-macro (setf memref) (&whole form &environment env value object offset index type
+ &key (localp nil))
+ (if (or (not (movitz:movitz-constantp type env))
+ (not (movitz:movitz-constantp localp env)))
form
(case (movitz::eval-form type)
(:character
@@ -544,33 +552,37 @@
(:movb :ah (:ebx :ecx)))
,value-var)))))
(:lisp
- (cond
- ((and (movitz:movitz-constantp offset env)
- (movitz:movitz-constantp index env))
- `(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:eax :ebx) ,value ,object)
- (:movl :eax (:ebx ,(+ (movitz:movitz-eval offset env)
- (* 4 (movitz:movitz-eval index env)))))))
- ((movitz:movitz-constantp offset env)
- (let ((value-var (gensym "memref-value-")))
- `(let ((,value-var ,value))
- (with-inline-assembly (:returns :eax)
- (:compile-two-forms (:ebx :ecx) ,object ,index)
- (:load-lexical (:lexical-binding ,value-var) :eax)
- ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2))
- `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx))
- (:movl :eax (:ebx :ecx ,(movitz:movitz-eval offset env)))))))
- (t (let ((value-var (gensym "memref-value-"))
- (object-var (gensym "memref-object-")))
- `(let ((,value-var ,value) (,object-var ,object))
+ (let* ((localp (movitz:movitz-eval localp env))
+ (prefixes (if localp
+ nil
+ movitz:*compiler-nonlocal-lispval-write-segment-prefix*)))
+ (cond
+ ((and (movitz:movitz-constantp offset env)
+ (movitz:movitz-constantp index env))
+ `(with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:eax :ebx) ,value ,object)
+ (,prefixes :movl :eax (:ebx ,(+ (movitz:movitz-eval offset env)
+ (* 4 (movitz:movitz-eval index env)))))))
+ ((movitz:movitz-constantp offset env)
+ (let ((value-var (gensym "memref-value-")))
+ `(let ((,value-var ,value))
(with-inline-assembly (:returns :eax)
- (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index)
+ (:compile-two-forms (:ebx :ecx) ,object ,index)
(:load-lexical (:lexical-binding ,value-var) :eax)
- ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
- `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx))
- (:addl :ebx :ecx) ; index += offset
- (:load-lexical (:lexical-binding ,object-var) :ebx)
- (:movl :eax (:ebx :ecx))))))))
+ ,@(when (plusp (- movitz:+movitz-fixnum-shift+ 2))
+ `((:sarl ,(- movitz:+movitz-fixnum-shift+ 2)) :ecx))
+ (,prefixes :movl :eax (:ebx :ecx ,(movitz:movitz-eval offset env)))))))
+ (t (let ((value-var (gensym "memref-value-"))
+ (object-var (gensym "memref-object-")))
+ `(let ((,value-var ,value) (,object-var ,object))
+ (with-inline-assembly (:returns :eax)
+ (:compile-two-forms (:untagged-fixnum-ecx :ebx) ,offset ,index)
+ (:load-lexical (:lexical-binding ,value-var) :eax)
+ ,@(when (cl:plusp (cl:- movitz::+movitz-fixnum-shift+ 2))
+ `((:sarl ,(cl:- movitz::+movitz-fixnum-shift+ 2)) :ebx))
+ (:addl :ebx :ecx) ; index += offset
+ (:load-lexical (:lexical-binding ,object-var) :ebx)
+ (,prefixes :movl :eax (:ebx :ecx)))))))))
(:code-vector
(cond
((and (movitz:movitz-constantp offset env)
More information about the Movitz-cvs
mailing list