movitz-cvs April 2004

movitz-cvs@common-lisp.net

1 participants
210 discussions

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv28476 Modified Files: los0-gc.lisp Log Message: Added los0-malloc-data-clumps, so that the los0 GC architecture now don't initialize non-pointer memory. Date: Fri Apr 16 10:44:42 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.9 movitz/losp/los0-gc.lisp:1.10 --- movitz/losp/los0-gc.lisp:1.9 Thu Apr 15 11:23:31 2004 +++ movitz/losp/los0-gc.lisp Fri Apr 16 10:44:42 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.9 2004/04/15 15:23:31 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.10 2004/04/16 14:44:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -54,7 +54,7 @@ (defun space-cons-pointer () (aref (%run-time-context-slot 'nursery-space) 0)) -(define-primitive-function new-fast-cons () +(define-primitive-function los0-fast-cons () "Allocate a cons cell from nursery-space." (with-inline-assembly (:returns :eax) retry-cons @@ -72,29 +72,46 @@ (:movl :ecx (:edx 2)) (:ret))) -(defun new-malloc-clumps (clumps) - (check-type clumps (integer 0 1000)) - (with-inline-assembly (:returns :ebx) +(defun los0-malloc-clumps (clumps) + (check-type clumps (integer 0 4000)) + (with-inline-assembly (:returns :eax) retry - (:compile-form (:result-mode :eax) clumps) + (:compile-form (:result-mode :ebx) clumps) (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) (:movl (:edx 2) :ecx) - (:leal (:edx :ecx 8) :ebx) - (:leal ((:eax 2) :ecx) :ecx) - (:cmpl #x3fff4 :ecx) + (:leal ((:ebx 2) :ecx) :eax) + (:cmpl #x3fff4 :eax) (:jge '(:sub-program () (:compile-form (:result-mode :ignore) (stop-and-copy)) (:jmp 'retry))) - (:movl :ecx (:edx 2)) + (:movl :eax (:edx 2)) + (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) + (:leal (:edx :ecx 8) :eax) (:xorl :ecx :ecx) init-loop ; Now init eax number of clumps. - (:movl :edi (:ebx (:ecx 2) -6)) - (:movl :edi (:ebx (:ecx 2) -2)) + (:movl :edi (:eax (:ecx 2) -6)) + (:movl :edi (:eax (:ecx 2) -2)) (:addl 4 :ecx) - (:cmpl :eax :ecx) - (:jb 'init-loop) - (:movl #.(movitz:tag :infant-object) (:ebx -2)))) + (:cmpl :ebx :ecx) + (:jb 'init-loop))) + +(defun los0-malloc-data-clumps (clumps) + (check-type clumps (integer 0 4000)) + (with-inline-assembly (:returns :eax) + retry + (:compile-form (:result-mode :ebx) clumps) + (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) + (:movl (:edx 2) :ecx) + (:leal ((:ebx 2) :ecx) :eax) + (:cmpl #x3fff4 :eax) + (:jge '(:sub-program () + (:compile-form (:result-mode :ignore) + (stop-and-copy)) + (:jmp 'retry))) + (:movl :eax (:edx 2)) + (:movl #.(movitz:tag :infant-object) (:edx :ecx 6)) + (:leal (:edx :ecx 8) :eax))) (defun los0-handle-out-of-memory (exception interrupt-frame) (declare (ignore exception interrupt-frame)) @@ -104,20 +121,25 @@ (defun install-los0-consing () (setf (%run-time-context-slot 'nursery-space) (allocate-duo-space)) - (let ((conser (symbol-value 'new-fast-cons))) + (setf (exception-handler 113) + (lambda (exception interrupt-frame) + (declare (ignore exception interrupt-frame)) + (format t "~&;; Handling out-of-memory exception..") + (stop-and-copy))) + (let ((conser (symbol-value 'los0-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 'new-malloc-clumps)) - (setf (symbol-function 'new-malloc-clumps) + (symbol-function 'los0-malloc-clumps)) + (setf (symbol-function 'los0-malloc-clumps) old-malloc)) - (setf (exception-handler 113) - (lambda (exception interrupt-frame) - (declare (ignore exception interrupt-frame)) - (format t "~&;; Handling out-of-memory exception..") - (stop-and-copy))) + (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 () @@ -127,9 +149,14 @@ conser)) (let ((old-malloc (symbol-function 'muerte:malloc-clumps))) (setf (symbol-function 'muerte:malloc-clumps) - (symbol-function 'new-malloc-clumps)) - (setf (symbol-function 'new-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 object-in-space-p (space object)

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv8224 Modified Files: packages.lisp Log Message: Added symbol malloc-data-clumps. Date: Fri Apr 16 10:43:44 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.17 movitz/packages.lisp:1.18 --- movitz/packages.lisp:1.17 Thu Apr 15 15:56:59 2004 +++ movitz/packages.lisp Fri Apr 16 10:43:44 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.17 2004/04/15 19:56:59 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.18 2004/04/16 14:43:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1141,6 +1141,7 @@ #:map-heap-words #:map-stack-words #:malloc-clumps + #:malloc-data-clumps #:malloc-cons-pointer #:malloc-buffer-start

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2464 Modified Files: arrays.lisp Log Message: Allocate non-pointer memory for arrays specialized to (unsigned-byte 32). Date: Fri Apr 16 10:42:51 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.16 movitz/losp/muerte/arrays.lisp:1.17 --- movitz/losp/muerte/arrays.lisp:1.16 Wed Mar 31 21:09:58 2004 +++ movitz/losp/muerte/arrays.lisp Fri Apr 16 10:42:51 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.16 2004/04/01 02:09:58 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.17 2004/04/16 14:42:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -548,7 +548,7 @@ (replace array initial-contents))) array)) ((member element-type '(u32 (unsigned-byte 32)) :test #'equal) - (let ((array (malloc-words dimensions))) + (let ((array (malloc-data-words dimensions))) (setf (memref array #.(bt:slot-offset 'movitz::movitz-vector 'movitz::flags) 0 :unsigned-byte16) 0)

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9296 Modified Files: inspect.lisp Log Message: Added function malloc-data-words, and some minor edits. Date: Fri Apr 16 10:42:22 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.7 movitz/losp/muerte/inspect.lisp:1.8 --- movitz/losp/muerte/inspect.lisp:1.7 Wed Mar 31 21:11:48 2004 +++ movitz/losp/muerte/inspect.lisp Fri Apr 16 10:42:22 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.7 2004/04/01 02:11:48 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.8 2004/04/16 14:42:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -189,10 +189,9 @@ (structure-object (copy-structure old)))) -(defun malloc-words (words) - (malloc-clumps (1+ (truncate (1+ words) 2)))) - (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) @@ -204,8 +203,15 @@ x)) (defun malloc-data-clumps (clumps) - "Allocate clumps for non-pointer data (i.e. doesn't require initialization)." + "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) + (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?"

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3021 Modified Files: special-operators.lisp Log Message: Commented out warning thats not really supposed to be there. Date: Fri Apr 16 06:24:54 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.21 movitz/special-operators.lisp:1.22 --- movitz/special-operators.lisp:1.21 Thu Apr 15 09:06:18 2004 +++ movitz/special-operators.lisp Fri Apr 16 06:24:54 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.21 2004/04/15 13:06:18 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.22 2004/04/16 10:24:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -686,6 +686,7 @@ `((:cmpl :edi ,(single-value-register not-returns)))) :returns :boolean-zf=1)) ; TRUE iff result equal to :edi/NIL. (otherwise + #+ignore (warn "unable to deal intelligently with inlined-NOT not-returns: ~S for ~S from ~S" not-returns not-result-mode (not-values :producer)) (let ((label (make-symbol "not-label"))) @@ -716,7 +717,7 @@ result-mode (car sub-form-result-mode)) as last-form-p = (endp (cdr sub-form)) - ;; do (warn "progn rm: ~S" (car sub-form-result-mode)) + ;; do (warn "progn rm: ~S" (car sub-form-result-mode)) appending (compiler-values-bind (&code code &returns sub-returns-mode &functional-p no-sub-side-effects-p

1 0

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

16 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv5331 Modified Files: image.lisp Log Message: Fixed warning about multiboot header too far away. Date: Fri Apr 16 04:57:29 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.23 movitz/image.lisp:1.24 --- movitz/image.lisp:1.23 Thu Apr 15 09:04:51 2004 +++ movitz/image.lisp Fri Apr 16 04:57:29 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.23 2004/04/15 13:04:51 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.24 2004/04/16 08:57:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -890,7 +890,9 @@ (warn "Multiboot load-address #x~x is below the 1MB mark." load-address)) (when (> (+ mb-file-position (sizeof mb)) 8192) - (warn "Multiboot header at position ~D is above the 8KB mark.")) + (warn "Multiboot header at position ~D is above the 8KB mark, ~ +this image will not be Multiboot compatible." + (+ mb-file-position (sizeof mb)))) (assert (file-position stream mb-file-position) () "Couldn't set file-position for ~W to ~W." (pathname stream)

1 0

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

15 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv20313 Modified Files: compiler.lisp Log Message: Argh, don't ask. Date: Thu Apr 15 15:58:20 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.47 movitz/compiler.lisp:1.48 --- movitz/compiler.lisp:1.47 Thu Apr 15 06:45:05 2004 +++ movitz/compiler.lisp Thu Apr 15 15:58:20 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.47 2004/04/15 10:45:05 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.48 2004/04/15 19:58:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2701,8 +2701,7 @@ (truncate (or (position-if (lambda (i) (member b (find-read-bindings i))) - (cdr init-pc) - :end 10) + (cdr init-pc)) 15) count))))))))) ;; First, make several passes while trying to locate bindings

1 0

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

15 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv17453 Modified Files: debugger.lisp Log Message: Removed the defpackage form from debugger.lisp, moved the exported symbols to packages.lisp. Date: Thu Apr 15 15:57:11 2004 Author: ffjeld Index: movitz/losp/x86-pc/debugger.lisp diff -u movitz/losp/x86-pc/debugger.lisp:1.9 movitz/losp/x86-pc/debugger.lisp:1.10 --- movitz/losp/x86-pc/debugger.lisp:1.9 Thu Apr 15 11:23:53 2004 +++ movitz/losp/x86-pc/debugger.lisp Thu Apr 15 15:57:10 2004 @@ -10,28 +10,11 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 22 10:09:18 2002 ;;;; -;;;; $Id: debugger.lisp,v 1.9 2004/04/15 15:23:53 ffjeld Exp $ +;;;; $Id: debugger.lisp,v 1.10 2004/04/15 19:57:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ (provide :x86-pc/debugger) - -(defpackage muerte - ;; (:use #:muerte.cl #:muerte #:muerte.x86-pc) - (:export #:*debugger-function* - #:*debugger-condition* - #:*backtrace-conflate-names* - #:*backtrace-do-conflate* - #:*backtrace-max-frames* - #:*backtrace-max-args* - #:*backtrace-on-error* - #:*backtrace-stack-frame-barrier* - #:*backtrace-do-fresh-lines* - #:*backtrace-be-spartan-p* - #:*backtrace-print-length* - #:*backtrace-print-level* - #:backtrace - )) (in-package muerte)

1 0

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

15 Apr '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv17093 Modified Files: packages.lisp Log Message: Removed the defpackage form from debugger.lisp, moved the exported symbols to packages.lisp. Date: Thu Apr 15 15:56:59 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.16 movitz/packages.lisp:1.17 --- movitz/packages.lisp:1.16 Thu Apr 15 11:24:31 2004 +++ movitz/packages.lisp Thu Apr 15 15:56:59 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.16 2004/04/15 15:24:31 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.17 2004/04/15 19:56:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1103,6 +1103,20 @@ print-unreadable-movitz-object #:*print-safely* + + #:*debugger-function* + #:*debugger-condition* + #:*backtrace-conflate-names* + #:*backtrace-do-conflate* + #:*backtrace-max-frames* + #:*backtrace-max-args* + #:*backtrace-on-error* + #:*backtrace-stack-frame-barrier* + #:*backtrace-do-fresh-lines* + #:*backtrace-be-spartan-p* + #:*backtrace-print-length* + #:*backtrace-print-level* + #:backtrace #:stack-ref #:with-each-dynamic-context

1 0

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

15 Apr '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv16197 Modified Files: functions.lisp Log Message: movitz::constant0 is not exported. Date: Thu Apr 15 14:53:15 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.8 movitz/losp/muerte/functions.lisp:1.9 --- movitz/losp/muerte/functions.lisp:1.8 Wed Apr 14 08:25:27 2004 +++ movitz/losp/muerte/functions.lisp Thu Apr 15 14:53:15 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.8 2004/04/14 12:25:27 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.9 2004/04/15 18:53:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -272,7 +272,7 @@ (assert (below index (funobj-num-constants funobj)) (index) "Index ~D out of range, ~S has ~D constants." index funobj (funobj-num-constants funobj)) (if (>= index (funobj-num-jumpers funobj)) - (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0) index :lisp) + (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0) index :lisp) ;; For a jumper, return its offset relative to the code-vector. ;; This is tricky wrt. to potential GC interrupts, because we're doing ;; pointer arithmetics. @@ -281,7 +281,7 @@ (:movl #.movitz:+code-vector-transient-word+ :ebx) (:addl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector)) :ebx) ; code-vector (word) into ebx - (:subl (:eax :ecx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0)) + (:subl (:eax :ecx #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0)) :ebx) (:negl :ebx) (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :eax)))) @@ -291,7 +291,7 @@ (assert (below index (funobj-num-constants funobj)) (index) "Index ~D out of range, ~S has ~D constants." index funobj (funobj-num-constants funobj)) (if (>= index (funobj-num-jumpers funobj)) - (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0) + (setf (memref funobj #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0) index :lisp) value) (progn @@ -301,7 +301,7 @@ (progn ;; without-gc (with-inline-assembly (:returns :nothing) (:compile-two-forms (:eax :ecx) funobj index) - (:leal (:ecx :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:constant0)) + (:leal (:ecx :eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0)) :ebx) ; dest. address into ebx. (:compile-form (:result-mode :untagged-fixnum-ecx) value) (:addl (:eax #.(bt:slot-offset 'movitz:movitz-funobj 'movitz:code-vector))

1 0

← Newer
1
...
7
8
9
10
11
12
13
...
21
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 April 2004