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

[movitz-cvs] CVS update: movitz/losp/lib/net/ip4.lisp
by ffjeld＠common-lisp.net 19 Apr '05

19 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv31787 Modified Files: ip4.lisp Log Message: Changed default network addresses in ip4-init (i.e. my lab changed network). Date: Tue Apr 19 08:50:04 2005 Author: ffjeld Index: movitz/losp/lib/net/ip4.lisp diff -u movitz/losp/lib/net/ip4.lisp:1.16 movitz/losp/lib/net/ip4.lisp:1.17 --- movitz/losp/lib/net/ip4.lisp:1.16 Thu Dec 9 00:40:03 2004 +++ movitz/losp/lib/net/ip4.lisp Tue Apr 19 08:50:04 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001, 2003-2004, +;;;; Copyright (C) 2001, 2003-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 Apr 30 13:52:57 2003 ;;;; -;;;; $Id: ip4.lisp,v 1.16 2004/12/08 23:40:03 ffjeld Exp $ +;;;; $Id: ip4.lisp,v 1.17 2005/04/19 06:50:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -480,7 +480,7 @@ (setf *ne2000* nil)) (values)) -(defun ip4-init () +(defun ip4-init (&optional (ip :129.242.19.151) (router :129.242.19.129)) (unless *ip4-nic* (let ((ethernet (some #'muerte.x86-pc.ne2k:ne2k-probe @@ -488,9 +488,9 @@ (assert ethernet ethernet "No ethernet device.") (setf *ip4-nic* ethernet))) (unless *ip4-ip* - (setf *ip4-ip* (ip4-address :129.242.16.173))) + (setf *ip4-ip* (ip4-address ip))) (unless *ip4-router* - (setf *ip4-router* (ip4-address :129.242.16.1))) + (setf *ip4-router* (ip4-address router))) ;; This is to announce our presence on the LAN.. (assert (polling-arp *ip4-router* (lambda () (eql #\space (muerte.x86-pc.keyboard:poll-char))))

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by ffjeld＠common-lisp.net 19 Apr '05

19 Apr '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv30960 Modified Files: image.lisp Log Message: Initialize *setf-namespace* at dump-time. In movitz-read, update old cons-cells also when they are found in the cache of previously-read cells. Date: Tue Apr 19 08:44:01 2005 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.88 movitz/image.lisp:1.89 --- movitz/image.lisp:1.88 Mon Jan 10 09:18:56 2005 +++ movitz/image.lisp Tue Apr 19 08:44:01 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.88 2005/01/10 08:18:56 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.89 2005/04/19 06:44:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -882,6 +882,8 @@ (let ((handler (movitz-env-symbol-function 'muerte::interrupt-default-handler))) (setf (movitz-run-time-context-exception-handlers (image-run-time-context *image*)) (movitz-read (make-array 256 :initial-element handler)))) + (setf (movitz-symbol-value (movitz-read 'muerte::*setf-namespace*)) + (movitz-read (movitz-environment-setf-function-names *movitz-global-environment*) t)) (let ((load-address (image-start-address *image*))) (setf (image-cons-pointer *image*) (- load-address (image-ds-segment-base *image*)) @@ -969,8 +971,6 @@ (setf (movitz-symbol-value mname) mvalue))) (setf (movitz-run-time-context-global-properties run-time-context) (movitz-read (list :packages (make-packages-hash) - :setf-namespace (movitz-environment-setf-function-names - *movitz-global-environment*) :trampoline-funcall%1op (find-primitive-function 'muerte::trampoline-funcall%1op) :trampoline-funcall%2op (find-primitive-function @@ -1483,7 +1483,10 @@ :element-type (array-element-type expr) :initial-contents expr)) (cons - (or (gethash expr (image-cons-constants *image*)) + (or (let ((old-cons (gethash expr (image-cons-constants *image*)))) + (when old-cons + (update-movitz-object old-cons expr) + old-cons)) (setf (gethash expr (image-cons-constants *image*)) (if (eq '#0=#:error (ignore-errors (when (not (list-length expr)) '#0#))) (multiple-value-bind (unfolded-expr cdr-index)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp
by ffjeld＠common-lisp.net 19 Apr '05

19 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30923 Modified Files: functions.lisp Log Message: Use *setf-namespace* rather than (get-global-property :setf-namespace). Date: Tue Apr 19 08:42:25 2005 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.27 movitz/losp/muerte/functions.lisp:1.28 --- movitz/losp/muerte/functions.lisp:1.27 Mon Jan 31 16:47:57 2005 +++ movitz/losp/muerte/functions.lisp Tue Apr 19 08:42:22 2005 @@ -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.27 2005/01/31 15:47:57 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.28 2005/04/19 06:42:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -20,6 +20,9 @@ (in-package muerte) +(defvar *setf-namespace* nil + "This hash-table is initialized by dump-image.") + (defun identity (x) x) (defun constantly-prototype (&rest ignore) @@ -484,15 +487,15 @@ (symbol (symbol-function function-name)) ((cons (eql setf)) - (symbol-function (gethash (cadr function-name) - (get-global-property :setf-namespace)))))) + (symbol-function (gethash (cadr function-name) *setf-namespace* + #+ignore (get-global-property :setf-namespace)))))) (defun (setf fdefinition) (value function-name) (etypecase function-name (symbol (setf (symbol-function function-name) value)) ((cons (eql setf)) - (let* ((setf-namespace (get-global-property :setf-namespace)) + (let* ((setf-namespace *setf-namespace* #+ignore (get-global-property :setf-namespace)) (setf-name (cadr function-name)) (setf-symbol (or (gethash setf-name setf-namespace) (setf (gethash setf-name setf-namespace)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/eval.lisp
by ffjeld＠common-lisp.net 19 Apr '05

19 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30908 Modified Files: eval.lisp Log Message: Use *setf-namespace* rather than (get-global-property :setf-namespace). Date: Tue Apr 19 08:42:16 2005 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.15 movitz/losp/muerte/eval.lisp:1.16 --- movitz/losp/muerte/eval.lisp:1.15 Thu Nov 18 18:57:14 2004 +++ movitz/losp/muerte/eval.lisp Tue Apr 19 08:42:15 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 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.15 2004/11/18 17:57:14 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.16 2005/04/19 06:42:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -337,15 +337,15 @@ :environment-p nil :recursive-p nil :whole-p nil)))))))))) - + (defun lookup-setf-function (name) - (let ((setf-name (gethash name (get-global-property :setf-namespace)))) + (let ((setf-name (gethash name *setf-namespace*))) (assert setf-name (name) "No function (~S ~S) defined." 'setf name) setf-name)) (defun setf-intern (name) - (values (gethash name (get-global-property :setf-namespace)))) + (values (gethash name *setf-namespace* #+ignore (get-global-property :setf-namespace)))) (defun special-operator-p (operator-name) (member operator-name '(quote function if progn tagbody go)))

1 0

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

19 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30891 Modified Files: environment.lisp Log Message: Use *setf-namespace* rather than (get-global-property :setf-namespace). Date: Tue Apr 19 08:42:11 2005 Author: ffjeld Index: movitz/losp/muerte/environment.lisp diff -u movitz/losp/muerte/environment.lisp:1.10 movitz/losp/muerte/environment.lisp:1.11 --- movitz/losp/muerte/environment.lisp:1.10 Wed Mar 9 08:19:19 2005 +++ movitz/losp/muerte/environment.lisp Tue Apr 19 08:42:11 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.10 2005/03/09 07:19:19 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.11 2005/04/19 06:42:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -48,8 +48,8 @@ (symbol function-name) ((cons (eql setf) (cons symbol null)) - (gethash (cadr function-name) - (get-global-property :setf-namespace))))) + (gethash (cadr function-name) *setf-namespace* + #+ignore (get-global-property :setf-namespace))))) (defun match-caller (name) (do ((frame (stack-frame-uplink nil (current-stack-frame))

1 0

[movitz-cvs] CVS update: movitz/losp/ll-testing.lisp
by ffjeld＠common-lisp.net 18 Apr '05

18 Apr '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv12012 Modified Files: ll-testing.lisp Log Message: Added install-global-segment-table. Date: Mon Apr 18 09:08:58 2005 Author: ffjeld Index: movitz/losp/ll-testing.lisp diff -u movitz/losp/ll-testing.lisp:1.2 movitz/losp/ll-testing.lisp:1.3 --- movitz/losp/ll-testing.lisp:1.2 Sat Apr 16 18:20:38 2005 +++ movitz/losp/ll-testing.lisp Mon Apr 18 09:08:58 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 14 08:18:43 2005 ;;;; -;;;; $Id: ll-testing.lisp,v 1.2 2005/04/16 16:20:38 ffjeld Exp $ +;;;; $Id: ll-testing.lisp,v 1.3 2005/04/18 07:08:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,7 +18,7 @@ (in-package muerte) (defun dump-global-segment-table (&key table entries nofill) - "Dump contents of the global (segment) descriptor table into a vector." + "Dump contents of the current global (segment) descriptor table into a vector." (multiple-value-bind (gdt-base gdt-limit) (%sgdt) (let* ((gdt-entries (/ (1+ gdt-limit) 8)) @@ -34,6 +34,21 @@ do (setf (aref table i) (memref gdt-base 0 :index i :type :unsigned-byte32 :physicalp t)))) table)))) + +(defun install-global-segment-table (table &optional entries) + "Install <table> as the GDT. +NB! ensure that the table object isn't garbage-collected." + (check-type table (vector (unsigned-byte 32))) + (let ((entries (or entries (truncate (length table) 2)))) + (check-type entries (integer 0 *)) + (let ((limit (1- (* 8 entries))) + (base (+ 2 (+ (object-location table) + (memref nil (movitz-type-slot-offset 'movitz-run-time-context + 'physical-address-offset) + :type :lisp))))) + (%lgdt base limit) + (values table limit)))) + (defun format-segment-table (table &key (start 0) (end (truncate (length table) 2))) (loop for i from start below end

1 0

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

18 Apr '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv11996 Modified Files: los0.lisp Log Message: *** empty log message *** Date: Mon Apr 18 09:08:42 2005 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.38 movitz/losp/los0.lisp:1.39 --- movitz/losp/los0.lisp:1.38 Fri Apr 15 09:04:24 2005 +++ movitz/losp/los0.lisp Mon Apr 18 09:08:42 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.38 2005/04/15 07:04:24 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.39 2005/04/18 07:08:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1330,6 +1330,8 @@ (:movl 4 :eax) no-overflow)) +(defvar *segment-descriptor-table*) + (defun genesis () ;; (install-shallow-binding) (let ((extended-memsize 0)) @@ -1341,6 +1343,11 @@ (format t "Extended memory: ~D KB~%" extended-memsize) (idt-init) + + (setf *segment-descriptor-table* ; Ensure we have a GDT with 16 entries, in static-space. + (muerte::install-global-segment-table + (muerte::dump-global-segment-table :entries 16))) + (install-los0-consing :kb-size 500) #+ignore (install-los0-consing :kb-size (max 50 (truncate (- extended-memsize 2048) 2))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/segments.lisp
by ffjeld＠common-lisp.net 18 Apr '05

18 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11967 Modified Files: segments.lisp Log Message: Added accessor segment-descriptor. Fixed bug in accessor segment-descriptor-avl-x-db-g: use the correct offset. Date: Mon Apr 18 09:07:45 2005 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.10 movitz/losp/muerte/segments.lisp:1.11 --- movitz/losp/muerte/segments.lisp:1.10 Fri Apr 15 09:04:10 2005 +++ movitz/losp/muerte/segments.lisp Mon Apr 18 09:07:45 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu May 8 14:25:06 2003 ;;;; -;;;; $Id: segments.lisp,v 1.10 2005/04/15 07:04:10 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.11 2005/04/18 07:07:45 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -215,13 +215,33 @@ "Access bits 52-55 of the segment descriptor." (check-type table (and vector (not simple-vector))) (ldb (byte 4 4) - (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + (memref table (+ 6 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) :type :unsigned-byte8))) (defun (setf segment-descriptor-avl-x-db-g) (bits table index) "Access bits 52-55 of the segment descriptor." (check-type table (and vector (not simple-vector))) (setf (ldb (byte 4 4) - (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + (memref table (+ 6 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) :type :unsigned-byte8)) bits)) + +(defun segment-descriptor (table index) + "Access entire segment descriptor as a 64-bit integer." + (check-type table (and vector (not simple-vector))) + (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (logior (ash (memref table offset :index 1 :type :unsigned-byte32) + 32) + (ash (memref table offset :index 0 :type :unsigned-byte32) + 0)))) + +(defun (setf segment-descriptor) (value table index) + "Access entire segment descriptor as a 64-bit integer." + (check-type table (and vector (not simple-vector))) + (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (setf (memref table offset :index 1 :type :unsigned-byte32) + (ldb (byte 32 32) value)) + (setf (memref table offset :index 0 :type :unsigned-byte32) + (ldb (byte 32 0) value)) + value)) +

1 0

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

18 Apr '05

Update of /project/movitz/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv10275 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 18 08:44:50 2005 Author: ffjeld Index: public_html/ChangeLog diff -u public_html/ChangeLog:1.3 public_html/ChangeLog:1.4 --- public_html/ChangeLog:1.3 Wed Mar 9 08:33:09 2005 +++ public_html/ChangeLog Mon Apr 18 08:44:49 2005 @@ -1,3 +1,11 @@ +2005-04-18 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> + + * Added support in the compiler for non-dynamic-extent &rest + function variables, so you don't _have_ to have those (declare + (dynamic-extent rest)) in there. Efficiency-wise, I'd still + recommend including them, though, because otherwise copy-list is + called to produce a infinite-extent list. + 2005-03-09 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> * Added/much improved support for GC-migration of

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by ffjeld＠common-lisp.net 17 Apr '05

17 Apr '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv14251 Modified Files: compiler.lisp Log Message: Fix make-special-funarg-shadowing so as to have non-dynamic-extent &rest bindings work (albeit not very efficiently). Date: Mon Apr 18 00:24:24 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.136 movitz/compiler.lisp:1.137 --- movitz/compiler.lisp:1.136 Wed Apr 13 09:25:41 2005 +++ movitz/compiler.lisp Mon Apr 18 00:24:20 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.136 2005/04/13 07:25:41 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.137 2005/04/17 22:24:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -4760,13 +4760,22 @@ need-normalized-ecx-p))) (defun make-special-funarg-shadowing (env function-body) - "" - (cond - ((without-function-prelude-p env) - function-body) - ((special-variable-shadows env) - `(muerte.cl::let ,(special-variable-shadows env) ,function-body)) - (t function-body))) + "Wrap function-body in a let, if we need to. +We need to when the function's lambda-list binds a special variable, +or when there's a non-dynamic-extent &rest binding." + (if (without-function-prelude-p env) + function-body + (let ((shadowing + (append (special-variable-shadows env) + (when (and (rest-var env) + (not (movitz-env-get (rest-var env) 'dynamic-extent nil env nil)) + (not (movitz-env-get (rest-var env) 'ignore nil env nil))) + (movitz-env-load-declarations `((muerte.cl:dynamic-extent ,(rest-var env))) + env :funobj) + `((,(rest-var env) (muerte.cl:copy-list ,(rest-var env)))))))) + (if (null shadowing) + function-body + `(muerte.cl::let ,shadowing ,function-body))))) (defun make-compiled-function-postlude (funobj env use-stack-frame-p) (declare (ignore funobj env))

1 0