source: branches/1.2/devel/source/lisp-kernel/ppc-constants64.h @ 8123

Last change on this file since 8123 was 5640, checked in by gb, 14 years ago

nil_value, etc a page higher.

  • 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))
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 free_alist;           /* preallocated conses for finalization_alist */
307  LispObj finalization_alist;   /* key/value alist for finalization */
308  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
309  LispObj hash;                 /* backpointer to hash-table */
310  LispObj deleted_count;        /* number of deleted entries */
311  LispObj cache_idx;            /* index of last cached pair */
312  LispObj cache_key;            /* value of last cached key */
313  LispObj cache_value;          /* last cached value */
314} hash_table_vector_header;
315
316/*
317  Bits (masks)  in hash_table_vector.flags:
318*/
319
320/* GC should track keys when addresses change */ 
321#define nhash_track_keys_mask fixnum_bitmask(28)
322
323/* GC should set when nhash_track_keys_bit & addresses change */
324#define nhash_key_moved_mask  fixnum_bitmask(27)
325
326/* weak on key or value (need new "weak both" encoding.) */
327#define nhash_weak_mask       fixnum_bitmask(12)
328
329/* weak on value */
330#define nhash_weak_value_mask fixnum_bitmask(11)
331
332/* finalizable */
333#define nhash_finalizable_mask fixnum_bitmask(10)
334
335
336/* Lfun bits */
337
338#define lfbits_nonnullenv_mask fixnum_bitmask(0)
339#define lfbits_keys_mask fixnum_bitmask(1)
340#define lfbits_restv_mask fixnum_bitmask(7)
341#define lfbits_optinit_mask fixnum_bitmask(14)
342#define lfbits_rest_mask fixnum_bitmask(15)
343#define lfbits_aok_mask fixnum_bitmask(16)
344#define lfbits_lap_mask fixnum_bitmask(23)
345#define lfbits_trampoline_mask fixnum_bitmask(24)
346#define lfbits_evaluated_mask fixnum_bitmask(25)
347#define lfbits_cm_mask fixnum_bitmask(26)         /* combined_method */
348#define lfbits_nextmeth_mask fixnum_bitmask(26)   /* or call_next_method with method_mask */
349#define lfbits_gfn_mask fixnum_bitmask(27)        /* generic_function */
350#define lfbits_nextmeth_with_args_mask fixnum_bitmask(27)   /* or call_next_method_with_args with method_mask */
351#define lfbits_method_mask fixnum_bitmask(28)     /* method function */
352/* PPC only but want it defined for xcompile */
353#define lfbits_noname_mask fixnum_bitmask(29)
354
355/*
356  known values of an "extended" (gcable) macptr's flags word:
357*/
358
359typedef enum {
360  xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
361  xmacptr_flag_recursive_lock,  /* recursive-lock */
362  xmacptr_flag_ptr,             /* malloc/free */
363  xmacptr_flag_rwlock,          /* read/write lock */
364  xmacptr_flag_semaphore        /* semaphore */
365} xmacptr_flag;
366
367/* Creole */
368
369#define doh_quantum 400
370#define doh_block_slots ((doh_quantum >> 2) - 3)
371
372typedef struct doh_block {
373  struct doh_block *link;
374  unsigned size;
375  unsigned free;
376  LispObj data[doh_block_slots];
377} doh_block, *doh_block_ptr;
378
379
380#define population_weak_list (0<<fixnum_shift)
381#define population_weak_alist (1<<fixnum_shift)
382#define population_termination_bit (16+fixnum_shift)
383#define population_type_mask ((1<<population_termination_bit)-1)
384
385#define gc_retain_pages_bit fixnum_bitmask(0)
386#define gc_integrity_check_bit fixnum_bitmask(2)
387#define egc_verbose_bit fixnum_bitmask(3)
388#define gc_verbose_bit fixnum_bitmask(4)
389#define gc_allow_stack_overflows_bit fixnum_bitmask(5)
390#define gc_postgc_pending fixnum_bitmask(26)
391
392#include "lisp-errors.h"
393
394
395
396#define TCR_BIAS (0x0)
397
398typedef struct tcr {
399  struct tcr* next;
400  struct tcr* prev;
401  struct {
402    float f;
403    u_int32_t tag;
404  } single_float_convert;
405  union {
406    double d;
407    struct {u_int32_t h, l;} words;
408  } lisp_fpscr;                 /* lisp thread's fpscr (in low word) */
409  special_binding* db_link;     /* special binding chain head */
410  LispObj catch_top;            /* top catch frame */
411  LispObj* save_vsp;  /* VSP when in foreign code */
412  LispObj* save_tsp;  /* TSP when in foreign code */
413  struct area* cs_area; /* cstack area pointer */
414  struct area* vs_area; /* vstack area pointer */
415  struct area* ts_area; /* tstack area pointer */
416  LispObj cs_limit;             /* stack overflow limit */
417  natural bytes_allocated;
418  natural log2_allocation_quantum;      /* for per-tread consing */
419  signed_natural interrupt_pending;     /* pending interrupt flag */
420  xframe_list* xframe; /* exception-frame linked list */
421  int* errno_loc;               /* per-thread (?) errno location */
422  LispObj ffi_exception;        /* fpscr bits from ff-call */
423  LispObj osid;                 /* OS thread id */
424  signed_natural valence;                       /* odd when in foreign code */
425  signed_natural foreign_exception_status;      /* non-zero -> call lisp_exit_hook */
426  void* native_thread_info;     /* platform-dependent */
427  void* native_thread_id;       /* mach_thread_t, pid_t, etc. */
428  void* last_allocptr;
429  void* save_allocptr;
430  void* save_allocbase;
431  void* reset_completion;
432  void* activate;
433  signed_natural suspend_count;
434  ExceptionInformation* suspend_context;
435  ExceptionInformation* pending_exception_context;
436  void* suspend;                /* suspension semaphore */
437  void* resume;                 /* resumption semaphore */
438  natural flags;
439  ExceptionInformation* gc_context;
440  void* termination_semaphore;
441  signed_natural unwinding;
442  natural tlb_limit;
443  LispObj* tlb_pointer;
444  natural shutdown_count;
445  void *safe_ref_address;
446} TCR;
447
448#define t_offset -(sizeof(lispsymbol))
449
450/*
451  These were previously global variables.  There are lots of implicit
452  assumptions about the size of a heap segment, so they might as well
453  be constants.
454*/
455
456#define heap_segment_size 0x00020000L
457#define log2_heap_segment_size 17L
458
459#endif
460
Note: See TracBrowser for help on using the repository browser.