static void
zero_stack(void)
{
- u32 *ptr = (u32 *)current_control_stack_pointer;
+ lispobj *ptr = current_control_stack_pointer;
search:
do {
if (*ptr)
void *
gc_general_alloc(int bytes, int unboxed_p, int quick_p) {
lispobj *new=new_space_free_pointer;
- new_space_free_pointer+=(bytes/4);
+ new_space_free_pointer+=(bytes/N_WORD_BYTES);
return new;
}
user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
-#if 0
- printf("Statistics:\n");
- printf("%10.2f sec of real time\n", real_time);
- printf("%10.2f sec of user time,\n", user_time);
- printf("%10.2f sec of system time.\n", system_time);
-#else
printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
real_time, user_time, system_time);
-#endif
gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
/* before we scavenge the context. */
#ifdef reg_LIP
lip = *os_context_register_addr(context, reg_LIP);
- /* 0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
- lip_offset = 0x7FFFFFFF;
+ /* 0x7FFFFFFF on 32-bit platforms;
+ 0x7FFFFFFFFFFFFFFF on 64-bit platforms */
+ lip_offset = (((unsigned long)1) << (N_WORD_BITS - 1)) - 1;
lip_register_pair = -1;
for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
unsigned long reg;
== (char *)((unsigned long)(fdefn->raw_addr))) {
scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
fdefn->raw_addr =
- (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
+ (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
return sizeof(struct fdefn) / sizeof(lispobj);
}
else
tag = lowtag_of(object);
/* Allocate space. */
- new = gc_general_alloc(nwords*4,ALLOC_BOXED,ALLOC_QUICK);
+ new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK);
/* Copy the object. */
- memcpy(new,native_pointer(object),nwords*4);
+ memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
return make_lispobj(new,tag);
}
}
}
#endif
- else if ((object & 3) == 0) {
+ else if (fixnump(object)) {
/* It's a fixnum: really easy.. */
n_words_scavenged = 1;
} else {
struct code *code, *ncode;
return_pc = (struct simple_fun *) native_pointer(object);
- offset = HeaderValue(return_pc->header) * 4 ;
+ /* FIXME: was times 4, should it really be N_WORD_BYTES? */
+ offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
/* Transport the whole code object */
code = (struct code *) ((unsigned long) return_pc - offset);
struct code *code, *ncode;
fheader = (struct simple_fun *) native_pointer(object);
- offset = HeaderValue(fheader->header) * 4;
+ /* FIXME: was times 4, should it really be N_WORD_BYTES? */
+ offset = HeaderValue(fheader->header) * N_WORD_BYTES;
/* Transport the whole code object */
code = (struct code *) ((unsigned long) fheader - offset);
fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
/* gc.c has more casts here, which may be relevant or alternatively
may be compiler warning defeaters. try
- fdefn->raw_addr =
- (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
+ fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
*/
return sizeof(struct fdefn) / sizeof(lispobj);
} else {
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
return nwords;
}
vector = (struct vector *) native_pointer(object);
length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
return copy_large_unboxed_object(object, nwords);
}
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length + 2, 2);
+ nwords = CEILING(NWORDS(length, 32) + 2, 2);
return nwords;
}
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return nwords;
}
vector = (struct vector *) native_pointer(object);
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return copy_large_unboxed_object(object, nwords);
}
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return nwords;
}
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return nwords;
}
vector = (struct vector *) native_pointer(object);
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return copy_large_unboxed_object(object, nwords);
}
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 2 + 2, 2);
+ nwords = CEILING(NWORDS(length, 64) + 2, 2);
return nwords;
}
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
+ nwords = CEILING(NWORDS(length, 128) + 2, 2);
return nwords;
}
vector = (struct vector *) native_pointer(object);
length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
+ nwords = CEILING(NWORDS(length, 128) + 2, 2);
return copy_large_unboxed_object(object, nwords);
}
vector = (struct vector *) where;
length = fixnum_value(vector->length);
- nwords = CEILING(length * 4 + 2, 2);
+ nwords = CEILING(NWORDS(length, 128) + 2, 2);
return nwords;
}
scav_lose(lispobj *where, lispobj object)
{
lose("no scavenge function for object 0x%08x (widetag 0x%x)",
- (unsigned long)object,
- widetag_of(*(lispobj*)native_pointer(object)));
+ (unsigned long)object,
+ widetag_of(*(lispobj*)native_pointer(object)));
+
return 0; /* bogus return value to satisfy static type checking */
}
trans_vector_unsigned_byte_32;
#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
- trans_vector_unsigned_byte_32;
+ trans_vector_unsigned_byte_64;
#endif
#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
static inline unsigned int
NWORDS(unsigned int x, unsigned int n_bits)
{
- unsigned int elements_per_word = N_WORD_BITS/n_bits;
+ /* A good compiler should be able to constant-fold this whole thing,
+ even with the conditional. */
+ if(n_bits <= N_WORD_BITS) {
+ unsigned int elements_per_word = N_WORD_BITS/n_bits;
- return CEILING(x, elements_per_word)/elements_per_word;
+ return CEILING(x, elements_per_word)/elements_per_word;
+ }
+ else {
+ /* FIXME: should have some sort of assertion that N_WORD_BITS
+ evenly divides n_bits */
+ return x * (n_bits/N_WORD_BITS);
+ }
}
/* FIXME: Shouldn't this be defined in sbcl.h? */
/* If thing is an immediate then this is a cons. */
if (is_lisp_pointer(thing)
- || ((thing & 3) == 0) /* fixnum */
+ || (fixnump(thing))
|| (widetag_of(thing) == BASE_CHAR_WIDETAG)
|| (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
count = 2;
gc_assert(page_table[first_page].first_object_offset == 0);
next_page = first_page;
- remaining_bytes = nwords*4;
+ remaining_bytes = nwords*N_WORD_BYTES;
while (remaining_bytes > PAGE_BYTES) {
gc_assert(page_table[next_page].gen == from_space);
gc_assert(page_table[next_page].allocated == BOXED_PAGE_FLAG);
bytes_allocated -= bytes_freed;
/* Add the region to the new_areas if requested. */
- add_new_area(first_page,0,nwords*4);
+ add_new_area(first_page,0,nwords*N_WORD_BYTES);
return(object);
} else {
tag = lowtag_of(object);
/* Allocate space. */
- new = gc_quick_alloc_large(nwords*4);
+ new = gc_quick_alloc_large(nwords*N_WORD_BYTES);
- memcpy(new,native_pointer(object),nwords*4);
+ memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
/* Return Lisp pointer of new object. */
return ((lispobj) new) | tag;
tag = lowtag_of(object);
/* Allocate space. */
- new = gc_quick_alloc_unboxed(nwords*4);
+ new = gc_quick_alloc_unboxed(nwords*N_WORD_BYTES);
- memcpy(new,native_pointer(object),nwords*4);
+ memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
/* Return Lisp pointer of new object. */
return ((lispobj) new) | tag;
{
int tag;
lispobj *new;
- lispobj *source, *dest;
int first_page;
gc_assert(is_lisp_pointer(object));
gc_assert((nwords & 0x01) == 0);
if ((nwords > 1024*1024) && gencgc_verbose)
- FSHOW((stderr, "/copy_large_unboxed_object: %d bytes\n", nwords*4));
+ FSHOW((stderr, "/copy_large_unboxed_object: %d bytes\n", nwords*N_WORD_BYTES));
/* Check whether it's a large object. */
first_page = find_page_index((void *)object);
gc_assert(page_table[first_page].first_object_offset == 0);
next_page = first_page;
- remaining_bytes = nwords*4;
+ remaining_bytes = nwords*N_WORD_BYTES;
while (remaining_bytes > PAGE_BYTES) {
gc_assert(page_table[next_page].gen == from_space);
gc_assert((page_table[next_page].allocated == UNBOXED_PAGE_FLAG)
"/copy_large_unboxed bytes_freed=%d\n",
bytes_freed));
- generations[from_space].bytes_allocated -= 4*nwords + bytes_freed;
- generations[new_space].bytes_allocated += 4*nwords;
+ generations[from_space].bytes_allocated -= nwords*N_WORD_BYTES + bytes_freed;
+ generations[new_space].bytes_allocated += nwords*N_WORD_BYTES;
bytes_allocated -= bytes_freed;
return(object);
tag = lowtag_of(object);
/* Allocate space. */
- new = gc_quick_alloc_large_unboxed(nwords*4);
-
- dest = new;
- source = (lispobj *) native_pointer(object);
-
- /* Copy the object. */
- while (nwords > 0) {
- dest[0] = source[0];
- dest[1] = source[1];
- dest += 2;
- source += 2;
- nwords -= 2;
- }
+ new = gc_quick_alloc_large_unboxed(nwords*N_WORD_BYTES);
+
+ /* Copy the object. */
+ memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
/* Return Lisp pointer of new object. */
return ((lispobj) new) | tag;
nheader_words = HeaderValue(*(lispobj *)code);
nwords = ncode_words + nheader_words;
- constants_start_addr = (void *)code + 5*4;
- constants_end_addr = (void *)code + nheader_words*4;
- code_start_addr = (void *)code + nheader_words*4;
- code_end_addr = (void *)code + nwords*4;
+ constants_start_addr = (void *)code + 5*N_WORD_BYTES;
+ constants_end_addr = (void *)code + nheader_words*N_WORD_BYTES;
+ code_start_addr = (void *)code + nheader_words*N_WORD_BYTES;
+ code_end_addr = (void *)code + nwords*N_WORD_BYTES;
/* Work through the unboxed code. */
for (p = code_start_addr; p < code_end_addr; p++) {
/* FSHOW((stderr,
"/compiled code object at %x: header words = %d, code words = %d\n",
new_code, nheader_words, ncode_words)); */
- constants_start_addr = (void *)new_code + 5*4;
- constants_end_addr = (void *)new_code + nheader_words*4;
- code_start_addr = (void *)new_code + nheader_words*4;
- code_end_addr = (void *)new_code + nwords*4;
+ constants_start_addr = (void *)new_code + 5*N_WORD_BYTES;
+ constants_end_addr = (void *)new_code + nheader_words*N_WORD_BYTES;
+ code_start_addr = (void *)new_code + nheader_words*N_WORD_BYTES;
+ code_end_addr = (void *)new_code + nwords*N_WORD_BYTES;
/*
FSHOW((stderr,
"/const start = %x, end = %x\n",
/* If it's within the old_code object then it must be an
* absolute fixup (relative ones are not saved) */
if ((old_value >= (unsigned)old_code)
- && (old_value < ((unsigned)old_code + nwords*4)))
+ && (old_value < ((unsigned)old_code + nwords*N_WORD_BYTES)))
/* So add the dispacement. */
*(unsigned *)((unsigned)code_start_addr + offset) =
old_value + displacement;
}
/* Is it plausible cons? */
if ((is_lisp_pointer(start_addr[0])
- || ((start_addr[0] & 3) == 0) /* fixnum */
+ || (fixnump(start_addr[0]))
|| (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
|| (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
&& (is_lisp_pointer(start_addr[1])
- || ((start_addr[1] & 3) == 0) /* fixnum */
+ || (fixnump(start_addr[1]))
|| (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG)
|| (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG)))
break;
gc_assert(page_table[first_page].first_object_offset == 0);
next_page = first_page;
- remaining_bytes = nwords*4;
+ remaining_bytes = nwords*N_WORD_BYTES;
while (remaining_bytes > PAGE_BYTES) {
gc_assert(page_table[next_page].gen == from_space);
gc_assert((page_table[next_page].allocated == BOXED_PAGE_FLAG)
int j;
int wp_it = 1;
void **page_addr = (void **)page_address(page);
- int num_words = page_table[page].bytes_used / 4;
+ int num_words = page_table[page].bytes_used / N_WORD_BYTES;
/* Shouldn't be a free page. */
gc_assert(page_table[page].allocated != FREE_PAGE_FLAG);
/* Work through previous_new_areas. */
for (i = 0; i < previous_new_areas_index; i++) {
- /* FIXME: All these bare *4 and /4 should be something
- * like BYTES_PER_WORD or WBYTES. */
int page = (*previous_new_areas)[i].page;
int offset = (*previous_new_areas)[i].offset;
- int size = (*previous_new_areas)[i].size / 4;
- gc_assert((*previous_new_areas)[i].size % 4 == 0);
+ int size = (*previous_new_areas)[i].size / N_WORD_BYTES;
+ gc_assert((*previous_new_areas)[i].size % N_WORD_BYTES == 0);
scavenge(page_address(page)+offset, size);
}
if (free_bytes > 0) {
int *start_addr = (int *)((unsigned)page_address(page)
+ page_table[page].bytes_used);
- int size = free_bytes / 4;
+ int size = free_bytes / N_WORD_BYTES;
int i;
for (i = 0; i < size; i++) {
if (start_addr[i] != 0) {
* problem.. */
#define QSHOW_SIGNALS 0
-/* FIXME: Make HeaderValue, CONS, SYMBOL, and FDEFN into inline
- * functions instead of macros. */
-
-#define HeaderValue(obj) ((unsigned long) ((obj) >> N_WIDETAG_BITS))
-
-#define CONS(obj) ((struct cons *)((obj)-LIST_POINTER_LOWTAG))
-#define SYMBOL(obj) ((struct symbol *)((obj)-OTHER_POINTER_LOWTAG))
-#define FDEFN(obj) ((struct fdefn *)((obj)-OTHER_POINTER_LOWTAG))
-
/* KLUDGE: These are in theory machine-dependent and OS-dependent, but
* in practice the "foo int" definitions work for all the machines
* that SBCL runs on as of 0.6.7. If we port to the Alpha or some
* other non-32-bit machine we'll probably need real machine-dependent
* and OS-dependent definitions again. */
/* even on alpha, int happens to be 4 bytes. long is longer. */
+/* FIXME: these names really shouldn't reflect their length and this
+ is not quite right for some of the FFI stuff */
+#if 64 == N_WORD_BITS
+typedef unsigned long u32;
+typedef signed long s32;
+#else
typedef unsigned int u32;
typedef signed int s32;
-#define LOW_WORD(c) ((long)(c) & 0xFFFFFFFFL)
+#endif
+
/* this is an integral type the same length as a machine pointer */
typedef unsigned long pointer_sized_uint_t ;
-typedef u32 lispobj;
+/* FIXME: we do things this way because of the alpha32 port. once
+ alpha64 has arrived, all this nastiness can go away */
+#if 64 == N_WORD_BITS
+#define LOW_WORD(c) ((pointer_sized_uint_t)c)
+typedef unsigned long lispobj;
+#else
+#define LOW_WORD(c) ((long)(c) & 0xFFFFFFFFL)
+/* fake it on alpha32 */
+typedef unsigned int lispobj;
+#endif
static inline int
lowtag_of(lispobj obj) {
return obj & WIDETAG_MASK;
}
+static inline unsigned long
+HeaderValue(lispobj obj)
+{
+ return obj >> N_WIDETAG_BITS;
+}
+
+static inline struct cons *
+CONS(lispobj obj)
+{
+ return (struct cons *)(obj - LIST_POINTER_LOWTAG);
+}
+
+static inline struct symbol *
+SYMBOL(lispobj obj)
+{
+ return (struct symbol *)(obj - OTHER_POINTER_LOWTAG);
+}
+
+static inline struct fdefn *
+FDEFN(lispobj obj)
+{
+ return (struct fdefn *)(obj - OTHER_POINTER_LOWTAG);
+}
+
/* Is the Lisp object obj something with pointer nature (as opposed to
* e.g. a fixnum or character or unbound marker)? */
static inline int
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.14.1"
+"0.8.14.2"
projects / sbcl.git / commitdiff