movitz-cvs July 2004

movitz-cvs@common-lisp.net

2 participants
376 discussions

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

16 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27424 Modified Files: inspect.lisp Log Message: Added %make-bignum. Date: Thu Jul 15 17:02:03 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.21 movitz/losp/muerte/inspect.lisp:1.22 --- movitz/losp/muerte/inspect.lisp:1.21 Thu Jul 15 14:07:04 2004 +++ movitz/losp/muerte/inspect.lisp Thu Jul 15 17:02:03 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.21 2004/07/15 21:07:04 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.22 2004/07/16 00:02:03 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -306,6 +306,16 @@ (:movl :ecx (:eax :edx #.movitz:+other-type-offset+)) (:subl 4 :edx) (:jnc 'copy-bignum-loop)))) + +(defun %make-bignum (bigits) + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ecx) (malloc-non-pointer-words (1+ bigits)) bigits) + (:shll 16 :ecx) + (:orl ,(movitz:tag :bignum 0) :ecx) + (:movl :ecx (:eax ,movitz:+other-type-offset+))))) + (do-it))) (defun print-bignum (x) (check-type x bignum)

1 0

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

15 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv29726 Modified Files: memory.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:36 2004 Author: ffjeld Index: movitz/losp/x86-pc/memory.lisp diff -u movitz/losp/x86-pc/memory.lisp:1.3 movitz/losp/x86-pc/memory.lisp:1.4 --- movitz/losp/x86-pc/memory.lisp:1.3 Mon Jan 19 03:23:52 2004 +++ movitz/losp/x86-pc/memory.lisp Thu Jul 15 14:07:36 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Oct 11 16:32:11 2001 ;;;; -;;;; $Id: memory.lisp,v 1.3 2004/01/19 11:23:52 ffjeld Exp $ +;;;; $Id: memory.lisp,v 1.4 2004/07/15 21:07:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -20,6 +20,7 @@ (in-package muerte.x86-pc) (defun memory-size () + "Return memory size in megabytes." (let ((kilobyte-memsize (+ #x400 (prog1 @@ -30,4 +31,4 @@ (progn (setf (io-port #x70 :unsigned-byte8) #x17) (io-port #x71 :unsigned-byte8))))))) - (truncate kilobyte-memsize 1024))) + (values (truncate kilobyte-memsize 1024))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/symbols.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-serv29617 Modified Files: symbols.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:32 2004 Author: ffjeld Index: movitz/losp/muerte/symbols.lisp diff -u movitz/losp/muerte/symbols.lisp:1.16 movitz/losp/muerte/symbols.lisp:1.17 --- movitz/losp/muerte/symbols.lisp:1.16 Tue Jul 13 07:06:56 2004 +++ movitz/losp/muerte/symbols.lisp Thu Jul 15 14:07:32 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.16 2004/07/13 14:06:56 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.17 2004/07/15 21:07:32 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -28,14 +28,14 @@ (symbol (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) symbol) - (:call-global-constant dynamic-load))))) + (:call-local-pf dynamic-load))))) (defun %unbounded-symbol-value (symbol) "Return the symbol's value without checking if it's bound or not." (check-type symbol symbol) (with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) symbol) - (:call-global-constant dynamic-find-binding) + (:call-local-pf dynamic-find-binding) (:jnc 'no-local-binding) (:movl (:eax) :eax) (:jmp 'done) @@ -51,7 +51,7 @@ (with-inline-assembly (:returns :ebx) (:compile-form (:result-mode :eax) symbol) (:compile-form (:result-mode :ebx) value) - (:call-global-constant dynamic-store))))) + (:call-local-pf dynamic-store))))) (defun set (symbol value) (setf (symbol-value symbol) value)) @@ -147,7 +147,7 @@ (flags 0)) (eval-when (:compile-toplevel) (assert (= 1 (- (movitz:tag :symbol) (movitz:tag :other))))) - (let ((symbol (%word-offset (malloc-clumps 3) 1))) + (let ((symbol (%word-offset (malloc-pointer-words 6) 1))) (setf-movitz-accessor (symbol movitz-symbol package) package) (setf-movitz-accessor (symbol movitz-symbol name) name) (setf (memref symbol #.(bt:slot-offset 'movitz:movitz-symbol 'movitz::hash-key) @@ -170,7 +170,7 @@ (if (or (eq nil symbol) (not copy-properties)) (%create-symbol (symbol-name symbol)) - (let ((x (%word-offset (malloc-clumps 3) 1))) + (let ((x (%word-offset (malloc-pointer-words 6) 1))) (dotimes (i 6) (setf (memref x #.(cl:- (movitz:tag :symbol)) i :lisp) (memref symbol #.(cl:- (movitz:tag :symbol)) i :lisp)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.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-serv29355 Modified Files: run-time-context.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:27 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.8 movitz/losp/muerte/run-time-context.lisp:1.9 --- movitz/losp/muerte/run-time-context.lisp:1.8 Thu Jul 15 04:17:02 2004 +++ movitz/losp/muerte/run-time-context.lisp Thu Jul 15 14:07:27 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.8 2004/07/15 11:17:02 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.9 2004/07/15 21:07:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -132,8 +132,7 @@ (defun clone-run-time-context (&key (parent (current-run-time-context)) (name :anonymous)) (check-type parent run-time-context) - (let ((context (inline-malloc #.(bt:sizeof 'movitz::movitz-constant-block) - :other-tag :run-time-context))) + (let ((context (malloc-pointer-words #.(cl:truncate (bt:sizeof 'movitz::movitz-constant-block) 4)))) (memcopy context parent -6 0 0 #.(bt:sizeof 'movitz::movitz-constant-block) :unsigned-byte8) (setf (%run-time-context-slot 'name context) name

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/primitive-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-serv28224 Modified Files: primitive-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:07:22 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.28 movitz/losp/muerte/primitive-functions.lisp:1.29 --- movitz/losp/muerte/primitive-functions.lisp:1.28 Thu Jul 15 04:18:49 2004 +++ movitz/losp/muerte/primitive-functions.lisp Thu Jul 15 14:07:22 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.28 2004/07/15 11:18:49 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.29 2004/07/15 21:07:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -420,10 +420,12 @@ (:movl :edi (:esp 4)) ; terminate list (:jmp :ebx))) ; return -(define-primitive-function malloc () - "Stupid allocator.. Number of bytes in EBX. Result in EAX." +(define-primitive-function malloc-pointer-words () + "Stupid allocator.. Number of words in EAX/fixnum. +Result in EAX, with tag :other." (with-inline-assembly (:returns :multiple-values) - (:locally (:movl (:edi (:edi-offset malloc-buffer)) :eax)) + (:movl :eax :ebx) + (:locally (:movl (:edi (:edi-offset nursery-space)) :eax)) (:testb #xff :al) (:jnz '(:sub-program (not-initialized) (:int 110) @@ -440,9 +442,52 @@ (:halt) (:jmp 'failed))) (:movl :edx (:eax 4)) ; new cons pointer - (:leal (:eax :ecx) :eax) + (:leal (:eax :ecx 6) :eax) (:ret))) +(define-primitive-function malloc-non-pointer-words () + "Stupid allocator.. Number of words in EAX/fixnum. +Result in EAX, with tag 6." + (with-inline-assembly (:returns :multiple-values) + (:movl :eax :ebx) + (:locally (:movl (:edi (:edi-offset nursery-space)) :eax)) + (:testb #xff :al) + (:jnz '(:sub-program (not-initialized) + (:int 110) + (:halt) + (:jmp 'not-initialized))) + (:addl 7 :ebx) + (:andb #xf8 :bl) + (:movl (:eax 4) :ecx) ; cons pointer to ECX + (:leal (:ebx :ecx) :edx) ; new roof to EDX + (:cmpl :edx (:eax)) ; end of buffer? + (:jl '(:sub-program (failed) + (:movl (:eax) :esi) + (:int 112) + (:halt) + (:jmp 'failed))) + (:movl :edx (:eax 4)) ; new cons pointer + (:leal (:eax :ecx 6) :eax) + (:ret))) + +(define-compiler-macro malloc-pointer-words (words) + `(with-inline-assembly (:returns :eax :type pointer) + (:compile-form (:result-mode :eax) ,words) + (:call-local-pf malloc-pointer-words))) + +(defun malloc-pointer-words (words) + (check-type words (integer 2 *)) + (malloc-pointer-words words)) + +(define-compiler-macro malloc-non-pointer-words (words) + `(with-inline-assembly (:returns :eax :type pointer) + (:compile-form (:result-mode :eax) ,words) + (:call-local-pf malloc-non-pointer-words))) + +(defun malloc-non-pointer-words (words) + (check-type words (integer 2 *)) + (malloc-non-pointer-words words)) + (define-primitive-function muerte::get-cons-pointer () "Return in EAX the next object location with space for EAX words, with tag 6. Preserve ECX." @@ -452,16 +497,8 @@ ;; is never comitted. `(with-inline-assembly (:returns :multiple-values) (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) - (:movl :eax :ebx) - (:call-global-constant malloc) + (:call-local-pf malloc-pointer-words) (:locally (:movl (:edi (:edi-offset scratch0)) :ecx)) - (:leal (:eax 6) :eax) - (:ret)) - #+ignore - `(with-inline-assembly (:returns :multiple-values) - (:locally (:movl (:edi (:edi-offset malloc-buffer)) :eax)) - (:movl (:eax 4) :ecx) ; cons pointer to ECX - (:leal (:eax :ecx 6) :eax) (:ret)))) (do-it))) @@ -471,36 +508,26 @@ (macrolet ((do-it () ;; Since get-cons-pointer is implemented as an (already committed) - ;; malloc, this is a NOP - `(with-inline-assembly (:returns :multiple-values) - (:ret)) - #+ignore + ;; malloc, this is a no-op. `(with-inline-assembly (:returns :multiple-values) - (:pushl :eax) - (:pushl :ebx) - (:movl :ecx :ebx) - (:call-global-constant malloc) - (:popl :ebx) - (:popl :eax) (:ret)))) (do-it))) (defun malloc-initialize (buffer-start buffer-size) - "BUFFER-START: the (fixnum) 4K address. BUFFER-SIZE: The size in 4K units." + "BUFFER-START is the location from which to allocate. +BUFFER-SIZE is the number of words in the buffer." (check-type buffer-start fixnum) (check-type buffer-size fixnum) (with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :eax) buffer-start) - (:shll #.(cl:- 12 movitz::+movitz-fixnum-shift+) :eax) - (:locally (:movl :eax (:edi (:edi-offset malloc-buffer)))) + (:locally (:movl :eax (:edi (:edi-offset nursery-space)))) (:compile-form (:result-mode :ebx) buffer-size) - (:shll #.(cl:- 12 movitz::+movitz-fixnum-shift+) :ebx) (:movl :ebx (:eax)) ; roof pointern (:movl 16 (:eax 4)))) ; cons pointer (defun malloc-buffer-start () (with-inline-assembly (:returns :eax) - (:locally (:movl (:edi (:edi-offset malloc-buffer)) :eax)) + (:locally (:movl (:edi (:edi-offset nursery-space)) :eax)) (:testb 7 :al) (:jnz '(:sub-program () (:int 107))))) @@ -508,7 +535,7 @@ (defun malloc-cons-pointer () "Return current cons-pointer in 8-byte units since buffer-start." (with-inline-assembly (:returns :eax) - (:locally (:movl (:edi (:edi-offset malloc-buffer)) :eax)) + (:locally (:movl (:edi (:edi-offset nursery-space)) :eax)) (:movl (:eax 4) :eax) (:testb 7 :al) (:jnz '(:sub-program () @@ -524,7 +551,7 @@ "Allocate a cons cell. Call with car in eax and cdr in ebx." (with-inline-assembly (:returns :multiple-values) (:xchgl :eax :ecx) - (:locally (:movl (:edi (:edi-offset malloc-buffer)) :eax)) + (:locally (:movl (:edi (:edi-offset nursery-space)) :eax)) (:movl (:eax 4) :edx) (:addl 8 :edx) (:cmpl :edx (:eax)) @@ -570,14 +597,14 @@ (:ret) not-fixnum (:locally (:movl :ecx (:edi (:edi-offset scratch0)))) ; Save value for later - (:call-global-constant malloc) + (:movl ,(* 2 movitz:+movitz-fixnum-factor+) :eax) + (:call-local-pf malloc-non-pointer-words) (:movl ,(dpb movitz:+movitz-fixnum-factor+ (byte 16 16) (movitz:tag :bignum 0)) - (:eax)) + (:eax ,movitz:+other-type-offset+)) (:locally (:movl (:edi (:edi-offset scratch0)) :ecx)) ; Restore value - (:movl :ecx (:eax 4)) - (:leal (:eax 6) :eax) + (:movl :ecx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) (:ret)))) (do-it)))

1 0

[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

← Newer
1
...
19
20
21
22
23
24
25
...
38
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs July 2004