[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Sep 21 13:05:50 UTC 2004
Update of /project/movitz/cvsroot/movitz/losp
In directory common-lisp.net:/tmp/cvs-serv16838
Modified Files:
los0-gc.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:05:50 2004
Author: ffjeld
Index: movitz/losp/los0-gc.lisp
diff -u movitz/losp/los0-gc.lisp:1.37 movitz/losp/los0-gc.lisp:1.38
--- movitz/losp/los0-gc.lisp:1.37 Thu Sep 16 10:55:00 2004
+++ movitz/losp/los0-gc.lisp Tue Sep 21 15:05:49 2004
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef at acm.org>
;;;; Created at: Sat Feb 21 17:48:32 2004
;;;;
-;;;; $Id: los0-gc.lisp,v 1.37 2004/09/16 08:55:00 ffjeld Exp $
+;;;; $Id: los0-gc.lisp,v 1.38 2004/09/21 13:05:49 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -74,32 +74,26 @@
(values))
(define-primitive-function los0-fast-cons ()
- "Allocate a cons cell from nursery-space."
+ "Allocate a cons cell of EAX and EBX from nursery-space."
(macrolet
((do-it ()
`(with-inline-assembly (:returns :eax)
retry-cons
;; Set up thread-atomical execution
- (:locally (:movl ,(movitz::atomically-status-simple-pf 'fast-cons t)
- (:edi (:edi-offset atomically-status))))
+ (:locally (:movl ,(movitz::atomically-continuation-simple-pf 'fast-cons)
+ (:edi (:edi-offset atomically-continuation))))
(:locally (:movl (:edi (:edi-offset nursery-space)) :edx))
(:movl (:edx 2) :ecx)
(:cmpl (:edx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements))
:ecx)
(:jae '(:sub-program (allocation-failed)
- ;; Exit thread-atomical
- (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status))))
- (:int 113)
- ;; This interrupt can be retried.
- (:jmp 'retry-cons)))
+ (:int 113)))
(:movl :eax (:edx :ecx 2))
(:movl :ebx (:edx :ecx 6))
(:addl 8 :ecx)
(:movl :ecx (:edx 2)) ; Commit allocation
;; Exit thread-atomical
- (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status))))
+ (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
(:leal (:edx :ecx -5) :eax)
(:ret))))
(do-it)))
@@ -144,7 +138,7 @@
((do-it ()
`(with-inline-assembly (:returns :multiple-values)
retry
- (:locally (:cmpl 0 (:edi (:edi-offset atomically-status)))) ; Atomically?
+ (:locally (:cmpl 0 (:edi (:edi-offset atomically-continuation)))) ; Atomically?
(:je '(:sub-program ()
(:int 63))) ; This must be called inside atomically.
(:locally (:movl (:edi (:edi-offset nursery-space)) :edx))
@@ -168,7 +162,7 @@
((do-it ()
`(with-inline-assembly (:returns :multiple-values)
retry
- (:locally (:cmpl 0 (:edi (:edi-offset atomically-status)))) ; Atomically?
+ (:locally (:cmpl 0 (:edi (:edi-offset atomically-continuation)))) ; Atomically?
(:je '(:sub-program ()
(:int 50))) ; This must be called inside atomically.
(:addl ,movitz:+movitz-fixnum-factor+ :ecx)
@@ -196,17 +190,14 @@
(:ret)
not-fixnum
retry-cons
- (:locally (:movl ,(movitz::atomically-status-simple-pf 'box-u32-ecx t)
- (:edi (:edi-offset atomically-status))))
+ (:locally (:movl ,(movitz::atomically-continuation-simple-pf 'box-u32-ecx)
+ (:edi (:edi-offset atomically-continuation))))
(:locally (:movl (:edi (:edi-offset nursery-space)) :edx))
(:movl (:edx 2) :eax)
(:cmpl (:edx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements))
:eax)
(:jae '(:sub-program ()
- (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status))))
- (:int 113) ; This interrupt can be retried.
- (:jmp 'retry-cons)))
+ (:int 113)))
(:movl ,(dpb movitz:+movitz-fixnum-factor+
(byte 16 16) (movitz:tag :bignum 0))
(:edx :eax 2))
@@ -214,70 +205,11 @@
(:addl 8 :eax)
(:movl :eax (:edx 2)) ; Commit allocation
;; Exit thread-atomical
- (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive)
- (:edi (:edi-offset atomically-status))))
+ (:locally (:movl 0 (:edi (:edi-offset atomically-continuation))))
(:leal (:edx :eax) :eax)
(:ret))))
(do-it)))
-(define-primitive-function los0-malloc-pointer-words (words)
- "Number of words in EAX/fixnum. Result in EAX with tag :other."
- (macrolet
- ((do-it ()
- `(with-inline-assembly (:returns :multiple-values)
- (:addl 4 :eax)
- (:andl -8 :eax)
- (:movl :eax :ebx) ; Save count for later
- retry
- (:locally (:movl (:edi (:edi-offset nursery-space)) :edx))
- (:movl (:edx 2) :ecx)
- (:leal (:ecx :eax) :eax)
- (:cmpl (:edx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements))
- :eax)
- (:ja '(:sub-program ()
- (:int 113)
- (:movl :ebx :eax) ; Restore count in EAX before retry
- (:jmp 'retry)))
- (:movl :eax (:edx 2))
- (:movl ,(movitz:basic-vector-type-tag :any-t)
- (:edx :ecx ,(+ 8 movitz:+other-type-offset+)))
- (:subl 8 :ebx)
- (:movl :ebx (:edx :ecx ,(+ 16 movitz:+other-type-offset+)))
- (:leal (:edx :ecx 8) :eax)
- (:xorl :ecx :ecx)
- (:addl 8 :ecx)
- init-loop ; Now init ebx number of words
- (:movl :edi (:eax :ecx ,(- (movitz:tag :other))))
- (:addl 4 :ecx)
- (:cmpl :ebx :ecx)
- (:jb 'init-loop)
- (:ret))))
- (do-it)))
-
-(define-primitive-function los0-malloc-non-pointer-words (words)
- "Number of words in EAX/fixnum. Result in EAX with tag :other."
- (macrolet
- ((do-it ()
- `(with-inline-assembly (:returns :multiple-values)
- (:addl 4 :eax)
- (:andl -8 :eax)
- (:movl :eax :ebx) ; Save count for later
- retry
- (:locally (:movl (:edi (:edi-offset nursery-space)) :edx))
- (:movl (:edx 2) :ecx)
- (:leal (:ecx :eax) :eax)
- (:cmpl (:edx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements))
- :eax)
- (:ja '(:sub-program ()
- (:int 113)
- (:movl :ebx :eax) ; Restore count in EAX before retry
- (:jmp 'retry)))
- (:movl :eax (:edx 2))
- (:movl ,(movitz:tag :infant-object) (:edx :ecx ,(+ 8 movitz:+other-type-offset+)))
- (:leal (:edx :ecx 8) :eax) ; Now EAX is a valid pointer
- (:ret))))
- (do-it)))
-
(defvar *gc-stack*)
(defun install-los0-consing (&key (context (current-run-time-context))
@@ -466,7 +398,21 @@
old object: ~Z: ~S
new object: ~Z: ~S
oldspace: ~Z, newspace: ~Z, i: ~D"
- old old new new oldspace newspace i))))))))
+ old old new new oldspace newspace i))))))
+ (map-heap-words (lambda (x y)
+ (declare (ignore y))
+ (when (location-in-object-p (space-other (%run-time-context-slot 'nursery-space))
+ (object-location x))
+ (break "Seeing old object in values-vector: ~Z" x))
+ x)
+ #x38 #xb8)
+ (let* ((stack (%run-time-context-slot 'muerte::nursery-space))
+ (stack-start (- (length stack) (muerte::current-control-stack-depth))))
+ (do ((i 0 (+ i 3)))
+ ((>= i (length a)))
+ (when (find (aref a i) stack :start stack-start)
+ (break "Seeing old object ~S in current stack!"
+ (aref a i)))))))
;; GC completed, oldspace is evacuated.
(unless *gc-quiet*
More information about the Movitz-cvs
mailing list