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

Modified Files: los0-gc.lisp Log Message: Added a handler for the out-of-memory exception to automatically call stop-and-copy. So now the GC architecture should in principle be complete!

Date: Tue Apr 6 20:45:54 2004 Author: ffjeld

Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.4 movitz/losp/los0-gc.lisp:1.5 --- movitz/losp/los0-gc.lisp:1.4 Tue Apr 6 19:47:26 2004 +++ movitz/losp/los0-gc.lisp Tue Apr 6 20:45:54 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.4 2004/04/06 23:47:26 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.5 2004/04/07 00:45:54 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -57,10 +57,13 @@ (define-primitive-function new-fast-cons () "Allocate a cons cell from nursery-space." (with-inline-assembly (:returns :eax) + retry-cons (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) (:movl (:edx 2) :ecx) (:cmpl #x3fff4 :ecx) - (:jge '(:sub-program () (:int 112))) + (:jge '(:sub-program () + (:int 112) + (:jmp 'retry-cons))) (:movl :eax (:edx :ecx 2)) (:movl :ebx (:edx :ecx 6)) (:leal (:edx :ecx 3) :eax) @@ -92,6 +95,11 @@ (:jb 'init-loop) (:movl #.(movitz:tag :infant-object) (:ebx -2))))

+(defun los0-handle-out-of-memory (exception interrupt-frame) + (declare (ignore exception interrupt-frame)) + (format t "~&;; Handling out-of-memory exception..") + (stop-and-copy)) + (defun install-los0-consing () (setf (%run-time-context-slot 'nursery-space) (allocate-duo-space)) @@ -104,6 +112,7 @@ (symbol-function 'new-malloc-clumps)) (setf (symbol-function 'new-malloc-clumps) old-malloc)) + (setf (interrupt-handler 112) 'los0-handle-out-of-memory) (values))

(defun install-old-consing ()