Changeset 557
- Timestamp:
- Feb 21, 2004, 5:27:13 PM (21 years ago)
- Location:
- trunk/ccl/lisp-kernel
- Files:
-
- 2 added
- 19 edited
-
area.h (modified) (1 diff)
-
bits.c (modified) (1 diff)
-
bits.h (modified) (1 diff)
-
constants.h (modified) (4 diffs)
-
constants32.h (added)
-
constants64.h (added)
-
constants64.s (modified) (2 diffs)
-
darwin/.gdb_history (modified) (1 diff)
-
darwin/Makefile (modified) (1 diff)
-
gc.c (modified) (128 diffs)
-
gc.h (modified) (3 diffs)
-
lisp-exceptions.h (modified) (1 diff)
-
lisp.h (modified) (1 diff)
-
lisp_globals.h (modified) (1 diff)
-
lisptypes.h (modified) (1 diff)
-
macros.h (modified) (3 diffs)
-
macros.s (modified) (6 diffs)
-
pantherg5/Makefile (modified) (5 diffs)
-
plsym.c (modified) (1 diff)
-
pmcl-kernel.c (modified) (10 diffs)
-
spentry.s (modified) (67 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/lisp-kernel/area.h
r6 r557 39 39 40 40 typedef struct area { 41 struct area *pred;/* linked list predecessor */42 struct area *succ;/* linked list successor */43 BytePtr low;/* arithmetic lower limit on addresses (inclusive) */44 BytePtr high;/* arithmetic upper limit on addresses (exclusive) */45 BytePtr active;/* low bound (stack) or high bound (heap) */46 BytePtr softlimit; /* only makes sense for dynamic heaps & stacks */47 BytePtr hardlimit; /* only makes sense for dynamic heaps & stacks */48 area_codecode;49 bitvector markbits; /* markbits for active area */50 unsigned ndwords; /* "active" size of dynamic area or stack */51 struct area *older; /* if ephemeral, the next older ephemeral area41 NATURAL_POINTER_FIELD(struct area,pred); /* linked list predecessor */ 42 NATURAL_POINTER_FIELD(struct area,succ); /* linked list successor */ 43 NATURAL_POINTER_FIELD(char,low); /* arithmetic lower limit on addresses (inclusive) */ 44 NATURAL_POINTER_FIELD(char,high); /* arithmetic upper limit on addresses (exclusive) */ 45 NATURAL_POINTER_FIELD(char,active); /* low bound (stack) or high bound (heap) */ 46 NATURAL_POINTER_FIELD(char,softlimit); /* only makes sense for dynamic heaps & stacks */ 47 NATURAL_POINTER_FIELD(char,hardlimit); /* only makes sense for dynamic heaps & stacks */ 48 natural code; 49 NATURAL_POINTER_FIELD(natural, markbits); /* markbits for active area */ 50 natural ndnodes; /* "active" size of dynamic area or stack */ 51 NATURAL_POINTER_FIELD(struct area,older); /* if ephemeral, the next older ephemeral area 52 52 or the dynamic area */ 53 struct area *younger;/* if ephemeral, the next "younger" ephemeral area54 if there is one. If dynamic, the oldest ephemeral53 NATURAL_POINTER_FIELD(struct area,younger); /* if ephemeral, the next "younger" ephemeral area 54 if there is one. If dynamic, the oldest ephemeral 55 55 area. */ 56 Ptr h; /* The pointer allocated to contain this area, or NULL56 NATURAL_POINTER_FIELD(char, h); /* The pointer allocated to contain this area, or NULL 57 57 if the operating system allocated it for us. */ 58 protected_area_ptr softprot; /* "soft" protected_area */59 protected_area_ptr hardprot; /* "hard" protected_area */60 unsignedowner; /* position in external_containers linked list */61 bitvector refbits;/* intergenerational references.62 May or may not be the same as markbits */63 unsigned threshold;/* egc threshold (boxed "fullword count") or 0 */58 NATURAL_POINTER_FIELD(protected_area,softprot); /* "soft" protected_area */ 59 NATURAL_POINTER_FIELD(protected_area,hardprot); /* "hard" protected_area */ 60 natural owner; /* position in external_containers linked list */ 61 NATURAL_POINTER_FIELD(natural, refbits); /* intergenerational references. 62 May or may not be the same as markbits */ 63 natural threshold; /* egc threshold (boxed "fullword count") or 0 */ 64 64 LispObj gccount; /* boxed generation GC count. */ 65 65 } area; -
trunk/ccl/lisp-kernel/bits.c
r6 r557 16 16 17 17 18 #include "lisp.h" 18 19 #include "bits.h" 19 #include "lisp.h"20 20 21 21 -
trunk/ccl/lisp-kernel/bits.h
r6 r557 25 25 #include <string.h> 26 26 27 typedef unsigned*bitvector;27 typedef natural *bitvector; 28 28 29 29 -
trunk/ccl/lisp-kernel/constants.h
r469 r557 17 17 #ifndef __constants__ 18 18 #define __constants__ 1 19 20 21 #define nbits_in_word 3222 #define nbits_in_byte 823 #define ntagbits 3 /* But only 2 are significant to lisp */24 #define nlisptagbits 225 #define nfixnumtagbits 226 #define num_subtag_bits 827 #define fixnumshift 228 #define fixnum_shift 229 #define fulltagmask 730 #define tagmask 331 #define fixnummask 332 #define subtagmask ((1<<num_subtag_bits)-1)33 #define ncharcodebits 1634 #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 19 68 20 /* Register usage: */ … … 106 58 #define closure_data temp0 107 59 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_misc120 #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_bignum153 154 #define subtag_ratio NODE_SUBTAG(1)155 #define max_rational_subtag subtag_ratio156 157 #define subtag_single_float IMM_SUBTAG(1)158 #define subtag_double_float IMM_SUBTAG(2)159 #define min_float_subtag subtag_single_float160 #define max_float_subtag subtag_double_float161 #define max_real_subtag subtag_double_float162 163 #define subtag_complex NODE_SUBTAG(3)164 #define max_numeric_subtag subtag_complex165 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_string178 #define max_16_bit_ivector_subtag subtag_s16_vector179 #define max_string_subtag subtag_simple_general_string180 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_vector185 #define max_8_bit_ivector_subtag subtag_simple_base_string186 #define min_string_subtag subtag_simple_base_string187 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_vector192 #define min_cl_ivector_subtag subtag_single_float_vector193 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_vectorH199 #define min_array_subtag subtag_arrayH200 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_macptr206 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 a305 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 unbound337 #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 together342 */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 400422 #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 448 60 /* 449 61 These were previously global variables. There are lots of implicit … … 455 67 #define log2_heap_segment_size 16 456 68 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))) 503 71 504 72 #define TCR_FLAG_BIT_FOREIGN fixnumshift … … 511 79 #define TCR_STATE_EXCEPTION_RETURN (4) 512 80 513 #define memo_size (1 << 15) 81 #ifdef PPC64 82 #include "constants64.h" 83 #else 84 #include "constants32.h" 514 85 #endif 515 86 87 #define dnode_size (node_size*2) 88 #define dnode_shift node_shift+1 89 90 #endif -
trunk/ccl/lisp-kernel/constants64.s
r527 r557 93 93 /* There's some room for expansion in non-array ivector space. */ 94 94 define_subtag(bignum,ivector_class_64_bit,0) 95 define_subtag(macptr,ivector_class_64_bit,1)96 define_subtag(dead_macptr,ivector_class_64_bit,2)97 95 define_subtag(double_float,ivector_class_64_bit,3) 96 define_subtag(macptr,ivector_class_64_bit,5) 97 define_subtag(dead_macptr,ivector_class_64_bit,6) 98 98 define_subtag(code_vector,ivector_class_32_bit,0) 99 99 define_subtag(xcode_vector,ivector_class_32_bit,1) 100 100 101 ;; Size doesn't matter for non-CL-array gvectors; I can't think of a good 102 ;; reason to classify them in any particular way. Let's put funcallable 103 ;; things in the first slice by themselves, though it's not clear that 104 ;; that helps FUNCALL much. 101 102 103 104 /* 105 Size doesn't matter for non-CL-array gvectors; I can't think of a good 106 reason to classify them in any particular way. Let's put funcallable 107 things in the first slice by themselves, though it's not clear that 108 that helps FUNCALL much. 109 */ 105 110 gvector_funcallable = fulltag_nodeheader_0 106 111 … … 134 139 135 140 define_subtag(single_float,fulltag_imm_0,0) 136 define_subtag(slot_unbound,fulltag_imm_0,1)137 slot_unbound_marker = subtag_slot_unbound138 define_subtag(illegal,fulltag_imm_0,2)139 illegal_marker = subtag_illegal140 141 141 142 define_subtag(go_tag,fulltag_imm_1,0) 142 143 define_subtag(block_tag,fulltag_imm_1,1) 144 143 145 define_subtag(character,fulltag_imm_2,0) 146 144 147 define_subtag(unbound,fulltag_imm_3,0) 145 148 unbound_marker = subtag_unbound 146 149 undefined = unbound_marker 147 define_subtag(no_thread_local_binding,fulltag_imm_3,1) 150 define_subtag(slot_unbound,fulltag_imm_3,1) 151 slot_unbound_marker = subtag_slot_unbound 152 define_subtag(illegal,fulltag_imm_3,2) 153 illegal_marker = subtag_illegal 154 define_subtag(no_thread_local_binding,fulltag_imm_3,3) 155 no_thread_local_binding_marker = subtag_no_thread_local_binding 148 156 149 157 -
trunk/ccl/lisp-kernel/darwin/.gdb_history
r6 r557 25 25 x/i _SPfuncall 26 26 quit 27 x/i wait_for_exception_lock_in_handler 28 break *wait_for_exception_lock_in_handler 29 run 30 stepi 31 x/x $r2 32 kill 33 quit -
trunk/ccl/lisp-kernel/darwin/Makefile
r523 r557 52 52 CDEFINES = -DDARWIN $(BROKEN_PREPROCESSOR_WORKAROUND) -DOPENMCL_MAJOR_VERSION=$(OPENMCL_MAJOR_VERSION) -DOPENMCL_MINOR_VERSION=$(OPENMCL_MINOR_VERSION) 53 53 CDEBUG = -g 54 COPT = -O254 COPT = #-O2 55 55 56 56 .s.o: -
trunk/ccl/lisp-kernel/gc.c
r54 r557 47 47 area *a = (area *) (zalloc(sizeof(area))); 48 48 if (a) { 49 unsigned nd words = area_dword(highaddr, lowaddr);49 unsigned ndnodes = area_dnode(highaddr, lowaddr); 50 50 a->low = lowaddr; 51 51 a->high = highaddr; 52 52 a->active = (code == AREA_DYNAMIC) ? lowaddr : highaddr; 53 53 a->code = code; 54 a->nd words = ndwords;54 a->ndnodes = ndnodes; 55 55 /* Caller must allocate markbits when allocating heap ! */ 56 56 … … 183 183 case fulltag_even_fixnum: 184 184 case fulltag_odd_fixnum: 185 #ifdef PPC64 186 case fulltag_imm_0: 187 case fulltag_imm_1: 188 case fulltag_imm_2: 189 case fulltag_imm_3: 190 #else 185 191 case fulltag_imm: 192 #endif 186 193 return; 187 194 195 #ifndef PPC64 188 196 case fulltag_nil: 189 197 if (n != lisp_nil) { … … 191 199 } 192 200 return; 193 201 #endif 202 203 #ifdef PPC64 204 case fulltag_nodeheader_0: 205 case fulltag_nodeheader_1: 206 case fulltag_nodeheader_2: 207 case fulltag_nodeheader_3: 208 case fulltag_immheader_0: 209 case fulltag_immheader_1: 210 case fulltag_immheader_2: 211 case fulltag_immheader_3: 212 #else 194 213 case fulltag_nodeheader: 195 214 case fulltag_immheader: 215 #endif 196 216 Bug(NULL, "Header not expected : 0x%08x", n); 197 217 return; … … 199 219 case fulltag_misc: 200 220 case fulltag_cons: 201 a = heap_area_containing((BytePtr) n);221 a = heap_area_containing((BytePtr)ptr_from_lispobj(n)); 202 222 203 223 if (a == NULL) { … … 207 227 bad .. */ 208 228 a = active_dynamic_area; 209 if ((n > ( (LispObj)a->active)) &&210 (n < ( (LispObj)a->high))) {229 if ((n > (ptr_to_lispobj(a->active))) && 230 (n < (ptr_to_lispobj(a->high)))) { 211 231 Bug(NULL, "Node points to heap free space: 0x%08x", n); 212 232 } … … 219 239 header_tag = fulltag_of(header); 220 240 if (tag == fulltag_cons) { 221 if (( header_tag == fulltag_nodeheader) ||222 ( header_tag == fulltag_immheader)) {241 if ((nodeheader_tag_p(header_tag)) || 242 (immheader_tag_p(header_tag))) { 223 243 Bug(NULL, "Cons cell at 0x%08x has bogus header : 0x%08x", n, header); 224 244 } … … 226 246 } 227 247 228 if (( header_tag != fulltag_nodeheader) &&229 ( header_tag != fulltag_immheader)) {248 if ((!nodeheader_tag_p(header_tag)) && 249 (!immheader_tag_p(header_tag))) { 230 250 Bug(NULL,"Vector at 0x%08x has bogus header : 0x%08x", n, header); 231 251 } … … 244 264 node = *current++; 245 265 tag = fulltag_of(node); 246 if ( tag == fulltag_immheader) {266 if (immheader_tag_p(tag)) { 247 267 current = (LispObj *)skip_over_ivector((unsigned)prev, node); 248 } else if ( tag == fulltag_nodeheader) {268 } else if (nodeheader_tag_p(tag)) { 249 269 elements = header_element_count(node) | 1; 250 270 while (elements--) { … … 299 319 end != limit; 300 320 current = next) { 301 next = (LispObj *) *current;321 next = ptr_from_lispobj(*current); 302 322 end = ((next >= start) && (next < limit)) ? next : limit; 303 323 if (current[1] == 0) { … … 332 352 } 333 353 334 if ( tag == fulltag_immheader) {335 q = (LispObj *)skip_over_ivector( (LispObj)p, header);354 if (immheader_tag_p(tag)) { 355 q = (LispObj *)skip_over_ivector(ptr_to_lispobj(p), header); 336 356 if (q >= nextpage) { 337 357 bucket->halfword = 0; 338 358 return q; 339 359 } 340 } else if ( tag == fulltag_nodeheader) {360 } else if (nodeheader_tag_p(tag)) { 341 361 q = p + ((2 + header_element_count(header)) & ~1); 342 362 if (p >= page) { … … 376 396 LispObj *p, *page = (LispObj *)truncate_to_power_of_2(start,12); 377 397 pageentry 378 *buckets = pagemap + ((( LispObj)page- lisp_global(HEAP_START)) >> 12);398 *buckets = pagemap + (((ptr_to_lispobj(page)) - lisp_global(HEAP_START)) >> 12); 379 399 380 400 if (start != page) { … … 398 418 LispObj *end, 399 419 LispObj ephemeral_start, 400 unsigned long ephemeral_d words)420 unsigned long ephemeral_dnodes) 401 421 { 402 422 LispObj node, oldspacestart = lisp_global(HEAP_START); … … 407 427 node = *start; 408 428 tag = fulltag_of(node); 409 if ( tag == fulltag_immheader) { /* An ivector */410 start = (LispObj *)skip_over_ivector((LispObj)start, node);429 if (immheader_tag_p(tag)) { /* An ivector */ 430 start = ptr_from_lispobj(skip_over_ivector(ptr_to_lispobj(start), node)); 411 431 } else { 412 432 if ((header_subtag(node) == subtag_hash_vector) || … … 414 434 least if we have to track key movement */ 415 435 (((tag == fulltag_cons) || (tag == fulltag_misc)) && 416 (area_d word(node, ephemeral_start) < ephemeral_dwords))) {436 (area_dnode(node, ephemeral_start) < ephemeral_dnodes))) { 417 437 /* Tagged pointer to (some) younger generation; update refmap */ 418 set_bit(refbits,area_d word(start, oldspacestart));438 set_bit(refbits,area_dnode(start, oldspacestart)); 419 439 } else { 420 440 node = start[1]; 421 441 tag = fulltag_of(node); 422 442 if (((tag == fulltag_cons) || (tag == fulltag_misc)) && 423 (area_d word(node, ephemeral_start) < ephemeral_dwords)) {424 set_bit(refbits,area_d word(start, oldspacestart));443 (area_dnode(node, ephemeral_start) < ephemeral_dnodes)) { 444 set_bit(refbits,area_dnode(start, oldspacestart)); 425 445 } 426 446 } … … 434 454 LispObj *page, 435 455 LispObj ephemeral_start, 436 unsigned ephemeral_d words)456 unsigned ephemeral_dnodes) 437 457 { 438 458 LispObj *start; … … 441 461 start = page + bucket->bits.offset; 442 462 update_refmap_for_range(start, 443 (LispObj *) align_to_power_of_2( (LispObj)start+1,12),463 (LispObj *) align_to_power_of_2(ptr_to_lispobj(start+1),12), 444 464 ephemeral_start, 445 ephemeral_d words);465 ephemeral_dnodes); 446 466 } 447 467 } … … 452 472 update_refmap_for_area(area *a, BytePtr curfree) 453 473 { 454 if (a->nd words) {474 if (a->ndnodes) { 455 475 LispObj 456 476 *start = (LispObj *) a->low, … … 458 478 *last_whole_page_end = (LispObj *) truncate_to_power_of_2(limit,12), 459 479 *first_partial_page_start = (LispObj *) truncate_to_power_of_2(start,12); 460 pageentry *p = pagemap + ( (LispObj)start- lisp_global(HEAP_START) >> 12);461 unsigned younger_d words = area_dword((LispObj)curfree,(LispObj)limit);480 pageentry *p = pagemap + (ptr_to_lispobj(start) - lisp_global(HEAP_START) >> 12); 481 unsigned younger_dnodes = area_dnode(ptr_to_lispobj(curfree),ptr_to_lispobj(limit)); 462 482 463 483 if (last_whole_page_end == first_partial_page_start) { 464 484 if (p->bits.modified && p->bits.hasnode) { 465 update_refmap_for_range(start,limit, (LispObj)limit,younger_dwords);485 update_refmap_for_range(start,limit,ptr_to_lispobj(limit),younger_dnodes); 466 486 } 467 487 } else { … … 470 490 *page_end = first_partial_page_start + (4096 / sizeof(LispObj *)); 471 491 if (p->bits.modified && p->bits.hasnode) { 472 update_refmap_for_range(start,page_end, (LispObj)limit,younger_dwords);492 update_refmap_for_range(start,page_end,ptr_to_lispobj(limit),younger_dnodes); 473 493 } 474 494 start = page_end; … … 478 498 start < last_whole_page_end; 479 499 start += (4096 / sizeof(LispObj *)), p++) { 480 update_refmap_for_page(p,start, (LispObj)limit,younger_dwords);500 update_refmap_for_page(p,start,ptr_to_lispobj(limit),younger_dnodes); 481 501 } 482 502 if (start < limit) { 483 503 if (p->bits.modified && p->bits.hasnode) { 484 update_refmap_for_range(start+p->bits.offset,limit, (LispObj)limit,younger_dwords);504 update_refmap_for_range(start+p->bits.offset,limit,ptr_to_lispobj(limit),younger_dnodes); 485 505 } 486 506 } … … 523 543 tenured_low = tenured_area->low; 524 544 unsigned 525 dynamic_d words = area_dword(curfree, a->low),526 new_tenured_d words = area_dword(curfree, tenured_area->low);545 dynamic_dnodes = area_dnode(curfree, a->low), 546 new_tenured_dnodes = area_dnode(curfree, tenured_area->low); 527 547 bitvector 528 548 refbits = tenured_area->refbits, … … 531 551 532 552 target->high = target->active = curfree; 533 target->nd words = area_dword(curfree, target_low);553 target->ndnodes = area_dnode(curfree, target_low); 534 554 535 555 for (child = target->younger; child != a; child = child->younger) { 536 556 child->high = child->low = child->active = curfree; 537 child->nd words = 0;557 child->ndnodes = 0; 538 558 } 539 559 540 560 a->low = curfree; 541 a->nd words = area_dword(a->high, curfree);542 543 new_markbits = refbits + ((new_tenured_d words + 31) >> 5);561 a->ndnodes = area_dnode(a->high, curfree); 562 563 new_markbits = refbits + ((new_tenured_dnodes + 31) >> 5); 544 564 545 565 if (target == tenured_area) { 546 zero_bits(refbits, new_tenured_d words);547 lisp_global(OLDEST_EPHEMERAL) = (LispObj) curfree;566 zero_bits(refbits, new_tenured_dnodes); 567 lisp_global(OLDEST_EPHEMERAL) = ptr_to_lispobj(curfree); 548 568 } else { 549 569 /* Need more (zeroed) refbits & fewer markbits */ … … 572 592 area *a = active_dynamic_area, *child; 573 593 BytePtr curlow = from->low; 574 unsigned new_tenured_d words = area_dword(curlow, tenured_area->low);594 unsigned new_tenured_dnodes = area_dnode(curlow, tenured_area->low); 575 595 576 596 for (child = from; child != a; child = child->younger) { 577 597 child->low = child->active = child->high = curlow; 578 child->nd words = 0;598 child->ndnodes = 0; 579 599 } 580 600 581 601 a->low = curlow; 582 a->nd words = area_dword(a->high, curlow);602 a->ndnodes = area_dnode(a->high, curlow); 583 603 584 a->markbits = (tenured_area->refbits) + ((new_tenured_d words+31)>>5);604 a->markbits = (tenured_area->refbits) + ((new_tenured_dnodes+31)>>5); 585 605 if (from == tenured_area) { 586 606 /* Everything's in the dynamic area */ … … 602 622 } 603 623 if (activate) { 604 LispObj *heap_start = (LispObj *)lisp_global(HEAP_START);624 LispObj *heap_start = ptr_from_lispobj(lisp_global(HEAP_START)); 605 625 606 626 a->older = g1_area; … … 709 729 bitvector GCmarkbits = NULL; 710 730 LispObj GCarealow; 711 unsigned GCnd words_in_area;731 unsigned GCndnodes_in_area; 712 732 LispObj GCweakvll = (LispObj)NULL; 713 733 LispObj GCephemeral_low; 714 unsigned GCn_ephemeral_d words;734 unsigned GCn_ephemeral_dnodes; 715 735 716 736 … … 722 742 { 723 743 int tag_n = fulltag_of(n); 724 unsigned d word, bits, *bitsp, mask;744 unsigned dnode, bits, *bitsp, mask; 725 745 726 746 if (!is_node_fulltag(tag_n)) { … … 728 748 } 729 749 730 d word = gc_area_dword(n);731 if (d word >= GCndwords_in_area) {750 dnode = gc_area_dnode(n); 751 if (dnode >= GCndnodes_in_area) { 732 752 return; 733 753 } 734 set_bits_vars(GCmarkbits,d word,bitsp,bits,mask);754 set_bits_vars(GCmarkbits,dnode,bitsp,bits,mask); 735 755 if (bits & mask) { 736 756 return; … … 739 759 740 760 if (tag_n == fulltag_cons) { 741 cons *c = (cons *) untag(n);761 cons *c = (cons *) ptr_from_lispobj(untag(n)); 742 762 rmark(c->car); 743 763 rmark(c->cdr); … … 745 765 } 746 766 { 747 LispObj *base = (LispObj *) untag(n);748 unsigned749 header = *(( unsigned*) base),767 LispObj *base = (LispObj *) ptr_from_lispobj(untag(n)); 768 natural 769 header = *((natural *) base), 750 770 subtag = header_subtag(header), 751 771 element_count = header_element_count(header), 752 772 total_size_in_bytes, /* including 4-byte header */ 753 suffix_d words;773 suffix_dnodes; 754 774 755 775 tag_n = fulltag_of(header); 756 776 777 #ifdef PPC64 778 if ((nodeheader_tag_p(tag_n)) || 779 (tag_n == ivector_class_64_bit)) { 780 total_size_in_bytes = 8 + (element_count<<3); 781 } else if (tag_n == ivector_class_8_bit) { 782 total_size_in_bytes = 8 + element_count; 783 } else if (tag_n == ivector_class_32_bit) { 784 total_size_in_bytes = 8 + (element_count<<2); 785 } else { 786 /* ivector_class_other_bit contains 16-bit arrays & bitvector */ 787 if (subtag == subtag_bit_vector) { 788 total_size_in_bytes = 8 + ((element_count+7)>>3); 789 } else { 790 total_size_in_bytes = 8 + (element_count<<1); 791 } 792 } 793 #else 757 794 if ((tag_n == fulltag_nodeheader) || 758 795 (subtag <= max_32_bit_ivector_subtag)) { … … 767 804 total_size_in_bytes = 4 + ((element_count+7)>>3); 768 805 } 769 suffix_dwords = ((total_size_in_bytes+7)>>3) -1; 770 771 if (suffix_dwords) { 772 set_n_bits(GCmarkbits, dword+1, suffix_dwords); 773 } 774 775 if (tag_n == fulltag_nodeheader) { 806 #endif 807 suffix_dnodes = ((total_size_in_bytes+(dnode_size-1))>>dnode_shift) -1; 808 809 if (suffix_dnodes) { 810 set_n_bits(GCmarkbits, dnode+1, suffix_dnodes); 811 } 812 813 if (nodeheader_tag_p(tag_n)) { 776 814 if (subtag == subtag_hash_vector) { 777 815 ((hash_table_vector_header *) base)->cache_key = undefined; … … 820 858 { 821 859 int tag_n = fulltag_of(n); 822 unsigned eph_d word;823 824 if ( tag_n == fulltag_nodeheader) {860 unsigned eph_dnode; 861 862 if (nodeheader_tag_p(tag_n)) { 825 863 return (header_subtag(n) == subtag_hash_vector); 826 864 } … … 828 866 if ((tag_n == fulltag_cons) || 829 867 (tag_n == fulltag_misc)) { 830 eph_d word = area_dword(n, GCephemeral_low);831 if (eph_d word < GCn_ephemeral_dwords) {868 eph_dnode = area_dnode(n, GCephemeral_low); 869 if (eph_dnode < GCn_ephemeral_dnodes) { 832 870 mark_root(n); /* May or may not mark it */ 833 871 return true; /* but return true 'cause it's an ephemeral node */ … … 855 893 mark_root(pc); 856 894 } else { 857 unsigned dword = gc_area_dword(pc);858 if ((d word < GCndwords_in_area) &&859 !ref_bit(GCmarkbits,d word)) {895 natural dnode = gc_area_dnode(pc); 896 if ((dnode < GCndnodes_in_area) && 897 !ref_bit(GCmarkbits,dnode)) { 860 898 LispObj 861 899 *headerP, 862 900 header; 863 901 864 for(headerP = (LispObj*) (untag(pc));865 d word < GCndwords_in_area;866 headerP-=2, --d word) {902 for(headerP = (LispObj*)ptr_from_lispobj(untag(pc)); 903 dnode < GCndnodes_in_area; 904 headerP-=2, --dnode) { 867 905 header = *headerP; 868 906 869 907 if ((header & code_header_mask) == subtag_code_vector) { 870 set_n_bits(GCmarkbits, d word, (2+header_element_count(header))>>1);908 set_n_bits(GCmarkbits, dnode, (2+header_element_count(header))>>1); 871 909 return; 872 910 } … … 892 930 int tag_n = fulltag_of(n); 893 931 bitvector markbits = GCmarkbits; 894 unsigned d word, bits, *bitsp, mask;932 unsigned dnode, bits, *bitsp, mask; 895 933 896 934 if (!is_node_fulltag(tag_n)) { … … 898 936 } 899 937 900 d word = gc_area_dword(n);901 if (d word >= GCndwords_in_area) {938 dnode = gc_area_dnode(n); 939 if (dnode >= GCndnodes_in_area) { 902 940 return; 903 941 } 904 set_bits_vars(markbits,d word,bitsp,bits,mask);942 set_bits_vars(markbits,dnode,bitsp,bits,mask); 905 943 if (bits & mask) { 906 944 return; … … 958 996 tag_n = fulltag_of(next); 959 997 if (!is_node_fulltag(tag_n)) goto MarkCdr; 960 d word = gc_area_dword(next);961 if (d word >= GCndwords_in_area) goto MarkCdr;962 set_bits_vars(markbits,d word,bitsp,bits,mask);998 dnode = gc_area_dnode(next); 999 if (dnode >= GCndnodes_in_area) goto MarkCdr; 1000 set_bits_vars(markbits,dnode,bitsp,bits,mask); 963 1001 if (bits & mask) goto MarkCdr; 964 1002 *bitsp = (bits | mask); … … 976 1014 tag_n = fulltag_of(next); 977 1015 if (!is_node_fulltag(tag_n)) goto Climb; 978 d word = gc_area_dword(next);979 if (d word >= GCndwords_in_area) goto Climb;980 set_bits_vars(markbits,d word,bitsp,bits,mask);1016 dnode = gc_area_dnode(next); 1017 if (dnode >= GCndnodes_in_area) goto Climb; 1018 set_bits_vars(markbits,dnode,bitsp,bits,mask); 981 1019 if (bits & mask) goto Climb; 982 1020 *bitsp = (bits | mask); … … 991 1029 MarkVector: 992 1030 { 993 LispObj *base = (LispObj *) untag(this);994 unsigned995 header = *(( unsigned*) base),996 subtag = header_subtag(header),997 element_count = header_element_count(header),998 total_size_in_bytes,999 suffix_dwords;1031 LispObj *base = (LispObj *) ptr_from_lispobj(untag(this)); 1032 natural 1033 header = *((natural *) base), 1034 subtag = header_subtag(header), 1035 element_count = header_element_count(header), 1036 total_size_in_bytes, 1037 suffix_dnodes; 1000 1038 1001 1039 tag_n = fulltag_of(header); 1002 1040 1041 #ifdef PPC64 1042 if ((nodeheader_tag_p(tag_n)) || 1043 (tag_n == ivector_class_64_bit)) { 1044 total_size_in_bytes = 8 + (element_count<<3); 1045 } else if (tag_n == ivector_class_8_bit) { 1046 total_size_in_bytes = 8 + element_count; 1047 } else if (tag_n == ivector_class_32_bit) { 1048 total_size_in_bytes = 8 + (element_count<<2); 1049 } else { 1050 /* ivector_class_other_bit contains 16-bit arrays & bitvector */ 1051 if (subtag == subtag_bit_vector) { 1052 total_size_in_bytes = 8 + ((element_count+7)>>3); 1053 } else { 1054 total_size_in_bytes = 8 + (element_count<<1); 1055 } 1056 } 1057 #else 1003 1058 if ((tag_n == fulltag_nodeheader) || 1004 1059 (subtag <= max_32_bit_ivector_subtag)) { … … 1013 1068 total_size_in_bytes = 4 + ((element_count+7)>>3); 1014 1069 } 1015 suffix_dwords = ((total_size_in_bytes+7)>>3)-1; 1016 1017 if (suffix_dwords) { 1018 set_n_bits(GCmarkbits, dword+1, suffix_dwords); 1019 } 1020 1021 if (tag_n != fulltag_nodeheader) goto Climb; 1070 #endif 1071 suffix_dnodes = ((total_size_in_bytes+(dnode_size-1))>>dnode_shift)-1; 1072 1073 if (suffix_dnodes) { 1074 set_n_bits(GCmarkbits, dnode+1, suffix_dnodes); 1075 } 1076 1077 if (!nodeheader_tag_p(tag_n)) goto Climb; 1022 1078 1023 1079 if (subtag == subtag_hash_vector) { … … 1042 1098 } 1043 1099 1044 this = untag(this) + ((element_count+1) << 2);1100 this = untag(this) + ((element_count+1) << node_shift); 1045 1101 goto MarkVectorLoop; 1046 1102 } 1047 1103 1048 1104 ClimbVector: 1049 prev = *((LispObj *) this);1050 *((LispObj *) this) = next;1105 prev = *((LispObj *) ptr_from_lispobj(this)); 1106 *((LispObj *) ptr_from_lispobj(this)) = next; 1051 1107 1052 1108 MarkVectorLoop: 1053 this -= 4;1054 next = *((LispObj *) this);1109 this -= node_size; 1110 next = *((LispObj *) ptr_from_lispobj(this)); 1055 1111 tag_n = fulltag_of(next); 1056 if ( tag_n == fulltag_nodeheader) goto MarkVectorDone;1112 if (nodeheader_tag_p(tag_n)) goto MarkVectorDone; 1057 1113 if (!is_node_fulltag(tag_n)) goto MarkVectorLoop; 1058 d word = gc_area_dword(next);1059 if (d word >= GCndwords_in_area) goto MarkVectorLoop;1060 set_bits_vars(markbits,d word,bitsp,bits,mask);1114 dnode = gc_area_dnode(next); 1115 if (dnode >= GCndnodes_in_area) goto MarkVectorLoop; 1116 set_bits_vars(markbits,dnode,bitsp,bits,mask); 1061 1117 if (bits & mask) goto MarkVectorLoop; 1062 1118 *bitsp = (bits | mask); 1063 *( (LispObj *) this) = prev;1119 *(ptr_from_lispobj(this)) = prev; 1064 1120 if (tag_n == fulltag_cons) goto DescendCons; 1065 1121 goto DescendVector; … … 1078 1134 } 1079 1135 1080 unsigned 1081 skip_over_ivector( unsignedstart, LispObj header)1082 { 1083 unsigned1136 LispObj * 1137 skip_over_ivector(natural start, LispObj header) 1138 { 1139 natural 1084 1140 element_count = header_element_count(header), 1085 1141 subtag = header_subtag(header), 1086 1142 nbytes; 1087 1143 1144 #ifdef PPC64 1145 switch (fulltag_of(header)) { 1146 case ivector_class_64_bit: 1147 nbytes = element_count << 3; 1148 break; 1149 case ivector_class_32_bit: 1150 nbytes = element_count << 2; 1151 break; 1152 case ivector_class_8_bit: 1153 nbytes = element_count; 1154 break; 1155 case ivector_class_other_bit: 1156 default: 1157 if (subtag == subtag_bit_vector) { 1158 nbytes = (element_count+7)>>3; 1159 } else { 1160 nbytes = element_count << 1; 1161 } 1162 } 1163 return ptr_from_lispobj(start+(~15 & (nbytes + 8 + 15))); 1164 #else 1088 1165 if (subtag <= max_32_bit_ivector_subtag) { 1089 1166 nbytes = element_count << 2; … … 1097 1174 nbytes = (element_count+7) >> 3; 1098 1175 } 1099 return start+(~7 & (nbytes + 4 + 7)); 1176 return ptr_from_lispobj(start+(~7 & (nbytes + 4 + 7))); 1177 #endif 1100 1178 } 1101 1179 … … 1106 1184 LispObj x1, *base = start; 1107 1185 int tag; 1108 unsigned ref_dword, node_dword;1186 natural ref_dnode, node_dnode; 1109 1187 Boolean intergen_ref; 1110 1188 1111 1189 while (start < end) { 1112 1190 x1 = *start; 1113 if ((tag = fulltag_of(x1)) == fulltag_immheader) { 1114 start = (LispObj *)skip_over_ivector((unsigned) start, x1); 1191 tag = fulltag_of(x1); 1192 if (immheader_tag_p(tag)) { 1193 start = skip_over_ivector(ptr_to_lispobj(start), x1); 1115 1194 } else { 1116 1195 intergen_ref = false; 1117 1196 if ((tag == fulltag_misc) || (tag == fulltag_cons)) { 1118 node_d word = gc_area_dword(x1);1119 if (node_d word < GCndwords_in_area) {1197 node_dnode = gc_area_dnode(x1); 1198 if (node_dnode < GCndnodes_in_area) { 1120 1199 intergen_ref = true; 1121 1200 } … … 1125 1204 tag = fulltag_of(x1); 1126 1205 if ((tag == fulltag_misc) || (tag == fulltag_cons)) { 1127 node_d word = gc_area_dword(x1);1128 if (node_d word < GCndwords_in_area) {1206 node_dnode = gc_area_dnode(x1); 1207 if (node_dnode < GCndnodes_in_area) { 1129 1208 intergen_ref = true; 1130 1209 } … … 1132 1211 } 1133 1212 if (intergen_ref) { 1134 ref_d word = area_dword(start, base);1135 if (!ref_bit(refbits, ref_d word)) {1213 ref_dnode = area_dnode(start, base); 1214 if (!ref_bit(refbits, ref_dnode)) { 1136 1215 Bug(NULL, "Missing memoization in doubleword at 0x%08X", start); 1137 set_bit(refbits, ref_d word);1216 set_bit(refbits, ref_dnode); 1138 1217 } 1139 1218 } … … 1146 1225 1147 1226 void 1148 mark_memoized_area(area *a, unsigned num_memo_d words)1227 mark_memoized_area(area *a, unsigned num_memo_dnodes) 1149 1228 { 1150 1229 bitvector refbits = a->refbits; 1151 1230 LispObj *p = (LispObj *) a->low, x1, x2; 1152 unsigned inbits, outbits, bits, bitidx, *bitsp, nextbit, diff, memo_d word= 0;1231 unsigned inbits, outbits, bits, bitidx, *bitsp, nextbit, diff, memo_dnode = 0; 1153 1232 Boolean keep_x1, keep_x2; 1154 1233 1155 1234 if (GCDebug) { 1156 check_refmap_consistency(p, p+(num_memo_d words << 1), refbits);1235 check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits); 1157 1236 } 1158 1237 … … 1170 1249 1171 1250 /* 1172 We need to ensure that there are no bits set at or beyond "num_memo_d words"1251 We need to ensure that there are no bits set at or beyond "num_memo_dnodes" 1173 1252 in the bitvector. (This can happen as the EGC tenures/untenures things.) 1174 1253 We find bits by grabbing a fullword at a time and doing a cntlzw instruction; 1175 and don't want to have to check for (< memo_d word num_memo_dwords) in the loop.1254 and don't want to have to check for (< memo_dnode num_memo_dnodes) in the loop. 1176 1255 */ 1177 1256 1178 1257 { 1179 1258 unsigned 1180 bits_in_last_word = (num_memo_d words & 0x1f),1181 index_of_last_word = (num_memo_d words >> 5);1259 bits_in_last_word = (num_memo_dnodes & 0x1f), 1260 index_of_last_word = (num_memo_dnodes >> 5); 1182 1261 1183 1262 if (bits_in_last_word != 0) { … … 1188 1267 set_bitidx_vars(refbits, 0, bitsp, bits, bitidx); 1189 1268 inbits = outbits = bits; 1190 while (memo_d word < num_memo_dwords) {1269 while (memo_dnode < num_memo_dnodes) { 1191 1270 if (bits == 0) { 1192 1271 int remain = 0x20 - bitidx; 1193 memo_d word+= remain;1272 memo_dnode += remain; 1194 1273 p += (remain+remain); 1195 1274 if (outbits != inbits) { … … 1202 1281 nextbit = count_leading_zeros(bits); 1203 1282 if ((diff = (nextbit - bitidx)) != 0) { 1204 memo_d word+= diff;1283 memo_dnode += diff; 1205 1284 bitidx = nextbit; 1206 1285 p += (diff+diff); … … 1215 1294 outbits &= ~(BIT0_MASK >> bitidx); 1216 1295 } 1217 memo_d word++;1296 memo_dnode++; 1218 1297 bitidx++; 1219 1298 } … … 1221 1300 if (GCDebug) { 1222 1301 p = (LispObj *) a->low; 1223 check_refmap_consistency(p, p+(num_memo_d words << 1), refbits);1302 check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits); 1224 1303 } 1225 1304 } … … 1235 1314 while (start < end) { 1236 1315 x1 = *start; 1237 if ((tag = fulltag_of(x1)) == fulltag_immheader) { 1238 start = (LispObj *)skip_over_ivector((unsigned) start, x1); 1239 } else if (tag != fulltag_nodeheader) { 1316 tag = fulltag_of(x1); 1317 if (immheader_tag_p(tag)) { 1318 start = (LispObj *)ptr_from_lispobj(skip_over_ivector(ptr_to_lispobj(start), x1)); 1319 } else if (!nodeheader_tag_p(tag)) { 1240 1320 ++start; 1241 1321 mark_root(x1); … … 1243 1323 } else { 1244 1324 int subtag = header_subtag(x1); 1245 intelement_count = header_element_count(x1);1246 intsize = (element_count+1 + 1) & ~1;1325 natural element_count = header_element_count(x1); 1326 natural size = (element_count+1 + 1) & ~1; 1247 1327 1248 1328 if (subtag == subtag_hash_vector) { … … 1277 1357 } 1278 1358 1279 void1280 mark_dohs( void )1281 {1282 doh_block_ptr doh_block = (doh_block_ptr) lisp_global(DOH_HEAD);1283 while( doh_block ) {1284 mark_simple_area_range( &doh_block->data[0], &doh_block->data[doh_block_slots] );1285 doh_block = doh_block->link;1286 }1287 }1288 1359 1289 1360 /* Mark a tstack area */ … … 1301 1372 end != limit; 1302 1373 current = next) { 1303 next = (LispObj *) *current;1374 next = (LispObj *) ptr_from_lispobj(*current); 1304 1375 end = ((next >= start) && (next < limit)) ? next : limit; 1305 1376 if (current[1] == 0) { … … 1378 1449 N.B. : elements 0 and 1 are already marked (or are immediate, etc.) 1379 1450 */ 1380 LispObj *prev = ((LispObj *) untag(weakv))+(1+2), cell = *prev;1451 LispObj *prev = ((LispObj *) ptr_from_lispobj(untag(weakv))+(1+2)), cell = *prev; 1381 1452 LispObj termination_list = lisp_nil; 1382 1453 int weak_type = (int) deref(weakv,2); … … 1385 1456 Boolean done = false; 1386 1457 cons *rawcons; 1387 unsigned d word, car_dword;1458 unsigned dnode, car_dnode; 1388 1459 bitvector markbits = GCmarkbits; 1389 1460 … … 1397 1468 /* weak alist */ 1398 1469 while (! done) { 1399 d word = gc_area_dword(cell);1400 if ((d word >= GCndwords_in_area) ||1401 (ref_bit(markbits, d word))) {1470 dnode = gc_area_dnode(cell); 1471 if ((dnode >= GCndnodes_in_area) || 1472 (ref_bit(markbits, dnode))) { 1402 1473 done = true; 1403 1474 } else { … … 1406 1477 unsigned cell_tag; 1407 1478 1408 rawcons = (cons *) untag(cell);1479 rawcons = (cons *) ptr_from_lispobj(untag(cell)); 1409 1480 alist_cell = rawcons->car; 1410 1481 cell_tag = fulltag_of(alist_cell); 1411 1482 1412 1483 if ((cell_tag == fulltag_cons) && 1413 ((car_d word = gc_area_dword(alist_cell)) < GCndwords_in_area) &&1414 (! ref_bit(markbits, car_d word)) &&1484 ((car_dnode = gc_area_dnode(alist_cell)) < GCndnodes_in_area) && 1485 (! ref_bit(markbits, car_dnode)) && 1415 1486 (is_node_fulltag(fulltag_of(thecar = car(alist_cell)))) && 1416 ((car_d word = gc_area_dword(thecar)) < GCndwords_in_area) &&1417 (! ref_bit(markbits, car_d word))) {1487 ((car_dnode = gc_area_dnode(thecar)) < GCndnodes_in_area) && 1488 (! ref_bit(markbits, car_dnode))) { 1418 1489 *prev = rawcons->cdr; 1419 1490 if (terminatablep) { … … 1422 1493 } 1423 1494 } else { 1424 set_bit(markbits, d word);1495 set_bit(markbits, dnode); 1425 1496 prev = (LispObj *)(&(rawcons->cdr)); 1426 1497 mark_root(alist_cell); … … 1432 1503 /* weak list */ 1433 1504 while (! done) { 1434 d word = gc_area_dword(cell);1435 if ((d word >= GCndwords_in_area) ||1436 (ref_bit(markbits, d word))) {1505 dnode = gc_area_dnode(cell); 1506 if ((dnode >= GCndnodes_in_area) || 1507 (ref_bit(markbits, dnode))) { 1437 1508 done = true; 1438 1509 } else { … … 1446 1517 1447 1518 if (is_node_fulltag(cartag) && 1448 ((car_d word = gc_area_dword(thecar)) < GCndwords_in_area) &&1449 (! ref_bit(markbits, car_d word))) {1519 ((car_dnode = gc_area_dnode(thecar)) < GCndnodes_in_area) && 1520 (! ref_bit(markbits, car_dnode))) { 1450 1521 *prev = rawcons->cdr; 1451 1522 if (terminatablep) { … … 1454 1525 } 1455 1526 } else { 1456 set_bit(markbits, d word);1527 set_bit(markbits, dnode); 1457 1528 prev = (LispObj *)(&(rawcons->cdr)); 1458 1529 } … … 1478 1549 reaphashv(LispObj hashv) 1479 1550 { 1480 hash_table_vector_header *hashp = (hash_table_vector_header *) untag(hashv); 1481 unsigned 1482 dword, 1551 hash_table_vector_header 1552 *hashp = (hash_table_vector_header *) ptr_from_lispobj(untag(hashv)); 1553 natural 1554 dnode, 1483 1555 npairs = (header_element_count(hashp->header) - 1484 1556 ((sizeof(hash_table_vector_header)/sizeof(LispObj)) -1)) >> 1; … … 1497 1569 tag = fulltag_of(weakelement); 1498 1570 if (is_node_fulltag(tag)) { 1499 d word = gc_area_dword(weakelement);1500 if ((d word < GCndwords_in_area) &&1501 ! ref_bit(markbits, d word)) {1571 dnode = gc_area_dnode(weakelement); 1572 if ((dnode < GCndnodes_in_area) && 1573 ! ref_bit(markbits, dnode)) { 1502 1574 pairp[0] = undefined; 1503 1575 pairp[1] = lisp_nil; … … 1514 1586 mark_weak_hash_vector(hash_table_vector_header *hashp, unsigned elements) 1515 1587 { 1516 unsigned flags = hashp->flags, key_d word, val_dword;1588 unsigned flags = hashp->flags, key_dnode, val_dnode; 1517 1589 Boolean 1518 1590 marked_new = false, … … 1545 1617 val_tag = fulltag_of(val); 1546 1618 if (is_node_fulltag(key_tag)) { 1547 key_d word = gc_area_dword(key);1548 if ((key_d word < GCndwords_in_area) &&1549 ! ref_bit(GCmarkbits,key_d word)) {1619 key_dnode = gc_area_dnode(key); 1620 if ((key_dnode < GCndnodes_in_area) && 1621 ! ref_bit(GCmarkbits,key_dnode)) { 1550 1622 key_marked = false; 1551 1623 } 1552 1624 } 1553 1625 if (is_node_fulltag(val_tag)) { 1554 val_d word = gc_area_dword(val);1555 if ((val_d word < GCndwords_in_area) &&1556 ! ref_bit(GCmarkbits,val_d word)) {1626 val_dnode = gc_area_dnode(val); 1627 if ((val_dnode < GCndnodes_in_area) && 1628 ! ref_bit(GCmarkbits,val_dnode)) { 1557 1629 val_marked = false; 1558 1630 } … … 1579 1651 { 1580 1652 int elements = header_element_count(header_of(weak_alist)); 1581 unsigned d word;1653 unsigned dnode; 1582 1654 int pair_tag; 1583 1655 Boolean marked_new = false; … … 1590 1662 for(alist = deref(weak_alist, elements); 1591 1663 (fulltag_of(alist) == fulltag_cons) && 1592 ((d word = gc_area_dword(alist)) < GCndwords_in_area) &&1593 (! ref_bit(markbits,d word));1664 ((dnode = gc_area_dnode(alist)) < GCndnodes_in_area) && 1665 (! ref_bit(markbits,dnode)); 1594 1666 alist = cdr(alist)) { 1595 1667 pair = car(alist); 1596 1668 pair_tag = fulltag_of(pair); 1597 1669 if ((is_node_fulltag(pair_tag)) && 1598 ((d word = gc_area_dword(pair_tag)) < GCndwords_in_area) &&1599 (! ref_bit(markbits,d word))) {1670 ((dnode = gc_area_dnode(pair_tag)) < GCndnodes_in_area) && 1671 (! ref_bit(markbits,dnode))) { 1600 1672 if (pair_tag == fulltag_cons) { 1601 1673 key = car(pair); 1602 1674 if ((! is_node_fulltag(fulltag_of(key))) || 1603 ((d word = gc_area_dword(key)) >= GCndwords_in_area) ||1604 ref_bit(markbits,d word)) {1675 ((dnode = gc_area_dnode(key)) >= GCndnodes_in_area) || 1676 ref_bit(markbits,dnode)) { 1605 1677 /* key is marked, mark value if necessary */ 1606 1678 value = cdr(pair); 1607 1679 if (is_node_fulltag(fulltag_of(value)) && 1608 ((d word = gc_area_dword(value)) < GCndwords_in_area) &&1609 (! ref_bit(markbits,d word))) {1680 ((dnode = gc_area_dnode(value)) < GCndnodes_in_area) && 1681 (! ref_bit(markbits,dnode))) { 1610 1682 mark_root(value); 1611 1683 marked_new = true; … … 1714 1786 mark_xp(ExceptionInformation *xp) 1715 1787 { 1716 unsigned long *regs = (unsigned long*) xpGPRvector(xp);1788 natural *regs = (natural *) xpGPRvector(xp); 1717 1789 int r; 1718 1790 … … 1788 1860 LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next, ptr; 1789 1861 xmacptr_flag flag; 1790 unsigned d word;1862 unsigned dnode; 1791 1863 xmacptr *x; 1792 1864 1793 1865 while((next = *prev) != (LispObj)NULL) { 1794 d word = gc_area_dword(next);1795 x = (xmacptr *) untag(next);1796 1797 if ((d word >= GCndwords_in_area) ||1798 (ref_bit(GCmarkbits,d word))) {1866 dnode = gc_area_dnode(next); 1867 x = (xmacptr *) ptr_from_lispobj(untag(next)); 1868 1869 if ((dnode >= GCndnodes_in_area) || 1870 (ref_bit(GCmarkbits,dnode))) { 1799 1871 prev = &(x->link); 1800 1872 } else { … … 1810 1882 1811 1883 case xmacptr_flag_ptr: 1812 deallocate((char *)ptr );1884 deallocate((char *)ptr_from_lispobj(ptr)); 1813 1885 break; 1814 1886 … … 1863 1935 /* A "pagelet" contains 32 doublewords. The relocation table contains 1864 1936 a word for each pagelet which defines the lowest address to which 1865 d words on that pagelet will be relocated.1937 dnodes on that pagelet will be relocated. 1866 1938 1867 1939 The relocation address of a given pagelet is the sum of the relocation … … 1877 1949 bitvector markbits = GCmarkbits; 1878 1950 unsigned char *bytep = (unsigned char *) markbits; 1879 unsigned npagelets = ((GCnd words_in_area+31)>>5);1951 unsigned npagelets = ((GCndnodes_in_area+31)>>5); 1880 1952 unsigned thesebits; 1881 1953 LispObj first = 0; … … 1906 1978 1907 1979 LispObj 1908 d word_forwarding_address(unsigned dword, int tag_n)1980 dnode_forwarding_address(unsigned dnode, int tag_n) 1909 1981 { 1910 1982 unsigned pagelet, nbits; … … 1913 1985 1914 1986 if (GCDebug) { 1915 if (! ref_bit(GCmarkbits, d word)) {1987 if (! ref_bit(GCmarkbits, dnode)) { 1916 1988 Bug(NULL, "unmarked object being forwarded!\n"); 1917 1989 } 1918 1990 } 1919 1991 1920 pagelet = d word>> 5;1921 nbits = d word& 0x1f;1922 near_bits = ((unsigned short *)GCmarkbits)[d word>>4];1992 pagelet = dnode >> 5; 1993 nbits = dnode & 0x1f; 1994 near_bits = ((unsigned short *)GCmarkbits)[dnode>>4]; 1923 1995 1924 1996 if (nbits < 16) { 1925 1997 new = GCrelocptr[pagelet] + tag_n;; 1926 /* Increment "new" by the count of 1 bits which precede the d word*/1998 /* Increment "new" by the count of 1 bits which precede the dnode */ 1927 1999 if (near_bits == 0xffff) { 1928 2000 return (new + (nbits << 3)); … … 1955 2027 { 1956 2028 int tag_n = fulltag_of(obj); 1957 unsigned d word;2029 unsigned dnode; 1958 2030 1959 2031 /* Locatives can be tagged as conses, "fulltag_misc" … … 1962 2034 doesn't hurt to check ... */ 1963 2035 2036 #ifdef PPC64 2037 if ((tag_n & lowtag_mask) != lowtag_primary) { 2038 return obj; 2039 } 2040 #else 1964 2041 if ((1<<tag_n) & ((1<<fulltag_immheader) | 1965 2042 (1<<fulltag_nodeheader) | … … 1968 2045 return obj; 1969 2046 } 1970 1971 dword = gc_area_dword(obj); 1972 1973 if ((dword >= GCndwords_in_area) || 2047 #endif 2048 2049 dnode = gc_area_dnode(obj); 2050 2051 if ((dnode >= GCndnodes_in_area) || 1974 2052 (obj < GCfirstunmarked)) { 1975 2053 return obj; 1976 2054 } 1977 2055 1978 return d word_forwarding_address(dword, tag_n);2056 return dnode_forwarding_address(dnode, tag_n); 1979 2057 } 1980 2058 … … 1983 2061 { 1984 2062 int tag_n; 1985 unsigned d word = gc_area_dword(node);1986 1987 if ((d word >= GCndwords_in_area) ||2063 unsigned dnode = gc_area_dnode(node); 2064 2065 if ((dnode >= GCndnodes_in_area) || 1988 2066 (node < GCfirstunmarked)) { 1989 2067 return node; … … 1995 2073 } 1996 2074 1997 return d word_forwarding_address(dword, tag_n);2075 return dnode_forwarding_address(dnode, tag_n); 1998 2076 } 1999 2077 … … 2031 2109 while ((next = *prev) != (LispObj)NULL) { 2032 2110 *prev = node_forwarding_address(next); 2033 prev = &(((xmacptr *) (untag(next)))->link);2111 prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link); 2034 2112 } 2035 2113 } … … 2045 2123 node = *p; 2046 2124 tag_n = fulltag_of(node); 2047 if ( tag_n == fulltag_immheader) {2125 if (immheader_tag_p(tag_n)) { 2048 2126 p = (LispObj *) skip_over_ivector((unsigned) p, node); 2049 } else if ( tag_n == fulltag_nodeheader) {2127 } else if (nodeheader_tag_p(tag_n)) { 2050 2128 nwords = header_element_count(node); 2051 2129 nwords += (1- (nwords&1)); … … 2096 2174 2097 2175 void 2098 forward_memoized_area(area *a, unsigned num_memo_d words)2176 forward_memoized_area(area *a, unsigned num_memo_dnodes) 2099 2177 { 2100 2178 bitvector refbits = a->refbits; 2101 2179 LispObj *p = (LispObj *) a->low, x1, x2, new; 2102 unsigned bits, bitidx, *bitsp, nextbit, diff, memo_d word = 0, hash_dword_limit = 0;2180 unsigned bits, bitidx, *bitsp, nextbit, diff, memo_dnode = 0, hash_dnode_limit = 0; 2103 2181 int tag_x1; 2104 2182 hash_table_vector_header *hashp = NULL; … … 2106 2184 2107 2185 if (GCDebug) { 2108 check_refmap_consistency(p, p+(num_memo_d words << 1), refbits);2186 check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits); 2109 2187 } 2110 2188 … … 2114 2192 2115 2193 set_bitidx_vars(refbits, 0, bitsp, bits, bitidx); 2116 while (memo_d word < num_memo_dwords) {2194 while (memo_dnode < num_memo_dnodes) { 2117 2195 if (bits == 0) { 2118 2196 int remain = 0x20 - bitidx; 2119 memo_d word+= remain;2197 memo_dnode += remain; 2120 2198 p += (remain+remain); 2121 2199 bits = *++bitsp; … … 2124 2202 nextbit = count_leading_zeros(bits); 2125 2203 if ((diff = (nextbit - bitidx)) != 0) { 2126 memo_d word+= diff;2204 memo_dnode += diff; 2127 2205 bitidx = nextbit; 2128 2206 p += (diff+diff); … … 2132 2210 tag_x1 = fulltag_of(x1); 2133 2211 bits &= ~(BIT0_MASK >> bitidx); 2134 header_p = ( tag_x1 == fulltag_nodeheader);2212 header_p = (nodeheader_tag_p(tag_x1)); 2135 2213 2136 2214 if (header_p && … … 2138 2216 hashp = (hash_table_vector_header *) p; 2139 2217 if (hashp->flags & nhash_track_keys_mask) { 2140 hash_d word_limit = memo_dword+ ((header_element_count(x1)+2)>>1);2218 hash_dnode_limit = memo_dnode + ((header_element_count(x1)+2)>>1); 2141 2219 } else { 2142 2220 hashp = NULL; … … 2156 2234 if (new != x2) { 2157 2235 *p = new; 2158 if (memo_d word < hash_dword_limit) {2236 if (memo_dnode < hash_dnode_limit) { 2159 2237 hashp->flags |= nhash_key_moved_mask; 2160 hash_d word_limit = 0;2238 hash_dnode_limit = 0; 2161 2239 hashp = NULL; 2162 2240 } 2163 2241 } 2164 2242 p++; 2165 memo_d word++;2243 memo_dnode++; 2166 2244 bitidx++; 2167 2245 … … 2170 2248 } 2171 2249 2172 void2173 forward_dohs( void )2174 {2175 doh_block_ptr doh_block = (doh_block_ptr) lisp_global(DOH_HEAD);2176 while( doh_block ) {2177 forward_range( &doh_block->data[0], &doh_block->data[doh_block_slots] );2178 doh_block = doh_block->link;2179 }2180 }2181 2250 2182 2251 … … 2306 2375 { 2307 2376 LispObj *src = (LispObj*) GCfirstunmarked, *dest = src, node, new; 2308 unsigned elements, d word = gc_area_dword(GCfirstunmarked), node_dwords = 0, imm_dwords = 0;2377 unsigned elements, dnode = gc_area_dnode(GCfirstunmarked), node_dnodes = 0, imm_dnodes = 0; 2309 2378 unsigned bitidx, *bitsp, bits, nextbit, diff; 2310 2379 int tag; … … 2314 2383 Boolean GCrelocated_code_vector = false; 2315 2384 2316 if (d word < GCndwords_in_area) {2385 if (dnode < GCndnodes_in_area) { 2317 2386 lisp_global(FWDNUM) += (1<<fixnum_shift); 2318 2387 2319 set_bitidx_vars(markbits,d word,bitsp,bits,bitidx);2320 while (d word < GCndwords_in_area) {2388 set_bitidx_vars(markbits,dnode,bitsp,bits,bitidx); 2389 while (dnode < GCndnodes_in_area) { 2321 2390 if (bits == 0) { 2322 2391 int remain = 0x20 - bitidx; 2323 d word+= remain;2392 dnode += remain; 2324 2393 src += (remain+remain); 2325 2394 bits = *++bitsp; … … 2329 2398 "bitidx" are 0. Count leading zeros in "bits" (there'll be 2330 2399 at least "bitidx" of them.) If there are more than "bitidx" 2331 leading zeros, bump "d word", "bitidx", and "src" by the difference. */2400 leading zeros, bump "dnode", "bitidx", and "src" by the difference. */ 2332 2401 nextbit = count_leading_zeros(bits); 2333 2402 if ((diff = (nextbit - bitidx)) != 0) { 2334 d word+= diff;2403 dnode += diff; 2335 2404 bitidx = nextbit; 2336 2405 src += (diff+diff); … … 2346 2415 node = *src++; 2347 2416 tag = fulltag_of(node); 2348 if ( tag == fulltag_nodeheader) {2417 if (nodeheader_tag_p(tag)) { 2349 2418 elements = header_element_count(node); 2350 node_d words = (elements+2)>>1;2351 d word += node_dwords;2419 node_dnodes = (elements+2)>>1; 2420 dnode += node_dnodes; 2352 2421 if ((header_subtag(node) == subtag_hash_vector) && 2353 2422 (((hash_table_vector_header *) (src-1))->flags & nhash_track_keys_mask)) { … … 2384 2453 *dest++ = node; 2385 2454 *dest++ = node_forwarding_address(*src++); 2386 while(--node_d words) {2455 while(--node_dnodes) { 2387 2456 *dest++ = node_forwarding_address(*src++); 2388 2457 *dest++ = node_forwarding_address(*src++); 2389 2458 } 2390 2459 } 2391 set_bitidx_vars(markbits,d word,bitsp,bits,bitidx);2392 } else if ( tag == fulltag_immheader) {2460 set_bitidx_vars(markbits,dnode,bitsp,bits,bitidx); 2461 } else if (immheader_tag_p(tag)) { 2393 2462 *dest++ = node; 2394 2463 *dest++ = *src++; 2395 2464 elements = header_element_count(node); 2396 2465 tag = header_subtag(node); 2466 #ifdef PPC64 2467 switch(fulltag_of(tag)) { 2468 case ivector_class_64_bit: 2469 imm_dnodes = ((elements+1)+1)>>1; 2470 break; 2471 case ivector_class_32_bit: 2472 if (tag == subtag_code_vector) { 2473 GCrelocated_code_vector = true; 2474 } 2475 imm_dnodes = (((elements+2)+3)>>2); 2476 break; 2477 case ivector_class_8_bit: 2478 imm_dnodes = (((elements+8)+15)>>4); 2479 break; 2480 case ivector_class_other_bit: 2481 if (tag == subtag_bit_vector) { 2482 imm_dnodes = (((elements+64)+127)>>7); 2483 } else { 2484 imm_dnodes = (((elements+4)+7)>>3); 2485 } 2486 } 2487 #else 2397 2488 if (tag <= max_32_bit_ivector_subtag) { 2398 2489 if (tag == subtag_code_vector) { 2399 2490 GCrelocated_code_vector = true; 2400 2491 } 2401 imm_d words = (((elements+1)+1)>>1);2492 imm_dnodes = (((elements+1)+1)>>1); 2402 2493 } else if (tag <= max_8_bit_ivector_subtag) { 2403 imm_d words = (((elements+4)+7)>>3);2494 imm_dnodes = (((elements+4)+7)>>3); 2404 2495 } else if (tag <= max_16_bit_ivector_subtag) { 2405 imm_d words = (((elements+2)+3)>>2);2496 imm_dnodes = (((elements+2)+3)>>2); 2406 2497 } else if (tag == subtag_bit_vector) { 2407 imm_d words = (((elements+32)+63)>>6);2498 imm_dnodes = (((elements+32)+63)>>6); 2408 2499 } else { 2409 imm_d words = elements+1;2500 imm_dnodes = elements+1; 2410 2501 } 2411 dword += imm_dwords; 2412 while (--imm_dwords) { 2502 #endif 2503 dnode += imm_dnodes; 2504 while (--imm_dnodes) { 2413 2505 *dest++ = *src++; 2414 2506 *dest++ = *src++; 2415 2507 } 2416 set_bitidx_vars(markbits,d word,bitsp,bits,bitidx);2508 set_bitidx_vars(markbits,dnode,bitsp,bits,bitidx); 2417 2509 } else { 2418 2510 *dest++ = node_forwarding_address(node); 2419 2511 *dest++ = node_forwarding_address(*src++); 2420 2512 bits &= ~(BIT0_MASK >> bitidx); 2421 d word++;2513 dnode++; 2422 2514 bitidx++; 2423 2515 } … … 2427 2519 2428 2520 { 2429 unsigned nbytes = (unsigned)dest - (unsigned)GCfirstunmarked;2521 natural nbytes = (natural)dest - (natural)GCfirstunmarked; 2430 2522 if ((nbytes != 0) && GCrelocated_code_vector) { 2431 xMakeDataExecutable((LogicalAddress) GCfirstunmarked, nbytes);2432 } 2433 } 2434 } 2435 return (LispObj)dest;2523 xMakeDataExecutable((LogicalAddress)ptr_from_lispobj(GCfirstunmarked), nbytes); 2524 } 2525 } 2526 } 2527 return ptr_to_lispobj(dest); 2436 2528 } 2437 2529 … … 2486 2578 GCephemeral_low = lisp_global(OLDEST_EPHEMERAL); 2487 2579 if (GCephemeral_low) { 2488 GCn_ephemeral_d words=area_dword(oldfree, GCephemeral_low);2580 GCn_ephemeral_dnodes=area_dnode(oldfree, GCephemeral_low); 2489 2581 update_area_refmaps(oldfree); 2490 2582 } else { … … 2492 2584 unprotect_area(oldspace_protected_area); 2493 2585 } 2494 GCn_ephemeral_d words = 0;2586 GCn_ephemeral_dnodes = 0; 2495 2587 } 2496 2588 … … 2531 2623 2532 2624 GCmarkbits = a->markbits; 2533 GCarealow = (LispObj) a->low,2534 GCnd words_in_area = gc_area_dword(oldfree);2535 2536 zero_bits(GCmarkbits, GCnd words_in_area);2625 GCarealow = ptr_to_lispobj(a->low); 2626 GCndnodes_in_area = gc_area_dnode(oldfree); 2627 2628 zero_bits(GCmarkbits, GCndnodes_in_area); 2537 2629 GCweakvll = (LispObj)NULL; 2538 2630 2539 2631 2540 if (GCn_ephemeral_d words == 0) {2632 if (GCn_ephemeral_dnodes == 0) { 2541 2633 /* For GCTWA, mark the internal package hash table vector of 2542 2634 *PACKAGE*, but don't mark its contents. */ … … 2545 2637 itab; 2546 2638 unsigned 2547 d word, ndwords;2639 dnode, ndnodes; 2548 2640 2549 2641 pkg = nrs_PACKAGE.vcell; 2550 2642 if ((fulltag_of(pkg) == fulltag_misc) && 2551 2643 (header_subtag(header_of(pkg)) == subtag_package)) { 2552 itab = ((package *) (untag(pkg)))->itab;2644 itab = ((package *)ptr_from_lispobj(untag(pkg)))->itab; 2553 2645 itabvec = car(itab); 2554 d word = gc_area_dword(itabvec);2555 if (d word < GCndwords_in_area) {2556 nd words = (header_element_count(header_of(itabvec))+1) >> 1;2557 set_n_bits(GCmarkbits, d word, ndwords);2646 dnode = gc_area_dnode(itabvec); 2647 if (dnode < GCndnodes_in_area) { 2648 ndnodes = (header_element_count(header_of(itabvec))+1) >> 1; 2649 set_n_bits(GCmarkbits, dnode, ndnodes); 2558 2650 } 2559 2651 } … … 2599 2691 2600 2692 if (lisp_global(OLDEST_EPHEMERAL)) { 2601 mark_memoized_area(tenured_area, area_d word(a->low,tenured_area->low));2693 mark_memoized_area(tenured_area, area_dnode(a->low,tenured_area->low)); 2602 2694 } 2603 2695 … … 2609 2701 } while (other_tcr != tcr); 2610 2702 2611 mark_dohs(); /* Creole */2612 2703 2613 2704 … … 2629 2720 if (fulltag_of(sym) == fulltag_misc) { 2630 2721 lispsymbol *rawsym = (lispsymbol *)(untag(sym)); 2631 unsigned d word = gc_area_dword(sym);2722 unsigned dnode = gc_area_dnode(sym); 2632 2723 2633 if ((d word < GCndwords_in_area) &&2634 (!ref_bit(GCmarkbits,d word))) {2724 if ((dnode < GCndnodes_in_area) && 2725 (!ref_bit(GCmarkbits,dnode))) { 2635 2726 /* Symbol is in GC area, not marked. 2636 2727 Mark it if fboundp, boundp, or if … … 2664 2755 if (fulltag_of(sym) == fulltag_misc) { 2665 2756 lispsymbol *rawsym = (lispsymbol *)(untag(sym)); 2666 unsigned d word = gc_area_dword(sym);2667 2668 if ((d word < GCndwords_in_area) &&2669 (!ref_bit(GCmarkbits,d word))) {2670 *raw = unbound ;2757 unsigned dnode = gc_area_dnode(sym); 2758 2759 if ((dnode < GCndnodes_in_area) && 2760 (!ref_bit(GCmarkbits,dnode))) { 2761 *raw = unbound_marker; 2671 2762 } 2672 2763 } … … 2688 2779 } while (other_tcr != tcr); 2689 2780 2690 forward_dohs(); /* Creole */2691 2781 2692 2782 forward_gcable_ptrs(); … … 2728 2818 2729 2819 if (GCephemeral_low) { 2730 forward_memoized_area(tenured_area, area_d word(a->low, tenured_area->low));2820 forward_memoized_area(tenured_area, area_dnode(a->low, tenured_area->low)); 2731 2821 } 2732 2822 … … 2802 2892 (header_subtag(header_of(val)) == subtag_macptr)) { 2803 2893 long long justfreed = oldfree - a->active; 2804 *( (long long *) ((macptr *) (untag(val)))->address) += justfreed;2894 *( (long long *) ((macptr *) ptr_from_lispobj(untag(val)))->address) += justfreed; 2805 2895 } 2806 2896 } … … 2823 2913 tag = fulltag_of(header); 2824 2914 2825 if (( tag == fulltag_nodeheader) ||2826 ( tag == fulltag_immheader)) {2915 if ((nodeheader_tag_p(tag)) || 2916 (immheader_tag_p(tag))) { 2827 2917 elements = header_element_count(header); 2828 if ( tag == fulltag_nodeheader) {2918 if (nodeheader_tag_p(tag)) { 2829 2919 start += ((elements+2) & ~1); 2830 2920 } else { 2831 2921 subtag = header_subtag(header); 2832 2922 2923 #ifdef PPC64 2924 switch(fulltag_of(header)) { 2925 case ivector_class_64_bit: 2926 bytes = 8 + (elements<<3); 2927 break; 2928 case ivector_class_32_bit: 2929 bytes = 8 + (elements<<2); 2930 break; 2931 case ivector_class_8_bit: 2932 bytes = 8 + elements; 2933 break; 2934 case ivector_class_other_bit: 2935 default: 2936 if (subtag == subtag_bit_vector) { 2937 bytes = 8 + ((elements+7)>>3); 2938 } else { 2939 bytes = 8 + (elements<<1); 2940 } 2941 } 2942 #else 2833 2943 if (subtag <= max_32_bit_ivector_subtag) { 2834 2944 bytes = 4 + (elements<<2); … … 2842 2952 bytes = 4 + ((elements+7)>>3); 2843 2953 } 2844 bytes = (bytes+7) & ~7; 2954 #endif 2955 bytes = (bytes+dnode_size-1) & ~(dnode_size-1); 2845 2956 total += bytes; 2846 start += (bytes >> 2);2957 start += (bytes >> node_shift); 2847 2958 } 2848 2959 } else { … … 2866 2977 BytePtr 2867 2978 free = dest->active, 2868 *old = (BytePtr *) untag(obj);2979 *old = (BytePtr *) ptr_from_lispobj(untag(obj)); 2869 2980 LispObj 2870 2981 header = header_of(obj), … … 2880 2991 break; 2881 2992 2882 case subtag_simple_general_string:2883 physbytes = 4 + (element_count << 1);2884 break;2885 2886 2993 case subtag_code_vector: 2887 2994 physbytes = 4 + (element_count << 2); … … 2895 3002 dest->active += physbytes; 2896 3003 2897 new = (LispObj)free+disp;3004 new = ptr_to_lispobj(free)+disp; 2898 3005 2899 3006 memcpy(free, (BytePtr)old, physbytes); … … 2904 3011 look like a header. 2905 3012 b) We'd like to be able to forward code-vector locatives, and 2906 it's easiest to do so if we leave a {forward_marker, d word_locative}3013 it's easiest to do so if we leave a {forward_marker, dnode_locative} 2907 3014 pair at every doubleword in the old vector. 2908 3015 */ … … 2934 3041 2935 3042 if ((tag == fulltag_misc) && 2936 (((BytePtr) obj) > low) &&2937 (((BytePtr) obj) < high)) {3043 (((BytePtr)ptr_from_lispobj(obj)) > low) && 3044 (((BytePtr)ptr_from_lispobj(obj)) < high)) { 2938 3045 header = deref(obj, 0); 2939 3046 if (header == forward_marker) { /* already copied */ … … 2941 3048 } else { 2942 3049 header_tag = fulltag_of(header); 2943 if ( header_tag == fulltag_immheader) {3050 if (immheader_tag_p(header_tag)) { 2944 3051 header_subtag = header_subtag(header); 2945 3052 if (((header_subtag == subtag_code_vector) && (what_to_copy & COPY_CODE)) || 2946 3053 ((what_to_copy & COPY_STRINGS) && 2947 ((header_subtag == subtag_simple_base_string) || 2948 (header_subtag == subtag_simple_general_string)))) { 3054 ((header_subtag == subtag_simple_base_string)))) { 2949 3055 *ref = purify_object(obj, dest); 2950 3056 } … … 2963 3069 tag = fulltag_of(loc); 2964 3070 2965 if (((BytePtr) loc> low) &&2966 ((BytePtr) loc< high)) {2967 LispObj *p = (LispObj *) (untag(loc));3071 if (((BytePtr)ptr_from_lispobj(loc) > low) && 3072 ((BytePtr)ptr_from_lispobj(loc) < high)) { 3073 LispObj *p = (LispObj *)ptr_from_lispobj(untag(loc)); 2968 3074 switch (tag) { 2969 3075 case fulltag_even_fixnum: … … 2980 3086 header = *p; 2981 3087 } while ((header & code_header_mask) != subtag_code_vector); 2982 *locaddr = purify_displaced_object( (LispObj)p, to, tag);3088 *locaddr = purify_displaced_object(ptr_to_lispobj(p), to, tag); 2983 3089 } 2984 3090 break; … … 3003 3109 } else { 3004 3110 tag = fulltag_of(header); 3005 if ( tag == fulltag_immheader) {3111 if (immheader_tag_p(tag)) { 3006 3112 start = (LispObj *)skip_over_ivector((unsigned)start, header); 3007 3113 } else { 3008 if ( tag != fulltag_nodeheader) {3114 if (!nodeheader_tag_p(tag)) { 3009 3115 copy_ivector_reference(start, low, high, to, what); 3010 3116 } … … 3031 3137 end != limit; 3032 3138 current = next) { 3033 next = (LispObj *) *current;3139 next = (LispObj *) ptr_from_lispobj(*current); 3034 3140 end = ((next >= start) && (next < limit)) ? next : limit; 3035 3141 if (current[1] == 0) { … … 3126 3232 } 3127 3233 3128 void3129 purify_dohs(BytePtr low, BytePtr high, area *to, int what)3130 {3131 doh_block_ptr doh_block = (doh_block_ptr) lisp_global(DOH_HEAD);3132 while( doh_block ) {3133 purify_range( &doh_block->data[0], &doh_block->data[doh_block_slots],3134 low, high, to, what );3135 doh_block = doh_block->link;3136 }3137 }3138 3234 3139 3235 void … … 3217 3313 3218 3314 while (fulltag_of(pkg_list) == fulltag_cons) { 3219 c = (cons *) untag(pkg_list);3220 p = (package *) untag(c->car);3315 c = (cons *) ptr_from_lispobj(untag(pkg_list)); 3316 p = (package *) ptr_from_lispobj(untag(c->car)); 3221 3317 pkg_list = c->cdr; 3222 c = (cons *) untag(p->itab);3318 c = (cons *) ptr_from_lispobj(untag(p->itab)); 3223 3319 htab = c->car; 3224 3320 elements = header_element_count(header_of(htab)); … … 3226 3322 obj = deref(htab,i); 3227 3323 if (fulltag_of(obj) == fulltag_misc) { 3228 rawsym = (lispsymbol *) untag(obj);3324 rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj)); 3229 3325 copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS); 3230 3326 } 3231 3327 } 3232 c = (cons *) untag(p->etab);3328 c = (cons *) ptr_from_lispobj(untag(p->etab)); 3233 3329 htab = c->car; 3234 3330 elements = header_element_count(header_of(htab)); … … 3236 3332 obj = deref(htab,i); 3237 3333 if (fulltag_of(obj) == fulltag_misc) { 3238 rawsym = (lispsymbol *) untag(obj);3334 rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj)); 3239 3335 copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS); 3240 3336 } … … 3252 3348 } while (other_tcr != tcr); 3253 3349 3254 purify_dohs(a->low, a->active, new_pure_area, COPY_CODE);3255 3350 3256 3351 { … … 3354 3449 header = *start; 3355 3450 tag = fulltag_of(header); 3356 if ( tag == fulltag_immheader) {3451 if (immheader_tag_p(tag)) { 3357 3452 start = (LispObj *)skip_over_ivector((unsigned)start, header); 3358 3453 } else { 3359 if ( tag != fulltag_nodeheader) {3454 if (!nodeheader_tag_p(tag)) { 3360 3455 impurify_noderef(start, low, high, delta); 3361 3456 } … … 3408 3503 end != limit; 3409 3504 current = next) { 3410 next = (LispObj *) *current;3505 next = (LispObj *) ptr_from_lispobj(*current); 3411 3506 end = ((next >= start) && (next < limit)) ? next : limit; 3412 3507 if (current[1] == 0) { … … 3479 3574 bcopy(ro_base, oldfree, n); 3480 3575 munmap(ro_base, n); 3481 a->nd words = area_dword(a, a->active);3576 a->ndnodes = area_dnode(a, a->active); 3482 3577 pure_space_active = r->active = r->low; 3483 r->nd words = 0;3484 3485 impurify_areas( (LispObj)ro_base, (LispObj)ro_limit, delta);3578 r->ndnodes = 0; 3579 3580 impurify_areas(ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta); 3486 3581 3487 3582 other_tcr = tcr; 3488 3583 do { 3489 impurify_tcr_xframes(other_tcr, (LispObj)ro_base, (LispObj)ro_limit, delta);3490 impurify_tcr_tlb(other_tcr, (LispObj)ro_base, (LispObj)ro_limit, delta);3584 impurify_tcr_xframes(other_tcr, ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta); 3585 impurify_tcr_tlb(other_tcr, ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta); 3491 3586 other_tcr = other_tcr->next; 3492 3587 } while (other_tcr != tcr); -
trunk/ccl/lisp-kernel/gc.h
r12 r557 38 38 39 39 extern LispObj GCarealow; 40 extern unsigned GCnd words_in_area;40 extern unsigned GCndnodes_in_area; 41 41 extern bitvector GCmarkbits; 42 42 LispObj *global_reloctab, *GCrelocptr; … … 48 48 void mark_locative_root(LispObj); 49 49 void rmark(LispObj); 50 unsigned skip_over_ivector(unsigned, LispObj);50 LispObj *skip_over_ivector(LispObj, LispObj); 51 51 void mark_simple_area_range(LispObj *,LispObj *); 52 52 LispObj calculate_relocation(); … … 64 64 65 65 66 #define area_d word(w,low) ((((LispObj)w) - (LispObj)low)>>3)67 #define gc_area_d word(w) area_dword(w,GCarealow)66 #define area_dnode(w,low) (((ptr_to_lispobj(w)) - ptr_to_lispobj(low))>>dnode_shift) 67 #define gc_area_dnode(w) area_dnode(w,GCarealow) 68 68 69 #ifdef PPC64 70 #define forward_marker subtag_forward_marker 71 #else 69 72 #define forward_marker fulltag_nil 73 #endif 70 74 71 #define VOID_ALLOCPTR 0xFFFFFFF875 #define VOID_ALLOCPTR ((LispObj)(-dnode_size)) 72 76 73 77 -
trunk/ccl/lisp-kernel/lisp-exceptions.h
r173 r557 87 87 88 88 89 typedef u nsignedopcode, *pc;89 typedef u_int32_t opcode, *pc; 90 90 91 91 #ifdef LINUX -
trunk/ccl/lisp-kernel/lisp.h
r6 r557 17 17 #ifndef __lisp__ 18 18 #define __lisp__ 19 20 /* 21 On some platforms (the G5 under Panther when -mpowerpc64 is in effect) 22 the C compiler belives that pointers are only 32 bits wide, even though 23 the machine's in 64-bit mode. If that's the case, prepand a gensym'ed 24 word to any pointer fields in any structure accessed by both C and Lisp 25 code. 26 27 This means that C and Lisp will have a slightly different notion of the 28 offset of each such field. The alternative - representing the pointer 29 as a 64-bit int and casting on every reference - seems just as ugly. 30 */ 31 32 #if defined(PPC64) && defined(FOREIGN_POINTER_32BIT) 33 #define NATURAL_POINTER_FIELD(type,name) unsigned _ ## name; type * name 34 #else 35 #define NATURAL_POINTER_FIELD(type,name) type *name; 36 #endif 37 19 38 20 39 #include "lisptypes.h" -
trunk/ccl/lisp-kernel/lisp_globals.h
r217 r557 77 77 #define SUBPRIMS_TARGET_N (-257) /* absolute address of subprim 255 jump target */ 78 78 79 79 #ifdef PPC64 80 #define lisp_global(g) (((LispObj *) 0x2000)[(g)]) 81 #define nrs_symbol(s) (((lispsymbol *) 0x2000)[(s)]) 82 #else 80 83 #define lisp_global(g) (((LispObj *) (nil_value-fulltag_nil))[(g)]) 81 84 #define nrs_symbol(s) (((lispsymbol *) (nil_value+(8-fulltag_nil)+8))[(s)]) 85 #endif 82 86 83 87 #define nrs_T (nrs_symbol(0)) /* t */ -
trunk/ccl/lisp-kernel/lisptypes.h
r6 r557 18 18 #define __lisptypes__ 19 19 20 typedef unsigned LispObj; 20 #include <sys/types.h> 21 #ifdef PPC64 22 typedef u_int64_t LispObj; 23 typedef u_int64_t natural; 24 typedef int64_t signed_natural; 25 #ifdef FOREIGN_POINTER_32BIT 26 typedef u_int32_t unsigned_of_pointer_size; 27 #else 28 typedef u_int64_t unsigned_of_pointer_size; 29 #endif 30 #else 31 typedef u_int32_t LispObj; 32 typedef u_int32_t natural; 33 typedef int32_t signed_natural; 34 typedef u_int32_t unsigned_of_pointer_size; 35 #endif 21 36 22 37 typedef struct ucontext ExceptionInformation, ExceptionInformationPowerPC; 23 38 24 typedef char *BytePtr;25 39 typedef int OSStatus, OSErr; 26 40 #define noErr ((OSErr) 0) 27 41 typedef int Boolean; 28 42 typedef void *LogicalAddress; 29 typedef char *StringPtr; 30 typedef char *Ptr; 43 typedef char *Ptr, *BytePtr, *StringPtr; 31 44 typedef unsigned int UInt32; 45 32 46 typedef union { 33 47 unsigned short halfword; 34 48 struct { 49 #ifdef PPC64 50 unsigned short offset:13; 51 unsigned short pad:1; 52 #else 35 53 unsigned short offset:14; 54 #endif 36 55 unsigned short hasnode:1; 37 56 unsigned short modified:1; -
trunk/ccl/lisp-kernel/macros.h
r6 r557 22 22 #define __macros__ 23 23 24 #define ptr_to_lispobj(p) ((LispObj)((unsigned_of_pointer_size)(p))) 25 #define ptr_from_lispobj(o) ((LispObj*)((unsigned_of_pointer_size)(o))) 24 26 #define lisp_reg_p(reg) ((reg) >= fn) 25 27 … … 28 30 #define untag(o) ((o) & ~fulltagmask) 29 31 30 #define deref(o,n) (*((LispObj*) ( (LispObj *)(untag((LispObj)o)))+(n)))32 #define deref(o,n) (*((LispObj*) (ptr_from_lispobj(untag((LispObj)o)))+(n))) 31 33 #define header_of(o) deref(o,0) 32 34 … … 47 49 #define FBOUNDP(sym) ((((lispsymbol *)(sym))->fcell) != nrs_UDF.vcell) 48 50 51 #ifdef PPC64 52 #define nodeheader_tag_p(tag) (((tag) & lowtag_mask) == lowtag_nodeheader) 53 #else 54 #define nodeheader_tag_p(tag) (tag == fulltag_nodeheader) 55 #endif 56 57 #ifdef PPC64 58 #define immheader_tag_p(tag) (((tag) & lowtag_mask) == lowtag_immheader) 59 #else 60 #define immheader_tag_p(tag) (tag == fulltag_immheader) 61 #endif 49 62 50 63 /* lfuns */ -
trunk/ccl/lisp-kernel/macros.s
r528 r557 59 59 ldx $@ 60 60 ]) 61 define([ldru],[ 62 ldu $@ 63 ]) 61 64 define([str],[ 62 65 std $@ 63 66 ]) 64 67 define([strx],[ 65 stdx %@68 stdx $@ 66 69 ]) 67 70 define([stru],[ … … 102 105 ]) 103 106 define([srari],[ 104 sradi #@107 sradi $@ 105 108 ]) 106 109 define([srri],[ … … 125 128 define([ldrx],[ 126 129 lwzx $@ 130 ]) 131 define([ldru],[ 132 lwzu $@ 127 133 ]) 128 134 define([str],[ … … 169 175 ]) 170 176 define([srari],[ 171 srawi #@177 srawi $@ 172 178 ]) 173 179 define([srri],[ … … 229 235 230 236 define([box_fixnum],[ 231 sl wi $1,$2,fixnumshift])237 slri($1,$2,fixnumshift)]) 232 238 233 239 define([unbox_fixnum],[ 234 sra wi $1,$2,fixnumshift])240 srari($1,$2,fixnumshift)]) 235 241 236 242 define([loaddf],[ … … 294 300 /* "Length" is fixnum element count */ 295 301 define([header_length],[ 296 rlwinm $1,$2,nbits_in_word-(num_subtag_bits-nfixnumtagbits),(num_subtag_bits-nfixnumtagbits),31-nfixnumtagbits]) 302 ifdef([PPC64],[ 303 clrlsldi $1,$2,nbits_in_word-num_subtag_bits,fixnum_shift 304 ],[ 305 rlwinm $1,$2,nbits_in_word-(num_subtag_bits-nfixnumtagbits),(num_subtag_bits-nfixnumtagbits),31-nfixnumtagbits 306 ]) 307 ]) 297 308 298 309 -
trunk/ccl/lisp-kernel/pantherg5/Makefile
r530 r557 48 48 AS = as 49 49 M4 = gm4 50 M4FLAGS = -DDARWIN -DPPC64 -D PANTHERG550 M4FLAGS = -DDARWIN -DPPC64 -DFOREIGN_POINTER_32BIT 51 51 ASFLAGS = -force_cpusubtype_ALL 52 CDEFINES = -D DARWIN $(BROKEN_PREPROCESSOR_WORKAROUND) -DOPENMCL_MAJOR_VERSION=$(OPENMCL_MAJOR_VERSION) -DOPENMCL_MINOR_VERSION=$(OPENMCL_MINOR_VERSION)52 CDEFINES = -DPPC64 -DFOREIGN_POINTER_32BIT -DDARWIN $(BROKEN_PREPROCESSOR_WORKAROUND) -DOPENMCL_MAJOR_VERSION=$(OPENMCL_MAJOR_VERSION) -DOPENMCL_MINOR_VERSION=$(OPENMCL_MINOR_VERSION) 53 53 CDEBUG = -g 54 COPT = -O2 -mpowerpc64 -DPPC64 -DPANTHERG554 COPT = -O2 -mpowerpc64 55 55 56 56 .s.o: … … 78 78 79 79 KSPOBJ= $(SPOBJ) 80 all: ../../dppccl 80 all: ../../dppccl64 81 81 82 82 … … 89 89 90 90 91 ../../dppccl : $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ)91 ../../dppccl64: $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) 92 92 $(LD) $(LDFLAGS) $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(OSLIBS) 93 93 … … 115 115 116 116 cclean: 117 $(RM) -f $(KERNELOBJ) $(DEBUGOBJ) ../../dppccl 117 $(RM) -f $(KERNELOBJ) $(DEBUGOBJ) ../../dppccl64 118 118 119 119 # Some earlier versions of this Makefile built "subprims_r.o". … … 122 122 $(RM) -f $(SPOBJ) $(KSPOBJ) subprims_r.o 123 123 124 strip: ../../dppccl 125 strip -s retain ../../dppccl 124 strip: ../../dppccl64 125 strip -s retain ../../dppccl64 -
trunk/ccl/lisp-kernel/plsym.c
r6 r557 31 31 32 32 33 unsigned skip_over_ivector(unsigned, LispObj);34 33 35 34 /* -
trunk/ccl/lisp-kernel/pmcl-kernel.c
r510 r557 547 547 reserved->low += size; 548 548 reserved->active = reserved->low; 549 reserved->nd words -= (size>>3);549 reserved->ndnodes -= (size>>dnode_shift); 550 550 return low; 551 551 } … … 600 600 { 601 601 unsigned 602 nd words = area_dword(lisp_global(HEAP_END),lisp_global(HEAP_START)),602 ndnodes = area_dnode(lisp_global(HEAP_END),lisp_global(HEAP_START)), 603 603 npages = (lisp_global(HEAP_END)-lisp_global(HEAP_START)) >> 12, 604 markbits_size = 12+((nd words+7)>>3),605 reloctab_size = (sizeof(LispObj)*(((nd words+31)>>5)+1)),604 markbits_size = 12+((ndnodes+7)>>dnode_shift), 605 reloctab_size = (sizeof(LispObj)*(((ndnodes+31)>>5)+1)), 606 606 pagemap_size = align_to_power_of_2(npages*sizeof(pageentry),12); 607 607 BytePtr … … 676 676 677 677 a->high += delta; 678 a->nd words = area_dword(a->high, a->low);678 a->ndnodes = area_dnode(a->high, a->low); 679 679 a->hardlimit = a->high; 680 680 oldspace_protected_area->end = a->high; … … 697 697 698 698 a->high -= delta; 699 a->nd words = area_dword(a->high, a->low);699 a->ndnodes = area_dnode(a->high, a->low); 700 700 a->hardlimit = a->high; 701 701 oldspace_protected_area->end = a->high; 702 702 uncommit_pages(a->high, delta); 703 703 reserved->low -= delta; 704 reserved->nd words += (delta>>3);704 reserved->ndnodes += (delta>>dnode_shift); 705 705 lisp_global(HEAP_END) -= delta; 706 706 return true; … … 1185 1185 lisp_global(LEXPR_RETURN) = (LispObj)&nvalret; 1186 1186 lisp_global(LEXPR_RETURN1V) = (LispObj)&popj; 1187 lisp_global(ALL_AREAS) = (LispObj)(all_areas);1187 lisp_global(ALL_AREAS) = ptr_to_lispobj(all_areas); 1188 1188 1189 1189 … … 1196 1196 1197 1197 1198 lisp_global(IMAGE_NAME) = (LispObj) image_name;1199 lisp_global(ARGV) = (LispObj) argv;1200 lisp_global(KERNEL_IMPORTS) = (LispObj) import_ptrs_base;1198 lisp_global(IMAGE_NAME) = ptr_to_lispobj(image_name); 1199 lisp_global(ARGV) = ptr_to_lispobj(argv); 1200 lisp_global(KERNEL_IMPORTS) = (LispObj)import_ptrs_base; 1201 1201 1202 1202 lisp_global(METERING_INFO) = (LispObj) &lisp_metering; … … 1204 1204 *(double *) &(lisp_global(DOUBLE_FLOAT_ONE)) = (double) 1.0; 1205 1205 1206 lisp_global(ARGV) = (LispObj) argv;1207 1206 lisp_global(HOST_PLATFORM) = (LispObj) 1208 1207 #ifdef LINUX … … 1242 1241 tenured_area->younger = g2_area; 1243 1242 tenured_area->refbits = a->markbits; 1244 lisp_global(TENURED_AREA) = (LispObj)(tenured_area);1243 lisp_global(TENURED_AREA) = ptr_to_lispobj(tenured_area); 1245 1244 g2_area->threshold = (4<<20); /* 4MB */ 1246 1245 g1_area->threshold = (2<<20); /* 2MB */ … … 1253 1252 thread_init_tcr(tcr, current_sp, current_sp-stack_base); 1254 1253 1255 lisp_global(EXCEPTION_LOCK) = (LispObj)new_recursive_lock();1254 lisp_global(EXCEPTION_LOCK) = ptr_to_lispobj(new_recursive_lock()); 1256 1255 enable_fp_exceptions(); 1257 1256 start_vbl(); … … 1262 1261 #endif 1263 1262 tcr->prev = tcr->next = tcr; 1264 lisp_global(TCR_LOCK) = (LispObj)new_recursive_lock();1263 lisp_global(TCR_LOCK) = ptr_to_lispobj(new_recursive_lock()); 1265 1264 lisp_global(INTERRUPT_SIGNAL) = (LispObj) box_fixnum(SIGNAL_FOR_PROCESS_INTERRUPT); 1266 1265 tcr->interrupt_level = (-1<<fixnumshift); -
trunk/ccl/lisp-kernel/spentry.s
r529 r557 100 100 __(li fn,0) 101 101 __(add imm1,vsp,nargs) 102 __(la imm1,- 4(imm1))102 __(la imm1,-node_size(imm1)) 103 103 __(bne cr0,local_label(_throw_all_values)) 104 104 __(set_nargs(1)) … … 127 127 __(bne cr1,local_label(_throw_multiple)) 128 128 /* Catcher expects single value in arg_z */ 129 __(ldr(arg_z,- 4(imm0)))129 __(ldr(arg_z,-node_size(imm0))) 130 130 __(b local_label(_throw_pushed_values)) 131 131 local_label(_throw_multiple): … … 135 135 __(subi imm2,imm2,fixnum_one) 136 136 __(cmpri(imm2,0)) 137 __(l wzu temp0,-4(imm0))137 __(ldru(temp0,-node_size(imm0))) 138 138 __(push(temp0,imm1)) 139 139 __(bgt local_label(_throw_mvloop)) … … 190 190 __(b local_label(_nthrowv_push_test)) 191 191 local_label(_nthrowv_push_loop): 192 __(l wzu temp1,-4(imm1))192 __(ldru(temp1,-node_size(imm1))) 193 193 __(push(temp1,imm0)) 194 194 local_label(_nthrowv_push_test): … … 227 227 __(add imm1,nargs,vsp) 228 228 __(ldr(imm0,tsp_frame.backlink(tsp))) /* end of tsp frame */ 229 __(str(rzero,- 4(imm0)))229 __(str(rzero,-node_size(imm0))) 230 230 __(la imm0,tsp_frame.data_offset(tsp)) 231 231 __(str(nargs,0(imm0))) 232 232 __(b local_label(_nthrowv_tpushtest)) 233 233 local_label(_nthrowv_tpushloop): 234 __(l wzu temp0,-4(imm1))235 __(stru(temp0, 4(imm0)))234 __(ldru(temp0,-node_size(imm1))) 235 __(stru(temp0,node_size(imm0))) 236 236 __(subi imm2,imm2,fixnum_one) 237 237 local_label(_nthrowv_tpushtest): 238 238 __(cmpri(imm2,0)) 239 239 __(bne local_label(_nthrowv_tpushloop)) 240 __(stru(imm4, 4(imm0)))240 __(stru(imm4,node_size(imm0))) 241 241 __(ldr(vsp,lisp_frame.savevsp(sp))) 242 242 __(str(rzero,lisp_frame.savevsp(sp))) /* tell stack overflow code to skip this frame */ … … 251 251 __(b local_label(_nthrowv_tpoptest)) 252 252 local_label(_nthrowv_tpoploop): 253 __(l wzu temp0,4(imm0))253 __(ldru(temp0,node_size(imm0))) 254 254 __(vpush(temp0)) 255 255 __(subi imm2,imm2,fixnum_one) … … 257 257 __(cmpri(imm2,0)) 258 258 __(bne local_label(_nthrowv_tpoploop)) 259 __(ldr(imm4, 4(imm0)))259 __(ldr(imm4,node_size(imm0))) 260 260 __(unlink(tsp)) 261 261 __(b local_label(_nthrowv_nextframe)) … … 319 319 __(TSP_Alloc_Fixed_Boxed(8)) /* tsp overhead, value, throw count */ 320 320 __(str(arg_z,tsp_frame.data_offset(tsp))) 321 __(str(imm4,tsp_frame.data_offset+ 4(tsp)))321 __(str(imm4,tsp_frame.data_offset+node_size(tsp))) 322 322 __(ldr(vsp,lisp_frame.savevsp(sp))) 323 323 __(str(rzero,lisp_frame.savevsp(sp))) /* Tell stack overflow code to ignore this frame */ 324 324 __(bctrl) 325 325 __(ldr(arg_z,tsp_frame.data_offset(tsp))) 326 __(ldr(imm4,tsp_frame.data_offset+ 4(tsp)))326 __(ldr(imm4,tsp_frame.data_offset+node_size(tsp))) 327 327 __(ldr(fn,lisp_frame.savefn(sp))) 328 328 __(ldr(loc_pc,lisp_frame.savelr(sp))) … … 367 367 __(ldr(temp0,0(vsp))) 368 368 __(cmpri(nargs,fixnum_one)) 369 __(la vsp, 4(vsp))369 __(la vsp,node_size(vsp)) 370 370 __(Cons(arg_z,temp0,arg_z)) 371 371 __(subi nargs,nargs,fixnum_one) … … 382 382 __(ldr(temp0,0(vsp))) 383 383 __(cmpri(nargs,fixnum_one)) 384 __(la vsp, 4(vsp))384 __(la vsp,node_size(vsp)) 385 385 __(Cons(arg_z,temp0,arg_z)) 386 386 __(subi nargs,nargs,fixnum_one) … … 401 401 1: __(ldr(temp0,0(vsp))) 402 402 __(cmpri(cr1,nargs,fixnum_one)) 403 __(la vsp, 4(vsp))403 __(la vsp,node_size(vsp)) 404 404 __(rplaca(imm1,temp0)) 405 405 __(rplacd(imm1,arg_z)) … … 422 422 1: __(ldr(temp0,0(vsp))) 423 423 __(cmpri(cr1,nargs,fixnum_one)) 424 __(la vsp, 4(vsp))424 __(la vsp,node_size(vsp)) 425 425 __(rplaca(imm1,temp0)) 426 426 __(rplacd(imm1,arg_z)) … … 447 447 __(add imm1,imm0,nargs) 448 448 1: 449 __(la nargs,- 4(nargs))449 __(la nargs,-node_size(nargs)) 450 450 __(cmpri(cr1,nargs,0)) 451 451 __(ldr(temp1,0(vsp))) 452 __(la vsp, 4(vsp))453 __(st wu temp1,-4(imm1))452 __(la vsp,node_size(vsp)) 453 __(stru(temp1,-node_size(imm1))) 454 454 __(bne cr1,1b) 455 455 2: … … 504 504 heap-cons the object if there's no room on the tstack.) */ 505 505 _spentry(stack_misc_alloc) 506 ifdef([PPC64],[ 507 ],[ 506 508 __(rlwinm. imm2,arg_y,32-fixnumshift,0,(8+fixnumshift)-1) 507 509 __(unbox_fixnum(imm0,arg_z)) … … 550 552 __(srwi imm2,imm2,fixnumshift+3) 551 553 __(b 1b) 552 554 ]) 555 553 556 /* subtype (boxed, of course) is vpushed, followed by nargs bytes worth of */ 554 557 /* initial-contents. Note that this can be used to cons any type of initialized */ … … 638 641 __(li arg_z,nil_value) 639 642 __(neg imm1,imm1) 640 __(subi imm1,imm1, 4)643 __(subi imm1,imm1,node_size) 641 644 __(bge 1f) 642 645 __(ldrx(arg_z,imm0,imm1)) 643 646 1: 644 __(la vsp, 4(imm0))647 __(la vsp,node_size(imm0)) 645 648 __(blr) 646 649 … … 665 668 __(add imm0,nargs,vsp) 666 669 __(blt- cr0,1f) 667 __(ldr(arg_z,- 4(imm0)))670 __(ldr(arg_z,-node_size(imm0))) 668 671 1: 669 672 __(mr vsp,temp0) … … 696 699 __(cmpr(cr0,imm2,nargs)) 697 700 __(addi imm2,imm2,fixnum_one) 698 __(l wzu arg_z,-4(imm1))701 __(ldru(arg_z,-node_size(imm1))) 699 702 __(push(arg_z,imm0)) 700 703 __(bne cr0,5b) … … 756 759 __(ldr(temp0,0(vsp))) 757 760 __(cmpri(imm1,fixnum_one)) 758 __(la vsp, 4(vsp))761 __(la vsp,node_size(vsp)) 759 762 __(Cons(arg_z,temp0,arg_z)) 760 763 __(subi imm1,imm1,fixnum_one) … … 776 779 __(ldr(temp0,0(vsp))) 777 780 __(cmpri(imm1,fixnum_one)) 778 __(la vsp, 4(vsp))781 __(la vsp,node_size(vsp)) 779 782 __(Cons(arg_z,temp0,arg_z)) 780 783 __(subi imm1,imm1,fixnum_one) … … 793 796 __(ldr(temp0,0(vsp))) 794 797 __(cmpri(imm1,fixnum_one)) 795 __(la vsp, 4(vsp))798 __(la vsp,node_size(vsp)) 796 799 __(Cons(arg_z,temp0,arg_z)) 797 800 __(subi imm1,imm1,fixnum_one) … … 890 893 __(subi arg_z,arg_z,2<<fixnumshift) 891 894 __(cmplri(cr0,arg_z,0)) 892 __(ldr(arg_x, 0(varptr)))893 __(ldr(arg_y, 4(varptr)))894 __(str(imm4, 0(varptr)))895 __(str(imm4, 4(varptr)))896 __(la varptr, 8(varptr))897 __(str(arg_x, 0(valptr)))898 __(str(arg_y, 4(valptr)))899 __(la valptr, 8(valptr))895 __(ldr(arg_x,node_size*0(varptr))) 896 __(ldr(arg_y,node_size*1(varptr))) 897 __(str(imm4,node_size*0(varptr))) 898 __(str(imm4,node_size*1(varptr))) 899 __(la varptr,node_size*2(varptr)) 900 __(str(arg_x,node_size*0(valptr))) 901 __(str(arg_y,node_size*1(valptr))) 902 __(la valptr,node_size*2(valptr)) 900 903 __(bne cr0,4b) 901 904 … … 913 916 5: 914 917 __(cmpwi cr0,keyword_flags,16<<fixnumshift) /* seen :a-o-k yet ? */ 915 __(l wzu arg_z,-4(valptr))916 __(l wzu arg_y,-4(valptr))918 __(ldru(arg_z,-node_size(valptr))) 919 __(ldru(arg_y,-node_size(valptr))) 917 920 __(cmpri(cr1,arg_y,nil_value)) 918 921 __(li arg_x,nrs.kallowotherkeys) … … 1337 1340 /* Argument in arg_z, result in imm0. May use temp0. */ 1338 1341 _spentry(getxlong) 1342 ifdef([PPC64],[ 1343 ],[ 1339 1344 __(extract_lisptag(imm0,arg_z)) 1340 1345 __(cmpri(cr0,imm0,tag_fixnum)) … … 1368 1373 local_label(error): 1369 1374 __(uuo_interr(error_object_not_integer,arg_z)) /* not quite right but what 68K MCL said */ 1370 1375 1376 ]) 1377 1371 1378 /* Everything up to the last arg has been vpushed, nargs is set to 1372 1379 the (boxed) count of things already pushed. … … 1375 1382 ppc2-invoke-fn assumes that temp1 is preserved here. */ 1376 1383 _spentry(spreadargz) 1384 ifdef([PPC64],[ 1385 ],[ 1377 1386 __(extract_lisptag(imm1,arg_z)) 1378 1387 __(cmpri(cr1,imm1,tag_list)) … … 1408 1417 __(set_nargs(2)) 1409 1418 __(b _SPksignalerr) 1410 1419 ]) 1411 1420 1412 1421 /* Tail-recursively funcall temp0. */ … … 1424 1433 __(add imm1,imm1,vsp) 1425 1434 1: 1426 __(l wzu temp2,-4(imm1))1435 __(ldru(temp2,-node_size(imm1))) 1427 1436 __(cmpr(cr0,imm1,vsp)) 1428 1437 __(push(temp2,imm0)) … … 1448 1457 __(mtlr loc_pc) 1449 1458 1: 1450 __(l wzu temp2,-4(imm1))1459 __(ldru(temp2,-node_size(imm1))) 1451 1460 __(cmpr(cr0,imm1,vsp)) 1452 1461 __(push(temp2,imm0)) … … 1482 1491 __(add imm1,imm1,vsp) 1483 1492 1: 1484 __(l wzu temp2,-4(imm1))1493 __(ldru(temp2,-node_size(imm1))) 1485 1494 __(cmpr(cr0,imm1,vsp)) 1486 1495 __(push(temp2,imm0)) … … 1507 1516 __(add imm1,imm1,vsp) 1508 1517 1: 1509 __(l wzu temp2,-4(imm1))1518 __(ldru(temp2,-node_size(imm1))) 1510 1519 __(cmpr(cr0,imm1,vsp)) 1511 1520 __(push(temp2,imm0)) … … 1542 1551 __(add imm1,imm1,vsp) 1543 1552 1: 1544 __(l wzu fname,-4(imm1))1553 __(ldru(fname,-node_size(imm1))) 1545 1554 __(cmpr(cr0,imm1,vsp)) 1546 1555 __(push(fname,imm0)) … … 1558 1567 1559 1568 _spentry(misc_ref) 1569 ifdef([PPC64],[ 1570 ],[ 1560 1571 __(trap_unless_fulltag_equal(arg_y,fulltag_misc,imm0)) 1561 1572 __(trap_unless_lisptag_equal(arg_z,tag_fixnum,imm0)) … … 1568 1579 lisp object in arg_z. Do type and bounds-checking. 1569 1580 */ 1570 1581 ]) 1571 1582 misc_ref_common: 1583 ifdef([PPC64],[ 1584 ],[ 1572 1585 __(extract_fulltag(imm2,imm1)) 1573 1586 __(cmpri(cr0,imm2,fulltag_nodeheader)) … … 1667 1680 __(str(imm1,double_float.value+4(arg_z))) 1668 1681 __(blr) 1682 ]) 1669 1683 1670 1684 … … 1687 1701 __(vpush(imm0)) 1688 1702 __(vpush(imm0)) 1689 __(andi. imm0,vsp,1<< 2) /* (oddp vsp ?) */1703 __(andi. imm0,vsp,1<<word_shift) /* (oddp vsp ?) */ 1690 1704 __(beq cr0,1f) 1691 __(str(arg_y, 8(vsp))) /* car */1692 __(str(arg_z, 4(vsp))) /* cdr */1693 __(la arg_z,fulltag_cons+ 4(vsp))1694 __(blr) 1695 1: 1696 __(str(arg_y, 4(vsp))) /* car, again */1705 __(str(arg_y,node_size*2(vsp))) /* car */ 1706 __(str(arg_z,node_size(vsp))) /* cdr */ 1707 __(la arg_z,fulltag_cons+node_size(vsp)) 1708 __(blr) 1709 1: 1710 __(str(arg_y,node_size(vsp))) /* car, again */ 1697 1711 __(str(arg_z,0(vsp))) 1698 1712 __(la arg_z,fulltag_cons(vsp)) … … 1815 1829 __(li arg_z,nil_value) 1816 1830 __(ldr(imm2,tsp_frame.backlink(tsp))) 1817 __(la imm2,- 8+tag_list(imm2))1831 __(la imm2,-tsp_frame.fixed_overhead+fulltag_cons(imm2)) 1818 1832 __(b 2f) 1819 1833 1: … … 1847 1861 1848 1862 _spentry(stkgvector) 1849 __(la imm0,- 4(nargs))1863 __(la imm0,-fixnum_one(nargs)) 1850 1864 __(cmpri(cr1,imm0,0)) 1851 1865 __(add imm1,vsp,nargs) 1852 __(l wzu temp0,-4(imm1))1866 __(ldru(temp0,-node_size(imm1))) 1853 1867 __(slwi imm2,imm0,num_subtag_bits-fixnumshift) 1854 1868 __(rlwimi imm2,temp0,32-fixnumshift,32-num_subtag_bits,31) … … 1863 1877 __(addi imm0,imm0,fixnum1) 1864 1878 __(cmpr(cr1,imm0,nargs)) 1865 __(l wzu temp0,-4(imm1))1866 __(st wu temp0,4(imm3))1879 __(ldru(temp0,-node_size(imm1))) 1880 __(stru(temp0,node_size(imm3))) 1867 1881 2: 1868 1882 __(bne cr1,1b) … … 1887 1901 1888 1902 _spentry(misc_alloc) 1903 ifdef([PPC64],[ 1904 ],[ 1889 1905 __(extract_unsigned_byte_bits_(imm2,arg_y,24)) 1890 1906 __(unbox_fixnum(imm0,arg_z)) … … 1919 1935 9: 1920 1936 __(uuo_interr(error_object_not_unsigned_byte_24,arg_y)) 1937 ]) 1921 1938 1922 1939 /* almost exactly as above, but "swap exception handling info" … … 1996 2013 __(b 1f) 1997 2014 0: __(mr imm1,imm2) 1998 __(ldr(temp0, 4(imm1)))2015 __(ldr(temp0,binding.sym(imm1))) 1999 2016 __(cmpr(temp0,arg_y)) 2000 __(ldr(imm2, 0(imm1)))2017 __(ldr(imm2,binding.link(imm1))) 2001 2018 __(cmpri(cr1,imm2,0)) 2002 2019 __(bne 1f) 2003 __(ldr(arg_z, 8(imm1)))2020 __(ldr(arg_z,binding.val(imm1))) 2004 2021 __(b 9f) 2005 2022 1: __(bne cr1,0b) … … 2032 2049 2033 2050 _spentry(macro_bind) 2051 ifdef([PPC64],[ 2052 ],[ 2034 2053 __(mr whole_reg,arg_reg) 2035 2054 __(extract_lisptag(imm0,arg_reg)) … … 2043 2062 __(set_nargs(2)) 2044 2063 __(b _SPksignalerr) 2045 2064 ]) 2046 2065 2047 2066 _spentry(destructuring_bind) … … 2051 2070 _spentry(destructuring_bind_inner) 2052 2071 __(mr whole_reg,arg_z) 2053 destbind1: 2072 destbind1: 2073 ifdef([PPC64],[ 2074 ],[ 2054 2075 /* Extract required arg count. */ 2055 2076 /* A bug in gas: can't handle shift count of "32" (= 0 */ … … 2227 2248 __(li temp0,t_value) 2228 2249 __(bne cr0,match_keys_loop) /* already saw this */ 2229 __(str(arg_y, 4(imm0)))2230 __(str(temp0, 0(imm0)))2250 __(str(arg_y,node_size*1(imm0))) 2251 __(str(temp0,node_size*2(imm0))) 2231 2252 __(b match_keys_loop) 2232 2253 match_test: … … 2259 2280 __(set_nargs(2)) 2260 2281 __(b _SPksignalerr) 2261 2282 ]) 2262 2283 /* vpush the values in the value set atop the vsp, incrementing nargs. */ 2263 2284 /* Discard the tsp frame; leave values atop the vsp. */ … … 2271 2292 __(mr imm2,tsp) /* last segment */ 2272 2293 local_label(walkloop): 2273 __(ldr(imm3, 12(imm1))) /* next segment */2294 __(ldr(imm3,tsp_frame.fixed_overhead+node_size(imm1))) /* next segment */ 2274 2295 __(cmpr(cr0,imm0,imm3)) /* last segment? */ 2275 __(str(imm2, 12(imm1))) /* reverse pointer */2296 __(str(imm2,tsp_frame.fixed_overhead+node_size(imm1))) /* reverse pointer */ 2276 2297 __(mr imm2,imm1) /* last segment <- current segment */ 2277 2298 __(mr imm1,imm3) /* current segment <- next segment */ … … 2281 2302 /* walk backwards, pushing values on VSP and incrementing NARGS */ 2282 2303 local_label(pushloop): 2283 __(ldr(imm0, 8(imm2))) /* nargs in segment */2304 __(ldr(imm0,tsp_frame.data_offset(imm2))) /* nargs in segment */ 2284 2305 __(cmpri(cr0,imm0,0)) 2285 2306 __(cmpr(cr1,imm2,tsp)) 2286 __(la imm3, 16(imm2))2307 __(la imm3,tsp_frame.data_offset+(2*node_size)(imm2)) 2287 2308 __(add imm3,imm3,imm0) 2288 2309 __(add nargs,nargs,imm0) 2289 2310 __(b 2f) 2290 2311 1: 2291 __(l wzu arg_z,-4(imm3))2312 __(ldru(arg_z,-node_size(imm3))) 2292 2313 __(cmpri(cr0,imm0,fixnum_one)) 2293 2314 __(subi imm0,imm0,fixnum_one) … … 2295 2316 2: 2296 2317 __(bne cr0,1b) 2297 __(ldr(imm2, 12(imm2))) /* previous segment */2318 __(ldr(imm2,tsp_frame.data_offset+node_size(imm2))) /* previous segment */ 2298 2319 __(bne cr1,local_label(pushloop)) 2299 2320 __(unlink(tsp)) … … 2309 2330 __(beq cr1,local_label(yz)) 2310 2331 __(blt cr1,local_label(z)) 2311 __(ldr(arg_z, 0(vsp)))2312 __(ldr(arg_y, 4(vsp)))2313 __(ldr(arg_x, 8(vsp)))2314 __(la vsp, 12(vsp))2332 __(ldr(arg_z,node_size*0(vsp))) 2333 __(ldr(arg_y,node_size*1(vsp))) 2334 __(ldr(arg_x,node_size*2(vsp))) 2335 __(la vsp,node_size*3(vsp)) 2315 2336 __(blr) 2316 2337 local_label(yz): 2317 __(ldr(arg_z, 0(vsp)))2318 __(ldr(arg_y, 4(vsp)))2319 __(la vsp, 8(vsp))2338 __(ldr(arg_z,node_size*0(vsp))) 2339 __(ldr(arg_y,node_size*1(vsp))) 2340 __(la vsp,node_size*2(vsp)) 2320 2341 __(blr) 2321 2342 local_label(z): 2322 __(ldr(arg_z, 0(vsp)))2323 __(la vsp, 4(vsp))2343 __(ldr(arg_z,node_size*0(vsp))) 2344 __(la vsp,node_size*1(vsp)) 2324 2345 __(blr) 2325 2346 … … 2347 2368 /* like misc_set, only pass the (boxed) subtag in temp0 */ 2348 2369 _spentry(subtag_misc_set) 2370 ifdef([PPC64],[ 2371 ],[ 2349 2372 __(trap_unless_fulltag_equal(arg_x,fulltag_misc,imm0)) 2350 2373 __(trap_unless_lisptag_equal(arg_y,tag_fixnum,imm0)) … … 2352 2375 __(trlge(arg_y,imm0)) 2353 2376 __(unbox_fixnum(imm1,temp0)) 2377 ]) 2354 2378 misc_set_common: 2379 ifdef([PPC64],[ 2380 ],[ 2355 2381 __(extract_fulltag(imm2,imm1)) 2356 2382 __(cmpri(cr0,imm2,fulltag_nodeheader)) … … 2514 2540 __(strx(imm2,arg_x,imm0)) 2515 2541 __(blr) 2516 2542 ]) 2517 2543 2518 2544 /* "spread" the lexpr in arg_z. … … 2527 2553 __(cmpri(cr1,nargs,0)) 2528 2554 __(cmpri(cr2,nargs,2<<fixnumshift)) 2529 __(la imm1, 4(imm1))2555 __(la imm1,node_size(imm1)) 2530 2556 __(bge cr3,9f) 2531 2557 __(beq cr4,2f) … … 2547 2573 __(cmpri(cr3,imm0,4<<fixnumshift)) 2548 2574 __(subi imm0,imm0,fixnumone) 2549 __(l wzu arg_z,-4(imm1))2575 __(ldru(arg_z,-node_size(imm1))) 2550 2576 __(vpush(arg_z)) 2551 2577 9: 2552 2578 __(bne cr3,8b) 2553 __(ldr(arg_x,- 4(imm1)))2554 __(ldr(arg_y,- 8(imm1)))2555 __(ldr(arg_z,- 12(imm1)))2579 __(ldr(arg_x,-node_size*1(imm1))) 2580 __(ldr(arg_y,-node_size*2(imm1))) 2581 __(ldr(arg_z,-node_size*3(imm1))) 2556 2582 __(blr) 2557 2583 … … 2559 2585 /* lexpr, maybe vpop arg_x */ 2560 2586 2: 2561 __(ldr(arg_y,- 4(imm1)))2562 __(ldr(arg_z,- 8(imm1)))2587 __(ldr(arg_y,-node_size*1(imm1))) 2588 __(ldr(arg_z,-node_size*2(imm1))) 2563 2589 __(beqlr cr2) /* return if (new) nargs = 2 */ 2564 2590 __(vpop(arg_x)) … … 2568 2594 /* maybe vpop arg_y, arg_x */ 2569 2595 1: 2570 __(ldr(arg_z,- 4(imm1)))2596 __(ldr(arg_z,-node_size(imm1))) 2571 2597 __(bltlr cr2) /* return if (new) nargs < 2 */ 2572 2598 __(vpop(arg_y)) … … 2603 2629 __(cmpri(cr0,imm3,1<<fixnumshift)) 2604 2630 __(subi imm3,imm3,1<<fixnumshift) 2605 __(l wzu temp0,-4(imm0))2606 __(st wu temp0,-4(imm2))2631 __(ldru(temp0,-node_size(imm0))) 2632 __(stru(temp0,-node_size(imm2))) 2607 2633 __(bne cr0,1b) 2608 2634 2: … … 2636 2662 __(str(imm1,tsp_frame.backlink(tsp))) /* keep one tsp "frame" as far as rest of lisp is concerned */ 2637 2663 __(str(nargs,tsp_frame.data_offset(tsp))) 2638 __(str(imm2,tsp_frame.data_offset+ 4(tsp))) /* previous tsp */2639 __(la imm3,tsp_frame.data_offset+ 8(tsp))2664 __(str(imm2,tsp_frame.data_offset+node_size(tsp))) /* previous tsp */ 2665 __(la imm3,tsp_frame.data_offset+node_size*2(tsp)) 2640 2666 __(add imm3,imm3,nargs) 2641 2667 __(add imm0,vsp,nargs) … … 2643 2669 __(b 2f) 2644 2670 1: 2645 __(l wzu arg_z,-4(imm0))2671 __(ldru(arg_z,-node_size(imm0))) 2646 2672 __(cmpr(cr0,imm0,vsp)) 2647 __(st wu arg_z,-4(imm3))2673 __(stru(arg_z,-node_size(imm3))) 2648 2674 2: 2649 2675 __(bne cr0,1b) … … 2861 2887 /* Next, determine the length of arg_y. We */ 2862 2888 /* know that it's a proper list. */ 2863 __(li imm0,- 4)2889 __(li imm0,-node_size) 2864 2890 __(mr temp0,arg_y) 2865 2891 1: 2866 2892 __(cmpri(cr0,temp0,nil_value)) 2867 __(la imm0, 4(imm0))2893 __(la imm0,node_size(imm0)) 2868 2894 __(_cdr(temp0,temp0)) 2869 2895 __(bne 1b) … … 3279 3305 3280 3306 _spentry(builtin_eql) 3307 ifdef([PPC64],[ 3308 ],[ 3281 3309 __(cmpr(cr0,arg_y,arg_z)) 3282 3310 __(extract_lisptag(imm0,arg_y)) … … 3292 3320 2: __(li arg_z,nil_value) 3293 3321 __(blr) 3322 ]) 3294 3323 3295 3324 _spentry(builtin_length) 3325 ifdef([PPC64],[ 3326 ],[ 3296 3327 __(extract_typecode(imm0,arg_z)) 3297 3328 __(cmpri(cr0,imm0,min_vector_subtag)) … … 3329 3360 __(mr arg_z,temp2) 3330 3361 __(blr) 3362 ]) 3331 3363 3332 3364 _spentry(builtin_seqtype) 3365 ifdef([PPC64],[ 3366 ],[ 3333 3367 __(extract_typecode(imm0,arg_z)) 3334 3368 __(cmpri(cr0,imm0,tag_list)) … … 3342 3376 2: 3343 3377 __(jump_builtin(_builtin_seqtype,1)) 3378 ]) 3344 3379 3345 3380 _spentry(builtin_assq) … … 4319 4354 /* Next, determine the length of arg_y. We */ 4320 4355 /* know that it's a proper list. */ 4321 __(li imm0,- 4)4356 __(li imm0,-node_size) 4322 4357 __(mr temp4,arg_y) 4323 4358 1: 4324 4359 __(cmpri(cr0,temp4,nil_value)) 4325 __(la imm0, 4(imm0))4360 __(la imm0,node_size(imm0)) 4326 4361 __(_cdr(temp4,temp4)) 4327 4362 __(bne 1b)
Note:
See TracChangeset
for help on using the changeset viewer.
