Skip to content
Snippets Groups Projects
Commit fe8050ac authored by dtc's avatar dtc
Browse files

Fix a bignum allocation problem in generic-*. The high word was being

zeroed outside a pseudo-atomic and after the bignum header had been
set to just one word. When a GC occurred before the high word had been
zeroed, the first word of the next object was invalidly zeroed.
Problem spotted and fixed by Ken Olum.
parent 7fe1b6d0
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/alpha/arith.lisp,v 1.3 1997/06/26 16:57:25 pw Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/alpha/arith.lisp,v 1.4 1998/08/05 09:03:37 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -180,18 +180,25 @@ ...@@ -180,18 +180,25 @@
(inst xor temp hi temp) (inst xor temp hi temp)
(inst bne temp two-words) (inst bne temp two-words)
;; Only need one word, fix the header and zero the high-word. ;; Only need one word, fix the header.
(inst li (logior (ash 1 type-bits) bignum-type) temp2) (inst li (logior (ash 1 type-bits) bignum-type) temp2)
(inst li 0 hi) ;; Allocate one word.
(pseudo-atomic (:extra (pad-data-block (1+ bignum-digits-offset)))
(inst bis alloc-tn other-pointer-type res)
(storew temp2 res 0 other-pointer-type))
;; Store one word
(storew lo res bignum-digits-offset other-pointer-type)
;; Out of here
(lisp-return lra lip :offset 2)
TWO-WORDS TWO-WORDS
;; Allocate two words.
(pseudo-atomic (:extra (pad-data-block (+ 2 bignum-digits-offset))) (pseudo-atomic (:extra (pad-data-block (+ 2 bignum-digits-offset)))
(inst bis alloc-tn other-pointer-type res) (inst bis alloc-tn other-pointer-type res)
(storew temp2 res 0 other-pointer-type)) (storew temp2 res 0 other-pointer-type))
;; Store two words.
(storew lo res bignum-digits-offset other-pointer-type) (storew lo res bignum-digits-offset other-pointer-type)
(storew hi res (1+ bignum-digits-offset) other-pointer-type) (storew hi res (1+ bignum-digits-offset) other-pointer-type)
;; Out of here ;; Out of here
(lisp-return lra lip :offset 2) (lisp-return lra lip :offset 2)
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/arith.lisp,v 1.15 1997/10/25 16:31:44 pw Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/arith.lisp,v 1.16 1998/08/05 09:03:41 dtc Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -144,11 +144,33 @@ ...@@ -144,11 +144,33 @@
(inst sra temp lo 31) (inst sra temp lo 31)
(inst xor temp hi) (inst xor temp hi)
(inst bne temp two-words) (inst bne temp two-words)
;; Assume a two word header.
(inst li temp (logior (ash 2 type-bits) bignum-type)) (inst li temp (logior (ash 2 type-bits) bignum-type))
;; Only need one word, fix the header and zero the high-word. ;; Only need one word, fix the header.
(inst li temp (logior (ash 1 type-bits) bignum-type)) (inst li temp (logior (ash 1 type-bits) bignum-type))
(inst li hi 0)
#-gengc
(pseudo-atomic (pa-flag :extra (pad-data-block (+ 1 bignum-digits-offset)))
(inst or res alloc-tn other-pointer-type)
(storew temp res 0 other-pointer-type))
#+gengc
(without-scheduling ()
(inst or res alloc-tn other-pointer-type)
(storew temp alloc-tn)
(inst addu alloc-tn (pad-data-block (+ 1 bignum-digits-offset))))
(storew lo res bignum-digits-offset other-pointer-type)
;; Out of here
#+gengc
(progn
(inst addu lip ra (* 2 word-bytes))
(inst j lip)
(inst nop))
#-gengc
(lisp-return lra lip :offset 2)
TWO-WORDS TWO-WORDS
#-gengc #-gengc
...@@ -173,6 +195,7 @@ ...@@ -173,6 +195,7 @@
#-gengc #-gengc
(lisp-return lra lip :offset 2) (lisp-return lra lip :offset 2)
DO-STATIC-FUN DO-STATIC-FUN
(inst lw lip null-tn (static-function-offset 'two-arg-*)) (inst lw lip null-tn (static-function-offset 'two-arg-*))
(inst li nargs (fixnum 2)) (inst li nargs (fixnum 2))
......
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