Index: /trunk/ccl/lisp-kernel/area.h =================================================================== --- /trunk/ccl/lisp-kernel/area.h (revision 556) +++ /trunk/ccl/lisp-kernel/area.h (revision 557) @@ -39,27 +39,27 @@ typedef struct area { - struct area *pred; /* linked list predecessor */ - struct area *succ; /* linked list successor */ - BytePtr low; /* arithmetic lower limit on addresses (inclusive) */ - BytePtr high; /* arithmetic upper limit on addresses (exclusive) */ - BytePtr active; /* low bound (stack) or high bound (heap) */ - BytePtr softlimit; /* only makes sense for dynamic heaps & stacks */ - BytePtr hardlimit; /* only makes sense for dynamic heaps & stacks */ - area_code code; - bitvector markbits; /* markbits for active area */ - unsigned ndwords; /* "active" size of dynamic area or stack */ - struct area *older; /* if ephemeral, the next older ephemeral area + NATURAL_POINTER_FIELD(struct area,pred); /* linked list predecessor */ + NATURAL_POINTER_FIELD(struct area,succ); /* linked list successor */ + NATURAL_POINTER_FIELD(char,low); /* arithmetic lower limit on addresses (inclusive) */ + NATURAL_POINTER_FIELD(char,high); /* arithmetic upper limit on addresses (exclusive) */ + NATURAL_POINTER_FIELD(char,active); /* low bound (stack) or high bound (heap) */ + NATURAL_POINTER_FIELD(char,softlimit); /* only makes sense for dynamic heaps & stacks */ + NATURAL_POINTER_FIELD(char,hardlimit); /* only makes sense for dynamic heaps & stacks */ + natural code; + NATURAL_POINTER_FIELD(natural, markbits); /* markbits for active area */ + natural ndnodes; /* "active" size of dynamic area or stack */ + NATURAL_POINTER_FIELD(struct area,older); /* if ephemeral, the next older ephemeral area or the dynamic area */ - struct area *younger; /* if ephemeral, the next "younger" ephemeral area - if there is one. If dynamic, the oldest ephemeral + NATURAL_POINTER_FIELD(struct area,younger); /* if ephemeral, the next "younger" ephemeral area + if there is one. If dynamic, the oldest ephemeral area. */ - Ptr h; /* The pointer allocated to contain this area, or NULL + NATURAL_POINTER_FIELD(char, h); /* The pointer allocated to contain this area, or NULL if the operating system allocated it for us. */ - protected_area_ptr softprot; /* "soft" protected_area */ - protected_area_ptr hardprot; /* "hard" protected_area */ - unsigned owner; /* position in external_containers linked list */ - bitvector refbits; /* intergenerational references. - May or may not be the same as markbits */ - unsigned threshold; /* egc threshold (boxed "fullword count") or 0 */ + NATURAL_POINTER_FIELD(protected_area,softprot); /* "soft" protected_area */ + NATURAL_POINTER_FIELD(protected_area,hardprot); /* "hard" protected_area */ + natural owner; /* position in external_containers linked list */ + NATURAL_POINTER_FIELD(natural, refbits); /* intergenerational references. + May or may not be the same as markbits */ + natural threshold; /* egc threshold (boxed "fullword count") or 0 */ LispObj gccount; /* boxed generation GC count. */ } area; Index: /trunk/ccl/lisp-kernel/bits.c =================================================================== --- /trunk/ccl/lisp-kernel/bits.c (revision 556) +++ /trunk/ccl/lisp-kernel/bits.c (revision 557) @@ -16,6 +16,6 @@ +#include "lisp.h" #include "bits.h" -#include "lisp.h" Index: /trunk/ccl/lisp-kernel/bits.h =================================================================== --- /trunk/ccl/lisp-kernel/bits.h (revision 556) +++ /trunk/ccl/lisp-kernel/bits.h (revision 557) @@ -25,5 +25,5 @@ #include -typedef unsigned *bitvector; +typedef natural *bitvector; Index: /trunk/ccl/lisp-kernel/constants.h =================================================================== --- /trunk/ccl/lisp-kernel/constants.h (revision 556) +++ /trunk/ccl/lisp-kernel/constants.h (revision 557) @@ -17,52 +17,4 @@ #ifndef __constants__ #define __constants__ 1 - - -#define nbits_in_word 32 -#define nbits_in_byte 8 -#define ntagbits 3 /* But only 2 are significant to lisp */ -#define nlisptagbits 2 -#define nfixnumtagbits 2 -#define num_subtag_bits 8 -#define fixnumshift 2 -#define fixnum_shift 2 -#define fulltagmask 7 -#define tagmask 3 -#define fixnummask 3 -#define subtagmask ((1< 4 (so that code-vector entry-points can be branched to, since the low */ -/* two bits of the PC are ignored) and that both FULLTAG-MISC and FULLTAG-IMM have header fulltags */ -/* that share the same TAG. */ -/* Things that walk memory (and the stack) have to be careful to look at the FULLTAG of each */ -/* object that they see. */ - -#define fulltag_even_fixnum 0 /* I suppose EVENP/ODDP might care; nothing else does. */ -#define fulltag_cons 1 /* a real (non_null) cons. Shares TAG with fulltag_nil. */ -#define fulltag_nodeheader 2 /* Header of heap_allocated object that contains lisp_object pointers */ -#define fulltag_imm 3 /* a "real" immediate object. Shares TAG with fulltag_immheader. */ -#define fulltag_odd_fixnum 4 /* */ -#define fulltag_nil 5 /* NIL and nothing but. (Note that there's still a hidden NILSYM.) */ -#define fulltag_misc 6 /* Pointer "real" tag_misc object. Shares TAG with fulltag_nodeheader. */ -#define fulltag_immheader 7 /* Header of heap-allocated object that contains unboxed data. */ /* Register usage: */ @@ -106,344 +58,4 @@ #define closure_data temp0 - -/* Order of CAR and CDR doesn't seem to matter much - there aren't */ -/* too many tricks to be played with predecrement/preincrement addressing. */ -/* Keep them in the confusing MCL 3.0 order, to avoid confusion. */ - -typedef struct cons { - LispObj cdr; - LispObj car; -} cons; - - -#define misc_header_offset -fulltag_misc -#define misc_subtag_offset misc_header_offset+3 /* low byte of header */ -#define misc_data_offset misc_header_offset+4 /* first word of data */ -#define misc_dfloat_offset misc_header_offset+8 /* double-floats are doubleword-aligned */ - -#define max_64_bit_constant_index ((0x7fff + misc_dfloat_offset)>>3) -#define max_32_bit_constant_index ((0x7fff + misc_data_offset)>>2) -#define max_16_bit_constant_index ((0x7fff + misc_data_offset)>>1) -#define max_8_bit_constant_index (0x7fff + misc_data_offset) -#define max_1_bit_constant_index ((0x7fff + misc_data_offset)<<5) - -/* T is almost adjacent to NIL: since NIL is a misaligned CONS, it spans */ -/* two doublewords. The arithmetic difference between T and NIL is */ -/* such that the least-significant bit and exactly one other bit is */ -/* set in the result. */ - -#define t_offset (8+(8-fulltag_nil)+fulltag_misc) - -/* The order in which various header values are defined is significant in several ways: */ -/* 1) Numeric subtags precede non-numeric ones; there are further orderings among numeric subtags. */ -/* 2) All subtags which denote CL arrays are preceded by those that don't, */ -/* with a further ordering which requires that (< header-arrayH header-vectorH ,@all-other-CL-vector-types) */ -/* 3) The element-size of ivectors is determined by the ordering of ivector subtags. */ -/* 4) All subtags are >= fulltag-immheader . */ - -#define SUBTAG(tag,subtag) ((tag) | ((subtag) << ntagbits)) -#define IMM_SUBTAG(subtag) SUBTAG(fulltag_immheader,(subtag)) -#define NODE_SUBTAG(subtag) SUBTAG(fulltag_nodeheader,(subtag)) - - -/* Numeric subtags. */ - -#define subtag_bignum IMM_SUBTAG(0) -#define min_numeric_subtag subtag_bignum - -#define subtag_ratio NODE_SUBTAG(1) -#define max_rational_subtag subtag_ratio - -#define subtag_single_float IMM_SUBTAG(1) -#define subtag_double_float IMM_SUBTAG(2) -#define min_float_subtag subtag_single_float -#define max_float_subtag subtag_double_float -#define max_real_subtag subtag_double_float - -#define subtag_complex NODE_SUBTAG(3) -#define max_numeric_subtag subtag_complex - - -/* CL array types. There are more immediate types than node types; all CL array subtags must be > than */ -/* all non-CL-array subtags. So we start by defining the immediate subtags in decreasing order, starting */ -/* with that subtag whose element size isn't an integral number of bits and ending with those whose */ -/* element size - like all non-CL-array fulltag-immheader types - is 32 bits. */ - -#define subtag_bit_vector IMM_SUBTAG(31) -#define subtag_double_float_vector IMM_SUBTAG(30) -#define subtag_s16_vector IMM_SUBTAG(29) -#define subtag_u16_vector IMM_SUBTAG(28) -#define subtag_simple_general_string IMM_SUBTAG(27) -#define min_16_bit_ivector_subtag subtag_simple_general_string -#define max_16_bit_ivector_subtag subtag_s16_vector -#define max_string_subtag subtag_simple_general_string - -#define subtag_simple_base_string IMM_SUBTAG(26) -#define subtag_s8_vector IMM_SUBTAG(25) -#define subtag_u8_vector IMM_SUBTAG(24) -#define min_8_bit_ivector_subtag subtag_u8_vector -#define max_8_bit_ivector_subtag subtag_simple_base_string -#define min_string_subtag subtag_simple_base_string - -#define subtag_s32_vector IMM_SUBTAG(23) -#define subtag_u32_vector IMM_SUBTAG(22) -#define subtag_single_float_vector IMM_SUBTAG(21) -#define max_32_bit_ivector_subtag subtag_s32_vector -#define min_cl_ivector_subtag subtag_single_float_vector - - -#define subtag_vectorH NODE_SUBTAG(21) -#define subtag_arrayH NODE_SUBTAG(20) -#define subtag_simple_vector NODE_SUBTAG(22) /* Only one such subtag) */ -#define min_vector_subtag subtag_vectorH -#define min_array_subtag subtag_arrayH - -/* So, we get the remaining subtags (n: (n > max-numeric-subtag) & (n < min-array-subtag)) */ -/* for various immediate/node object types. */ - -#define subtag_macptr IMM_SUBTAG(3) -#define min_non_numeric_imm_subtag subtag_macptr - -#define subtag_dead_macptr IMM_SUBTAG(4) -#define subtag_code_vector IMM_SUBTAG(5) -#define subtag_creole IMM_SUBTAG(6) - -#define max_non_array_imm_subtag ((19<> 2) - 3) - -typedef struct doh_block { - struct doh_block *link; - unsigned size; - unsigned free; - LispObj data[doh_block_slots]; -} doh_block, *doh_block_ptr; - - -#define population_weak_list (0< call lisp_exit_hook */ - void *native_thread_info; /* platform-dependent */ - void *native_thread_id; /* mach_thread_t, pid_t, etc. */ - void *last_allocptr; - void *save_allocptr; - void *save_allocbase; - void *reset_completion; - void *activate; - int suspend_count; - ExceptionInformation *suspend_context; - ExceptionInformation *pending_exception_context; - void *suspend; /* suspension semaphore */ - void *resume; /* resumption semaphore */ - int flags; - ExceptionInformation *gc_context; - int suspend_total; - int suspend_total_on_exception_entry; - unsigned tlb_limit; - LispObj *tlb_pointer; - unsigned shutdown_count; -} TCR; +#define BA_MASK ((unsigned) ((-1<<26) | (1<<1))) +#define BA_VAL ((unsigned) ((18<<26) | (1<<1))) #define TCR_FLAG_BIT_FOREIGN fixnumshift @@ -511,5 +79,12 @@ #define TCR_STATE_EXCEPTION_RETURN (4) -#define memo_size (1 << 15) +#ifdef PPC64 +#include "constants64.h" +#else +#include "constants32.h" #endif +#define dnode_size (node_size*2) +#define dnode_shift node_shift+1 + +#endif Index: /trunk/ccl/lisp-kernel/constants32.h =================================================================== --- /trunk/ccl/lisp-kernel/constants32.h (revision 557) +++ /trunk/ccl/lisp-kernel/constants32.h (revision 557) @@ -0,0 +1,461 @@ +/* + Copyright (C) 1994-2001 Digitool, Inc + This file is part of OpenMCL. + + OpenMCL is licensed under the terms of the Lisp Lesser GNU Public + License , known as the LLGPL and distributed with OpenMCL as the + file "LICENSE". The LLGPL consists of a preamble and the LGPL, + which is distributed with OpenMCL as the file "LGPL". Where these + conflict, the preamble takes precedence. + + OpenMCL is referenced in the preamble as the "LIBRARY." + + The LLGPL is also available online at + http://opensource.franz.com/preamble.html +*/ + +#ifndef __constants32__ +#define __constants32__ 1 + + +#define nbits_in_word 32 +#define nbits_in_byte 8 +#define ntagbits 3 /* But only 2 are significant to lisp */ +#define nlisptagbits 2 +#define nfixnumtagbits 2 +#define num_subtag_bits 8 +#define fixnumshift 2 +#define fixnum_shift 2 +#define fulltagmask 7 +#define tagmask 3 +#define fixnummask 3 +#define subtagmask ((1< 4 (so that code-vector entry-points can be branched to, since the low */ +/* two bits of the PC are ignored) and that both FULLTAG-MISC and FULLTAG-IMM have header fulltags */ +/* that share the same TAG. */ +/* Things that walk memory (and the stack) have to be careful to look at the FULLTAG of each */ +/* object that they see. */ + +#define fulltag_even_fixnum 0 /* I suppose EVENP/ODDP might care; nothing else does. */ +#define fulltag_cons 1 /* a real (non_null) cons. Shares TAG with fulltag_nil. */ +#define fulltag_nodeheader 2 /* Header of heap_allocated object that contains lisp_object pointers */ +#define fulltag_imm 3 /* a "real" immediate object. Shares TAG with fulltag_immheader. */ +#define fulltag_odd_fixnum 4 /* */ +#define fulltag_nil 5 /* NIL and nothing but. (Note that there's still a hidden NILSYM.) */ +#define fulltag_misc 6 /* Pointer "real" tag_misc object. Shares TAG with fulltag_nodeheader. */ +#define fulltag_immheader 7 /* Header of heap-allocated object that contains unboxed data. */ + + + +/* Order of CAR and CDR doesn't seem to matter much - there aren't */ +/* too many tricks to be played with predecrement/preincrement addressing. */ +/* Keep them in the confusing MCL 3.0 order, to avoid confusion. */ + +typedef struct cons { + LispObj cdr; + LispObj car; +} cons; + + +#define misc_header_offset -fulltag_misc +#define misc_subtag_offset misc_header_offset+3 /* low byte of header */ +#define misc_data_offset misc_header_offset+4 /* first word of data */ +#define misc_dfloat_offset misc_header_offset+8 /* double-floats are doubleword-aligned */ + +#define max_64_bit_constant_index ((0x7fff + misc_dfloat_offset)>>3) +#define max_32_bit_constant_index ((0x7fff + misc_data_offset)>>2) +#define max_16_bit_constant_index ((0x7fff + misc_data_offset)>>1) +#define max_8_bit_constant_index (0x7fff + misc_data_offset) +#define max_1_bit_constant_index ((0x7fff + misc_data_offset)<<5) + +/* T is almost adjacent to NIL: since NIL is a misaligned CONS, it spans */ +/* two doublewords. The arithmetic difference between T and NIL is */ +/* such that the least-significant bit and exactly one other bit is */ +/* set in the result. */ + +#define t_offset (8+(8-fulltag_nil)+fulltag_misc) + +/* The order in which various header values are defined is significant in several ways: */ +/* 1) Numeric subtags precede non-numeric ones; there are further orderings among numeric subtags. */ +/* 2) All subtags which denote CL arrays are preceded by those that don't, */ +/* with a further ordering which requires that (< header-arrayH header-vectorH ,@all-other-CL-vector-types) */ +/* 3) The element-size of ivectors is determined by the ordering of ivector subtags. */ +/* 4) All subtags are >= fulltag-immheader . */ + +#define SUBTAG(tag,subtag) ((tag) | ((subtag) << ntagbits)) +#define IMM_SUBTAG(subtag) SUBTAG(fulltag_immheader,(subtag)) +#define NODE_SUBTAG(subtag) SUBTAG(fulltag_nodeheader,(subtag)) + + +/* Numeric subtags. */ + +#define subtag_bignum IMM_SUBTAG(0) +#define min_numeric_subtag subtag_bignum + +#define subtag_ratio NODE_SUBTAG(1) +#define max_rational_subtag subtag_ratio + +#define subtag_single_float IMM_SUBTAG(1) +#define subtag_double_float IMM_SUBTAG(2) +#define min_float_subtag subtag_single_float +#define max_float_subtag subtag_double_float +#define max_real_subtag subtag_double_float + +#define subtag_complex NODE_SUBTAG(3) +#define max_numeric_subtag subtag_complex + + +/* CL array types. There are more immediate types than node types; all CL array subtags must be > than */ +/* all non-CL-array subtags. So we start by defining the immediate subtags in decreasing order, starting */ +/* with that subtag whose element size isn't an integral number of bits and ending with those whose */ +/* element size - like all non-CL-array fulltag-immheader types - is 32 bits. */ + +#define subtag_bit_vector IMM_SUBTAG(31) +#define subtag_double_float_vector IMM_SUBTAG(30) +#define subtag_s16_vector IMM_SUBTAG(29) +#define subtag_u16_vector IMM_SUBTAG(28) +#define subtag_simple_general_string IMM_SUBTAG(27) +#define min_16_bit_ivector_subtag subtag_simple_general_string +#define max_16_bit_ivector_subtag subtag_s16_vector +#define max_string_subtag subtag_simple_general_string + +#define subtag_simple_base_string IMM_SUBTAG(26) +#define subtag_s8_vector IMM_SUBTAG(25) +#define subtag_u8_vector IMM_SUBTAG(24) +#define min_8_bit_ivector_subtag subtag_u8_vector +#define max_8_bit_ivector_subtag subtag_simple_base_string +#define min_string_subtag subtag_simple_base_string + +#define subtag_s32_vector IMM_SUBTAG(23) +#define subtag_u32_vector IMM_SUBTAG(22) +#define subtag_single_float_vector IMM_SUBTAG(21) +#define max_32_bit_ivector_subtag subtag_s32_vector +#define min_cl_ivector_subtag subtag_single_float_vector + + +#define subtag_vectorH NODE_SUBTAG(21) +#define subtag_arrayH NODE_SUBTAG(20) +#define subtag_simple_vector NODE_SUBTAG(22) /* Only one such subtag) */ +#define min_vector_subtag subtag_vectorH +#define min_array_subtag subtag_arrayH + +/* So, we get the remaining subtags (n: (n > max-numeric-subtag) & (n < min-array-subtag)) */ +/* for various immediate/node object types. */ + +#define subtag_macptr IMM_SUBTAG(3) +#define min_non_numeric_imm_subtag subtag_macptr + +#define subtag_dead_macptr IMM_SUBTAG(4) +#define subtag_code_vector IMM_SUBTAG(5) +#define subtag_creole IMM_SUBTAG(6) + +#define max_non_array_imm_subtag ((19<> 2) - 3) + +typedef struct doh_block { + struct doh_block *link; + unsigned size; + unsigned free; + LispObj data[doh_block_slots]; +} doh_block, *doh_block_ptr; + + +#define population_weak_list (0< call lisp_exit_hook */ + void *native_thread_info; /* platform-dependent */ + void *native_thread_id; /* mach_thread_t, pid_t, etc. */ + void *last_allocptr; + void *save_allocptr; + void *save_allocbase; + void *reset_completion; + void *activate; + int suspend_count; + ExceptionInformation *suspend_context; + ExceptionInformation *pending_exception_context; + void *suspend; /* suspension semaphore */ + void *resume; /* resumption semaphore */ + int flags; + ExceptionInformation *gc_context; + int suspend_total; + int suspend_total_on_exception_entry; + unsigned tlb_limit; + LispObj *tlb_pointer; + unsigned shutdown_count; +} TCR; + + + +#endif + Index: /trunk/ccl/lisp-kernel/constants64.h =================================================================== --- /trunk/ccl/lisp-kernel/constants64.h (revision 557) +++ /trunk/ccl/lisp-kernel/constants64.h (revision 557) @@ -0,0 +1,437 @@ +/* + Copyright (C) 1994-2001 Digitool, Inc + This file is part of OpenMCL. + + OpenMCL is licensed under the terms of the Lisp Lesser GNU Public + License , known as the LLGPL and distributed with OpenMCL as the + file "LICENSE". The LLGPL consists of a preamble and the LGPL, + which is distributed with OpenMCL as the file "LGPL". Where these + conflict, the preamble takes precedence. + + OpenMCL is referenced in the preamble as the "LIBRARY." + + The LLGPL is also available online at + http://opensource.franz.com/preamble.html +*/ + +#ifndef __constants64__ +#define __constants64__ 1 + + +#define nbits_in_word 64 +#define nbits_in_byte 8 +#define ntagbits 4 +#define nlisptagbits 3 +#define nfixnumtagbits 2 +#define num_subtag_bits 8 +#define fixnumshift 3 +#define fixnum_shift 3 +#define fulltagmask 15 +#define tagmask 7 +#define fixnummask 3 +#define subtagmask ((1<>3) +#define max_32_bit_constant_index ((0x7fff + misc_data_offset)>>2) +#define max_16_bit_constant_index ((0x7fff + misc_data_offset)>>1) +#define max_8_bit_constant_index (0x7fff + misc_data_offset) +#define max_1_bit_constant_index ((0x7fff + misc_data_offset)<<5) + + +/* The objects themselves look something like this: */ + +/* Order of CAR and CDR doesn't seem to matter much - there aren't */ +/* too many tricks to be played with predecrement/preincrement addressing. */ +/* Keep them in the confusing MCL 3.0 order, to avoid confusion. */ + +typedef struct cons { + LispObj cdr; + LispObj car; +} cons; + + + +typedef struct lispsymbol { + LispObj header; + LispObj pname; + LispObj vcell; + LispObj fcell; + LispObj package_plist; + LispObj flags; +} lispsymbol; + +typedef struct ratio { + LispObj header; + LispObj numer; + LispObj denom; +} ratio; + +typedef struct double_float { + LispObj header; + LispObj value; +} double_float; + + +typedef struct macptr { + LispObj header; + LispObj address; + LispObj class; + LispObj type; +} macptr; + +typedef struct xmacptr { + LispObj header; + LispObj address; + LispObj class; + LispObj type; + LispObj flags; + LispObj link; +} xmacptr; + + +typedef struct eabi_c_frame { + struct eabi_c_frame *backlink; + unsigned savelr; + LispObj params[8]; +} eabi_c_frame; + +/* PowerOpen ABI C frame */ + +typedef struct c_frame { + struct c_frame *backlink; + unsigned crsave; + unsigned savelr; + unsigned unused[2]; + unsigned savetoc; /* Used with CFM */ + unsigned params[8]; /* Space for callee to save r3-r10 */ +} c_frame; + +typedef struct lisp_frame { + struct lisp_frame *backlink; + LispObj savefn; + LispObj savelr; + LispObj savevsp; +} lisp_frame; + +typedef struct special_binding { + struct special_binding *link; + struct lispsymbol *sym; + LispObj value; +} special_binding; + +/* The GC (at least) needs to know what a + package looks like, so that it can do GCTWA. */ +typedef struct package { + LispObj header; + LispObj itab; /* itab and etab look like (vector (fixnum . fixnum) */ + LispObj etab; + LispObj used; + LispObj used_by; + LispObj names; + LispObj shadowed; +} package; + +/* + The GC also needs to know what a catch_frame looks like. +*/ + +typedef struct catch_frame { + LispObj header; + LispObj catch_tag; + LispObj link; + LispObj mvflag; + LispObj csp; + LispObj db_link; + LispObj regs[8]; + LispObj xframe; + LispObj tsp_segment; +} catch_frame; + +#define catch_frame_element_count ((sizeof(catch_frame)/sizeof(LispObj))-1) +#define catch_frame_header make_header(subtag_catch_frame,catch_frame_element_count) + + +/* + All exception frames in a thread are linked together + */ +typedef struct xframe_list { + ExceptionInformationPowerPC *curr; + struct xframe_list *prev; +} xframe_list; + +#define fixnum_bitmask(n) (1<<((n)+fixnumshift)) + +/* + The GC (at least) needs to know about hash-table-vectors and their flag bits. +*/ + +typedef struct hash_table_vector_header { + LispObj header; + LispObj link; /* If weak */ + LispObj flags; /* a fixnum; see below */ + LispObj free_alist; /* preallocated conses for finalization_alist */ + LispObj finalization_alist; /* key/value alist for finalization */ + LispObj weak_deletions_count; /* incremented when GC deletes weak pair */ + LispObj hash; /* backpointer to hash-table */ + LispObj deleted_count; /* number of deleted entries */ + LispObj cache_idx; /* index of last cached pair */ + LispObj cache_key; /* value of last cached key */ + LispObj cache_value; /* last cached value */ +} hash_table_vector_header; + +/* + Bits (masks) in hash_table_vector.flags: +*/ + +/* GC should track keys when addresses change */ +#define nhash_track_keys_mask fixnum_bitmask(28) + +/* GC should set when nhash_track_keys_bit & addresses change */ +#define nhash_key_moved_mask fixnum_bitmask(27) + +/* weak on key or value (need new "weak both" encoding.) */ +#define nhash_weak_mask fixnum_bitmask(12) + +/* weak on value */ +#define nhash_weak_value_mask fixnum_bitmask(11) + +/* finalizable */ +#define nhash_finalizable_mask fixnum_bitmask(10) + + +/* Lfun bits */ + +#define lfbits_nonnullenv_mask fixnum_bitmask(0) +#define lfbits_keys_mask fixnum_bitmask(1) +#define lfbits_restv_mask fixnum_bitmask(7) +#define lfbits_optinit_mask fixnum_bitmask(14) +#define lfbits_rest_mask fixnum_bitmask(15) +#define lfbits_aok_mask fixnum_bitmask(16) +#define lfbits_lap_mask fixnum_bitmask(23) +#define lfbits_trampoline_mask fixnum_bitmask(24) +#define lfbits_evaluated_mask fixnum_bitmask(25) +#define lfbits_cm_mask fixnum_bitmask(26) /* combined_method */ +#define lfbits_nextmeth_mask fixnum_bitmask(26) /* or call_next_method with method_mask */ +#define lfbits_gfn_mask fixnum_bitmask(27) /* generic_function */ +#define lfbits_nextmeth_with_args_mask fixnum_bitmask(27) /* or call_next_method_with_args with method_mask */ +#define lfbits_method_mask fixnum_bitmask(28) /* method function */ +/* PPC only but want it defined for xcompile */ +#define lfbits_noname_mask fixnum_bitmask(29) + +/* + known values of an "extended" (gcable) macptr's flags word: +*/ + +typedef enum { + xmacptr_flag_none = 0, /* Maybe already disposed by Lisp */ + xmacptr_flag_recursive_lock, /* recursive-lock */ + xmacptr_flag_ptr, /* malloc/free */ + xmacptr_flag_rwlock, /* read/write lock */ + xmacptr_flag_semaphore /* semaphore */ +} xmacptr_flag; + +/* Creole */ + +#define doh_quantum 400 +#define doh_block_slots ((doh_quantum >> 2) - 3) + +typedef struct doh_block { + struct doh_block *link; + unsigned size; + unsigned free; + LispObj data[doh_block_slots]; +} doh_block, *doh_block_ptr; + + +#define population_weak_list (0< call lisp_exit_hook */ + NATURAL_POINTER_FIELD(void,native_thread_info); /* platform-dependent */ + NATURAL_POINTER_FIELD(void,native_thread_id); /* mach_thread_t, pid_t, etc. */ + NATURAL_POINTER_FIELD(void,last_allocptr); + NATURAL_POINTER_FIELD(void,save_allocptr); + NATURAL_POINTER_FIELD(void,save_allocbase); + NATURAL_POINTER_FIELD(void,reset_completion); + NATURAL_POINTER_FIELD(void,activate); + signed_natural suspend_count; + NATURAL_POINTER_FIELD(ExceptionInformation,suspend_context); + NATURAL_POINTER_FIELD(ExceptionInformation,pending_exception_context); + NATURAL_POINTER_FIELD(void,suspend); /* suspension semaphore */ + NATURAL_POINTER_FIELD(void,resume); /* resumption semaphore */ + signed_natural flags; + NATURAL_POINTER_FIELD(ExceptionInformation,gc_context); + signed_natural suspend_total; + signed_natural suspend_total_on_exception_entry; + natural tlb_limit; + NATURAL_POINTER_FIELD(LispObj,tlb_pointer); + natural shutdown_count; +} TCR; + + + +#endif + Index: /trunk/ccl/lisp-kernel/constants64.s =================================================================== --- /trunk/ccl/lisp-kernel/constants64.s (revision 556) +++ /trunk/ccl/lisp-kernel/constants64.s (revision 557) @@ -93,14 +93,19 @@ /* There's some room for expansion in non-array ivector space. */ define_subtag(bignum,ivector_class_64_bit,0) -define_subtag(macptr,ivector_class_64_bit,1) -define_subtag(dead_macptr,ivector_class_64_bit,2) define_subtag(double_float,ivector_class_64_bit,3) +define_subtag(macptr,ivector_class_64_bit,5) +define_subtag(dead_macptr,ivector_class_64_bit,6) define_subtag(code_vector,ivector_class_32_bit,0) define_subtag(xcode_vector,ivector_class_32_bit,1) -;; Size doesn't matter for non-CL-array gvectors; I can't think of a good -;; reason to classify them in any particular way. Let's put funcallable -;; things in the first slice by themselves, though it's not clear that -;; that helps FUNCALL much. + + + +/* + Size doesn't matter for non-CL-array gvectors; I can't think of a good + reason to classify them in any particular way. Let's put funcallable + things in the first slice by themselves, though it's not clear that + that helps FUNCALL much. +*/ gvector_funcallable = fulltag_nodeheader_0 @@ -134,16 +139,19 @@ define_subtag(single_float,fulltag_imm_0,0) -define_subtag(slot_unbound,fulltag_imm_0,1) -slot_unbound_marker = subtag_slot_unbound -define_subtag(illegal,fulltag_imm_0,2) -illegal_marker = subtag_illegal define_subtag(go_tag,fulltag_imm_1,0) define_subtag(block_tag,fulltag_imm_1,1) + define_subtag(character,fulltag_imm_2,0) + define_subtag(unbound,fulltag_imm_3,0) unbound_marker = subtag_unbound undefined = unbound_marker -define_subtag(no_thread_local_binding,fulltag_imm_3,1) +define_subtag(slot_unbound,fulltag_imm_3,1) +slot_unbound_marker = subtag_slot_unbound +define_subtag(illegal,fulltag_imm_3,2) +illegal_marker = subtag_illegal +define_subtag(no_thread_local_binding,fulltag_imm_3,3) +no_thread_local_binding_marker = subtag_no_thread_local_binding Index: /trunk/ccl/lisp-kernel/darwin/.gdb_history =================================================================== --- /trunk/ccl/lisp-kernel/darwin/.gdb_history (revision 556) +++ /trunk/ccl/lisp-kernel/darwin/.gdb_history (revision 557) @@ -25,2 +25,9 @@ x/i _SPfuncall quit +x/i wait_for_exception_lock_in_handler +break *wait_for_exception_lock_in_handler +run +stepi +x/x $r2 +kill +quit Index: /trunk/ccl/lisp-kernel/darwin/Makefile =================================================================== --- /trunk/ccl/lisp-kernel/darwin/Makefile (revision 556) +++ /trunk/ccl/lisp-kernel/darwin/Makefile (revision 557) @@ -52,5 +52,5 @@ CDEFINES = -DDARWIN $(BROKEN_PREPROCESSOR_WORKAROUND) -DOPENMCL_MAJOR_VERSION=$(OPENMCL_MAJOR_VERSION) -DOPENMCL_MINOR_VERSION=$(OPENMCL_MINOR_VERSION) CDEBUG = -g -COPT = -O2 +COPT = #-O2 .s.o: Index: /trunk/ccl/lisp-kernel/gc.c =================================================================== --- /trunk/ccl/lisp-kernel/gc.c (revision 556) +++ /trunk/ccl/lisp-kernel/gc.c (revision 557) @@ -47,10 +47,10 @@ area *a = (area *) (zalloc(sizeof(area))); if (a) { - unsigned ndwords = area_dword(highaddr, lowaddr); + unsigned ndnodes = area_dnode(highaddr, lowaddr); a->low = lowaddr; a->high = highaddr; a->active = (code == AREA_DYNAMIC) ? lowaddr : highaddr; a->code = code; - a->ndwords = ndwords; + a->ndnodes = ndnodes; /* Caller must allocate markbits when allocating heap ! */ @@ -183,7 +183,15 @@ case fulltag_even_fixnum: case fulltag_odd_fixnum: +#ifdef PPC64 + case fulltag_imm_0: + case fulltag_imm_1: + case fulltag_imm_2: + case fulltag_imm_3: +#else case fulltag_imm: +#endif return; +#ifndef PPC64 case fulltag_nil: if (n != lisp_nil) { @@ -191,7 +199,19 @@ } return; - +#endif + +#ifdef PPC64 + case fulltag_nodeheader_0: + case fulltag_nodeheader_1: + case fulltag_nodeheader_2: + case fulltag_nodeheader_3: + case fulltag_immheader_0: + case fulltag_immheader_1: + case fulltag_immheader_2: + case fulltag_immheader_3: +#else case fulltag_nodeheader: case fulltag_immheader: +#endif Bug(NULL, "Header not expected : 0x%08x", n); return; @@ -199,5 +219,5 @@ case fulltag_misc: case fulltag_cons: - a = heap_area_containing((BytePtr)n); + a = heap_area_containing((BytePtr)ptr_from_lispobj(n)); if (a == NULL) { @@ -207,6 +227,6 @@ bad .. */ a = active_dynamic_area; - if ((n > ((LispObj)a->active)) && - (n < ((LispObj)a->high))) { + if ((n > (ptr_to_lispobj(a->active))) && + (n < (ptr_to_lispobj(a->high)))) { Bug(NULL, "Node points to heap free space: 0x%08x", n); } @@ -219,6 +239,6 @@ header_tag = fulltag_of(header); if (tag == fulltag_cons) { - if ((header_tag == fulltag_nodeheader) || - (header_tag == fulltag_immheader)) { + if ((nodeheader_tag_p(header_tag)) || + (immheader_tag_p(header_tag))) { Bug(NULL, "Cons cell at 0x%08x has bogus header : 0x%08x", n, header); } @@ -226,6 +246,6 @@ } - if ((header_tag != fulltag_nodeheader) && - (header_tag != fulltag_immheader)) { + if ((!nodeheader_tag_p(header_tag)) && + (!immheader_tag_p(header_tag))) { Bug(NULL,"Vector at 0x%08x has bogus header : 0x%08x", n, header); } @@ -244,7 +264,7 @@ node = *current++; tag = fulltag_of(node); - if (tag == fulltag_immheader) { + if (immheader_tag_p(tag)) { current = (LispObj *)skip_over_ivector((unsigned)prev, node); - } else if (tag == fulltag_nodeheader) { + } else if (nodeheader_tag_p(tag)) { elements = header_element_count(node) | 1; while (elements--) { @@ -299,5 +319,5 @@ end != limit; current = next) { - next = (LispObj *) *current; + next = ptr_from_lispobj(*current); end = ((next >= start) && (next < limit)) ? next : limit; if (current[1] == 0) { @@ -332,11 +352,11 @@ } - if (tag == fulltag_immheader) { - q = (LispObj *)skip_over_ivector((LispObj)p, header); + if (immheader_tag_p(tag)) { + q = (LispObj *)skip_over_ivector(ptr_to_lispobj(p), header); if (q >= nextpage) { bucket->halfword = 0; return q; } - } else if (tag == fulltag_nodeheader) { + } else if (nodeheader_tag_p(tag)) { q = p + ((2 + header_element_count(header)) & ~1); if (p >= page) { @@ -376,5 +396,5 @@ LispObj *p, *page = (LispObj *)truncate_to_power_of_2(start,12); pageentry - *buckets = pagemap + (((LispObj)page - lisp_global(HEAP_START)) >> 12); + *buckets = pagemap + (((ptr_to_lispobj(page)) - lisp_global(HEAP_START)) >> 12); if (start != page) { @@ -398,5 +418,5 @@ LispObj *end, LispObj ephemeral_start, - unsigned long ephemeral_dwords) + unsigned long ephemeral_dnodes) { LispObj node, oldspacestart = lisp_global(HEAP_START); @@ -407,6 +427,6 @@ node = *start; tag = fulltag_of(node); - if (tag == fulltag_immheader) { /* An ivector */ - start = (LispObj *)skip_over_ivector((LispObj)start, node); + if (immheader_tag_p(tag)) { /* An ivector */ + start = ptr_from_lispobj(skip_over_ivector(ptr_to_lispobj(start), node)); } else { if ((header_subtag(node) == subtag_hash_vector) || @@ -414,13 +434,13 @@ least if we have to track key movement */ (((tag == fulltag_cons) || (tag == fulltag_misc)) && - (area_dword(node, ephemeral_start) < ephemeral_dwords))) { + (area_dnode(node, ephemeral_start) < ephemeral_dnodes))) { /* Tagged pointer to (some) younger generation; update refmap */ - set_bit(refbits,area_dword(start, oldspacestart)); + set_bit(refbits,area_dnode(start, oldspacestart)); } else { node = start[1]; tag = fulltag_of(node); if (((tag == fulltag_cons) || (tag == fulltag_misc)) && - (area_dword(node, ephemeral_start) < ephemeral_dwords)) { - set_bit(refbits,area_dword(start, oldspacestart)); + (area_dnode(node, ephemeral_start) < ephemeral_dnodes)) { + set_bit(refbits,area_dnode(start, oldspacestart)); } } @@ -434,5 +454,5 @@ LispObj *page, LispObj ephemeral_start, - unsigned ephemeral_dwords) + unsigned ephemeral_dnodes) { LispObj *start; @@ -441,7 +461,7 @@ start = page + bucket->bits.offset; update_refmap_for_range(start, - (LispObj *) align_to_power_of_2((LispObj)start+1,12), + (LispObj *) align_to_power_of_2(ptr_to_lispobj(start+1),12), ephemeral_start, - ephemeral_dwords); + ephemeral_dnodes); } } @@ -452,5 +472,5 @@ update_refmap_for_area(area *a, BytePtr curfree) { - if (a->ndwords) { + if (a->ndnodes) { LispObj *start = (LispObj *) a->low, @@ -458,10 +478,10 @@ *last_whole_page_end = (LispObj *) truncate_to_power_of_2(limit,12), *first_partial_page_start = (LispObj *) truncate_to_power_of_2(start,12); - pageentry *p = pagemap + ((LispObj)start - lisp_global(HEAP_START) >> 12); - unsigned younger_dwords = area_dword((LispObj)curfree,(LispObj)limit); + pageentry *p = pagemap + (ptr_to_lispobj(start) - lisp_global(HEAP_START) >> 12); + unsigned younger_dnodes = area_dnode(ptr_to_lispobj(curfree),ptr_to_lispobj(limit)); if (last_whole_page_end == first_partial_page_start) { if (p->bits.modified && p->bits.hasnode) { - update_refmap_for_range(start,limit,(LispObj)limit,younger_dwords); + update_refmap_for_range(start,limit,ptr_to_lispobj(limit),younger_dnodes); } } else { @@ -470,5 +490,5 @@ *page_end = first_partial_page_start + (4096 / sizeof(LispObj *)); if (p->bits.modified && p->bits.hasnode) { - update_refmap_for_range(start,page_end,(LispObj)limit,younger_dwords); + update_refmap_for_range(start,page_end,ptr_to_lispobj(limit),younger_dnodes); } start = page_end; @@ -478,9 +498,9 @@ start < last_whole_page_end; start += (4096 / sizeof(LispObj *)), p++) { - update_refmap_for_page(p,start,(LispObj)limit,younger_dwords); + update_refmap_for_page(p,start,ptr_to_lispobj(limit),younger_dnodes); } if (start < limit) { if (p->bits.modified && p->bits.hasnode) { - update_refmap_for_range(start+p->bits.offset,limit,(LispObj)limit,younger_dwords); + update_refmap_for_range(start+p->bits.offset,limit,ptr_to_lispobj(limit),younger_dnodes); } } @@ -523,6 +543,6 @@ tenured_low = tenured_area->low; unsigned - dynamic_dwords = area_dword(curfree, a->low), - new_tenured_dwords = area_dword(curfree, tenured_area->low); + dynamic_dnodes = area_dnode(curfree, a->low), + new_tenured_dnodes = area_dnode(curfree, tenured_area->low); bitvector refbits = tenured_area->refbits, @@ -531,19 +551,19 @@ target->high = target->active = curfree; - target->ndwords = area_dword(curfree, target_low); + target->ndnodes = area_dnode(curfree, target_low); for (child = target->younger; child != a; child = child->younger) { child->high = child->low = child->active = curfree; - child->ndwords = 0; + child->ndnodes = 0; } a->low = curfree; - a->ndwords = area_dword(a->high, curfree); - - new_markbits = refbits + ((new_tenured_dwords + 31) >> 5); + a->ndnodes = area_dnode(a->high, curfree); + + new_markbits = refbits + ((new_tenured_dnodes + 31) >> 5); if (target == tenured_area) { - zero_bits(refbits, new_tenured_dwords); - lisp_global(OLDEST_EPHEMERAL) = (LispObj) curfree; + zero_bits(refbits, new_tenured_dnodes); + lisp_global(OLDEST_EPHEMERAL) = ptr_to_lispobj(curfree); } else { /* Need more (zeroed) refbits & fewer markbits */ @@ -572,15 +592,15 @@ area *a = active_dynamic_area, *child; BytePtr curlow = from->low; - unsigned new_tenured_dwords = area_dword(curlow, tenured_area->low); + unsigned new_tenured_dnodes = area_dnode(curlow, tenured_area->low); for (child = from; child != a; child = child->younger) { child->low = child->active = child->high = curlow; - child->ndwords = 0; + child->ndnodes = 0; } a->low = curlow; - a->ndwords = area_dword(a->high, curlow); + a->ndnodes = area_dnode(a->high, curlow); - a->markbits = (tenured_area->refbits) + ((new_tenured_dwords+31)>>5); + a->markbits = (tenured_area->refbits) + ((new_tenured_dnodes+31)>>5); if (from == tenured_area) { /* Everything's in the dynamic area */ @@ -602,5 +622,5 @@ } if (activate) { - LispObj *heap_start = (LispObj *)lisp_global(HEAP_START); + LispObj *heap_start = ptr_from_lispobj(lisp_global(HEAP_START)); a->older = g1_area; @@ -709,8 +729,8 @@ bitvector GCmarkbits = NULL; LispObj GCarealow; -unsigned GCndwords_in_area; +unsigned GCndnodes_in_area; LispObj GCweakvll = (LispObj)NULL; LispObj GCephemeral_low; -unsigned GCn_ephemeral_dwords; +unsigned GCn_ephemeral_dnodes; @@ -722,5 +742,5 @@ { int tag_n = fulltag_of(n); - unsigned dword, bits, *bitsp, mask; + unsigned dnode, bits, *bitsp, mask; if (!is_node_fulltag(tag_n)) { @@ -728,9 +748,9 @@ } - dword = gc_area_dword(n); - if (dword >= GCndwords_in_area) { + dnode = gc_area_dnode(n); + if (dnode >= GCndnodes_in_area) { return; } - set_bits_vars(GCmarkbits,dword,bitsp,bits,mask); + set_bits_vars(GCmarkbits,dnode,bitsp,bits,mask); if (bits & mask) { return; @@ -739,5 +759,5 @@ if (tag_n == fulltag_cons) { - cons *c = (cons *) untag(n); + cons *c = (cons *) ptr_from_lispobj(untag(n)); rmark(c->car); rmark(c->cdr); @@ -745,14 +765,31 @@ } { - LispObj *base = (LispObj *) untag(n); - unsigned - header = *((unsigned *) base), + LispObj *base = (LispObj *) ptr_from_lispobj(untag(n)); + natural + header = *((natural *) base), subtag = header_subtag(header), element_count = header_element_count(header), total_size_in_bytes, /* including 4-byte header */ - suffix_dwords; + suffix_dnodes; tag_n = fulltag_of(header); +#ifdef PPC64 + if ((nodeheader_tag_p(tag_n)) || + (tag_n == ivector_class_64_bit)) { + total_size_in_bytes = 8 + (element_count<<3); + } else if (tag_n == ivector_class_8_bit) { + total_size_in_bytes = 8 + element_count; + } else if (tag_n == ivector_class_32_bit) { + total_size_in_bytes = 8 + (element_count<<2); + } else { + /* ivector_class_other_bit contains 16-bit arrays & bitvector */ + if (subtag == subtag_bit_vector) { + total_size_in_bytes = 8 + ((element_count+7)>>3); + } else { + total_size_in_bytes = 8 + (element_count<<1); + } + } +#else if ((tag_n == fulltag_nodeheader) || (subtag <= max_32_bit_ivector_subtag)) { @@ -767,11 +804,12 @@ total_size_in_bytes = 4 + ((element_count+7)>>3); } - suffix_dwords = ((total_size_in_bytes+7)>>3) -1; - - if (suffix_dwords) { - set_n_bits(GCmarkbits, dword+1, suffix_dwords); - } - - if (tag_n == fulltag_nodeheader) { +#endif + suffix_dnodes = ((total_size_in_bytes+(dnode_size-1))>>dnode_shift) -1; + + if (suffix_dnodes) { + set_n_bits(GCmarkbits, dnode+1, suffix_dnodes); + } + + if (nodeheader_tag_p(tag_n)) { if (subtag == subtag_hash_vector) { ((hash_table_vector_header *) base)->cache_key = undefined; @@ -820,7 +858,7 @@ { int tag_n = fulltag_of(n); - unsigned eph_dword; - - if (tag_n == fulltag_nodeheader) { + unsigned eph_dnode; + + if (nodeheader_tag_p(tag_n)) { return (header_subtag(n) == subtag_hash_vector); } @@ -828,6 +866,6 @@ if ((tag_n == fulltag_cons) || (tag_n == fulltag_misc)) { - eph_dword = area_dword(n, GCephemeral_low); - if (eph_dword < GCn_ephemeral_dwords) { + eph_dnode = area_dnode(n, GCephemeral_low); + if (eph_dnode < GCn_ephemeral_dnodes) { mark_root(n); /* May or may not mark it */ return true; /* but return true 'cause it's an ephemeral node */ @@ -855,18 +893,18 @@ mark_root(pc); } else { - unsigned dword = gc_area_dword(pc); - if ((dword < GCndwords_in_area) && - !ref_bit(GCmarkbits,dword)) { + natural dnode = gc_area_dnode(pc); + if ((dnode < GCndnodes_in_area) && + !ref_bit(GCmarkbits,dnode)) { LispObj *headerP, header; - for(headerP = (LispObj*)(untag(pc)); - dword < GCndwords_in_area; - headerP-=2, --dword) { + for(headerP = (LispObj*)ptr_from_lispobj(untag(pc)); + dnode < GCndnodes_in_area; + headerP-=2, --dnode) { header = *headerP; if ((header & code_header_mask) == subtag_code_vector) { - set_n_bits(GCmarkbits, dword, (2+header_element_count(header))>>1); + set_n_bits(GCmarkbits, dnode, (2+header_element_count(header))>>1); return; } @@ -892,5 +930,5 @@ int tag_n = fulltag_of(n); bitvector markbits = GCmarkbits; - unsigned dword, bits, *bitsp, mask; + unsigned dnode, bits, *bitsp, mask; if (!is_node_fulltag(tag_n)) { @@ -898,9 +936,9 @@ } - dword = gc_area_dword(n); - if (dword >= GCndwords_in_area) { + dnode = gc_area_dnode(n); + if (dnode >= GCndnodes_in_area) { return; } - set_bits_vars(markbits,dword,bitsp,bits,mask); + set_bits_vars(markbits,dnode,bitsp,bits,mask); if (bits & mask) { return; @@ -958,7 +996,7 @@ tag_n = fulltag_of(next); if (!is_node_fulltag(tag_n)) goto MarkCdr; - dword = gc_area_dword(next); - if (dword >= GCndwords_in_area) goto MarkCdr; - set_bits_vars(markbits,dword,bitsp,bits,mask); + dnode = gc_area_dnode(next); + if (dnode >= GCndnodes_in_area) goto MarkCdr; + set_bits_vars(markbits,dnode,bitsp,bits,mask); if (bits & mask) goto MarkCdr; *bitsp = (bits | mask); @@ -976,7 +1014,7 @@ tag_n = fulltag_of(next); if (!is_node_fulltag(tag_n)) goto Climb; - dword = gc_area_dword(next); - if (dword >= GCndwords_in_area) goto Climb; - set_bits_vars(markbits,dword,bitsp,bits,mask); + dnode = gc_area_dnode(next); + if (dnode >= GCndnodes_in_area) goto Climb; + set_bits_vars(markbits,dnode,bitsp,bits,mask); if (bits & mask) goto Climb; *bitsp = (bits | mask); @@ -991,14 +1029,31 @@ MarkVector: { - LispObj *base = (LispObj *) untag(this); - unsigned - header = *((unsigned *) base), - subtag = header_subtag(header), - element_count = header_element_count(header), - total_size_in_bytes, - suffix_dwords; + LispObj *base = (LispObj *) ptr_from_lispobj(untag(this)); + natural + header = *((natural *) base), + subtag = header_subtag(header), + element_count = header_element_count(header), + total_size_in_bytes, + suffix_dnodes; tag_n = fulltag_of(header); +#ifdef PPC64 + if ((nodeheader_tag_p(tag_n)) || + (tag_n == ivector_class_64_bit)) { + total_size_in_bytes = 8 + (element_count<<3); + } else if (tag_n == ivector_class_8_bit) { + total_size_in_bytes = 8 + element_count; + } else if (tag_n == ivector_class_32_bit) { + total_size_in_bytes = 8 + (element_count<<2); + } else { + /* ivector_class_other_bit contains 16-bit arrays & bitvector */ + if (subtag == subtag_bit_vector) { + total_size_in_bytes = 8 + ((element_count+7)>>3); + } else { + total_size_in_bytes = 8 + (element_count<<1); + } + } +#else if ((tag_n == fulltag_nodeheader) || (subtag <= max_32_bit_ivector_subtag)) { @@ -1013,11 +1068,12 @@ total_size_in_bytes = 4 + ((element_count+7)>>3); } - suffix_dwords = ((total_size_in_bytes+7)>>3)-1; - - if (suffix_dwords) { - set_n_bits(GCmarkbits, dword+1, suffix_dwords); - } - - if (tag_n != fulltag_nodeheader) goto Climb; +#endif + suffix_dnodes = ((total_size_in_bytes+(dnode_size-1))>>dnode_shift)-1; + + if (suffix_dnodes) { + set_n_bits(GCmarkbits, dnode+1, suffix_dnodes); + } + + if (!nodeheader_tag_p(tag_n)) goto Climb; if (subtag == subtag_hash_vector) { @@ -1042,24 +1098,24 @@ } - this = untag(this) + ((element_count+1) << 2); + this = untag(this) + ((element_count+1) << node_shift); goto MarkVectorLoop; } ClimbVector: - prev = *((LispObj *) this); - *((LispObj *) this) = next; + prev = *((LispObj *) ptr_from_lispobj(this)); + *((LispObj *) ptr_from_lispobj(this)) = next; MarkVectorLoop: - this -= 4; - next = *((LispObj *) this); + this -= node_size; + next = *((LispObj *) ptr_from_lispobj(this)); tag_n = fulltag_of(next); - if (tag_n == fulltag_nodeheader) goto MarkVectorDone; + if (nodeheader_tag_p(tag_n)) goto MarkVectorDone; if (!is_node_fulltag(tag_n)) goto MarkVectorLoop; - dword = gc_area_dword(next); - if (dword >= GCndwords_in_area) goto MarkVectorLoop; - set_bits_vars(markbits,dword,bitsp,bits,mask); + dnode = gc_area_dnode(next); + if (dnode >= GCndnodes_in_area) goto MarkVectorLoop; + set_bits_vars(markbits,dnode,bitsp,bits,mask); if (bits & mask) goto MarkVectorLoop; *bitsp = (bits | mask); - *((LispObj *) this) = prev; + *(ptr_from_lispobj(this)) = prev; if (tag_n == fulltag_cons) goto DescendCons; goto DescendVector; @@ -1078,12 +1134,33 @@ } -unsigned -skip_over_ivector(unsigned start, LispObj header) -{ - unsigned +LispObj * +skip_over_ivector(natural start, LispObj header) +{ + natural element_count = header_element_count(header), subtag = header_subtag(header), nbytes; +#ifdef PPC64 + switch (fulltag_of(header)) { + case ivector_class_64_bit: + nbytes = element_count << 3; + break; + case ivector_class_32_bit: + nbytes = element_count << 2; + break; + case ivector_class_8_bit: + nbytes = element_count; + break; + case ivector_class_other_bit: + default: + if (subtag == subtag_bit_vector) { + nbytes = (element_count+7)>>3; + } else { + nbytes = element_count << 1; + } + } + return ptr_from_lispobj(start+(~15 & (nbytes + 8 + 15))); +#else if (subtag <= max_32_bit_ivector_subtag) { nbytes = element_count << 2; @@ -1097,5 +1174,6 @@ nbytes = (element_count+7) >> 3; } - return start+(~7 & (nbytes + 4 + 7)); + return ptr_from_lispobj(start+(~7 & (nbytes + 4 + 7))); +#endif } @@ -1106,16 +1184,17 @@ LispObj x1, *base = start; int tag; - unsigned ref_dword, node_dword; + natural ref_dnode, node_dnode; Boolean intergen_ref; while (start < end) { x1 = *start; - if ((tag = fulltag_of(x1)) == fulltag_immheader) { - start = (LispObj *)skip_over_ivector((unsigned) start, x1); + tag = fulltag_of(x1); + if (immheader_tag_p(tag)) { + start = skip_over_ivector(ptr_to_lispobj(start), x1); } else { intergen_ref = false; if ((tag == fulltag_misc) || (tag == fulltag_cons)) { - node_dword = gc_area_dword(x1); - if (node_dword < GCndwords_in_area) { + node_dnode = gc_area_dnode(x1); + if (node_dnode < GCndnodes_in_area) { intergen_ref = true; } @@ -1125,6 +1204,6 @@ tag = fulltag_of(x1); if ((tag == fulltag_misc) || (tag == fulltag_cons)) { - node_dword = gc_area_dword(x1); - if (node_dword < GCndwords_in_area) { + node_dnode = gc_area_dnode(x1); + if (node_dnode < GCndnodes_in_area) { intergen_ref = true; } @@ -1132,8 +1211,8 @@ } if (intergen_ref) { - ref_dword = area_dword(start, base); - if (!ref_bit(refbits, ref_dword)) { + ref_dnode = area_dnode(start, base); + if (!ref_bit(refbits, ref_dnode)) { Bug(NULL, "Missing memoization in doubleword at 0x%08X", start); - set_bit(refbits, ref_dword); + set_bit(refbits, ref_dnode); } } @@ -1146,13 +1225,13 @@ void -mark_memoized_area(area *a, unsigned num_memo_dwords) +mark_memoized_area(area *a, unsigned num_memo_dnodes) { bitvector refbits = a->refbits; LispObj *p = (LispObj *) a->low, x1, x2; - unsigned inbits, outbits, bits, bitidx, *bitsp, nextbit, diff, memo_dword = 0; + unsigned inbits, outbits, bits, bitidx, *bitsp, nextbit, diff, memo_dnode = 0; Boolean keep_x1, keep_x2; if (GCDebug) { - check_refmap_consistency(p, p+(num_memo_dwords << 1), refbits); + check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits); } @@ -1170,14 +1249,14 @@ /* - We need to ensure that there are no bits set at or beyond "num_memo_dwords" + We need to ensure that there are no bits set at or beyond "num_memo_dnodes" in the bitvector. (This can happen as the EGC tenures/untenures things.) We find bits by grabbing a fullword at a time and doing a cntlzw instruction; - and don't want to have to check for (< memo_dword num_memo_dwords) in the loop. + and don't want to have to check for (< memo_dnode num_memo_dnodes) in the loop. */ { unsigned - bits_in_last_word = (num_memo_dwords & 0x1f), - index_of_last_word = (num_memo_dwords >> 5); + bits_in_last_word = (num_memo_dnodes & 0x1f), + index_of_last_word = (num_memo_dnodes >> 5); if (bits_in_last_word != 0) { @@ -1188,8 +1267,8 @@ set_bitidx_vars(refbits, 0, bitsp, bits, bitidx); inbits = outbits = bits; - while (memo_dword < num_memo_dwords) { + while (memo_dnode < num_memo_dnodes) { if (bits == 0) { int remain = 0x20 - bitidx; - memo_dword += remain; + memo_dnode += remain; p += (remain+remain); if (outbits != inbits) { @@ -1202,5 +1281,5 @@ nextbit = count_leading_zeros(bits); if ((diff = (nextbit - bitidx)) != 0) { - memo_dword += diff; + memo_dnode += diff; bitidx = nextbit; p += (diff+diff); @@ -1215,5 +1294,5 @@ outbits &= ~(BIT0_MASK >> bitidx); } - memo_dword++; + memo_dnode++; bitidx++; } @@ -1221,5 +1300,5 @@ if (GCDebug) { p = (LispObj *) a->low; - check_refmap_consistency(p, p+(num_memo_dwords << 1), refbits); + check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits); } } @@ -1235,7 +1314,8 @@ while (start < end) { x1 = *start; - if ((tag = fulltag_of(x1)) == fulltag_immheader) { - start = (LispObj *)skip_over_ivector((unsigned) start, x1); - } else if (tag != fulltag_nodeheader) { + tag = fulltag_of(x1); + if (immheader_tag_p(tag)) { + start = (LispObj *)ptr_from_lispobj(skip_over_ivector(ptr_to_lispobj(start), x1)); + } else if (!nodeheader_tag_p(tag)) { ++start; mark_root(x1); @@ -1243,6 +1323,6 @@ } else { int subtag = header_subtag(x1); - int element_count = header_element_count(x1); - int size = (element_count+1 + 1) & ~1; + natural element_count = header_element_count(x1); + natural size = (element_count+1 + 1) & ~1; if (subtag == subtag_hash_vector) { @@ -1277,13 +1357,4 @@ } -void -mark_dohs( void ) -{ - doh_block_ptr doh_block = (doh_block_ptr) lisp_global(DOH_HEAD); - while( doh_block ) { - mark_simple_area_range( &doh_block->data[0], &doh_block->data[doh_block_slots] ); - doh_block = doh_block->link; - } -} /* Mark a tstack area */ @@ -1301,5 +1372,5 @@ end != limit; current = next) { - next = (LispObj *) *current; + next = (LispObj *) ptr_from_lispobj(*current); end = ((next >= start) && (next < limit)) ? next : limit; if (current[1] == 0) { @@ -1378,5 +1449,5 @@ N.B. : elements 0 and 1 are already marked (or are immediate, etc.) */ - LispObj *prev = ((LispObj *) untag(weakv))+(1+2), cell = *prev; + LispObj *prev = ((LispObj *) ptr_from_lispobj(untag(weakv))+(1+2)), cell = *prev; LispObj termination_list = lisp_nil; int weak_type = (int) deref(weakv,2); @@ -1385,5 +1456,5 @@ Boolean done = false; cons *rawcons; - unsigned dword, car_dword; + unsigned dnode, car_dnode; bitvector markbits = GCmarkbits; @@ -1397,7 +1468,7 @@ /* weak alist */ while (! done) { - dword = gc_area_dword(cell); - if ((dword >= GCndwords_in_area) || - (ref_bit(markbits, dword))) { + dnode = gc_area_dnode(cell); + if ((dnode >= GCndnodes_in_area) || + (ref_bit(markbits, dnode))) { done = true; } else { @@ -1406,14 +1477,14 @@ unsigned cell_tag; - rawcons = (cons *) untag(cell); + rawcons = (cons *) ptr_from_lispobj(untag(cell)); alist_cell = rawcons->car; cell_tag = fulltag_of(alist_cell); if ((cell_tag == fulltag_cons) && - ((car_dword = gc_area_dword(alist_cell)) < GCndwords_in_area) && - (! ref_bit(markbits, car_dword)) && + ((car_dnode = gc_area_dnode(alist_cell)) < GCndnodes_in_area) && + (! ref_bit(markbits, car_dnode)) && (is_node_fulltag(fulltag_of(thecar = car(alist_cell)))) && - ((car_dword = gc_area_dword(thecar)) < GCndwords_in_area) && - (! ref_bit(markbits, car_dword))) { + ((car_dnode = gc_area_dnode(thecar)) < GCndnodes_in_area) && + (! ref_bit(markbits, car_dnode))) { *prev = rawcons->cdr; if (terminatablep) { @@ -1422,5 +1493,5 @@ } } else { - set_bit(markbits, dword); + set_bit(markbits, dnode); prev = (LispObj *)(&(rawcons->cdr)); mark_root(alist_cell); @@ -1432,7 +1503,7 @@ /* weak list */ while (! done) { - dword = gc_area_dword(cell); - if ((dword >= GCndwords_in_area) || - (ref_bit(markbits, dword))) { + dnode = gc_area_dnode(cell); + if ((dnode >= GCndnodes_in_area) || + (ref_bit(markbits, dnode))) { done = true; } else { @@ -1446,6 +1517,6 @@ if (is_node_fulltag(cartag) && - ((car_dword = gc_area_dword(thecar)) < GCndwords_in_area) && - (! ref_bit(markbits, car_dword))) { + ((car_dnode = gc_area_dnode(thecar)) < GCndnodes_in_area) && + (! ref_bit(markbits, car_dnode))) { *prev = rawcons->cdr; if (terminatablep) { @@ -1454,5 +1525,5 @@ } } else { - set_bit(markbits, dword); + set_bit(markbits, dnode); prev = (LispObj *)(&(rawcons->cdr)); } @@ -1478,7 +1549,8 @@ reaphashv(LispObj hashv) { - hash_table_vector_header *hashp = (hash_table_vector_header *) untag(hashv); - unsigned - dword, + hash_table_vector_header + *hashp = (hash_table_vector_header *) ptr_from_lispobj(untag(hashv)); + natural + dnode, npairs = (header_element_count(hashp->header) - ((sizeof(hash_table_vector_header)/sizeof(LispObj)) -1)) >> 1; @@ -1497,7 +1569,7 @@ tag = fulltag_of(weakelement); if (is_node_fulltag(tag)) { - dword = gc_area_dword(weakelement); - if ((dword < GCndwords_in_area) && - ! ref_bit(markbits, dword)) { + dnode = gc_area_dnode(weakelement); + if ((dnode < GCndnodes_in_area) && + ! ref_bit(markbits, dnode)) { pairp[0] = undefined; pairp[1] = lisp_nil; @@ -1514,5 +1586,5 @@ mark_weak_hash_vector(hash_table_vector_header *hashp, unsigned elements) { - unsigned flags = hashp->flags, key_dword, val_dword; + unsigned flags = hashp->flags, key_dnode, val_dnode; Boolean marked_new = false, @@ -1545,14 +1617,14 @@ val_tag = fulltag_of(val); if (is_node_fulltag(key_tag)) { - key_dword = gc_area_dword(key); - if ((key_dword < GCndwords_in_area) && - ! ref_bit(GCmarkbits,key_dword)) { + key_dnode = gc_area_dnode(key); + if ((key_dnode < GCndnodes_in_area) && + ! ref_bit(GCmarkbits,key_dnode)) { key_marked = false; } } if (is_node_fulltag(val_tag)) { - val_dword = gc_area_dword(val); - if ((val_dword < GCndwords_in_area) && - ! ref_bit(GCmarkbits,val_dword)) { + val_dnode = gc_area_dnode(val); + if ((val_dnode < GCndnodes_in_area) && + ! ref_bit(GCmarkbits,val_dnode)) { val_marked = false; } @@ -1579,5 +1651,5 @@ { int elements = header_element_count(header_of(weak_alist)); - unsigned dword; + unsigned dnode; int pair_tag; Boolean marked_new = false; @@ -1590,22 +1662,22 @@ for(alist = deref(weak_alist, elements); (fulltag_of(alist) == fulltag_cons) && - ((dword = gc_area_dword(alist)) < GCndwords_in_area) && - (! ref_bit(markbits,dword)); + ((dnode = gc_area_dnode(alist)) < GCndnodes_in_area) && + (! ref_bit(markbits,dnode)); alist = cdr(alist)) { pair = car(alist); pair_tag = fulltag_of(pair); if ((is_node_fulltag(pair_tag)) && - ((dword = gc_area_dword(pair_tag)) < GCndwords_in_area) && - (! ref_bit(markbits,dword))) { + ((dnode = gc_area_dnode(pair_tag)) < GCndnodes_in_area) && + (! ref_bit(markbits,dnode))) { if (pair_tag == fulltag_cons) { key = car(pair); if ((! is_node_fulltag(fulltag_of(key))) || - ((dword = gc_area_dword(key)) >= GCndwords_in_area) || - ref_bit(markbits,dword)) { + ((dnode = gc_area_dnode(key)) >= GCndnodes_in_area) || + ref_bit(markbits,dnode)) { /* key is marked, mark value if necessary */ value = cdr(pair); if (is_node_fulltag(fulltag_of(value)) && - ((dword = gc_area_dword(value)) < GCndwords_in_area) && - (! ref_bit(markbits,dword))) { + ((dnode = gc_area_dnode(value)) < GCndnodes_in_area) && + (! ref_bit(markbits,dnode))) { mark_root(value); marked_new = true; @@ -1714,5 +1786,5 @@ mark_xp(ExceptionInformation *xp) { - unsigned long *regs = (unsigned long *) xpGPRvector(xp); + natural *regs = (natural *) xpGPRvector(xp); int r; @@ -1788,13 +1860,13 @@ LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next, ptr; xmacptr_flag flag; - unsigned dword; + unsigned dnode; xmacptr *x; while((next = *prev) != (LispObj)NULL) { - dword = gc_area_dword(next); - x = (xmacptr *) untag(next); - - if ((dword >= GCndwords_in_area) || - (ref_bit(GCmarkbits,dword))) { + dnode = gc_area_dnode(next); + x = (xmacptr *) ptr_from_lispobj(untag(next)); + + if ((dnode >= GCndnodes_in_area) || + (ref_bit(GCmarkbits,dnode))) { prev = &(x->link); } else { @@ -1810,5 +1882,5 @@ case xmacptr_flag_ptr: - deallocate((char *)ptr); + deallocate((char *)ptr_from_lispobj(ptr)); break; @@ -1863,5 +1935,5 @@ /* A "pagelet" contains 32 doublewords. The relocation table contains a word for each pagelet which defines the lowest address to which - dwords on that pagelet will be relocated. + dnodes on that pagelet will be relocated. The relocation address of a given pagelet is the sum of the relocation @@ -1877,5 +1949,5 @@ bitvector markbits = GCmarkbits; unsigned char *bytep = (unsigned char *) markbits; - unsigned npagelets = ((GCndwords_in_area+31)>>5); + unsigned npagelets = ((GCndnodes_in_area+31)>>5); unsigned thesebits; LispObj first = 0; @@ -1906,5 +1978,5 @@ LispObj -dword_forwarding_address(unsigned dword, int tag_n) +dnode_forwarding_address(unsigned dnode, int tag_n) { unsigned pagelet, nbits; @@ -1913,16 +1985,16 @@ if (GCDebug) { - if (! ref_bit(GCmarkbits, dword)) { + if (! ref_bit(GCmarkbits, dnode)) { Bug(NULL, "unmarked object being forwarded!\n"); } } - pagelet = dword >> 5; - nbits = dword & 0x1f; - near_bits = ((unsigned short *)GCmarkbits)[dword>>4]; + pagelet = dnode >> 5; + nbits = dnode & 0x1f; + near_bits = ((unsigned short *)GCmarkbits)[dnode>>4]; if (nbits < 16) { new = GCrelocptr[pagelet] + tag_n;; - /* Increment "new" by the count of 1 bits which precede the dword */ + /* Increment "new" by the count of 1 bits which precede the dnode */ if (near_bits == 0xffff) { return (new + (nbits << 3)); @@ -1955,5 +2027,5 @@ { int tag_n = fulltag_of(obj); - unsigned dword; + unsigned dnode; /* Locatives can be tagged as conses, "fulltag_misc" @@ -1962,4 +2034,9 @@ doesn't hurt to check ... */ +#ifdef PPC64 + if ((tag_n & lowtag_mask) != lowtag_primary) { + return obj; + } +#else if ((1<= GCndwords_in_area) || +#endif + + dnode = gc_area_dnode(obj); + + if ((dnode >= GCndnodes_in_area) || (obj < GCfirstunmarked)) { return obj; } - return dword_forwarding_address(dword, tag_n); + return dnode_forwarding_address(dnode, tag_n); } @@ -1983,7 +2061,7 @@ { int tag_n; - unsigned dword = gc_area_dword(node); - - if ((dword >= GCndwords_in_area) || + unsigned dnode = gc_area_dnode(node); + + if ((dnode >= GCndnodes_in_area) || (node < GCfirstunmarked)) { return node; @@ -1995,5 +2073,5 @@ } - return dword_forwarding_address(dword, tag_n); + return dnode_forwarding_address(dnode, tag_n); } @@ -2031,5 +2109,5 @@ while ((next = *prev) != (LispObj)NULL) { *prev = node_forwarding_address(next); - prev = &(((xmacptr *)(untag(next)))->link); + prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link); } } @@ -2045,7 +2123,7 @@ node = *p; tag_n = fulltag_of(node); - if (tag_n == fulltag_immheader) { + if (immheader_tag_p(tag_n)) { p = (LispObj *) skip_over_ivector((unsigned) p, node); - } else if (tag_n == fulltag_nodeheader) { + } else if (nodeheader_tag_p(tag_n)) { nwords = header_element_count(node); nwords += (1- (nwords&1)); @@ -2096,9 +2174,9 @@ void -forward_memoized_area(area *a, unsigned num_memo_dwords) +forward_memoized_area(area *a, unsigned num_memo_dnodes) { bitvector refbits = a->refbits; LispObj *p = (LispObj *) a->low, x1, x2, new; - unsigned bits, bitidx, *bitsp, nextbit, diff, memo_dword = 0, hash_dword_limit = 0; + unsigned bits, bitidx, *bitsp, nextbit, diff, memo_dnode = 0, hash_dnode_limit = 0; int tag_x1; hash_table_vector_header *hashp = NULL; @@ -2106,5 +2184,5 @@ if (GCDebug) { - check_refmap_consistency(p, p+(num_memo_dwords << 1), refbits); + check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits); } @@ -2114,8 +2192,8 @@ set_bitidx_vars(refbits, 0, bitsp, bits, bitidx); - while (memo_dword < num_memo_dwords) { + while (memo_dnode < num_memo_dnodes) { if (bits == 0) { int remain = 0x20 - bitidx; - memo_dword += remain; + memo_dnode += remain; p += (remain+remain); bits = *++bitsp; @@ -2124,5 +2202,5 @@ nextbit = count_leading_zeros(bits); if ((diff = (nextbit - bitidx)) != 0) { - memo_dword += diff; + memo_dnode += diff; bitidx = nextbit; p += (diff+diff); @@ -2132,5 +2210,5 @@ tag_x1 = fulltag_of(x1); bits &= ~(BIT0_MASK >> bitidx); - header_p = (tag_x1 == fulltag_nodeheader); + header_p = (nodeheader_tag_p(tag_x1)); if (header_p && @@ -2138,5 +2216,5 @@ hashp = (hash_table_vector_header *) p; if (hashp->flags & nhash_track_keys_mask) { - hash_dword_limit = memo_dword + ((header_element_count(x1)+2)>>1); + hash_dnode_limit = memo_dnode + ((header_element_count(x1)+2)>>1); } else { hashp = NULL; @@ -2156,12 +2234,12 @@ if (new != x2) { *p = new; - if (memo_dword < hash_dword_limit) { + if (memo_dnode < hash_dnode_limit) { hashp->flags |= nhash_key_moved_mask; - hash_dword_limit = 0; + hash_dnode_limit = 0; hashp = NULL; } } p++; - memo_dword++; + memo_dnode++; bitidx++; @@ -2170,13 +2248,4 @@ } -void -forward_dohs( void ) -{ - doh_block_ptr doh_block = (doh_block_ptr) lisp_global(DOH_HEAD); - while( doh_block ) { - forward_range( &doh_block->data[0], &doh_block->data[doh_block_slots] ); - doh_block = doh_block->link; - } -} @@ -2306,5 +2375,5 @@ { LispObj *src = (LispObj*) GCfirstunmarked, *dest = src, node, new; - unsigned elements, dword = gc_area_dword(GCfirstunmarked), node_dwords = 0, imm_dwords = 0; + unsigned elements, dnode = gc_area_dnode(GCfirstunmarked), node_dnodes = 0, imm_dnodes = 0; unsigned bitidx, *bitsp, bits, nextbit, diff; int tag; @@ -2314,12 +2383,12 @@ Boolean GCrelocated_code_vector = false; - if (dword < GCndwords_in_area) { + if (dnode < GCndnodes_in_area) { lisp_global(FWDNUM) += (1<>1; - dword += node_dwords; + node_dnodes = (elements+2)>>1; + dnode += node_dnodes; if ((header_subtag(node) == subtag_hash_vector) && (((hash_table_vector_header *) (src-1))->flags & nhash_track_keys_mask)) { @@ -2384,40 +2453,63 @@ *dest++ = node; *dest++ = node_forwarding_address(*src++); - while(--node_dwords) { + while(--node_dnodes) { *dest++ = node_forwarding_address(*src++); *dest++ = node_forwarding_address(*src++); } } - set_bitidx_vars(markbits,dword,bitsp,bits,bitidx); - } else if (tag == fulltag_immheader) { + set_bitidx_vars(markbits,dnode,bitsp,bits,bitidx); + } else if (immheader_tag_p(tag)) { *dest++ = node; *dest++ = *src++; elements = header_element_count(node); tag = header_subtag(node); +#ifdef PPC64 + switch(fulltag_of(tag)) { + case ivector_class_64_bit: + imm_dnodes = ((elements+1)+1)>>1; + break; + case ivector_class_32_bit: + if (tag == subtag_code_vector) { + GCrelocated_code_vector = true; + } + imm_dnodes = (((elements+2)+3)>>2); + break; + case ivector_class_8_bit: + imm_dnodes = (((elements+8)+15)>>4); + break; + case ivector_class_other_bit: + if (tag == subtag_bit_vector) { + imm_dnodes = (((elements+64)+127)>>7); + } else { + imm_dnodes = (((elements+4)+7)>>3); + } + } +#else if (tag <= max_32_bit_ivector_subtag) { if (tag == subtag_code_vector) { GCrelocated_code_vector = true; } - imm_dwords = (((elements+1)+1)>>1); + imm_dnodes = (((elements+1)+1)>>1); } else if (tag <= max_8_bit_ivector_subtag) { - imm_dwords = (((elements+4)+7)>>3); + imm_dnodes = (((elements+4)+7)>>3); } else if (tag <= max_16_bit_ivector_subtag) { - imm_dwords = (((elements+2)+3)>>2); + imm_dnodes = (((elements+2)+3)>>2); } else if (tag == subtag_bit_vector) { - imm_dwords = (((elements+32)+63)>>6); + imm_dnodes = (((elements+32)+63)>>6); } else { - imm_dwords = elements+1; + imm_dnodes = elements+1; } - dword += imm_dwords; - while (--imm_dwords) { +#endif + dnode += imm_dnodes; + while (--imm_dnodes) { *dest++ = *src++; *dest++ = *src++; } - set_bitidx_vars(markbits,dword,bitsp,bits,bitidx); + set_bitidx_vars(markbits,dnode,bitsp,bits,bitidx); } else { *dest++ = node_forwarding_address(node); *dest++ = node_forwarding_address(*src++); bits &= ~(BIT0_MASK >> bitidx); - dword++; + dnode++; bitidx++; } @@ -2427,11 +2519,11 @@ { - unsigned nbytes = (unsigned)dest - (unsigned)GCfirstunmarked; + natural nbytes = (natural)dest - (natural)GCfirstunmarked; if ((nbytes != 0) && GCrelocated_code_vector) { - xMakeDataExecutable((LogicalAddress)GCfirstunmarked, nbytes); - } - } - } - return (LispObj)dest; + xMakeDataExecutable((LogicalAddress)ptr_from_lispobj(GCfirstunmarked), nbytes); + } + } + } + return ptr_to_lispobj(dest); } @@ -2486,5 +2578,5 @@ GCephemeral_low = lisp_global(OLDEST_EPHEMERAL); if (GCephemeral_low) { - GCn_ephemeral_dwords=area_dword(oldfree, GCephemeral_low); + GCn_ephemeral_dnodes=area_dnode(oldfree, GCephemeral_low); update_area_refmaps(oldfree); } else { @@ -2492,5 +2584,5 @@ unprotect_area(oldspace_protected_area); } - GCn_ephemeral_dwords = 0; + GCn_ephemeral_dnodes = 0; } @@ -2531,12 +2623,12 @@ GCmarkbits = a->markbits; - GCarealow = (LispObj) a->low, - GCndwords_in_area = gc_area_dword(oldfree); - - zero_bits(GCmarkbits, GCndwords_in_area); + GCarealow = ptr_to_lispobj(a->low); + GCndnodes_in_area = gc_area_dnode(oldfree); + + zero_bits(GCmarkbits, GCndnodes_in_area); GCweakvll = (LispObj)NULL; - if (GCn_ephemeral_dwords == 0) { + if (GCn_ephemeral_dnodes == 0) { /* For GCTWA, mark the internal package hash table vector of *PACKAGE*, but don't mark its contents. */ @@ -2545,15 +2637,15 @@ itab; unsigned - dword, ndwords; + dnode, ndnodes; pkg = nrs_PACKAGE.vcell; if ((fulltag_of(pkg) == fulltag_misc) && (header_subtag(header_of(pkg)) == subtag_package)) { - itab = ((package *)(untag(pkg)))->itab; + itab = ((package *)ptr_from_lispobj(untag(pkg)))->itab; itabvec = car(itab); - dword = gc_area_dword(itabvec); - if (dword < GCndwords_in_area) { - ndwords = (header_element_count(header_of(itabvec))+1) >> 1; - set_n_bits(GCmarkbits, dword, ndwords); + dnode = gc_area_dnode(itabvec); + if (dnode < GCndnodes_in_area) { + ndnodes = (header_element_count(header_of(itabvec))+1) >> 1; + set_n_bits(GCmarkbits, dnode, ndnodes); } } @@ -2599,5 +2691,5 @@ if (lisp_global(OLDEST_EPHEMERAL)) { - mark_memoized_area(tenured_area, area_dword(a->low,tenured_area->low)); + mark_memoized_area(tenured_area, area_dnode(a->low,tenured_area->low)); } @@ -2609,5 +2701,4 @@ } while (other_tcr != tcr); - mark_dohs(); /* Creole */ @@ -2629,8 +2720,8 @@ if (fulltag_of(sym) == fulltag_misc) { lispsymbol *rawsym = (lispsymbol *)(untag(sym)); - unsigned dword = gc_area_dword(sym); + unsigned dnode = gc_area_dnode(sym); - if ((dword < GCndwords_in_area) && - (!ref_bit(GCmarkbits,dword))) { + if ((dnode < GCndnodes_in_area) && + (!ref_bit(GCmarkbits,dnode))) { /* Symbol is in GC area, not marked. Mark it if fboundp, boundp, or if @@ -2664,9 +2755,9 @@ if (fulltag_of(sym) == fulltag_misc) { lispsymbol *rawsym = (lispsymbol *)(untag(sym)); - unsigned dword = gc_area_dword(sym); - - if ((dword < GCndwords_in_area) && - (!ref_bit(GCmarkbits,dword))) { - *raw = unbound; + unsigned dnode = gc_area_dnode(sym); + + if ((dnode < GCndnodes_in_area) && + (!ref_bit(GCmarkbits,dnode))) { + *raw = unbound_marker; } } @@ -2688,5 +2779,4 @@ } while (other_tcr != tcr); - forward_dohs(); /* Creole */ forward_gcable_ptrs(); @@ -2728,5 +2818,5 @@ if (GCephemeral_low) { - forward_memoized_area(tenured_area, area_dword(a->low, tenured_area->low)); + forward_memoized_area(tenured_area, area_dnode(a->low, tenured_area->low)); } @@ -2802,5 +2892,5 @@ (header_subtag(header_of(val)) == subtag_macptr)) { long long justfreed = oldfree - a->active; - *( (long long *) ((macptr *) (untag(val)))->address) += justfreed; + *( (long long *) ((macptr *) ptr_from_lispobj(untag(val)))->address) += justfreed; } } @@ -2823,12 +2913,32 @@ tag = fulltag_of(header); - if ((tag == fulltag_nodeheader) || - (tag == fulltag_immheader)) { + if ((nodeheader_tag_p(tag)) || + (immheader_tag_p(tag))) { elements = header_element_count(header); - if (tag == fulltag_nodeheader) { + if (nodeheader_tag_p(tag)) { start += ((elements+2) & ~1); } else { subtag = header_subtag(header); +#ifdef PPC64 + switch(fulltag_of(header)) { + case ivector_class_64_bit: + bytes = 8 + (elements<<3); + break; + case ivector_class_32_bit: + bytes = 8 + (elements<<2); + break; + case ivector_class_8_bit: + bytes = 8 + elements; + break; + case ivector_class_other_bit: + default: + if (subtag == subtag_bit_vector) { + bytes = 8 + ((elements+7)>>3); + } else { + bytes = 8 + (elements<<1); + } + } +#else if (subtag <= max_32_bit_ivector_subtag) { bytes = 4 + (elements<<2); @@ -2842,7 +2952,8 @@ bytes = 4 + ((elements+7)>>3); } - bytes = (bytes+7) & ~7; +#endif + bytes = (bytes+dnode_size-1) & ~(dnode_size-1); total += bytes; - start += (bytes >> 2); + start += (bytes >> node_shift); } } else { @@ -2866,5 +2977,5 @@ BytePtr free = dest->active, - *old = (BytePtr *) untag(obj); + *old = (BytePtr *) ptr_from_lispobj(untag(obj)); LispObj header = header_of(obj), @@ -2880,8 +2991,4 @@ break; - case subtag_simple_general_string: - physbytes = 4 + (element_count << 1); - break; - case subtag_code_vector: physbytes = 4 + (element_count << 2); @@ -2895,5 +3002,5 @@ dest->active += physbytes; - new = (LispObj)free+disp; + new = ptr_to_lispobj(free)+disp; memcpy(free, (BytePtr)old, physbytes); @@ -2904,5 +3011,5 @@ look like a header. b) We'd like to be able to forward code-vector locatives, and - it's easiest to do so if we leave a {forward_marker, dword_locative} + it's easiest to do so if we leave a {forward_marker, dnode_locative} pair at every doubleword in the old vector. */ @@ -2934,6 +3041,6 @@ if ((tag == fulltag_misc) && - (((BytePtr)obj) > low) && - (((BytePtr)obj) < high)) { + (((BytePtr)ptr_from_lispobj(obj)) > low) && + (((BytePtr)ptr_from_lispobj(obj)) < high)) { header = deref(obj, 0); if (header == forward_marker) { /* already copied */ @@ -2941,10 +3048,9 @@ } else { header_tag = fulltag_of(header); - if (header_tag == fulltag_immheader) { + if (immheader_tag_p(header_tag)) { header_subtag = header_subtag(header); if (((header_subtag == subtag_code_vector) && (what_to_copy & COPY_CODE)) || ((what_to_copy & COPY_STRINGS) && - ((header_subtag == subtag_simple_base_string) || - (header_subtag == subtag_simple_general_string)))) { + ((header_subtag == subtag_simple_base_string)))) { *ref = purify_object(obj, dest); } @@ -2963,7 +3069,7 @@ tag = fulltag_of(loc); - if (((BytePtr)loc > low) && - ((BytePtr)loc < high)) { - LispObj *p = (LispObj *)(untag(loc)); + if (((BytePtr)ptr_from_lispobj(loc) > low) && + ((BytePtr)ptr_from_lispobj(loc) < high)) { + LispObj *p = (LispObj *)ptr_from_lispobj(untag(loc)); switch (tag) { case fulltag_even_fixnum: @@ -2980,5 +3086,5 @@ header = *p; } while ((header & code_header_mask) != subtag_code_vector); - *locaddr = purify_displaced_object((LispObj)p, to, tag); + *locaddr = purify_displaced_object(ptr_to_lispobj(p), to, tag); } break; @@ -3003,8 +3109,8 @@ } else { tag = fulltag_of(header); - if (tag == fulltag_immheader) { + if (immheader_tag_p(tag)) { start = (LispObj *)skip_over_ivector((unsigned)start, header); } else { - if (tag != fulltag_nodeheader) { + if (!nodeheader_tag_p(tag)) { copy_ivector_reference(start, low, high, to, what); } @@ -3031,5 +3137,5 @@ end != limit; current = next) { - next = (LispObj *) *current; + next = (LispObj *) ptr_from_lispobj(*current); end = ((next >= start) && (next < limit)) ? next : limit; if (current[1] == 0) { @@ -3126,14 +3232,4 @@ } -void -purify_dohs(BytePtr low, BytePtr high, area *to, int what) -{ - doh_block_ptr doh_block = (doh_block_ptr) lisp_global(DOH_HEAD); - while( doh_block ) { - purify_range( &doh_block->data[0], &doh_block->data[doh_block_slots], - low, high, to, what ); - doh_block = doh_block->link; - } -} void @@ -3217,8 +3313,8 @@ while (fulltag_of(pkg_list) == fulltag_cons) { - c = (cons *) untag(pkg_list); - p = (package *) untag(c->car); + c = (cons *) ptr_from_lispobj(untag(pkg_list)); + p = (package *) ptr_from_lispobj(untag(c->car)); pkg_list = c->cdr; - c = (cons *) untag(p->itab); + c = (cons *) ptr_from_lispobj(untag(p->itab)); htab = c->car; elements = header_element_count(header_of(htab)); @@ -3226,9 +3322,9 @@ obj = deref(htab,i); if (fulltag_of(obj) == fulltag_misc) { - rawsym = (lispsymbol *) untag(obj); + rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj)); copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS); } } - c = (cons *) untag(p->etab); + c = (cons *) ptr_from_lispobj(untag(p->etab)); htab = c->car; elements = header_element_count(header_of(htab)); @@ -3236,5 +3332,5 @@ obj = deref(htab,i); if (fulltag_of(obj) == fulltag_misc) { - rawsym = (lispsymbol *) untag(obj); + rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj)); copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS); } @@ -3252,5 +3348,4 @@ } while (other_tcr != tcr); - purify_dohs(a->low, a->active, new_pure_area, COPY_CODE); { @@ -3354,8 +3449,8 @@ header = *start; tag = fulltag_of(header); - if (tag == fulltag_immheader) { + if (immheader_tag_p(tag)) { start = (LispObj *)skip_over_ivector((unsigned)start, header); } else { - if (tag != fulltag_nodeheader) { + if (!nodeheader_tag_p(tag)) { impurify_noderef(start, low, high, delta); } @@ -3408,5 +3503,5 @@ end != limit; current = next) { - next = (LispObj *) *current; + next = (LispObj *) ptr_from_lispobj(*current); end = ((next >= start) && (next < limit)) ? next : limit; if (current[1] == 0) { @@ -3479,14 +3574,14 @@ bcopy(ro_base, oldfree, n); munmap(ro_base, n); - a->ndwords = area_dword(a, a->active); + a->ndnodes = area_dnode(a, a->active); pure_space_active = r->active = r->low; - r->ndwords = 0; - - impurify_areas((LispObj)ro_base, (LispObj)ro_limit, delta); + r->ndnodes = 0; + + impurify_areas(ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta); other_tcr = tcr; do { - impurify_tcr_xframes(other_tcr, (LispObj)ro_base, (LispObj)ro_limit, delta); - impurify_tcr_tlb(other_tcr, (LispObj)ro_base, (LispObj)ro_limit, delta); + impurify_tcr_xframes(other_tcr, ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta); + impurify_tcr_tlb(other_tcr, ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta); other_tcr = other_tcr->next; } while (other_tcr != tcr); Index: /trunk/ccl/lisp-kernel/gc.h =================================================================== --- /trunk/ccl/lisp-kernel/gc.h (revision 556) +++ /trunk/ccl/lisp-kernel/gc.h (revision 557) @@ -38,5 +38,5 @@ extern LispObj GCarealow; -extern unsigned GCndwords_in_area; +extern unsigned GCndnodes_in_area; extern bitvector GCmarkbits; LispObj *global_reloctab, *GCrelocptr; @@ -48,5 +48,5 @@ void mark_locative_root(LispObj); void rmark(LispObj); -unsigned skip_over_ivector(unsigned, LispObj); +LispObj *skip_over_ivector(LispObj, LispObj); void mark_simple_area_range(LispObj *,LispObj *); LispObj calculate_relocation(); @@ -64,10 +64,14 @@ -#define area_dword(w,low) ((((LispObj)w) - (LispObj)low)>>3) -#define gc_area_dword(w) area_dword(w,GCarealow) +#define area_dnode(w,low) (((ptr_to_lispobj(w)) - ptr_to_lispobj(low))>>dnode_shift) +#define gc_area_dnode(w) area_dnode(w,GCarealow) +#ifdef PPC64 +#define forward_marker subtag_forward_marker +#else #define forward_marker fulltag_nil +#endif -#define VOID_ALLOCPTR 0xFFFFFFF8 +#define VOID_ALLOCPTR ((LispObj)(-dnode_size)) Index: /trunk/ccl/lisp-kernel/lisp-exceptions.h =================================================================== --- /trunk/ccl/lisp-kernel/lisp-exceptions.h (revision 556) +++ /trunk/ccl/lisp-kernel/lisp-exceptions.h (revision 557) @@ -87,5 +87,5 @@ -typedef unsigned opcode, *pc; +typedef u_int32_t opcode, *pc; #ifdef LINUX Index: /trunk/ccl/lisp-kernel/lisp.h =================================================================== --- /trunk/ccl/lisp-kernel/lisp.h (revision 556) +++ /trunk/ccl/lisp-kernel/lisp.h (revision 557) @@ -17,4 +17,23 @@ #ifndef __lisp__ #define __lisp__ + +/* + On some platforms (the G5 under Panther when -mpowerpc64 is in effect) + the C compiler belives that pointers are only 32 bits wide, even though + the machine's in 64-bit mode. If that's the case, prepand a gensym'ed + word to any pointer fields in any structure accessed by both C and Lisp + code. + + This means that C and Lisp will have a slightly different notion of the + offset of each such field. The alternative - representing the pointer + as a 64-bit int and casting on every reference - seems just as ugly. +*/ + +#if defined(PPC64) && defined(FOREIGN_POINTER_32BIT) +#define NATURAL_POINTER_FIELD(type,name) unsigned _ ## name; type * name +#else +#define NATURAL_POINTER_FIELD(type,name) type *name; +#endif + #include "lisptypes.h" Index: /trunk/ccl/lisp-kernel/lisp_globals.h =================================================================== --- /trunk/ccl/lisp-kernel/lisp_globals.h (revision 556) +++ /trunk/ccl/lisp-kernel/lisp_globals.h (revision 557) @@ -77,7 +77,11 @@ #define SUBPRIMS_TARGET_N (-257) /* absolute address of subprim 255 jump target */ - +#ifdef PPC64 +#define lisp_global(g) (((LispObj *) 0x2000)[(g)]) +#define nrs_symbol(s) (((lispsymbol *) 0x2000)[(s)]) +#else #define lisp_global(g) (((LispObj *) (nil_value-fulltag_nil))[(g)]) #define nrs_symbol(s) (((lispsymbol *) (nil_value+(8-fulltag_nil)+8))[(s)]) +#endif #define nrs_T (nrs_symbol(0)) /* t */ Index: /trunk/ccl/lisp-kernel/lisptypes.h =================================================================== --- /trunk/ccl/lisp-kernel/lisptypes.h (revision 556) +++ /trunk/ccl/lisp-kernel/lisptypes.h (revision 557) @@ -18,20 +18,39 @@ #define __lisptypes__ -typedef unsigned LispObj; +#include +#ifdef PPC64 +typedef u_int64_t LispObj; +typedef u_int64_t natural; +typedef int64_t signed_natural; +#ifdef FOREIGN_POINTER_32BIT +typedef u_int32_t unsigned_of_pointer_size; +#else +typedef u_int64_t unsigned_of_pointer_size; +#endif +#else +typedef u_int32_t LispObj; +typedef u_int32_t natural; +typedef int32_t signed_natural; +typedef u_int32_t unsigned_of_pointer_size; +#endif typedef struct ucontext ExceptionInformation, ExceptionInformationPowerPC; -typedef char *BytePtr; typedef int OSStatus, OSErr; #define noErr ((OSErr) 0) typedef int Boolean; typedef void *LogicalAddress; -typedef char *StringPtr; -typedef char *Ptr; +typedef char *Ptr, *BytePtr, *StringPtr; typedef unsigned int UInt32; + typedef union { unsigned short halfword; struct { +#ifdef PPC64 + unsigned short offset:13; + unsigned short pad:1; +#else unsigned short offset:14; +#endif unsigned short hasnode:1; unsigned short modified:1; Index: /trunk/ccl/lisp-kernel/macros.h =================================================================== --- /trunk/ccl/lisp-kernel/macros.h (revision 556) +++ /trunk/ccl/lisp-kernel/macros.h (revision 557) @@ -22,4 +22,6 @@ #define __macros__ +#define ptr_to_lispobj(p) ((LispObj)((unsigned_of_pointer_size)(p))) +#define ptr_from_lispobj(o) ((LispObj*)((unsigned_of_pointer_size)(o))) #define lisp_reg_p(reg) ((reg) >= fn) @@ -28,5 +30,5 @@ #define untag(o) ((o) & ~fulltagmask) -#define deref(o,n) (*((LispObj*) ((LispObj *)(untag((LispObj)o)))+(n))) +#define deref(o,n) (*((LispObj*) (ptr_from_lispobj(untag((LispObj)o)))+(n))) #define header_of(o) deref(o,0) @@ -47,4 +49,15 @@ #define FBOUNDP(sym) ((((lispsymbol *)(sym))->fcell) != nrs_UDF.vcell) +#ifdef PPC64 +#define nodeheader_tag_p(tag) (((tag) & lowtag_mask) == lowtag_nodeheader) +#else +#define nodeheader_tag_p(tag) (tag == fulltag_nodeheader) +#endif + +#ifdef PPC64 +#define immheader_tag_p(tag) (((tag) & lowtag_mask) == lowtag_immheader) +#else +#define immheader_tag_p(tag) (tag == fulltag_immheader) +#endif /* lfuns */ Index: /trunk/ccl/lisp-kernel/macros.s =================================================================== --- /trunk/ccl/lisp-kernel/macros.s (revision 556) +++ /trunk/ccl/lisp-kernel/macros.s (revision 557) @@ -59,9 +59,12 @@ ldx $@ ]) + define([ldru],[ + ldu $@ + ]) define([str],[ std $@ ]) define([strx],[ - stdx %@ + stdx $@ ]) define([stru],[ @@ -102,5 +105,5 @@ ]) define([srari],[ - sradi #@ + sradi $@ ]) define([srri],[ @@ -125,4 +128,7 @@ define([ldrx],[ lwzx $@ + ]) + define([ldru],[ + lwzu $@ ]) define([str],[ @@ -169,5 +175,5 @@ ]) define([srari],[ - srawi #@ + srawi $@ ]) define([srri],[ @@ -229,8 +235,8 @@ define([box_fixnum],[ - slwi $1,$2,fixnumshift]) + slri($1,$2,fixnumshift)]) define([unbox_fixnum],[ - srawi $1,$2,fixnumshift]) + srari($1,$2,fixnumshift)]) define([loaddf],[ @@ -294,5 +300,10 @@ /* "Length" is fixnum element count */ define([header_length],[ - rlwinm $1,$2,nbits_in_word-(num_subtag_bits-nfixnumtagbits),(num_subtag_bits-nfixnumtagbits),31-nfixnumtagbits]) +ifdef([PPC64],[ + clrlsldi $1,$2,nbits_in_word-num_subtag_bits,fixnum_shift + ],[ + rlwinm $1,$2,nbits_in_word-(num_subtag_bits-nfixnumtagbits),(num_subtag_bits-nfixnumtagbits),31-nfixnumtagbits + ]) +]) Index: /trunk/ccl/lisp-kernel/pantherg5/Makefile =================================================================== --- /trunk/ccl/lisp-kernel/pantherg5/Makefile (revision 556) +++ /trunk/ccl/lisp-kernel/pantherg5/Makefile (revision 557) @@ -48,9 +48,9 @@ AS = as M4 = gm4 -M4FLAGS = -DDARWIN -DPPC64 -DPANTHERG5 +M4FLAGS = -DDARWIN -DPPC64 -DFOREIGN_POINTER_32BIT ASFLAGS = -force_cpusubtype_ALL -CDEFINES = -DDARWIN $(BROKEN_PREPROCESSOR_WORKAROUND) -DOPENMCL_MAJOR_VERSION=$(OPENMCL_MAJOR_VERSION) -DOPENMCL_MINOR_VERSION=$(OPENMCL_MINOR_VERSION) +CDEFINES = -DPPC64 -DFOREIGN_POINTER_32BIT -DDARWIN $(BROKEN_PREPROCESSOR_WORKAROUND) -DOPENMCL_MAJOR_VERSION=$(OPENMCL_MAJOR_VERSION) -DOPENMCL_MINOR_VERSION=$(OPENMCL_MINOR_VERSION) CDEBUG = -g -COPT = -O2 -mpowerpc64 -DPPC64 -DPANTHERG5 +COPT = -O2 -mpowerpc64 .s.o: @@ -78,5 +78,5 @@ KSPOBJ= $(SPOBJ) -all: ../../dppccl +all: ../../dppccl64 @@ -89,5 +89,5 @@ -../../dppccl: $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) +../../dppccl64: $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(LD) $(LDFLAGS) $(KSPOBJ) $(KERNELOBJ) $(DEBUGOBJ) $(OSLIBS) @@ -115,5 +115,5 @@ cclean: - $(RM) -f $(KERNELOBJ) $(DEBUGOBJ) ../../dppccl + $(RM) -f $(KERNELOBJ) $(DEBUGOBJ) ../../dppccl64 # Some earlier versions of this Makefile built "subprims_r.o". @@ -122,4 +122,4 @@ $(RM) -f $(SPOBJ) $(KSPOBJ) subprims_r.o -strip: ../../dppccl - strip -s retain ../../dppccl +strip: ../../dppccl64 + strip -s retain ../../dppccl64 Index: /trunk/ccl/lisp-kernel/plsym.c =================================================================== --- /trunk/ccl/lisp-kernel/plsym.c (revision 556) +++ /trunk/ccl/lisp-kernel/plsym.c (revision 557) @@ -31,5 +31,4 @@ -unsigned skip_over_ivector(unsigned, LispObj); /* Index: /trunk/ccl/lisp-kernel/pmcl-kernel.c =================================================================== --- /trunk/ccl/lisp-kernel/pmcl-kernel.c (revision 556) +++ /trunk/ccl/lisp-kernel/pmcl-kernel.c (revision 557) @@ -547,5 +547,5 @@ reserved->low += size; reserved->active = reserved->low; - reserved->ndwords -= (size>>3); + reserved->ndnodes -= (size>>dnode_shift); return low; } @@ -600,8 +600,8 @@ { unsigned - ndwords = area_dword(lisp_global(HEAP_END),lisp_global(HEAP_START)), + ndnodes = area_dnode(lisp_global(HEAP_END),lisp_global(HEAP_START)), npages = (lisp_global(HEAP_END)-lisp_global(HEAP_START)) >> 12, - markbits_size = 12+((ndwords+7)>>3), - reloctab_size = (sizeof(LispObj)*(((ndwords+31)>>5)+1)), + markbits_size = 12+((ndnodes+7)>>dnode_shift), + reloctab_size = (sizeof(LispObj)*(((ndnodes+31)>>5)+1)), pagemap_size = align_to_power_of_2(npages*sizeof(pageentry),12); BytePtr @@ -676,5 +676,5 @@ a->high += delta; - a->ndwords = area_dword(a->high, a->low); + a->ndnodes = area_dnode(a->high, a->low); a->hardlimit = a->high; oldspace_protected_area->end = a->high; @@ -697,10 +697,10 @@ a->high -= delta; - a->ndwords = area_dword(a->high, a->low); + a->ndnodes = area_dnode(a->high, a->low); a->hardlimit = a->high; oldspace_protected_area->end = a->high; uncommit_pages(a->high, delta); reserved->low -= delta; - reserved->ndwords += (delta>>3); + reserved->ndnodes += (delta>>dnode_shift); lisp_global(HEAP_END) -= delta; return true; @@ -1185,5 +1185,5 @@ lisp_global(LEXPR_RETURN) = (LispObj)&nvalret; lisp_global(LEXPR_RETURN1V) = (LispObj)&popj; - lisp_global(ALL_AREAS) = (LispObj) (all_areas); + lisp_global(ALL_AREAS) = ptr_to_lispobj(all_areas); @@ -1196,7 +1196,7 @@ - lisp_global(IMAGE_NAME) = (LispObj) image_name; - lisp_global(ARGV) = (LispObj) argv; - lisp_global(KERNEL_IMPORTS) = (LispObj) import_ptrs_base; + lisp_global(IMAGE_NAME) = ptr_to_lispobj(image_name); + lisp_global(ARGV) = ptr_to_lispobj(argv); + lisp_global(KERNEL_IMPORTS) = (LispObj)import_ptrs_base; lisp_global(METERING_INFO) = (LispObj) &lisp_metering; @@ -1204,5 +1204,4 @@ *(double *) &(lisp_global(DOUBLE_FLOAT_ONE)) = (double) 1.0; - lisp_global(ARGV) = (LispObj) argv; lisp_global(HOST_PLATFORM) = (LispObj) #ifdef LINUX @@ -1242,5 +1241,5 @@ tenured_area->younger = g2_area; tenured_area->refbits = a->markbits; - lisp_global(TENURED_AREA) = (LispObj)(tenured_area); + lisp_global(TENURED_AREA) = ptr_to_lispobj(tenured_area); g2_area->threshold = (4<<20); /* 4MB */ g1_area->threshold = (2<<20); /* 2MB */ @@ -1253,5 +1252,5 @@ thread_init_tcr(tcr, current_sp, current_sp-stack_base); - lisp_global(EXCEPTION_LOCK) = (LispObj)new_recursive_lock(); + lisp_global(EXCEPTION_LOCK) = ptr_to_lispobj(new_recursive_lock()); enable_fp_exceptions(); start_vbl(); @@ -1262,5 +1261,5 @@ #endif tcr->prev = tcr->next = tcr; - lisp_global(TCR_LOCK) = (LispObj)new_recursive_lock(); + lisp_global(TCR_LOCK) = ptr_to_lispobj(new_recursive_lock()); lisp_global(INTERRUPT_SIGNAL) = (LispObj) box_fixnum(SIGNAL_FOR_PROCESS_INTERRUPT); tcr->interrupt_level = (-1<