September 2004 - movitz-cvs@common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp
by Frode Vatvedt Fjeld 27 Sep '04

27 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25648 Modified Files: run-time-context.lisp Log Message: Removed dead code. Date: Mon Sep 27 10:54:53 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.13 movitz/losp/muerte/run-time-context.lisp:1.14 --- movitz/losp/muerte/run-time-context.lisp:1.13 Mon Sep 27 10:53:37 2004 +++ movitz/losp/muerte/run-time-context.lisp Mon Sep 27 10:54:53 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.13 2004/09/27 08:53:37 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.14 2004/09/27 08:54:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -114,10 +114,6 @@ (name :anonymous)) (check-type parent run-time-context) (let ((context (%shallow-copy-object parent #.(movitz::movitz-type-word-size 'movitz-run-time-context)))) -;;; #+ignore -;;; (malloc-pointer-words #.(cl:truncate (bt:sizeof 'movitz::movitz-run-time-context) 4)))) -;;; (memcopy context parent -6 0 0 #.(bt:sizeof 'movitz::movitz-run-time-context) -;;; :unsigned-byte8) (setf (%run-time-context-slot 'name context) name (%run-time-context-slot 'self context) context) (setf (%run-time-context-segment-base 'segment-descriptor-thread-context context)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp
by Frode Vatvedt Fjeld 27 Sep '04

27 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25620 Modified Files: run-time-context.lisp Log Message: Removed the last usage of the obsolete malloc-pointer-words. Date: Mon Sep 27 10:53:38 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.12 movitz/losp/muerte/run-time-context.lisp:1.13 --- movitz/losp/muerte/run-time-context.lisp:1.12 Wed Sep 22 19:55:34 2004 +++ movitz/losp/muerte/run-time-context.lisp Mon Sep 27 10:53:37 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.12 2004/09/22 17:55:34 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.13 2004/09/27 08:53:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -113,9 +113,11 @@ (defun clone-run-time-context (&key (parent (current-run-time-context)) (name :anonymous)) (check-type parent run-time-context) - (let ((context (malloc-pointer-words #.(cl:truncate (bt:sizeof 'movitz::movitz-run-time-context) 4)))) - (memcopy context parent -6 0 0 #.(bt:sizeof 'movitz::movitz-run-time-context) - :unsigned-byte8) + (let ((context (%shallow-copy-object parent #.(movitz::movitz-type-word-size 'movitz-run-time-context)))) +;;; #+ignore +;;; (malloc-pointer-words #.(cl:truncate (bt:sizeof 'movitz::movitz-run-time-context) 4)))) +;;; (memcopy context parent -6 0 0 #.(bt:sizeof 'movitz::movitz-run-time-context) +;;; :unsigned-byte8) (setf (%run-time-context-slot 'name context) name (%run-time-context-slot 'self context) context) (setf (%run-time-context-segment-base 'segment-descriptor-thread-context context)

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by Frode Vatvedt Fjeld 25 Sep '04

25 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv11999 Modified Files: debugger.lisp Log Message: Minor edits. Date: Sat Sep 25 17:53:25 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.25 movitz/losp/x86-pc/debugger.lisp:1.26 --- movitz/losp/x86-pc/debugger.lisp:1.25 Wed Sep 22 20:00:55 2004 +++ movitz/losp/x86-pc/debugger.lisp Sat Sep 25 17:53:25 2004 @@ -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.25 2004/09/22 18:00:55 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.26 2004/09/25 15:53:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -553,7 +553,10 @@ exception primitive-name (code-vector-offset primitive-vector eip))))))) - (t (format t "DIT Exception ~D with ESI=~Z and EIP=#x~X." + (t ;; This should in principle never happen, but since this + ;; is a debugger, making this an error or break would probably + ;; just be a nuisance. + (format t "DIT Exception ~D. Unable to determine current function (!) with ESI=~Z and EIP=#x~X." exception funobj eip))))))))) (function (let ((name (funobj-name funobj)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.lisp
by Frode Vatvedt Fjeld 25 Sep '04

25 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11099 Modified Files: primitive-functions.lisp Log Message: Added "RET atomification". I.e. when an interrupt occurs just before a RET instruction, EIP is moved to a well-known code-vector that just does the same RET. The point is that otherwise it's impossible (or too difficult) to figure out which code-vector EIP references. Date: Sat Sep 25 17:51:22 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.44 movitz/losp/muerte/primitive-functions.lisp:1.45 --- movitz/losp/muerte/primitive-functions.lisp:1.44 Wed Sep 22 16:48:27 2004 +++ movitz/losp/muerte/primitive-functions.lisp Sat Sep 25 17:51:22 2004 @@ -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.44 2004/09/22 14:48:27 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.45 2004/09/25 15:51:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -714,4 +714,7 @@ ;;;;;; - +(define-primitive-function ret-trampoline () + "This is the global RET trampoline, used to achieve stack discipline." + (with-inline-assembly (:returns :multiple-values) + (:ret)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.lisp
by Frode Vatvedt Fjeld 25 Sep '04

25 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11082 Modified Files: interrupt.lisp Log Message: Added "RET atomification". I.e. when an interrupt occurs just before a RET instruction, EIP is moved to a well-known code-vector that just does the same RET. The point is that otherwise it's impossible (or too difficult) to figure out which code-vector EIP references. Date: Sat Sep 25 17:51:20 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.26 movitz/losp/muerte/interrupt.lisp:1.27 --- movitz/losp/muerte/interrupt.lisp:1.26 Wed Sep 22 19:57:33 2004 +++ movitz/losp/muerte/interrupt.lisp Sat Sep 25 17:51:20 2004 @@ -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.26 2004/09/22 17:57:33 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.27 2004/09/25 15:51:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -123,6 +123,14 @@ (:pushl (:eax 2)) ; debug1: nursery-space's fresh-pointer (:locally (:movl 0 (:edi (:edi-offset atomically-continuation)))) + + ;; Do RET atomicification + (:movl (:ebp ,(dit-frame-offset :eip)) :ecx) + (:cmpb ,(realpart (ia-x86:asm :ret)) (:ecx)) + (:jne 'not-at-ret-instruction) + (:locally (:movl (:edi (:edi-offset ret-trampoline)) :ecx)) + (:movl :ecx (:ebp ,(dit-frame-offset :eip))) + not-at-ret-instruction (:xorl :eax :eax) ; Ensure safe value (:xorl :edx :edx) ; Ensure safe value

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 25 Sep '04

25 Sep '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7837 Modified Files: image.lisp Log Message: Some re-arrangements of the run-time-context structure. Date: Sat Sep 25 17:40:30 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.70 movitz/image.lisp:1.71 --- movitz/image.lisp:1.70 Tue Sep 21 15:01:00 2004 +++ movitz/image.lisp Sat Sep 25 17:40:30 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.70 2004/09/21 13:01:00 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.71 2004/09/25 15:40:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -181,6 +181,11 @@ :binary-tag :primitive-function :map-binary-read-delayed 'movitz-word-code-vector :binary-type code-vector-word) + (dynamic-unwind-next + :map-binary-write 'movitz-intern-code-vector + :binary-tag :primitive-function + :map-binary-read-delayed 'movitz-word-code-vector + :binary-type code-vector-word) (dynamic-unwind :map-binary-write 'movitz-intern-code-vector :binary-tag :primitive-function @@ -341,13 +346,13 @@ :map-binary-read-delayed 'movitz-word :initarg :exception-handlers :accessor movitz-run-time-context-exception-handlers) - (exception-handler-tails - :binary-type word - :initform nil - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word - :initarg :exception-handler-tails - :accessor movitz-run-time-context-exception-handler-tails) +;;; (exception-handler-tails +;;; :binary-type word +;;; :initform nil +;;; :map-binary-write 'movitz-read-and-intern +;;; :map-binary-read-delayed 'movitz-word +;;; :initarg :exception-handler-tails +;;; :accessor movitz-run-time-context-exception-handler-tails) (interrupt-descriptor-table :binary-type word :accessor movitz-run-time-context-interrupt-descriptor-table @@ -460,11 +465,11 @@ (scratch1 :binary-type word :initform 0) - (dynamic-unwind-next + (ret-trampoline + :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector - :binary-tag :primitive-function :map-binary-read-delayed 'movitz-word-code-vector - :binary-type code-vector-word)) + :binary-tag :primitive-function)) (:slot-align null-symbol -5)) (defun atomically-continuation-simple-pf (pf-name)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.lisp
by Frode Vatvedt Fjeld 25 Sep '04

25 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7800 Modified Files: los-closette.lisp Log Message: break rather than warn when auto-bootstrapping CLOS. Date: Sat Sep 25 17:38:48 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.20 movitz/losp/muerte/los-closette.lisp:1.21 --- movitz/losp/muerte/los-closette.lisp:1.20 Thu Sep 23 11:11:26 2004 +++ movitz/losp/muerte/los-closette.lisp Sat Sep 25 17:38:47 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 23 14:29:10 2002 ;;;; -;;;; $Id: los-closette.lisp,v 1.20 2004/09/23 09:11:26 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.21 2004/09/25 15:38:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -779,7 +779,9 @@ (let ((x (std-gf-classes-to-emf-table gf))) (cond ((not x) - (warn "Auto-bootstrapping CLOS.") + (unless (get 'clos-bootsrap 'breaking-on-auto-bootstrap) + (setf (get 'clos-bootsrap 'breaking-on-auto-bootstrap) t) + (break "Auto-bootstrapping CLOS.")) (clos-bootstrap) (unless (get 'clos-bootstrap 'have-bootstrapped) (error "Giving up auto-bootstrapping of CLOS."))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/packages.lisp
by Frode Vatvedt Fjeld 25 Sep '04

25 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7752 Modified Files: packages.lisp Log Message: Use (string name) rather than name for the error when not finding a package. Date: Sat Sep 25 17:36:16 2004 Author: ffjeld Index: movitz/losp/muerte/packages.lisp diff -u movitz/losp/muerte/packages.lisp:1.3 movitz/losp/muerte/packages.lisp:1.4 --- movitz/losp/muerte/packages.lisp:1.3 Tue Apr 13 16:21:09 2004 +++ movitz/losp/muerte/packages.lisp Sat Sep 25 17:36:16 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 30 15:19:43 2001 ;;;; -;;;; $Id: packages.lisp,v 1.3 2004/04/13 14:21:09 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.4 2004/09/25 15:36:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -48,7 +48,7 @@ (defun assert-package (name) (or (find-package name) - (error "There is no package named ~S." name))) + (error "There is no package named ~S." (string name)))) (defun find-symbol-string (name start end key &optional (package *package*)) (check-type name string)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/simple-streams.lisp
by Frode Vatvedt Fjeld 25 Sep '04

25 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6728 Modified Files: simple-streams.lisp Log Message: Verify that vector-push-extend works for writing to string-stream. Date: Sat Sep 25 17:26:49 2004 Author: ffjeld Index: movitz/losp/muerte/simple-streams.lisp diff -u movitz/losp/muerte/simple-streams.lisp:1.5 movitz/losp/muerte/simple-streams.lisp:1.6 --- movitz/losp/muerte/simple-streams.lisp:1.5 Thu May 20 19:48:34 2004 +++ movitz/losp/muerte/simple-streams.lisp Sat Sep 25 17:26:49 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Aug 29 13:39:43 2003 ;;;; -;;;; $Id: simple-streams.lisp,v 1.5 2004/05/20 17:48:34 ffjeld Exp $ +;;;; $Id: simple-streams.lisp,v 1.6 2004/09/25 15:26:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -427,7 +427,9 @@ (%check stream :output) (funcall-stm-handler-2 j-write-char character (sm melded-stream stream)))) (string - (vector-push-extend character stream)))) + (assert (vector-push-extend character stream) + () "Vector-push-extend for string stream failed pushing ~S into ~S." + character stream)))) (defun %read-line (stream eof-error-p eof-value recursive-p) (declare (ignore recursive-p))

1 0

[movitz-cvs] CVS update: movitz/losp/lib/repl.lisp
by Frode Vatvedt Fjeld 25 Sep '04

25 Sep '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv6696 Modified Files: repl.lisp Log Message: Make *repl-readline-context* be nil by default, so we don't get unbound errors (that tend to recurse, since the debugger will want to reference this variable). Date: Sat Sep 25 17:25:54 2004 Author: ffjeld Index: movitz/losp/lib/repl.lisp diff -u movitz/losp/lib/repl.lisp:1.12 movitz/losp/lib/repl.lisp:1.13 --- movitz/losp/lib/repl.lisp:1.12 Thu Jul 22 00:29:20 2004 +++ movitz/losp/lib/repl.lisp Sat Sep 25 17:25:53 2004 @@ -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.12 2004/07/21 22:29:20 ffjeld Exp $ +;;;; $Id: repl.lisp,v 1.13 2004/09/25 15:25:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -35,7 +35,7 @@ (defparameter *repl-prompter* 'default-repl-prompter) (defparameter *repl-prompt-context* nil) (defparameter *repl-print-format* "~@{~&~W~}") -(defvar *repl-readline-context*) +(defvar *repl-readline-context* nil) (defvar *repl-consless* nil) (defun default-repl-prompter ()

1 0