Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
;;; -*- 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).
;;; **********************************************************************
;;;
;;; This file contains the RT VM definition of operand loading/saving and
;;; the Move VOP.
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
;;; 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-string-char immediate-sap)
(let ((val (tn-value x))
(dest (sc-case y
((any-reg descriptor-reg string-char-reg sap-reg) y)
((control-stack number-stack sap-stack string-char-stack)
temp))))
(etypecase val
(integer
(loadi dest val))
(null
(move dest null-tn))
((member t)
(error "can't load T yet."))
(string-char
(loadi dest (logior (ash (char-code val) type-bits)
character-type))))
(unless (eq dest y)
(store-stack-tn y temp))))
(constant
(sc-case y
((any-reg descriptor-reg)
(load-slot y env-tn (tn-offset x)))
(control-stack
(load-slot temp env-tn (tn-offset x))
(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
(string-char-reg
(load-stack-tn y x)
(inst nilz y y system:%character-code-mask))))
(string-char-stack
(sc-case y
(string-char-reg
(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
(string-char-reg
(inst oiu x x (ash system:%string-char-type clc::type-shift-16))
(store-stack-tn y x))))
(string-char-stack
(sc-case x
(string-char-reg
(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)))