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

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-functions.lisp
by ffjeld＠common-lisp.net 14 Dec '04

14 Dec '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16187 Modified Files: primitive-functions.lisp Log Message: *** empty log message *** Date: Tue Dec 14 17:22:10 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.57 movitz/losp/muerte/primitive-functions.lisp:1.58 --- movitz/losp/muerte/primitive-functions.lisp:1.57 Thu Nov 25 19:06:02 2004 +++ movitz/losp/muerte/primitive-functions.lisp Tue Dec 14 17:22:08 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.57 2004/11/25 18:06:02 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.58 2004/12/14 16:22:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,6 +18,18 @@ (provide :muerte/primitive-functions) (in-package muerte) + +(defconstant +funobj-trampoline-table+ + #(trampoline-funcall%1op + trampoline-funcall%2op + trampoline-funcall%3op + trampoline-cl-dispatch-1or2 + assert-1arg + assert-2args + assert-3args + decode-args-1or2)) + +(defconstant +funobj-trampoline-table-size+ 16) (define-primitive-function trampoline-funcall%1op () "Call a function with 1 argument"

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp
by ffjeld＠common-lisp.net 14 Dec '04

14 Dec '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16137 Modified Files: functions.lisp Log Message: *** empty log message *** Date: Tue Dec 14 17:20:57 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.24 movitz/losp/muerte/functions.lisp:1.25 --- movitz/losp/muerte/functions.lisp:1.24 Thu Oct 21 22:34:04 2004 +++ movitz/losp/muerte/functions.lisp Tue Dec 14 17:20:57 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.24 2004/10/21 20:34:04 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.25 2004/12/14 16:20:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,7 +18,7 @@ (require :muerte/setf) (provide :muerte/functions) -(In-package muerte) +(in-package muerte) (defun identity (x) x)

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 13 Dec '04

