diff --git a/assembly/alpha/arith.lisp b/assembly/alpha/arith.lisp index a17c269e8f42eb2768bef1e0b8247dd3dda031e4..e74ff21362a1e055b8689581af0917d831a4180f 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 044cd9d04ded40f428f7476f43e4728497c8ab2c..2e73dfccb4297a9dd2d4926e0c8adb9b5e643e6d 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))