1 | /* |
---|
2 | Copyright (C) 2003-2009, Clozure Associates. |
---|
3 | Copyright (C) 1994-2001 Digitool, Inc |
---|
4 | This file is part of Clozure CL. |
---|
5 | |
---|
6 | Clozure CL is licensed under the terms of the Lisp Lesser GNU Public |
---|
7 | License , known as the LLGPL and distributed with Clozure CL as the |
---|
8 | file "LICENSE". The LLGPL consists of a preamble and the LGPL, |
---|
9 | which is distributed with Clozure CL as the file "LGPL". Where these |
---|
10 | conflict, the preamble takes precedence. |
---|
11 | |
---|
12 | Clozure CL is referenced in the preamble as the "LIBRARY." |
---|
13 | |
---|
14 | The LLGPL is also available online at |
---|
15 | http://opensource.franz.com/preamble.html |
---|
16 | */ |
---|
17 | |
---|
18 | |
---|
19 | #include "ppc-constants.h" |
---|
20 | |
---|
21 | #define rcontext 2 |
---|
22 | |
---|
23 | #define nbits_in_word 64L |
---|
24 | #define log2_nbits_in_word 6L |
---|
25 | #define nbits_in_byte 8L |
---|
26 | #define ntagbits 4L |
---|
27 | #define nlisptagbits 3L |
---|
28 | #define nfixnumtagbits 2L |
---|
29 | #define num_subtag_bits 8L |
---|
30 | #define fixnumshift 3L |
---|
31 | #define fixnum_shift 3L |
---|
32 | #define fulltagmask 15L |
---|
33 | #define tagmask 7L |
---|
34 | #define fixnummask 3 |
---|
35 | #define subtagmask ((1L<<num_subtag_bits)-1L) |
---|
36 | #define ncharcodebits 8L |
---|
37 | #define charcode_shift 8L |
---|
38 | #define node_size 8L |
---|
39 | #define node_shift 3L |
---|
40 | |
---|
41 | #define lowtagmask 3L |
---|
42 | #define lowtag_mask lowtagmask |
---|
43 | |
---|
44 | #define lowtag_primary 0L |
---|
45 | #define lowtag_imm 1L |
---|
46 | #define lowtag_immheader 2L |
---|
47 | #define lowtag_nodeheader 3L |
---|
48 | |
---|
49 | #define tag_fixnum 0L |
---|
50 | |
---|
51 | #define fulltag_even_fixnum 0L |
---|
52 | #define fulltag_imm_0 1L |
---|
53 | #define fulltag_immheader_0 2L |
---|
54 | #define fulltag_nodeheader_0 3L |
---|
55 | #define fulltag_cons 4L |
---|
56 | #define fulltag_imm_1 5L |
---|
57 | #define fulltag_immheader_1 6L |
---|
58 | #define fulltag_nodeheader_1 7L |
---|
59 | #define fulltag_odd_fixnum 8L |
---|
60 | #define fulltag_imm_2 9L |
---|
61 | #define fulltag_immheader_2 10L |
---|
62 | #define fulltag_nodeheader_2 11L |
---|
63 | #define fulltag_misc 12L |
---|
64 | #define fulltag_imm_3 13L |
---|
65 | #define fulltag_immheader_3 14L |
---|
66 | #define fulltag_nodeheader_3 15L |
---|
67 | |
---|
68 | #define SUBTAG(tag,subtag) ((tag) | ((subtag) << ntagbits)) |
---|
69 | #define cl_array_subtag_mask 0x80L |
---|
70 | #define CL_ARRAY_SUBTAG(tag,subtag) (cl_array_subtag_mask | (SUBTAG(tag,subtag))) |
---|
71 | |
---|
72 | #define subtag_arrayH CL_ARRAY_SUBTAG(fulltag_nodeheader_1,0L) |
---|
73 | #define subtag_vectorH CL_ARRAY_SUBTAG(fulltag_nodeheader_2,0L) |
---|
74 | #define subtag_simple_vector CL_ARRAY_SUBTAG(fulltag_nodeheader_3,0L) |
---|
75 | #define min_vector_subtag subtag_vectorH |
---|
76 | |
---|
77 | #define ivector_class_64_bit fulltag_immheader_3 |
---|
78 | #define ivector_class_32_bit fulltag_immheader_2 |
---|
79 | #define ivector_class_other_bit fulltag_immheader_1 |
---|
80 | #define ivector_class_8_bit fulltag_immheader_0 |
---|
81 | |
---|
82 | #define subtag_s64_vector CL_ARRAY_SUBTAG(ivector_class_64_bit,1) |
---|
83 | #define subtag_u64_vector CL_ARRAY_SUBTAG(ivector_class_64_bit,2) |
---|
84 | #define subtag_fixnum_vector CL_ARRAY_SUBTAG(ivector_class_64_bit,3) |
---|
85 | #define subtag_double_float_vector CL_ARRAY_SUBTAG(ivector_class_64_bit,4) |
---|
86 | #define subtag_s32_vector CL_ARRAY_SUBTAG(ivector_class_32_bit,1) |
---|
87 | #define subtag_u32_vector CL_ARRAY_SUBTAG(ivector_class_32_bit,2) |
---|
88 | #define subtag_single_float_vector CL_ARRAY_SUBTAG(ivector_class_32_bit,3) |
---|
89 | #define subtag_simple_base_string CL_ARRAY_SUBTAG(ivector_class_32_bit,5) |
---|
90 | #define subtag_s16_vector CL_ARRAY_SUBTAG(ivector_class_other_bit,1) |
---|
91 | #define subtag_u16_vector CL_ARRAY_SUBTAG(ivector_class_other_bit,2) |
---|
92 | #define subtag_bit_vector CL_ARRAY_SUBTAG(ivector_class_other_bit,7) |
---|
93 | #define subtag_s8_vector CL_ARRAY_SUBTAG(ivector_class_8_bit,1) |
---|
94 | #define subtag_u8_vector CL_ARRAY_SUBTAG(ivector_class_8_bit,2) |
---|
95 | |
---|
96 | /* There's some room for expansion in non-array ivector space. */ |
---|
97 | #define subtag_macptr SUBTAG(ivector_class_64_bit,1) |
---|
98 | #define subtag_dead_macptr SUBTAG(ivector_class_64_bit,2) |
---|
99 | #define subtag_code_vector SUBTAG(ivector_class_32_bit,0) |
---|
100 | #define subtag_xcode_vector SUBTAG(ivector_class_32_bit,1) |
---|
101 | #define subtag_bignum SUBTAG(ivector_class_32_bit,2) |
---|
102 | #define subtag_double_float SUBTAG(ivector_class_32_bit,3) |
---|
103 | |
---|
104 | |
---|
105 | /* |
---|
106 | Size doesn't matter for non-CL-array gvectors; I can't think of a good |
---|
107 | reason to classify them in any particular way. Let's put funcallable |
---|
108 | things in the first slice by themselves, though it's not clear that |
---|
109 | that helps FUNCALL much. |
---|
110 | */ |
---|
111 | #define gvector_funcallable fulltag_nodeheader_0 |
---|
112 | |
---|
113 | #define subtag_function SUBTAG(gvector_funcallable,0) |
---|
114 | #define subtag_symbol SUBTAG(gvector_funcallable,1) |
---|
115 | #define subtag_catch_frame SUBTAG(fulltag_nodeheader_1,0) |
---|
116 | #define subtag_basic_stream SUBTAG(fulltag_nodeheader_1,1) |
---|
117 | #define subtag_lock SUBTAG(fulltag_nodeheader_1,2) |
---|
118 | #define subtag_hash_vector SUBTAG(fulltag_nodeheader_1,3) |
---|
119 | #define subtag_pool SUBTAG(fulltag_nodeheader_1,4) |
---|
120 | #define subtag_weak SUBTAG(fulltag_nodeheader_1,5) |
---|
121 | #define subtag_package SUBTAG(fulltag_nodeheader_1,6) |
---|
122 | |
---|
123 | #define subtag_slot_vector SUBTAG(fulltag_nodeheader_2,0) |
---|
124 | #define subtag_instance SUBTAG(fulltag_nodeheader_2,1) |
---|
125 | #define subtag_struct SUBTAG(fulltag_nodeheader_2,2) |
---|
126 | #define subtag_istruct SUBTAG(fulltag_nodeheader_2,3) |
---|
127 | #define subtag_value_cell SUBTAG(fulltag_nodeheader_2,4) |
---|
128 | #define subtag_xfunction SUBTAG(fulltag_nodeheader_2,5) |
---|
129 | |
---|
130 | #define subtag_ratio SUBTAG(fulltag_nodeheader_3,0) |
---|
131 | #define subtag_complex SUBTAG(fulltag_nodeheader_3,1) |
---|
132 | |
---|
133 | |
---|
134 | |
---|
135 | #define nil_value (0x3000+fulltag_misc+sizeof(struct lispsymbol)+(LOWMEM_BIAS)) |
---|
136 | #define t_value (0x3000+fulltag_misc+(LOWMEM_BIAS)) |
---|
137 | #define misc_bias fulltag_misc |
---|
138 | #define cons_bias fulltag_cons |
---|
139 | |
---|
140 | |
---|
141 | #define misc_header_offset -fulltag_misc |
---|
142 | #define misc_subtag_offset misc_header_offset+7 /* low byte of header */ |
---|
143 | #define misc_data_offset misc_header_offset+8 /* first word of data */ |
---|
144 | #define misc_dfloat_offset misc_header_offset /* double-floats are doubleword-aligned */ |
---|
145 | |
---|
146 | #define subtag_single_float SUBTAG(fulltag_imm_0,0) |
---|
147 | |
---|
148 | #define subtag_go_tag SUBTAG(fulltag_imm_1,2) /* deprecated */ |
---|
149 | #define subtag_block_tag SUBTAG(fulltag_imm_1,3) /* deprecated */ |
---|
150 | |
---|
151 | #define subtag_character SUBTAG(fulltag_imm_1,0) |
---|
152 | |
---|
153 | #define subtag_unbound SUBTAG(fulltag_imm_3,0) |
---|
154 | #define unbound_marker subtag_unbound |
---|
155 | #define undefined unbound_marker |
---|
156 | #define unbound unbound_marker |
---|
157 | #define subtag_slot_unbound SUBTAG(fulltag_imm_3,1) |
---|
158 | #define slot_unbound_marker subtag_slot_unbound |
---|
159 | #define slot_unbound slot_unbound_marker |
---|
160 | #define subtag_illegal SUBTAG(fulltag_imm_3,2) |
---|
161 | #define illegal_marker subtag_illegal |
---|
162 | #define subtag_no_thread_local_binding SUBTAG(fulltag_imm_3,3) |
---|
163 | #define no_thread_local_binding_marker subtag_no_thread_local_binding |
---|
164 | #define subtag_forward_marker SUBTAG(fulltag_imm_3,7) |
---|
165 | |
---|
166 | #define max_64_bit_constant_index ((0x7fff + misc_dfloat_offset)>>3) |
---|
167 | #define max_32_bit_constant_index ((0x7fff + misc_data_offset)>>2) |
---|
168 | #define max_16_bit_constant_index ((0x7fff + misc_data_offset)>>1) |
---|
169 | #define max_8_bit_constant_index (0x7fff + misc_data_offset) |
---|
170 | #define max_1_bit_constant_index ((0x7fff + misc_data_offset)<<5) |
---|
171 | |
---|
172 | |
---|
173 | /* The objects themselves look something like this: */ |
---|
174 | |
---|
175 | typedef struct double_float { |
---|
176 | LispObj header; |
---|
177 | LispObj value; |
---|
178 | } double_float; |
---|
179 | |
---|
180 | |
---|
181 | |
---|
182 | typedef struct eabi_c_frame { |
---|
183 | struct eabi_c_frame *backlink; |
---|
184 | unsigned savelr; |
---|
185 | LispObj params[8]; |
---|
186 | } eabi_c_frame; |
---|
187 | |
---|
188 | /* PowerOpen ABI C frame */ |
---|
189 | |
---|
190 | typedef struct c_frame { |
---|
191 | struct c_frame *backlink; |
---|
192 | natural crsave; |
---|
193 | natural savelr; |
---|
194 | natural unused[2]; |
---|
195 | natural savetoc; /* Used with CFM (and on Linux.) */ |
---|
196 | natural params[8]; /* Space for callee to save r3-r10 */ |
---|
197 | } c_frame; |
---|
198 | |
---|
199 | typedef struct lisp_frame { |
---|
200 | struct lisp_frame *backlink; |
---|
201 | LispObj savefn; |
---|
202 | LispObj savelr; |
---|
203 | LispObj savevsp; |
---|
204 | } lisp_frame; |
---|
205 | |
---|
206 | |
---|
207 | /* |
---|
208 | The GC also needs to know what a catch_frame looks like. |
---|
209 | */ |
---|
210 | |
---|
211 | typedef struct catch_frame { |
---|
212 | LispObj header; |
---|
213 | LispObj catch_tag; |
---|
214 | LispObj link; |
---|
215 | LispObj mvflag; |
---|
216 | LispObj csp; |
---|
217 | LispObj db_link; |
---|
218 | LispObj regs[8]; |
---|
219 | LispObj xframe; |
---|
220 | LispObj tsp_segment; |
---|
221 | } catch_frame; |
---|
222 | |
---|
223 | #define catch_frame_element_count ((sizeof(catch_frame)/sizeof(LispObj))-1) |
---|
224 | #define catch_frame_header make_header(subtag_catch_frame,catch_frame_element_count) |
---|
225 | |
---|
226 | |
---|
227 | /* |
---|
228 | All exception frames in a thread are linked together |
---|
229 | */ |
---|
230 | typedef struct xframe_list { |
---|
231 | ExceptionInformation *curr; |
---|
232 | struct xframe_list *prev; |
---|
233 | } xframe_list; |
---|
234 | |
---|
235 | #define fixnum_bitmask(n) (1LL<<((n)+fixnumshift)) |
---|
236 | |
---|
237 | |
---|
238 | #include "lisp-errors.h" |
---|
239 | |
---|
240 | |
---|
241 | |
---|
242 | #define TCR_BIAS (0x0) |
---|
243 | |
---|
244 | typedef struct tcr { |
---|
245 | struct tcr* next; |
---|
246 | struct tcr* prev; |
---|
247 | struct { |
---|
248 | float f; |
---|
249 | u_int32_t tag; |
---|
250 | } single_float_convert; |
---|
251 | union { |
---|
252 | double d; |
---|
253 | struct {u_int32_t h, l;} words; |
---|
254 | } lisp_fpscr; /* lisp thread's fpscr (in low word) */ |
---|
255 | special_binding* db_link; /* special binding chain head */ |
---|
256 | LispObj catch_top; /* top catch frame */ |
---|
257 | LispObj* save_vsp; /* VSP when in foreign code */ |
---|
258 | LispObj* save_tsp; /* TSP when in foreign code */ |
---|
259 | struct area* cs_area; /* cstack area pointer */ |
---|
260 | struct area* vs_area; /* vstack area pointer */ |
---|
261 | struct area* ts_area; /* tstack area pointer */ |
---|
262 | LispObj cs_limit; /* stack overflow limit */ |
---|
263 | natural bytes_allocated; |
---|
264 | natural log2_allocation_quantum; /* for per-tread consing */ |
---|
265 | signed_natural interrupt_pending; /* pending interrupt flag */ |
---|
266 | xframe_list* xframe; /* exception-frame linked list */ |
---|
267 | int* errno_loc; /* per-thread (?) errno location */ |
---|
268 | LispObj ffi_exception; /* fpscr bits from ff-call */ |
---|
269 | LispObj osid; /* OS thread id */ |
---|
270 | signed_natural valence; /* odd when in foreign code */ |
---|
271 | signed_natural foreign_exception_status; /* non-zero -> call lisp_exit_hook */ |
---|
272 | void* native_thread_info; /* platform-dependent */ |
---|
273 | void* native_thread_id; /* mach_thread_t, pid_t, etc. */ |
---|
274 | void* last_allocptr; |
---|
275 | void* save_allocptr; |
---|
276 | void* save_allocbase; |
---|
277 | void* reset_completion; |
---|
278 | void* activate; |
---|
279 | signed_natural suspend_count; |
---|
280 | ExceptionInformation* suspend_context; |
---|
281 | ExceptionInformation* pending_exception_context; |
---|
282 | void* suspend; /* suspension semaphore */ |
---|
283 | void* resume; /* resumption semaphore */ |
---|
284 | natural flags; |
---|
285 | ExceptionInformation* gc_context; |
---|
286 | void* termination_semaphore; |
---|
287 | signed_natural unwinding; |
---|
288 | natural tlb_limit; |
---|
289 | LispObj* tlb_pointer; |
---|
290 | natural shutdown_count; |
---|
291 | void *safe_ref_address; |
---|
292 | } TCR; |
---|
293 | |
---|
294 | #define t_offset -(sizeof(lispsymbol)) |
---|
295 | |
---|
296 | /* |
---|
297 | These were previously global variables. There are lots of implicit |
---|
298 | assumptions about the size of a heap segment, so they might as well |
---|
299 | be constants. |
---|
300 | */ |
---|
301 | |
---|
302 | #define heap_segment_size 0x00020000L |
---|
303 | #define log2_heap_segment_size 17L |
---|
304 | |
---|