source: trunk/source/lisp-kernel/ppc-constants64.h @ 11675

Last change on this file since 11675 was 11675, checked in by gb, 11 years ago

Add a mechanism that allows user-defined functions to be used to free
GCable pointers.

Move the xmacptr_flag* constants form architecure-specific headers to
gc.h (they were all identical.) Define xmacptr_flag_user_first and
xmacptr_flag_user_last, so that some xmacptr flags denote user-specified
"dispose" functions.

Define 'register_xmacptr_dispose_function' and add it to imports.s.
This function provides a very simple way to associate a foreign function
with a dynamically-allocated user-defined xmacptr_flag value.

If we discover an umarked xmacptr whose flags denote a user-defined
dispose function, enqueue the macptr for later (postGC) disposal. (We
can't necessarily call the dispose function in the middle of the GC,
since other suspended threads may own locks.) Since we aren't really
sure what fields in the foreign pointer could be used to link pointers
together, we basically have to mark the (otherwise unreachable)
xmacptr object and link it onto a new list via its "class" cell and
arrange for forward_gcable_ptrs() to update this linked list. (The
xmacptr is unreachable and will be GCed next time.)

Make freeGCptrs handle post-GC freeing pf xmacptrs with user-defined
dispose functions.

Note that the order in which user-defined dispose functions are
registered must be consistent (e.g., a saved image must register
the same set of dispose functions in the same order as were registered
before the image was saved.)

