[movitz-cvs] CVS update: movitz/losp/muerte/integers.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Sep 21 13:06:22 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv17359
Modified Files:
integers.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:21 2004
Author: ffjeld
Index: movitz/losp/muerte/integers.lisp
diff -u movitz/losp/muerte/integers.lisp:1.95 movitz/losp/muerte/integers.lisp:1.96
--- movitz/losp/muerte/integers.lisp:1.95 Mon Sep 20 10:06:53 2004
+++ movitz/losp/muerte/integers.lisp Tue Sep 21 15:06:20 2004
@@ -9,7 +9,7 @@
;;;; Created at: Wed Nov 8 18:44:57 2000
;;;; Distribution: See the accompanying file COPYING.
;;;;
-;;;; $Id: integers.lisp,v 1.95 2004/09/20 08:06:53 ffjeld Exp $
+;;;; $Id: integers.lisp,v 1.96 2004/09/21 13:06:20 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -485,7 +485,7 @@
((positive-bignum negative-fixnum)
(+ y x))
((negative-fixnum positive-bignum)
- (with-inline-assembly (:returns :eax :labels (retry-not-size1
+ (with-inline-assembly (:returns :eax :labels (restart-addition
retry-jumper
not-size1
copy-bignum-loop
@@ -502,15 +502,23 @@
(:addl (:eax (:offset movitz-bignum bigit0)) :ecx)
(:call-local-pf box-u32-ecx)
(:jmp 'pfix-pbig-done)
- retry-not-size1
+
+ not-size1
+ (:declare-label-set retry-jumper (restart-addition))
+ (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+ (:pushl 'retry-jumper)
+ ;; ..this allows us to detect recursive atomicallies.
+ (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+ (:pushl :ebp)
+
+ restart-addition
+ (:movl (:esp) :ebp)
(:compile-form (:result-mode :eax) y)
(:movzxw (:eax (:offset movitz-bignum length)) :ecx)
- not-size1
- (:declare-label-set retry-jumper (retry-not-size1))
- (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
- (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
+
(:leal ((:ecx 1) ,(* 1 movitz:+movitz-fixnum-factor+))
:eax) ; Number of words
(:call-local-pf get-cons-pointer)
@@ -545,15 +553,15 @@
(:subl ,movitz:+movitz-fixnum-factor+ :ecx)
no-expansion
(:call-local-pf cons-commit)
- (: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)
pfix-pbig-done))
((positive-bignum positive-bignum)
(if (< (%bignum-bigits y) (%bignum-bigits x))
(+ y x)
;; Assume x is smallest.
- (with-inline-assembly (:returns :eax :labels (retry-not-size1
+ (with-inline-assembly (:returns :eax :labels (restart-addition
retry-jumper
not-size1
copy-bignum-loop
@@ -570,20 +578,30 @@
(:jne 'not-size1)
(:movl (:ebx (:offset movitz-bignum bigit0)) :ecx)
(:addl (:eax (:offset movitz-bignum bigit0)) :ecx)
- (:jc 'retry-not-size1)
+ (:jc 'not-size1)
(:call-local-pf box-u32-ecx)
(:jmp 'pfix-pbig-done)
- retry-not-size1
+
+ not-size1
+ ;; Set up atomically continuation.
+ (:declare-label-set restart-jumper (restart-addition))
+ (: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)
+ restart-addition
+
+ (:movl (:esp) :ebp)
(:compile-form (:result-mode :eax) y)
(:movzxw (:eax (:offset movitz-bignum length)) :ecx)
- not-size1
- (:declare-label-set retry-jumper (retry-not-size1))
- (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
- (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
+
(:leal ((:ecx 1) ,(* 2 movitz:+movitz-fixnum-factor+))
:eax) ; Number of words
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
+
(:call-local-pf get-cons-pointer)
(:load-lexical (:lexical-binding y) :ebx) ; bignum
(:movzxw (:ebx (:offset movitz-bignum length)) :ecx)
@@ -636,8 +654,8 @@
(:addl ,movitz:+movitz-fixnum-factor+ :ecx)
no-expansion
(:call-local-pf cons-commit)
- (: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)
pfix-pbig-done)
))
(((integer * -1) (integer 0 *))
@@ -1055,14 +1073,23 @@
((fixnum bignum)
(let (r)
(with-inline-assembly (:returns :eax)
- retry
- (:declare-label-set retry-jumper (retry))
+ ;; Set up atomically continuation.
+ (:declare-label-set restart-jumper (restart-multiplication))
+ (: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)
+ restart-multiplication
+
+ (:movl (:esp) :ebp)
(:compile-two-forms (:eax :ebx) (integer-length x) (integer-length y))
- (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
- (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
+
;; Compute (1+ (ceiling (+ (len x) (len y)) 32)) ..
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
+
(:leal (:eax :ebx ,(* 4 (+ 31 32))) :eax)
(:andl ,(logxor #xffffffff (* 31 4)) :eax)
(:shrl 5 :eax)
@@ -1108,8 +1135,8 @@
(:movl :edi :edx)
(:cld) ; EAX, EDX, and ESI are GC roots again.
(:call-local-pf cons-commit)
- (: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)
(:compile-form (:result-mode :ebx) x)
(:testl :ebx :ebx)
(:jns 'positive-result)
@@ -1221,16 +1248,26 @@
(:call-local-pf box-u32-ecx)
(:popl :ebx)
(:jmp 'done)
+
not-size1
+ ;; Set up atomically continuation.
+ (:declare-label-set restart-jumper (restart-truncation))
+ (: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)
+ restart-truncation
+
+ (:movl (:esp) :ebp)
(:xorl :eax :eax)
(:compile-form (:result-mode :ebx) number)
(:movw (:ebx (:offset movitz-bignum length)) :ax)
- (:declare-label-set retry-jumper (not-size1))
- (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
- (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
(:addl 4 :eax)
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
+
(:call-local-pf get-cons-pointer) ; New bignum into EAX
(:store-lexical (:lexical-binding r) :eax :type bignum) ; XXX breaks GC invariant!
@@ -1285,8 +1322,9 @@
no-more-shrinkage
(:call-local-pf cons-commit)
fixnum-result
- (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status))))
+ ;; Exit atomically block.
+ (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
+ (:leal (:esp 16) :esp)
done
(:movl 2 :ecx)
(:stc)))))
@@ -1722,8 +1760,18 @@
;; We need to generate a bignum..
;; ..filling in 1-bits since the integer is negative.
(:pushl :eax) ; This will become the LSB bigit.
- retry-ones-expanded-bignum
- (:declare-label-set retry-jumper-ones-expanded-bignum (retry-ones-expanded-bignum))
+
+ ;; Set up atomically continuation.
+ (:declare-label-set restart-jumper (restart-ones-expanded-bignum))
+ (: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)
+ restart-ones-expanded-bignum
+
+ (:movl (:esp) :ebp)
+;;; (:declare-label-set retry-jumper-ones-expanded-bignum (retry-ones-expanded-bignum))
;; Calculate word-size from bytespec-size.
(:compile-form (:result-mode :ecx) size)
(:addl ,(* 31 movitz:+movitz-fixnum-factor+) :ecx) ; Add 31
@@ -1731,10 +1779,10 @@
(:andl ,(- movitz:+movitz-fixnum-factor+) :ecx)
(:leal (:ecx ,movitz:+movitz-fixnum-factor+) ; Add 1 for header.
:eax)
- (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
- (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
- 'retry-jumper-ones-expanded-bignum)
- (:edi (:edi-offset atomically-status))))
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
+
(:call-local-pf get-cons-pointer)
(:shll 16 :ecx)
(:orl ,(movitz:tag :bignum 0) :ecx)
@@ -1744,8 +1792,8 @@
,(* 1 movitz:+movitz-fixnum-factor+)) ; add 1 for header.
:ecx)
(:call-local-pf cons-commit)
- (: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)
;; Have fresh bignum in EAX, now fill it with ones.
(:xorl :ecx :ecx) ; counter
fill-ones-loop
@@ -1858,7 +1906,7 @@
(do-it)))
(t (macrolet
((do-it ()
- `(let ()
+ `(let (new-size)
(with-inline-assembly (:returns :eax)
(:compile-form (:result-mode :ebx) integer)
(:compile-form (:result-mode :ecx) position)
@@ -1919,14 +1967,24 @@
(:jz 'ldb-done) ; New size was zero, so the result of ldb is zero.
(:movl :ecx :eax) ; New size into EAX.
size-ok
- retry
- (:declare-label-set retry-jumper (retry))
- (:locally (:movl :esp (:edi (:edi-offset atomically-esp))))
- (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp)
- 'retry-jumper)
- (:edi (:edi-offset atomically-status))))
+ (:store-lexical (:lexical-binding new-size) :eax :type fixnum)
+
+ ;; Set up atomically continuation.
+ (:declare-label-set restart-ldb-jumper (restart-ldb))
+ (:locally (:pushl (:edi (:edi-offset :dynamic-env))))
+ (:pushl 'restart-ldb-jumper)
+ ;; ..this allows us to detect recursive atomicallies.
+ (:locally (:pushl (:edi (:edi-offset :atomically-continuation))))
+ (:pushl :ebp)
+ restart-ldb
+
+ (:movl (:esp) :ebp)
+ (:load-lexical (:lexical-binding new-size) :eax)
+
+ (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation))))
+ ;; Now inside atomically section.
;; (new) Size is in EAX.
- (:pushl :eax) ; Save for later
+
(:subl ,movitz:+movitz-fixnum-factor+ :eax)
(:andl ,(logxor #xffffffff
(mask-field (byte (+ 5 movitz:+movitz-fixnum-shift+) 0) -1))
@@ -1997,7 +2055,6 @@
;; Now we must mask MSB bigit.
(:movzxw (:ebx (:offset movitz-bignum length))
:edx)
- (:popl :ecx) ; (new) bytespec size
(:load-lexical (:lexical-binding size) :ecx)
(:shrl 5 :ecx)
(:andl -4 :ecx) ; ECX = index of (conceptual) MSB
@@ -2044,8 +2101,8 @@
:ecx)
(:call-local-pf cons-commit)
return-fixnum
- (: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)
ldb-done))))
(do-it)))))))
More information about the Movitz-cvs
mailing list