Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv19993
Modified Files:
more-macros.lisp
Log Message:
Changed order of arguments for %run-time-context-slot, new signature
is (context slot-name), where nil may be used as a designator for
(current-run-time-context).
Date: Thu May 5 22:52:11 2005
Author: ffjeld
Index: movitz/losp/muerte/more-macros.lisp
diff -u movitz/losp/muerte/more-macros.lisp:1.26 movitz/losp/muerte/more-macros.lisp:1.27
--- movitz/losp/muerte/more-macros.lisp:1.26 Thu May 5 20:08:20 2005
+++ movitz/losp/muerte/more-macros.lisp Thu May 5 22:52:10 2005
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org>
;;;; Created at: Fri Jun 7 15:05:57 2002
;;;;
-;;;; $Id: more-macros.lisp,v 1.26 2005/05/05 18:08:20 ffjeld Exp $
+;;;; $Id: more-macros.lisp,v 1.27 2005/05/05 20:52:10 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -318,14 +318,15 @@
,format-control ,@format-arguments)
,@body))
-(define-compiler-macro %run-time-context-slot (&whole form &environment env slot-name
- &optional (context '(current-run-time-context)))
- (if (not (and (movitz:movitz-constantp slot-name env)))
+(define-compiler-macro %run-time-context-slot (&whole form &environment env context slot-name)
+ (if (not (movitz:movitz-constantp slot-name env))
form
(let* ((slot-name (movitz::eval-form slot-name env))
(slot-type (bt:binary-slot-type 'movitz::movitz-run-time-context
(intern (symbol-name slot-name) :movitz))))
- (if (equal context '(current-run-time-context))
+ (if (or (and (movitz:movitz-constantp context env)
+ (eq nil (movitz:movitz-eval context env)))
+ (equal context '(current-run-time-context)))
(ecase slot-type
(movitz::word
`(with-inline-assembly (:returns :eax)
@@ -359,26 +360,31 @@
,(- (movitz:tag :other)))) :ecx))))))))
-(define-compiler-macro (setf %run-time-context-slot) (&whole form &environment env value slot-name
- &optional (context '(current-run-time-context)))
- (if (not (and (movitz:movitz-constantp slot-name env)
- (equal context '(current-run-time-context))))
+(define-compiler-macro (setf %run-time-context-slot) (&whole form &environment env value context slot-name)
+ (if (not (movitz:movitz-constantp slot-name env))
form
- (let ((slot-name (movitz:movitz-eval slot-name env)))
- (ecase (bt:binary-slot-type 'movitz::movitz-run-time-context (intern (symbol-name slot-name) :movitz))
- (movitz:word
- `(with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) ,value)
- (:locally (:movl :eax (:edi (:edi-offset ,slot-name))))))
- (movitz:lu32
- `(with-inline-assembly (:returns :untagged-fixnum-ecx)
- (:compile-form (:result-mode :untagged-fixnum-ecx) ,value)
- (:locally (:movl :ecx (:edi (:edi-offset ,slot-name))))))
- (movitz:code-vector-word
- `(with-inline-assembly (:returns :eax)
- (:compile-form (:result-mode :eax) ,value)
- (:leal (:eax ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :ecx)
- (:locally (:movl :ecx (:edi (:edi-offset ,slot-name))))))))))
+ (let* ((slot-name (movitz::eval-form slot-name env))
+ (slot-type (bt:binary-slot-type 'movitz::movitz-run-time-context
+ (intern (symbol-name slot-name) :movitz))))
+ (if (or (and (movitz:movitz-constantp context env)
+ (eq nil (movitz:movitz-eval context env)))
+ (equal context '(current-run-time-context)))
+ (ecase slot-type
+ (movitz:word
+ `(with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :eax) ,value)
+ (:locally (:movl :eax (:edi (:edi-offset ,slot-name))))))
+ (movitz:lu32
+ `(with-inline-assembly (:returns :untagged-fixnum-ecx)
+ (:compile-form (:result-mode :untagged-fixnum-ecx) ,value)
+ (:locally (:movl :ecx (:edi (:edi-offset ,slot-name))))))
+ (movitz:code-vector-word
+ `(with-inline-assembly (:returns :eax)
+ (:compile-form (:result-mode :eax) ,value)
+ (:leal (:eax ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :ecx)
+ (:locally (:movl :ecx (:edi (:edi-offset ,slot-name)))))))
+ ;; FIXME
+ form))))
(define-compiler-macro read-time-stamp-counter ()
`(with-inline-assembly-case ()