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

[Frode Vatvedt Fjeld]

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

Modified Files:
	functions.lisp 
Log Message:
Slight rewrite of some funobj accessors. This still needs work, though.

Date: Wed Apr 14 08:25:28 2004
Author: ffjeld

Index: movitz/losp/muerte/functions.lisp
diff -u movitz/losp/muerte/functions.lisp:1.7 movitz/losp/muerte/functions.lisp:1.8
--- movitz/losp/muerte/functions.lisp:1.7	Sun Mar 28 12:31:41 2004
+++ movitz/losp/muerte/functions.lisp	Wed Apr 14 08:25:27 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.7 2004/03/28 17:31:41 ffjeld Exp $
+;;;; $Id: functions.lisp,v 1.8 2004/04/14 12:25:27 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -84,14 +84,13 @@
 
 (defun funobj-code-vector (funobj)
   (check-type funobj compiled-function)
-  (%word-offset (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :lisp)
-		-2))
+  (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :code-vector))
 
 (defun (setf funobj-code-vector) (code-vector funobj)
   (check-type funobj compiled-function)
   (check-type code-vector vector-u8)
-  (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :lisp)
-    (%word-offset code-vector 2)))
+  (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :code-vector)
+    code-vector))
 
 (defun funobj-code-vector%1op (funobj)
   "This slot is not a lisp value, it is a direct address to code entry point. In practice it is either
@@ -274,16 +273,18 @@
     "Index ~D out of range, ~S has ~D constants." index funobj (funobj-num-constants funobj))
   (if (>= index (funobj-num-jumpers funobj))
       (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0) index :lisp)
-    (without-gc
-     (with-inline-assembly (:returns :eax)
-       (:compile-two-forms (:eax :untagged-fixnum-ecx) funobj index)
-       (:movl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector))
-	      :ebx)
-       (:negl :ebx)
-       (:addl ((:ecx 4) :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0))
-	      :ebx)
-       (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :eax)
-       (:xorl :ebx :ebx)))))
+    ;; For a jumper, return its offset relative to the code-vector.
+    ;; This is tricky wrt. to potential GC interrupts, because we're doing
+    ;; pointer arithmetics.
+    (with-inline-assembly (:returns :eax)
+      (:compile-two-forms (:eax :ecx) funobj index)
+      (:movl #.movitz:+code-vector-transient-word+ :ebx)
+      (:addl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector))
+	     :ebx)			; code-vector (word) into ebx
+      (:subl (:eax :ecx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0))
+	     :ebx)
+      (:negl :ebx)
+      (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :eax))))
 
 (defun (setf funobj-constant-ref) (value funobj index)
   (check-type funobj compiled-function)
@@ -297,10 +298,10 @@
       (assert (below value (length (funobj-code-vector funobj))) (value)
 	"The jumper value ~D is invalid because the code-vector's size is ~D."
 	value (length (funobj-code-vector funobj)))
-      (without-gc
+      (progn ;; without-gc
        (with-inline-assembly (:returns :nothing)
-	 (:compile-two-forms (:eax :untagged-fixnum-ecx) funobj index)
-	 (:leal ((:ecx 4) :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0))
+	 (:compile-two-forms (:eax :ecx) funobj index)
+	 (:leal (:ecx :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0))
 		:ebx)			; dest. address into ebx.
 	 (:compile-form (:result-mode :untagged-fixnum-ecx) value)
 	 (:addl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector))