source: trunk/ccl/lisp-kernel/constants64.h @ 557

Last change on this file since 557 was 557, checked in by gb, 16 years ago

PPC64 changes (some of them rather suspect ...). 32-bit kernel may be a
little funky ...

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.0 KB
Line 
1/*
2   Copyright (C) 1994-2001 Digitool, Inc
3   This file is part of OpenMCL. 
4
5   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
6   License , known as the LLGPL and distributed with OpenMCL as the
7   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
8   which is distributed with OpenMCL as the file "LGPL".  Where these
9   conflict, the preamble takes precedence. 
10
11   OpenMCL is referenced in the preamble as the "LIBRARY."
12
13   The LLGPL is also available online at
14   http://opensource.franz.com/preamble.html
15*/
16
17#ifndef __constants64__
18#define __constants64__ 1
19
20
21#define nbits_in_word 64
22#define nbits_in_byte 8
23#define ntagbits 4     
24#define nlisptagbits 3
25#define nfixnumtagbits 2
26#define num_subtag_bits 8
27#define fixnumshift 3
28#define fixnum_shift 3
29#define fulltagmask 15
30#define tagmask  7
31#define fixnummask 3
32#define subtagmask ((1<<num_subtag_bits)-1)
33#define ncharcodebits 16
34#define charcode_shift (nbits_in_word-ncharcodebits)
35#define node_size 8
36#define node_shift 3
37
38#define lowtagmask 3
39#define lowtag_mask lowtagmask
40
41#define lowtag_primary 0
42#define lowtag_imm 1
43#define lowtag_immheader 2
44#define lowtag_nodeheader 3
45
46#define tag_fixnum 0
47
48#define fulltag_even_fixnum 0
49#define fulltag_imm_0 1
50#define fulltag_immheader_0 2
51#define fulltag_nodeheader_0 3
52#define fulltag_cons 4
53#define fulltag_imm_1 5
54#define fulltag_immheader_1 6
55#define fulltag_nodeheader_1 7
56#define fulltag_odd_fixnum 8
57#define fulltag_imm_2 9
58#define fulltag_immheader_2 10
59#define fulltag_nodeheader_2 11
60#define fulltag_misc 12
61#define fulltag_imm_3 13
62#define fulltag_immheader_3 14
63#define fulltag_nodeheader_3 15
64
65#define SUBTAG(tag,subtag) ((tag) | ((subtag) << ntagbits))
66#define cl_array_subtag_mask 0x80
67#define CL_ARRAY_SUBTAG(tag,subtag) (cl_array_subtag_mask | (SUBTAG(tag,subtag)))
68
69#define subtag_arrayH CL_ARRAY_SUBTAG(fulltag_nodeheader_1,0)
70#define subtag_vectorH CL_ARRAY_SUBTAG(fulltag_nodeheader_2,0)
71#define subtag_simple_vector CL_ARRAY_SUBTAG(fulltag_nodeheader_3,0)
72#define min_vector_subtag subtag_vectorH       
73
74#define ivector_class_64_bit fulltag_immheader_3
75#define ivector_class_32_bit fulltag_immheader_2
76#define ivector_class_other_bit fulltag_immheader_1
77#define ivector_class_8_bit fulltag_immheader_0
78
79#define subtag_s64_vector CL_ARRAY_SUBTAG(ivector_class_64_bit,1)
80#define subtag_u64_vector CL_ARRAY_SUBTAG(ivector_class_64_bit,2)
81#define subtag_double_float_vector CL_ARRAY_SUBTAG(ivector_class_64_bit,4)
82#define subtag_s32_vector CL_ARRAY_SUBTAG(ivector_class_32_bit,1)
83#define subtag_u32_vector CL_ARRAY_SUBTAG(ivector_class_32_bit,2)
84#define subtag_single_float_vector CL_ARRAY_SUBTAG(ivector_class_32_bit,3)
85#define subtag_s16_vector CL_ARRAY_SUBTAG(ivector_class_other_bit,1)
86#define subtag_u16_vector CL_ARRAY_SUBTAG(ivector_class_other_bit,2)
87#define subtag_bit_vector CL_ARRAY_SUBTAG(ivector_class_other_bit,7)
88#define subtag_s8_vector CL_ARRAY_SUBTAG(ivector_class_8_bit,1)
89#define subtag_u8_vector CL_ARRAY_SUBTAG(ivector_class_8_bit,2)
90#define subtag_simple_base_string CL_ARRAY_SUBTAG(ivector_class_8_bit,5)
91
92
93/* There's some room for expansion in non-array ivector space. */
94#define subtag_bignum SUBTAG(ivector_class_64_bit,0)
95#define subtag_double_float SUBTAG(ivector_class_64_bit,3)
96#define subtag_macptr SUBTAG(ivector_class_64_bit,5)
97#define subtag_dead_macptr SUBTAG(ivector_class_64_bit,6)
98#define subtag_code_vector SUBTAG(ivector_class_32_bit,0)
99#define subtag_xcode_vector SUBTAG(ivector_class_32_bit,1)
100
101
102/*
103 Size doesn't matter for non-CL-array gvectors; I can't think of a good
104 reason to classify them in any particular way.  Let's put funcallable
105 things in the first slice by themselves, though it's not clear that
106 that helps FUNCALL much.
107*/
108#define gvector_funcallable fulltag_nodeheader_0
109       
110#define subtag_function SUBTAG(gvector_funcallable,0)
111#define subtag_symbol SUBTAG(gvector_funcallable,1)
112#define subtag_catch_frame SUBTAG(fulltag_nodeheader_1,0)
113#define subtag_lisp_thread SUBTAG(fulltag_nodeheader_1,1)
114#define subtag_lock SUBTAG(fulltag_nodeheader_1,2)
115#define subtag_hash_vector SUBTAG(fulltag_nodeheader_1,3)
116#define subtag_pool SUBTAG(fulltag_nodeheader_1,4)
117#define subtag_weak SUBTAG(fulltag_nodeheader_1,5)
118#define subtag_package SUBTAG(fulltag_nodeheader_1,6)
119#define subtag_svar SUBTAG(fulltag_nodeheader_1,7)
120#define subtag_slot_vector SUBTAG(0,fulltag_nodeheader_2)
121#define subtag_instance SUBTAG(1,fulltag_nodeheader_2)
122#define subtag_struct SUBTAG(2,fulltag_nodeheader_2)
123#define subtag_istruct SUBTAG(3,fulltag_nodeheader_2)
124#define subtag_value_cell SUBTAG(4,fulltag_nodeheader_2)
125#define subtag_xfunction SUBTAG(5,fulltag_nodeheader_2)
126
127
128#define nil_value (0x2000+fulltag_misc+sizeof(struct lispsymbol))
129#define t_value (0x2000+fulltag_misc)   
130#define misc_bias fulltag_misc
131#define cons_bias fulltag_cons
132
133       
134#define misc_header_offset -fulltag_misc
135#define misc_subtag_offset misc_header_offset+7       /* low byte of header */
136#define misc_data_offset misc_header_offset+4           /* first word of data */
137#define misc_dfloat_offset misc_header_offset           /* double-floats are doubleword-aligned */
138
139#define subtag_single_float SUBTAG(fulltag_imm_0,0)
140
141#define subtag_go_tag SUBTAG(fulltag_imm_1,2)
142#define subtag_block_tag SUBTAG(fulltag_imm_1,3)
143
144#define subtag_character SUBTAG(fulltag_imm_2,0)
145
146#define subtag_unbound SUBTAG(fulltag_imm_3,0)
147#define unbound_marker subtag_unbound
148#define undefined unbound_marker
149#define subtag_slot_unbound SUBTAG(fulltag_imm_3,1)
150#define slot_unbound_marker subtag_slot_unbound
151#define subtag_illegal SUBTAG(fulltag_imm_3,2)
152#define illegal_marker subtag_illegal
153#define subtag_no_thread_local_binding SUBTAG(fulltag_imm_3,3)
154#define no_thread_local_binding_marker subtag_no_thread_local_binding       
155#define subtag_forward_marker SUBTAG(fulltag_imm_3,15)
156       
157#define max_64_bit_constant_index ((0x7fff + misc_dfloat_offset)>>3)
158#define max_32_bit_constant_index ((0x7fff + misc_data_offset)>>2)
159#define max_16_bit_constant_index ((0x7fff + misc_data_offset)>>1)
160#define max_8_bit_constant_index (0x7fff + misc_data_offset)
161#define max_1_bit_constant_index ((0x7fff + misc_data_offset)<<5)
162
163
164/* The objects themselves look something like this: */
165
166/*  Order of CAR and CDR doesn't seem to matter much - there aren't */
167/*  too many tricks to be played with predecrement/preincrement addressing. */
168/*  Keep them in the confusing MCL 3.0 order, to avoid confusion. */
169
170typedef struct cons {
171  LispObj cdr;
172  LispObj car;
173} cons;
174
175
176
177typedef struct lispsymbol {
178  LispObj header;
179  LispObj pname;
180  LispObj vcell;
181  LispObj fcell;
182  LispObj package_plist;
183  LispObj flags;
184} lispsymbol;
185
186typedef struct ratio {
187  LispObj header;
188  LispObj numer;
189  LispObj denom;
190} ratio;
191
192typedef struct double_float {
193  LispObj header;
194  LispObj value;
195} double_float;
196
197
198typedef struct macptr {
199  LispObj header;
200  LispObj address;
201  LispObj class;
202  LispObj type;
203} macptr;
204
205typedef struct xmacptr {
206  LispObj header;
207  LispObj address;
208  LispObj class;
209  LispObj type;
210  LispObj flags;
211  LispObj link;
212} xmacptr;
213 
214
215typedef struct eabi_c_frame {
216  struct eabi_c_frame *backlink;
217  unsigned savelr;
218  LispObj params[8];
219} eabi_c_frame;
220
221/* PowerOpen ABI C frame */
222
223typedef struct c_frame {
224  struct c_frame *backlink;
225  unsigned crsave;
226  unsigned savelr;
227  unsigned unused[2];
228  unsigned savetoc;             /* Used with CFM */
229  unsigned params[8];           /* Space for callee to save r3-r10 */
230} c_frame;
231
232typedef struct lisp_frame {
233  struct lisp_frame *backlink;
234  LispObj savefn;
235  LispObj savelr;
236  LispObj savevsp;
237} lisp_frame;
238
239typedef struct special_binding {
240  struct special_binding *link;
241  struct lispsymbol *sym;
242  LispObj value;
243} special_binding;
244
245/* The GC (at least) needs to know what a
246   package looks like, so that it can do GCTWA. */
247typedef struct package {
248  LispObj header;
249  LispObj itab;                 /* itab and etab look like (vector (fixnum . fixnum) */
250  LispObj etab;
251  LispObj used;
252  LispObj used_by;
253  LispObj names;
254  LispObj shadowed;
255} package;
256
257/*
258  The GC also needs to know what a catch_frame looks like.
259*/
260
261typedef struct catch_frame {
262  LispObj header;
263  LispObj catch_tag;
264  LispObj link;
265  LispObj mvflag;
266  LispObj csp;
267  LispObj db_link;
268  LispObj regs[8];
269  LispObj xframe;
270  LispObj tsp_segment;
271} catch_frame;
272
273#define catch_frame_element_count ((sizeof(catch_frame)/sizeof(LispObj))-1)
274#define catch_frame_header make_header(subtag_catch_frame,catch_frame_element_count)
275
276
277/*
278  All exception frames in a thread are linked together
279  */
280typedef struct xframe_list {
281  ExceptionInformationPowerPC *curr;
282  struct xframe_list *prev;
283} xframe_list;
284
285#define fixnum_bitmask(n)  (1<<((n)+fixnumshift))
286
287/*
288  The GC (at least) needs to know about hash-table-vectors and their flag bits.
289*/
290
291typedef struct hash_table_vector_header {
292  LispObj header;
293  LispObj link;                 /* If weak */
294  LispObj flags;                /* a fixnum; see below */
295  LispObj free_alist;           /* preallocated conses for finalization_alist */
296  LispObj finalization_alist;   /* key/value alist for finalization */
297  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
298  LispObj hash;                 /* backpointer to hash-table */
299  LispObj deleted_count;        /* number of deleted entries */
300  LispObj cache_idx;            /* index of last cached pair */
301  LispObj cache_key;            /* value of last cached key */
302  LispObj cache_value;          /* last cached value */
303} hash_table_vector_header;
304
305/*
306  Bits (masks)  in hash_table_vector.flags:
307*/
308
309/* GC should track keys when addresses change */ 
310#define nhash_track_keys_mask fixnum_bitmask(28)
311
312/* GC should set when nhash_track_keys_bit & addresses change */
313#define nhash_key_moved_mask  fixnum_bitmask(27)
314
315/* weak on key or value (need new "weak both" encoding.) */
316#define nhash_weak_mask       fixnum_bitmask(12)
317
318/* weak on value */
319#define nhash_weak_value_mask fixnum_bitmask(11)
320
321/* finalizable */
322#define nhash_finalizable_mask fixnum_bitmask(10)
323
324
325/* Lfun bits */
326
327#define lfbits_nonnullenv_mask fixnum_bitmask(0)
328#define lfbits_keys_mask fixnum_bitmask(1)
329#define lfbits_restv_mask fixnum_bitmask(7)
330#define lfbits_optinit_mask fixnum_bitmask(14)
331#define lfbits_rest_mask fixnum_bitmask(15)
332#define lfbits_aok_mask fixnum_bitmask(16)
333#define lfbits_lap_mask fixnum_bitmask(23)
334#define lfbits_trampoline_mask fixnum_bitmask(24)
335#define lfbits_evaluated_mask fixnum_bitmask(25)
336#define lfbits_cm_mask fixnum_bitmask(26)         /* combined_method */
337#define lfbits_nextmeth_mask fixnum_bitmask(26)   /* or call_next_method with method_mask */
338#define lfbits_gfn_mask fixnum_bitmask(27)        /* generic_function */
339#define lfbits_nextmeth_with_args_mask fixnum_bitmask(27)   /* or call_next_method_with_args with method_mask */
340#define lfbits_method_mask fixnum_bitmask(28)     /* method function */
341/* PPC only but want it defined for xcompile */
342#define lfbits_noname_mask fixnum_bitmask(29)
343
344/*
345  known values of an "extended" (gcable) macptr's flags word:
346*/
347
348typedef enum {
349  xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
350  xmacptr_flag_recursive_lock,  /* recursive-lock */
351  xmacptr_flag_ptr,             /* malloc/free */
352  xmacptr_flag_rwlock,          /* read/write lock */
353  xmacptr_flag_semaphore        /* semaphore */
354} xmacptr_flag;
355
356/* Creole */
357
358#define doh_quantum 400
359#define doh_block_slots ((doh_quantum >> 2) - 3)
360
361typedef struct doh_block {
362  struct doh_block *link;
363  unsigned size;
364  unsigned free;
365  LispObj data[doh_block_slots];
366} doh_block, *doh_block_ptr;
367
368
369#define population_weak_list (0<<fixnum_shift)
370#define population_weak_alist (1<<fixnum_shift)
371#define population_termination_bit (16+fixnum_shift)
372#define population_type_mask ((1<<population_termination_bit)-1)
373
374#define gc_retain_pages_bit fixnum_bitmask(0)
375#define gc_integrity_check_bit fixnum_bitmask(2)
376#define gc_allow_stack_overflows_bit fixnum_bitmask(5)
377#define gc_postgc_pending fixnum_bitmask(26)
378
379#include "lisp-errors.h"
380
381
382
383
384
385typedef struct tcr {
386  NATURAL_POINTER_FIELD(struct tcr,next);
387  NATURAL_POINTER_FIELD(struct tcr,prev);
388  struct {
389    float f;
390    u_int32_t tag;
391  } single_float_convert;
392  union {
393    double d;
394    struct {u_int32_t h, l;} words;
395  } lisp_fpscr;                 /* lisp thread's fpscr (in low word) */
396  NATURAL_POINTER_FIELD(special_binding,db_link);       /* special binding chain head */
397  LispObj catch_top;            /* top catch frame */
398  NATURAL_POINTER_FIELD(LispObj,save_vsp);  /* VSP when in foreign code */
399  NATURAL_POINTER_FIELD(LispObj,save_tsp);  /* TSP when in foreign code */
400  NATURAL_POINTER_FIELD(struct area,cs_area); /* cstack area pointer */
401  NATURAL_POINTER_FIELD(struct area,vs_area); /* vstack area pointer */
402  NATURAL_POINTER_FIELD(struct area,ts_area); /* tstack area pointer */
403  LispObj cs_limit;             /* stack overflow limit */
404  natural bytes_allocated;
405  signed_natural interrupt_level;      /* for w-o-i preemption */
406  signed_natural interrupt_pending;     /* likewise */
407  NATURAL_POINTER_FIELD(xframe_list,xframe); /* exception-frame linked list */
408  NATURAL_POINTER_FIELD(int,errno_loc);         /* per-thread (?) errno location */
409  LispObj ffi_exception;        /* fpscr bits from ff-call */
410  LispObj osid;                 /* OS thread id */
411  signed_natural valence;                       /* odd when in foreign code */
412  signed_natural foreign_exception_status;      /* non-zero -> call lisp_exit_hook */
413  NATURAL_POINTER_FIELD(void,native_thread_info);       /* platform-dependent */
414  NATURAL_POINTER_FIELD(void,native_thread_id); /* mach_thread_t, pid_t, etc. */
415  NATURAL_POINTER_FIELD(void,last_allocptr);
416  NATURAL_POINTER_FIELD(void,save_allocptr);
417  NATURAL_POINTER_FIELD(void,save_allocbase);
418  NATURAL_POINTER_FIELD(void,reset_completion);
419  NATURAL_POINTER_FIELD(void,activate);
420  signed_natural suspend_count;
421  NATURAL_POINTER_FIELD(ExceptionInformation,suspend_context);
422  NATURAL_POINTER_FIELD(ExceptionInformation,pending_exception_context);
423  NATURAL_POINTER_FIELD(void,suspend);          /* suspension semaphore */
424  NATURAL_POINTER_FIELD(void,resume);                   /* resumption semaphore */
425  signed_natural flags;
426  NATURAL_POINTER_FIELD(ExceptionInformation,gc_context);
427  signed_natural suspend_total;
428  signed_natural suspend_total_on_exception_entry;
429  natural tlb_limit;
430  NATURAL_POINTER_FIELD(LispObj,tlb_pointer);
431  natural shutdown_count;
432} TCR;
433
434
435
436#endif
437
Note: See TracBrowser for help on using the repository browser.