[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Sep 21 13:06:38 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv17683
Modified Files:
functions.lisp
Log Message:
Re-worked the atomically protocol. There is now one run-time-context
field, atomically-continuation, whose semantics is slightly different
from the old atomically-status and atomically-esp.
Date: Tue Sep 21 15:06:36 2004
Author: ffjeld
Index: movitz/losp/muerte/functions.lisp
diff -u movitz/losp/muerte/functions.lisp:1.19 movitz/losp/muerte/functions.lisp:1.20
--- movitz/losp/muerte/functions.lisp:1.19 Wed Sep 15 12:22:59 2004
+++ movitz/losp/muerte/functions.lisp Tue Sep 21 15:06:36 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.19 2004/09/15 10:22:59 ffjeld Exp $
+;;;; $Id: functions.lisp,v 1.20 2004/09/21 13:06:36 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -111,17 +111,26 @@
(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
a pointer into the regular code-vector, or it points (with offset 2) to another vector entirely.
-The former is represented as a lisp integer that is the index into the code-vector, the latter is represented
-as that vector."
+The former is represented as a lisp integer that is the index into the code-vector, the latter is
+represented as that vector."
(check-type funobj function)
(with-inline-assembly (:returns :eax)
+ ;; Set up atomically continuation.
+ (:declare-label-set restart-jumper (retry))
+ (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+ (:pushl 'restart-jumper)
+ ;; ..this allows us to detect recursive atomicallies.
+ (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+ (:pushl :ebp)
retry
- (:declare-label-set retry-jumper (retry))
- (:locally (:movl '(:funcall #.(movitz::atomically-status-jumper-fn t)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
+
+ (:movl (:esp) :ebp)
(:compile-form (:result-mode :ebx) funobj)
(:movl (:ebx (:offset movitz-funobj code-vector)) :eax) ; EAX = code-vector
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
+
(:movl (:ebx (:offset movitz-funobj code-vector%1op)) :ecx)
;; determine if ECX is a pointer into EBX
(:subl :eax :ecx)
@@ -138,8 +147,8 @@
(:movl #xfffffffe :eax)
(:addl (:ebx (:offset movitz-funobj code-vector%1op)) :eax)
done
- (:locally (:movl #.(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status)))))) ; this cell stores word+2
+ (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+ (:leal (:esp 16) :esp)))
(defun (setf funobj-code-vector%1op) (code-vector funobj)
(check-type funobj function)
@@ -163,17 +172,26 @@
(defun funobj-code-vector%2op (funobj)
"This slot is not a lisp value, it is a direct address to code entry point. In practice it is either
a pointer into the regular code-vector, or it points (with offset 2) to another vector entirely.
-The former is represented as a lisp integer that is the index into the code-vector, the latter is represented
-as that vector."
+The former is represented as a lisp integer that is the index into the code-vector, the latter is
+represented as that vector."
(check-type funobj function)
(with-inline-assembly (:returns :eax)
+ ;; Set up atomically continuation.
+ (:declare-label-set restart-jumper (retry))
+ (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+ (:pushl 'restart-jumper)
+ ;; ..this allows us to detect recursive atomicallies.
+ (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+ (:pushl :ebp)
retry
- (:declare-label-set retry-jumper (retry))
- (:locally (:movl '(:funcall #.(movitz::atomically-status-jumper-fn t)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
+
+ (:movl (:esp) :ebp)
(:compile-form (:result-mode :ebx) funobj)
(:movl (:ebx (:offset movitz-funobj code-vector)) :eax) ; EAX = code-vector
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
+
(:movl (:ebx (:offset movitz-funobj code-vector%2op)) :ecx)
;; determine if ECX is a pointer into EBX
(:subl :eax :ecx)
@@ -190,8 +208,8 @@
(:movl #xfffffffe :eax)
(:addl (:ebx (:offset movitz-funobj code-vector%2op)) :eax)
done
- (:locally (:movl #.(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status))))))
+ (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+ (:leal (:esp 16) :esp)))
(defun (setf funobj-code-vector%2op) (code-vector funobj)
(check-type funobj function)
@@ -215,17 +233,26 @@
(defun funobj-code-vector%3op (funobj)
"This slot is not a lisp value, it is a direct address to code entry point. In practice it is either
a pointer into the regular code-vector, or it points (with offset 2) to another vector entirely.
-The former is represented as a lisp integer that is the index into the code-vector, the latter is represented
-as that vector."
+The former is represented as a lisp integer that is the index into the code-vector, the latter is
+represented as that vector."
(check-type funobj function)
(with-inline-assembly (:returns :eax)
+ ;; Set up atomically continuation.
+ (:declare-label-set restart-jumper (retry))
+ (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+ (:pushl 'restart-jumper)
+ ;; ..this allows us to detect recursive atomicallies.
+ (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+ (:pushl :ebp)
retry
- (:declare-label-set retry-jumper (retry))
- (:locally (:movl '(:funcall #.(movitz::atomically-status-jumper-fn t)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
+
+ (:movl (:esp) :ebp)
(:compile-form (:result-mode :ebx) funobj)
(:movl (:ebx (:offset movitz-funobj code-vector)) :eax) ; EAX = code-vector
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
+
(:movl (:ebx (:offset movitz-funobj code-vector%3op)) :ecx)
;; determine if ECX is a pointer into EBX
(:subl :eax :ecx)
@@ -242,8 +269,8 @@
(:movl #xfffffffe :eax)
(:addl (:ebx (:offset movitz-funobj code-vector%3op)) :eax)
done
- (:locally (:movl #.(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status))))))
+ (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+ (:leal (:esp 16) :esp)))
(defun (setf funobj-code-vector%3op) (code-vector funobj)
(check-type funobj function)
@@ -393,37 +420,7 @@
(:cmpl :ebx :edx)
(:ja 'init-loop)
init-done
- (:leal (:edx ,(bt:sizeof 'movitz:movitz-funobj)) :ecx))
- #+ignore
- `(with-inline-assembly (:returns :eax :labels (retry-alloc retry-jumper))
- (:declare-label-set retry-jumper (retry-alloc))
- retry-alloc
- (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
- (:compile-form (:result-mode :eax)
- (+ num-constants
- #.(cl:truncate (bt:sizeof 'movitz:movitz-funobj) 4)))
- (:call-local-pf get-cons-pointer)
- (:movl #.(movitz:tag :funobj) (:eax #.movitz:+other-type-offset+))
- (:load-lexical (:lexical-binding num-constants) :edx)
- (:movl :edx :ecx)
- (:shll #.(cl:- 16 movitz:+movitz-fixnum-shift+) :ecx)
- (:movl :ecx (:eax (:offset movitz-funobj num-jumpers)))
- (:xorl :ecx :ecx)
- (:xorl :ebx :ebx)
- (:testl :edx :edx)
- (:jmp 'init-done)
- init-loop
- (:movl :ecx (:eax :ebx #.movitz:+other-type-offset+))
- (:addl 4 :ebx)
- (:cmpl :ebx :edx)
- (:ja 'init-loop)
- init-done
- (:leal (:edx #.(bt:sizeof 'movitz:movitz-funobj)) :ecx)
- (:call-local-pf cons-commit)
- (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status)))))))
+ (:leal (:edx ,(bt:sizeof 'movitz:movitz-funobj)) :ecx))))
(do-it))))
(setf (funobj-name funobj) name
(funobj-code-vector funobj) code-vector
More information about the Movitz-cvs
mailing list