movitz-cvs April 2005

movitz-cvs@common-lisp.net

1 participants
62 discussions

[movitz-cvs] CVS update: movitz/losp/x86-pc/debugger.lisp
by ffjeld＠common-lisp.net 20 Apr '05

20 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv20378 Modified Files: debugger.lisp Log Message: Removed obsolete (get-global-property :setf-namespace) code. Date: Wed Apr 20 08:54:07 2005 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.37 movitz/losp/x86-pc/debugger.lisp:1.38 --- movitz/losp/x86-pc/debugger.lisp:1.37 Wed Mar 9 08:22:32 2005 +++ movitz/losp/x86-pc/debugger.lisp Wed Apr 20 08:54:07 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.37 2005/03/09 07:22:32 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.38 2005/04/20 06:54:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -630,7 +630,7 @@ (location-in-object-p (%run-time-context-slot slot-name) instruction-location)) (return (values slot-name :run-time-context)))) - (with-hash-table-iterator (hashis (get-global-property :setf-namespace)) + (with-hash-table-iterator (hashis *setf-namespace*) (do () (nil) (multiple-value-bind (morep setf-name symbol) (hashis)

1 0

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

20 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20361 Modified Files: functions.lisp Log Message: Removed obsolete (get-global-property :setf-namespace) code. Date: Wed Apr 20 08:53:28 2005 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.28 movitz/losp/muerte/functions.lisp:1.29 --- movitz/losp/muerte/functions.lisp:1.28 Tue Apr 19 08:42:22 2005 +++ movitz/losp/muerte/functions.lisp Wed Apr 20 08:53:28 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.28 2005/04/19 06:42:22 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.29 2005/04/20 06:53:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -476,7 +476,7 @@ (check-type old-funobj function) (%shallow-copy-object old-funobj (+ (funobj-num-constants old-funobj) - #.(movitz::movitz-type-word-size 'movitz-funobj)))) + (movitz-type-word-size 'movitz-funobj)))) (defun install-funobj-name (name funobj) (setf (funobj-name funobj) name) @@ -487,18 +487,16 @@ (symbol (symbol-function function-name)) ((cons (eql setf)) - (symbol-function (gethash (cadr function-name) *setf-namespace* - #+ignore (get-global-property :setf-namespace)))))) + (symbol-function (gethash (cadr function-name) *setf-namespace*))))) (defun (setf fdefinition) (value function-name) (etypecase function-name (symbol (setf (symbol-function function-name) value)) ((cons (eql setf)) - (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) + (let* ((setf-name (cadr function-name)) + (setf-symbol (or (gethash setf-name *setf-namespace*) + (setf (gethash setf-name *setf-namespace*) (make-symbol (format nil "~A-~A" 'setf 'setf-name)))))) (setf (symbol-function setf-symbol) value)))))

1 0

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

20 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20345 Modified Files: eval.lisp Log Message: Removed obsolete (get-global-property :setf-namespace) code. Date: Wed Apr 20 08:53:24 2005 Author: ffjeld Index: movitz/losp/muerte/eval.lisp diff -u movitz/losp/muerte/eval.lisp:1.16 movitz/losp/muerte/eval.lisp:1.17 --- movitz/losp/muerte/eval.lisp:1.16 Tue Apr 19 08:42:15 2005 +++ movitz/losp/muerte/eval.lisp Wed Apr 20 08:53:23 2005 @@ -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.16 2005/04/19 06:42:15 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.17 2005/04/20 06:53:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -345,7 +345,7 @@ setf-name)) (defun setf-intern (name) - (values (gethash name *setf-namespace* #+ignore (get-global-property :setf-namespace)))) + (values (gethash name *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 20 Apr '05

20 Apr '05

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

1 0

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

20 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20314 Modified Files: basic-functions.lisp Log Message: Added operator location-physical-offset. Date: Wed Apr 20 08:52:26 2005 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.16 movitz/losp/muerte/basic-functions.lisp:1.17 --- movitz/losp/muerte/basic-functions.lisp:1.16 Thu Jan 27 08:47:37 2005 +++ movitz/losp/muerte/basic-functions.lisp Wed Apr 20 08:52:26 2005 @@ -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.16 2005/01/27 07:47:37 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.17 2005/04/20 06:52:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -349,6 +349,18 @@ (defun object-tag (object) (object-tag object)) + + +(define-compiler-macro location-physical-offset () + '(memref nil (movitz-type-slot-offset 'movitz-run-time-context + 'physical-address-offset) + :type :lisp)) + +(defun location-physical-offset () + "The offset between physical and logical locations. +A location is an 4-aligned address (32 bits whose two lsb are zero) +interpreted as a lispval, and consequently a fixnum." + (location-physical-offset)) (defun halt-cpu () (halt-cpu))

1 0

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

20 Apr '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv20293 Modified Files: stream-image.lisp Log Message: *** empty log message *** Date: Wed Apr 20 08:51:57 2005 Author: ffjeld Index: movitz/stream-image.lisp diff -u movitz/stream-image.lisp:1.11 movitz/stream-image.lisp:1.12 --- movitz/stream-image.lisp:1.11 Fri Aug 6 16:43:55 2004 +++ movitz/stream-image.lisp Wed Apr 20 08:51:57 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: Mon Aug 27 14:46:50 2001 ;;;; -;;;; $Id: stream-image.lisp,v 1.11 2004/08/06 14:43:55 ffjeld Exp $ +;;;; $Id: stream-image.lisp,v 1.12 2005/04/20 06:51:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -91,6 +91,8 @@ (read-binary 'movitz-std-instance (image-stream image))) (:bignum (read-binary 'movitz-bignum (image-stream image))) + (:run-time-context + (read-binary 'movitz-run-time-context (image-stream image))) (t (warn "unknown other object: #x~X: ~S code #x~X." word type-tag type-code) (make-instance 'movitz-fixnum :value (truncate word 4))))))

1 0

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

20 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20271 Modified Files: inspect.lisp Log Message: Use proper movitz-type-word-size operator rather than #.(movitz:...) Date: Wed Apr 20 08:51:13 2005 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.49 movitz/losp/muerte/inspect.lisp:1.50 --- movitz/losp/muerte/inspect.lisp:1.49 Mon Feb 28 18:00:05 2005 +++ movitz/losp/muerte/inspect.lisp Wed Apr 20 08:51:12 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.49 2005/02/28 17:00:05 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.50 2005/04/20 06:51:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -264,7 +264,9 @@ (function (copy-funobj old)) (structure-object - (copy-structure old)))) + (copy-structure old)) + (run-time-context + (%shallow-copy-object old (movitz-type-word-size 'movitz-run-time-context))))) (defun objects-equalp (x y) "Basically, this verifies whether x is a shallow-copy of y, or vice versa." @@ -364,51 +366,51 @@ (symbol (<= object-location location - (+ -1 object-location #.(movitz::movitz-type-word-size :movitz-symbol)))) + (+ -1 object-location (movitz-type-word-size :movitz-symbol)))) (run-time-context (<= object-location location - (+ -1 object-location #.(movitz::movitz-type-word-size :movitz-run-time-context)))) + (+ -1 object-location (movitz-type-word-size :movitz-run-time-context)))) (std-instance (<= object-location location - (+ -1 object-location #.(movitz::movitz-type-word-size :movitz-std-instance)))) + (+ -1 object-location (movitz-type-word-size :movitz-std-instance)))) (function (<= object-location location (+ -1 object-location - #.(movitz::movitz-type-word-size :movitz-funobj) + (movitz-type-word-size :movitz-funobj) (funobj-num-constants object)))) ((or string code-vector (simple-array (unsigned-byte 8) 1)) (<= object-location location (+ -1 object-location - #.(movitz::movitz-type-word-size 'movitz-basic-vector) + (movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (array-dimension object 0) 7) 8))))) (vector-u16 (<= object-location location (+ -1 object-location - #.(movitz::movitz-type-word-size 'movitz-basic-vector) + (movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (array-dimension object 0) 3) 4))))) ((or vector-u32 simple-vector) (<= object-location location (+ -1 object-location - #.(movitz::movitz-type-word-size 'movitz-basic-vector) + (movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (array-dimension object 0) 1) 2))))) (structure-object (<= object-location location (+ -1 object-location - #.(movitz::movitz-type-word-size :movitz-struct) + (movitz-type-word-size :movitz-struct) (* 2 (truncate (+ (structure-object-length object) 1) 2)))))))) (defun location-in-code-vector-p%unsafe (code-vector location) (and (<= (object-location code-vector) location) (<= location (+ -1 (object-location code-vector) - #.(movitz::movitz-type-word-size 'movitz-basic-vector) + (movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (memref code-vector (movitz-type-slot-offset 'movitz-basic-vector 'num-elements)) 7)

1 0

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

20 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20241 Modified Files: basic-macros.lisp Log Message: Added compiler-macro movitz-type-word-size. Date: Wed Apr 20 08:50:10 2005 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.56 movitz/losp/muerte/basic-macros.lisp:1.57 --- movitz/losp/muerte/basic-macros.lisp:1.56 Tue Mar 1 00:38:03 2005 +++ movitz/losp/muerte/basic-macros.lisp Wed Apr 20 08:50:10 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.56 2005/02/28 23:38:03 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.57 2005/04/20 06:50:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -401,6 +401,12 @@ (find-symbol (string slot-name) :movitz)))) (:leal ((:ecx #.movitz::+movitz-fixnum-factor+) :edi ,(- (movitz::image-nil-word movitz::*image*))) :eax))) + +(define-compiler-macro movitz-type-word-size (type &environment env) + (if (not (movitz:movitz-constantp type env)) + (error "Non-constant movitz-type-word-size call.") + (movitz::movitz-type-word-size (intern (symbol-name (movitz:movitz-eval type env)) + :movitz)))) (define-compiler-macro movitz-type-slot-offset (type slot &environment env) (if (not (and (movitz:movitz-constantp type env)

1 0

[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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs April 2005