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

[movitz-cvs] CVS update: movitz/losp/muerte/strings.lisp
by ffjeld＠common-lisp.net 12 Jun '05

12 Jun '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv14624 Modified Files: strings.lisp Log Message: Use char rather than schar, in general. Date: Sun Jun 12 22:01:49 2005 Author: ffjeld Index: movitz/losp/muerte/strings.lisp diff -u movitz/losp/muerte/strings.lisp:1.2 movitz/losp/muerte/strings.lisp:1.3 --- movitz/losp/muerte/strings.lisp:1.2 Mon Jan 19 12:23:47 2004 +++ movitz/losp/muerte/strings.lisp Sun Jun 12 22:01:49 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 19 17:05:25 2001 ;;;; -;;;; $Id: strings.lisp,v 1.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: strings.lisp,v 1.3 2005/06/12 20:01:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -30,7 +30,7 @@ (do ((i start1 (1+ i)) (j start2 (1+ j))) ((>= i end1) t) - (unless (char= (schar string1 i) (schar string2 j)) + (unless (char= (char string1 i) (char string2 j)) (return nil))))) (defun string/= (string1 string2 &key (start1 0) end1 (start2 0) end2) @@ -45,7 +45,7 @@ (do ((i start1 (1+ i)) (j start2 (1+ j))) ((>= i end1) t) - (unless (char-equal (schar string1 i) (schar string2 j)) + (unless (char-equal (char string1 i) (char string2 j)) (return nil))))) (defun string-not-equal (string1 string2 &key (start1 0) end1 (start2 0) end2) @@ -69,16 +69,16 @@ (let* ((length (- end start)) (cased-string (make-string length))) (dotimes (i length) - (setf (schar cased-string i) - (char-upcase (schar string (+ i start))))) + (setf (char cased-string i) + (char-upcase (char string (+ i start))))) cased-string)) (defun string-downcase (string &key (start 0) (end (length string))) (let* ((length (- end start)) (cased-string (make-string length))) (dotimes (i length) - (setf (schar cased-string i) - (char-downcase (schar string (+ i start))))) + (setf (char cased-string i) + (char-downcase (char string (+ i start))))) cased-string)) (defun string-capitalize (string &key (start 0) end) @@ -90,8 +90,8 @@ (j 0 (1+ j)) (between-words-p t)) ((>= i end) capitalized-string) - (setf (schar capitalized-string j) - (let ((c (schar string i))) + (setf (char capitalized-string j) + (let ((c (char string i))) (cond ((and between-words-p (char-alpha-p c)) (setf between-words-p nil)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by ffjeld＠common-lisp.net 11 Jun '05

11 Jun '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16796 Modified Files: inspect.lisp Log Message: Rename copy-vector to shallow-copy-vector, and have it understand indirect-vectors. Should fix a GC issue. Date: Sat Jun 11 02:02:04 2005 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.54 movitz/losp/muerte/inspect.lisp:1.55 --- movitz/losp/muerte/inspect.lisp:1.54 Sat Jun 11 01:07:07 2005 +++ movitz/losp/muerte/inspect.lisp Sat Jun 11 02:02:04 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.54 2005/06/10 23:07:07 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.55 2005/06/11 00:02:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -257,7 +257,7 @@ (symbol (copy-symbol old t)) (vector - (copy-vector old)) + (shallow-copy-vector old)) (function (copy-funobj old)) (structure-object

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by ffjeld＠common-lisp.net 11 Jun '05

