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

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

15 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24264 Modified Files: defstruct.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:06:55 2004 Author: ffjeld Index: movitz/losp/muerte/defstruct.lisp diff -u movitz/losp/muerte/defstruct.lisp:1.8 movitz/losp/muerte/defstruct.lisp:1.9 --- movitz/losp/muerte/defstruct.lisp:1.8 Fri May 21 02:41:39 2004 +++ movitz/losp/muerte/defstruct.lisp Thu Jul 15 14:06:55 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.8 2004/05/21 09:41:39 ffjeld Exp $ +;;;; $Id: defstruct.lisp,v 1.9 2004/07/15 21:06:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -26,7 +26,7 @@ (defun copy-structure (object) (check-type object structure-object) (let* ((length (structure-object-length object)) - (copy (malloc-words length))) + (copy (malloc-pointer-words (+ 2 length)))) (setf (memref copy -6 0 :lisp) (memref object -6 0 :lisp)) (setf (memref copy -6 1 :unsigned-byte32) @@ -231,20 +231,20 @@ if (and constructor (symbolp constructor)) collect `(defun ,constructor (&key ,@key-lambda) - (let ((s (malloc-words ,(length slot-names)))) + (let ((s (malloc-pointer-words ,(+ 2 (length slot-names))))) (setf (memref s #.(bt:slot-offset 'movitz::movitz-struct 'movitz::name) - 0 :lisp) + 0 :lisp) ',struct-name) (setf (memref s #.(bt:slot-offset 'movitz::movitz-struct 'movitz::type) - 0 :unsigned-byte8) + 0 :unsigned-byte8) #.(movitz::tag :defstruct)) (setf (memref s #.(bt:slot-offset 'movitz::movitz-struct 'movitz::length) - 0 :unsigned-byte16) + 0 :unsigned-byte16) ,(length slot-names)) ,@(loop for slot-name in slot-names as i upfrom 0 collecting `(setf (memref s #.(bt:slot-offset 'movitz::movitz-struct - 'movitz::slot0) - ,i :lisp) + 'movitz::slot0) + ,i :lisp) ,slot-name)) s)) else if (and constructor (listp constructor)) @@ -253,7 +253,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 (malloc-words ,(length slot-names)))) + (let ((s (malloc-pointer-words ,(+ 2 (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/cons.lisp
by Frode Vatvedt Fjeld 15 Jul '04

15 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23869 Modified Files: cons.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:06:51 2004 Author: ffjeld Index: movitz/losp/muerte/cons.lisp diff -u movitz/losp/muerte/cons.lisp:1.4 movitz/losp/muerte/cons.lisp:1.5 --- movitz/losp/muerte/cons.lisp:1.4 Sat Apr 17 08:34:03 2004 +++ movitz/losp/muerte/cons.lisp Thu Jul 15 14:06:51 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 15:25:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: cons.lisp,v 1.4 2004/04/17 15:34:03 ffjeld Exp $ +;;;; $Id: cons.lisp,v 1.5 2004/07/15 21:06:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -244,4 +244,4 @@ (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) car) (:compile-form (:result-mode :ebx) cdr) - (:call-global-constant fast-cons))) + (:call-local-pf fast-cons)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp
by Frode Vatvedt Fjeld 15 Jul '04

15 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23821 Modified Files: basic-macros.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:06:46 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.26 movitz/losp/muerte/basic-macros.lisp:1.27 --- movitz/losp/muerte/basic-macros.lisp:1.26 Sun Jul 11 16:04:14 2004 +++ movitz/losp/muerte/basic-macros.lisp Thu Jul 15 14:06:46 2004 @@ -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.26 2004/07/11 23:04:14 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.27 2004/07/15 21:06:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -434,7 +434,7 @@ `(eq ',x ,y)) (t `(with-inline-assembly (:returns :boolean-zf=1) (:compile-two-forms (:eax :ebx) ,x ,y) - (:call-global-constant fast-eql))))) + (:call-global-pf fast-eql))))) (define-compiler-macro values (&rest sub-forms) `(inline-values ,@sub-forms)) @@ -523,23 +523,6 @@ :cl :muerte.cl))))) ',symbol)) - - -(defmacro inline-malloc (size &key (tag :other) other-tag wide-other-tag) - (assert (not (and (not other-tag) wide-other-tag))) - `(with-inline-assembly (:returns :eax :side-effects t) - ,@(if (integerp size) - `((:movl ,size :ebx)) - `((:compile-form (:result-mode :ebx) ,size) - (:shrl ,movitz::+movitz-fixnum-shift+ :ebx))) - (:globally (:call (:edi (:edi-offset malloc)))) - (:addl ,(if (integerp tag) tag (movitz::tag tag)) :eax) - ,@(when (and (eq tag :other) other-tag (not wide-other-tag)) - `((:movb ,(movitz::tag other-tag) (:eax ,movitz:+other-type-offset+)))) - ,@(when (and (eq tag :other) other-tag wide-other-tag) - `((:movw ,(dpb wide-other-tag (byte 8 8) (movitz:tag other-tag)) - (:eax ,movitz:+other-type-offset+)))))) - (defmacro check-type (place type &optional type-string) (if (not (stringp type-string)) `(let ((place-value ,place)) @@ -1051,7 +1034,7 @@ (:compile-form (:result-mode :eax) ,symbol) (:cmpl :edi :eax) (:je 'boundp-done) ; if ZF=0, then CF=0 - (:call-global-constant dynamic-find-binding) + (:call-local-pf dynamic-find-binding) (:jc 'boundp-done) (:movl (:eax #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::value)) :eax) (:globally (:cmpl (:edi (:edi-offset unbound-value)) :eax))

1 0

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

15 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23556 Modified Files: arrays.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:06:42 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.35 movitz/losp/muerte/arrays.lisp:1.36 --- movitz/losp/muerte/arrays.lisp:1.35 Sun Jul 11 16:02:33 2004 +++ movitz/losp/muerte/arrays.lisp Thu Jul 15 14:06:42 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.35 2004/07/11 23:02:33 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.36 2004/07/15 21:06:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -236,7 +236,7 @@ :u32 (:movl (:eax :ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :ecx) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:jmp 'return) :u8 :code (:movl :ebx :ecx) @@ -336,7 +336,7 @@ ;; u32? (:cmpl ,(movitz:basic-vector-type-tag :u32) :ecx) (:jne 'not-u32-vector) - (:call-global-constant unbox-u32) + (:call-local-pf unbox-u32) (:movl :ecx (:ebx :edx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data))) (:jmp 'return) @@ -547,7 +547,7 @@ `(funcall%unsafe ,reader ,@args)))) (defun make-basic-vector%character (dimensions fill-pointer initial-element initial-contents) - (let ((array (malloc-data-words (truncate (+ dimensions 3) 4)))) + (let ((array (malloc-non-pointer-words (+ 2 (truncate (+ dimensions 3) 4))))) (setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements) 0 :lisp) dimensions) @@ -570,7 +570,7 @@ array)) (defun make-basic-vector%u32 (dimensions fill-pointer initial-element initial-contents) - (let ((array (malloc-data-words dimensions))) + (let ((array (malloc-non-pointer-words (+ 2 dimensions)))) (setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements) 0 :lisp) dimensions) @@ -592,7 +592,7 @@ array)) (defun make-basic-vector%u8 (length fill-pointer initial-element initial-contents) - (let ((array (malloc-data-words (truncate (+ length 3) 4)))) + (let ((array (malloc-non-pointer-words (+ 2 (truncate (+ length 3) 4))))) (setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements) 0 :lisp) length) @@ -614,7 +614,7 @@ array)) (defun make-basic-vector%bit (length fill-pointer initial-element initial-contents) - (let ((array (malloc-data-words (truncate (+ length 31) 32)))) + (let ((array (malloc-non-pointer-words (+ 2 (truncate (+ length 31) 32))))) (setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements) 0 :lisp) length) @@ -636,7 +636,7 @@ array)) (defun make-basic-vector%code (dimensions fill-pointer initial-element initial-contents) - (let ((array (malloc-data-words (truncate (+ dimensions 3) 4)))) + (let ((array (malloc-non-pointer-words (+ 2 (truncate (+ dimensions 3) 4))))) (setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements) 0 :lisp) dimensions) @@ -659,7 +659,7 @@ (defun make-basic-vector%t (dimensions fill-pointer initial-element initial-contents) (check-type dimensions (and fixnum (integer 0 *))) - (let ((array (malloc-words dimensions))) + (let ((array (malloc-pointer-words (+ 2 dimensions)))) (setf (memref array #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements) 0 :lisp) dimensions)

1 0

[movitz-cvs] CVS update: movitz/losp/lib/malloc-init.lisp
by Frode Vatvedt Fjeld 15 Jul '04

15 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv23175 Modified Files: malloc-init.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:06:38 2004 Author: ffjeld Index: movitz/losp/lib/malloc-init.lisp diff -u movitz/losp/lib/malloc-init.lisp:1.4 movitz/losp/lib/malloc-init.lisp:1.5 --- movitz/losp/lib/malloc-init.lisp:1.4 Wed Jul 7 10:37:11 2004 +++ movitz/losp/lib/malloc-init.lisp Thu Jul 15 14:06:38 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Jan 9 15:57:22 2002 ;;;; -;;;; $Id: malloc-init.lisp,v 1.4 2004/07/07 17:37:11 ffjeld Exp $ +;;;; $Id: malloc-init.lisp,v 1.5 2004/07/15 21:06:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -20,14 +20,18 @@ (in-package muerte.lib) (let* ((stack-vector (%run-time-context-slot 'muerte::stack-vector)) - (kernel-end (+ (* 4 (muerte:object-location stack-vector)) - 8 (* 4 (array-dimension stack-vector 0)))) - (memsize (muerte.x86-pc::memory-size)) - (start (truncate (+ kernel-end 4095) 4096))) - (muerte:malloc-initialize start (- (* memsize #x100) start)) - (loop for x from (truncate kernel-end 4) below (* start 1024) + ;; We assume the kernel static are ends with the stack-vector. + (kernel-end-location (+ 2 (muerte:object-location stack-vector) + (array-dimension stack-vector 0))) + (memsize-mb (muerte.x86-pc::memory-size)) + ;; Start-location is kernel-end rounded up to the next 4096 edge. + (start-location (logand (+ kernel-end-location (1- 4096/4)) -4096/4)) + ;; End-location is the end of the memory. + (end-location (* (1- memsize-mb) 1024 1024/4))) + (muerte:malloc-initialize start-location end-location) + (setf (cdar muerte::%memory-map%) end-location) + (loop for x from kernel-end-location below start-location do (setf (memref x 0 0 :unsigned-byte32) 0)) - ;; (format t "Memory: ~D MB. Malloc area at ~D K.~%" memsize (* start 4)) (values))

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 15 Jul '04

15 Jul '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv22784 Modified Files: los0-gc.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:06:33 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.27 movitz/losp/los0-gc.lisp:1.28 --- movitz/losp/los0-gc.lisp:1.27 Thu Jul 15 04:22:08 2004 +++ movitz/losp/los0-gc.lisp Thu Jul 15 14:06:33 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.27 2004/07/15 11:22:08 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.28 2004/07/15 21:06:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -182,71 +182,67 @@ (:ret)))) (do-it))) -(defun los0-malloc-clumps (clumps) - (check-type clumps (integer 0 160000)) +(define-primitive-function los0-malloc-pointer-words (words) + "Number of words in EAX/fixnum. Result in EAX with tag :other." (macrolet ((do-it () - `(with-inline-assembly (:returns :eax) + `(with-inline-assembly (:returns :multiple-values) + (:addl 4 :eax) + (:andl -8 :eax) + (:movl :eax :ebx) ; Save count for later retry - (:compile-form (:result-mode :ebx) clumps) - (:declare-label-set retry-jumper (retry)) - (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t) - 'retry-jumper) - (:edi (:edi-offset atomically-status)))) (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) (:movl (:edx 2) :ecx) - (:leal ((:ebx 2) :ecx) :eax) + (:leal (:ecx :eax) :eax) (:cmpl (:edx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)) :eax) (:ja '(:sub-program () - (:int 113))) + (:int 113) + (:movl :ebx :eax) ; Restore count in EAX before retry + (:jmp 'retry))) (:movl :eax (:edx 2)) - (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) - (:edi (:edi-offset atomically-status)))) - (:movl ,(movitz:tag :infant-object) (:edx :ecx 6)) + (:movl ,(movitz:tag :infant-object) (:edx :ecx ,(+ 8 movitz:+other-type-offset+))) (:leal (:edx :ecx 8) :eax) (:xorl :ecx :ecx) - init-loop ; Now init eax number of clumps. - (:movl :edi (:eax (:ecx 2) -6)) - (:movl :edi (:eax (:ecx 2) -2)) + init-loop ; Now init ebx number of words + (:movl :edi (:eax :ecx ,(- (movitz:tag :other)))) (:addl 4 :ecx) (:cmpl :ebx :ecx) - (:jb 'init-loop)))) + (:jb 'init-loop) + (:ret)))) (do-it))) -(defun los0-malloc-data-clumps (clumps) - (check-type clumps (integer 0 160000)) +(define-primitive-function los0-malloc-non-pointer-words (words) + "Number of words in EAX/fixnum. Result in EAX with tag :other." (macrolet ((do-it () - `(with-inline-assembly (:returns :eax) + `(with-inline-assembly (:returns :multiple-values) + (:addl 4 :eax) + (:andl -8 :eax) + (:movl :eax :ebx) ; Save count for later retry - (:compile-form (:result-mode :ebx) clumps) - (:declare-label-set retry-jumper (retry)) - (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t) - 'retry-jumper) - (:edi (:edi-offset atomically-status)))) (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) (:movl (:edx 2) :ecx) - (:leal ((:ebx 2) :ecx) :eax) + (:leal (:ecx :eax) :eax) (:cmpl (:edx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::num-elements)) :eax) (:ja '(:sub-program () - (:int 113))) + (:int 113) + (:movl :ebx :eax) ; Restore count in EAX before retry + (:jmp 'retry))) (:movl :eax (:edx 2)) - (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) - (:edi (:edi-offset atomically-status)))) - - (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) - (:leal (:edx :ecx 8) :eax)))) + (:movl ,(movitz:tag :infant-object) (:edx :ecx ,(+ 8 movitz:+other-type-offset+))) + (:leal (:edx :ecx 8) :eax) ; Now EAX is a valid pointer + (:ret)))) (do-it))) -(defun install-los0-consing (&key (run-time-context (current-run-time-context)) + +(defun install-los0-consing (&key (context (current-run-time-context)) (kb-size 1024) duo-space) - "Install the 'Los0' GC architecture on run-time-context." - (setf (%run-time-context-slot 'nursery-space run-time-context) - (or duo-space - (allocate-duo-space (* kb-size #x100)))) + "Install the 'Los0' GC architecture on run-time-context CONTEXT. +Either use an explicitly provided DUO-SPACE, or allocate a fresh +duo-space where each space is KB-SIZE kilobytes." (setf (exception-handler 113) (lambda (exception interrupt-frame) (declare (ignore exception interrupt-frame)) @@ -259,41 +255,30 @@ (break "Los0 GC keyboard poll.")) ((nil) (return)))))) - (flet ((install-primitive (name slot) - (let ((code-vector (symbol-value name))) - (check-type code-vector code-vector) - (setf (%run-time-context-slot slot run-time-context) code-vector)))) - (install-primitive 'los0-fast-cons 'muerte::fast-cons) - (install-primitive 'los0-box-u32-ecx 'muerte::box-u32-ecx) - (install-primitive 'los0-get-cons-pointer 'muerte::get-cons-pointer) - (install-primitive 'los0-cons-commit 'muerte::cons-commit)) - (let ((old-malloc (symbol-function 'muerte:malloc-clumps))) - (setf (symbol-function 'muerte:malloc-clumps) - (symbol-function 'los0-malloc-clumps)) - (setf (symbol-function 'los0-malloc-clumps) - old-malloc)) - (let ((old-malloc-data (symbol-function 'muerte:malloc-data-clumps))) - (setf (symbol-function 'muerte:malloc-data-clumps) - (symbol-function 'los0-malloc-data-clumps)) - (setf (symbol-function 'los0-malloc-data-clumps) - old-malloc-data)) - (values)) - -(defun install-old-consing () - (let ((conser (symbol-value 'muerte::fast-cons))) - (check-type conser vector) - (setf (%run-time-context-slot 'muerte::fast-cons) - conser)) - (let ((old-malloc (symbol-function 'muerte:malloc-clumps))) - (setf (symbol-function 'muerte:malloc-clumps) - (symbol-function 'los0-malloc-clumps)) - (setf (symbol-function 'los0-malloc-clumps) - old-malloc)) - (let ((old-malloc-data (symbol-function 'muerte:malloc-data-clumps))) - (setf (symbol-function 'muerte:malloc-data-clumps) - (symbol-function 'los0-malloc-data-clumps)) - (setf (symbol-function 'los0-malloc-data-clumps) - old-malloc-data)) + (let* ((actual-duo-space (or duo-space + (allocate-duo-space (* kb-size #x100)))) + (last-location (object-location (cons 1 2)))) + (macrolet ((install-primitive (name slot) + `(let ((code-vector (symbol-value ',name))) + (check-type code-vector code-vector) + (if (eq context (current-run-time-context)) + ;; The point of this is to not trigger CLOS bootstrapping. + (setf (%run-time-context-slot ',slot) code-vector) + (setf (%run-time-context-slot ',slot context) code-vector))))) + (install-primitive los0-fast-cons muerte::fast-cons) + (install-primitive los0-box-u32-ecx muerte::box-u32-ecx) + (install-primitive los0-get-cons-pointer muerte::get-cons-pointer) + (install-primitive los0-cons-commit muerte::cons-commit) + (install-primitive los0-malloc-pointer-words muerte::malloc-pointer-words) + (install-primitive los0-malloc-non-pointer-words muerte::malloc-non-pointer-words)) + (if (eq context (current-run-time-context)) + (setf (%run-time-context-slot 'muerte::nursery-space) + actual-duo-space) + (setf (%run-time-context-slot 'muerte::nursery-space context) + actual-duo-space)) + ;; Pretend that the heap stops here, so that we don't have to scan + ;; the entire tail end of memory, which isn't going to be used. + (setf (cdar muerte::%memory-map-roots%) last-location)) (values)) (defun object-in-space-p (space object) @@ -387,8 +372,8 @@ (setf (memref (object-location x) 0 0 :lisp) forward-x) forward-x))))))))) ;; Scavenge roots - (map-heap-words evacuator 0 (+ (malloc-buffer-start) - (* 2 (malloc-cons-pointer)))) + (dolist (range muerte::%memory-map-roots%) + (map-heap-words evacuator (car range) (cdr range))) (map-stack-words evacuator (current-stack-frame)) ;; Scan newspace, Cheney style. (loop with newspace-location = (+ 2 (object-location newspace))

1 0

[movitz-cvs] CVS update: movitz/special-operators.lisp
by Frode Vatvedt Fjeld 15 Jul '04

15 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21911 Modified Files: special-operators.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:06:28 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.27 movitz/special-operators.lisp:1.28 --- movitz/special-operators.lisp:1.27 Wed Jul 14 17:29:19 2004 +++ movitz/special-operators.lisp Thu Jul 15 14:06:28 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.27 2004/07/15 00:29:19 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.28 2004/07/15 21:06:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -553,11 +553,16 @@ (setq side-effects t)) (setq modifies (modifies-union modifies sub-modifies)) code)))) - (setf (assembly-macro-expander :call-global-constant amenv) + (setf (assembly-macro-expander :call-global-pf amenv) #'(lambda (expr) (destructuring-bind (name) (cdr expr) `((:globally (:call (:edi (:edi-offset ,name)))))))) + (setf (assembly-macro-expander :call-local-pf amenv) + #'(lambda (expr) + (destructuring-bind (name) + (cdr expr) + `((:locally (:call (:edi (:edi-offset ,name)))))))) (setf (assembly-macro-expander :warn amenv) #'(lambda (expr) (apply #'warn (cdr expr))

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by Frode Vatvedt Fjeld 15 Jul '04

15 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21377 Modified Files: packages.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:06:24 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.32 movitz/packages.lisp:1.33 --- movitz/packages.lisp:1.32 Thu Jul 15 05:26:34 2004 +++ movitz/packages.lisp Thu Jul 15 14:06:24 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.32 2004/07/15 12:26:34 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.33 2004/07/15 21:06:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1141,11 +1141,13 @@ #:map-heap-words #:map-stack-words - #:malloc-clumps - #:malloc-data-clumps - #:malloc-cons-pointer #:malloc-buffer-start #:malloc-end + + #:malloc-pointer-words + #:malloc-non-pointer-words + #:%memory-map% + #:%memory-map-roots% #:%word-offset #:%run-time-context-slot

1 0

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

15 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19136 Modified Files: image.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:06:19 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.46 movitz/image.lisp:1.47 --- movitz/image.lisp:1.46 Tue Jul 13 05:59:33 2004 +++ movitz/image.lisp Thu Jul 15 14:06:19 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.46 2004/07/13 12:59:33 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.47 2004/07/15 21:06:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -300,14 +300,19 @@ :initform 0) (values :binary-type #.(* 4 +movitz-multiple-values-limit+)) - (malloc + (malloc-pointer-words :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) - (malloc-buffer - :binary-type lu32 - :initform 0) + (malloc-non-pointer-words + :binary-type code-vector-word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) +;;; (malloc-buffer +;;; :binary-type lu32 +;;; :initform 0) (default-interrupt-trampoline :map-binary-write 'movitz-intern-code-vector :binary-tag :primitive-function

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by Frode Vatvedt Fjeld 15 Jul '04

15 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv28064 Modified Files: packages.lisp Log Message: Export muerte:current-run-time-context. Date: Thu Jul 15 05:26:34 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.31 movitz/packages.lisp:1.32 --- movitz/packages.lisp:1.31 Thu Jul 15 04:16:14 2004 +++ movitz/packages.lisp Thu Jul 15 05:26:34 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.31 2004/07/15 11:16:14 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.32 2004/07/15 12:26:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1197,6 +1197,7 @@ #:basic-restart #:illegal-object #:run-time-context + #:current-run-time-context make-funobj funobj-type

1 0