source: trunk/ccl/lisp-kernel/constants.h @ 469

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

Add shutdown_count field to tcr.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 16.5 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 __constants__
18#define __constants__ 1
19
20
21#define nbits_in_word 32
22#define nbits_in_byte 8
23#define ntagbits 3      /* But only 2 are significant to lisp */
24#define nlisptagbits 2
25#define nfixnumtagbits 2
26#define num_subtag_bits 8
27#define fixnumshift 2
28#define fixnum_shift 2
29#define fulltagmask 7
30#define tagmask  3
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
36/*  Tags. */
37/*  There are two-bit tags and three-bit tags. */
38/*  A FULLTAG is the value of the low three bits of a tagged object. */
39/*  A TAG is the value of the low two bits of a tagged object. */
40/*  A TYPECODE is either a TAG or the value of a "tag-misc" object's header-byte. */
41
42/*  There are 4 primary TAG values.  Any object which lisp can "see" can be classified  */
43/*  by its TAG.  (Some headers have FULLTAGS that are congruent modulo 4 with the */
44/*  TAGS of other objects, but lisp can't "see" headers.) */
45
46
47#define tag_fixnum 0    /*  All fixnums, whether odd or even */
48#define tag_list 1      /*  Conses and NIL */
49#define tag_misc 2      /*  Heap-consed objects other than lists: vectors, symbols, functions, floats ... */
50#define tag_imm  3      /*  Immediate-objects: characters, UNBOUND, other markers. */
51
52/*  And there are 8 FULLTAG values.  Note that NIL has its own FULLTAG (congruent mod 4 to tag-list), */
53/*  that FULLTAG-MISC is > 4 (so that code-vector entry-points can be branched to, since the low */
54/*  two bits of the PC are ignored) and that both FULLTAG-MISC and FULLTAG-IMM have header fulltags */
55/*  that share the same TAG. */
56/*  Things that walk memory (and the stack) have to be careful to look at the FULLTAG of each */
57/*  object that they see. */
58
59#define fulltag_even_fixnum 0   /*  I suppose EVENP/ODDP might care; nothing else does. */
60#define fulltag_cons     1      /*  a real (non_null) cons.  Shares TAG with fulltag_nil. */
61#define fulltag_nodeheader 2    /*  Header of heap_allocated object that contains lisp_object pointers */
62#define fulltag_imm      3      /*  a "real" immediate object.  Shares TAG with fulltag_immheader. */
63#define fulltag_odd_fixnum 4    /*   */
64#define fulltag_nil      5      /*  NIL and nothing but.  (Note that there's still a hidden NILSYM.) */
65#define fulltag_misc     6      /*  Pointer "real" tag_misc object.  Shares TAG with fulltag_nodeheader. */
66#define fulltag_immheader 7     /*  Header of heap-allocated object that contains unboxed data. */
67
68/*  Register usage: */
69#define rzero 0
70#define sp 1
71#define rcontext 2
72#define imm0 3
73#define imm1 4
74#define imm2 5
75#define imm3 6
76#define imm4 7
77#define imm5 8
78#define allocptr 9
79#define allocbase 10
80#define nargs 11
81#define tsp 12
82#define vsp 13
83#define loc_pc 14               /*  code vector locative */
84#define fn 15           
85#define temp4 16
86#define temp3 17
87#define temp2 18
88#define temp1 19
89#define temp0 20       
90#define arg_x 21
91#define arg_y 22
92#define arg_z 23
93#define save7 24
94#define save6 25
95#define save5 26
96#define save4 27
97#define save3 28
98#define save2 29
99#define save1 30
100#define save0 31
101
102#define vfp save0       /*  frame pointer if needed (stack consing). */
103#define fname temp3
104#define nfn temp2
105#define next_method_context temp1
106#define closure_data temp0
107
108
109/*  Order of CAR and CDR doesn't seem to matter much - there aren't */
110/*  too many tricks to be played with predecrement/preincrement addressing. */
111/*  Keep them in the confusing MCL 3.0 order, to avoid confusion. */
112
113typedef struct cons {
114  LispObj cdr;
115  LispObj car;
116} cons;
117
118
119#define misc_header_offset -fulltag_misc
120#define misc_subtag_offset misc_header_offset+3         /*  low byte of header */
121#define misc_data_offset misc_header_offset+4           /*  first word of data */
122#define misc_dfloat_offset misc_header_offset+8         /*  double-floats are doubleword-aligned */
123
124#define max_64_bit_constant_index ((0x7fff + misc_dfloat_offset)>>3)
125#define max_32_bit_constant_index ((0x7fff + misc_data_offset)>>2)
126#define max_16_bit_constant_index ((0x7fff + misc_data_offset)>>1)
127#define max_8_bit_constant_index (0x7fff + misc_data_offset)
128#define max_1_bit_constant_index ((0x7fff + misc_data_offset)<<5)
129
130/*  T is almost adjacent to NIL: since NIL is a misaligned CONS, it spans */
131/*  two doublewords.  The arithmetic difference between T and NIL is */
132/*  such that the least-significant bit and exactly one other bit is */
133/*  set in the result. */
134
135#define t_offset (8+(8-fulltag_nil)+fulltag_misc)
136
137/*  The order in which various header values are defined is significant in several ways: */
138/*  1) Numeric subtags precede non-numeric ones; there are further orderings among numeric subtags. */
139/*  2) All subtags which denote CL arrays are preceded by those that don't, */
140/*     with a further ordering which requires that (< header-arrayH header-vectorH ,@all-other-CL-vector-types) */
141/*  3) The element-size of ivectors is determined by the ordering of ivector subtags. */
142/*  4) All subtags are >= fulltag-immheader . */
143
144#define SUBTAG(tag,subtag) ((tag) | ((subtag) << ntagbits))
145#define IMM_SUBTAG(subtag) SUBTAG(fulltag_immheader,(subtag))
146#define NODE_SUBTAG(subtag) SUBTAG(fulltag_nodeheader,(subtag))
147
148       
149/* Numeric subtags. */
150
151#define subtag_bignum IMM_SUBTAG(0)
152#define min_numeric_subtag subtag_bignum
153
154#define subtag_ratio NODE_SUBTAG(1)
155#define max_rational_subtag subtag_ratio
156
157#define subtag_single_float IMM_SUBTAG(1)
158#define subtag_double_float IMM_SUBTAG(2)
159#define min_float_subtag subtag_single_float
160#define max_float_subtag subtag_double_float
161#define max_real_subtag subtag_double_float
162
163#define subtag_complex NODE_SUBTAG(3)
164#define max_numeric_subtag subtag_complex
165
166
167/*  CL array types.  There are more immediate types than node types; all CL array subtags must be > than */
168/*  all non-CL-array subtags.  So we start by defining the immediate subtags in decreasing order, starting */
169/*  with that subtag whose element size isn't an integral number of bits and ending with those whose */
170/*  element size - like all non-CL-array fulltag-immheader types - is 32 bits. */
171
172#define subtag_bit_vector IMM_SUBTAG(31)
173#define subtag_double_float_vector IMM_SUBTAG(30)
174#define subtag_s16_vector IMM_SUBTAG(29)
175#define subtag_u16_vector IMM_SUBTAG(28)
176#define subtag_simple_general_string IMM_SUBTAG(27)
177#define min_16_bit_ivector_subtag subtag_simple_general_string
178#define max_16_bit_ivector_subtag subtag_s16_vector
179#define max_string_subtag subtag_simple_general_string
180
181#define subtag_simple_base_string IMM_SUBTAG(26)
182#define subtag_s8_vector IMM_SUBTAG(25)
183#define subtag_u8_vector IMM_SUBTAG(24)
184#define min_8_bit_ivector_subtag subtag_u8_vector
185#define max_8_bit_ivector_subtag subtag_simple_base_string
186#define min_string_subtag subtag_simple_base_string
187
188#define subtag_s32_vector IMM_SUBTAG(23)
189#define subtag_u32_vector IMM_SUBTAG(22)
190#define subtag_single_float_vector IMM_SUBTAG(21)
191#define max_32_bit_ivector_subtag subtag_s32_vector
192#define min_cl_ivector_subtag subtag_single_float_vector
193
194
195#define subtag_vectorH NODE_SUBTAG(21)
196#define subtag_arrayH NODE_SUBTAG(20)
197#define subtag_simple_vector NODE_SUBTAG(22)    /*  Only one such subtag) */
198#define min_vector_subtag subtag_vectorH
199#define min_array_subtag subtag_arrayH
200
201/*  So, we get the remaining subtags (n: (n > max-numeric-subtag) & (n < min-array-subtag)) */
202/*  for various immediate/node object types. */
203
204#define subtag_macptr IMM_SUBTAG(3)
205#define min_non_numeric_imm_subtag subtag_macptr
206
207#define subtag_dead_macptr IMM_SUBTAG(4)
208#define subtag_code_vector IMM_SUBTAG(5)
209#define subtag_creole IMM_SUBTAG(6)
210
211#define max_non_array_imm_subtag ((19<<ntagbits)|fulltag_immheader)
212
213#define subtag_catch_frame NODE_SUBTAG(4)
214#define subtag_function NODE_SUBTAG(5)
215#define subtag_sgbuf NODE_SUBTAG(6)
216#define subtag_symbol NODE_SUBTAG(7)
217#define subtag_lock NODE_SUBTAG(8)
218#define subtag_hash_vector NODE_SUBTAG(9)
219#define subtag_pool NODE_SUBTAG(10)
220#define subtag_weak NODE_SUBTAG(11)
221#define subtag_package NODE_SUBTAG(12)
222#define subtag_mark NODE_SUBTAG(13)
223#define subtag_instance NODE_SUBTAG(14)
224#define subtag_struct NODE_SUBTAG(15)
225#define subtag_istruct NODE_SUBTAG(16)
226#define max_non_array_node_subtag ((19<<ntagbits)|fulltag_immheader)
227       
228/*  The objects themselves look something like this: */
229
230typedef struct lispsymbol {
231  LispObj header;
232  LispObj pname;
233  LispObj vcell;
234  LispObj fcell;
235  LispObj package_plist;
236  LispObj flags;
237} lispsymbol;
238
239typedef struct ratio {
240  LispObj header;
241  LispObj numer;
242  LispObj denom;
243} ratio;
244
245typedef struct double_float {
246  LispObj header;
247  LispObj pad;
248  LispObj value_high;
249  LispObj value_low;
250} double_float;
251
252typedef struct single_float {
253  LispObj header;
254  LispObj value;
255} single_float;
256
257typedef struct macptr {
258  LispObj header;
259  LispObj address;
260  LispObj class;
261  LispObj type;
262} macptr;
263
264typedef struct xmacptr {
265  LispObj header;
266  LispObj address;
267  LispObj class;
268  LispObj type;
269  LispObj flags;
270  LispObj link;
271} xmacptr;
272 
273
274typedef struct eabi_c_frame {
275  struct eabi_c_frame *backlink;
276  unsigned savelr;
277  unsigned params[8];
278} eabi_c_frame;
279
280/* PowerOpen ABI C frame */
281
282typedef struct c_frame {
283  struct c_frame *backlink;
284  unsigned crsave;
285  unsigned savelr;
286  unsigned unused[2];
287  unsigned savetoc;             /* Used with CFM */
288  unsigned params[8];           /* Space for callee to save r3-r10 */
289} c_frame;
290
291typedef struct lisp_frame {
292  struct lisp_frame *backlink;
293  LispObj savefn;
294  LispObj savelr;
295  LispObj savevsp;
296} lisp_frame;
297
298typedef struct special_binding {
299  struct special_binding *link;
300  struct lispsymbol *sym;
301  LispObj value;
302} special_binding;
303
304/* The GC (at least) needs to know what a
305   package looks like, so that it can do GCTWA. */
306typedef struct package {
307  LispObj header;
308  LispObj itab;                 /* itab and etab look like (vector (fixnum . fixnum) */
309  LispObj etab;
310  LispObj used;
311  LispObj used_by;
312  LispObj names;
313  LispObj shadowed;
314} package;
315
316/*
317  The GC also needs to know what a catch_frame looks like.
318*/
319
320typedef struct catch_frame {
321  LispObj header;
322  LispObj catch_tag;
323  LispObj link;
324  LispObj mvflag;
325  LispObj csp;
326  LispObj db_link;
327  LispObj regs[8];
328  LispObj xframe;
329  LispObj tsp_segment;
330} catch_frame;
331
332#define catch_frame_element_count ((sizeof(catch_frame)/sizeof(LispObj))-1)
333#define catch_frame_header make_header(subtag_catch_frame,catch_frame_element_count)
334
335#define unbound SUBTAG(fulltag_imm, 6)
336#define undefined unbound
337#define subtag_character SUBTAG(fulltag_imm, 9)
338#define no_thread_local_binding_marker SUBTAG(fulltag_imm,30)
339
340/*
341  All exception frames in a thread are linked together
342  */
343typedef struct xframe_list {
344  ExceptionInformationPowerPC *curr;
345  struct xframe_list *prev;
346} xframe_list;
347
348#define fixnum_bitmask(n)  (1<<((n)+fixnumshift))
349
350/*
351  The GC (at least) needs to know about hash-table-vectors and their flag bits.
352*/
353
354typedef struct hash_table_vector_header {
355  LispObj header;
356  LispObj link;                 /* If weak */
357  LispObj flags;                /* a fixnum; see below */
358  LispObj free_alist;           /* preallocated conses for finalization_alist */
359  LispObj finalization_alist;   /* key/value alist for finalization */
360  LispObj weak_deletions_count; /* incremented when GC deletes weak pair */
361  LispObj hash;                 /* backpointer to hash-table */
362  LispObj deleted_count;        /* number of deleted entries */
363  LispObj cache_idx;            /* index of last cached pair */
364  LispObj cache_key;            /* value of last cached key */
365  LispObj cache_value;          /* last cached value */
366} hash_table_vector_header;
367
368/*
369  Bits (masks)  in hash_table_vector.flags:
370*/
371
372/* GC should track keys when addresses change */ 
373#define nhash_track_keys_mask fixnum_bitmask(28)
374
375/* GC should set when nhash_track_keys_bit & addresses change */
376#define nhash_key_moved_mask  fixnum_bitmask(27)
377
378/* weak on key or value (need new "weak both" encoding.) */
379#define nhash_weak_mask       fixnum_bitmask(12)
380
381/* weak on value */
382#define nhash_weak_value_mask fixnum_bitmask(11)
383
384/* finalizable */
385#define nhash_finalizable_mask fixnum_bitmask(10)
386
387
388/* Lfun bits */
389
390#define lfbits_nonnullenv_mask fixnum_bitmask(0)
391#define lfbits_keys_mask fixnum_bitmask(1)
392#define lfbits_restv_mask fixnum_bitmask(7)
393#define lfbits_optinit_mask fixnum_bitmask(14)
394#define lfbits_rest_mask fixnum_bitmask(15)
395#define lfbits_aok_mask fixnum_bitmask(16)
396#define lfbits_lap_mask fixnum_bitmask(23)
397#define lfbits_trampoline_mask fixnum_bitmask(24)
398#define lfbits_evaluated_mask fixnum_bitmask(25)
399#define lfbits_cm_mask fixnum_bitmask(26)         /* combined_method */
400#define lfbits_nextmeth_mask fixnum_bitmask(26)   /* or call_next_method with method_mask */
401#define lfbits_gfn_mask fixnum_bitmask(27)        /* generic_function */
402#define lfbits_nextmeth_with_args_mask fixnum_bitmask(27)   /* or call_next_method_with_args with method_mask */
403#define lfbits_method_mask fixnum_bitmask(28)     /* method function */
404/* PPC only but want it defined for xcompile */
405#define lfbits_noname_mask fixnum_bitmask(29)
406
407/*
408  known values of an "extended" (gcable) macptr's flags word:
409*/
410
411typedef enum {
412  xmacptr_flag_none = 0,        /* Maybe already disposed by Lisp */
413  xmacptr_flag_recursive_lock,  /* recursive-lock */
414  xmacptr_flag_ptr,             /* malloc/free */
415  xmacptr_flag_rwlock,          /* read/write lock */
416  xmacptr_flag_semaphore        /* semaphore */
417} xmacptr_flag;
418
419/* Creole */
420
421#define doh_quantum 400
422#define doh_block_slots ((doh_quantum >> 2) - 3)
423
424typedef struct doh_block {
425  struct doh_block *link;
426  unsigned size;
427  unsigned free;
428  LispObj data[doh_block_slots];
429} doh_block, *doh_block_ptr;
430
431
432#define population_weak_list (0<<fixnum_shift)
433#define population_weak_alist (1<<fixnum_shift)
434#define population_termination_bit (16+fixnum_shift)
435#define population_type_mask ((1<<population_termination_bit)-1)
436
437#define gc_retain_pages_bit fixnum_bitmask(0)
438#define gc_integrity_check_bit fixnum_bitmask(2)
439#define gc_allow_stack_overflows_bit fixnum_bitmask(5)
440#define gc_postgc_pending fixnum_bitmask(26)
441
442#include "lisp-errors.h"
443
444#define BA_MASK ((unsigned) ((-1<<26) | (1<<1)))
445#define BA_VAL  ((unsigned) ((18<<26) | (1<<1)))
446
447
448/*
449  These were previously global variables.  There are lots of implicit
450  assumptions about the size of a heap segment, so they might as well
451  be constants.
452*/
453
454#define heap_segment_size 0x00010000
455#define log2_heap_segment_size 16
456
457#define nil_value 0x00002015
458
459typedef struct tcr {
460  struct tcr *next;
461  struct tcr *prev;
462  union {
463    double d;
464    struct {unsigned h, l;} words;
465  } lisp_fpscr;                 /* lisp thread's fpscr (in low word) */
466  special_binding *db_link;     /* special binding chain head */
467  LispObj catch_top;            /* top catch frame */
468  LispObj *save_vsp;            /* VSP when in foreign code */
469  LispObj *save_tsp;            /* TSP when in foreign code */
470  struct area *cs_area;         /* cstack area pointer */
471  struct area *vs_area;         /* vstack area pointer */
472  struct area *ts_area;         /* tstack area pointer */
473  LispObj cs_limit;             /* stack overflow limit */
474  unsigned long long bytes_allocated;
475  int interrupt_level;          /* for w-o-i preemption */
476  int interrupt_pending;        /* likewise */
477  xframe_list *xframe;          /* exception-frame linked list */
478  int *errno_loc;               /* per-thread (?) errno location */
479  LispObj ffi_exception;        /* fpscr bits from ff-call */
480  LispObj osid;                 /* OS thread id */
481  int valence;                  /* odd when in foreign code */
482  int foreign_exception_status; /* non-zero -> call lisp_exit_hook */
483  void *native_thread_info;     /* platform-dependent */
484  void *native_thread_id;       /* mach_thread_t, pid_t, etc. */
485  void *last_allocptr;
486  void *save_allocptr;
487  void *save_allocbase;
488  void *reset_completion;
489  void *activate;
490  int suspend_count;
491  ExceptionInformation *suspend_context;
492  ExceptionInformation *pending_exception_context;
493  void *suspend;                /* suspension semaphore */
494  void *resume;                 /* resumption semaphore */
495  int flags;
496  ExceptionInformation *gc_context;
497  int suspend_total;
498  int suspend_total_on_exception_entry;
499  unsigned tlb_limit;
500  LispObj *tlb_pointer;
501  unsigned shutdown_count;
502} TCR;
503
504#define TCR_FLAG_BIT_FOREIGN fixnumshift
505#define TCR_FLAG_BIT_AWAITING_PRESET (fixnumshift+1)
506#define TCR_FLAG_BIT_ALT_SUSPEND (fixnumshift+2)
507
508#define TCR_STATE_FOREIGN (1)
509#define TCR_STATE_LISP    (0)
510#define TCR_STATE_EXCEPTION_WAIT (2)
511#define TCR_STATE_EXCEPTION_RETURN (4)
512
513#define memo_size (1 << 15)
514#endif
515
Note: See TracBrowser for help on using the repository browser.