11 Jun '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16781 Modified Files: arrays.lisp Log Message: Rename copy-vector to shallow-copy-vector, and have it understand indirect-vectors. Should fix a GC issue. Date: Sat Jun 11 02:01:56 2005 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.52 movitz/losp/muerte/arrays.lisp:1.53 --- movitz/losp/muerte/arrays.lisp:1.52 Sat Jun 11 01:08:16 2005 +++ movitz/losp/muerte/arrays.lisp Sat Jun 11 02:01:56 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.52 2005/06/10 23:08:16 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.53 2005/06/11 00:01:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -176,23 +176,25 @@ "Vector has no fill-pointer.") (%basic-vector-fill-pointer vector)))) -(defun copy-vector (vector) - (check-type vector vector) +(defun shallow-copy-vector (vector) + (check-type vector (simple-array * 1)) (let ((length (the fixnum (memref vector (movitz-type-slot-offset 'movitz-basic-vector 'num-elements))))) - (ecase (vector-element-type-code vector) - (#.(bt:enum-value 'movitz::movitz-vector-element-type :any-t) - (%shallow-copy-object vector (+ 2 length))) - (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32) - (%shallow-copy-non-pointer-object vector (+ 2 length))) + (ecase (memref vector (movitz-type-slot-offset 'movitz-basic-vector 'element-type) + :type :unsigned-byte8) + ((#.(bt:enum-value 'movitz::movitz-vector-element-type :any-t) + #.(bt:enum-value 'movitz::movitz-vector-element-type :indirects)) + (%shallow-copy-object vector (+ 2 length))) + ((#.(bt:enum-value 'movitz::movitz-vector-element-type :u32)) + (%shallow-copy-non-pointer-object vector (+ 2 length))) ((#.(bt:enum-value 'movitz::movitz-vector-element-type :character) #.(bt:enum-value 'movitz::movitz-vector-element-type :u8) #.(bt:enum-value 'movitz::movitz-vector-element-type :code)) (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 3 length) 4)))) - (#.(bt:enum-value 'movitz::movitz-vector-element-type :u16) - (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 1 length) 2)))) - (#.(bt:enum-value 'movitz::movitz-vector-element-type :bit) - (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 31 length) 32))))))) + ((#.(bt:enum-value 'movitz::movitz-vector-element-type :u16)) + (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 1 length) 2)))) + ((#.(bt:enum-value 'movitz::movitz-vector-element-type :bit)) + (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 31 length) 32))))))) (defun (setf fill-pointer) (new-fill-pointer vector) (etypecase vector

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by ffjeld＠common-lisp.net 11 Jun '05

11 Jun '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv16751 Modified Files: los0-gc.lisp Log Message: Remove a restart. Date: Sat Jun 11 02:01:09 2005 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.55 movitz/losp/los0-gc.lisp:1.56 --- movitz/losp/los0-gc.lisp:1.55 Sat Jun 11 01:05:44 2005 +++ movitz/losp/los0-gc.lisp Sat Jun 11 02:01:09 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.55 2005/06/10 23:05:44 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.56 2005/06/11 00:01:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -411,15 +411,14 @@ (dolist (range muerte::%memory-map-roots%) (map-header-vals evacuator (car range) (cdr range)))) ;; Scan newspace, Cheney style. - (with-simple-restart (nil "Cheney-scanning newspace.") - (loop with newspace-location = (+ 2 (object-location newspace)) - with scan-pointer = 2 - as fresh-pointer = (space-fresh-pointer newspace) - while (< scan-pointer fresh-pointer) - do (map-header-vals evacuator - (+ newspace-location scan-pointer) - (+ newspace-location (space-fresh-pointer newspace))) - (setf scan-pointer fresh-pointer))) + (loop with newspace-location = (+ 2 (object-location newspace)) + with scan-pointer = 2 + as fresh-pointer = (space-fresh-pointer newspace) + while (< scan-pointer fresh-pointer) + do (map-header-vals evacuator + (+ newspace-location scan-pointer) + (+ newspace-location (space-fresh-pointer newspace))) + (setf scan-pointer fresh-pointer)) ;; Consistency check.. (map-stack-vector (lambda (x foo) (declare (ignore foo))

1 0

[movitz-cvs] CVS update: public_html/index.html
by ffjeld＠common-lisp.net 10 Jun '05

10 Jun '05

Update of /project/movitz/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv14079 Modified Files: index.html Log Message: *** empty log message *** Date: Sat Jun 11 01:19:12 2005 Author: ffjeld Index: public_html/index.html diff -u public_html/index.html:1.24 public_html/index.html:1.25 --- public_html/index.html:1.24 Sat Jan 29 11:42:28 2005 +++ public_html/index.html Sat Jun 11 01:19:12 2005 @@ -15,6 +15,9 @@ <h3>Most recent news</h3> + <p> <i>June 11, 2005</i> Started to add support for threads (in the + "threading" package), and also for adjustable and displaced vectors. + <p> <i>January 29, 2005</i> The stack discipline and associated GC scavenging routines have been cleaned up, now hopefully work as they should, even in the corner cases when two interrupts occur in rapid @@ -28,17 +31,7 @@ just fine (mostly to do with CLisp having CL symbols with e.g. CLOS as home package). - <p> QEMU's NE2000 device seems to work ok with Movitz, both in ISA - and PCI modes. - - <p> <i>August 18, 2004:</i> 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. - - <p> For more news, see the <a + <p> For more and older news, see the <a href="ChangeLog"><tt>ChangeLog</tt></a>. <h3>Introduction</h3>

1 0

[movitz-cvs] CVS update: public_html/ChangeLog
by ffjeld＠common-lisp.net 10 Jun '05

10 Jun '05

Update of /project/movitz/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv14053 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sat Jun 11 01:17:18 2005 Author: ffjeld Index: public_html/ChangeLog diff -u public_html/ChangeLog:1.5 public_html/ChangeLog:1.6 --- public_html/ChangeLog:1.5 Sun Apr 24 23:59:59 2005 +++ public_html/ChangeLog Sat Jun 11 01:17:17 2005 @@ -1,3 +1,7 @@ +2005-06-11 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> + + * Started to add support for adjustable and displaced vectors. + 2005-04-24 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> * Fixed a bug in the compilation of (values ...) for more than two

1 0

[movitz-cvs] CVS update: movitz/losp/lib/threading.lisp
by ffjeld＠common-lisp.net 10 Jun '05

10 Jun '05

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv13168 Modified Files: threading.lisp Log Message: Have segment-descriptor-table-manager use *gc-hooks* to deal with moving of descriptor-table. Date: Sat Jun 11 01:09:14 2005 Author: ffjeld Index: movitz/losp/lib/threading.lisp diff -u movitz/losp/lib/threading.lisp:1.7 movitz/losp/lib/threading.lisp:1.8 --- movitz/losp/lib/threading.lisp:1.7 Mon May 9 00:05:13 2005 +++ movitz/losp/lib/threading.lisp Sat Jun 11 01:09:14 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 28 08:30:01 2005 ;;;; -;;;; $Id: threading.lisp,v 1.7 2005/05/08 22:05:13 ffjeld Exp $ +;;;; $Id: threading.lisp,v 1.8 2005/06/10 23:09:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -33,8 +33,11 @@ ((table :reader segment-descriptor-table :initarg :table - :initform (setf (muerte::global-segment-descriptor-table) - (muerte::dump-global-segment-table :entries 64))) + :initform (let ((table (muerte::dump-global-segment-table :entries 64))) + (push (lambda () + (setf (muerte::global-segment-descriptor-table) table)) + *gc-hooks*) + (setf (muerte::global-segment-descriptor-table) table))) (clients :initform (make-array 64)) (range-start

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by ffjeld＠common-lisp.net 10 Jun '05

10 Jun '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13152 Modified Files: arrays.lisp Log Message: Make the with-subvector-accessors operator know about indirect-vectors. Date: Sat Jun 11 01:08:17 2005 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.51 movitz/losp/muerte/arrays.lisp:1.52 --- movitz/losp/muerte/arrays.lisp:1.51 Fri Jun 10 00:19:02 2005 +++ movitz/losp/muerte/arrays.lisp Sat Jun 11 01:08:16 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.51 2005/06/09 22:19:02 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.52 2005/06/10 23:08:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -644,9 +644,9 @@ ;;; fast vector access -(defun subvector-accessors (vector start end) +(defun subvector-accessors (vector &optional start end) "Check that vector is a vector, that start and end are within vector's bounds, -and return accessors for that subsequence (fast & unsafe accessors, that is)." +and return basic-vector and accessors for that subsequence." (when (and start end) (assert (<= 0 start end)) (assert (<= end (array-dimension vector 0)))) @@ -654,37 +654,37 @@ (indirect-vector (with-indirect-vector (indirect vector) (if (= 0 (indirect displaced-offset)) - (values #'aref #'(setf aref)) + (subvector-accessors (indirect displaced-to) start end) (let ((offset (indirect displaced-offset))) - (values (lambda (a i) (aref a (+ i offset))) + (values vector + (lambda (a i) (aref a (+ i offset))) (lambda (v a i) (setf (aref a (+ i offset)) v))))))) (vector (case (vector-element-type-code vector) (#.(bt:enum-value 'movitz::movitz-vector-element-type :any-t) - (values #'svref%unsafe #'(setf svref%unsafe))) + (values vector #'svref%unsafe #'(setf svref%unsafe))) (#.(bt:enum-value 'movitz::movitz-vector-element-type :character) - (values #'char%unsafe #'(setf char%unsafe))) + (values vector #'char%unsafe #'(setf char%unsafe))) (#.(bt:enum-value 'movitz::movitz-vector-element-type :u8) - (values #'u8ref%unsafe #'(setf u8ref%unsafe))) + (values vector #'u8ref%unsafe #'(setf u8ref%unsafe))) (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32) - (values #'u32ref%unsafe #'(setf u32ref%unsafe))) + (values vector #'u32ref%unsafe #'(setf u32ref%unsafe))) (#.(bt:enum-value 'movitz::movitz-vector-element-type :code) - (values #'u8ref%unsafe #'(setf u8ref%unsafe))) + (values vector #'u8ref%unsafe #'(setf u8ref%unsafe))) (t (warn "don't know about vector's element-type: ~S" vector) - (values #'aref #'(setf aref))))))) + (values vector #'aref #'(setf aref))))))) (defmacro with-subvector-accessor ((name vector-form &optional start end) &body body) "Installs name as an accessor into vector-form, bound by start and end." (let ((reader (gensym "sub-vector-reader-")) (writer (gensym "sub-vector-writer-")) (vector (gensym "sub-vector-"))) - `(let ((,vector ,vector-form)) - (multiple-value-bind (,reader ,writer) - (subvector-accessors ,vector ,start ,end) - (declare (ignorable ,reader ,writer)) - (macrolet ((,name (index) - `(accessor%unsafe (,',reader ,',writer) ,',vector ,index))) - ,@body))))) + `(multiple-value-bind (,vector ,reader ,writer) + (subvector-accessors ,vector-form ,start ,end) + (declare (ignorable ,reader ,writer)) + (macrolet ((,name (index) + `(accessor%unsafe (,',reader ,',writer) ,',vector ,index))) + ,@body)))) (defmacro accessor%unsafe ((reader writer) &rest args) (declare (ignore writer))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.lisp
by ffjeld＠common-lisp.net 10 Jun '05

10 Jun '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13134 Modified Files: inspect.lisp Log Message: vector-u16 and vector-u32 are obsolete. Date: Sat Jun 11 01:07:07 2005 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.53 movitz/losp/muerte/inspect.lisp:1.54 --- movitz/losp/muerte/inspect.lisp:1.53 Thu May 5 22:52:02 2005 +++ movitz/losp/muerte/inspect.lisp Sat Jun 11 01:07:07 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.53 2005/05/05 20:52:02 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.54 2005/06/10 23:07:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -388,13 +388,13 @@ (+ -1 object-location (movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (array-dimension object 0) 7) 8))))) - (vector-u16 + ((simple-array (unsigned-byte 16) 1) (<= object-location location (+ -1 object-location (movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (array-dimension object 0) 3) 4))))) - ((or vector-u32 simple-vector) + ((or simple-vector (simple-array (unsigned-byte 32) 1)) (<= object-location location (+ -1 object-location

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/scavenge.lisp
by ffjeld＠common-lisp.net 10 Jun '05

10 Jun '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13117 Modified Files: scavenge.lisp Log Message: Add scavenger support for indirect-vectors. Date: Sat Jun 11 01:06:40 2005 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.50 movitz/losp/muerte/scavenge.lisp:1.51 --- movitz/losp/muerte/scavenge.lisp:1.50 Thu May 5 22:51:55 2005 +++ movitz/losp/muerte/scavenge.lisp Sat Jun 11 01:06:39 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.50 2005/05/05 20:51:55 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.51 2005/06/10 23:06:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -180,8 +180,12 @@ (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (logand (1+ len) -2))))) ((scavenge-typep x :basic-vector) - (if (scavenge-wide-typep x :basic-vector - #.(bt:enum-value 'movitz:movitz-vector-element-type :any-t)) + (if (or (scavenge-wide-typep x :basic-vector + #.(bt:enum-value 'movitz:movitz-vector-element-type + :any-t)) + (scavenge-wide-typep x :basic-vector + #.(bt:enum-value 'movitz:movitz-vector-element-type + :indirects))) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (error "Scanned unknown basic-vector-header ~S at location #x~X." x scan))) ((and (eq x 3) (eq x2 0))

1 0