1 | ;;;-*- Mode: Lisp; Package: CCL-*- |
---|
2 | ;;; |
---|
3 | ;;; Copyright (C) 2009 Clozure Associates |
---|
4 | ;;; Copyright (C) 1994-2001 Digitool, Inc |
---|
5 | ;;; This file is part of Clozure CL. |
---|
6 | ;;; |
---|
7 | ;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU Public |
---|
8 | ;;; License , known as the LLGPL and distributed with Clozure CL as the |
---|
9 | ;;; file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
10 | ;;; which is distributed with Clozure CL as the file "LGPL". Where these |
---|
11 | ;;; conflict, the preamble takes precedence. |
---|
12 | ;;; |
---|
13 | ;;; Clozure CL is referenced in the preamble as the "LIBRARY." |
---|
14 | ;;; |
---|
15 | ;;; The LLGPL is also available online at |
---|
16 | ;;; http://opensource.franz.com/preamble.html |
---|
17 | (in-package "CCL") |
---|
18 | |
---|
19 | ;;; A "register spec" is a fixnum. Bit 28 is clear; bits 24-26 |
---|
20 | ;;; (inclusive) define the type of register-spec in question. Of |
---|
21 | ;;; course, a register spec can also be a "logical register" (lreg) |
---|
22 | ;;; structure. Someday soon, these might totally replace the fixnum |
---|
23 | ;;; "hard regspecs" that're described in this file, and might be used |
---|
24 | ;;; to refer to stack-based values as well as registers. In the |
---|
25 | ;;; meantime, we have to bootstrap a bit. |
---|
26 | |
---|
27 | (defmacro register-spec-p (regspec) |
---|
28 | `(%register-spec-p ,regspec)) |
---|
29 | |
---|
30 | (defun %register-spec-p (regspec) |
---|
31 | (if (typep regspec 'fixnum) |
---|
32 | (not (logbitp 28 (the fixnum regspec))) |
---|
33 | (typep regspec 'lreg))) |
---|
34 | |
---|
35 | (defconstant regspec-type-byte (byte 3 24)) |
---|
36 | (defmacro regspec-type (regspec) |
---|
37 | `(%regspec-type ,regspec)) |
---|
38 | |
---|
39 | (defun %regspec-type (regspec) |
---|
40 | (if (typep regspec 'fixnum) |
---|
41 | (the fixnum (ldb regspec-type-byte (the fixnum regspec))) |
---|
42 | (if (typep regspec 'lreg) |
---|
43 | (the fixnum (lreg-type regspec)) |
---|
44 | (error "bad regspec: ~s" regspec)))) |
---|
45 | |
---|
46 | ;;; Physical registers. |
---|
47 | ;;; A regspec-type of 0 denotes some type of "physical" (machine) register: |
---|
48 | ;;; a GPR, FPR, CR field, CR bit, or SPR. |
---|
49 | (defconstant regspec-hard-reg-type 0) |
---|
50 | ; There are at most 32 members of any class of hard reg, so bytes 5-8 are |
---|
51 | ; used to encode that information; the "value" of the hard reg in question |
---|
52 | ; is in bits 0-4. |
---|
53 | ; In some cases, we can also attach a "mode" to a hard-reg-spec. |
---|
54 | ; Usually, non-0 values of the "mode" field are attached to the |
---|
55 | ; "imm" (unboxed) registers. |
---|
56 | ; A GPR whose "mode" is hard-reg-class-gpr-mode-node can have a "type" |
---|
57 | ; field which asserts that the register's contents map onto one or more |
---|
58 | ; of the primitive non-node types. This information can help some of |
---|
59 | ; the functions that copy between GPRs of different "mode" elide some |
---|
60 | ; type-checking. |
---|
61 | (defconstant regspec-hard-reg-type-value-byte (byte 8 0)) |
---|
62 | (defconstant regspec-hard-reg-type-class-byte (byte 3 8)) |
---|
63 | (defconstant regspec-hard-reg-type-mode-byte (byte 4 11)) |
---|
64 | (defconstant regspec-hard-reg-type-type-byte (byte 8 15)) |
---|
65 | |
---|
66 | (defconstant hard-reg-class-gpr 0) |
---|
67 | (defconstant hard-reg-class-fpr 1) |
---|
68 | ; This is ppc-specific |
---|
69 | (defconstant hard-reg-class-crf 2) ; Value is one of 0, 4, 8, ... 28 |
---|
70 | (defconstant hard-reg-class-crbit 3) |
---|
71 | (defconstant hard-reg-class-spr 4) |
---|
72 | |
---|
73 | ; "mode" values for GPRs. |
---|
74 | (defconstant hard-reg-class-gpr-mode-node 0) ; a tagged lisp object |
---|
75 | (defconstant hard-reg-class-gpr-mode-u32 1) ; unboxed unsigned 32-bit value |
---|
76 | (defconstant hard-reg-class-gpr-mode-s32 2) ; unboxed signed 32-bit value |
---|
77 | (defconstant hard-reg-class-gpr-mode-u16 3) ; unboxed unsigned 16-bit value |
---|
78 | (defconstant hard-reg-class-gpr-mode-s16 4) ; unboxed signed 16-bit value |
---|
79 | (defconstant hard-reg-class-gpr-mode-u8 5) ; unboxed unsigned 8-bit value |
---|
80 | (defconstant hard-reg-class-gpr-mode-s8 6) ; unboxed signed 8-bit value |
---|
81 | (defconstant hard-reg-class-gpr-mode-address 7) ; unboxed unsigned 32-bit address |
---|
82 | (defconstant hard-reg-class-gpr-mode-u64 8) |
---|
83 | (defconstant hard-reg-class-gpr-mode-s64 9) |
---|
84 | |
---|
85 | (defconstant hard-reg-class-gpr-mode-invalid -1) ; Never a valid mode. |
---|
86 | |
---|
87 | ; "mode" values for FPRs. |
---|
88 | (defconstant hard-reg-class-fpr-mode-double 0) ; unboxed IEEE double |
---|
89 | (defconstant hard-reg-class-fpr-mode-single 1) ; unboxed IEEE single |
---|
90 | |
---|
91 | ; "type" values for FPRs - type of SOURCE may be encoded herein |
---|
92 | (defconstant hard-reg-class-fpr-type-double 0) ; IEEE double |
---|
93 | (defconstant hard-reg-class-fpr-type-single 1) ; IEEE single |
---|
94 | |
---|
95 | |
---|
96 | (defmacro set-regspec-mode (regspec mode) |
---|
97 | `(%set-regspec-mode ,regspec ,mode)) |
---|
98 | |
---|
99 | (defun %set-regspec-mode (regspec mode) |
---|
100 | (if (typep regspec 'fixnum) |
---|
101 | (dpb (the fixnum mode) regspec-hard-reg-type-mode-byte regspec) |
---|
102 | (if (typep regspec 'lreg) |
---|
103 | (progn (setf (lreg-mode regspec) mode) regspec) |
---|
104 | (error "bad regspec: ~s" regspec)))) |
---|
105 | |
---|
106 | (defmacro get-regspec-mode (regspec) |
---|
107 | `(%get-regspec-mode ,regspec)) |
---|
108 | |
---|
109 | (defun %get-regspec-mode (regspec) |
---|
110 | (if (typep regspec 'fixnum) |
---|
111 | (ldb regspec-hard-reg-type-mode-byte regspec) |
---|
112 | (if (typep regspec 'lreg) |
---|
113 | (lreg-mode regspec) |
---|
114 | (error "bad regspec: ~s" regspec)))) |
---|
115 | |
---|
116 | |
---|
117 | (defmacro node-regspec-type-modes (modes) |
---|
118 | `(the fixnum (logior ,@(mapcar #'(lambda (x) `(ash 1 ,x)) modes)))) |
---|
119 | |
---|
120 | (defmacro set-node-regspec-type-modes (regspec &rest modes) |
---|
121 | `(%set-node-regspec-type-modes ,regspec (node-regspec-type-modes ,modes))) |
---|
122 | |
---|
123 | (defun %set-node-regspec-type-modes (regspec modes) |
---|
124 | (if (typep regspec 'fixnum) |
---|
125 | (dpb (the fixnum modes) regspec-hard-reg-type-type-byte (the fixnum regspec)) |
---|
126 | (if (typep regspec 'lreg) |
---|
127 | (progn (setf (lreg-type regspec) modes) regspec) |
---|
128 | (error "bad regspec: ~s" regspec)))) |
---|
129 | |
---|
130 | (defmacro get-node-regspec-type-modes (regspec) |
---|
131 | `(%get-regspec-type-modes ,regspec)) |
---|
132 | |
---|
133 | (defun %get-regspec-type-modes (regspec) |
---|
134 | (if (typep regspec 'fixnum) |
---|
135 | (ldb regspec-hard-reg-type-type-byte (the fixnum regspec)) |
---|
136 | (if (typep regspec 'lreg) |
---|
137 | (lreg-type regspec) |
---|
138 | (error "bad regspec: ~s" regspec)))) |
---|
139 | |
---|
140 | (defmacro hard-reg-class-mask (&rest classes) |
---|
141 | `(the fixnum (logior ,@(mapcar #'(lambda (x) `(ash 1 ,x)) classes)))) |
---|
142 | |
---|
143 | (defconstant hard-reg-class-gpr-mask (hard-reg-class-mask hard-reg-class-gpr)) |
---|
144 | (defconstant hard-reg-class-gpr-crf-mask (hard-reg-class-mask hard-reg-class-gpr hard-reg-class-crf)) |
---|
145 | |
---|
146 | ; Assuming that "regspec" denotes a physical register, return its class. |
---|
147 | (defmacro hard-regspec-class (regspec) |
---|
148 | `(%hard-regspec-class ,regspec)) |
---|
149 | |
---|
150 | (defun %hard-regspec-class (regspec) |
---|
151 | (if (typep regspec 'fixnum) |
---|
152 | (the fixnum (ldb regspec-hard-reg-type-class-byte (the fixnum regspec))) |
---|
153 | (if (typep regspec 'lreg) |
---|
154 | (lreg-class regspec) |
---|
155 | (error "bad regspec: ~s" regspec)))) |
---|
156 | |
---|
157 | ; Return physical regspec's value: |
---|
158 | (defmacro hard-regspec-value (regspec) |
---|
159 | `(%hard-regspec-value ,regspec)) |
---|
160 | |
---|
161 | (defun %hard-regspec-value (regspec) |
---|
162 | (if (typep regspec 'fixnum) |
---|
163 | (the fixnum (ldb regspec-hard-reg-type-value-byte (the fixnum regspec))) |
---|
164 | (if (typep regspec 'lreg) |
---|
165 | (lreg-value regspec) |
---|
166 | (error "bad regspec: ~s" regspec)))) |
---|
167 | |
---|
168 | ;;; Logical (as opposed to "physical") registers are represented by structures |
---|
169 | ;;; of type LREG. The structures let us track information about assignments |
---|
170 | ;;; and references to lregs, and the indirection lets us defer decisions about |
---|
171 | ;;; storage mapping (register assignment, etc.) until later. |
---|
172 | |
---|
173 | ;; A GPR which is allowed to hold any lisp object (but NOT an object header.) |
---|
174 | (defconstant regspec-lisp-reg-type 1) |
---|
175 | |
---|
176 | ;; A GPR which is allowed to contain any -non- lisp object. |
---|
177 | (defconstant regspec-unboxed-reg-type 2) |
---|
178 | |
---|
179 | ;; A GPR which can contain either an immediate lisp object (fixnum, immediate) |
---|
180 | ;; or any non-lisp object. |
---|
181 | (defconstant regspec-any-gpr-reg-type (logior regspec-lisp-reg-type regspec-unboxed-reg-type)) |
---|
182 | |
---|
183 | ;; An FPR. All FPRs are created equal; there's no reason to |
---|
184 | ;; worry about whether an FPR's holding a 32 or 64-bit float. |
---|
185 | (defconstant regspec-fpr-reg-type 4) |
---|
186 | |
---|
187 | ;; One of the 8 fields of the Condition Register. |
---|
188 | (defconstant regspec-crf-reg-type 5) |
---|
189 | |
---|
190 | ;; One of the 32 bits of the Condition Register. |
---|
191 | (defconstant regspec-crbit-reg-type 6) |
---|
192 | |
---|
193 | (defmacro make-hard-crf-reg (crf) |
---|
194 | `(dpb hard-reg-class-crf regspec-hard-reg-type-class-byte (the fixnum ,crf))) |
---|
195 | |
---|
196 | (defmacro make-hard-fp-reg (regnum &optional (mode hard-reg-class-fpr-mode-double)) |
---|
197 | `(dpb (the fixnum ,mode) |
---|
198 | regspec-hard-reg-type-mode-byte |
---|
199 | (dpb hard-reg-class-fpr regspec-hard-reg-type-class-byte (the fixnum ,regnum)))) |
---|
200 | |
---|
201 | ;;; "Memory specs" have bit 28 set. Since bit 28 is the sign bit in 68K MCL, |
---|
202 | ;;; we have to be a little careful when creating them to ensure that the result |
---|
203 | ;;; is a fixnum. |
---|
204 | |
---|
205 | (defmacro memory-spec-p (thing) |
---|
206 | `(if (typep ,thing 'fixnum) (logbitp 28 (the fixnum ,thing)))) |
---|
207 | |
---|
208 | (defmacro make-memory-spec (thing) |
---|
209 | `(logior (ash -1 28) (the fixnum ,thing))) |
---|
210 | |
---|
211 | ;;; Bits 24-26 (inclusive) of a memory-spec define the type of memory-spec in question. |
---|
212 | (defconstant memspec-type-byte (byte 3 24)) |
---|
213 | (defmacro memspec-type (memspec) |
---|
214 | `(ldb memspec-type-byte (the fixnum ,memspec))) |
---|
215 | |
---|
216 | ;;; A slot in the value-stack frame. This needs to get interpreted |
---|
217 | ;;; relative to the top of the vsp. The low 15 bits denote the |
---|
218 | ;;; offset in the frame; the low 2 bits are always clear, since the |
---|
219 | ;;; vstack is always aligned on a 32-bit boundary. |
---|
220 | (defconstant memspec-frame-address 0) |
---|
221 | |
---|
222 | |
---|
223 | ;;; Address-specs - whether memory- or register-based - might be used to indicate the |
---|
224 | ;;; canonical address of a variable. Sometimes, this address is actually the address |
---|
225 | ;;; of a "value cell" object; if so, bit 27 will be set in the indicated address. |
---|
226 | |
---|
227 | (defun addrspec-vcell-p (x) |
---|
228 | (logbitp 27 x)) |
---|
229 | |
---|
230 | (defmacro make-vcell-memory-spec (x) |
---|
231 | `(logior (ash 1 27) (the fixnum ,x))) |
---|
232 | |
---|
233 | (defmacro memspec-frame-address-offset (m) |
---|
234 | `(logand (the fixnum ,m) #xffff)) |
---|
235 | |
---|
236 | |
---|
237 | (provide "REG") |
---|