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

[movitz-cvs] CVS update: movitz/losp/x86-pc/serial.lisp
by ffjeld＠common-lisp.net 09 Mar '05

09 Mar '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv7852 Modified Files: serial.lisp Log Message: Some hacking for sending console output to serial port. Date: Wed Mar 9 08:21:42 2005 Author: ffjeld Index: movitz/losp/x86-pc/serial.lisp diff -u movitz/losp/x86-pc/serial.lisp:1.2 movitz/losp/x86-pc/serial.lisp:1.3 --- movitz/losp/x86-pc/serial.lisp:1.2 Thu May 20 20:16:13 2004 +++ movitz/losp/x86-pc/serial.lisp Wed Mar 9 08:21:42 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-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: Fri Oct 11 14:42:12 2002 ;;;; -;;;; $Id: serial.lisp,v 1.2 2004/05/20 18:16:13 ffjeld Exp $ +;;;; $Id: serial.lisp,v 1.3 2005/03/09 07:21:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,7 +18,7 @@ (provide :x86-pc/serial) (defpackage muerte.x86-pc.serial - (:use muerte.cl muerte.lib muerte.x86-pc) + (:use muerte.cl muerte.lib muerte.x86-pc muerte) (:export uart-probe uart-divisor uart-baudrate @@ -147,6 +147,28 @@ ;;;(defun uart-read-char (io-base) ;;; (loop until )) +(defun uart-write-char (io-base char) + (loop until (logbitp 5 (io-register8 io-base +uart-read-lsr+))) + (setf (io-port (+ io-base +uart-write-transmitter-buffer+) :character) + char)) + +(defun make-serial-write-char (&key (io-base (or (some #'uart-probe +uart-probe-addresses+) + (error "No serial port found."))) + (baudrate 9600) + (word-length 8) + (parity :none) + (stop-bits 1)) + (setf (uart-baudrate io-base) baudrate + (io-register8 io-base +uart-write-lcr+) (encode-uart-lcr word-length parity stop-bits)) + (setf (io-register8 io-base +uart-write-fcr+) 0) + (lambda (char &optional stream) + (case char + (#\newline + (uart-write-char io-base #\return))) + (uart-write-char io-base char) + (muerte::%write-char char (muerte::output-stream-designator stream)))) + + (defun com (string &key (io-base (or (some #'uart-probe +uart-probe-addresses+) (error "No serial port found."))) (baudrate 9600) @@ -157,7 +179,6 @@ (io-register8 io-base +uart-write-lcr+) (encode-uart-lcr word-length parity stop-bits)) (setf (io-register8 io-base +uart-write-fcr+) 0) (loop for c across string - do (loop until (logbitp 5 (io-register8 io-base +uart-read-lsr+))) - (setf (io-port (+ io-base +uart-write-transmitter-buffer+) :character) c)) + do (uart-write-char io-base c)) io-base)

1 0

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

09 Mar '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7833 Modified Files: interrupt.lisp Log Message: Add (setf dit-frame-ref). Date: Wed Mar 9 08:20:55 2005 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.40 movitz/losp/muerte/interrupt.lisp:1.41 --- movitz/losp/muerte/interrupt.lisp:1.40 Thu Feb 3 10:18:55 2005 +++ movitz/losp/muerte/interrupt.lisp Wed Mar 9 08:20:54 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.40 2005/02/03 09:18:55 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.41 2005/03/09 07:20:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -73,6 +73,10 @@ (eq nil (movitz:movitz-eval stack env)))) form `(setf (memref ,frame (dit-frame-offset ,reg) :type ,type) ,value))) + +(defun (setf dit-frame-ref) (value stack frame reg &optional (type :lisp)) + (setf (stack-frame-ref stack (+ frame (dit-frame-index reg)) 0 type) + value)) (defun dit-frame-casf (stack dit-frame) "Compute the `currently active stack-frame' when the interrupt occurred."

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/memref.lisp
by ffjeld＠common-lisp.net 09 Mar '05

09 Mar '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7810 Modified Files: memref.lisp Log Message: Add :tag as a type for memref. Date: Wed Mar 9 08:19:53 2005 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.43 movitz/losp/muerte/memref.lisp:1.44 --- movitz/losp/muerte/memref.lisp:1.43 Wed Feb 2 08:47:34 2005 +++ movitz/losp/muerte/memref.lisp Wed Mar 9 08:19:53 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.43 2005/02/02 07:47:34 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.44 2005/03/09 07:19:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -83,7 +83,7 @@ `(let ((,object-var ,object) (,offset-var ,offset)) (with-inline-assembly (:returns :untagged-fixnum-ecx - :type (unsigned-byte 16)) + :type (unsigned-byte 8)) (:compile-two-forms (:eax :untagged-fixnum-ecx) ,object-var ,offset-var) ;; (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) (:movzxb (:eax :ecx ,(offset-by 1)) :ecx) @@ -287,6 +287,28 @@ (:addl :ebx :ecx) (:movl (:eax :ecx ,(offset-by 4)) :ecx) (:andl -4 :ecx))))))) + (:tag + (assert (= 4 movitz::+movitz-fixnum-factor+)) + (cond + ((and (eq 0 offset) (eq 0 index)) + `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3)) + (:compile-form (:result-mode :eax) ,object) + (:movl (:eax ,(offset-by 4)) :ecx) + (:andl 7 :ecx))) + ((eq 0 offset) + `(with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3)) + (:compile-two-forms (:eax :ecx) ,object ,index) + (:movl (:eax :ecx ,(offset-by 4)) :ecx) + (:andl 7 :ecx))) + (t (let ((object-var (gensym "memref-object-"))) + `(let ((,object-var ,object)) + (with-inline-assembly (:returns :untagged-fixnum-ecx :type (unsigned-byte 3)) + (:compile-two-forms (:ecx :ebx) ,offset ,index) + (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) + (:load-lexical (:lexical-binding ,object-var) :eax) + (:addl :ebx :ecx) + (:movl (:eax :ecx ,(offset-by 4)) :ecx) + (:andl 7 :ecx))))))) (:unsigned-byte32 (let ((endian (movitz:movitz-eval endian env))) (assert (member endian '(:host :little))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/environment.lisp
by ffjeld＠common-lisp.net 09 Mar '05

09 Mar '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7791 Modified Files: environment.lisp Log Message: Be less worried about bignums when computing CPU-cycles in time. Date: Wed Mar 9 08:19:20 2005 Author: ffjeld Index: movitz/losp/muerte/environment.lisp diff -u movitz/losp/muerte/environment.lisp:1.9 movitz/losp/muerte/environment.lisp:1.10 --- movitz/losp/muerte/environment.lisp:1.9 Tue Jan 25 14:45:54 2005 +++ movitz/losp/muerte/environment.lisp Wed Mar 9 08:19:19 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Oct 20 00:41:57 2001 ;;;; -;;;; $Id: environment.lisp,v 1.9 2005/01/25 13:45:54 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.10 2005/03/09 07:19:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -139,13 +139,10 @@ (time-skew-measure start-mem x-lo x-hi)) finally (return x))))) (clumps (and start-mem (- (malloc-cons-pointer) start-mem))) - (delta-hi (- end-time-hi start-time-hi)) - (delta-lo (- end-time-lo start-time-lo skew))) - (if (= 0 delta-hi) - (format t "~&;; CPU cycles: ~D.~@[~%;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~]~%" - delta-lo clumps clumps) - (format t "~&;; CPU cycles: ~DM.~%~@[;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~]~%" - (+ (ash delta-hi 9) (ash delta-lo -20)) clumps clumps))))) + (delta-time (+ (ash (- end-time-hi start-time-hi) 29) + (- end-time-lo start-time-lo skew)))) + (format t "~&;; CPU cycles: ~D.~%~@[;; Space used: ~D clumps = ~/muerte:pprint-clumps/.~]~%" + delta-time clumps clumps)))) (defmacro time (form) `(let ((start-mem (malloc-cons-pointer)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/cpu-id.lisp
by ffjeld＠common-lisp.net 09 Mar '05

09 Mar '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7771 Modified Files: cpu-id.lisp Log Message: Mask edx to a _positive_ fixnum. Date: Wed Mar 9 08:18:15 2005 Author: ffjeld Index: movitz/losp/muerte/cpu-id.lisp diff -u movitz/losp/muerte/cpu-id.lisp:1.9 movitz/losp/muerte/cpu-id.lisp:1.10 --- movitz/losp/muerte/cpu-id.lisp:1.9 Sat Aug 14 19:55:29 2004 +++ movitz/losp/muerte/cpu-id.lisp Wed Mar 9 08:18:14 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-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 Apr 15 22:47:13 2002 ;;;; -;;;; $Id: cpu-id.lisp,v 1.9 2004/08/14 17:55:29 ffjeld Exp $ +;;;; $Id: cpu-id.lisp,v 1.10 2005/03/09 07:18:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -197,11 +197,12 @@ (:rdtsc) ; Read Time-Stamp Counter into EDX:EAX (:shldl 5 :eax :edx) (:shll #.movitz:+movitz-fixnum-shift+ :eax) - (:andl #.(cl:logxor #xffffffff movitz::+movitz-fixnum-zmask+) :edx) + (:andl #.(cl:* movitz:+movitz-fixnum-factor+ movitz:+movitz-most-positive-fixnum+) + :edx) (:andl #.(cl:* movitz:+movitz-fixnum-factor+ movitz:+movitz-most-positive-fixnum+) :eax) - (:movl :edx :ebx) (:cld) + (:movl :edx :ebx) (:movl 2 :ecx) (:stc)))

1 0

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

09 Mar '05

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv7742 Modified Files: repl.lisp Log Message: Only interpret integers as restarts when we're in a debugger context. Date: Wed Mar 9 08:16:48 2005 Author: ffjeld Index: movitz/losp/lib/repl.lisp diff -u movitz/losp/lib/repl.lisp:1.14 movitz/losp/lib/repl.lisp:1.15 --- movitz/losp/lib/repl.lisp:1.14 Thu Feb 24 13:21:30 2005 +++ movitz/losp/lib/repl.lisp Wed Mar 9 08:16:48 2005 @@ -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.14 2005/02/24 12:21:30 ffjeld Exp $ +;;;; $Id: repl.lisp,v 1.15 2005/03/09 07:16:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -83,6 +83,7 @@ (copy-list results))) (values-list results))) (let ((restart (and (integerp form) + muerte:*debugger-dynamic-context* (muerte:find-restart-by-index form muerte:*debugger-dynamic-context*)))) (cond

1 0

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

02 Mar '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16775 Modified Files: io-port.lisp Log Message: Fixed stupid bug in (setf io-port :character), the byte output would be completely wrong. Date: Wed Mar 2 18:15:43 2005 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.12 movitz/losp/muerte/io-port.lisp:1.13 --- movitz/losp/muerte/io-port.lisp:1.12 Wed Sep 22 19:43:35 2004 +++ movitz/losp/muerte/io-port.lisp Wed Mar 2 18:15:43 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001-2004, +;;;; Copyright (C) 2001-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 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.12 2004/09/22 17:43:35 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.13 2005/03/02 17:15:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -165,7 +165,6 @@ (:load-lexical (:lexical-binding ,value-var) :eax) (:std) (:shrl ,movitz::+movitz-fixnum-shift+ :edx) - (:shrl ,movitz::+movitz-fixnum-shift+ :eax) (:shrl 8 :eax) (:outb :al :dx) (:movl :edi :edx)

1 0

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

01 Mar '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv11016 Modified Files: debugger.lisp Log Message: Have find-function-name search (setf ...) and (method ...) namespaces. Date: Tue Mar 1 01:41:32 2005 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.35 movitz/losp/x86-pc/debugger.lisp:1.36 --- movitz/losp/x86-pc/debugger.lisp:1.35 Tue Mar 1 00:34:02 2005 +++ movitz/losp/x86-pc/debugger.lisp Tue Mar 1 01:41:32 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.35 2005/02/28 23:34:02 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.36 2005/03/01 00:41:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -614,12 +614,31 @@ (location-in-object-p (%run-time-context-slot slot-name) instruction-location)) (return (values slot-name :run-time-context)))) - (do-all-symbols (symbol) - (when (and (fboundp symbol) + (with-hash-table-iterator (hashis (get-global-property :setf-namespace)) + (do () (nil) + (multiple-value-bind (morep setf-name symbol) + (hashis) + (cond + ((not morep) + (return nil)) + ((and (fboundp symbol) (location-in-code-vector-p%unsafe (funobj-code-vector (symbol-function symbol)) instruction-location)) - (return symbol)) + (return (list 'setf setf-name))))))) + (do-all-symbols (symbol) + (when (fboundp symbol) + (let ((f (symbol-function symbol))) + (when (location-in-code-vector-p%unsafe (funobj-code-vector f) + instruction-location) + (return symbol)) + (when (typep f 'generic-function) + (dolist (m (generic-function-methods f)) + (when (location-in-code-vector-p%unsafe (funobj-code-vector (method-function m)) + instruction-location) + (return-from find-function-name + (funobj-name (method-function m)))))))) (when (and (boundp symbol) (typep (symbol-value symbol) 'code-vector) (location-in-code-vector-p%unsafe (symbol-value symbol) instruction-location)) (return (values symbol :symbol-value)))))) +

