Skip to content
Snippets Groups Projects
move.lisp 4.83 KiB
Newer Older
wlott's avatar
wlott committed
;;; -*- Package: C; Log: C.Log -*-
;;;
;;; **********************************************************************
;;; 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). 
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/move.lisp,v 1.8 1990/02/28 18:26:05 wlott Exp $
wlott's avatar
wlott committed
;;;
wlott's avatar
wlott committed
;;;    This file contains the RT VM definition of operand loading/saving and
;;; the Move VOP.
;;;
;;; Written by Rob MacLachlan
;;;
wlott's avatar
wlott committed
(in-package "C")
wlott's avatar
wlott committed

;;; Load-Constant-TN  --  Internal
;;;
;;;    Load the Constant or immediate constant TN X into Y.  Temp is a
;;; descriptor register temp or NIL, if none is available.  Temp must be
;;; supplied if Y may be in memory.  Node is for souce context.
;;;
(defun load-constant-tn (x y temp node)
  (declare (type tn x y) (type (or tn null temp)) (type node node))
  (assemble node
    (sc-case x
      ((zero negative-immediate unsigned-immediate immediate
	     null random-immediate immediate-base-character immediate-sap)
wlott's avatar
wlott committed
       (let ((val (tn-value x))
	     (dest (sc-case y
		     ((any-reg descriptor-reg base-character-reg sap-reg) y)
		     ((control-stack number-stack sap-stack
				     base-character-stack)
wlott's avatar
wlott committed
		      temp))))
	 (etypecase val
	   (integer
	    (loadi dest (fixnum val)))
wlott's avatar
wlott committed
	   (null
	    (move dest null-tn))
	    (load-symbol dest val))
wlott's avatar
wlott committed
	   (string-char
	    (loadi dest (logior (ash (char-code val) type-bits)
				base-character-type))))
wlott's avatar
wlott committed
	 (unless (eq dest y)
	   (store-stack-tn y temp))))
      (constant
       (sc-case y
	 ((any-reg descriptor-reg)
	  (loadw y code-tn (tn-offset x) other-pointer-type))
wlott's avatar
wlott committed
	 (control-stack
	  (loadw temp code-tn (tn-offset x) other-pointer-type)
wlott's avatar
wlott committed
	  (store-stack-tn y temp)))))))


;;;; The Move VOP:
;;;
;;;    The Move VOP is used for doing arbitrary moves when there is no
;;; type-specific move/coerce operation.

;;; We need a register to do a memory-memory move.
;;;
(define-vop (move)
  (:args (x :target y
	    :scs (any-reg descriptor-reg)
	    :load nil))
  (:results (y :scs (any-reg descriptor-reg)
	       :load nil))
  (:temporary (:scs (descriptor-reg)
	       :from :argument  :to :result)
	      temp)
  (:node-var node)
  (:effects)
  (:affected)
  (:generator 0
    (unless (location= x y)
      (sc-case x
	((any-reg descriptor-reg)
	 (sc-case y
	   ((any-reg descriptor-reg)
	    (move y x))
	   (control-stack
	    (store-stack-tn y x))))
	(control-stack
	 (sc-case y
	   ((any-reg descriptor-reg)
	    (load-stack-tn y x))
	   (control-stack
	    (load-stack-tn temp x)
	    (store-stack-tn y temp))))
	(t
	 (unassemble (load-constant-tn x y temp node)))))))


;;; Make Move the check VOP for T so that type check generation doesn't think
;;; it is a hairy type.  This also allows checking of a few of the values in a
;;; continuation to fall out.
;;;
(primitive-type-vop move (:check) t)


;;;; ILLEGAL-MOVE

;;; This VOP exists just to begin the lifetime of a TN that couldn't be written
;;; legally due to a type error.  An error is signalled before this VOP is
;;; so we don't need to do anything (not that there would be anything sensible
;;; to do anyway.)
;;;
(define-vop (illegal-move)
  (:results (y))
  (:ignore y)
  (:generator 666))


;;;; Operand loading and saving:
;;;
;;;    These are the VOPs used for loading or saving Load-TNs.  They cannot
;;; allocate any temporaries since packing has already been done by the time
;;; that these VOPs are emitted.  It can be assumed that the loaded (saved) TN
;;; is free before (after) the load (save) (so may be used as a temporary.)
;;;

(define-vop (load-operand)
  (:args (x))
  (:results (y))
  (:node-var node)
  (:generator 5
    (sc-case x
      (control-stack
       (sc-case y
	 ((any-reg descriptor-reg)
	  (load-stack-tn y x))
	 #+nil
	 (base-character-reg
wlott's avatar
wlott committed
	  (load-stack-tn y x)
	  (inst nilz y y system:%character-code-mask))))
      (base-character-stack
wlott's avatar
wlott committed
       (sc-case y
	 (base-character-reg
wlott's avatar
wlott committed
	  (load-stack-tn y x))))
      (t
       (unassemble (load-constant-tn x y nil node))))))

(define-vop (store-operand)
  (:args (x))
  (:results (y))
  (:generator 5
    (sc-case y
      (control-stack
       (sc-case x
	 ((any-reg descriptor-reg)
	  (store-stack-tn y x))
	 #+nil
	 (base-character-reg
wlott's avatar
wlott committed
	  (inst oiu x x (ash system:%string-char-type clc::type-shift-16))
	  (store-stack-tn y x))))
      (base-character-stack
wlott's avatar
wlott committed
       (sc-case x
	 (base-character-reg
wlott's avatar
wlott committed
	  (store-stack-tn y x)))))))


;;;; Register saving and restoring VOPs.

(define-vop (save-reg)
  (:args (reg))
  (:results (stack))
  (:generator 5
    (store-stack-tn stack reg)))

(define-vop (restore-reg)
  (:args (stack))
  (:results (reg))
  (:generator 5
    (load-stack-tn reg stack)))