Ignore:
Timestamp:
Feb 22, 2004, 1:27:13 AM (15 years ago)
Author:
gb
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/lisp-kernel/constants.h

    r469 r557  
    1717#ifndef __constants__
    1818#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. */
    6719
    6820/*  Register usage: */
     
    10658#define closure_data temp0
    10759
    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 
    113 typedef 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 
    230 typedef struct lispsymbol {
    231   LispObj header;
    232   LispObj pname;
    233   LispObj vcell;
    234   LispObj fcell;
    235   LispObj package_plist;
    236   LispObj flags;
    237 } lispsymbol;
    238 
    239 typedef struct ratio {
    240   LispObj header;
    241   LispObj numer;
    242   LispObj denom;
    243 } ratio;
    244 
    245 typedef struct double_float {
    246   LispObj header;
    247   LispObj pad;
    248   LispObj value_high;
    249   LispObj value_low;
    250 } double_float;
    251 
    252 typedef struct single_float {
    253   LispObj header;
    254   LispObj value;
    255 } single_float;
    256 
    257 typedef struct macptr {
    258   LispObj header;
    259   LispObj address;
    260   LispObj class;
    261   LispObj type;
    262 } macptr;
    263 
    264 typedef struct xmacptr {
    265   LispObj header;
    266   LispObj address;
    267   LispObj class;
    268   LispObj type;
    269   LispObj flags;
    270   LispObj link;
    271 } xmacptr;
    272  
    273 
    274 typedef 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 
    282 typedef 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 
    291 typedef struct lisp_frame {
    292   struct lisp_frame *backlink;
    293   LispObj savefn;
    294   LispObj savelr;
    295   LispObj savevsp;
    296 } lisp_frame;
    297 
    298 typedef 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. */
    306 typedef 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 
    320 typedef 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   */
    343 typedef 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 
    354 typedef 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 
    411 typedef 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 
    424 typedef 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 
    44860/*
    44961  These were previously global variables.  There are lots of implicit
     
    45567#define log2_heap_segment_size 16
    45668
    457 #define nil_value 0x00002015
    458 
    459 typedef 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;
     69#define BA_MASK ((unsigned) ((-1<<26) | (1<<1)))
     70#define BA_VAL  ((unsigned) ((18<<26) | (1<<1)))
    50371
    50472#define TCR_FLAG_BIT_FOREIGN fixnumshift
     
    51179#define TCR_STATE_EXCEPTION_RETURN (4)
    51280
    513 #define memo_size (1 << 15)
     81#ifdef PPC64
     82#include "constants64.h"
     83#else
     84#include "constants32.h"
    51485#endif
    51586
     87#define dnode_size (node_size*2)
     88#define dnode_shift node_shift+1
     89
     90#endif
Note: See TracChangeset for help on using the changeset viewer.