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

[movitz-cvs] CVS update: movitz/losp/muerte/basic-functions.lisp
by Frode Vatvedt Fjeld 23 Mar '04

23 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv30688 Modified Files: basic-functions.lisp Log Message: Added operator %word-offset that constructs a new word by adding some offset. Use with extreme care, obviously. Date: Tue Mar 23 05:53:25 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.4 movitz/losp/muerte/basic-functions.lisp:1.5 --- movitz/losp/muerte/basic-functions.lisp:1.4 Mon Mar 22 11:37:51 2004 +++ movitz/losp/muerte/basic-functions.lisp Tue Mar 23 05:53:25 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.4 2004/03/22 16:37:51 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.5 2004/03/23 10:53:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -343,16 +343,15 @@ (defun halt-cpu () (halt-cpu)) -(defun malloc-words (words) - (malloc-clumps (1+ (truncate (1+ words) 2)))) +(define-compiler-macro %word-offset (&environment env word offset) + (if (movitz:movitz-constantp offset env) + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) ,word) + (:addl ,(movitz:movitz-eval offset env) :eax)) + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ecx) ,word ,offset) + (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) + (:addl :ecx :eax)))) -(defun malloc-clumps (clumps) - (let ((x (with-inline-assembly (:returns :eax :side-effects t) - (:compile-form (:result-mode :ebx) clumps) - (:shll 1 :ebx) - (:globally (:call (:edi (:edi-offset malloc)))) - (:addl #.(movitz::tag :other) :eax)))) - (dotimes (i clumps) - (setf (memref x -6 i :lisp) nil - (memref x -2 i :lisp) nil)) - x)) +(defun %word-offset (word offset) + (%word-offset word offset)) \ No newline at end of file

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/io-space.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv2225 Modified Files: io-space.lisp Log Message: Make print-object method for io-space-devices more safe. Date: Mon Mar 22 12:08:14 2004 Author: ffjeld Index: movitz/losp/x86-pc/io-space.lisp diff -u movitz/losp/x86-pc/io-space.lisp:1.2 movitz/losp/x86-pc/io-space.lisp:1.3 --- movitz/losp/x86-pc/io-space.lisp:1.2 Mon Jan 19 06:23:52 2004 +++ movitz/losp/x86-pc/io-space.lisp Mon Mar 22 12:08:14 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue May 6 10:50:36 2003 ;;;; -;;;; $Id: io-space.lisp,v 1.2 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: io-space.lisp,v 1.3 2004/03/22 17:08:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -79,8 +79,10 @@ (defmethod print-object ((device io-space-device) stream) (print-unreadable-object (device stream :type t) (format stream "~@[ ~A~]~@[ @ I/O #x~X~]" - (device-name device) - (io-range-start (first (io-space device))))) + (when (slot-boundp device 'device-name) + (device-name device)) + (when (slot-boundp device 'allocated-io-space) + (io-range-start (first (io-space device)))))) device) (defvar *io-space-register* nil) ; a list of io-space devices.

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv9151 Modified Files: storage-types.lisp Log Message: Added a type-tag of a kind that probably won't ever be used for anything, but who knows. I'll document this when GC works. Date: Mon Mar 22 11:45:40 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.11 movitz/storage-types.lisp:1.12 --- movitz/storage-types.lisp:1.11 Fri Mar 19 05:49:39 2004 +++ movitz/storage-types.lisp Mon Mar 22 11:45:39 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.11 2004/03/19 10:49:39 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.12 2004/03/22 16:45:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -72,6 +72,7 @@ :funobj #x30 :std-instance #x40 :run-time-context #x50 + :infant-object #x65 ;; :simple-vector #x20 ;; :character-vector

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2624 Modified Files: image.lisp Log Message: Added a slot nursery-space to constant-block. Date: Mon Mar 22 11:42:54 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.16 movitz/image.lisp:1.17 --- movitz/image.lisp:1.16 Fri Feb 13 17:03:16 2004 +++ movitz/image.lisp Mon Mar 22 11:42:53 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.16 2004/02/13 22:03:16 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.17 2004/03/22 16:42:53 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -355,6 +355,13 @@ (physical-address-offset :binary-type lu32 :initform (image-ds-segment-base *image*)) + (nursery-space + :binary-type word + :initform nil + :map-binary-write 'movitz-read-and-intern + :map-binary-read-delayed (lambda (x type) + (declare (ignore x type)) + (movitz-read nil))) (stack-vector :binary-type word :initform nil @@ -694,12 +701,11 @@ (defun create-image (&key (init-file *default-image-init-file*) (start-address #x100000)) - (#+allegro excl:tenuring #-allegro progn - (psetq *image* (let ((*image* (make-movitz-image start-address))) - (when init-file - (movitz-compile-file init-file)) - *image*) - *i* (when (boundp '*image*) *image*))) + (psetq *image* (let ((*image* (make-movitz-image start-address))) + (when init-file + (movitz-compile-file init-file)) + *image*) + *i* (when (boundp '*image*) *image*)) *image*) (defun dump-image (&key (path *default-image-file*) ((:image *image*) *image*)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23234 Modified Files: symbols.lisp Log Message: A small change in strategy for allocating memory. Date: Mon Mar 22 11:38:20 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.2 movitz/losp/muerte/symbols.lisp:1.3 --- movitz/losp/muerte/symbols.lisp:1.2 Mon Jan 19 06:23:47 2004 +++ movitz/losp/muerte/symbols.lisp Mon Mar 22 11:38:20 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.2 2004/01/19 11:23:47 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.3 2004/03/22 16:38:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -120,8 +120,20 @@ (not (eq (movitz-accessor symbol movitz-symbol function-value) (load-global-constant movitz::unbound-function)))))) +(defun %other-to-symbol (x) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) x) + (:leal (:eax 2) :ecx) + (:testb 7 :cl) + (:jnz '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Not an other heap-object: ~S" x)) + (:jmp 'continue))) + continue + (:addl 1 :eax))) + (defun make-symbol (name) - (let ((symbol (inline-malloc #.(bt:sizeof 'movitz::movitz-symbol) :tag :symbol))) + (let ((symbol (%other-to-symbol (malloc-clumps 3)))) (setf-movitz-accessor (symbol movitz-symbol package) nil) (setf-movitz-accessor (symbol movitz-symbol hash-key) (sxhash name)) (setf (symbol-flags symbol) 0

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20992 Modified Files: los-closette.lisp Log Message: A small change in strategy for allocating memory. Date: Mon Mar 22 11:38:10 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.5 movitz/losp/muerte/los-closette.lisp:1.6 --- movitz/losp/muerte/los-closette.lisp:1.5 Thu Feb 26 06:40:44 2004 +++ movitz/losp/muerte/los-closette.lisp Mon Mar 22 11:38:10 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.5 2004/02/26 11:40:44 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.6 2004/03/22 16:38:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -119,7 +119,7 @@ (defun allocate-std-instance (class slots) - (let ((instance (inline-malloc #.(bt:sizeof 'movitz:movitz-std-instance) :tag :other))) + (let ((instance (malloc-clumps 2))) (setf (memref instance #.(bt:slot-offset 'movitz:movitz-struct 'movitz:type) 0 :unsigned-byte8) #.(movitz:tag :std-instance)) @@ -1137,9 +1137,7 @@ (check-type class structure-class) (let* ((slots (structure-slots class)) (num-slots (length slots)) - (struct (inline-malloc (+ #.(bt:sizeof 'movitz::movitz-struct) - (* 4 num-slots) - (if (evenp num-slots) 0 1))))) + (struct (malloc-words num-slots))) (setf (memref struct #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name) 0 :lisp) (class-name class))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/functions.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20180 Modified Files: functions.lisp Log Message: A small change in strategy for allocating memory. Date: Mon Mar 22 11:38:05 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.2 movitz/losp/muerte/functions.lisp:1.3 --- movitz/losp/muerte/functions.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/functions.lisp Mon Mar 22 11:38:05 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.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.3 2004/03/22 16:38:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -265,12 +265,16 @@ (defun funobj-num-jumpers (funobj) (check-type funobj compiled-function) - (movitz-accessor-u16 funobj movitz-funobj num-jumpers)) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) funobj) + (:movzxw (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::num-jumpers)) :eax))) (defun (setf funobj-num-jumpers) (num-jumpers funobj) (check-type funobj compiled-function) - (check-type num-jumpers (unsigned-byte 16)) - (set-movitz-accessor-u16 funobj movitz-funobj num-jumpers num-jumpers)) + (check-type num-jumpers (unsigned-byte 14)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) num-jumpers funobj) + (:movw :ax (:ebx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::num-jumpers))))) (defun funobj-constant-ref (funobj index) (check-type funobj compiled-function) @@ -333,9 +337,10 @@ (make-array (length code-vector) :element-type 'u8 :initial-contents code-vector)))) - (let ((funobj (inline-malloc (+ #.(bt:sizeof 'movitz:movitz-funobj) - (* 4 (length constants))) - :other-tag :funobj))) + (let ((funobj (malloc-words (+ #.(cl:truncate (bt:sizeof 'movitz:movitz-funobj) 4) + (length constants))))) + (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:type) 0 :unsigned-byte16) + #.(movitz:tag :funobj)) (setf (funobj-name funobj) name (funobj-code-vector funobj) code-vector ;; revert to default trampolines for now.. @@ -376,9 +381,10 @@ (defun copy-funobj (old-funobj &optional (name (funobj-name old-funobj))) (let* ((num-constants (funobj-num-constants old-funobj)) - (funobj (inline-malloc (+ #.(bt:sizeof 'movitz:movitz-funobj) - (* 4 num-constants)) - :other-tag :funobj))) + (funobj (malloc-words (+ #.(cl:truncate (bt:sizeof 'movitz:movitz-funobj) 4) + num-constants)))) + (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:type) 0 :unsigned-byte16) + (memref old-funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:type) 0 :unsigned-byte16)) (setf (funobj-num-constants funobj) num-constants) (replace-funobj funobj old-funobj name)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/defstruct.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16417 Modified Files: defstruct.lisp Log Message: A small change in strategy for allocating memory. Date: Mon Mar 22 11:37:59 2004 Author: ffjeld Index: movitz/losp/muerte/defstruct.lisp diff -u movitz/losp/muerte/defstruct.lisp:1.2 movitz/losp/muerte/defstruct.lisp:1.3 --- movitz/losp/muerte/defstruct.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/defstruct.lisp Mon Mar 22 11:37:59 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Jan 22 13:10:59 2001 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: defstruct.lisp,v 1.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: defstruct.lisp,v 1.3 2004/03/22 16:37:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -212,8 +212,7 @@ if (and constructor (symbolp constructor)) collect `(defun ,constructor (&key ,@key-lambda) - (let ((s (inline-malloc ,(logand -8 (+ #.(bt:sizeof 'movitz::movitz-struct) - (* 4 (1+ (length slot-names)))))))) + (let ((s (malloc-words ,(length slot-names)))) (setf (memref s #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name) 0 :lisp) ',struct-name) @@ -235,8 +234,7 @@ (boa-lambda-list (cdr constructor)) (boa-variables (movitz::list-normal-lambda-list-variables boa-lambda-list))) `(defun ,boa-constructor ,boa-lambda-list - (let ((s (inline-malloc ,(logand -8 (+ #.(bt:sizeof 'movitz::movitz-struct) - (* 4 (1+ (length slot-names)))))))) + (let ((s (malloc-words ,(length slot-names)))) (setf (memref s #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name) 0 :lisp) ',struct-name)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-functions.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16227 Modified Files: basic-functions.lisp Log Message: A small change in strategy for allocating memory. Date: Mon Mar 22 11:37:51 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.3 movitz/losp/muerte/basic-functions.lisp:1.4 --- movitz/losp/muerte/basic-functions.lisp:1.3 Thu Feb 26 08:44:29 2004 +++ movitz/losp/muerte/basic-functions.lisp Mon Mar 22 11:37:51 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.3 2004/02/26 13:44:29 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.4 2004/03/22 16:37:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -342,3 +342,17 @@ (defun halt-cpu () (halt-cpu)) + +(defun malloc-words (words) + (malloc-clumps (1+ (truncate (1+ words) 2)))) + +(defun malloc-clumps (clumps) + (let ((x (with-inline-assembly (:returns :eax :side-effects t) + (:compile-form (:result-mode :ebx) clumps) + (:shll 1 :ebx) + (:globally (:call (:edi (:edi-offset malloc)))) + (:addl #.(movitz::tag :other) :eax)))) + (dotimes (i clumps) + (setf (memref x -6 i :lisp) nil + (memref x -2 i :lisp) nil)) + x))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Frode Vatvedt Fjeld 22 Mar '04

22 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16065 Modified Files: arrays.lisp Log Message: A small change in strategy for allocating memory. Date: Mon Mar 22 11:37:47 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.6 movitz/losp/muerte/arrays.lisp:1.7 --- movitz/losp/muerte/arrays.lisp:1.6 Thu Mar 18 04:19:45 2004 +++ movitz/losp/muerte/arrays.lisp Mon Mar 22 11:37:47 2004 @@ -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.6 2004/03/18 09:19:45 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.7 2004/03/22 16:37:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -549,19 +549,26 @@ (initial-contents (replace a initial-contents))) a)) - (t (let ((a (inline-malloc (+ #.(bt:sizeof 'movitz::movitz-vector) (* 4 dimensions)) - :other-tag :vector - :wide-other-tag #.(bt:enum-value 'movitz::movitz-vector-element-type - :any-t)))) - (setf (memref a #.(bt:slot-offset 'movitz::movitz-vector 'movitz::num-elements) + (t (let ((array (malloc-words dimensions) + #+ignore + (inline-malloc (+ #.(bt:sizeof 'movitz::movitz-vector) (* 4 dimensions)) + :other-tag :vector + :wide-other-tag #.(bt:enum-value 'movitz::movitz-vector-element-type + :any-t)))) + (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::type) + 0 :unsigned-byte16) + #.(movitz:vector-type-tag :any-t)) + (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::num-elements) 0 :unsigned-byte16) dimensions) - (setf (fill-pointer a) fill-pointer) - (if initial-contents - (replace a initial-contents) + (setf (fill-pointer array) fill-pointer) + (cond + (initial-contents + (replace array initial-contents)) + (initial-element (dotimes (i dimensions) - (setf (svref%unsafe a i) initial-element))) - a)))))) + (setf (svref%unsafe array i) initial-element)))) + array)))))) (defun vector (&rest objects) "=> vector"

1 0