March 2004 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS update: movitz/losp/muerte/variables.lisp
by Frode Vatvedt Fjeld 24 Mar '04

24 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31107 Modified Files: variables.lisp Log Message: Added muerte:*build-number* magic variable that gets initialized to the build number, aka. bootblock ID. Date: Wed Mar 24 13:39:53 2004 Author: ffjeld Index: movitz/losp/muerte/variables.lisp diff -u movitz/losp/muerte/variables.lisp:1.1.1.1 movitz/losp/muerte/variables.lisp:1.2 --- movitz/losp/muerte/variables.lisp:1.1.1.1 Tue Jan 13 06:05:06 2004 +++ movitz/losp/muerte/variables.lisp Wed Mar 24 13:39:53 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 5 21:53:34 2003 ;;;; -;;;; $Id: variables.lisp,v 1.1.1.1 2004/01/13 11:05:06 ffjeld Exp $ +;;;; $Id: variables.lisp,v 1.2 2004/03/24 18:39:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -37,3 +37,5 @@ (defparameter *debugger-hook* nil) (defvar internal-time-units-per-second) + +(defvar *build-number* :unknown) \ No newline at end of file

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by Frode Vatvedt Fjeld 24 Mar '04

24 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv30219 Modified Files: packages.lisp Log Message: Added muerte:*build-number* magic variable that gets initialized to the build number, aka. bootblock ID. Date: Wed Mar 24 13:39:47 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.9 movitz/packages.lisp:1.10 --- movitz/packages.lisp:1.9 Wed Mar 24 06:24:35 2004 +++ movitz/packages.lisp Wed Mar 24 13:39:47 2004 @@ -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.9 2004/03/24 11:24:35 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.10 2004/03/24 18:39:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1111,7 +1111,8 @@ stack-frame-call-site stack-frame-ref check-stack-limit - + + *build-number* *error-no-condition-for-debugger* formatted-error

1 0

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

24 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv30051 Modified Files: image.lisp Log Message: Added muerte:*build-number* magic variable that gets initialized to the build number, aka. bootblock ID. Date: Wed Mar 24 13:39:42 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.18 movitz/image.lisp:1.19 --- movitz/image.lisp:1.18 Wed Mar 24 08:20:24 2004 +++ movitz/image.lisp Wed Mar 24 13:39:42 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.18 2004/03/24 13:20:24 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.19 2004/03/24 18:39:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -718,6 +718,8 @@ (format t "~&;; Doing initiating dump..") (dump-image :path path :multiboot-p multiboot-p :ignore-dump-count t) (assert (plusp (dump-count *image*)))) + (setf (movitz-symbol-value (movitz-read 'muerte:*build-number*)) + (1+ *bootblock-build*)) (let ((load-address (image-start-address *image*))) (setf (image-cons-pointer *image*) (- load-address (image-ds-segment-base *image*))

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 24 Mar '04

24 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11133 Modified Files: compiler.lisp Log Message: Improved propagation of :protect-registers somewhat. Date: Wed Mar 24 13:38:18 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.33 movitz/compiler.lisp:1.34 --- movitz/compiler.lisp:1.33 Thu Feb 26 08:48:42 2004 +++ movitz/compiler.lisp Wed Mar 24 13:38:18 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.33 2004/02/26 13:48:42 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.34 2004/03/24 18:38:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2436,9 +2436,12 @@ (destructuring-bind (binding &key init-with-register init-with-type protect-registers protect-carry) (cdr i) - (declare (ignore binding protect-registers protect-carry init-with-type)) + (declare (ignore binding protect-carry init-with-type)) (when init-with-register - (setf free-so-far (remove init-with-register free-so-far))))) + (setf free-so-far (remove-if (lambda (x) + (or (eq x init-with-register) + (member x protect-registers))) + free-so-far))))) (t (case (instruction-is i) ((nil :call) (return nil)) @@ -5575,12 +5578,13 @@ (list source))) (define-extended-code-expander :store-lexical (instruction funobj frame-map) - (destructuring-bind (destination source &key shared-reference-p type) + (destructuring-bind (destination source &key shared-reference-p type protect-registers) (cdr instruction) (declare (ignore type)) (make-store-lexical (ensure-local-binding destination funobj) (ensure-local-binding source funobj) - shared-reference-p frame-map))) + shared-reference-p frame-map + :protect-registers protect-registers))) ;;;;;;;;;;;;;;;;;; Init-lexvar

