source: trunk/source/lisp-kernel/x86-constants32.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.

File size: 14.5 KB
Line 
1/* offsets into uc_mcontext.ss */
2#ifdef DARWIN
3#define REG_EAX 0
4#define REG_EBX 1
5#define REG_ECX 2
6#define REG_EDX 3
7#define REG_EDI 4
8#define REG_ESI 5
9#define REG_EBP 6
10#define REG_ESP 7
11#define REG_EFL 9
12#define REG_EIP 10
13#endif
14
15#ifdef WINDOWS
16/* Offsets relative to _CONTEXT.Edi */
17#define REG_EDI 0
18#define REG_ESI 1
19#define REG_EBX 2
20#define REG_EDX 3
21#define REG_ECX 4
22#define REG_EAX 5
23#define REG_EBP 6
24#define REG_EIP 7
25#define REG_EFL 9
26#define REG_ESP 10
27#endif
28
29#ifdef FREEBSD
30#define REG_EDI 5
31#define REG_ESI 6
32#define REG_EBP 7
33#define REG_ISP 8
34#define REG_EBX 9
35#define REG_EDX 10
36#define REG_ECX 11
37#define REG_EAX 12
38#define REG_EIP 15
39#define REG_EFL 17
40#define REG_ESP 18
41#endif
42
43#ifdef SOLARIS
44#include <sys/regset.h>
45#include <limits.h>
46#define REG_EAX EAX
47#define REG_EBX EBX
48#define REG_ECX ECX
49#define REG_EDX EDX
50#define REG_ESI ESI
51#define REG_EDI EDI
52#define REG_EBP EBP
53#define REG_ESP UESP    /* Maybe ... ESP is often 0, but who knows why ? */
54#define REG_EFL EFL
55#define REG_EIP EIP
56#endif
57
58/* Indicies of GPRs in the mcontext component of a ucontext */
59#define Iimm0  REG_EAX
60#define Iarg_z REG_EBX
61#define Itemp0 REG_ECX
62#define Itemp1 REG_EDX
63#define Ifn    REG_EDI
64#define Iarg_y REG_ESI
65#define Iesp   REG_ESP
66#define Iebp   REG_EBP
67#define Ieip   REG_EIP
68#define Iflags REG_EFL
69
70#define Isp Iesp
71#define Iip Ieip
72#define Iallocptr Itemp0
73#define Ira0 Itemp0
74#define Inargs Itemp1
75#define Ixfn Itemp1
76
77/* MMX register offsets from where mm0 is found in uc_mcontext.fs */
78#define Imm0 0
79#define Imm1 1
80
81#define nbits_in_word 32
82#define log2_nbits_in_word 5
83#define nbits_in_byte 8
84#define ntagbits 3
85#define nlisptagbits 2
86#define nfixnumtagbits 2
87#define num_subtag_bits 8
88#define fixnumshift 2
89#define fixnum_shift 2
90#define fulltagmask 7
91#define tagmask  3
92#define fixnummask 3
93#define subtagmask ((1<<num_subtag_bits)-1)
94#define ncharcodebits 8
95#define charcode_shift 8
96#define node_size 4
97#define node_shift 2
98
99#define tag_fixnum 0
100#define tag_list 1
101#define tag_misc 2
102#define tag_imm 3
103
104#define fulltag_even_fixnum 0
105#define fulltag_cons 1
106#define fulltag_nodeheader 2
107#define fulltag_imm 3
108#define fulltag_odd_fixnum 4
109#define fulltag_tra 5
110#define fulltag_misc 6
111#define fulltag_immheader 7
112
113#define SUBTAG(tag,subtag) ((tag) | ((subtag) << ntagbits))
114#define IMM_SUBTAG(subtag) SUBTAG(fulltag_immheader,(subtag))
115#define NODE_SUBTAG(subtag) SUBTAG(fulltag_nodeheader,(subtag))
116
117#define subtag_bignum IMM_SUBTAG(0)
118#define min_numeric_subtag subtag_bignum
119#define subtag_ratio NODE_SUBTAG(1)
120#define max_rational_subtag subtag_ratio
121#define subtag_single_float IMM_SUBTAG(1)
122#define subtag_double_float IMM_SUBTAG(2)
123#define min_float_subtag subtag_single_float
124#define max_float_subtag subtag_double_float
125#define max_real_subtag subtag_double_float
126#define subtag_complex NODE_SUBTAG(3)
127#define max_numeric_subtag subtag_complex
128
129#define subtag_bit_vector IMM_SUBTAG(31)
130#define subtag_double_float_vector IMM_SUBTAG(30)
131#define subtag_s16_vector IMM_SUBTAG(29)
132#define subtag_u16_vector IMM_SUBTAG(28)
133#define min_16_bit_ivector_subtag subtag_u16_vector
134#define max_16_bit_ivector_subtag subtag_s16_vector
135
136/* subtag 27 unused*/
137#define subtag_s8_vector IMM_SUBTAG(26)
138#define subtag_u8_vector IMM_SUBTAG(25)
139#define min_8_bit_ivector_subtag subtag_u8_vector
140#define max_8_bit_ivector_subtag IMM_SUBTAG(27)
141
142#define subtag_simple_base_string IMM_SUBTAG(24)
143#define subtag_fixnum_vector IMM_SUBTAG(23)
144#define subtag_s32_vector IMM_SUBTAG(22)
145#define subtag_u32_vector IMM_SUBTAG(21)
146#define subtag_single_float_vector IMM_SUBTAG(20)
147#define max_32_bit_ivector_subtag IMM_SUBTAG(24)
148#define min_cl_ivector_subtag subtag_single_float_vector
149
150#define subtag_vectorH NODE_SUBTAG(20)
151#define subtag_arrayH NODE_SUBTAG(19)
152#define subtag_simple_vector NODE_SUBTAG(21)    /*  Only one such subtag */
153#define min_vector_subtag subtag_vectorH
154#define min_array_subtag subtag_arrayH
155
156#define subtag_macptr IMM_SUBTAG(3)
157#define min_non_numeric_imm_subtag subtag_macptr
158
159#define subtag_dead_macptr IMM_SUBTAG(4)
160#define subtag_code_vector IMM_SUBTAG(5)
161#define subtag_creole IMM_SUBTAG(6)
162
163#define max_non_array_imm_subtag ((19<<ntagbits)|fulltag_immheader)
164
165#define subtag_catch_frame NODE_SUBTAG(4)
166#define subtag_function NODE_SUBTAG(5)
167#define subtag_basic_stream NODE_SUBTAG(6)
168#define subtag_symbol NODE_SUBTAG(7)
169#define subtag_lock NODE_SUBTAG(8)
170#define subtag_hash_vector NODE_SUBTAG(9)
171#define subtag_pool NODE_SUBTAG(10)
172#define subtag_weak NODE_SUBTAG(11)
173#define subtag_package NODE_SUBTAG(12)
174#define subtag_slot_vector NODE_SUBTAG(13)
175#define subtag_instance NODE_SUBTAG(14)
176#define subtag_struct NODE_SUBTAG(15)
177#define subtag_istruct NODE_SUBTAG(16)
178#define max_non_array_node_subtag ((19<<ntagbits)|fulltag_immheader)
179
180#define subtag_unbound SUBTAG(fulltag_imm, 6)
181#define unbound_marker subtag_unbound
182#define undefined subtag_unbound
183#define unbound subtag_unbound
184#define subtag_character SUBTAG(fulltag_imm, 9)
185#define slot_unbound SUBTAG(fulltag_imm, 10)
186#define slot_unbound_marker slot_unbound
187#define subtag_illegal SUBTAG(fulltag_imm,11)
188#define illegal_marker subtag_illegal
189#define subtag_forward_marker SUBTAG(fulltag_imm,28)
190#define subtag_reserved_frame  SUBTAG(fulltag_imm,29)
191#define reserved_frame_marker subtag_reserved_frame
192#define subtag_no_thread_local_binding SUBTAG(fulltag_imm,30)
193#define no_thread_local_binding_marker subtag_no_thread_local_binding
194#define subtag_function_boundary_marker SUBTAG(fulltag_imm,31)
195#define function_boundary_marker subtag_function_boundary_marker
196
197typedef struct cons {
198    LispObj cdr;
199    LispObj car;
200} cons;
201
202typedef struct lispsymbol {
203    LispObj header;
204    LispObj pname;
205    LispObj vcell;
206    LispObj fcell;
207    LispObj package_predicate;
208    LispObj flags;
209    LispObj plist;
210    LispObj binding_index;
211} lispsymbol;
212
213typedef struct ratio {
214    LispObj header;
215    LispObj numer;
216    LispObj denom;
217} ratio;
218
219typedef struct double_float {
220    LispObj header;
221    LispObj pad;
222    LispObj value_low;
223    LispObj value_high;
224} double_float;
225
226typedef struct single_float {
227    LispObj header;
228    LispObj value;
229} single_float;
230
231typedef struct macptr {
232    LispObj header;
233    LispObj address;
234    LispObj class;
235    LispObj type;
236} macptr;
237
238typedef struct xmacptr {
239    LispObj header;
240    LispObj address;
241    LispObj class;
242    LispObj type;
243    LispObj flags;
244    LispObj link;
245} xmacptr;
246
247typedef struct special_binding {
248    struct special_binding *link;
249    struct lispsymbol *sym;
250    LispObj value;
251} special_binding;
252
253typedef struct lisp_frame {
254    struct lisp_frame *backlink;
255    LispObj tra;
256    LispObj xtra;               /* if tra is nvalretn */
257} lisp_frame;
258
259typedef struct exception_callback_frame {
260    struct lisp_frame *backlink;
261    LispObj tra;                /* ALWAYS 0 FOR AN XCF */
262    LispObj nominal_function;   /* the current function at the time of the exception */
263    LispObj relative_pc;        /* Boxed byte offset within actual function or absolute address */
264    LispObj containing_uvector; /* the uvector that contains the relative PC or NIL */
265    LispObj xp;                 /* exception context */
266    LispObj ra0;                /* value of ra0 from context */
267    LispObj foreign_sp;         /* foreign sp at the time that exception occurred */
268    LispObj prev_xframe;        /* so %apply-in-frame can unwind it */
269} xcf;
270
271/* The GC (at least) needs to know what a
272   package looks like, so that it can do GCTWA. */
273typedef struct package {
274    LispObj header;
275    LispObj itab;               /* itab and etab look like (vector (fixnum . fixnum) */
276    LispObj etab;
277    LispObj used;
278    LispObj used_by;
279    LispObj names;
280    LispObj shadowed;
281} package;
282
283typedef struct catch_frame {
284    LispObj header;
285    LispObj catch_tag;
286    LispObj link;
287    LispObj mvflag;
288    LispObj esp;
289    LispObj ebp;
290    LispObj foreign_sp;
291    LispObj db_link;
292    LispObj xframe;
293    LispObj pc;
294} catch_frame;
295
296#define catch_frame_element_count ((sizeof(catch_frame)/sizeof(LispObj))-1)
297#define catch_frame_header make_header(subtag_catch_frame,catch_frame_element_count)
298
299/*
300   All exception frames in a thread are linked together
301 */
302typedef struct xframe_list {
303  ExceptionInformation *curr;
304  natural node_regs_mask;
305  struct xframe_list *prev;
306} xframe_list;
307
308#define fixnum_bitmask(n)  (1<<((n)+fixnumshift))
309
310/*
311  The GC (at least) needs to know about hash-table-vectors and their flag bits.
312*/
313
314typedef struct hash_table_vector_header {
315  LispObj header;
316  LispObj link;                 /* If weak */
317  LispObj flags;                /* a fixnum; see below */
318  LispObj gc_count;             /* gc-count kernel global */
319  LispObj free_alist;           /* preallocated conses for finalization_alist */
320  LispObj finalization_alist;   /* key/value alist for finalization */
321  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
322  LispObj hash;                 /* backpointer to hash-table */
323  LispObj deleted_count;        /* number of deleted entries [not maintained if lock-free] */
324  LispObj count;                /* number of valid entries [not maintained if lock-free] */
325  LispObj cache_idx;            /* index of last cached pair */
326  LispObj cache_key;            /* value of last cached key */
327  LispObj cache_value;          /* last cached value */
328  LispObj size;                 /* number of entries in table */
329  LispObj size_reciprocal;      /* shifted reciprocal of size */
330} hash_table_vector_header;
331
332/*
333  Bits (masks) in hash_table_vector.flags:
334*/
335
336/* GC should track keys when addresses change */ 
337#define nhash_track_keys_mask fixnum_bitmask(28)
338
339/* GC should set when nhash_track_keys_bit & addresses change */
340#define nhash_key_moved_mask  fixnum_bitmask(27)
341
342/* weak on key or value (need new "weak both" encoding.) */
343#define nhash_weak_mask       fixnum_bitmask(12)
344
345/* weak on value */
346#define nhash_weak_value_mask fixnum_bitmask(11)
347
348/* finalizable */
349#define nhash_finalizable_mask fixnum_bitmask(10)
350
351/* keys frozen, i.e. don't clobber keys, only values */
352#define nhash_keys_frozen_mask fixnum_bitmask(9)
353
354/* Lfun bits */
355
356#define lfbits_nonnullenv_mask fixnum_bitmask(0)
357#define lfbits_keys_mask fixnum_bitmask(1)
358#define lfbits_restv_mask fixnum_bitmask(7)
359#define lfbits_optinit_mask fixnum_bitmask(14)
360#define lfbits_rest_mask fixnum_bitmask(15)
361#define lfbits_aok_mask fixnum_bitmask(16)
362#define lfbits_lap_mask fixnum_bitmask(23)
363#define lfbits_trampoline_mask fixnum_bitmask(24)
364#define lfbits_evaluated_mask fixnum_bitmask(25)
365#define lfbits_cm_mask fixnum_bitmask(26)         /* combined_method */
366#define lfbits_nextmeth_mask fixnum_bitmask(26)   /* or call_next_method with method_mask */
367#define lfbits_gfn_mask fixnum_bitmask(27)        /* generic_function */
368#define lfbits_nextmeth_with_args_mask fixnum_bitmask(27)   /* or call_next_method_with_args with method_mask */
369#define lfbits_method_mask fixnum_bitmask(28)     /* method function */
370/* PPC only but want it defined for xcompile */
371#define lfbits_noname_mask fixnum_bitmask(29)
372
373
374/* Creole */
375
376#define doh_quantum 400
377#define doh_block_slots ((doh_quantum >> 2) - 3)
378
379typedef struct doh_block {
380  struct doh_block *link;
381  unsigned size;
382  unsigned free;
383  LispObj data[doh_block_slots];
384} doh_block, *doh_block_ptr;
385
386#define population_weak_list (0<<fixnum_shift)
387#define population_weak_alist (1<<fixnum_shift)
388#define population_termination_bit (16+fixnum_shift)
389#define population_type_mask ((1<<population_termination_bit)-1)
390
391#define gc_retain_pages_bit fixnum_bitmask(0)
392#define gc_integrity_check_bit fixnum_bitmask(2)
393#define egc_verbose_bit fixnum_bitmask(3)
394#define gc_verbose_bit fixnum_bitmask(4)
395#define gc_allow_stack_overflows_bit fixnum_bitmask(5)
396#define gc_postgc_pending fixnum_bitmask(26)
397
398#include "lisp-errors.h"
399
400#ifdef DARWIN
401#include <architecture/i386/sel.h>
402#else
403typedef unsigned short sel_t;   /* for now */
404#endif
405
406#define TCR_BIAS 0
407
408/*
409 * bits correspond to reg encoding used in instructions
410 *   7   6   5   4   3   2   1   0
411 *  edi esi ebp esp ebx edx ecx eax
412 */
413
414#define X8632_DEFAULT_NODE_REGS_MASK 0xce
415
416typedef struct tcr {
417  struct tcr *next;
418  struct tcr *prev;
419  natural node_regs_mask; /* bit set means correspnding reg contains node */
420  struct tcr *linear;
421  /* this spill area must be 16-byte aligned */
422  LispObj save0;                /* spill area for node registers */
423  LispObj save1;
424  LispObj save2;
425  LispObj save3;
426  LispObj *save_ebp;            /* EBP when in foreign code */
427  u32_t lisp_mxcsr;
428  u32_t foreign_mxcsr;
429  special_binding *db_link;     /* special binding chain head */
430  LispObj catch_top;            /* top catch frame */
431  LispObj *save_vsp;              /* VSP when in foreign code */
432  LispObj *save_tsp;              /* TSP when in foreign code */
433  LispObj *foreign_sp;
434  struct area *cs_area;         /* cstack area pointer */
435  struct area *vs_area;         /* vstack area pointer */
436  struct area *ts_area;         /* tstack area pointer */
437  LispObj cs_limit;                     /* stack overflow limit */
438  natural bytes_allocated;
439  natural bytes_consed_high;
440  natural log2_allocation_quantum;      /* for per-thread consing */
441  signed_natural interrupt_pending;     /* pending interrupt flag */
442  xframe_list *xframe;    /* exception-frame linked list */
443  int *errno_loc;               /* per-thread (?) errno location */
444  LispObj ffi_exception;        /* fpscr bits from ff-call */
445  LispObj osid;                 /* OS thread id */
446  signed_natural valence;         /* odd when in foreign code */
447  signed_natural foreign_exception_status; /* non-zero -> call lisp_exit_hook */
448  void *native_thread_info;                  /* platform-dependent */
449  void *native_thread_id;       /* mach_thread_t, pid_t, etc. */
450  void *last_allocptr;
451  void *save_allocptr;
452  void *save_allocbase;
453  void *reset_completion;
454  void *activate;
455  signed_natural suspend_count;
456  ExceptionInformation *suspend_context;
457  ExceptionInformation *pending_exception_context;
458  void *suspend;                /* suspension semaphore */
459  void *resume;                 /* resumption semaphore */
460  natural flags;
461  ExceptionInformation *gc_context;
462  void *termination_semaphore;
463  signed_natural unwinding;
464  natural tlb_limit;
465  LispObj *tlb_pointer;
466  natural shutdown_count;
467  LispObj *next_tsp;
468  void *safe_ref_address;
469  sel_t ldt_selector;
470  natural scratch_mxcsr;
471  natural unboxed0;
472  natural unboxed1;
473  LispObj next_method_context; /* used in lieu of register */
474  natural save_eflags;
475  void *allocated;
476  void *pending_io_info;
477  void *io_datum;
478} TCR;
479
480#define nil_value ((0x13000 + (fulltag_cons))+(LOWMEM_BIAS))
481#define t_value ((0x13008 + (fulltag_misc))+(LOWMEM_BIAS))
482#define t_offset (t_value-nil_value)
483#define misc_header_offset -fulltag_misc
484#define misc_data_offset misc_header_offset + node_size
485
486#define heap_segment_size 0x00010000
487#define log2_heap_segment_size 16
488
489#ifndef EFL_DF
490#define EFL_DF 1024
491#endif
Note: See TracBrowser for help on using the repository browser.