Newer
Older
;;; -*- 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.12 1990/04/23 16:45:09 wlott Exp $
;;; This file contains the MIPS VM definition of operand loading/saving and
;;; Written by Rob MacLachlan.
;;; MIPS conversion by William Lott.
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
(define-move-function (load-immediate 1) (vop x y)
((null unsigned-immediate immediate zero negative-immediate
random-immediate immediate-base-character immediate-sap)
(any-reg descriptor-reg base-character-reg sap-reg))
(let ((val (tn-value x)))
(etypecase val
(integer
(loadi y (fixnum val)))
(null
(move y null-tn))
(symbol
(load-symbol y val))
(character
(loadi y (logior (ash (char-code val) type-bits)
base-character-type))))))
(define-move-function (load-number 1) (vop x y)
((null unsigned-immediate immediate zero negative-immediate random-immediate)
(signed-reg unsigned-reg))
(loadi y (tn-value x)))
(define-move-function (load-base-character 1) (vop x y)
((immediate-base-character) (base-character-reg))
(loadi y (char-code (tn-value x))))
(define-move-function (load-constant 5) (vop x y)
((constant) (any-reg descriptor-reg))
(loadw y code-tn (tn-offset x) other-pointer-type))
(define-move-function (load-stack 5) (vop x y)
((control-stack) (any-reg descriptor-reg))
(load-stack-tn y x))
(define-move-function (load-number-stack 5) (vop x y)
((base-character-stack) (base-character-reg)
(sap-stack) (sap-reg)
(signed-stack) (signed-reg)
(unsigned-stack) (unsigned-reg))
(let ((nfp (current-nfp-tn vop)))
(loadw y nfp (tn-offset x))))
(define-move-function (load-single 5) (vop x y)
((single-stack) (single-reg))
(cerror "Do nothing." "Not yet." x y))
(define-move-function (load-double 7) (vop x y)
((double-stack) (double-reg))
(cerror "Do nothing." "Not yet." x y))
(define-move-function (store-stack 5) (vop x y)
((any-reg descriptor-reg) (control-stack))
(store-stack-tn y x))
(define-move-function (store-number-stack 5) (vop x y)
((base-character-reg) (base-character-stack)
(sap-reg) (sap-stack)
(signed-reg) (signed-stack)
(unsigned-reg) (unsigned-stack))
(let ((nfp (current-nfp-tn vop)))
(storew x nfp (tn-offset y))))
(define-move-function (store-single 5) (vop x y)
((single-reg) (single-stack))
(cerror "Do nothing." "Not yet." x y))
(define-move-function (store-double 7) (vop x y)
((double-reg) (double-stack))
(cerror "Do nothing." "Not yet." x y))
;;;; The Move VOP:
;;;
(define-vop (move)
(:args (x :target y
:scs (any-reg descriptor-reg)
(define-move-vop move :move
(any-reg descriptor-reg)
(any-reg descriptor-reg))
;;; 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)
;;; The Move-Argument VOP is used for moving descriptor values into another
;;; frame for argument or known value passing.
;;;
(define-vop (move-argument)
(:args (x :target y
:scs (any-reg descriptor-reg))
(fp :scs (descriptor-reg)
:load-if (not (sc-is y any-reg descriptor-reg))))
(:results (y))
(:generator 0
(sc-case y
((any-reg descriptor-reg)
(move y x))
(control-stack
(storew x fp (tn-offset y))))))
;;;
(define-move-vop move-argument :move-argument
(any-reg descriptor-reg)
(any-reg descriptor-reg))
;;;; 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)
(:generator 666
(error-call di:object-not-type-error x type)))