1 0

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

28 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7466 Modified Files: typep.lisp Log Message: Added (typep code-vector) Date: Tue Mar 1 00:39:04 2005 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.41 movitz/losp/muerte/typep.lisp:1.42 --- movitz/losp/muerte/typep.lisp:1.41 Tue Jan 25 14:55:36 2005 +++ movitz/losp/muerte/typep.lisp Tue Mar 1 00:39:04 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.41 2005/01/25 13:55:36 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.42 2005/02/28 23:39:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -577,6 +577,9 @@ (define-simple-typep (hash-table hash-table-p)) (define-simple-typep (package packagep)) + +(define-simple-typep (code-vector code-vector-p) (x) + (typep x 'code-vector)) ;;;

1 0

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

28 Feb '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7432 Modified Files: basic-macros.lisp Log Message: Fixed boundp to accept nil as argument. Date: Tue Mar 1 00:38:05 2005 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.55 movitz/losp/muerte/basic-macros.lisp:1.56 --- movitz/losp/muerte/basic-macros.lisp:1.55 Fri Feb 25 08:59:04 2005 +++ movitz/losp/muerte/basic-macros.lisp Tue Mar 1 00:38:03 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.55 2005/02/25 07:59:04 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.56 2005/02/28 23:38:03 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1059,8 +1059,8 @@ `(with-inline-assembly-case () (do-case (t :boolean-zf=0 :labels (boundp-done)) (:compile-form (:result-mode :ebx) ,symbol) - (:leal (:ebx ,(- (movitz:tag :symbol))) :ecx) - (:testb 7 :cl) + (:leal (:ebx ,(- (movitz:tag :null))) :ecx) + (:testb 5 :cl) (:jne '(:sub-program () (:int 66))) (:call-local-pf dynamic-variable-lookup) (:globally (:cmpl (:edi (:edi-offset new-unbound-value)) :eax)))))

1 0