13 Dec '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv9675 Modified Files: compiler.lisp Log Message: *** empty log message *** Date: Mon Dec 13 18:10:33 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.120 movitz/compiler.lisp:1.121 --- movitz/compiler.lisp:1.120 Mon Dec 13 12:21:48 2004 +++ movitz/compiler.lisp Mon Dec 13 18:10:32 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.120 2004/12/13 11:21:48 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.121 2004/12/13 17:10:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -988,15 +988,15 @@ (mapcar #'car rest)) (vector-push 0 code-vector)))) (setf (movitz-funobj-code-vector funobj) + #+ignore (make-movitz-vector (length code-vector) :fill-pointer code-length :element-type 'code :initial-contents code-vector) - #+ignore (make-movitz-code-vector code-vector - (car (slot-value funobj 'code-vector%1op)) - (car (slot-value funobj 'code-vector%2op)) - (car (slot-value funobj 'code-vector%3op)))))) + (slot-value funobj 'code-vector%1op) + (slot-value funobj 'code-vector%2op) + (slot-value funobj 'code-vector%3op))))) funobj) #+ignore

1 0

[movitz-cvs] CVS update: movitz/losp/los0.lisp
by ffjeld＠common-lisp.net 13 Dec '04

13 Dec '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv24723 Modified Files: los0.lisp Log Message: *** empty log message *** Date: Mon Dec 13 12:27:59 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.33 movitz/losp/los0.lisp:1.34 --- movitz/losp/los0.lisp:1.33 Fri Nov 26 15:59:59 2004 +++ movitz/losp/los0.lisp Mon Dec 13 12:27:58 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.33 2004/11/26 14:59:59 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.34 2004/12/13 11:27:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -23,7 +23,7 @@ (require :lib/readline) (require :lib/toplevel) -(require :lib/net/ip6) +;; (require :lib/net/ip6) (require :lib/net/ip4) (require :lib/repl) @@ -37,7 +37,7 @@ #:muerte.readline #:muerte.toplevel #:muerte.ethernet - #:muerte.ip6 +;; #:muerte.ip6 #:muerte.ip4 #:muerte.mop #+ignore muerte.x86-pc.serial)) @@ -624,7 +624,7 @@ -s#+ignore +#+ignore (defun test-ncase (x y z) (numargs-case (1 (x) (values x 'one)) @@ -931,7 +931,7 @@ (prog () loop (case (muerte.x86-pc.keyboard:poll-char) - ((#\esc) + ((#\escape) (break "Console pager")) ((#\n #\N) ; No more (return-from paging (values))) @@ -1151,7 +1151,7 @@ (defparameter *timer-stack* nil) (defparameter *timer-prevstack* nil) (defparameter *timer-esi* nil) -(defparameter *timer-frame* #100()) +(defparameter *timer-frame* #100(nil)) (defparameter *timer-base* 2) (defparameter *timer-variation* 1000) @@ -1281,7 +1281,7 @@ :quiet t :mac (muerte.ip4::polling-arp :129.242.16.1 (lambda () - (eql #\esc (muerte.x86-pc.keyboard:poll-char))))))) + (eql #\escape (muerte.x86-pc.keyboard:poll-char))))))) (defun mumbojumbo (x) (with-inline-assembly (:returns :eax) @@ -1436,7 +1436,7 @@ (when (receive outside buffer) (transmit inside buffer)) (case (muerte.x86-pc.keyboard:poll-char) - (#\esc (break "Under the bridge.")) + (#\escape (break "Under the bridge.")) (#\e (error "this is an error!"))))))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/typep.lisp
by ffjeld＠common-lisp.net 13 Dec '04

13 Dec '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24697 Modified Files: typep.lisp Log Message: Fixed deftype expander vs. CL package. Date: Mon Dec 13 12:25:44 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.39 movitz/losp/muerte/typep.lisp:1.40 --- movitz/losp/muerte/typep.lisp:1.39 Wed Nov 24 11:08:28 2004 +++ movitz/losp/muerte/typep.lisp Mon Dec 13 12:25:41 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.39 2004/11/24 10:08:28 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.40 2004/12/13 11:25:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -436,8 +436,9 @@ (format nil "~A-~A" 'deftype name))))) `(progn (eval-when (:compile-toplevel) - (unless (eq (symbol-package (cadr ',form)) (find-package :common-lisp)) - ,form) + (unless (find-symbol (symbol-name (cadr ',form)) :common-lisp) + #+ignore (eq (symbol-package (cadr ',form)) (find-package :common-lisp)) + (eval ',form)) (setf (gethash (translate-program ',name :cl :muerte.cl) *compiler-derived-typespecs*) (lambda ,lambda ,@body))

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by ffjeld＠common-lisp.net 13 Dec '04

13 Dec '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24668 Modified Files: storage-types.lisp Log Message: Fixed unbound. Date: Mon Dec 13 12:24:10 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.45 movitz/storage-types.lisp:1.46 --- movitz/storage-types.lisp:1.45 Fri Dec 10 13:46:52 2004 +++ movitz/storage-types.lisp Mon Dec 13 12:24:09 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.45 2004/12/10 12:46:52 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.46 2004/12/13 11:24:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -151,9 +151,12 @@ (defun movitz-read-and-intern (expr type) (ecase type (word - (if (typep expr 'movitz-object) - (movitz-intern expr) - (movitz-intern (movitz-read expr)))) + (cond + ((eq expr 'unbound) + (slot-value (image-run-time-context *image*) 'new-unbound-value)) + ((typep expr 'movitz-object) + (movitz-intern expr)) + (t (movitz-intern (movitz-read expr))))) (code-vector-word (movitz-intern-code-vector expr)))) @@ -335,13 +338,27 @@ :binary-type other-type-byte :reader movitz-vector-type :initform :code-vector) - (blurg) + (entry1 + :binary-type u8 + :initarg :entry1) (num-elements - :binary-type word + :binary-type lu16 :initarg :num-elements - :reader movitz-vector-num-elements - :map-binary-write 'movitz-read-and-intern - :map-binary-read-delayed 'movitz-word-and-print) + :reader movitz-vector-num-elements) + (entry2 + :binary-type lu16 + :initarg :num-elements + :map-binary-write (lambda (x &optional type) + (declare (ignore type)) + (check-type x (unsigned-byte 14)) + (* x 4)) + :map-binary-read (lambda (x &optional type) + (declare (ignore type)) + (assert (zerop (mod x 4))) + (truncate x 4))) + (entry3 + :binary-type lu16 + :initarg :num-elements) (data :binary-lisp-type :label) ; data follows physically here (symbolic-data @@ -537,11 +554,23 @@ fill-pointer size)))) +(defun make-movitz-code-vector (code entry1 entry2 entry3) + (make-instance 'movitz-code-vector + :symbolic-data code + :num-elements (1- (ceiling (length code) 8)) + :entry1 entry1 + :entry2 entry2 + :entry3 entry3)) + +(defmethod write-binary-record ((obj movitz-code-vector) stream) + (+ (call-next-method) ; header + (loop for data across (movitz-vector-symbolic-data obj) + summing (write-binary 'u8 stream data)))) + (defun make-movitz-string (string) (make-movitz-vector (length string) :element-type 'character :initial-contents (map 'list #'identity string))) -;; (map 'list #'make-movitz-character string))) (defun movitz-stringp (x) (and (typep x '(or movitz-basic-vector)) @@ -565,7 +594,7 @@ :binary-type word :map-binary-write 'movitz-read-and-intern :map-binary-read-delayed 'movitz-word - :initform 'muerte::unbound ; + :initform 'unbound :accessor movitz-symbol-value :initarg :value) (plist @@ -883,7 +912,7 @@ (standard-gf-function ; a movitz-funobj which is called by dispatcher (in code-vector) :accessor standard-gf-function :initarg :function - :initform 'muerte::unbound + :initform 'muerte::unbound-function :binary-type word :map-binary-write 'movitz-read-and-intern-function-value) (num-required-arguments @@ -922,7 +951,7 @@ nil) (defun make-standard-gf (class slots &key lambda-list (name "unnamed") - (function 'muerte::unbound) + (function 'muerte::unbound-function) num-required-arguments classes-to-emf-table) (make-instance 'movitz-funobj-standard-gf

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by ffjeld＠common-lisp.net 13 Dec '04

13 Dec '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24645 Modified Files: image.lisp Log Message: Fixed some unbound stuff. Date: Mon Dec 13 12:22:50 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.84 movitz/image.lisp:1.85 --- movitz/image.lisp:1.84 Thu Dec 9 15:04:54 2004 +++ movitz/image.lisp Mon Dec 13 12:22:50 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.84 2004/12/09 14:04:54 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.85 2004/12/13 11:22:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -824,7 +824,7 @@ that function's code-vector." (let ((code-vector (movitz-symbol-value (movitz-read name)))) - (unless (and code-vector (not (eq 'muerte::unbound code-vector))) + (unless (and code-vector (not (eq 'unbound code-vector))) (cerror "Install an empty vector instead." "Global constant primitive function ~S is not defined!" name) (setf code-vector @@ -922,7 +922,7 @@ (setf (slot-value run-time-context gcf-name) 0) (cond ((or (not gcf-funobj) - (eq 'muerte::unbound gcf-funobj)) + (eq 'unbound gcf-funobj)) (warn "Global constant function ~S is not defined!" gcf-name)) (t (check-type gcf-funobj movitz-funobj) (setf (slot-value run-time-context gcf-name)

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 13 Dec '04

13 Dec '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv24615 Modified Files: compiler.lisp Log Message: *** empty log message *** Date: Mon Dec 13 12:21:49 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.119 movitz/compiler.lisp:1.120 --- movitz/compiler.lisp:1.119 Fri Dec 10 13:46:30 2004 +++ movitz/compiler.lisp Mon Dec 13 12:21:48 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.119 2004/12/10 12:46:30 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.120 2004/12/13 11:21:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -86,7 +86,7 @@ (defvar *compiler-trust-user-type-declarations-p* t) -(defvar *compiling-function-name*) +(defvar *compiling-function-name* nil) (defvar muerte.cl:*compile-file-pathname* nil) (defvar *extended-code-expanders* @@ -933,8 +933,7 @@ (let ((ia-x86:*instruction-compute-extra-prefix-map* '((:call . compute-call-extra-prefix)))) (ia-x86:proglist-encode :octet-vector :32-bit #x00000000 - (ia-x86:read-proglist (append combined-code - #+ignore `((% bytes 8 0 0 0)))) + (ia-x86:read-proglist combined-code) :symtab-lookup (lambda (label) (case label @@ -951,8 +950,6 @@ (* 4 pos))))))))) (setf (movitz-funobj-symtab funobj) code-symtab) (let ((code-length (- (length code-vector) 3 -3))) -;;; (assert (not (mismatch #(0 0 0) code-vector :start2 code-length)) () -;;; "No space in code-vector was allocated for entry-points.") (setf (fill-pointer code-vector) code-length) ;; debug info (setf (ldb (byte 1 5) (slot-value funobj 'debug-info)) @@ -991,11 +988,15 @@ (mapcar #'car rest)) (vector-push 0 code-vector)))) (setf (movitz-funobj-code-vector funobj) - (make-movitz-vector (length code-vector) - :fill-pointer code-length - :element-type 'code - :initial-contents code-vector - )))) + (make-movitz-vector (length code-vector) + :fill-pointer code-length + :element-type 'code + :initial-contents code-vector) + #+ignore + (make-movitz-code-vector code-vector + (car (slot-value funobj 'code-vector%1op)) + (car (slot-value funobj 'code-vector%2op)) + (car (slot-value funobj 'code-vector%3op)))))) funobj) #+ignore @@ -2809,8 +2810,7 @@ (and (not (instruction-is i :init-lexvar)) (member binding (find-read-bindings i) :test #'binding-eql))) - (cdr init-pc) - #-sbcl :end #-sbcl 15)) + (cdr init-pc))) (binding-destination (third load-instruction)) (distance (position load-instruction (cdr init-pc)))) (multiple-value-bind (free-registers more-later-p) @@ -3020,8 +3020,7 @@ (truncate (or (position-if (lambda (i) (member b (find-read-bindings i))) - (cdr init-pc) - #-sbcl :end #-sbcl 10) + (cdr init-pc)) 15) count))))))))) ;; First, make several passes while trying to locate bindings

1 0

[movitz-cvs] CVS update: public_html/index.html
by ffjeld＠common-lisp.net 12 Dec '04

12 Dec '04

Update of /project/movitz/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv19926 Modified Files: index.html Log Message: *** empty log message *** Date: Sun Dec 12 13:38:42 2004 Author: ffjeld Index: public_html/index.html diff -u public_html/index.html:1.20 public_html/index.html:1.21 --- public_html/index.html:1.20 Wed Aug 18 11:27:57 2004 +++ public_html/index.html Sun Dec 12 13:38:40 2004 @@ -15,22 +15,20 @@ <h3>Most recent news</h3> + December 12, 2004: Various bits and pieces have been + cleaned up so that recent (2.33) CLisp can now compile Movitz kernels + just fine (mostly to do with CLisp having CL symbols with e.g. CLOS + as home package). + + QEMU's NE2000 device seems to work ok with Movitz, both in ISA + and PCI modes. + August 18, 2004: Movitz finally runs in <a href="http://fabrice.bellard.free.fr/qemu/">QEMU</a>, which is a very nice x86 emulator. It uses some sort of JIT technique, so it's much faster than Bochs. There was a bug in QEMU's (version 0.6.0) emulation of the x86 <tt>bounds</tt> instruction, which didn't agree with Movitz, and which is now fixed in QEMU's CVS. - - July 8, 2004: The data-structure for vectors has been - changed. The vectors length is now represented by a fixnum, - increasing the maximum length from <tt>#xffff</tt> to - <tt>most-positive-fixnum</tt>. - - The example GC system is changed to reflect the new vector - data-structure, so that the hard 256 KB limit on newspaces is no - more. The default size is set to 2 MB, and this newspace size is used - in the new <a href="files/los0.img"><tt>los0.img</tt></a>. For more news, see the <a href="files/ChangeLog"><tt>ChangeLog</tt></a>.

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/keyboard.lisp
by ffjeld＠common-lisp.net 10 Dec '04

10 Dec '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv1703 Modified Files: keyboard.lisp Log Message: Avoid the named-integer cruft. Date: Fri Dec 10 13:48:34 2004 Author: ffjeld Index: movitz/losp/x86-pc/keyboard.lisp diff -u movitz/losp/x86-pc/keyboard.lisp:1.5 movitz/losp/x86-pc/keyboard.lisp:1.6 --- movitz/losp/x86-pc/keyboard.lisp:1.5 Thu Dec 9 00:40:24 2004 +++ movitz/losp/x86-pc/keyboard.lisp Fri Dec 10 13:48:34 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Sep 24 16:04:12 2001 ;;;; -;;;; $Id: keyboard.lisp,v 1.5 2004/12/08 23:40:24 ffjeld Exp $ +;;;; $Id: keyboard.lisp,v 1.6 2004/12/10 12:48:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -115,10 +115,9 @@ (t (values (ldb (byte 7 0) first-code) (logbitp 7 first-code)))))) -(define-named-integer qualifier (:only-constants t) - (0 shift) - (1 ctrl) - (2 alt)) +(defconstant +qualifier-shift+ 0) +(defconstant +qualifier-ctrl+ 1) +(defconstant +qualifier-alt+ 2) (defvar *qualifier-state* 0)

1 0