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