Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25162

Modified Files: inspect.lisp Log Message: This rather substantial check-in is a clean-up of all things related to dynamic memory allocation. In particular, the separation between the muerte kernel with its 'default' memory management (which simply allocates objects consecutively until it runs out) and the los0 GC implementation is improved.

Date: Thu Jul 15 14:07:04 2004 Author: ffjeld

Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.20 movitz/losp/muerte/inspect.lisp:1.21 --- movitz/losp/muerte/inspect.lisp:1.20 Tue Jul 13 15:42:38 2004 +++ movitz/losp/muerte/inspect.lisp Thu Jul 15 14:07:04 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.20 2004/07/13 22:42:38 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.21 2004/07/15 21:07:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -19,6 +19,17 @@

(in-package muerte)

+(define-global-variable %memory-map% + '((0 . #x80000)) ; 0-2 MB + "This is a list of the active memory ranges. Each element is a cons-cell +where the car is the start-location and the cdr the end-location. +A 'location' is a fixnum interpreted as a pointer (i.e. the pointer value +with the lower two bits masked off). +This variable should be initialized during bootup initialization.") + +(defvar %memory-map-roots% '((0 . #x80000)) + "The memory-map that is to be scanned for pointer roots.") + (define-compiler-macro check-stack-limit () `(with-inline-assembly (:returns :nothing) (:locally (:bound (:edi (:edi-offset stack-bottom)) :esp)))) @@ -183,46 +194,17 @@ (symbol (copy-symbol old t)) (vector - (make-array (array-dimension old 0) - :element-type (array-element-type old) - :initial-contents old - :fill-pointer (fill-pointer old))) + (let ((new (make-array (array-dimension old 0) + :element-type (array-element-type old) + :initial-contents old))) + (when (array-has-fill-pointer-p old) + (setf (fill-pointer new) (fill-pointer old))) + new)) (function (copy-funobj old)) (structure-object (copy-structure old))))

-(defun malloc-clumps (clumps) - "Allocate general-purpose memory, i.e. including pointers. -The unit clump is 8 bytes, or two words." - (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) - (:xorl :ecx :ecx) - reset-loop - (:movl :edi (:eax :ecx -6)) - (:addl 4 :ecx) - (:cmpl :ecx :ebx) - (:jae 'reset-loop)))) - #+ignore - (dotimes (i (* 2 clumps)) - (setf (memref x -6 i :lisp) nil)) - x)) - -(defun malloc-data-clumps (clumps) - "Allocate memory for non-pointer data (i.e. doesn't require initialization)." - ;; Never mind, this is the stupid default implementation. - (malloc-clumps clumps)) - -(defun malloc-words (words) - "Allocate space for at least (+ 2 words) cells/words." - (malloc-clumps (1+ (truncate (1+ words) 2)))) - -(defun malloc-data-words (words) - (malloc-data-clumps (1+ (truncate (1+ words) 2)))) - (defun location-in-object-p (object location) "Is location inside object?" (let ((object-location (object-location object))) @@ -315,7 +297,7 @@ (defun copy-bignum (old) (check-type old bignum) (let* ((length (%bignum-bigits old)) - (new (malloc-data-clumps (1+ (truncate length 2))))) + (new (malloc-non-pointer-words (1+ length)))) (with-inline-assembly (:returns :eax) (:compile-two-forms (:eax :ebx) new old) (:compile-form (:result-mode :edx) length)