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