[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp

Frode Vatvedt Fjeld ffjeld at common-lisp.net
Thu Oct 21 20:34:04 UTC 2004


Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv3436

Modified Files:
	functions.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:34:04 2004
Author: ffjeld

Index: movitz/losp/muerte/functions.lisp
diff -u movitz/losp/muerte/functions.lisp:1.23 movitz/losp/muerte/functions.lisp:1.24
--- movitz/losp/muerte/functions.lisp:1.23	Tue Oct 12 16:43:27 2004
+++ movitz/losp/muerte/functions.lisp	Thu Oct 21 22:34:04 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Mar 12 22:58:54 2002
 ;;;;                
-;;;; $Id: functions.lisp,v 1.23 2004/10/12 14:43:27 ffjeld Exp $
+;;;; $Id: functions.lisp,v 1.24 2004/10/21 20:34:04 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -307,31 +307,37 @@
 
 (defun funobj-lambda-list (funobj)
   (check-type funobj function)
-  (movitz-accessor funobj movitz-funobj lambda-list))
+  (memref funobj (movitz-type-slot-offset 'movitz-funobj 'lambda-list)))
 
 (defun (setf funobj-lambda-list) (lambda-list funobj)
   (check-type funobj function)
   (check-type lambda-list list)
-  (setf-movitz-accessor (funobj movitz-funobj lambda-list) lambda-list))
+  (setf (memref funobj (movitz-type-slot-offset 'movitz-funobj 'lambda-list))
+    lambda-list))
 
 (defun funobj-num-constants (funobj)
   (check-type funobj function)
-  (movitz-accessor-u16 funobj movitz-funobj num-constants))
+  (memref funobj (movitz-type-slot-offset 'movitz-funobj 'num-constants)
+	  :type :unsigned-byte16))
 
 (defun (setf funobj-num-constants) (num-constants funobj)
   (check-type funobj function)
   (check-type num-constants (unsigned-byte 16))
-  (set-movitz-accessor-u16 funobj movitz-funobj num-constants num-constants))
+  (setf (memref funobj (movitz-type-slot-offset 'movitz-funobj 'num-constants)
+		:type :unsigned-byte16)
+    num-constants))
 
 (defun funobj-num-jumpers (funobj)
   (check-type funobj function)
-  (with-inline-assembly (:returns :eax)
-    (:compile-form (:result-mode :eax) funobj)
-    (:movzxw (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::num-jumpers)) :eax)))
+  (memref funobj (movitz-type-slot-offset 'movitz-funobj 'num-jumpers)
+	  :type :unsigned-byte14))
 
 (defun (setf funobj-num-jumpers) (num-jumpers funobj)
   (check-type funobj function)
-  (check-type num-jumpers (unsigned-byte 14))
+  (setf (memref funobj (movitz-type-slot-offset 'movitz-funobj 'num-jumpers)
+		:type :unsigned-byte14)
+    num-jumpers)
+  #+ignore
   (with-inline-assembly (:returns :eax)
     (:compile-two-forms (:eax :ebx) num-jumpers funobj)
     (:movw :ax (:ebx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::num-jumpers)))))





More information about the Movitz-cvs mailing list