Skip to content
Snippets Groups Projects
Commit dd5d189d authored by wlott's avatar wlott
Browse files

Added explicit gc-trigger test.

parent febc3817
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; 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. ;;; Stuff to handle allocating simple objects.
;;; ;;;
...@@ -65,7 +65,7 @@ ...@@ -65,7 +65,7 @@
,@(when (or need-unbound-marker header variable-length) ,@(when (or need-unbound-marker header variable-length)
'((:temp temp non-descriptor-reg ocfp-offset))) '((:temp temp non-descriptor-reg ocfp-offset)))
(:res result descriptor-reg a0-offset)) (:res result descriptor-reg a0-offset))
(pseudo-atomic (alloc) (pseudo-atomic (temp)
(load-symbol-value alloc *allocation-pointer*) (load-symbol-value alloc *allocation-pointer*)
(inst cal result alloc ,lowtag) (inst cal result alloc ,lowtag)
,@(cond ((and header variable-length) ,@(cond ((and header variable-length)
...@@ -91,4 +91,6 @@ ...@@ -91,4 +91,6 @@
,@(when need-unbound-marker ,@(when need-unbound-marker
`((inst li temp unbound-marker-type))) `((inst li temp unbound-marker-type)))
,@(init-forms) ,@(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))))))
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; 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. ;;; Stuff to handle simple cases for generic arithmetic.
;;; ;;;
...@@ -205,6 +205,8 @@ ...@@ -205,6 +205,8 @@
(store-symbol-value alloc *allocation-pointer*) (store-symbol-value alloc *allocation-pointer*)
(storew temp res 0 other-pointer-type) (storew temp res 0 other-pointer-type)
(storew ocfp/low res bignum-digits-offset 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 ;; Out of here
(lisp-return lra lip :offset 1) (lisp-return lra lip :offset 1)
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; 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. ;;; This file contains the support routines for arrays and vectors.
;;; ;;;
...@@ -44,6 +44,8 @@ ...@@ -44,6 +44,8 @@
(storew ndescr vector 0 vm:other-pointer-type) (storew ndescr vector 0 vm:other-pointer-type)
(storew length vector vm:vector-length-slot vm:other-pointer-type) (storew length vector vm:vector-length-slot vm:other-pointer-type)
(store-symbol-value alloc *allocation-pointer*)) (store-symbol-value alloc *allocation-pointer*))
(load-symbol-value ndescr *internal-gc-trigger*)
(inst tlt ndescr alloc)
(move result vector)) (move result vector))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment