February 2005 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by ffjeld＠common-lisp.net 03 Feb '05

03 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3410 Modified Files: interrupt.lisp Log Message: Changed the protocol (wrt. stack discipline) for dynamic control transfer slightly, so that restart-atomically-continuation (i.e. continue after an interrupt occurred inside an atomical sequence) fits into it all. Date: Thu Feb 3 10:18:55 2005 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.39 movitz/losp/muerte/interrupt.lisp:1.40 --- movitz/losp/muerte/interrupt.lisp:1.39 Wed Feb 2 11:48:49 2005 +++ movitz/losp/muerte/interrupt.lisp Thu Feb 3 10:18:55 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.39 2005/02/02 10:48:49 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.40 2005/02/03 09:18:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -84,7 +84,7 @@ (= 0 (ldb (byte 2 0) (dit-frame-ref stack dit-frame :atomically-continuation :unsigned-byte8)))) (stack-frame-ref stack atomically-location 0)) ((null ebp) ; special dynamic control-transfer mode - (stack-frame-ref stack (dit-frame-ref stack dit-frame :dynamic-env) 0)) + (stack-frame-ref stack (dit-frame-ref stack dit-frame :scratch1) 0)) ((< esp ebp) ebp) ((eq esp ebp) @@ -255,15 +255,12 @@ (:movl :edi :esi) ; before bumping ESP, remove reference to funobj.. ; ..in case it's stack-allocated. + (:movl (:ecx 12) :edx) - (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) ; exit to target dynamic-env - - (:movl :edi :ebp) ; enter non-local jump stack mode. - (:movl :ecx :esp) ; - (:movl (:esp) :ecx) ; target stack-frame EBP - (:movl (:ecx -4) :esi) ; get target funobj into ESI - (:movl (:esp 8) :ecx) ; target jumper number - (:jmp (:esi :ecx (:offset movitz-funobj constant0))) + (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) ; interruptee's dynamic-env + (:movl :ecx :edx) + (:locally (:call (:edi (:edi-offset dynamic-jump-next)))) + (:int 63) restart-simple-pf ;; ECX holds the run-time-context offset for us to load.

1 0

[movitz-cvs] CVS update: movitz/special-operators.lisp
by ffjeld＠common-lisp.net 03 Feb '05

03 Feb '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3383 Modified Files: special-operators.lisp Log Message: Changed the protocol (wrt. stack discipline) for dynamic control transfer slightly, so that restart-atomically-continuation (i.e. continue after an interrupt occurred inside an atomical sequence) fits into it all. Date: Thu Feb 3 10:18:51 2005 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.48 movitz/special-operators.lisp:1.49 --- movitz/special-operators.lisp:1.48 Tue Jan 4 17:54:10 2005 +++ movitz/special-operators.lisp Thu Feb 3 10:18:51 2005 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.48 2005/01/04 16:54:10 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.49 2005/02/03 09:18:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1210,6 +1210,7 @@ `((:load-lexical ,dynamic-slot-binding :edx) (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) ; final continuation (:load-lexical ,next-continuation-step-binding :edx) ; next continuation-step + (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) ; goto target dynamic-env (:locally (:call (:edi (:edi-offset dynamic-jump-next)))))))))) ;;; (:locally (:movl :esi (:edi (:edi-offset scratch1))))

1 0

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by ffjeld＠common-lisp.net 03 Feb '05

03 Feb '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3366 Modified Files: special-operators-cl.lisp Log Message: Changed the protocol (wrt. stack discipline) for dynamic control transfer slightly, so that restart-atomically-continuation (i.e. continue after an interrupt occurred inside an atomical sequence) fits into it all. Date: Thu Feb 3 10:18:45 2005 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.44 movitz/special-operators-cl.lisp:1.45 --- movitz/special-operators-cl.lisp:1.44 Thu Jan 27 09:58:53 2005 +++ movitz/special-operators-cl.lisp Thu Feb 3 10:18:45 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.44 2005/01/27 08:58:53 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.45 2005/02/03 09:18:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -769,7 +769,7 @@ (:locally (:call (:edi (:edi-offset dynamic-unwind-next)))) ;; have next-continuation in EAX, final-continuation in EDX (:locally (:movl :edx (:edi (:edi-offset raw-scratch0)))) ; final continuation - + (:locally (:movl :eax (:edi (:edi-offset dynamic-env)))) ; new dynamic-env (:movl :eax :edx) (:clc) (:locally (:call (:edi (:edi-offset dynamic-jump-next)))))))))))) @@ -1304,6 +1304,7 @@ ;;; (:movl ',continue-label (:esp 8)) ; new jumper index (:load-lexical ,next-continuation-step-binding :edx) + (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) (:locally (:call (:edi (:edi-offset dynamic-jump-next)))) ;;; (:locally (:movl :esi (:edi (:edi-offset scratch1))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/cons.lisp
by ffjeld＠common-lisp.net 03 Feb '05

03 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3307 Modified Files: cons.lisp Log Message: *** empty log message *** Date: Thu Feb 3 10:15:46 2005 Author: ffjeld Index: movitz/losp/muerte/cons.lisp diff -u movitz/losp/muerte/cons.lisp:1.8 movitz/losp/muerte/cons.lisp:1.9 --- movitz/losp/muerte/cons.lisp:1.8 Thu Oct 21 22:33:59 2004 +++ movitz/losp/muerte/cons.lisp Thu Feb 3 10:15:46 2005 @@ -1,15 +1,15 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 20012000, 2002-2004, +;;;; Copyright (C) 2000-2005, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: cons.lisp -;;;; Description: +;;;; Description: Cons-cell functionality. ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Dec 8 15:25:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: cons.lisp,v 1.8 2004/10/21 20:33:59 ffjeld Exp $ +;;;; $Id: cons.lisp,v 1.9 2005/02/03 09:15:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp
by ffjeld＠common-lisp.net 03 Feb '05

03 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2591 Modified Files: scavenge.lisp Log Message: Tweaking of scavenge-find-code-vector: match ret-trampoline, and don't break upon EDX match. Date: Thu Feb 3 10:13:20 2005 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.46 movitz/losp/muerte/scavenge.lisp:1.47 --- movitz/losp/muerte/scavenge.lisp:1.46 Wed Feb 2 08:50:57 2005 +++ movitz/losp/muerte/scavenge.lisp Thu Feb 3 10:13:20 2005 @@ -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.46 2005/02/02 07:50:57 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.47 2005/02/03 09:13:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -201,13 +201,16 @@ ((location-in-object-p dit-code-vector location) dit-code-vector) ((match-funobj esi location)) + ((location-in-object-p (symbol-value 'ret-trampoline) location) + (symbol-value 'ret-trampoline)) (t (break "DIT returns outside DIT??"))))) ((match-funobj casf-funobj location)) ((match-funobj esi location)) - ((match-funobj edx location) - (break "Trampoline/EDX situation?")) + ((match-funobj edx location)) ((not (typep casf-funobj 'function)) (break "Unknown funobj/frame-type: ~S" casf-funobj)) + ((location-in-object-p (symbol-value 'ret-trampoline) location) + (symbol-value 'ret-trampoline)) ((location-in-object-p (%run-time-context-slot 'dynamic-jump-next) location) (%run-time-context-slot 'dynamic-jump-next)) ((when primitive-function-p

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv28673 Modified Files: interrupt.lisp Log Message: Changed dit-frame-casf to support atomically mode. Fixed small bug in dit-frame-ref. Date: Wed Feb 2 11:48:49 2005 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.38 movitz/losp/muerte/interrupt.lisp:1.39 --- movitz/losp/muerte/interrupt.lisp:1.38 Wed Feb 2 08:50:25 2005 +++ movitz/losp/muerte/interrupt.lisp Wed Feb 2 11:48:49 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.38 2005/02/02 07:50:25 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.39 2005/02/02 10:48:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -64,7 +64,7 @@ `(memref ,frame (dit-frame-offset ,reg) :type ,type))) (defun dit-frame-ref (stack frame reg &optional (type :lisp)) - (stack-frame-ref stack frame (dit-frame-index reg) type)) + (stack-frame-ref stack (+ frame (dit-frame-index reg)) 0 type)) (define-compiler-macro (setf dit-frame-ref) (&whole form value stack frame reg &optional (type :lisp) @@ -74,14 +74,15 @@ form `(setf (memref ,frame (dit-frame-offset ,reg) :type ,type) ,value))) -;;;(defun (setf dit-frame-ref) (x reg type &optional (frame *last-dit-frame*)) -;;; (setf (memref frame (dit-frame-offset reg) 0 type) x)) - (defun dit-frame-casf (stack dit-frame) "Compute the `currently active stack-frame' when the interrupt occurred." - (let ((ebp (dit-frame-ref stack dit-frame :ebp)) + (let ((atomically-location (dit-frame-ref stack dit-frame :atomically-continuation :location)) + (ebp (dit-frame-ref stack dit-frame :ebp)) (esp (dit-frame-esp stack dit-frame))) (cond + ((and (not (= 0 atomically-location)) + (= 0 (ldb (byte 2 0) (dit-frame-ref stack dit-frame :atomically-continuation :unsigned-byte8)))) + (stack-frame-ref stack atomically-location 0)) ((null ebp) ; special dynamic control-transfer mode (stack-frame-ref stack (dit-frame-ref stack dit-frame :dynamic-env) 0)) ((< esp ebp)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv27130 Modified Files: debugger.lisp Log Message: Improved stack-frame-numargs to recognize (:xorl :ecx :ecx), i.e. the passing of zero arguments to a frame. Date: Wed Feb 2 11:23:07 2005 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.31 movitz/losp/x86-pc/debugger.lisp:1.32 --- movitz/losp/x86-pc/debugger.lisp:1.31 Wed Feb 2 08:51:26 2005 +++ movitz/losp/x86-pc/debugger.lisp Wed Feb 2 11:23:07 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.31 2005/02/02 07:51:26 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.32 2005/02/02 10:23:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -148,13 +148,19 @@ (loop while (and (plusp load-ecx-index) (= #x90 (aref code load-ecx-index))) ; Skip any NOPs do (decf load-ecx-index)) - (cond - ((= #xb1 (aref code (- load-ecx-index 1))) - ;; Assume it's a (:movb x :cl) instruction - (aref code load-ecx-index)) - (t ;; now we should search further for where ecx may be set.. - (format t "{no ECX at ~D in ~S}" call-site funobj) - nil)))))))))))) + (let ((opcode0 (aref code (1- load-ecx-index))) + (opcode1 (aref code load-ecx-index))) + (cond + ((= #xb1 opcode0) + ;; Assume it's a (:movb x :cl) instruction + (aref code load-ecx-index)) + ((and (= #x33 opcode0) (= #xc9 opcode1)) + ;; XORL :ECX :ECX + 0) + (t ;; now we should search further for where ecx may be set.. + (format *debug-io* "{no ECX at ~D in ~S, opcode #x~X #x~X}" + call-site funobj opcode0 opcode1) + nil))))))))))))) (defun signed8-index (s8) "Convert a 8-bit twos-complement signed integer bitpattern to

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23031 Modified Files: inspect.lisp Log Message: Teach stack-frame-call-site about DIT-frames. Date: Wed Feb 2 10:12:54 2005 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.46 movitz/losp/muerte/inspect.lisp:1.47 --- movitz/losp/muerte/inspect.lisp:1.46 Tue Jan 25 14:49:51 2005 +++ movitz/losp/muerte/inspect.lisp Wed Feb 2 10:12:54 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.46 2005/01/25 13:49:51 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.47 2005/02/02 09:12:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -70,12 +70,19 @@ (let ((uplink (stack-frame-uplink stack frame))) (when (and uplink (not (= 0 uplink))) (let ((funobj (stack-frame-funobj stack uplink))) - (when (typep funobj 'function) + (cond + ((typep funobj 'function) (let* ((code-vector (funobj-code-vector funobj)) (eip (stack-frame-ref stack frame 1 :unsigned-byte32)) (delta (- eip 8 (* #.movitz::+movitz-fixnum-factor+ (object-location code-vector))))) (when (below delta (length code-vector)) - (values delta code-vector funobj)))))))) + (values delta code-vector funobj)))) + ((eq 0 funobj) + (let* ((code-vector (symbol-value 'default-interrupt-trampoline)) + (eip (stack-frame-ref stack frame 1 :unsigned-byte32)) + (delta (- eip 8 (* #.movitz::+movitz-fixnum-factor+ (object-location code-vector))))) + (when (below delta (length code-vector)) + (values delta code-vector funobj))))))))) (defun stack-frame-ref (stack frame index &optional (type ':lisp)) "If stack is provided, stack-frame is an index into that stack vector.

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv19160 Modified Files: debugger.lisp Log Message: Tweaked stack-frame-numargs to be slightly more clever. Date: Wed Feb 2 08:51:26 2005 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.30 movitz/losp/x86-pc/debugger.lisp:1.31 --- movitz/losp/x86-pc/debugger.lisp:1.30 Thu Jan 27 12:19:53 2005 +++ movitz/losp/x86-pc/debugger.lisp Wed Feb 2 08:51:26 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.30 2005/01/27 11:19:53 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.31 2005/02/02 07:51:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -144,12 +144,17 @@ ((integerp (car map)) (car map)) ((eq :ecx (car map)) - (cond - ((= #xb1 (aref code (- call-site 5))) - ;; Assume it's a (:movb x :cl) instruction - (aref code (- call-site 4))) - (t ;; now we should search further for where ecx may be set.. - nil))))))))))) + (let ((load-ecx-index (- call-site 4))) + (loop while (and (plusp load-ecx-index) + (= #x90 (aref code load-ecx-index))) ; Skip any NOPs + do (decf load-ecx-index)) + (cond + ((= #xb1 (aref code (- load-ecx-index 1))) + ;; Assume it's a (:movb x :cl) instruction + (aref code load-ecx-index)) + (t ;; now we should search further for where ecx may be set.. + (format t "{no ECX at ~D in ~S}" call-site funobj) + nil)))))))))))) (defun signed8-index (s8) "Convert a 8-bit twos-complement signed integer bitpattern to

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp
by ffjeld＠common-lisp.net 02 Feb '05

02 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19141 Modified Files: scavenge.lisp Log Message: Fixed a number of stack-scavenging bugs. Date: Wed Feb 2 08:50:57 2005 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.45 movitz/losp/muerte/scavenge.lisp:1.46 --- movitz/losp/muerte/scavenge.lisp:1.45 Mon Jan 31 18:54:03 2005 +++ movitz/losp/muerte/scavenge.lisp Wed Feb 2 08:50:57 2005 @@ -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.45 2005/01/31 17:54:03 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.46 2005/02/02 07:50:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -175,7 +175,7 @@ (when (location-in-object-p code-vector location) (return code-vector)))))) -(defun scavenge-find-code-vector (location casf-funobj esi &optional primitive-function-p) +(defun scavenge-find-code-vector (location casf-funobj esi &optional primitive-function-p edx) (flet ((match-funobj (funobj location) (cond ((not (typep funobj 'function)) @@ -203,7 +203,9 @@ ((match-funobj esi location)) (t (break "DIT returns outside DIT??"))))) ((match-funobj casf-funobj location)) - ((match-funobj esi location)) + ((match-funobj esi location)) + ((match-funobj edx location) + (break "Trampoline/EDX situation?")) ((not (typep casf-funobj 'function)) (break "Unknown funobj/frame-type: ~S" casf-funobj)) ((location-in-object-p (%run-time-context-slot 'dynamic-jump-next) location) @@ -302,7 +304,7 @@ 0 interrupted-esi nil)) (new-code-vector (map-stack-instruction-pointer function eip-index old-code-vector))) - ;; + ;; (when atomically (we should be more clever about the stack..)) (multiple-value-bind (x0-location x0-tag) (stack-frame-ref nil next-frame-bottom 0 :signed-byte30+2) (cond @@ -316,7 +318,9 @@ (symbol-value 'ret-trampoline))) (let* ((old-x0-code-vector (scavenge-find-code-vector (stack-frame-ref nil next-eip-index 0 :location) - casf-funobj interrupted-esi t))) + casf-funobj interrupted-esi t + (unless secondary-register-mode-p + (dit-frame-ref nil dit-frame :edx))))) (map-stack-instruction-pointer function next-eip-index old-x0-code-vector)) (setf next-eip-index next-frame-bottom next-frame-bottom (1+ next-frame-bottom))) @@ -328,7 +332,10 @@ (location-in-object-p casf-code-vector x1-location)) (let* ((old-x1-code-vector (scavenge-find-code-vector (stack-frame-ref nil next-eip-index 0 :location) - casf-funobj interrupted-esi t))) + casf-funobj + (unless secondary-register-mode-p + interrupted-esi) + t))) (map-stack-instruction-pointer function next-eip-index old-x1-code-vector)) (setf next-eip-index (+ 1 next-frame-bottom) next-frame-bottom (+ 2 next-frame-bottom)))))))

1 0