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

Last change on this file since 10731 was 10731, checked in by gz, 12 years ago

Implemented "nearly-lock-free" hash tables. They are created by
calling MAKE-HASH-TABLE with :LOCK-FREE t, or by setting
CCL::*LOCK-FREE-HASH-TABLE-DEFAULT* to T. There is some documentation
in a big comment in l0-hash.lisp, but basically the idea is to try to
avoid any locking in GETHASH, getting the performance equivalent to
readonly tables, at the cost of rehashing becoming more
expensive. PUTHASH should be roughly equivalent (it avoids getting a
lock, but does sync memory a few times).

So far, I've only tested them on linuxx8664, by building ccl multiple
times with *lock-free-hash-table-default* = T on, so no real
multi-threaded testing. I will now switch to the mac and try to
build and use the IDE that way.

Other changes: moved some slots from the hash table to the hash table
vector so they can all be swapped in/out all at once. Made nhash.find
return -1 when not found, also to avoid some synchronization issues.
%needs-rehashing-p now takes a hash table vector, not the hash table.
Got rid of a bunch of unused slots and constants in hash tables.

Incremented fasl version in case there are any fasdumped hash tables out there.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.7 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))
136#define t_value (0x3000+fulltag_misc)   
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  known values of an "extended" (gcable) macptr's flags word:
364*/
365
366typedef enum {
367  xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
368  xmacptr_flag_recursive_lock,  /* recursive-lock */
369  xmacptr_flag_ptr,             /* malloc/free */
370  xmacptr_flag_rwlock,          /* read/write lock */
371  xmacptr_flag_semaphore        /* semaphore */
372} xmacptr_flag;
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
387#define population_weak_list (0<<fixnum_shift)
388#define population_weak_alist (1<<fixnum_shift)
389#define population_termination_bit (16+fixnum_shift)
390#define population_type_mask ((1<<population_termination_bit)-1)
391
392#define gc_retain_pages_bit fixnum_bitmask(0)
393#define gc_integrity_check_bit fixnum_bitmask(2)
394#define egc_verbose_bit fixnum_bitmask(3)
395#define gc_verbose_bit fixnum_bitmask(4)
396#define gc_allow_stack_overflows_bit fixnum_bitmask(5)
397#define gc_postgc_pending fixnum_bitmask(26)
398
399#include "lisp-errors.h"
400
401
402
403#define TCR_BIAS (0x0)
404
405typedef struct tcr {
406  struct tcr* next;
407  struct tcr* prev;
408  struct {
409    float f;
410    u_int32_t tag;
411  } single_float_convert;
412  union {
413    double d;
414    struct {u_int32_t h, l;} words;
415  } lisp_fpscr;                 /* lisp thread's fpscr (in low word) */
416  special_binding* db_link;     /* special binding chain head */
417  LispObj catch_top;            /* top catch frame */
418  LispObj* save_vsp;  /* VSP when in foreign code */
419  LispObj* save_tsp;  /* TSP when in foreign code */
420  struct area* cs_area; /* cstack area pointer */
421  struct area* vs_area; /* vstack area pointer */
422  struct area* ts_area; /* tstack area pointer */
423  LispObj cs_limit;             /* stack overflow limit */
424  natural bytes_allocated;
425  natural log2_allocation_quantum;      /* for per-tread consing */
426  signed_natural interrupt_pending;     /* pending interrupt flag */
427  xframe_list* xframe; /* exception-frame linked list */
428  int* errno_loc;               /* per-thread (?) errno location */
429  LispObj ffi_exception;        /* fpscr bits from ff-call */
430  LispObj osid;                 /* OS thread id */
431  signed_natural valence;                       /* odd when in foreign code */
432  signed_natural foreign_exception_status;      /* non-zero -> call lisp_exit_hook */
433  void* native_thread_info;     /* platform-dependent */
434  void* native_thread_id;       /* mach_thread_t, pid_t, etc. */
435  void* last_allocptr;
436  void* save_allocptr;
437  void* save_allocbase;
438  void* reset_completion;
439  void* activate;
440  signed_natural suspend_count;
441  ExceptionInformation* suspend_context;
442  ExceptionInformation* pending_exception_context;
443  void* suspend;                /* suspension semaphore */
444  void* resume;                 /* resumption semaphore */
445  natural flags;
446  ExceptionInformation* gc_context;
447  void* termination_semaphore;
448  signed_natural unwinding;
449  natural tlb_limit;
450  LispObj* tlb_pointer;
451  natural shutdown_count;
452  void *safe_ref_address;
453} TCR;
454
455#define t_offset -(sizeof(lispsymbol))
456
457/*
458  These were previously global variables.  There are lots of implicit
459  assumptions about the size of a heap segment, so they might as well
460  be constants.
461*/
462
463#define heap_segment_size 0x00020000L
464#define log2_heap_segment_size 17L
465
466#endif
467
Note: See TracBrowser for help on using the repository browser.