From fe8050ac8d53e2bb06722881251b67e59104a584 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Wed, 5 Aug 1998 09:03:41 +0000
Subject: [PATCH] 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.

---
 assembly/alpha/arith.lisp | 17 ++++++++++++-----
 assembly/mips/arith.lisp  | 29 ++++++++++++++++++++++++++---
 2 files changed, 38 insertions(+), 8 deletions(-)

diff --git a/assembly/alpha/arith.lisp b/assembly/alpha/arith.lisp
index a17c269e8..e74ff2136 100644
--- a/assembly/alpha/arith.lisp
+++ b/assembly/alpha/arith.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (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 @@
   (inst xor temp hi temp)
   (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 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
+  ;; Allocate two words.
   (pseudo-atomic (:extra (pad-data-block (+ 2 bignum-digits-offset)))
     (inst bis alloc-tn other-pointer-type res)
     (storew temp2 res 0 other-pointer-type))
-
+  ;; Store two words.
   (storew lo res bignum-digits-offset other-pointer-type)
   (storew hi res (1+ bignum-digits-offset) other-pointer-type)
-
   ;; Out of here
   (lisp-return lra lip :offset 2)
 
diff --git a/assembly/mips/arith.lisp b/assembly/mips/arith.lisp
index 044cd9d04..2e73dfccb 100644
--- a/assembly/mips/arith.lisp
+++ b/assembly/mips/arith.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (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 @@
   (inst sra temp lo 31)
   (inst xor temp hi)
   (inst bne temp two-words)
+  ;; Assume a two word header.
   (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 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
   #-gengc
@@ -173,6 +195,7 @@
   #-gengc
   (lisp-return lra lip :offset 2)
 
+
   DO-STATIC-FUN
   (inst lw lip null-tn (static-function-offset 'two-arg-*))
   (inst li nargs (fixnum 2))
-- 
GitLab