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

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

21 Dec '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv30619 Modified Files: compiler.lisp Log Message: Add a check for whether (middle-of) code-vectors can look like code-vector headers. Date: Tue Dec 21 15:23:50 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.122 movitz/compiler.lisp:1.123 --- movitz/compiler.lisp:1.122 Wed Dec 15 14:58:04 2004 +++ movitz/compiler.lisp Tue Dec 21 15:23:49 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.122 2004/12/15 13:58:04 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.123 2004/12/21 14:23:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -987,6 +987,7 @@ ((some (lambda (label) (assoc label code-symtab)) (mapcar #'car rest)) (vector-push 0 code-vector)))) + (check-locate-concistency code-vector) (setf (movitz-funobj-code-vector funobj) (make-movitz-vector (length code-vector) :fill-pointer code-length @@ -998,6 +999,13 @@ (slot-value funobj 'code-vector%2op) (slot-value funobj 'code-vector%3op))))) funobj) + +(defun check-locate-concistency (code-vector) + (loop for x from 0 below (length code-vector) by 8 + do (when (and (= (tag :basic-vector) (aref code-vector x)) + (= (enum-value 'movitz-vector-element-type :code) (aref code-vector (1+ x)))) + (break "Code-vector can break %find-code-vector at offset ~D." x))) + (values)) #+ignore (defun make-compiled-function-body-default (form funobj env top-level-p)

1 0

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

20 Dec '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20219 Modified Files: los-closette.lisp Log Message: Fixed typo in "bootstrap". Date: Mon Dec 20 14:42:51 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.23 movitz/losp/muerte/los-closette.lisp:1.24 --- movitz/losp/muerte/los-closette.lisp:1.23 Tue Nov 23 17:06:37 2004 +++ movitz/losp/muerte/los-closette.lisp Mon Dec 20 14:42:51 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.23 2004/11/23 16:06:37 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.24 2004/12/20 13:42:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -786,8 +786,8 @@ (let ((x (std-gf-classes-to-emf-table gf))) (cond ((not x) - (unless (get 'clos-bootsrap 'breaking-on-auto-bootstrap) - (setf (get 'clos-bootsrap 'breaking-on-auto-bootstrap) t) + (unless (get 'clos-bootstrap 'breaking-on-auto-bootstrap) + (setf (get 'clos-bootstrap 'breaking-on-auto-bootstrap) t) (break "Auto-bootstrapping CLOS.")) (clos-bootstrap) (unless (get 'clos-bootstrap 'have-bootstrapped)

1 0

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

20 Dec '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11859 Modified Files: storage-types.lisp Log Message: *** empty log message *** Date: Mon Dec 20 11:53:47 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.46 movitz/storage-types.lisp:1.47 --- movitz/storage-types.lisp:1.46 Mon Dec 13 12:24:09 2004 +++ movitz/storage-types.lisp Mon Dec 20 11:53:47 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.46 2004/12/13 11:24:09 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.47 2004/12/20 10:53:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -69,7 +69,6 @@ :other 6 :symbol 7 - :code-vector #x1a :basic-vector #x22 :defstruct #x2a :funobj #x3a @@ -333,41 +332,6 @@ ;;; movitz-vectors -(define-binary-class movitz-code-vector (movitz-heap-object-other) - ((type - :binary-type other-type-byte - :reader movitz-vector-type - :initform :code-vector) - (entry1 - :binary-type u8 - :initarg :entry1) - (num-elements - :binary-type lu16 - :initarg :num-elements - :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 - :initarg :symbolic-data - :initform nil - :accessor movitz-vector-symbolic-data)) - (:slot-align type #.+other-type-offset+)) - - (define-binary-class movitz-basic-vector (movitz-heap-object-other) ((type :binary-type other-type-byte @@ -553,19 +517,6 @@ :fill-pointer (if (integerp fill-pointer) 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)

1 0

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

20 Dec '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11821 Modified Files: basic-functions.lisp Log Message: Removed dead code. Date: Mon Dec 20 11:51:53 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.14 movitz/losp/muerte/basic-functions.lisp:1.15 --- movitz/losp/muerte/basic-functions.lisp:1.14 Fri Nov 12 15:51:56 2004 +++ movitz/losp/muerte/basic-functions.lisp Mon Dec 20 11:51:52 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 18:41:57 2001 ;;;; -;;;; $Id: basic-functions.lisp,v 1.14 2004/11/12 14:51:56 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.15 2004/12/20 10:51:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -68,29 +68,6 @@ (:xorl :ecx :ecx) (:call (:esi #.(movitz::slot-offset 'movitz::movitz-funobj 'movitz::code-vector))))) -#+ignore -(defun funcall%1ops (function-name arg0) - (funcall%1ops function-name arg0) ; compiler-macro - #+ignore (with-inline-assembly (:returns :multiple-values) - (:compile-form (:result-mode :esi) (etypecase function-name - (symbol (symbol-function function-name)) - (compiled-function function-name))) - (:compile-form (:result-mode :edx) function-name) - (:compile-form (:result-mode :eax) arg0) - (:call (:esi #.(movitz::slot-offset 'movitz::movitz-funobj 'movitz::code-vector%1op))))) - -#+ignore -(defun funcall%2ops (function arg0 arg1) - (funcall%2ops function arg0 arg1) ; compiler-macro. - #+ignore (with-inline-assembly (:returns :multiple-values) - (:compile-form (:result-mode :esi) (etypecase function - (symbol (symbol-function function)) - (compiled-function function))) - (:compile-form (:result-mode :edx) function) - (:compile-form (:result-mode :eax) arg0) - (:compile-form (:result-mode :ebx) arg1) - (:call (:esi #.(movitz::slot-offset 'movitz::movitz-funobj 'movitz::code-vector%2op))))) - (defun funcall (function-or-name &rest args) (numargs-case (1 (function-or-name)

1 0

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

15 Dec '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14326 Modified Files: sequences.lisp Log Message: *** empty log message *** Date: Wed Dec 15 14:58:34 2004 Author: ffjeld Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.18 movitz/losp/muerte/sequences.lisp:1.19 --- movitz/losp/muerte/sequences.lisp:1.18 Thu Sep 2 11:44:15 2004 +++ movitz/losp/muerte/sequences.lisp Wed Dec 15 14:58:34 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.18 2004/09/02 09:44:15 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.19 2004/12/15 13:58:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -684,12 +684,24 @@ (defun fill (sequence item &key (start 0) end) "=> sequence" - (sequence-dispatch sequence + (etypecase sequence (list (do ((p (nthcdr start sequence) (cdr p)) (i start (1+ i))) ((or (null p) (and end (>= i end)))) (setf (car p) item))) + ((simple-array (unsigned-byte 32) 1) + (let* ((length (array-dimension sequence 0)) + (end (or end length))) + (unless (<= 0 end length) + (error 'index-out-of-range :index end :range length)) + (do ((i start (1+ i))) + ((>= i end)) + (declare (type index i)) + (setf (memref sequence (movitz-type-slot-offset 'movitz-basic-vector 'data) + :index i + :type :unsigned-byte32) + item)))) (vector (let ((end (or end (length sequence)))) (with-subvector-accessor (sequence-ref sequence start end)

1 0

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

15 Dec '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv14307 Modified Files: los0.lisp Log Message: *** empty log message *** Date: Wed Dec 15 14:58:27 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.34 movitz/losp/los0.lisp:1.35 --- movitz/losp/los0.lisp:1.34 Mon Dec 13 12:27:58 2004 +++ movitz/losp/los0.lisp Wed Dec 15 14:58:26 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.34 2004/12/13 11:27:58 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.35 2004/12/15 13:58:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1187,6 +1187,8 @@ ;;; (vector-push code-vector ts)))) ;; (muerte::cli) (pic8259-end-of-interrupt 0) + (when (eql #\esc (muerte.x86-pc.keyboard:poll-char)) + (break "Test-timer keyboard break.")) (with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :ecx) muerte.x86-pc::*screen*) (:shrl 2 :ecx)

1 0

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

15 Dec '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14281 Modified Files: image.lisp Log Message: *** empty log message *** Date: Wed Dec 15 14:58:15 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.85 movitz/image.lisp:1.86 --- movitz/image.lisp:1.85 Mon Dec 13 12:22:50 2004 +++ movitz/image.lisp Wed Dec 15 14:58:08 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.85 2004/12/13 11:22:50 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.86 2004/12/15 13:58:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -847,6 +847,7 @@ *image*) (defun set-file-position (stream position &optional who) + (declare (ignore who)) (or (ignore-errors (file-position stream position)) (let* ((end (file-position stream :end)) (diff (- position end)))

1 0

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

15 Dec '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14262 Modified Files: compiler.lisp Log Message: *** empty log message *** Date: Wed Dec 15 14:58:04 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.121 movitz/compiler.lisp:1.122 --- movitz/compiler.lisp:1.121 Mon Dec 13 18:10:32 2004 +++ movitz/compiler.lisp Wed Dec 15 14:58:04 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.121 2004/12/13 17:10:32 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.122 2004/12/15 13:58:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -988,11 +988,11 @@ (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 (slot-value funobj 'code-vector%1op) (slot-value funobj 'code-vector%2op)

1 0

[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