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

[movitz-cvs] CVS update: movitz/losp/muerte/memref.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-serv26965 Modified Files: memref.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:18 2004 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.15 movitz/losp/muerte/memref.lisp:1.16 --- movitz/losp/muerte/memref.lisp:1.15 Sun Jul 11 16:00:41 2004 +++ movitz/losp/muerte/memref.lisp Thu Jul 15 14:07:18 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.15 2004/07/11 23:00:41 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.16 2004/07/15 21:07:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -334,7 +334,7 @@ (,index-var ,index)) (with-inline-assembly (:returns :untagged-fixnum-ecx) (:load-lexical (:lexical-binding ,value-var) :eax) - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) (:compile-two-forms (:ebx :eax) ,object-var ,index-var) (:movl :ecx (:eax :ebx ,(movitz:movitz-eval offset env))))))) (t (let ((value-var (gensym "memref-value-")) @@ -348,7 +348,7 @@ (,index-var ,index)) (with-inline-assembly (:returns :untagged-fixnum-ecx) (:load-lexical (:lexical-binding ,value-var) :eax) - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) (:compile-two-forms (:eax :edx) ,index-var ,offset-var) (:load-lexical (:lexical-binding ,object-var) :ebx) (:std) @@ -609,7 +609,7 @@ (:addl :ecx :eax) (:shrl ,movitz::+movitz-fixnum-shift+ :eax) ; scale down address (,prefixes :movl (:eax) :ecx) - (:call-global-constant box-u32-ecx))) + (:call-local-pf box-u32-ecx))) (:unsigned-byte16 (cond ((and (eq 0 offset) (eq 0 index))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/los-closette.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-serv26048 Modified Files: los-closette.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:13 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.13 movitz/losp/muerte/los-closette.lisp:1.14 --- movitz/losp/muerte/los-closette.lisp:1.13 Mon Jul 12 19:31:24 2004 +++ movitz/losp/muerte/los-closette.lisp Thu Jul 15 14:07:13 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.13 2004/07/13 02:31:24 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.14 2004/07/15 21:07:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -119,7 +119,7 @@ (defun allocate-std-instance (class slots) - (let ((instance (malloc-clumps 2))) + (let ((instance (malloc-pointer-words 4))) (setf (memref instance #.(bt:slot-offset 'movitz:movitz-struct 'movitz:type) 0 :unsigned-byte8) #.(movitz:tag :std-instance)) @@ -988,6 +988,7 @@ (defclass complex (number) () (:metaclass built-in-class)) (defclass illegal-object (t) () (:metaclass built-in-class)) +(defclass infant-object (t) () (:metaclass built-in-class)) (defclass run-time-context (t) () @@ -1110,7 +1111,7 @@ (check-type class structure-class) (let* ((slots (class-slots class)) (num-slots (length slots)) - (struct (malloc-words num-slots))) + (struct (malloc-pointer-words (+ 2 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/integers.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-serv25761 Modified Files: integers.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:08 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.65 movitz/losp/muerte/integers.lisp:1.66 --- movitz/losp/muerte/integers.lisp:1.65 Wed Jul 14 17:26:26 2004 +++ movitz/losp/muerte/integers.lisp Thu Jul 15 14:07:08 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.65 2004/07/15 00:26:26 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.66 2004/07/15 21:07:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -44,7 +44,7 @@ (define-compiler-macro evenp (x) `(with-inline-assembly (:returns :boolean-zf=1) (:compile-form (:result-mode :eax) ,x) - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) (:testb 1 :cl))) (defun evenp (x) @@ -53,7 +53,7 @@ (define-compiler-macro oddp (x) `(with-inline-assembly (:returns :boolean-zf=0) (:compile-form (:result-mode :eax) ,x) - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) (:testb 1 :cl))) (defun oddp (x) @@ -139,13 +139,13 @@ (:movl :eax :ecx) (:jns 'fix-fix-negative) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:jmp 'fix-fix-ok) fix-fix-negative (:jz 'fix-double-negative) (:negl :ecx) (:shrl ,movitz:+movitz-fixnum-shift+ :ecx) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:movl ,(dpb 1 (byte 16 16) (movitz:tag :bignum #xff)) (:eax ,movitz:+other-type-offset+)) @@ -175,7 +175,7 @@ (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) (:addl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx) (:jc 'retry-not-size1) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:jmp 'pfix-pbig-done) retry-not-size1 (:compile-form (:result-mode :eax) y) @@ -188,7 +188,7 @@ (:edi (:edi-offset atomically-status)))) (:leal ((:ecx 1) ,(* 2 movitz:+movitz-fixnum-factor+)) :eax) ; Number of words - (:call-global-constant get-cons-pointer) + (:call-local-pf get-cons-pointer) (:load-lexical (:lexical-binding y) :ebx) ; bignum (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) @@ -219,7 +219,7 @@ (:addl #x40000 (:eax ,movitz:+other-type-offset+)) (:addl ,movitz:+movitz-fixnum-factor+ :ecx) no-expansion - (:call-global-constant cons-commit) + (:call-local-pf cons-commit) (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status)))) @@ -241,7 +241,7 @@ (:compile-form (:result-mode :ecx) x) (:sarl ,movitz:+movitz-fixnum-shift+ :ecx) (:addl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:jmp 'pfix-pbig-done) retry-not-size1 (:compile-form (:result-mode :eax) y) @@ -254,7 +254,7 @@ (:edi (:edi-offset atomically-status)))) (:leal ((:ecx 1) ,(* 1 movitz:+movitz-fixnum-factor+)) :eax) ; Number of words - (:call-global-constant get-cons-pointer) + (:call-local-pf get-cons-pointer) (:load-lexical (:lexical-binding y) :ebx) ; bignum (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) @@ -285,7 +285,7 @@ (:subl #x40000 (:eax ,movitz:+other-type-offset+)) (:subl ,movitz:+movitz-fixnum-factor+ :ecx) no-expansion - (:call-global-constant cons-commit) + (:call-local-pf cons-commit) (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status)))) @@ -310,7 +310,7 @@ (:movl (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx) (:addl (:eax ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :ecx) (:jc 'retry-not-size1) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:jmp 'pfix-pbig-done) retry-not-size1 (:compile-form (:result-mode :eax) y) @@ -323,7 +323,7 @@ (:edi (:edi-offset atomically-status)))) (:leal ((:ecx 1) ,(* 2 movitz:+movitz-fixnum-factor+)) :eax) ; Number of words - (:call-global-constant get-cons-pointer) + (:call-local-pf get-cons-pointer) (:load-lexical (:lexical-binding y) :ebx) ; bignum (:movzxw (:ebx ,(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) @@ -374,7 +374,7 @@ (:addl #x40000 (:eax ,movitz:+other-type-offset+)) (:addl ,movitz:+movitz-fixnum-factor+ :ecx) no-expansion - (:call-global-constant cons-commit) + (:call-local-pf cons-commit) (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status)))) pfix-pbig-done) @@ -842,16 +842,16 @@ (check-type n1 (signed-byte 30)) `(with-inline-assembly (:returns ,,condition :side-effects nil) (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-constant fast-compare-fixnum-real)))) + (:call-global-pf fast-compare-fixnum-real)))) ((movitz:movitz-constantp n2) (let ((n2 (movitz::movitz-eval n2))) (check-type n2 (signed-byte 30)) `(with-inline-assembly (:returns ,,condition :side-effects nil) (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-constant fast-compare-real-fixnum)))) + (:call-global-pf fast-compare-real-fixnum)))) (t `(with-inline-assembly (:returns ,,condition :side-effects nil) (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-constant fast-compare-two-reals)))))) + (:call-global-pf fast-compare-two-reals)))))) (defun ,2op-name (n1 n2) (,2op-name n1 n2)) @@ -917,7 +917,7 @@ (define-compiler-macro =%2op (n1 n2 &environment env) (cond ((movitz:movitz-constantp n1 env) - (let ((n1 (movitz::movitz-eval n1 env))) + (let ((n1 (movitz:movitz-eval n1 env))) (etypecase n1 ((eql 0) `(do-result-mode-case () @@ -931,16 +931,16 @@ ((signed-byte 30) `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil) (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-constant fast-compare-fixnum-real)))))) + (:call-global-pf fast-compare-fixnum-real))) + (integer + `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-two-reals)))))) ((movitz:movitz-constantp n2 env) - (let ((n2 (movitz::movitz-eval n2 env))) - (check-type n2 (signed-byte 30)) - `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-constant fast-compare-real-fixnum)))) + `(=%2op ,n2 ,n1)) (t `(with-inline-assembly (:returns :boolean-zf=1 :side-effects nil) (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-constant fast-compare-two-reals))))) + (:call-global-pf fast-compare-two-reals))))) (define-number-relational = =%2op nil :defun-p nil) @@ -1191,7 +1191,7 @@ (:store-lexical (:lexical-binding d0) :eax :type fixnum) (:store-lexical (:lexical-binding d1) :edx :type fixnum) (:compile-form (:result-mode :eax) - (malloc-data-words 3)) + (malloc-non-pointer-words 3)) (:movl ,(dpb (* 2 movitz:+movitz-fixnum-factor+) (byte 16 16) (movitz:tag :bignum 0)) (:eax ,movitz:+other-type-offset+)) @@ -1219,7 +1219,7 @@ (:shrdl ,movitz::+movitz-fixnum-shift+ :edx :ecx) (:movl :edi :edx) (:cld) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:jmp 'fixnum-done) u32-negative-result @@ -1228,7 +1228,7 @@ (:movl :edi :edx) (:cld) (:negl :ecx) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:xorl #xff00 (:eax ,movitz:+other-type-offset+)) (:jmp 'fixnum-done) @@ -1255,7 +1255,7 @@ :ecx) (:leal ((:ecx 1) ,(* 2 movitz:+movitz-fixnum-factor+)) :eax) - (:call-global-constant get-cons-pointer) ; New bignum into EAX + (:call-local-pf get-cons-pointer) ; New bignum into EAX (:load-lexical (:lexical-binding y) :ebx) ; bignum (:movl (:ebx ,movitz:+other-type-offset+) :ecx) @@ -1301,7 +1301,7 @@ (:cld) ; EAX, EDX, and ESI are GC roots again. (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :ecx) - (:call-global-constant cons-commit) + (:call-local-pf cons-commit) (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status)))) (:compile-form (:result-mode :ebx) x) @@ -1373,7 +1373,7 @@ (:movl :edi :eax) (:cld) (:pushl :edx) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:popl :ebx) (:jmp 'done) not-size1 @@ -1388,7 +1388,7 @@ (:edi (:edi-offset atomically-status)))) (:leal ((:ecx 1) 4) :eax) ; Number of words - (:call-global-constant get-cons-pointer) ; New bignum into EAX + (:call-local-pf get-cons-pointer) ; New bignum into EAX (:store-lexical (:lexical-binding r) :eax :type bignum) @@ -1440,7 +1440,7 @@ (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) (:jmp 'fixnum-result) ; don't commit the bignum no-more-shrinkage - (:call-global-constant cons-commit) + (:call-local-pf cons-commit) fixnum-result (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status)))) @@ -1639,14 +1639,14 @@ ((positive-bignum positive-fixnum) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) x) - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) (:compile-form (:result-mode :eax) y) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :ecx) (:andl :ecx :eax))) ((positive-fixnum positive-bignum) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) y) - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) (:compile-form (:result-mode :eax) x) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :ecx) (:andl :ecx :eax))) @@ -1681,7 +1681,7 @@ ((t positive-fixnum) (with-inline-assembly (:returns :eax :type fixnum) (:compile-form (:result-mode :eax) integer1) - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) (:shll ,movitz:+movitz-fixnum-shift+ :ecx) (:compile-form (:result-mode :eax) integer2) (:notl :ecx) @@ -1896,7 +1896,7 @@ (:locally (:movl '(:funcall ,(movitz::atomically-status-jumper-fn t :esp) 'retry-jumper-ones-expanded-bignum) (:edi (:edi-offset atomically-status)))) - (:call-global-constant get-cons-pointer) + (:call-local-pf get-cons-pointer) (:shll 16 :ecx) (:addl ,(dpb 1 (byte 16 16) (movitz:tag :bignum 0)) :ecx) ; add 1 for index->size (:movl :ecx (:eax ,movitz:+other-type-offset+)) @@ -1904,7 +1904,7 @@ (:leal ((:ecx ,movitz:+movitz-fixnum-factor+) ,(* 1 movitz:+movitz-fixnum-factor+)) ; add 1 for header. :ecx) - (:call-global-constant cons-commit) + (:call-local-pf cons-commit) (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status)))) ;; Have fresh bignum in EAX, now fill it with ones. @@ -2013,7 +2013,7 @@ (:movl :ebx :eax) (:jmp 'done-u32) cant-return-same - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) done-u32 ))) (do-it))) @@ -2097,7 +2097,7 @@ ;; Now add 1 for index->size, 1 for header, and 1 for tmp storage before shift. (:addl ,(* 3 movitz:+movitz-fixnum-factor+) :eax) (:pushl :eax) - (:call-global-constant get-cons-pointer) + (:call-local-pf get-cons-pointer) ;; (:store-lexical (:lexical-binding r) :eax :type t) (:popl :ecx) (:subl ,(* 2 movitz:+movitz-fixnum-factor+) :ecx) ; for tmp storage and header. @@ -2200,7 +2200,7 @@ (:movl :ebx :eax) (:leal ((:ecx 1) ,movitz:+movitz-fixnum-factor+) :ecx) - (:call-global-constant cons-commit) + (:call-local-pf cons-commit) return-fixnum (:locally (:movl ,(bt:enum-value 'movitz::atomically-status :inactive) (:edi (:edi-offset atomically-status)))) @@ -2231,7 +2231,7 @@ `(with-inline-assembly (:returns :register :type ,result-type) (:compile-form (:result-mode :eax) ,integer) - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) (:andl ,(mask-field (byte size position) -1) :ecx) ,@(unless (zerop position) `((:shrl ,position :ecx))) @@ -2263,15 +2263,15 @@ (:jz 'done) (:andl ,(mask-field (byte size 0) -1) :ecx) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) (:jmp 'done)))) nix - (:call-global-constant unbox-u32) + (:call-global-pf unbox-u32) ,@(unless (= 32 (- size position)) `((:andl ,(mask-field (byte size position) -1) :ecx))) ,@(unless (zerop position) `((:shrl ,position :ecx))) - (:call-global-constant box-u32-ecx) + (:call-local-pf box-u32-ecx) done))) (t form)))) (t form)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.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-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(a)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)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/functions.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-serv24621 Modified Files: functions.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:59 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.15 movitz/losp/muerte/functions.lisp:1.16 --- movitz/losp/muerte/functions.lisp:1.15 Tue Jul 13 15:41:48 2004 +++ movitz/losp/muerte/functions.lisp Thu Jul 15 14:06:59 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.15 2004/07/13 22:41:48 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.16 2004/07/15 21:06:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -351,8 +351,8 @@ (make-array (length code-vector) :element-type 'code :initial-contents code-vector)))) - (let ((funobj (malloc-words (+ #.(cl:truncate (bt:sizeof 'movitz:movitz-funobj) 4) - (length constants))))) + (let ((funobj (malloc-pointer-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 @@ -395,8 +395,8 @@ (defun copy-funobj (old-funobj &optional (name (funobj-name old-funobj))) (let* ((num-constants (funobj-num-constants old-funobj)) - (funobj (malloc-words (+ -2 #.(cl:truncate (bt:sizeof 'movitz:movitz-funobj) 4) - num-constants)))) + (funobj (malloc-pointer-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)

1 0

[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