#include <sys/types.h>
#include <stdlib.h>
#include <strings.h>
-#if (defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_LINUX))
-#include <sys/ptrace.h>
-#include <linux/user.h>
-#endif
#include <errno.h>
+#include "sbcl.h"
#include "runtime.h"
#include "os.h"
-#include "sbcl.h"
#include "globals.h"
#include "validate.h"
#include "interrupt.h"
#define PRINTNOISE
-#if defined(__i386__)
+#if defined(LISP_FEATURE_X86)
/* again, what's so special about the x86 that this is differently
* visible there than on other platforms? -dan 20010125
*/
static boolean
dynamic_pointer_p(lispobj ptr)
{
-#ifndef __i386__
+#ifndef LISP_FEATURE_GENCGC
return (ptr >= (lispobj)current_dynamic_space
&&
ptr < (lispobj)dynamic_space_free_pointer);
#endif
}
+static inline lispobj *
+newspace_alloc(int nwords, int constantp)
+{
+ lispobj *ret;
+ nwords=CEILING(nwords,2);
+ if(constantp) {
+ ret=read_only_free;
+ read_only_free+=nwords;
+ } else {
+ ret=static_free;
+ static_free+=nwords;
+ }
+ return ret;
+}
+
+
\f
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
#ifdef LISP_FEATURE_GENCGC
/*
/* FIXME: This is substantially the same code as
* possibly_valid_dynamic_space_pointer in gencgc.c. The only
* relevant difference seems to be that the gencgc code also checks
- * for raw pointers into Code objects */
+ * for raw pointers into Code objects, whereas in purify these are
+ * checked separately in setup_i386_stack_scav - they go onto
+ * valid_stack_ra_locations instead of just valid_stack_locations */
static int
valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
/* Allocate it */
old = (lispobj *)native_pointer(thing);
- if (constant) {
- new = read_only_free;
- read_only_free += CEILING(nwords, 2);
- }
- else {
- new = static_free;
- static_free += CEILING(nwords, 2);
- }
+ new = newspace_alloc(nwords,constant);
/* Copy it. */
bcopy(old, new, nwords * sizeof(lispobj));
* class, and only then can we transport as constant. If it is pure,
* we can ALWAYS transport as a constant. */
static lispobj
-ptrans_instance(lispobj thing, lispobj header, boolean constant)
+ptrans_instance(lispobj thing, lispobj header, boolean /* ignored */ constant)
{
lispobj layout = ((struct instance *)native_pointer(thing))->slots[0];
lispobj pure = ((struct instance *)native_pointer(layout))->slots[15];
/* Allocate it */
old = (lispobj *)native_pointer(thing);
- new = static_free;
- static_free += CEILING(nwords, 2);
+ new = newspace_alloc(nwords, 0); /* inconstant */
/* Copy it. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Allocate it */
old = (lispobj *)native_pointer(thing);
- new = static_free;
- static_free += CEILING(nwords, 2);
+ new = newspace_alloc(nwords, 0); /* inconstant */
/* Copy it. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Allocate it */
old = (lispobj *)native_pointer(thing);
- new = read_only_free;
- read_only_free += CEILING(nwords, 2);
+ new = newspace_alloc(nwords,1); /* always constant */
- /* Copy it. */
+ /* copy it. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
vector = (struct vector *)native_pointer(thing);
nwords = 2 + (CEILING((fixnum_value(vector->length)+extra)*bits,32)>>5);
- if (boxed && !constant) {
- new = static_free;
- static_free += CEILING(nwords, 2);
- }
- else {
- new = read_only_free;
- read_only_free += CEILING(nwords, 2);
- }
-
+ new=newspace_alloc(nwords, (constant || !boxed));
bcopy(vector, new, nwords * sizeof(lispobj));
result = make_lispobj(new, lowtag_of(thing));
return result;
}
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
static void
apply_code_fixups_during_purify(struct code *old_code, struct code *new_code)
{
code = (struct code *)native_pointer(thing);
nwords = HeaderValue(code->header) + fixnum_value(code->code_size);
- new = (struct code *)read_only_free;
- read_only_free += CEILING(nwords, 2);
+ new = (struct code *)newspace_alloc(nwords,1); /* constant */
bcopy(code, new, nwords * sizeof(lispobj));
/* Arrange to scavenge the debug info later. */
pscav_later(&new->debug_info, 1);
- if (new->trace_table_offset & 0x3)
+ /* FIXME: why would this be a fixnum? */
+ /* "why" is a hard word, but apparently for compiled functions the
+ trace_table_offset contains the length of the instructions, as
+ a fixnum. See CODE-INST-AREA-LENGTH in
+ src/compiler/target-disassem.lisp. -- CSR, 2004-01-08 */
+ if (!(fixnump(new->trace_table_offset)))
#if 0
- pscav(&new->trace_table_offset, 1, 0);
+ pscav(&new->trace_table_offset, 1, 0);
#else
- new->trace_table_offset = NIL; /* limit lifetime */
+ new->trace_table_offset = NIL; /* limit lifetime */
#endif
/* Scavenge the constants. */
gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
gc_assert(!dynamic_pointer_p(func));
-#ifdef __i386__
- /* Temporarly convert the self pointer to a real function pointer. */
+#ifdef LISP_FEATURE_X86
+ /* Temporarily convert the self pointer to a real function pointer. */
((struct simple_fun *)native_pointer(func))->self
-= FUN_RAW_ADDR_OFFSET;
#endif
pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1);
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
((struct simple_fun *)native_pointer(func))->self
+= FUN_RAW_ADDR_OFFSET;
#endif
* Otherwise we have to do something strange, 'cause it is buried
* inside a code object. */
- if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG ||
- widetag_of(header) == CLOSURE_FUN_HEADER_WIDETAG) {
+ if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG) {
/* We can only end up here if the code object has not been
* scavenged, because if it had been scavenged, forwarding pointers
nwords = 1 + HeaderValue(header);
old = (lispobj *)native_pointer(thing);
- /* Allocate the new one. */
- if (widetag_of(header) == FUNCALLABLE_INSTANCE_HEADER_WIDETAG) {
- /* FINs *must* not go in read_only space. */
- new = static_free;
- static_free += CEILING(nwords, 2);
- }
- else {
- /* Closures can always go in read-only space, 'cause they
- * never change. */
+ /* Allocate the new one. FINs *must* not go in read_only
+ * space. Closures can; they never change */
- new = read_only_free;
- read_only_free += CEILING(nwords, 2);
- }
+ new = newspace_alloc
+ (nwords,(widetag_of(header)!=FUNCALLABLE_INSTANCE_HEADER_WIDETAG));
+
/* Copy it. */
bcopy(old, new, nwords * sizeof(lispobj));
struct cons *old, *new, *orig;
int length;
- if (constant)
- orig = (struct cons *)read_only_free;
- else
- orig = (struct cons *)static_free;
+ orig = newspace_alloc(0,constant);
length = 0;
do {
/* Allocate a new cons cell. */
old = (struct cons *)native_pointer(thing);
- if (constant) {
- new = (struct cons *)read_only_free;
- read_only_free += WORDS_PER_CONS;
- }
- else {
- new = (struct cons *)static_free;
- static_free += WORDS_PER_CONS;
- }
+ new = (struct cons *) newspace_alloc(WORDS_PER_CONS,constant);
/* Copy the cons cell and keep a pointer to the cdr. */
new->car = old->car;
#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
return ptrans_vector(thing, 96, 0, 0, constant);
#endif
#ifdef sparc
#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
return ptrans_vector(thing, 192, 0, 0, constant);
#endif
#ifdef sparc
return sizeof(struct fdefn) / sizeof(lispobj);
}
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
/* now putting code objects in static space */
static int
pscav_code(struct code*code)
gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
gc_assert(!dynamic_pointer_p(func));
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
/* Temporarily convert the self pointer to a real function
* pointer. */
((struct simple_fun *)native_pointer(func))->self
-= FUN_RAW_ADDR_OFFSET;
#endif
pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1);
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
((struct simple_fun *)native_pointer(func))->self
+= FUN_RAW_ADDR_OFFSET;
#endif
}
count = 1;
}
- else if (thing & 3) {
+ else if (thing & 3) { /* FIXME: 3? not 2? */
/* It's an other immediate. Maybe the header for an unboxed */
/* object. */
switch (widetag_of(thing)) {
#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
vector = (struct vector *)addr;
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
count = fixnum_value(vector->length)*3+2;
#endif
#ifdef sparc
#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
vector = (struct vector *)addr;
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
count = fixnum_value(vector->length)*6+2;
#endif
#ifdef sparc
#endif
case CODE_HEADER_WIDETAG:
-#ifndef __i386__
+#ifndef LISP_FEATURE_X86
gc_abort(); /* no code headers in static space */
#else
count = pscav_code((struct code*)addr);
break;
case SIMPLE_FUN_HEADER_WIDETAG:
- case CLOSURE_FUN_HEADER_WIDETAG:
case RETURN_PC_HEADER_WIDETAG:
/* We should never hit any of these, 'cause they occur
* buried in the middle of code objects. */
gc_abort();
break;
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
case CLOSURE_HEADER_WIDETAG:
case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
/* The function self pointer needs special care on the
struct later *laters, *next;
struct thread *thread;
+ if(all_threads->next) {
+ /* FIXME: there should be _some_ sensible error reporting
+ * convention. See following comment too */
+ fprintf(stderr,"Can't purify when more than one thread exists\n");
+ fflush(stderr);
+ return 0;
+ }
+
#ifdef PRINTNOISE
printf("[doing purification:");
fflush(stdout);
return 0;
}
-#if defined(__i386__)
+#if defined(LISP_FEATURE_X86)
dynamic_space_free_pointer =
(lispobj*)SymbolValue(ALLOCATION_POINTER,0);
#endif
#endif
#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86))
-#if 0
- /* This is what we should do, but can't unless the threads in
- * question are suspended with ptrace. That's right, purify is not
- * threadsafe
- */
- for_each_thread(thread) {
- void **ptr;
- struct user_regs_struct regs;
- if(ptrace(PTRACE_GETREGS,thread->pid,0,®s)){
- fprintf(stderr,"child pid %d, %s\n",thread->pid,strerror(errno));
- lose("PTRACE_GETREGS");
- }
- setup_i386_stack_scav(regs.ebp,
- ((void *)thread->control_stack_end));
- }
-#endif /* 0 */
- /* stopgap until we can set things up as in preceding comment */
+ /* note this expects only one thread to be active. We'd have to
+ * stop all the others in the same way as GC does if we wanted
+ * PURIFY to work when >1 thread exists */
setup_i386_stack_scav(((&static_roots)-2),
((void *)all_threads->control_stack_end));
#endif
printf(" stack");
fflush(stdout);
#endif
-#ifndef __i386__
+#ifndef LISP_FEATURE_X86
pscav((lispobj *)all_threads->control_stack_start,
current_control_stack_pointer -
all_threads->control_stack_start,
printf(" bindings");
fflush(stdout);
#endif
-#if !defined(__i386__)
+#if !defined(LISP_FEATURE_X86)
pscav( (lispobj *)all_threads->binding_stack_start,
(lispobj *)current_binding_stack_pointer -
all_threads->binding_stack_start,
/* Zero the stack. Note that the stack is also zeroed by SUB-GC
* calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */
-#ifndef __i386__
+#ifndef LISP_FEATURE_X86
os_zero((os_vm_address_t) current_control_stack_pointer,
(os_vm_size_t)
((all_threads->control_stack_end -
SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0);
SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0);
-#if !defined(__i386__)
+#if !defined(LISP_FEATURE_X86)
dynamic_space_free_pointer = current_dynamic_space;
set_auto_gc_trigger(bytes_consed_between_gcs);
#else
projects / sbcl.git / blobdiff