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

[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

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

17 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv32518 Modified Files: packages.lisp Log Message: *** empty log message *** Date: Sun Apr 17 20:18:18 2005 Author: ffjeld Index: movitz/losp/muerte/packages.lisp diff -u movitz/losp/muerte/packages.lisp:1.7 movitz/losp/muerte/packages.lisp:1.8 --- movitz/losp/muerte/packages.lisp:1.7 Tue Mar 1 00:36:08 2005 +++ movitz/losp/muerte/packages.lisp Sun Apr 17 20:18:18 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 30 15:19:43 2001 ;;;; -;;;; $Id: packages.lisp,v 1.7 2005/02/28 23:36:08 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.8 2005/04/17 18:18:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -49,6 +49,13 @@ (defun assert-package (name) (or (find-package name) (error "There is no package named ~S." (string name)))) + +(defun list-all-packages () + (let (pkgs) + (maphash (lambda (k v) + (pushnew v pkgs)) + (get-global-property :packages)) + pkgs)) (defun find-symbol-string (name start end key &optional (package *package*)) (check-type name string)

1 0

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

16 Apr '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv14058 Modified Files: ll-testing.lisp Log Message: *** empty log message *** Date: Sat Apr 16 18:20:39 2005 Author: ffjeld Index: movitz/losp/ll-testing.lisp diff -u movitz/losp/ll-testing.lisp:1.1 movitz/losp/ll-testing.lisp:1.2 --- movitz/losp/ll-testing.lisp:1.1 Fri Apr 15 09:03:09 2005 +++ movitz/losp/ll-testing.lisp Sat Apr 16 18:20:38 2005 @@ -10,10 +10,11 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 14 08:18:43 2005 ;;;; -;;;; $Id: ll-testing.lisp,v 1.1 2005/04/15 07:03:09 ffjeld Exp $ +;;;; $Id: ll-testing.lisp,v 1.2 2005/04/16 16:20:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ +(provide :ll-testing) (in-package muerte) (defun dump-global-segment-table (&key table entries nofill)

1 0