[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-01-11-gd490020
Raymond Toy
rtoy at common-lisp.net
Fri Jan 27 05:06:37 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via d490020d261f746a63a0e2ae9a18c903c2570ff5 (commit)
via 838ff560a8554b7c4c866dacd614d8fa7560426c (commit)
via 7ceabd5050dd2d025180d06deecd96bdc6630503 (commit)
via e7997cb61e640d0cdd3852949b91bc1931203d3c (commit)
via 9dcff02ed5ae1d8fa31728e84b0d017337f75446 (commit)
from 768980ba86fe3e262da0016be08a89668f3e6157 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit d490020d261f746a63a0e2ae9a18c903c2570ff5
Merge: 7ceabd5 838ff56
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Jan 26 20:15:40 2012 -0800
Merge branch 'master' of ssh://diapentepomum/~rtoym/src/cmucl/git/cmucl into ppc-update
commit 838ff560a8554b7c4c866dacd614d8fa7560426c
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Jan 26 21:13:15 2012 -0700
Update code to work with 10.4 as well as 10.5. Merge latest code
to work with ppc.
diff --git a/src/lisp/Config.ppc_darwin b/src/lisp/Config.ppc_darwin
index 8609a4d..da9737a 100644
--- a/src/lisp/Config.ppc_darwin
+++ b/src/lisp/Config.ppc_darwin
@@ -12,7 +12,7 @@ CPPFLAGS = -I. -I$(PATH1)
# concatenate tokens which reguires the -traditional flag.
# Build for OSX 10.2.8 or later. (Is this what we want?)
-#OSX_VERSION=-mmacosx-version-min=10.2
+OSX_VERSION=-mmacosx-version-min=10.4
CC = gcc
LD = ld
NM = $(PATH1)/darwin-nm
diff --git a/src/lisp/Darwin-os.c b/src/lisp/Darwin-os.c
index 728324a..2da3d83 100644
--- a/src/lisp/Darwin-os.c
+++ b/src/lisp/Darwin-os.c
@@ -113,7 +113,52 @@ os_init(const char *argv[], const char *envp[])
#endif
}
+
#if defined(__ppc__)
+#if __DARWIN_UNIX03
+ /* Nothing needed for 10.5 */
+#else
+/* For 10.4 */
+#define __ss ss
+#define __r0 r0
+#define __r1 r1
+#define __r2 r2
+#define __r3 r3
+#define __r4 r4
+#define __r5 r5
+#define __r6 r6
+#define __r7 r7
+#define __r8 r8
+#define __r9 r9
+#define __r10 r10
+#define __r11 r11
+#define __r12 r12
+#define __r13 r13
+#define __r14 r14
+#define __r15 r15
+#define __r16 r16
+#define __r17 r17
+#define __r18 r18
+#define __r19 r19
+#define __r20 r20
+#define __r21 r21
+#define __r22 r22
+#define __r23 r23
+#define __r24 r24
+#define __r25 r25
+#define __r26 r26
+#define __r27 r27
+#define __r28 r28
+#define __r29 r29
+#define __r30 r30
+#define __r31 r31
+#define __lr lr
+#define __ctr ctr
+#define __es es
+#define __dar dar
+#define __dsisr dsisr
+#endif
+
unsigned long *
sc_reg(os_context_t * context, int offset)
{
@@ -466,23 +511,24 @@ sigbus_handle_now(HANDLER_ARGS)
static void
sigbus_handler(HANDLER_ARGS)
{
+ os_context_t *os_context = (os_context_t *) context;
#if defined(GENCGC)
caddr_t fault_addr = code->si_addr;
#endif
#ifdef RED_ZONE_HIT
- if (os_control_stack_overflow((void *) fault_addr, context))
+ if (os_control_stack_overflow((void *) fault_addr, os_context))
return;
#endif
#ifdef __ppc__
DPRINTF(0, (stderr, "sigbus:\n"));
- DPRINTF(0, (stderr, " PC = %p\n", SC_PC(context)));
- DPRINTF(0, (stderr, " ALLOC-TN = %p\n", SC_REG(context, reg_ALLOC)));
- DPRINTF(0, (stderr, " CODE-TN = %p\n", SC_REG(context, reg_CODE)));
- DPRINTF(0, (stderr, " LRA-TN = %p\n", SC_REG(context, reg_LRA)));
- DPRINTF(0, (stderr, " CFP-TN = %p\n", SC_REG(context, reg_CFP)));
- DPRINTF(0, (stderr, " FDEFN-TN = %p\n", SC_REG(context, reg_FDEFN)));
+ DPRINTF(0, (stderr, " PC = %p\n", SC_PC(os_context)));
+ DPRINTF(0, (stderr, " ALLOC-TN = %p\n", SC_REG(os_context, reg_ALLOC)));
+ DPRINTF(0, (stderr, " CODE-TN = %p\n", SC_REG(os_context, reg_CODE)));
+ DPRINTF(0, (stderr, " LRA-TN = %p\n", SC_REG(os_context, reg_LRA)));
+ DPRINTF(0, (stderr, " CFP-TN = %p\n", SC_REG(os_context, reg_CFP)));
+ DPRINTF(0, (stderr, " FDEFN-TN = %p\n", SC_REG(os_context, reg_FDEFN)));
DPRINTF(0, (stderr, " foreign_function_call = %d\n", foreign_function_call_active));
#endif
@@ -494,16 +540,16 @@ sigbus_handler(HANDLER_ARGS)
if (gc_write_barrier(code->si_addr))
return;
#else
- if (interrupt_maybe_gc(signal, code, context))
+ if (interrupt_maybe_gc(signal, code, os_context))
return;
#endif
/* a *real* protection fault */
fprintf(stderr, "sigbus_handler: Real protection violation at %p, PC = %p\n",
- fault_addr, (void *) SC_PC(context));
- sigbus_handle_now(signal, code, context);
+ fault_addr, (void *) SC_PC(os_context));
+ sigbus_handle_now(signal, code, os_context);
#ifdef __ppc__
/* Work around G5 bug; fix courtesy gbyers via chandler */
- sigreturn(context);
+ sigreturn(os_context);
#endif
}
diff --git a/src/lisp/ppc-arch.c b/src/lisp/ppc-arch.c
index 9b3963d..a7267fc 100644
--- a/src/lisp/ppc-arch.c
+++ b/src/lisp/ppc-arch.c
@@ -59,9 +59,10 @@ arch_init(fpu_mode_t mode)
os_vm_address_t arch_get_bad_addr(HANDLER_ARGS)
{
+ os_context_t *os_context = (os_context_t *) context;
os_vm_address_t addr;
- addr = (os_vm_address_t) SC_REG(context, PT_DAR);
+ addr = (os_vm_address_t) SC_REG(os_context, PT_DAR);
return addr;
}
@@ -372,11 +373,12 @@ handle_allocation_trap(os_context_t * context)
static void
sigill_handler(HANDLER_ARGS)
{
+ os_context_t *os_context = (os_context_t *) context;
int badinst;
int opcode;
- sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0);
- opcode = *((int *) SC_PC(context));
+ sigprocmask(SIG_SETMASK, &os_context->uc_sigmask, 0);
+ opcode = *((int *) SC_PC(os_context));
#if 0
printf("SIGILL entry: opcode = 0x%08x\n", opcode);
@@ -387,26 +389,26 @@ sigill_handler(HANDLER_ARGS)
/* Got a twnei reg_NL3,0 - check for deferred interrupt */
#if 1
/* Clear the pseudo-atomic-interrupted bit */
- SC_REG(context, reg_ALLOC) &= ~1;
+ SC_REG(os_context, reg_ALLOC) &= ~1;
#else
- (SC_REG(context, reg_ALLOC) -= PSEUDO_ATOMIC_INTERRUPTED_BIAS);
+ (SC_REG(os_context, reg_ALLOC) -= PSEUDO_ATOMIC_INTERRUPTED_BIAS);
#endif
- arch_skip_instruction(context);
- interrupt_handle_pending(context);
+ arch_skip_instruction(os_context);
+ interrupt_handle_pending(os_context);
#ifdef DARWIN
/* Work around G5 bug; fix courtesy gbyers via chandler */
- sigreturn(context);
+ sigreturn(os_context);
#endif
return;
}
/* Is this an allocation trap? */
#ifdef GENCGC
- if (allocation_trap_p(context)) {
- handle_allocation_trap(context);
- arch_skip_instruction(context);
+ if (allocation_trap_p(os_context)) {
+ handle_allocation_trap(os_context);
+ arch_skip_instruction(os_context);
#ifdef DARWIN
- sigreturn(context);
+ sigreturn(os_context);
#endif
return;
}
@@ -423,18 +425,18 @@ sigill_handler(HANDLER_ARGS)
switch (trap) {
case trap_Halt:
- fake_foreign_function_call(context);
+ fake_foreign_function_call(os_context);
lose("%%primitive halt called; the party is over.\n");
case trap_Error:
case trap_Cerror:
- interrupt_internal_error(signal, code, context,
+ interrupt_internal_error(signal, code, os_context,
trap == trap_Cerror);
break;
case trap_PendingInterrupt:
- arch_skip_instruction(context);
- interrupt_handle_pending(context);
+ arch_skip_instruction(os_context);
+ interrupt_handle_pending(os_context);
break;
case trap_Breakpoint:
@@ -442,7 +444,7 @@ sigill_handler(HANDLER_ARGS)
printf("trap_Breakpoint\n");
fflush(stdout);
#endif
- handle_breakpoint(signal, code, context);
+ handle_breakpoint(signal, code, os_context);
break;
case trap_FunctionEndBreakpoint:
@@ -450,8 +452,8 @@ sigill_handler(HANDLER_ARGS)
printf("trap_FunctionEndBreakpoint\n");
fflush(stdout);
#endif
- SC_PC(context) =
- (int) handle_function_end_breakpoint(signal, code, context);
+ SC_PC(os_context) =
+ (int) handle_function_end_breakpoint(signal, code, os_context);
break;
case trap_AfterBreakpoint:
@@ -459,45 +461,45 @@ sigill_handler(HANDLER_ARGS)
fprintf(stderr, "trap_AfterBreakpoint: break_addr = %p\n",
skipped_break_addr);
fprintf(stderr, " CSP = %p\n",
- (void *) SC_REG(context, reg_CSP));
+ (void *) SC_REG(os_context, reg_CSP));
fprintf(stderr, " CFP = %p\n",
- (void *) SC_REG(context, reg_CFP));
+ (void *) SC_REG(os_context, reg_CFP));
fprintf(stderr, " OCFP = %p\n",
- (void *) SC_REG(context, reg_OCFP));
+ (void *) SC_REG(os_context, reg_OCFP));
#endif
/* Put our breakpoint instruction back in */
*skipped_break_addr = TWLLEI_R0(trap_Breakpoint);
skipped_break_addr = NULL;
- *(unsigned long *) SC_PC(context) = displaced_after_inst;
- context->uc_sigmask = orig_sigmask;
+ *(unsigned long *) SC_PC(os_context) = displaced_after_inst;
+ os_context->uc_sigmask = orig_sigmask;
- os_flush_icache((os_vm_address_t) SC_PC(context),
+ os_flush_icache((os_vm_address_t) SC_PC(os_context),
sizeof(unsigned long));
break;
default:
- interrupt_handle_now(signal, code, context);
+ interrupt_handle_now(signal, code, os_context);
break;
}
#ifdef DARWIN
/* Work around G5 bug; fix courtesy gbyers via chandler */
- sigreturn(context);
+ sigreturn(os_context);
#endif
return;
}
if (((opcode >> 26) == 3) && (((opcode >> 21) & 31) == 24)) {
- interrupt_internal_error(signal, code, context, 0);
+ interrupt_internal_error(signal, code, os_context, 0);
#ifdef DARWIN
/* Work around G5 bug; fix courtesy gbyers via chandler */
- sigreturn(context);
+ sigreturn(os_context);
#endif
return;
}
- interrupt_handle_now(signal, code, context);
+ interrupt_handle_now(signal, code, os_context);
#ifdef DARWIN
/* Work around G5 bug; fix courtesy gbyers via chandler */
- sigreturn(context);
+ sigreturn(os_context);
#endif
}
diff --git a/src/lisp/ppc-lispregs.h b/src/lisp/ppc-lispregs.h
index b593c1f..09aec88 100644
--- a/src/lisp/ppc-lispregs.h
+++ b/src/lisp/ppc-lispregs.h
@@ -107,8 +107,13 @@
#ifndef LANGUAGE_ASSEMBLY
#if defined DARWIN
#define SC_REG(sc,reg) (*sc_reg(sc,reg))
+#if __DARWIN_UNIX03
+/* For 10.5 */
#define SC_PC(sc) (sc->uc_mcontext->__ss.__srr0)
#else
+#define SC_PC(sc) (sc->uc_mcontext->ss.srr0)
+#endif
+#else
#define SC_REG(sc,reg) (((unsigned long *)(sc->regs))[(reg)])
#define SC_PC(sc) (((unsigned long *)(sc->regs))[PT_NIP])
#endif
commit 7ceabd5050dd2d025180d06deecd96bdc6630503
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Jan 26 19:41:38 2012 -0800
Update so we can build on darwin/x86 again.
diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 3297725..6e5d63b 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -1180,7 +1180,7 @@
frame)))))
-#+(or sparc (and x86 darwin) (and (or x86 amd64) linux))
+#+(or sparc (and x86 (or darwin solaris netbsd)) (and (or x86 amd64) linux))
(defun find-foreign-function-name (address)
"Return a string describing the foreign function near ADDRESS"
(let ((addr (sys:sap-int address)))
@@ -1203,7 +1203,7 @@
(alien:slot info 'filename)
)))))))
-#-(or sparc (and x86 darwin) (and (or x86 amd64) linux))
+#-(or sparc (and x86 (or darwin solaris netbsd)) (and (or x86 amd64) linux))
(defun find-foreign-function-name (ra)
(declare (ignore ra))
"Foreign function call land")
commit e7997cb61e640d0cdd3852949b91bc1931203d3c
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Jan 26 18:43:56 2012 -0800
Update so we can build on darwin/x86 again.
diff --git a/src/lisp/Darwin-os.c b/src/lisp/Darwin-os.c
index cceaa55..728324a 100644
--- a/src/lisp/Darwin-os.c
+++ b/src/lisp/Darwin-os.c
@@ -101,6 +101,10 @@ timebase_init(void)
void
+os_init0(const char *argv[], const char *envp[])
+{}
+
+void
os_init(const char *argv[], const char *envp[])
{
os_vm_page_size = OS_VM_DEFAULT_PAGESIZE;
@@ -223,6 +227,16 @@ sc_reg(os_context_t * context, int offset)
#define __fpu_fcw fpu_fcw
#define __fpu_fsw fpu_fsw
#define __fpu_mxcsr fpu_mxcsr
+#ifdef FEATURE_SSE2
+#define __fpu_xmm0 fpu_xmm0
+#define __fpu_xmm1 fpu_xmm1
+#define __fpu_xmm2 fpu_xmm2
+#define __fpu_xmm3 fpu_xmm3
+#define __fpu_xmm4 fpu_xmm4
+#define __fpu_xmm5 fpu_xmm5
+#define __fpu_xmm6 fpu_xmm6
+#define __fpu_xmm7 fpu_xmm7
+#endif
#endif
unsigned long *
@@ -275,6 +289,24 @@ os_sigcontext_fpu_reg(ucontext_t *scp, int index)
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm6;
case 7:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7;
+#ifdef FEATURE_SSE2
+ case 8:
+ return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm0;
+ case 9:
+ return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm1;
+ case 10:
+ return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm2;
+ case 11:
+ return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm3;
+ case 12:
+ return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm4;
+ case 13:
+ return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm5;
+ case 14:
+ return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm6;
+ case 15:
+ return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7;
+#endif
}
return NULL;
}
@@ -413,18 +445,23 @@ valid_addr(os_vm_address_t addr)
newaddr = os_trunc_to_page(addr);
- if (in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE)
- || in_range_p(addr, STATIC_SPACE_START, STATIC_SPACE_SIZE)
+ if (in_range_p(addr, READ_ONLY_SPACE_START, read_only_space_size)
+ || in_range_p(addr, STATIC_SPACE_START, static_space_size)
|| in_range_p(addr, DYNAMIC_0_SPACE_START, dynamic_space_size)
#ifndef GENCGC
|| in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size)
#endif
- || in_range_p(addr, CONTROL_STACK_START, CONTROL_STACK_SIZE)
- || in_range_p(addr, BINDING_STACK_START, BINDING_STACK_SIZE))
+ || in_range_p(addr, CONTROL_STACK_START, control_stack_size)
+ || in_range_p(addr, BINDING_STACK_START, binding_stack_size))
return TRUE;
return FALSE;
}
+static void
+sigbus_handle_now(HANDLER_ARGS)
+{
+ interrupt_handle_now(signal, code, context);
+}
static void
sigbus_handler(HANDLER_ARGS)
@@ -433,6 +470,11 @@ sigbus_handler(HANDLER_ARGS)
caddr_t fault_addr = code->si_addr;
#endif
+#ifdef RED_ZONE_HIT
+ if (os_control_stack_overflow((void *) fault_addr, context))
+ return;
+#endif
+
#ifdef __ppc__
DPRINTF(0, (stderr, "sigbus:\n"));
DPRINTF(0, (stderr, " PC = %p\n", SC_PC(context)));
@@ -456,8 +498,9 @@ sigbus_handler(HANDLER_ARGS)
return;
#endif
/* a *real* protection fault */
- fprintf(stderr, "sigbus_handler: Real protection violation: %p\n", fault_addr);
- interrupt_handle_now(signal, code, context);
+ fprintf(stderr, "sigbus_handler: Real protection violation at %p, PC = %p\n",
+ fault_addr, (void *) SC_PC(context));
+ sigbus_handle_now(signal, code, context);
#ifdef __ppc__
/* Work around G5 bug; fix courtesy gbyers via chandler */
sigreturn(context);
@@ -495,3 +538,11 @@ os_dlsym(const char *sym_name, lispobj lib_list)
return sym_addr;
}
+
+#ifdef i386
+boolean
+os_support_sse2()
+{
+ return TRUE;
+}
+#endif
diff --git a/src/lisp/Darwin-os.h b/src/lisp/Darwin-os.h
index fb84f1c..99bd96b 100644
--- a/src/lisp/Darwin-os.h
+++ b/src/lisp/Darwin-os.h
@@ -14,7 +14,7 @@
#include <sys/mman.h>
#include <sys/signal.h>
#include <signal.h>
-#include <ucontext.h>
+#include <sys/ucontext.h>
#include <mach/vm_types.h>
typedef caddr_t os_vm_address_t;
@@ -28,14 +28,18 @@ typedef int os_vm_prot_t;
#define OS_VM_DEFAULT_PAGESIZE 4096
-#define HANDLER_ARGS int signal, siginfo_t *code, os_context_t *context
+#define HANDLER_ARGS int signal, siginfo_t *code, void *context
#define CODE(code) ((code) ? code->si_code : 0)
#define os_context_t ucontext_t
#ifdef __i386__
#define RESTORE_FPU(context) restore_fpu(context)
#endif
+#ifdef __ppc__
unsigned long *sc_reg(os_context_t *, int);
+#else
+int *sc_reg(os_context_t *, int);
+#endif
void restore_fpu(ucontext_t *);
#define PROTECTION_VIOLATION_SIGNAL SIGBUS
diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c
index 36683a1..f8aed88 100644
--- a/src/lisp/gencgc.c
+++ b/src/lisp/gencgc.c
@@ -169,20 +169,20 @@ check_escaped_stack_object(lispobj * where, lispobj obj)
if (Pointerp(obj)
&& (p = (void *) PTR(obj),
(p >= (void *) CONTROL_STACK_START
- && p < (void *) CONTROL_STACK_END))) {
+ && p < (void *) control_stack_end))) {
char *space;
if (where >= (lispobj *) DYNAMIC_0_SPACE_START
- && where < (lispobj *) (DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE))
+ && where < (lispobj *) (DYNAMIC_0_SPACE_START + dynamic_space_size))
space = "dynamic space";
else if (where >= (lispobj *) STATIC_SPACE_START
&& where <
- (lispobj *) (STATIC_SPACE_START + STATIC_SPACE_SIZE)) space =
+ (lispobj *) (STATIC_SPACE_START + static_space_size)) space =
"static space";
else if (where >= (lispobj *) READ_ONLY_SPACE_START
&& where <
(lispobj *) (READ_ONLY_SPACE_START +
- READ_ONLY_SPACE_SIZE)) space = "read-only space";
+ read_only_space_size)) space = "read-only space";
else
space = NULL;
@@ -198,7 +198,7 @@ check_escaped_stack_object(lispobj * where, lispobj obj)
(unsigned long) obj, where, space);
#ifndef i386
else if ((where >= (lispobj *) CONTROL_STACK_START
- && where < (lispobj *) (CONTROL_STACK_END))
+ && where < (lispobj *) (control_stack_end))
|| (space == NULL)) {
/* Do nothing if it the reference is from the control stack,
because that will happen, and that's ok. Or if it's from
@@ -2003,7 +2003,7 @@ read_only_space_p(lispobj obj)
static inline boolean
control_stack_space_p(lispobj obj)
{
- lispobj end = CONTROL_STACK_START + CONTROL_STACK_SIZE;
+ lispobj end = CONTROL_STACK_START + control_stack_size;
return (obj >= CONTROL_STACK_START) && (obj < end);
}
@@ -2011,7 +2011,7 @@ control_stack_space_p(lispobj obj)
static inline boolean
binding_stack_space_p(lispobj obj)
{
- lispobj end = BINDING_STACK_START + BINDING_STACK_SIZE;
+ lispobj end = BINDING_STACK_START + binding_stack_size;
return (obj >= BINDING_STACK_START) && (obj < end);
}
@@ -2078,8 +2078,10 @@ other_space_p(lispobj obj)
in_space = TRUE;
}
#elif defined(__ppc__)
- /*
- */
+ /*
+ * For ppc, just ignore anything below fpu_restore, which is
+ * currently at the end of ppc-assem.S.
+ */
if (obj <= (lispobj) &fpu_restore) {
in_space = TRUE;
}
@@ -7323,11 +7325,11 @@ garbage_collect_generation(int generation, int raise)
#ifdef GC_ASSERTIONS
#if defined(i386) || defined(__x86_64)
- invalid_stack_start = (void *) CONTROL_STACK_START;
+ invalid_stack_start = (void *) control_stack_start;
invalid_stack_end = (void *) &raise;
#else /* not i386 */
invalid_stack_start = (void *) &raise;
- invalid_stack_end = (void *) CONTROL_STACK_END;
+ invalid_stack_end = (void *) control_stack_end;
#endif /* not i386 */
#endif /* GC_ASSERTIONS */
@@ -7387,7 +7389,7 @@ garbage_collect_generation(int generation, int raise)
{
lispobj **ptr;
- for (ptr = (lispobj **) CONTROL_STACK_END - 1;
+ for (ptr = (lispobj **) control_stack_end - 1;
ptr > (lispobj **) (void *) &raise; ptr--)
preserve_pointer(*ptr);
}
commit 9dcff02ed5ae1d8fa31728e84b0d017337f75446
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Thu Jan 26 18:11:28 2012 -0800
Check in changes needed to build ppc. Yay! Very likely broke other
builds, though.
diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp
index 9c12017..3297725 100644
--- a/src/code/debug-int.lisp
+++ b/src/code/debug-int.lisp
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
- "$Header: src/code/debug-int.lisp $")
+ "$Header: /project/cmucl/cvsroot/src/code/debug-int.lisp,v 1.142 2010-07-14 23:08:59 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -1180,7 +1180,7 @@
frame)))))
-#+(or sparc (and x86 (or darwin solaris netbsd)) (and (or x86 amd64) linux))
+#+(or sparc (and x86 darwin) (and (or x86 amd64) linux))
(defun find-foreign-function-name (address)
"Return a string describing the foreign function near ADDRESS"
(let ((addr (sys:sap-int address)))
@@ -1203,7 +1203,7 @@
(alien:slot info 'filename)
)))))))
-#-(or sparc (and x86 (or darwin solaris netbsd)) (and (or x86 amd64) linux))
+#-(or sparc (and x86 darwin) (and (or x86 amd64) linux))
(defun find-foreign-function-name (ra)
(declare (ignore ra))
"Foreign function call land")
@@ -1253,7 +1253,7 @@ The result is a symbol or nil if the routine cannot be found."
;;; LRA, and the LRA is the word offset.
;;;
#-(or gengc x86 amd64)
-(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4")
+(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4" #+ppc "cmucl-ppc")
(defun compute-calling-frame (caller lra up-frame)
(declare (type system:system-area-pointer caller))
(when (cstack-pointer-valid-p caller)
@@ -1362,7 +1362,7 @@ The result is a symbol or nil if the routine cannot be found."
escaped))))))
#-(or gengc x86 amd64)
-(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4")
+(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4" #+ppc "cmucl-ppc")
(defun find-escaped-frame (frame-pointer)
(declare (type system:system-area-pointer frame-pointer))
(dotimes (index lisp::*free-interrupt-context-index* (values nil 0 nil))
@@ -1455,7 +1455,7 @@ The result is a symbol or nil if the routine cannot be found."
(values code pc-offset scp)))))))))))
#-(or gengc x86 amd64)
-(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4")
+(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4" #+ppc "cmucl-ppc")
(defun find-pc-from-assembly-fun (code scp)
"find the PC"
(let ((return-machine-address
@@ -3079,7 +3079,7 @@ The result is a symbol or nil if the routine cannot be found."
;;; SUB-ACCESS-DEBUG-VAR-SLOT -- Internal.
;;;
#-(or x86 amd64)
-(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4")
+(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4" #+ppc "cmucl-ppc")
(defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
(macrolet ((with-escaped-value ((var) &body forms)
`(if escaped
@@ -3505,7 +3505,7 @@ The result is a symbol or nil if the routine cannot be found."
;;; SUB-SET-DEBUG-VAR-SLOT -- Internal.
;;;
#-(or x86 amd64)
-(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4")
+(intl:with-textdomain ("cmucl" #+sparc "cmucl-sparc-svr4" #+ppc "cmucl-ppc")
(defun sub-set-debug-var-slot (fp sc-offset value &optional escaped)
(macrolet ((set-escaped-value (val)
`(if escaped
@@ -4501,7 +4501,8 @@ The result is a symbol or nil if the routine cannot be found."
;;; This handles code-location and debug-function :function-start breakpoints.
;;;
(intl:with-textdomain ("cmucl" #+(or x86 amd64) "cmucl-x86-vm"
- #+sparc "cmucl-sparc-svr4")
+ #+sparc "cmucl-sparc-svr4"
+ #+ppc "cmucl-ppc")
(defun handle-breakpoint-aux (breakpoints data offset component signal-context)
(unless breakpoints
(error (intl:gettext "Breakpoint that nobody wants?")))
diff --git a/src/lisp/Darwin-os.c b/src/lisp/Darwin-os.c
index 9cd0aa6..cceaa55 100644
--- a/src/lisp/Darwin-os.c
+++ b/src/lisp/Darwin-os.c
@@ -14,7 +14,7 @@
* Frobbed for OpenBSD by Pierre R. Mai, 2001.
* Frobbed for Darwin by Pierre R. Mai, 2003.
*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.35 2011/09/03 04:46:34 rtoy Exp $
+ * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.16.4.3 2009-03-18 15:37:29 rtoy Exp $
*
*/
@@ -99,9 +99,6 @@ timebase_init(void)
}
#endif
-void
-os_init0(const char *argv[], const char *envp[])
-{}
void
os_init(const char *argv[], const char *envp[])
@@ -113,91 +110,91 @@ os_init(const char *argv[], const char *envp[])
}
#if defined(__ppc__)
-int *
+unsigned long *
sc_reg(os_context_t * context, int offset)
{
- ppc_saved_state_t *state = &context->uc_mcontext->ss;
+ _STRUCT_PPC_THREAD_STATE *state = &context->uc_mcontext->__ss;
switch (offset) {
case 0:
- return &state->r0;
+ return &state->__r0;
case 1:
- return &state->r1;
+ return &state->__r1;
case 2:
- return &state->r2;
+ return &state->__r2;
case 3:
- return &state->r3;
+ return &state->__r3;
case 4:
- return &state->r4;
+ return &state->__r4;
case 5:
- return &state->r5;
+ return &state->__r5;
case 6:
- return &state->r6;
+ return &state->__r6;
case 7:
- return &state->r7;
+ return &state->__r7;
case 8:
- return &state->r8;
+ return &state->__r8;
case 9:
- return &state->r9;
+ return &state->__r9;
case 10:
- return &state->r10;
+ return &state->__r10;
case 11:
- return &state->r11;
+ return &state->__r11;
case 12:
- return &state->r12;
+ return &state->__r12;
case 13:
- return &state->r13;
+ return &state->__r13;
case 14:
- return &state->r14;
+ return &state->__r14;
case 15:
- return &state->r15;
+ return &state->__r15;
case 16:
- return &state->r16;
+ return &state->__r16;
case 17:
- return &state->r17;
+ return &state->__r17;
case 18:
- return &state->r18;
+ return &state->__r18;
case 19:
- return &state->r19;
+ return &state->__r19;
case 20:
- return &state->r20;
+ return &state->__r20;
case 21:
- return &state->r21;
+ return &state->__r21;
case 22:
- return &state->r22;
+ return &state->__r22;
case 23:
- return &state->r23;
+ return &state->__r23;
case 24:
- return &state->r24;
+ return &state->__r24;
case 25:
- return &state->r25;
+ return &state->__r25;
case 26:
- return &state->r26;
+ return &state->__r26;
case 27:
- return &state->r27;
+ return &state->__r27;
case 28:
- return &state->r28;
+ return &state->__r28;
case 29:
- return &state->r29;
+ return &state->__r29;
case 30:
- return &state->r30;
+ return &state->__r30;
case 31:
- return &state->r31;
+ return &state->__r31;
case 34:
/*
* Not sure if this is really defined anywhere, but after
* r31 is cr, xer, lr, and ctr. So we let 34 be lr.
*/
- return &state->lr;
+ return &state->__lr;
case 35:
- return &state->ctr;
+ return &state->__ctr;
case 41:
- return &context->uc_mcontext->es.dar;
+ return &context->uc_mcontext->__es.__dar;
case 42:
- return &context->uc_mcontext->es.dsisr;
+ return &context->uc_mcontext->__es.__dsisr;
}
- return (int *) 0;
+ return (unsigned long *) 0;
}
#elif defined(__i386__)
#if __DARWIN_UNIX03
@@ -226,16 +223,6 @@ sc_reg(os_context_t * context, int offset)
#define __fpu_fcw fpu_fcw
#define __fpu_fsw fpu_fsw
#define __fpu_mxcsr fpu_mxcsr
-#ifdef FEATURE_SSE2
-#define __fpu_xmm0 fpu_xmm0
-#define __fpu_xmm1 fpu_xmm1
-#define __fpu_xmm2 fpu_xmm2
-#define __fpu_xmm3 fpu_xmm3
-#define __fpu_xmm4 fpu_xmm4
-#define __fpu_xmm5 fpu_xmm5
-#define __fpu_xmm6 fpu_xmm6
-#define __fpu_xmm7 fpu_xmm7
-#endif
#endif
unsigned long *
@@ -288,24 +275,6 @@ os_sigcontext_fpu_reg(ucontext_t *scp, int index)
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm6;
case 7:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7;
-#ifdef FEATURE_SSE2
- case 8:
- return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm0;
- case 9:
- return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm1;
- case 10:
- return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm2;
- case 11:
- return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm3;
- case 12:
- return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm4;
- case 13:
- return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm5;
- case 14:
- return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm6;
- case 15:
- return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7;
-#endif
}
return NULL;
}
@@ -444,23 +413,18 @@ valid_addr(os_vm_address_t addr)
newaddr = os_trunc_to_page(addr);
- if (in_range_p(addr, READ_ONLY_SPACE_START, read_only_space_size)
- || in_range_p(addr, STATIC_SPACE_START, static_space_size)
+ if (in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE)
+ || in_range_p(addr, STATIC_SPACE_START, STATIC_SPACE_SIZE)
|| in_range_p(addr, DYNAMIC_0_SPACE_START, dynamic_space_size)
#ifndef GENCGC
|| in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size)
#endif
- || in_range_p(addr, CONTROL_STACK_START, control_stack_size)
- || in_range_p(addr, BINDING_STACK_START, binding_stack_size))
+ || in_range_p(addr, CONTROL_STACK_START, CONTROL_STACK_SIZE)
+ || in_range_p(addr, BINDING_STACK_START, BINDING_STACK_SIZE))
return TRUE;
return FALSE;
}
-static void
-sigbus_handle_now(HANDLER_ARGS)
-{
- interrupt_handle_now(signal, code, context);
-}
static void
sigbus_handler(HANDLER_ARGS)
@@ -469,11 +433,6 @@ sigbus_handler(HANDLER_ARGS)
caddr_t fault_addr = code->si_addr;
#endif
-#ifdef RED_ZONE_HIT
- if (os_control_stack_overflow((void *) fault_addr, context))
- return;
-#endif
-
#ifdef __ppc__
DPRINTF(0, (stderr, "sigbus:\n"));
DPRINTF(0, (stderr, " PC = %p\n", SC_PC(context)));
@@ -487,8 +446,8 @@ sigbus_handler(HANDLER_ARGS)
#if defined(GENCGC)
#if defined(SIGSEGV_VERBOSE)
- fprintf(stderr, "Signal %d, fault_addr=%x\n",
- signal, fault_addr);
+ fprintf(stderr, "Signal %d, fault_addr=%x, page_index=%d:\n",
+ signal, fault_addr, page_index);
#endif
if (gc_write_barrier(code->si_addr))
return;
@@ -496,11 +455,9 @@ sigbus_handler(HANDLER_ARGS)
if (interrupt_maybe_gc(signal, code, context))
return;
#endif
-
/* a *real* protection fault */
- fprintf(stderr, "sigbus_handler: Real protection violation at %p, PC = %p\n",
- fault_addr, (void *) SC_PC(context));
- sigbus_handle_now(signal, code, context);
+ fprintf(stderr, "sigbus_handler: Real protection violation: %p\n", fault_addr);
+ interrupt_handle_now(signal, code, context);
#ifdef __ppc__
/* Work around G5 bug; fix courtesy gbyers via chandler */
sigreturn(context);
@@ -538,11 +495,3 @@ os_dlsym(const char *sym_name, lispobj lib_list)
return sym_addr;
}
-
-#ifdef i386
-boolean
-os_support_sse2()
-{
- return TRUE;
-}
-#endif
diff --git a/src/lisp/Darwin-os.h b/src/lisp/Darwin-os.h
index 180e686..fb84f1c 100644
--- a/src/lisp/Darwin-os.h
+++ b/src/lisp/Darwin-os.h
@@ -1,6 +1,6 @@
/*
- $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.h,v 1.8 2011/01/09 00:12:36 rtoy Exp $
+ $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.h,v 1.7 2008-01-03 11:41:54 cshapiro Exp $
This code was written as part of the CMU Common Lisp project at
Carnegie Mellon University, and has been placed in the public domain.
@@ -14,7 +14,7 @@
#include <sys/mman.h>
#include <sys/signal.h>
#include <signal.h>
-#include <sys/ucontext.h>
+#include <ucontext.h>
#include <mach/vm_types.h>
typedef caddr_t os_vm_address_t;
@@ -28,14 +28,14 @@ typedef int os_vm_prot_t;
#define OS_VM_DEFAULT_PAGESIZE 4096
-#define HANDLER_ARGS int signal, siginfo_t *code, void *context
+#define HANDLER_ARGS int signal, siginfo_t *code, os_context_t *context
#define CODE(code) ((code) ? code->si_code : 0)
#define os_context_t ucontext_t
#ifdef __i386__
#define RESTORE_FPU(context) restore_fpu(context)
#endif
-int *sc_reg(os_context_t *, int);
+unsigned long *sc_reg(os_context_t *, int);
void restore_fpu(ucontext_t *);
#define PROTECTION_VIOLATION_SIGNAL SIGBUS
diff --git a/src/lisp/gencgc.c b/src/lisp/gencgc.c
index 423cc9c..36683a1 100644
--- a/src/lisp/gencgc.c
+++ b/src/lisp/gencgc.c
@@ -7,7 +7,7 @@
*
* Douglas Crosher, 1996, 1997, 1998, 1999.
*
- * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.112 2011/01/09 00:12:36 rtoy Exp $
+ * $Header: /project/cmucl/cvsroot/src/lisp/gencgc.c,v 1.112 2011-01-09 00:12:36 rtoy Exp $
*
*/
@@ -169,20 +169,20 @@ check_escaped_stack_object(lispobj * where, lispobj obj)
if (Pointerp(obj)
&& (p = (void *) PTR(obj),
(p >= (void *) CONTROL_STACK_START
- && p < (void *) control_stack_end))) {
+ && p < (void *) CONTROL_STACK_END))) {
char *space;
if (where >= (lispobj *) DYNAMIC_0_SPACE_START
- && where < (lispobj *) (DYNAMIC_0_SPACE_START + dynamic_space_size))
+ && where < (lispobj *) (DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE))
space = "dynamic space";
else if (where >= (lispobj *) STATIC_SPACE_START
&& where <
- (lispobj *) (STATIC_SPACE_START + static_space_size)) space =
+ (lispobj *) (STATIC_SPACE_START + STATIC_SPACE_SIZE)) space =
"static space";
else if (where >= (lispobj *) READ_ONLY_SPACE_START
&& where <
(lispobj *) (READ_ONLY_SPACE_START +
- read_only_space_size)) space = "read-only space";
+ READ_ONLY_SPACE_SIZE)) space = "read-only space";
else
space = NULL;
@@ -198,7 +198,7 @@ check_escaped_stack_object(lispobj * where, lispobj obj)
(unsigned long) obj, where, space);
#ifndef i386
else if ((where >= (lispobj *) CONTROL_STACK_START
- && where < (lispobj *) (control_stack_end))
+ && where < (lispobj *) (CONTROL_STACK_END))
|| (space == NULL)) {
/* Do nothing if it the reference is from the control stack,
because that will happen, and that's ok. Or if it's from
@@ -2003,7 +2003,7 @@ read_only_space_p(lispobj obj)
static inline boolean
control_stack_space_p(lispobj obj)
{
- lispobj end = CONTROL_STACK_START + control_stack_size;
+ lispobj end = CONTROL_STACK_START + CONTROL_STACK_SIZE;
return (obj >= CONTROL_STACK_START) && (obj < end);
}
@@ -2011,7 +2011,7 @@ control_stack_space_p(lispobj obj)
static inline boolean
binding_stack_space_p(lispobj obj)
{
- lispobj end = BINDING_STACK_START + binding_stack_size;
+ lispobj end = BINDING_STACK_START + BINDING_STACK_SIZE;
return (obj >= BINDING_STACK_START) && (obj < end);
}
@@ -2077,6 +2077,12 @@ other_space_p(lispobj obj)
if (obj == (lispobj) 0xffffffe9) {
in_space = TRUE;
}
+#elif defined(__ppc__)
+ /*
+ */
+ if (obj <= (lispobj) &fpu_restore) {
+ in_space = TRUE;
+ }
#endif
#endif
@@ -2710,11 +2716,11 @@ scavenge_interrupt_context(os_context_t * context)
#endif
#ifdef reg_LR
- PAIR_INTERIOR_POINTER(pc, SC_REG(context, reg_LR));
+ PAIR_INTERIOR_POINTER(lr, SC_REG(context, reg_LR));
#endif
#ifdef reg_CTR
- PAIR_INTERIOR_POINTER(pc, SC_REG(context, reg_CTR));
+ PAIR_INTERIOR_POINTER(ctr, SC_REG(context, reg_CTR));
#endif
/* Scanvenge all boxed registers in the context. */
@@ -7321,7 +7327,7 @@ garbage_collect_generation(int generation, int raise)
invalid_stack_end = (void *) &raise;
#else /* not i386 */
invalid_stack_start = (void *) &raise;
- invalid_stack_end = (void *) control_stack_end;
+ invalid_stack_end = (void *) CONTROL_STACK_END;
#endif /* not i386 */
#endif /* GC_ASSERTIONS */
@@ -7381,7 +7387,7 @@ garbage_collect_generation(int generation, int raise)
{
lispobj **ptr;
- for (ptr = (lispobj **) control_stack_end - 1;
+ for (ptr = (lispobj **) CONTROL_STACK_END - 1;
ptr > (lispobj **) (void *) &raise; ptr--)
preserve_pointer(*ptr);
}
diff --git a/src/lisp/ppc-lispregs.h b/src/lisp/ppc-lispregs.h
index 2b79bac..b593c1f 100644
--- a/src/lisp/ppc-lispregs.h
+++ b/src/lisp/ppc-lispregs.h
@@ -107,7 +107,7 @@
#ifndef LANGUAGE_ASSEMBLY
#if defined DARWIN
#define SC_REG(sc,reg) (*sc_reg(sc,reg))
-#define SC_PC(sc) (sc->uc_mcontext->ss.srr0)
+#define SC_PC(sc) (sc->uc_mcontext->__ss.__srr0)
#else
#define SC_REG(sc,reg) (((unsigned long *)(sc->regs))[(reg)])
#define SC_PC(sc) (((unsigned long *)(sc->regs))[PT_NIP])
-----------------------------------------------------------------------
Summary of changes:
src/code/debug-int.lisp | 15 ++--
src/lisp/Config.ppc_darwin | 2 +-
src/lisp/Darwin-os.c | 172 ++++++++++++++++++++++++++++----------------
src/lisp/Darwin-os.h | 6 ++-
src/lisp/gencgc.c | 16 +++-
src/lisp/ppc-arch.c | 64 +++++++++--------
src/lisp/ppc-lispregs.h | 5 ++
7 files changed, 173 insertions(+), 107 deletions(-)
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list