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

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

25 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv10682 Modified Files: print.lisp Log Message: Minor change to the way errors are printed under *print-safely*. Date: Fri Feb 25 09:00:12 2005 Author: ffjeld Index: movitz/losp/muerte/print.lisp diff -u movitz/losp/muerte/print.lisp:1.17 movitz/losp/muerte/print.lisp:1.18 --- movitz/losp/muerte/print.lisp:1.17 Mon Jan 17 12:02:27 2005 +++ movitz/losp/muerte/print.lisp Fri Feb 25 09:00:11 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Sep 3 11:48:19 2001 ;;;; -;;;; $Id: print.lisp,v 1.17 2005/01/17 11:02:27 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.18 2005/02/25 08:00:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -194,7 +194,7 @@ (handler-case (internal-write object) (serious-condition (c) (print-unreadable-object (c *standard-output* :type t :identity t) - (format t " while printing ~Z" object)))))))) + (format t " (while printing ~Z)" object)))))))) (defun internal-write (object) (let ((stream *standard-output*))

1 0

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

25 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv10604 Modified Files: inspect.lisp Log Message: Added location-in-code-vector-p%unsafe. Date: Fri Feb 25 08:59:31 2005 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.47 movitz/losp/muerte/inspect.lisp:1.48 --- movitz/losp/muerte/inspect.lisp:1.47 Wed Feb 2 10:12:54 2005 +++ movitz/losp/muerte/inspect.lisp Fri Feb 25 08:59:31 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.47 2005/02/02 09:12:54 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.48 2005/02/25 07:59:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -403,6 +403,16 @@ (+ -1 object-location #.(movitz::movitz-type-word-size :movitz-struct) (* 2 (truncate (+ (structure-object-length object) 1) 2)))))))) + +(defun location-in-code-vector-p%unsafe (code-vector location) + (and (<= (object-location code-vector) location) + (<= location + (+ -1 (object-location code-vector) + #.(movitz::movitz-type-word-size 'movitz-basic-vector) + (* 2 (truncate (+ (memref code-vector + (movitz-type-slot-offset 'movitz-basic-vector 'num-elements)) + 7) + 8)))))) (defun current-control-stack-depth (&optional (start-frame (current-stack-frame))) "How deep is the stack currently?"

1 0

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

25 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv10585 Modified Files: basic-macros.lisp Log Message: Added movitz-type-location-offset. Date: Fri Feb 25 08:59:05 2005 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.54 movitz/losp/muerte/basic-macros.lisp:1.55 --- movitz/losp/muerte/basic-macros.lisp:1.54 Tue Jan 4 12:36:09 2005 +++ movitz/losp/muerte/basic-macros.lisp Fri Feb 25 08:59:04 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.54 2005/01/04 11:36:09 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.55 2005/02/25 07:59:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -409,6 +409,13 @@ (bt:slot-offset (intern (symbol-name (movitz:movitz-eval type env)) :movitz) (intern (symbol-name (movitz:movitz-eval slot env)) :movitz)))) +(define-compiler-macro movitz-type-location-offset (type slot &environment env) + (if (not (and (movitz:movitz-constantp type env) + (movitz:movitz-constantp slot env))) + (error "Non-constant movitz-type-slot-offset call.") + (truncate (+ -6 (bt:slot-offset (intern (symbol-name (movitz:movitz-eval type env)) :movitz) + (intern (symbol-name (movitz:movitz-eval slot env)) :movitz))) + 4))) (define-compiler-macro not (x) `(muerte::inlined-not ,x)) @@ -540,7 +547,7 @@ nil) (t (if (member type '(standard-gf-instance function pointer atom integer fixnum positive-fixnum cons symbol character null list - string vector simple-vector vector-u8 vector-u16 code-vector)) + string vector simple-vector vector-u8 vector-u16)) `(with-inline-assembly (:returns :nothing :labels (fail)) (:compile-form (:result-mode (:boolean-branch-on-false . check-type-failed)) (typep ,place ',type))

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by ffjeld＠common-lisp.net 25 Feb '05

25 Feb '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv10561 Modified Files: packages.lisp Log Message: *** empty log message *** Date: Fri Feb 25 08:58:28 2005 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.43 movitz/packages.lisp:1.44 --- movitz/packages.lisp:1.43 Fri Nov 26 15:59:14 2004 +++ movitz/packages.lisp Fri Feb 25 08:58:26 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2003-2004, +;;;; Copyright (C) 2003-2005, ;;;; Department of Computer Science, University of Tromsoe, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.43 2004/11/26 14:59:14 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.44 2005/02/25 07:58:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

1 0

[movitz-cvs] CVS update: movitz/bochsrc.txt
by ffjeld＠common-lisp.net 25 Feb '05

25 Feb '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv10533 Modified Files: bochsrc.txt Log Message: *** empty log message *** Date: Fri Feb 25 08:58:11 2005 Author: ffjeld Index: movitz/bochsrc.txt diff -u movitz/bochsrc.txt:1.6 movitz/bochsrc.txt:1.7 --- movitz/bochsrc.txt:1.6 Wed Jul 21 15:27:58 2004 +++ movitz/bochsrc.txt Fri Feb 25 08:58:10 2005 @@ -45,8 +45,7 @@ # disable the mouse, since DLX is text only mouse: enabled=0 -ne2k: ioaddr=0x280, irq=9, mac=00:40:05:18:66:d8, ethmod=fbsd, ethdev=xl0 -ne2k: ioaddr=0x300, irq=3, mac=00:40:05:18:66:d9, ethmod=fbsd, ethdev=xl0 +ne2k: ioaddr=0x300, irq=3, mac=00:40:05:18:66:d9, ethmod=fbsd, ethdev=nge0 # panic: action=report error: action=report

1 0

[movitz-cvs] CVS update: public_html/ChangeLog
by ffjeld＠common-lisp.net 24 Feb '05

24 Feb '05

Update of /project/movitz/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv9175 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Feb 24 13:23:08 2005 Author: ffjeld Index: public_html/ChangeLog diff -u public_html/ChangeLog:1.1 public_html/ChangeLog:1.2 --- public_html/ChangeLog:1.1 Sat Jan 29 11:42:28 2005 +++ public_html/ChangeLog Thu Feb 24 13:23:08 2005 @@ -1,3 +1,8 @@ +2005-02-24 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> + + * Entering an integer at the REPL now invokes the corresponding + restart, if it exists. + 2005-01-29 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> * There's been quite a bit of work on scavenge.lisp. The stack scavenging

1 0

[movitz-cvs] CVS update: movitz/losp/lib/repl.lisp
by ffjeld＠common-lisp.net 24 Feb '05

24 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv9149 Modified Files: repl.lisp Log Message: Have the REPL interpret integers as restart to be invoked. Date: Thu Feb 24 13:21:31 2005 Author: ffjeld Index: movitz/losp/lib/repl.lisp diff -u movitz/losp/lib/repl.lisp:1.13 movitz/losp/lib/repl.lisp:1.14 --- movitz/losp/lib/repl.lisp:1.13 Sat Sep 25 17:25:53 2004 +++ movitz/losp/lib/repl.lisp Thu Feb 24 13:21:30 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001, 2003-2004, +;;;; Copyright (C) 2001, 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: Wed Mar 19 14:58:12 2003 ;;;; -;;;; $Id: repl.lisp,v 1.13 2004/09/25 15:25:53 ffjeld Exp $ +;;;; $Id: repl.lisp,v 1.14 2005/02/24 12:21:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -82,20 +82,26 @@ nil (copy-list results))) (values-list results))) - (if (not (keywordp form)) + (let ((restart (and (integerp form) + (muerte:find-restart-by-index form + muerte:*debugger-dynamic-context*)))) + (cond + (restart + (invoke-restart-interactively restart)) + ((not (keywordp form)) (multiple-value-call #'process-expresion - form previous-package t (eval form)) - (multiple-value-call #'process-expresion - form previous-package nil - (apply 'muerte.toplevel:invoke-toplevel-command - form - (loop for arg = (multiple-value-bind (arg x) - (simple-read-from-string buffer-string nil '#0=#:eof - :start buffer-pointer) - (setq buffer-pointer x) - arg) - until (eq arg '#0#) - collect arg)))))))) + form previous-package t (eval form))) + (t (multiple-value-call #'process-expresion + form previous-package nil + (apply 'muerte.toplevel:invoke-toplevel-command + form + (loop for arg = (multiple-value-bind (arg x) + (simple-read-from-string buffer-string nil '#0=#:eof + :start buffer-pointer) + (setq buffer-pointer x) + arg) + until (eq arg '#0#) + collect arg)))))))))) (muerte.readline::readline-break (c) (declare (ignore c)) (values))))

1 0

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

15 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13009 Modified Files: scavenge.lisp Log Message: Rename to map-instruction-pointer. Date: Tue Feb 15 23:22:47 2005 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.47 movitz/losp/muerte/scavenge.lisp:1.48 --- movitz/losp/muerte/scavenge.lisp:1.47 Thu Feb 3 10:13:20 2005 +++ movitz/losp/muerte/scavenge.lisp Tue Feb 15 23:22:47 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.47 2005/02/03 09:13:20 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.48 2005/02/15 22:22:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -98,7 +98,7 @@ (let ((new-code-vector (funcall function code-vector scan))) (check-type new-code-vector code-vector) (unless (eq code-vector new-code-vector) - (error "Code-vector migration is not implemented.") + (error "Code-vector migration is not implemented (~S)." funobj) (setf (memref scan 0 :index -1) (%word-offset new-code-vector 2)) ;; Do more stuff here to update code-vectors and jumpers )) @@ -195,24 +195,22 @@ (location-in-object-p x location) x)))))) (cond + ((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)) ((eq 0 casf-funobj) (let ((dit-code-vector (symbol-value 'default-interrupt-trampoline))) (cond ((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)) ((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 (scavenge-find-pf location) #+ignore @@ -247,7 +245,7 @@ (t (let* ((old-code-vector (scavenge-find-code-vector (stack-frame-ref nil eip-index 0 :location) frame-funobj nil nil))) - (map-stack-instruction-pointer function eip-index old-code-vector)) + (map-instruction-pointer function eip-index old-code-vector)) (let ((raw-locals (funobj-frame-raw-locals frame-funobj))) (if (= 0 raw-locals) (map-region function frame-bottom frame) @@ -306,7 +304,7 @@ (scavenge-find-code-vector (stack-frame-ref nil eip-index 0 :location) 0 interrupted-esi nil)) - (new-code-vector (map-stack-instruction-pointer function eip-index old-code-vector))) + (new-code-vector (map-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) @@ -324,7 +322,7 @@ 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)) + (map-instruction-pointer function next-eip-index old-x0-code-vector)) (setf next-eip-index next-frame-bottom next-frame-bottom (1+ next-frame-bottom))) (t (multiple-value-bind (x1-location x1-tag) @@ -339,19 +337,21 @@ (unless secondary-register-mode-p interrupted-esi) t))) - (map-stack-instruction-pointer function next-eip-index old-x1-code-vector)) + (map-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))))))) ;; proceed (map-stack function casf-frame next-frame-bottom next-eip-index map-region))))) -(defun map-stack-instruction-pointer (function index old-code-vector) - "Update the (raw) instruction-pointer in stack at index, +(defun map-instruction-pointer (function location + &optional (old-code-vector (memref location 0 :type :code-vector))) + "Update the (raw) instruction-pointer at location, assuming the pointer refers to old-code-vector." - (assert (location-in-object-p old-code-vector (stack-frame-ref nil index 0 :location))) + (check-type old-code-vector code-vector) + (assert (location-in-object-p old-code-vector (memref location 0 :type :location))) (let ((new-code-vector (funcall function old-code-vector nil))) (when (not (eq old-code-vector new-code-vector)) - (break "Code-vector for stack instruction-pointer moved. [index: ~S]" index)) + (break "Code-vector for stack instruction-pointer moved at location ~S" location)) new-code-vector))

1 0

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

14 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18079 Modified Files: bignums.lisp Log Message: In bignum-shift-leftf, ensure that ESI is restored to funobj before the function returns, as mandated by the stack discipline. Date: Mon Feb 14 08:13:42 2005 Author: ffjeld Index: movitz/losp/muerte/bignums.lisp diff -u movitz/losp/muerte/bignums.lisp:1.14 movitz/losp/muerte/bignums.lisp:1.15 --- movitz/losp/muerte/bignums.lisp:1.14 Tue Jan 25 14:45:24 2005 +++ movitz/losp/muerte/bignums.lisp Mon Feb 14 08:13:42 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Jul 17 19:42:57 2004 ;;;; -;;;; $Id: bignums.lisp,v 1.14 2005/01/25 13:45:24 ffjeld Exp $ +;;;; $Id: bignums.lisp,v 1.15 2005/02/14 07:13:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -391,10 +391,10 @@ (:movl :edi :edx) (:movl :edi :eax) ; Safe EAX (:cld) - (:movl (:ebp -4) :esi) shift-short-lsb (:shll :cl (:ebx (:offset movitz-bignum bigit0))) done + (:movl (:ebp -4) :esi) ))) (do-it))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.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-serv3432 Modified Files: primitive-functions.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:19:03 2005 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.62 movitz/losp/muerte/primitive-functions.lisp:1.63 --- movitz/losp/muerte/primitive-functions.lisp:1.62 Tue Feb 1 17:20:08 2005 +++ movitz/losp/muerte/primitive-functions.lisp Thu Feb 3 10:19:02 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.62 2005/02/01 16:20:08 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.63 2005/02/03 09:19:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -685,7 +685,7 @@ (with-inline-assembly (:returns :non-local-exit) (:movl :edi :esi) ; before bumping ESP, remove reference to funobj.. ; ..in case it's stack-allocated. - (:locally (:movl :edx (:edi (:edi-offset dynamic-env)))) ; exit to next-env + (:locally (:movl :edx (:edi (:edi-offset scratch1)))) ; non-local stack-mode target entry. (:movl :edi :ebp) ; enter non-local jump stack mode. (:movl :edx :esp) ; (:movl (:esp) :edx) ; target stack-frame EBP

1 0