Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv1825
Modified Files:
scavenge.lisp
Log Message:
Fixing dynamic control transfers, primarily to handle the
stack-allocated funobjs, but there seems to be a number of (other)
bugs here too. It's not quite working yet, though.
Date: Tue Jan 4 17:54:28 2005
Author: ffjeld
Index: movitz/losp/muerte/scavenge.lisp
diff -u movitz/losp/muerte/scavenge.lisp:1.38 movitz/losp/muerte/scavenge.lisp:1.39
--- movitz/losp/muerte/scavenge.lisp:1.38 Mon Jan 3 12:53:47 2005
+++ movitz/losp/muerte/scavenge.lisp Tue Jan 4 17:54:27 2005
@@ -1,6 +1,6 @@
;;;;------------------------------------------------------------------
;;;;
-;;;; Copyright (C) 2003-2004,
+;;;; Copyright (C) 2003-2005,
;;;; Department of Computer Science, University of Tromso, Norway.
;;;;
;;;; For distribution policy, see the accompanying file COPYING.
@@ -10,7 +10,7 @@
;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org>
;;;; Created at: Mon Mar 29 14:54:08 2004
;;;;
-;;;; $Id: scavenge.lisp,v 1.38 2005/01/03 11:53:47 ffjeld Exp $
+;;;; $Id: scavenge.lisp,v 1.39 2005/01/04 16:54:27 ffjeld Exp $
;;;;
;;;;------------------------------------------------------------------
@@ -204,10 +204,11 @@
(+ dit-frame (dit-frame-index :ecx)))))
;; 2. Pop to (dit-)frame's CASF
(setf nether-frame dit-frame
- frame (dit-frame-casf stack frame))
- (let ((casf-funobj (funcall function (stack-frame-funobj stack frame) frame))
+ frame casf-frame #+ignore (dit-frame-casf stack frame))
+ (let ((eip-location (dit-frame-ref stack dit-frame :eip :location))
+ (interrupted-esp (dit-frame-esp stack dit-frame))
(interrupted-ebp (dit-frame-ref stack dit-frame :ebp))
- (interrupted-esp (dit-frame-esp stack dit-frame)))
+ (casf-funobj (funcall function (stack-frame-funobj stack frame) frame)))
(cond
#+ignore
((eq nil casf-funobj)
@@ -218,23 +219,21 @@
(let ((casf-code-vector (scavenge-funobj-code-vector casf-funobj)))
;; 3. Scavenge the interrupted frame, according to one of i. ii. or iii.
(cond
- ((< interrupted-ebp interrupted-esp)
+ ((eq nil interrupted-ebp)
(cond
- ((location-in-object-p casf-code-vector
- (dit-frame-ref stack dit-frame :eip :location))
- (warn "DIT at throw situation, in target EIP=~S"
+ ((location-in-object-p casf-code-vector eip-location)
+ (warn "DIT at throw situation, in target ~S at ~S"
+ casf-funobj
(dit-frame-ref stack dit-frame :eip :unsigned-byte32))
(map-region function interrupted-esp frame))
- ((location-in-object-p (scavenge-funobj-code-vector (dit-frame-ref stack
- dit-frame
- :scratch1))
- (dit-frame-ref stack dit-frame :eip :location))
- (warn "DIT at throw situation, in thrower EIP=~S"
- (dit-frame-ref stack dit-frame :eip :unsigned-byte32))
- (map-region function interrupted-esp frame))
- (t (error "DIT with EBP<ESP, EBP=~S, ESP=~S"
- interrupted-ebp
- interrupted-esp))))
+ ((location-in-object-p (%run-time-context-slot 'dynamic-jump-next)
+ eip-location)
+ (warn "DIT at throw situation, in dynamic-jump-next.")
+ (let ((dynamic-env (dit-frame-ref stack dit-frame :dynamic-env)))
+ (assert (< dynamic-env frame))
+ (map-region function dynamic-env frame)))
+ (t (error "Unknown throw situation with EBP=~S, ESP=~S"
+ interrupted-ebp interrupted-esp))))
((location-in-object-p casf-code-vector
(dit-frame-ref stack dit-frame :eip :location))
(cond
@@ -295,7 +294,8 @@
(map-region function (+ interrupted-esp 1) frame)
(setf next-frame frame
next-nether-frame (+ interrupted-esp 1 -2))))))
- (t (error "DIT-frame interrupted unknown CASF funobj: ~S" casf-funobj))))))
+ (t (error "DIT-frame interrupted unknown CASF funobj: ~Z, CASF ~S"
+ casf-funobj casf-frame))))))
(t (error "Don't know how to scavenge across frame ~S of kind ~S." frame funobj)))))))
(values))