Skip to content
Snippets Groups Projects
Commit b812f3bf authored by wlott's avatar wlott
Browse files

changed for new pseudo-atomic.

parent 4fed4617
No related branches found
No related tags found
No related merge requests found
;;; -*- 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)
......
;;; -*- 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)
......
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