From b812f3bf477f19fc82471911bb23e205edde9c88 Mon Sep 17 00:00:00 2001
From: wlott <wlott>
Date: Tue, 28 Jul 1992 20:42:50 +0000
Subject: [PATCH] changed for new pseudo-atomic.

---
 assembly/mips/arith.lisp | 37 +++++++++++++++++-----------------
 assembly/mips/array.lisp | 43 ++++++++++++++++++++++------------------
 2 files changed, 42 insertions(+), 38 deletions(-)

diff --git a/assembly/mips/arith.lisp b/assembly/mips/arith.lisp
index 86f75dddd..ce1d09d24 100644
--- a/assembly/mips/arith.lisp
+++ b/assembly/mips/arith.lisp
@@ -1,13 +1,15 @@
 ;;; -*- Package: MIPS -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
-;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/arith.lisp,v 1.11 1992/07/28 20:42:28 wlott Exp $")
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/arith.lisp,v 1.10 1992/03/08 18:35:13 wlott Exp $
+;;; **********************************************************************
 ;;;
 ;;; Stuff to handle simple cases for generic arithmetic.
 ;;;
@@ -95,6 +97,7 @@
 			  (:temp temp non-descriptor-reg nl0-offset)
 			  (:temp lo non-descriptor-reg nl1-offset)
 			  (:temp hi non-descriptor-reg nl2-offset)
+			  (:temp pa-flag non-descriptor-reg nl4-offset)
 			  (:temp lip interior-reg lip-offset)
 			  (:temp lra descriptor-reg lra-offset)
 			  (:temp nargs any-reg nargs-offset)
@@ -124,24 +127,20 @@
   (inst or lo temp)
   (inst sra hi 2)
   ;; Allocate a BIGNUM for the result.
-  (pseudo-atomic (temp)
+  (pseudo-atomic (pa-flag :extra (pad-data-block (+ 2 bignum-digits-offset)))
     (let ((one-word (gen-label)))
-      (inst addu res alloc-tn vm:other-pointer-type)
-      ;; Assume we need one word.
-      (inst addu alloc-tn (vm:pad-data-block (1+ vm:bignum-digits-offset)))
-      ;; Is that correct?
+      (inst or res alloc-tn other-pointer-type)
+      ;; Do we need one word or two?
       (inst sra temp lo 31)
       (inst xor temp hi)
       (inst beq temp one-word)
-      (inst li temp (logior (ash 1 vm:type-bits) vm:bignum-type))
-      ;; Nope, we need two, so allocate the addition space.
-      (inst addu alloc-tn (- (vm:pad-data-block (+ 2 vm:bignum-digits-offset))
-			     (vm:pad-data-block (1+ vm:bignum-digits-offset))))
-      (inst li temp (logior (ash 2 vm:type-bits) vm:bignum-type))
-      (storew hi res (1+ vm:bignum-digits-offset) vm:other-pointer-type)
+      (inst li temp (logior (ash 1 type-bits) bignum-type))
+      ;; Nope, we need two.
+      (inst li temp (logior (ash 2 type-bits) bignum-type))
+      (storew hi res (1+ bignum-digits-offset) other-pointer-type)
       (emit-label one-word)
-      (storew temp res 0 vm:other-pointer-type)
-      (storew lo res vm:bignum-digits-offset vm:other-pointer-type)))
+      (storew temp res 0 other-pointer-type)
+      (storew lo res bignum-digits-offset other-pointer-type)))
   ;; Out of here
   (lisp-return lra lip :offset 2)
 
diff --git a/assembly/mips/array.lisp b/assembly/mips/array.lisp
index c8e4b4767..3e159ce58 100644
--- a/assembly/mips/array.lisp
+++ b/assembly/mips/array.lisp
@@ -1,13 +1,15 @@
 ;;; -*- Package: MIPS -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
-;;; **********************************************************************
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/array.lisp,v 1.19 1992/07/28 20:42:50 wlott Exp $")
 ;;;
-;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/mips/array.lisp,v 1.18 1990/11/18 16:56:21 wlott Exp $
+;;; **********************************************************************
 ;;;
 ;;;    This file contains the support routines for arrays and vectors.
 ;;;
@@ -28,17 +30,20 @@
 			  (:res result descriptor-reg a0-offset)
 
 			  (:temp ndescr non-descriptor-reg nl0-offset)
+			  (:temp pa-flag non-descriptor-reg nl4-offset)
 			  (:temp vector descriptor-reg a3-offset))
-  (pseudo-atomic (ndescr)
-    (inst or vector alloc-tn vm:other-pointer-type)
-    (inst addu alloc-tn alloc-tn (+ (1- (ash 1 vm:lowtag-bits))
-				    (* vm:vector-data-offset vm:word-bytes)))
-    (inst addu alloc-tn alloc-tn words)
-    (inst li ndescr (lognot vm:lowtag-mask))
-    (inst and alloc-tn alloc-tn ndescr)
-    (inst srl ndescr type vm:word-shift)
-    (storew ndescr vector 0 vm:other-pointer-type)
-    (storew length vector vm:vector-length-slot vm:other-pointer-type))
+  (pseudo-atomic (pa-flag)
+    (inst or vector alloc-tn other-pointer-type)
+    ;; This is kinda sleezy, changing words like this.  But we can because
+    ;; the vop thinks it is temporary.
+    (inst addu words (+ (1- (ash 1 lowtag-bits))
+			(* vector-data-offset word-bytes)))
+    (inst li ndescr (lognot lowtag-mask))
+    (inst and words ndescr)
+    (inst addu alloc-tn words)
+    (inst srl ndescr type word-shift)
+    (storew ndescr vector 0 other-pointer-type)
+    (storew length vector vector-length-slot other-pointer-type))
   (move result vector))
 
 
@@ -62,9 +67,9 @@
   ;; Save the return address.
   (inst subu retaddr lip-tn code-tn)
 
-  (loadw length string vm:vector-length-slot vm:other-pointer-type)
+  (loadw length string vector-length-slot other-pointer-type)
   (inst addu lip string
-	(- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type))
+	(- (* vector-data-offset word-bytes) other-pointer-type))
   (inst b test)
   (move accum zero-tn)
 
@@ -164,7 +169,7 @@
   (inst subu retaddr lip-tn code-tn)
 
   (inst addu lip string
-	(- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type))
+	(- (* vector-data-offset word-bytes) other-pointer-type))
   (inst b test)
   (move accum zero-tn)
 
-- 
GitLab