[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Thu Oct 21 20:33:57 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv3385
Modified Files:
basic-macros.lisp
Log Message:
Improve accessors to observe
*compiler-nonlocal-lispval-read/write-segment-prefix* more. Also
don't use the movitz-accessor etc. macros anymore, use memref and
movitz-type-slot-offset instead.
Date: Thu Oct 21 22:33:57 2004
Author: ffjeld
Index: movitz/losp/muerte/basic-macros.lisp
diff -u movitz/losp/muerte/basic-macros.lisp:1.42 movitz/losp/muerte/basic-macros.lisp:1.43
--- movitz/losp/muerte/basic-macros.lisp:1.42 Mon Oct 11 15:52:18 2004
+++ movitz/losp/muerte/basic-macros.lisp Thu Oct 21 22:33:57 2004
@@ -9,7 +9,7 @@
;;;; Created at: Wed Nov 8 18:44:57 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: basic-macros.lisp,v 1.42 2004/10/11 13:52:18 ffjeld Exp $
+;;;; $Id: basic-macros.lisp,v 1.43 2004/10/21 20:33:57 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -362,16 +362,20 @@
',(mapcar #'first clauses)))))
(defmacro movitz-accessor (object-form type slot-name)
+ (warn "movitz-accesor deprecated.")
`(with-inline-assembly (:returns :register :side-effects nil)
(:compile-form (:result-mode :eax) ,object-form)
- (:movl (:eax ,(bt:slot-offset (find-symbol (string type) :movitz)
+ (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix*
+ :movl (:eax ,(bt:slot-offset (find-symbol (string type) :movitz)
(find-symbol (string slot-name) :movitz)))
(:result-register))))
(defmacro setf-movitz-accessor ((object-form type slot-name) value-form)
+ (warn "setf-movitz-accesor deprecated.")
`(with-inline-assembly (:returns :eax :side-effects t)
(:compile-two-forms (:eax :ebx) ,value-form ,object-form)
- (:movl :eax (:ebx ,(bt:slot-offset (find-symbol (string type) :movitz)
+ (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix*
+ :movl :eax (:ebx ,(bt:slot-offset (find-symbol (string type) :movitz)
(find-symbol (string slot-name) :movitz))))))
(defmacro movitz-accessor-u16 (object-form type slot-name)
@@ -563,9 +567,14 @@
(t (if (member type '(standard-gf-instance function pointer atom
integer fixnum positive-fixnum cons symbol character null list
string vector simple-vector vector-u8 vector-u16 code-vector))
- `(unless (typep ,place ',type)
- (with-inline-assembly (:returns :non-local-exit)
- (:int 66)))
+ `(with-inline-assembly (:returns :nothing :labels (fail))
+ (:compile-form (:result-mode (:boolean-branch-on-false . check-type-failed))
+ (typep ,place ',type))
+ (() () '(:sub-program (check-type-failed) (:int 66))))
+ #+ignore
+ `(unless (typep ,place ',type)
+ (with-inline-assembly (:returns :non-local-exit)
+ (:int 66)))
form))))
(defmacro assert (test-form &optional places datum-form &rest argument-forms)
@@ -623,7 +632,8 @@
(:leal (:eax -1) :ecx)
(:testb 7 :cl)
(:jnz '(:sub-program () (:int 61)))
- (:movl :edi (:eax -1)))
+ (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix*
+ :movl :edi (:eax -1)))
`(with-inline-assembly (:returns :eax)
(:compile-two-forms (:eax :ebx) ,value ,cell)
(:leal (:ebx -1) :ecx)
@@ -631,7 +641,8 @@
(:jnz '(:sub-program ()
(:movl :ebx :eax)
(:int 61)))
- (:movl :eax (:ebx -1)))))
+ (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix*
+ :movl :eax (:ebx -1)))))
(define-compiler-macro (setf cdr) (value cell &environment env)
(if (and (movitz:movitz-constantp value env)
@@ -641,7 +652,8 @@
(:leal (:eax -1) :ecx)
(:testb 7 :cl)
(:jnz '(:sub-program () (:int 61)))
- (:movl :edi (:eax 3)))
+ (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix*
+ :movl :edi (:eax 3)))
`(with-inline-assembly (:returns :eax)
(:compile-two-forms (:eax :ebx) ,value ,cell)
(:leal (:ebx -1) :ecx)
@@ -649,7 +661,8 @@
(:jnz '(:sub-program ()
(:movl :ebx :eax)
(:int 61)))
- (:movl :eax (:ebx 3)))))
+ (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix*
+ :movl :eax (:ebx 3)))))
(define-compiler-macro rplaca (cons object)
`(with-inline-assembly (:returns :eax)
@@ -657,7 +670,8 @@
(:leal (:eax -1) :ecx)
(:testb 7 :cl)
(:jnz '(:sub-program () (:int 61)))
- (:movl :ebx (:eax -1))))
+ (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix*
+ :movl :ebx (:eax -1))))
(define-compiler-macro rplacd (cons object)
`(with-inline-assembly (:returns :eax)
@@ -665,7 +679,8 @@
(:leal (:eax -1) :ecx)
(:testb 7 :cl)
(:jnz '(:sub-program () (:int 61)))
- (:movl :ebx (:eax 3))))
+ (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix*
+ :movl :ebx (:eax 3))))
(define-compiler-macro endp (x)
`(let ((cell ,x))
@@ -709,7 +724,7 @@
(:leal (:edx -7) :ecx)
(:andb 7 :cl)
(:jnz 'not-symbol)
- (:movl (:edx ,(bt:slot-offset 'movitz::movitz-symbol 'movitz::function-value)) :esi)
+ (:movl (:edx (:offset movitz-symbol function-value)) :esi)
(:jmp 'funobj-ok)
not-symbol
(:cmpb 7 :cl)
@@ -925,7 +940,8 @@
:ecx)
(:testb 7 :cl)
(:jnz '(:sub-program () (:int 66)))
- (:movl ((:result-register) ,(bt:slot-offset 'movitz::movitz-std-instance slot))
+ (#.movitz:*compiler-nonlocal-lispval-read-segment-prefix*
+ :movl ((:result-register) ,(bt:slot-offset 'movitz::movitz-std-instance slot))
(:result-register))))))
(defmacro std-instance-writer (slot value instance-form)
@@ -937,8 +953,8 @@
:ecx)
(:testb 7 :cl)
(:jnz '(:sub-program () (:int 66)))
- (:movl :eax
- (:ebx ,(bt:slot-offset 'movitz::movitz-std-instance slot)))))))
+ (#.movitz:*compiler-nonlocal-lispval-write-segment-prefix*
+ :movl :eax (:ebx ,(bt:slot-offset 'movitz::movitz-std-instance slot)))))))
(define-compiler-macro std-instance-class (instance)
`(std-instance-reader class ,instance))
More information about the Movitz-cvs
mailing list