1 0

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by Frode Vatvedt Fjeld 24 Mar '04

24 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv29696 Modified Files: special-operators-cl.lisp Log Message: The compiler for m-v-bind was buggy when its binding were lended. This should fix it. Date: Wed Mar 24 13:36:41 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.11 movitz/special-operators-cl.lisp:1.12 --- movitz/special-operators-cl.lisp:1.11 Sat Feb 14 12:33:40 2004 +++ movitz/special-operators-cl.lisp Wed Mar 24 13:36:41 2004 @@ -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.11 2004/02/14 17:33:40 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.12 2004/03/24 18:36:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -468,7 +468,8 @@ :protect-carry t :protect-registers (:eax :ebx)) (:store-lexical ,(first lexical-bindings) :eax - :type ,(type-specifier-primary values-type)) + :type ,(type-specifier-primary values-type) + :protect-registers (:ebx)) (:init-lexvar ,(second lexical-bindings) :protect-carry t :protect-registers (:ebx)) @@ -490,14 +491,17 @@ append (case pos (0 `((:init-lexvar ,binding - :protect-registers '(:eax :ebx :ecx)) - (:store-lexical ,binding :eax :type ,type))) + :protect-registers (:eax :ebx :ecx)) + (:store-lexical ,binding :eax :type ,type + :protect-registers (:eax :ebx :ecx)))) (1 `((:init-lexvar ,binding - :protect-registers '(:ebx :ecx)) - (:store-lexical ,binding :edi :type null) + :protect-registers (:ebx :ecx)) + (:store-lexical ,binding :edi :type null + :protect-registers (:ecx)) (:cmpl 1 :ecx) (:jbe ',skip-label) - (:store-lexical ,binding :ebx :type ,type) + (:store-lexical ,binding :ebx :type ,type + :protect-registers (:ecx)) ,skip-label)) (t (if *compiler-use-cmov-p* `((:init-lexvar ,binding :protect-registers '(:ecx)) @@ -506,7 +510,8 @@ (:locally (:cmova (:edi (:edi-offset values ,(* 4 (- pos 2)))) :eax)) - (:store-lexical ,binding :eax :type ,type)) + (:store-lexical ,binding :eax :type ,type + :protect-registers (:eax))) `((:init-lexvar ,binding :protect-registers '(:ecx)) (:movl :edi :eax) (:cmpl ,pos :ecx) @@ -515,7 +520,8 @@ ,(* 4 (- pos 2)))) :eax)) ,skip-label - (:store-lexical ,binding :eax :type ,type))))))))))))))) + (:store-lexical ,binding :eax :type ,type + :protect-registers (:ecx)))))))))))))))) (compiler-values-bind (&code body-code &returns body-returns-mode) (compiler-call #'compile-form-unprotected :defaults forward

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/interrupt.lisp
by Frode Vatvedt Fjeld 24 Mar '04

24 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv16864 Modified Files: interrupt.lisp Log Message: Interrupts 67 and 68 are used as a very primitive tracing mechanism. Date: Wed Mar 24 08:36:26 2004 Author: ffjeld Index: movitz/losp/x86-pc/interrupt.lisp diff -u movitz/losp/x86-pc/interrupt.lisp:1.3 movitz/losp/x86-pc/interrupt.lisp:1.4 --- movitz/losp/x86-pc/interrupt.lisp:1.3 Mon Jan 19 06:23:52 2004 +++ movitz/losp/x86-pc/interrupt.lisp Wed Mar 24 08:36:26 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri May 4 18:08:50 2001 ;;;; -;;;; $Id: interrupt.lisp,v 1.3 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.4 2004/03/24 13:36:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -176,7 +176,12 @@ (int-frame-ref int-frame :error-code :unsigned-byte32) $eax $ebx $ecx)) (68 (warn "EIP: ~@Z EAX: ~@Z EBX: ~@Z ECX: ~@Z EDX: ~@Z" - $eip $eax $ebx $ecx $edx)) + $eip $eax $ebx $ecx $edx) + (dotimes (i 100000) + (with-inline-assembly (:returns :nothing) (:nop)))) + (67 (muerte.debug:backtrace :fresh-lines nil :length 6) + (dotimes (i 100000) + (with-inline-assembly (:returns :nothing) (:nop)))) (66 (error "Unspecified type error in ~S with EAX=~@Z, ECX=~@Z." (@ (+ int-frame (int-frame-index :esi))) $eax $ecx))

1 0

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

24 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv10722 Modified Files: debugger.lisp Log Message: Take pains not to have backtrace do any consing. It used to cons up the print-leadin flet, because it closed over a couple of variables and the compiler isn't too smart about such closures (yet). Date: Wed Mar 24 08:34:53 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.3 movitz/losp/x86-pc/debugger.lisp:1.4 --- movitz/losp/x86-pc/debugger.lisp:1.3 Fri Feb 13 17:11:38 2004 +++ movitz/losp/x86-pc/debugger.lisp Wed Mar 24 08:34:53 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.3 2004/02/13 22:11:38 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.4 2004/03/24 13:34:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -69,6 +69,7 @@ (defvar *backtrace-do-fresh-lines* t) (defvar *backtrace-print-length* 3) (defvar *backtrace-print-level* 2) +(defvar *backtrace-print-frames* nil) (defun pointer-in-range (x) (with-inline-assembly (:returns :boolean-cf=1) @@ -443,16 +444,17 @@ (or *debugger-invoked-stack-frame* (current-stack-frame))) ((:spartan *backtrace-be-spartan-p*)) + ((:fresh-lines *backtrace-do-fresh-lines*) *backtrace-do-fresh-lines*) (conflate *backtrace-do-conflate*) (length *backtrace-length*) - print-frames) + ((:print-frames *backtrace-print-frames*) *backtrace-print-frames*)) (let ((*standard-output* *debug-io*) (*print-length* *backtrace-print-length*) (*print-level* *backtrace-print-level*)) (loop with conflate-count = 0 with count = 0 for stack-frame = initial-stack-frame then (stack-frame-uplink stack-frame) as funobj = (stack-frame-funobj stack-frame t) - do (flet ((print-leadin (count conflate-count) + do (flet ((print-leadin (stack-frame count conflate-count) (when *backtrace-do-fresh-lines* (fresh-line)) (cond @@ -463,8 +465,8 @@ (write-string "=")) (write-char #\space)) (t (format t "~& |= "))) - (when print-frames - (format t "#x~X " stack-frame)))) + (when *backtrace-print-frames* + (format t "#x~X " stack-frame)))) (typecase funobj (integer (let* ((int-frame funobj) @@ -476,7 +478,7 @@ (incf conflate-count) (progn (incf count) - (print-leadin count conflate-count) + (print-leadin stack-frame count conflate-count) (setf conflate-count 0) (let ((exception (int-frame-ref int-frame :exception :unsigned-byte32)) (eip (int-frame-ref int-frame :eip :unsigned-byte32))) @@ -504,7 +506,7 @@ (< count length)) (write-string " ...") (return)) - (print-leadin count conflate-count) + (print-leadin stack-frame count conflate-count) (setf conflate-count 0) (write-char #\() (let* ((numargs (stack-frame-numargs stack-frame))

1 0

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

24 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23657 Modified Files: functions.lisp Log Message: Rewrote %funobj-code-vector accessor in terms of memref and %word-offset. The reader apparently compiles to the same as my hand-written assembly :-) Date: Wed Mar 24 08:33:21 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.3 movitz/losp/muerte/functions.lisp:1.4 --- movitz/losp/muerte/functions.lisp:1.3 Mon Mar 22 11:38:05 2004 +++ movitz/losp/muerte/functions.lisp Wed Mar 24 08:33:21 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 12 22:58:54 2002 ;;;; -;;;; $Id: functions.lisp,v 1.3 2004/03/22 16:38:05 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.4 2004/03/24 13:33:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -86,20 +86,14 @@ (defun funobj-code-vector (funobj) (check-type funobj compiled-function) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) funobj) - (:movl (:eax #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :eax) - (:subl 2 :eax))) ; this cell stores word+2 + (%word-offset (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :lisp) + -2)) (defun (setf funobj-code-vector) (code-vector funobj) (check-type funobj compiled-function) (check-type code-vector vector-u8) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :ebx) funobj) - (:compile-form (:result-mode :eax) code-vector) - (:addl 2 :eax) ; this cell stores word+2 - (:movl :eax (:ebx #.(bt::slot-offset 'movitz:movitz-funobj 'movitz:code-vector))) - (:subl 2 :eax))) + (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::code-vector) 0 :lisp) + (%word-offset code-vector 2))) (defun funobj-code-vector%1op (funobj) "This slot is not a lisp value, it is a direct address to code entry point. In practice it is either

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.lisp
by Frode Vatvedt Fjeld 24 Mar '04

24 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18306 Modified Files: symbols.lisp Log Message: In make-symbol, use %word-offset rather than %other-to-symbol. Date: Wed Mar 24 08:31:45 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.3 movitz/losp/muerte/symbols.lisp:1.4 --- movitz/losp/muerte/symbols.lisp:1.3 Mon Mar 22 11:38:20 2004 +++ movitz/losp/muerte/symbols.lisp Wed Mar 24 08:31:43 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.3 2004/03/22 16:38:20 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.4 2004/03/24 13:31:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -120,20 +120,10 @@ (not (eq (movitz-accessor symbol movitz-symbol function-value) (load-global-constant movitz::unbound-function)))))) -(defun %other-to-symbol (x) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) x) - (:leal (:eax 2) :ecx) - (:testb 7 :cl) - (:jnz '(:sub-program () - (:compile-form (:result-mode :ignore) - (error "Not an other heap-object: ~S" x)) - (:jmp 'continue))) - continue - (:addl 1 :eax))) - (defun make-symbol (name) - (let ((symbol (%other-to-symbol (malloc-clumps 3)))) + (eval-when (:compile-toplevel) + (assert (= 1 (- (movitz:tag :symbol) (movitz:tag :other))))) + (let ((symbol (%word-offset (malloc-clumps 3) 1))) (setf-movitz-accessor (symbol movitz-symbol package) nil) (setf-movitz-accessor (symbol movitz-symbol hash-key) (sxhash name)) (setf (symbol-flags symbol) 0

1 0

[movitz-cvs] CVS update: movitz/losp/los0.lisp
by Frode Vatvedt Fjeld 24 Mar '04

24 Mar '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv11393 Modified Files: los0.lisp Log Message: Add local *package* binding around top-level. Date: Wed Mar 24 08:25:13 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.4 movitz/losp/los0.lisp:1.5 --- movitz/losp/los0.lisp:1.4 Mon Mar 22 04:49:11 2004 +++ movitz/losp/los0.lisp Wed Mar 24 08:25:13 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.4 2004/03/22 09:49:11 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.5 2004/03/24 13:25:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -840,7 +840,8 @@ (let ((*repl-readline-context* (make-readline-context :history-size 16)) (*backtrace-stack-frame-barrier* (stack-frame-uplink (current-stack-frame))) #+ignore (*error-no-condition-for-debugger* t) - (*debugger-function* #'los0-debugger)) + (*debugger-function* #'los0-debugger) + (*package* nil)) (with-simple-restart (continue "Abort LOS0 boot-up initialization.") (setf *cpu-features*

1 0