From dd5d189df79646a813ff85b8b9122c86823f3436 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Tue, 22 Oct 1991 16:50:36 +0000 Subject: [PATCH] Added explicit gc-trigger test. --- assembly/rt/alloc.lisp | 8 +++++--- assembly/rt/arith.lisp | 4 +++- assembly/rt/array.lisp | 4 +++- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/assembly/rt/alloc.lisp b/assembly/rt/alloc.lisp index cf4c0a3b0..b62ce1d47 100644 --- a/assembly/rt/alloc.lisp +++ b/assembly/rt/alloc.lisp @@ -7,7 +7,7 @@ ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/alloc.lisp,v 1.3 1991/04/11 14:49:44 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/alloc.lisp,v 1.4 1991/10/22 16:50:28 wlott Exp $ ;;; ;;; Stuff to handle allocating simple objects. ;;; @@ -65,7 +65,7 @@ ,@(when (or need-unbound-marker header variable-length) '((:temp temp non-descriptor-reg ocfp-offset))) (:res result descriptor-reg a0-offset)) - (pseudo-atomic (alloc) + (pseudo-atomic (temp) (load-symbol-value alloc *allocation-pointer*) (inst cal result alloc ,lowtag) ,@(cond ((and header variable-length) @@ -91,4 +91,6 @@ ,@(when need-unbound-marker `((inst li temp unbound-marker-type))) ,@(init-forms) - (store-symbol-value alloc *allocation-pointer*))))))) + (store-symbol-value alloc *allocation-pointer*)) + (load-symbol-value temp *internal-gc-trigger*) + (inst tlt temp alloc)))))) diff --git a/assembly/rt/arith.lisp b/assembly/rt/arith.lisp index 1e470638e..b5bf9b007 100644 --- a/assembly/rt/arith.lisp +++ b/assembly/rt/arith.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/arith.lisp,v 1.4 1991/05/15 09:59:18 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/arith.lisp,v 1.5 1991/10/22 16:50:34 wlott Exp $ ;;; ;;; Stuff to handle simple cases for generic arithmetic. ;;; @@ -205,6 +205,8 @@ (store-symbol-value alloc *allocation-pointer*) (storew temp res 0 other-pointer-type) (storew ocfp/low res bignum-digits-offset other-pointer-type))) + (load-symbol-value temp *internal-gc-trigger*) + (inst tlt temp ocfp/low) ;; Out of here (lisp-return lra lip :offset 1) diff --git a/assembly/rt/array.lisp b/assembly/rt/array.lisp index 7cc07e88a..da95439f0 100644 --- a/assembly/rt/array.lisp +++ b/assembly/rt/array.lisp @@ -7,7 +7,7 @@ ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/array.lisp,v 1.3 1991/04/09 16:57:34 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/array.lisp,v 1.4 1991/10/22 16:50:36 wlott Exp $ ;;; ;;; This file contains the support routines for arrays and vectors. ;;; @@ -44,6 +44,8 @@ (storew ndescr vector 0 vm:other-pointer-type) (storew length vector vm:vector-length-slot vm:other-pointer-type) (store-symbol-value alloc *allocation-pointer*)) + (load-symbol-value ndescr *internal-gc-trigger*) + (inst tlt ndescr alloc) (move result vector)) -- GitLab