All of this fuss is to allow for things like GCable handles.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.3 KB
Line 
1/*
2   Copyright (C) 2003-2005, Clozure Associates.
3   Copyright (C) 1994-2001 Digitool, Inc
4   This file is part of OpenMCL. 
5
6   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7   License , known as the LLGPL and distributed with OpenMCL as the
8   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9   which is distributed with OpenMCL as the file "LGPL".  Where these
10   conflict, the preamble takes precedence. 
11
12   OpenMCL 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#ifndef __constants64__
19#define __constants64__ 1
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/*  Order of CAR and CDR doesn't seem to matter much - there aren't */
176/*  too many tricks to be played with predecrement/preincrement addressing. */
177/*  Keep them in the confusing MCL 3.0 order, to avoid confusion. */
178
179typedef struct cons {
180  LispObj cdr;
181  LispObj car;
182} cons;
183
184
185
186typedef struct lispsymbol {
187  LispObj header;
188  LispObj pname;
189  LispObj vcell;
190  LispObj fcell;
191  LispObj package_predicate;
192  LispObj flags;
193  LispObj plist;
194  LispObj binding_index;
195} lispsymbol;
196
197typedef struct ratio {
198  LispObj header;
199  LispObj numer;
200  LispObj denom;
201} ratio;
202
203typedef struct double_float {
204  LispObj header;
205  LispObj value;
206} double_float;
207
208
209typedef struct macptr {
210  LispObj header;
211  LispObj address;
212  LispObj class;
213  LispObj type;
214} macptr;
215
216typedef struct xmacptr {
217  LispObj header;
218  LispObj address;
219  LispObj class;
220  LispObj type;
221  LispObj flags;
222  LispObj link;
223} xmacptr;
224 
225
226typedef struct eabi_c_frame {
227  struct eabi_c_frame *backlink;
228  unsigned savelr;
229  LispObj params[8];
230} eabi_c_frame;
231
232/* PowerOpen ABI C frame */
233
234typedef struct c_frame {
235  struct c_frame *backlink;
236  natural crsave;
237  natural savelr;
238  natural unused[2];
239  natural savetoc;              /* Used with CFM (and on Linux.) */
240  natural params[8];            /* Space for callee to save r3-r10 */
241} c_frame;
242
243typedef struct lisp_frame {
244  struct lisp_frame *backlink;
245  LispObj savefn;
246  LispObj savelr;
247  LispObj savevsp;
248} lisp_frame;
249
250typedef struct special_binding {
251  struct special_binding *link;
252  struct lispsymbol *sym;
253  LispObj value;
254} special_binding;
255
256/* The GC (at least) needs to know what a
257   package looks like, so that it can do GCTWA. */
258typedef struct package {
259  LispObj header;
260  LispObj itab;                 /* itab and etab look like (vector (fixnum . fixnum) */
261  LispObj etab;
262  LispObj used;
263  LispObj used_by;
264  LispObj names;
265  LispObj shadowed;
266} package;
267
268/*
269  The GC also needs to know what a catch_frame looks like.
270*/
271
272typedef struct catch_frame {
273  LispObj header;
274  LispObj catch_tag;
275  LispObj link;
276  LispObj mvflag;
277  LispObj csp;
278  LispObj db_link;
279  LispObj regs[8];
280  LispObj xframe;
281  LispObj tsp_segment;
282} catch_frame;
283
284#define catch_frame_element_count ((sizeof(catch_frame)/sizeof(LispObj))-1)
285#define catch_frame_header make_header(subtag_catch_frame,catch_frame_element_count)
286
287
288/*
289  All exception frames in a thread are linked together
290  */
291typedef struct xframe_list {
292  ExceptionInformation *curr;
293  struct xframe_list *prev;
294} xframe_list;
295
296#define fixnum_bitmask(n)  (1LL<<((n)+fixnumshift))
297
298/*
299  The GC (at least) needs to know about hash-table-vectors and their flag bits.
300*/
301
302typedef struct hash_table_vector_header {
303  LispObj header;
304  LispObj link;                 /* If weak */
305  LispObj flags;                /* a fixnum; see below */
306  LispObj gc_count;             /* gc-count kernel global */
307  LispObj free_alist;           /* preallocated conses for finalization_alist */
308  LispObj finalization_alist;   /* key/value alist for finalization */
309  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
310  LispObj hash;                 /* backpointer to hash-table */
311  LispObj deleted_count;        /* number of deleted entries [not maintained if lock-free] */
312  LispObj count;                /* number of valid entries [not maintained if lock-free] */
313  LispObj cache_idx;            /* index of last cached pair */
314  LispObj cache_key;            /* value of last cached key */
315  LispObj cache_value;          /* last cached value */
316  LispObj size;                 /* number of entries in table */
317  LispObj size_reciprocal;      /* shifted reciprocal of size */
318} hash_table_vector_header;
319
320/*
321  Bits (masks)  in hash_table_vector.flags:
322*/
323
324/* GC should track keys when addresses change */ 
325#define nhash_track_keys_mask fixnum_bitmask(28)
326
327/* GC should set when nhash_track_keys_bit & addresses change */
328#define nhash_key_moved_mask  fixnum_bitmask(27)
329
330/* weak on key or value (need new "weak both" encoding.) */
331#define nhash_weak_mask       fixnum_bitmask(12)
332
333/* weak on value */
334#define nhash_weak_value_mask fixnum_bitmask(11)
335
336/* finalizable */
337#define nhash_finalizable_mask fixnum_bitmask(10)
338
339/* keys frozen, i.e. don't clobber keys, only values */
340#define nhash_keys_frozen_mask fixnum_bitmask(9)
341
342/* Lfun bits */
343
344#define lfbits_nonnullenv_mask fixnum_bitmask(0)
345#define lfbits_keys_mask fixnum_bitmask(1)
346#define lfbits_restv_mask fixnum_bitmask(7)
347#define lfbits_optinit_mask fixnum_bitmask(14)
348#define lfbits_rest_mask fixnum_bitmask(15)
349
350#define lfbits_aok_mask fixnum_bitmask(16)
351#define lfbits_lap_mask fixnum_bitmask(23)
352#define lfbits_trampoline_mask fixnum_bitmask(24)
353#define lfbits_evaluated_mask fixnum_bitmask(25)
354#define lfbits_cm_mask fixnum_bitmask(26)         /* combined_method */
355#define lfbits_nextmeth_mask fixnum_bitmask(26)   /* or call_next_method with method_mask */
356#define lfbits_gfn_mask fixnum_bitmask(27)        /* generic_function */
357#define lfbits_nextmeth_with_args_mask fixnum_bitmask(27)   /* or call_next_method_with_args with method_mask */
358#define lfbits_method_mask fixnum_bitmask(28)     /* method function */
359/* PPC only but want it defined for xcompile */
360#define lfbits_noname_mask fixnum_bitmask(29)
361
362
363/* Creole */
364
365#define doh_quantum 400
366#define doh_block_slots ((doh_quantum >> 2) - 3)
367
368typedef struct doh_block {
369  struct doh_block *link;
370  unsigned size;
371  unsigned free;
372  LispObj data[doh_block_slots];
373} doh_block, *doh_block_ptr;
374
375
376#define population_weak_list (0<<fixnum_shift)
377#define population_weak_alist (1<<fixnum_shift)
378#define population_termination_bit (16+fixnum_shift)
379#define population_type_mask ((1<<population_termination_bit)-1)
380
381#define gc_retain_pages_bit fixnum_bitmask(0)
382#define gc_integrity_check_bit fixnum_bitmask(2)
383#define egc_verbose_bit fixnum_bitmask(3)
384#define gc_verbose_bit fixnum_bitmask(4)
385#define gc_allow_stack_overflows_bit fixnum_bitmask(5)
386#define gc_postgc_pending fixnum_bitmask(26)
387
388#include "lisp-errors.h"
389
390
391
392#define TCR_BIAS (0x0)
393
394typedef struct tcr {
395  struct tcr* next;
396  struct tcr* prev;
397  struct {
398    float f;
399    u_int32_t tag;
400  } single_float_convert;
401  union {
402    double d;
403    struct {u_int32_t h, l;} words;
404  } lisp_fpscr;                 /* lisp thread's fpscr (in low word) */
405  special_binding* db_link;     /* special binding chain head */
406  LispObj catch_top;            /* top catch frame */
407  LispObj* save_vsp;  /* VSP when in foreign code */
408  LispObj* save_tsp;  /* TSP when in foreign code */
409  struct area* cs_area; /* cstack area pointer */
410  struct area* vs_area; /* vstack area pointer */
411  struct area* ts_area; /* tstack area pointer */
412  LispObj cs_limit;             /* stack overflow limit */
413  natural bytes_allocated;
414  natural log2_allocation_quantum;      /* for per-tread consing */
415  signed_natural interrupt_pending;     /* pending interrupt flag */
416  xframe_list* xframe; /* exception-frame linked list */
417  int* errno_loc;               /* per-thread (?) errno location */
418  LispObj ffi_exception;        /* fpscr bits from ff-call */
419  LispObj osid;                 /* OS thread id */
420  signed_natural valence;                       /* odd when in foreign code */
421  signed_natural foreign_exception_status;      /* non-zero -> call lisp_exit_hook */
422  void* native_thread_info;     /* platform-dependent */
423  void* native_thread_id;       /* mach_thread_t, pid_t, etc. */
424  void* last_allocptr;
425  void* save_allocptr;
426  void* save_allocbase;
427  void* reset_completion;
428  void* activate;
429  signed_natural suspend_count;
430  ExceptionInformation* suspend_context;
431  ExceptionInformation* pending_exception_context;
432  void* suspend;                /* suspension semaphore */
433  void* resume;                 /* resumption semaphore */
434  natural flags;
435  ExceptionInformation* gc_context;
436  void* termination_semaphore;
437  signed_natural unwinding;
438  natural tlb_limit;
439  LispObj* tlb_pointer;
440  natural shutdown_count;
441  void *safe_ref_address;
442} TCR;
443
444#define t_offset -(sizeof(lispsymbol))
445
446/*
447  These were previously global variables.  There are lots of implicit
448  assumptions about the size of a heap segment, so they might as well
449  be constants.
450*/
451
452#define heap_segment_size 0x00020000L
453#define log2_heap_segment_size 17L
454
455#endif
456
Note: See TracBrowser for help on using the repository browser.