--- /dev/null
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# This software is derived from the CMU CL system, which was
+# written at Carnegie Mellon University and released into the
+# public domain. The software is in the public domain and is
+# provided with absolutely no warranty. See the COPYING and CREDITS
+# files for more information.
+
+CFLAGS += -g -Dppc
+LD = ld #-taso
+LINKFLAGS = -v -g # -Wl,-T -Wl,ld-script.alpha-linux
+NM = nm -p
+
+ASSEM_SRC = ppc-assem.S ldso-stubs.S
+ARCH_SRC = ppc-arch.c
+
+OS_SRC = linux-os.c ppc-linux-os.c os-common.c
+LINKFLAGS+=-rdynamic # -static
+OS_LIBS= -ldl
+
+GC_SRC= gc.c
--- /dev/null
+/*
+
+ $Header$
+
+ This code was written as part of the CMU Common Lisp project at
+ Carnegie Mellon University, and has been placed in the public domain.
+
+*/
+
+#include <stdio.h>
+
+#include "arch.h"
+#include "sbcl.h"
+#include "globals.h"
+#include "validate.h"
+#include "os.h"
+#include "lispregs.h"
+#include "signal.h"
+#include "interrupt.h"
+#include "interr.h"
+
+ /* The header files may not define PT_DAR/PT_DSISR. This definition
+ is correct for all versions of ppc linux >= 2.0.30
+
+ As of DR2.1u4, MkLinux doesn't pass these registers to signal
+ handlers correctly; a patch is necessary in order to (partially)
+ correct this.
+
+ Even with the patch, the DSISR may not have its 'write' bit set
+ correctly (it tends not to be set if the fault was caused by
+ something other than a protection violation.)
+
+ Caveat callers. */
+
+#ifndef PT_DAR
+#define PT_DAR 41
+#endif
+
+#ifndef PT_DSISR
+#define PT_DSISR 42
+#endif
+
+void arch_init()
+{
+}
+
+os_vm_address_t
+arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context)
+{
+ unsigned long badinstr;
+ unsigned int *pc = (unsigned int *)(*os_context_pc_addr(context));
+ int instclass;
+ os_vm_address_t addr;
+
+
+ /* Make sure it's not the pc thats bogus, and that it was lisp code */
+ /* that caused the fault. */
+ if ((((unsigned long)pc) & 3) != 0 ||
+ ((pc < READ_ONLY_SPACE_START ||
+ pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) &&
+ ((lispobj *)pc < current_dynamic_space &&
+ (lispobj *)pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE)))
+ return 0;
+
+
+ addr = (os_vm_address_t) (*os_context_register_addr(context,PT_DAR));
+ return addr;
+}
+
+
+void
+arch_skip_instruction(os_context_t *context)
+{
+ ((char*)*os_context_pc_addr(context)) +=4;
+}
+
+unsigned char *
+arch_internal_error_arguments(os_context_t *context)
+{
+ return (unsigned char *)(*os_context_pc_addr(context)+4);
+}
+
+
+boolean
+arch_pseudo_atomic_atomic(os_context_t *context)
+{
+ return ((*os_context_register_addr(context,reg_ALLOC)) & 4);
+}
+
+#define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000
+
+void
+arch_set_pseudo_atomic_interrupted(os_context_t *context)
+{
+ *os_context_register_addr(context,reg_NL3)
+ += PSEUDO_ATOMIC_INTERRUPTED_BIAS;
+}
+
+unsigned long
+arch_install_breakpoint(void *pc)
+{
+ unsigned long *ptr = (unsigned long *)pc;
+ unsigned long result = *ptr;
+ *ptr = (3<<26) | (5 << 21) | trap_Breakpoint;
+ os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
+ return result;
+}
+
+void
+arch_remove_breakpoint(void *pc, unsigned long orig_inst)
+{
+ *(unsigned long *)pc = orig_inst;
+ os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
+}
+
+static unsigned long *skipped_break_addr, displaced_after_inst;
+static sigset_t orig_sigmask;
+
+void
+arch_do_displaced_inst(os_context_t *context,unsigned int orig_inst)
+{
+ /* not sure how we ensure that we get the breakpoint reinstalled
+ * after doing this -dan */
+ unsigned long *pc = (unsigned long *)(*os_context_pc_addr(context));
+
+ orig_sigmask = *os_context_sigmask_addr(context);
+ sigaddset_blockable(os_context_sigmask_addr(context));
+
+ *pc = orig_inst;
+ os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
+ skipped_break_addr = pc;
+}
+
+static void
+sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
+{
+ int badinst;
+ u32 code;
+ sigset_t *mask;
+ mask=(os_context_sigmask_addr(context));
+ sigsetmask(mask);
+ code=*((u32 *)(*os_context_pc_addr(context)));
+ if (code == ((3 << 26) | (16 << 21) | (reg_ALLOC << 16))) {
+ /* twlti reg_ALLOC,0 - check for deferred interrupt */
+ *os_context_register_addr(context,reg_ALLOC)
+ -= PSEUDO_ATOMIC_INTERRUPTED_BIAS;
+ arch_skip_instruction(context);
+ /* interrupt or GC was requested in PA; now we're done with the
+ PA section we may as well get around to it */
+ interrupt_handle_pending(context);
+ return;
+
+ }
+ if ((code >> 16) == ((3 << 10) | (6 << 5))) {
+ /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */
+ int trap = code & 0x1f, extra = (code >> 5) & 0x1f;
+
+ switch (trap) {
+ case trap_Halt:
+ fake_foreign_function_call(context);
+ lose("%%primitive halt called; the party is over.\n");
+
+ case trap_Error:
+ case trap_Cerror:
+ interrupt_internal_error(signal, code, context, trap == trap_Cerror);
+ break;
+
+ case trap_PendingInterrupt:
+ /* when do we run this branch instead of the twlti code above? */
+ arch_skip_instruction(context);
+ interrupt_handle_pending(context);
+ break;
+
+ case trap_Breakpoint:
+ handle_breakpoint(signal, code, context);
+ break;
+
+ case trap_FunEndBreakpoint:
+ *os_context_pc_addr(context)
+ =(int)handle_fun_end_breakpoint(signal, code, context);
+ break;
+
+ case trap_AfterBreakpoint:
+ *skipped_break_addr = trap_Breakpoint;
+ skipped_break_addr = NULL;
+ *(unsigned long *)*os_context_pc_addr(context)
+ = displaced_after_inst;
+ *os_context_sigmask_addr(context)= orig_sigmask;
+
+ os_flush_icache((os_vm_address_t) *os_context_pc_addr(context),
+ sizeof(unsigned long));
+ break;
+
+ default:
+ interrupt_handle_now(signal, code, context);
+ break;
+ }
+ }
+ if (((code >> 26) == 3) && (((code >> 21) & 31) == 24)) {
+ interrupt_internal_error(signal, code, context, 0);
+ }
+
+ interrupt_handle_now(signal, code, context);
+}
+
+
+void arch_install_interrupt_handlers()
+{
+ undoably_install_low_level_interrupt_handler(SIGILL,sigtrap_handler);
+ undoably_install_low_level_interrupt_handler(SIGTRAP,sigtrap_handler);
+}
+
+
+extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
+
+lispobj funcall0(lispobj function)
+{
+ lispobj *args = current_control_stack_pointer;
+
+ return call_into_lisp(function, args, 0);
+}
+
+lispobj funcall1(lispobj function, lispobj arg0)
+{
+ lispobj *args = current_control_stack_pointer;
+
+ current_control_stack_pointer += 1;
+ args[0] = arg0;
+
+ return call_into_lisp(function, args, 1);
+}
+
+lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1)
+{
+ lispobj *args = current_control_stack_pointer;
+
+ current_control_stack_pointer += 2;
+ args[0] = arg0;
+ args[1] = arg1;
+
+ return call_into_lisp(function, args, 2);
+}
+
+lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
+{
+ lispobj *args = current_control_stack_pointer;
+
+ current_control_stack_pointer += 3;
+ args[0] = arg0;
+ args[1] = arg1;
+ args[2] = arg2;
+
+ return call_into_lisp(function, args, 3);
+}
+
+void
+ppc_flush_icache(os_vm_address_t address, os_vm_size_t length)
+{
+ os_vm_address_t end = (os_vm_address_t) ((int)(address+length+(32-1)) &~(32-1));
+ extern void ppc_flush_cache_line(os_vm_address_t);
+
+ while (address < end) {
+ ppc_flush_cache_line(address);
+ address += 32;
+ }
+}
--- /dev/null
+#ifndef _PPC_ARCH_H
+#define _PPC_ARCH_H
+
+#define ARCH_HAS_LINK_REGISTER
+
+#endif /* _PPC_ARCH_H */
--- /dev/null
+#define LANGUAGE_ASSEMBLY
+
+#include "sbcl.h"
+#include "lispregs.h"
+#include "globals.h"
+
+
+#define FUNCDEF(x) .text ; \
+ .align 3 ; \
+ .type x,@function ; \
+x:
+#define GFUNCDEF(x) .globl x ; \
+ FUNCDEF(x)
+
+#define SET_SIZE(x) .size x,.-x
+
+/* Load a register from a global, using the register as an intermediary */
+/* The register will be a fixnum for one instruction, so this is gc-safe */
+
+#define load(reg,global) \
+ lis reg,global@ha; lwz reg,global@l(reg)
+#define store(reg,temp,global) \
+ lis temp,global@ha; stw reg,global@l(temp)
+
+#define FIRST_SAVE_FPR 14 /* lowest-numbered non-volatile FPR */
+#define FIRST_SAVE_GPR 14 /* lowest-numbered non-volatile GPR */
+#define NFPR_SAVE_BYTES(n) ((32-(n))*8)
+#define NGPR_SAVE_BYTES(n) ((32-(~1&((n)+1)))*4)
+#define FRAME_ARG_BYTES(n) (((((n)+2)*4)+15)&~15)
+
+#define FRAME_SIZE(first_g,first_f,out_arg_words,savecr) \
+(NFPR_SAVE_BYTES(first_f)+ NGPR_SAVE_BYTES(first_g)+ FRAME_ARG_BYTES(out_arg_words+savecr))
+#define SAVE_FPR(n) stfd n,-8*(32-(n))(11)
+#define SAVE_GPR(n) stw n,-4*(32-(n))(11)
+#define FULL_FRAME_SIZE FRAME_SIZE(FIRST_SAVE_GPR,FIRST_SAVE_FPR,0,1)
+
+#define RESTORE_FPR(n) lfd n,-8*(32-(n))(11)
+#define RESTORE_GPR(n) lwz n,-4*(32-(n))(11)
+#define C_FULL_PROLOG \
+ mflr 0 ; \
+ stw 0,4(1) ; \
+ mr 11,1 ; \
+ stwu 1,-FULL_FRAME_SIZE(1) ; \
+ SAVE_FPR(14) ; \
+ SAVE_FPR(15) ; \
+ SAVE_FPR(16) ; \
+ SAVE_FPR(17) ; \
+ SAVE_FPR(18) ; \
+ SAVE_FPR(19) ; \
+ SAVE_FPR(20) ; \
+ SAVE_FPR(21) ; \
+ SAVE_FPR(22) ; \
+ SAVE_FPR(23) ; \
+ SAVE_FPR(24) ; \
+ SAVE_FPR(25) ; \
+ SAVE_FPR(26) ; \
+ SAVE_FPR(27) ; \
+ SAVE_FPR(28) ; \
+ SAVE_FPR(29) ; \
+ SAVE_FPR(30) ; \
+ SAVE_FPR(31) ; \
+ la 11,-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
+ SAVE_GPR(14) ; \
+ SAVE_GPR(15) ; \
+ SAVE_GPR(16) ; \
+ SAVE_GPR(17) ; \
+ SAVE_GPR(18) ; \
+ SAVE_GPR(19) ; \
+ SAVE_GPR(20) ; \
+ SAVE_GPR(21) ; \
+ SAVE_GPR(22) ; \
+ SAVE_GPR(23) ; \
+ SAVE_GPR(24) ; \
+ SAVE_GPR(25) ; \
+ SAVE_GPR(26) ; \
+ SAVE_GPR(27) ; \
+ SAVE_GPR(28) ; \
+ SAVE_GPR(29) ; \
+ SAVE_GPR(30) ; \
+ SAVE_GPR(31)
+
+
+#define C_FULL_EPILOG \
+ la 11,FULL_FRAME_SIZE-NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(1) ; \
+ RESTORE_GPR(14) ; \
+ RESTORE_GPR(15) ; \
+ RESTORE_GPR(16) ; \
+ RESTORE_GPR(17) ; \
+ RESTORE_GPR(18) ; \
+ RESTORE_GPR(19) ; \
+ RESTORE_GPR(20) ; \
+ RESTORE_GPR(21) ; \
+ RESTORE_GPR(22) ; \
+ RESTORE_GPR(23) ; \
+ RESTORE_GPR(24) ; \
+ RESTORE_GPR(25) ; \
+ RESTORE_GPR(26) ; \
+ RESTORE_GPR(27) ; \
+ RESTORE_GPR(28) ; \
+ RESTORE_GPR(29) ; \
+ RESTORE_GPR(30) ; \
+ RESTORE_GPR(31) ; \
+ la 11,NFPR_SAVE_BYTES(FIRST_SAVE_FPR)(11) ; \
+ RESTORE_FPR(14) ; \
+ RESTORE_FPR(15) ; \
+ RESTORE_FPR(16) ; \
+ RESTORE_FPR(17) ; \
+ RESTORE_FPR(18) ; \
+ RESTORE_FPR(19) ; \
+ RESTORE_FPR(20) ; \
+ RESTORE_FPR(21) ; \
+ RESTORE_FPR(22) ; \
+ RESTORE_FPR(23) ; \
+ RESTORE_FPR(24) ; \
+ RESTORE_FPR(25) ; \
+ RESTORE_FPR(26) ; \
+ RESTORE_FPR(27) ; \
+ RESTORE_FPR(28) ; \
+ RESTORE_FPR(29) ; \
+ RESTORE_FPR(30) ; \
+ RESTORE_FPR(31) ; \
+ lwz 1,0(1) ; \
+ lwz 0,4(1) ; \
+ mtlr 0 ; \
+
+
+
+
+ .text
+
+/*
+ * Function to transfer control into lisp. The lisp object to invoke is
+ * passed as the first argument, which puts it in NL0
+ */
+
+ GFUNCDEF(call_into_lisp)
+ C_FULL_PROLOG
+ mfcr 0
+ stw 0,8(1)
+ /* store(reg_POLL,11,saver2) */
+ /* Initialize tagged registers */
+ li reg_ZERO,0
+ li reg_CODE,0
+ li reg_CNAME,0
+ li reg_LEXENV,0
+ li reg_FDEFN,0
+ li reg_OCFP,0
+ li reg_LRA,0
+ li reg_A0,0
+ li reg_A1,0
+ li reg_A2,0
+ li reg_A3,0
+ li reg_L0,0
+ li reg_L1,0
+ li reg_L2,0
+ li reg_LIP,0
+ lis reg_NULL,NIL@h
+ ori reg_NULL,reg_NULL,NIL@l
+
+ /* Turn on pseudo-atomic */
+
+ li reg_NL3,-4
+ li reg_ALLOC,4
+ store(reg_ZERO,reg_NL4,foreign_function_call_active)
+ load(reg_NL4,dynamic_space_free_pointer)
+ add reg_ALLOC,reg_ALLOC,reg_NL4
+ load(reg_BSP,current_binding_stack_pointer)
+ load(reg_CSP,current_control_stack_pointer)
+ load(reg_OCFP,current_control_frame_pointer)
+
+ /* No longer atomic, and check for interrupt */
+ add reg_ALLOC,reg_ALLOC,reg_NL3
+ twlti reg_ALLOC,0
+
+ /* Pass in the arguments */
+
+ mr reg_CFP,reg_NL1
+ mr reg_LEXENV,reg_NL0
+ lwz reg_A0,0(reg_CFP)
+ lwz reg_A1,4(reg_CFP)
+ lwz reg_A2,8(reg_CFP)
+ lwz reg_A3,12(reg_CFP)
+
+ /* Calculate LRA */
+ lis reg_LRA,lra@ha
+ addi reg_LRA,reg_LRA,lra@l
+ addi reg_LRA,reg_LRA,OTHER_POINTER_LOWTAG
+
+ /* Function is an indirect closure */
+ lwz reg_CODE,SIMPLE_FUN_SELF_OFFSET(reg_LEXENV)
+ addi reg_LIP,reg_CODE,6*4-FUN_POINTER_LOWTAG
+ mtctr reg_LIP
+ slwi reg_NARGS,reg_NL2,2
+ bctr
+
+ .align 3
+lra:
+ .long RETURN_PC_HEADER_WIDETAG
+
+ /* Blow off any extra values. */
+ mr reg_CSP,reg_OCFP
+ nop
+
+ /* Return the one value. */
+
+ mr 3,reg_A0
+
+ /* Turn on pseudo-atomic */
+ li reg_NL3,-4
+ la reg_ALLOC,4(reg_ALLOC)
+
+ /* Store lisp state */
+ clrrwi reg_NL1,reg_ALLOC,3
+ store(reg_NL1,reg_NL2,dynamic_space_free_pointer)
+ /* store(reg_POLL,reg_NL2,poll_flag) */
+ /* load(reg_NL2,current_thread) */
+ store(reg_BSP,reg_NL2,current_binding_stack_pointer)
+ store(reg_CSP,reg_NL2,current_control_stack_pointer)
+ store(reg_CFP,reg_NL2,current_control_frame_pointer)
+ /* load(reg_POLL,saver2) */
+
+ /* No longer in Lisp. */
+ store(reg_NL1,reg_NL2,foreign_function_call_active)
+
+ /* Check for interrupt */
+ add reg_ALLOC,reg_ALLOC,reg_NL3
+ twlti reg_ALLOC,0
+
+ /* Back to C */
+ lwz 5,8(1)
+ mtcrf 255,5
+ C_FULL_EPILOG
+ blr
+ SET_SIZE(call_into_lisp)
+\f
+
+ GFUNCDEF(call_into_c)
+ /* We're kind of low on unboxed, non-dedicated registers here:
+ most of the unboxed registers may have outgoing C args in them.
+ CFUNC is going to have to go in the CTR in a moment, anyway
+ so we'll free it up soon. reg_NFP is preserved by lisp if it
+ has a meaningful value in it, so we can use it. reg_NARGS is
+ free when it's not holding a copy of the "real" reg_NL3, which
+ gets tied up by the pseudo-atomic mechanism */
+ mtctr reg_CFUNC
+ mflr reg_LIP
+ /* Build a lisp stack frame */
+ mr reg_OCFP,reg_CFP
+ mr reg_CFP,reg_CSP
+ la reg_CSP,32(reg_CSP)
+ stw reg_OCFP,0(reg_CFP)
+ stw reg_CODE,8(reg_CFP)
+ /* The pseudo-atomic mechanism wants to use reg_NL3, but that
+ may be an outgoing C argument. Copy reg_NL3 to something that's
+ unboxed and -not- one of the C argument registers */
+ mr reg_NARGS,reg_NL3
+
+ /* Turn on pseudo-atomic */
+ li reg_NL3,-4
+ la reg_ALLOC,4(reg_ALLOC)
+
+ /* Convert the return address to an offset and save it on the stack. */
+ sub reg_NFP,reg_LIP,reg_CODE
+ la reg_NFP,OTHER_POINTER_LOWTAG(reg_NFP)
+ stw reg_NFP,4(reg_CFP)
+
+ /* Store Lisp state */
+ clrrwi reg_NFP,reg_ALLOC,3
+ store(reg_NFP,reg_CFUNC,dynamic_space_free_pointer)
+ /* load(reg_CFUNC,current_thread) */
+
+ store(reg_BSP,reg_CFUNC,current_binding_stack_pointer)
+ store(reg_CSP,reg_CFUNC,current_control_stack_pointer)
+ store(reg_CFP,reg_CFUNC,current_control_frame_pointer)
+
+ /* No longer in Lisp */
+ store(reg_CSP,reg_CFUNC,foreign_function_call_active)
+ /* load(reg_POLL,saver2) */
+ /* Disable pseudo-atomic; check pending interrupt */
+ add reg_ALLOC,reg_ALLOC,reg_NL3
+ twlti reg_ALLOC,0
+ mr reg_NL3,reg_NARGS
+
+ /* Into C we go. */
+ bctrl
+
+ /* Re-establish NIL */
+ lis reg_NULL,NIL@h
+ ori reg_NULL,reg_NULL,NIL@l
+ /* And reg_ZERO */
+ li reg_ZERO,0
+
+ /* If we GC'ed during the FF code (as the result of a callback ?)
+ the tagged lisp registers may now contain garbage (since the
+ registers were saved by C and not seen by the GC.) Put something
+ harmless in all such registers before allowing an interrupt */
+ li reg_CODE,0
+ li reg_CNAME,0
+ li reg_LEXENV,0
+ /* reg_OCFP was pointing to a control stack frame & was preserved by C */
+ li reg_LRA,0
+ li reg_A0,0
+ li reg_A1,0
+ li reg_A2,0
+ li reg_A3,0
+ li reg_L0,0
+ li reg_L1,0
+ li reg_L2,0
+ li reg_LIP,0
+
+ /* Atomic ... */
+ li reg_NL3,-4
+ li reg_ALLOC,4
+
+ /* No long in foreign function call. */
+ store(reg_ZERO,reg_NL2,foreign_function_call_active)
+
+ /* The free pointer may have moved */
+ load(reg_NL4,dynamic_space_free_pointer)
+ add reg_ALLOC,reg_ALLOC,reg_NL4
+
+ /* The BSP wasn't preserved by C, so load it */
+ load(reg_BSP,current_binding_stack_pointer)
+
+ /* Other lisp stack/frame pointers were preserved by C.
+ I can't imagine why they'd have moved */
+
+ /* Get the return address back. */
+ lwz reg_LIP,4(reg_CFP)
+ lwz reg_CODE,8(reg_CFP)
+ add reg_LIP,reg_CODE,reg_LIP
+ la reg_LIP,-OTHER_POINTER_LOWTAG(reg_LIP)
+
+ /* No longer atomic */
+ add reg_ALLOC,reg_ALLOC,reg_NL3
+ twlti reg_ALLOC,0
+ mtlr reg_LIP
+
+ /* Reset the lisp stack. */
+ mr reg_CSP,reg_CFP
+ mr reg_CFP,reg_OCFP
+
+ /* And back into Lisp. */
+ blr
+
+ SET_SIZE(call_into_c)
+
+ GFUNCDEF(xundefined_tramp)
+ .globl undefined_tramp
+ .byte 0,0,0,SIMPLE_FUN_HEADER_WIDETAG /* type_FunctionHeader */
+
+ .byte 18<<2
+undefined_tramp:
+ .byte 0,0,24
+ .long undefined_tramp
+ .long NIL
+ .long NIL
+ .long NIL
+ .long NIL
+ twllei reg_ZERO,trap_Cerror
+ .byte 4
+ .byte UNDEFINED_FUN_ERROR
+ .byte 254, 140, 2 /* 140? sparc says sc_descriptorReg */
+ .align 2
+1: lwz reg_CODE,FDEFN_RAW_ADDR_OFFSET(reg_FDEFN)
+ la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
+ mtctr reg_LIP
+ bctr
+
+ SET_SIZE(xundefined_tramp)
+
+ GFUNCDEF(xclosure_tramp)
+ .globl closure_tramp
+ .byte 0,0,0,SIMPLE_FUN_HEADER_WIDETAG
+ .byte 18<<2
+closure_tramp:
+ .byte 0,0,24
+ .long closure_tramp
+ .long NIL
+ .long NIL
+ .long NIL
+ .long NIL
+ lwz reg_LEXENV,FDEFN_FUN_OFFSET(reg_FDEFN)
+ lwz reg_CODE,CLOSURE_FUN_OFFSET(reg_LEXENV)
+ la reg_LIP,SIMPLE_FUN_CODE_OFFSET(reg_CODE)
+ mtctr reg_LIP
+ bctr
+
+ SET_SIZE(xclosure_tramp)
+
+ GFUNCDEF(fun_end_breakpoint_trap)
+ .long 0
+ SET_SIZE(fun_end_breakpoint_trap)
+
+ GFUNCDEF(fun_end_breakpoint)
+ .long 0
+ SET_SIZE(fun_end_breakpoint)
+
+ GFUNCDEF(fun_end_breakpoint_guts)
+ .long 0
+ SET_SIZE(fun_end_breakpoint_guts)
+
+ GFUNCDEF(fun_end_breakpoint_end)
+ .long 0
+ SET_SIZE(fun_end_breakpoint_end)
+
+
+ GFUNCDEF(ppc_flush_cache_line)
+ dcbf 0,3
+ sync
+ icbi 0,3
+ sync
+ isync
+ blr
+ SET_SIZE(ppc_flush_cache_line)
+
--- /dev/null
+/*
+ * This is the IBM/Motorola/Apple/whoever Linux incarnation of
+ * arch-dependent OS-dependent routines. See also "linux-os.c". */
+
+/*
+ * This software is part of the SBCL system. See the README file for
+ * more information.
+ *
+ * This software is derived from the CMU CL system, which was
+ * written at Carnegie Mellon University and released into the
+ * public domain. The software is in the public domain and is
+ * provided with absolutely no warranty. See the COPYING and CREDITS
+ * files for more information.
+ */
+
+/* These header files were lifted wholesale from linux-os.c, some may
+ * be redundant. -- Dan Barlow ca. 2001-05-01 */
+#include <stdio.h>
+#include <sys/param.h>
+#include <sys/file.h>
+#include "./signal.h"
+#include "os.h"
+#include "arch.h"
+#include "globals.h"
+#include "interrupt.h"
+#include "interr.h"
+#include "lispregs.h"
+#include "sbcl.h"
+#include <sys/socket.h>
+#include <sys/utsname.h>
+
+#include <sys/types.h>
+#include <signal.h>
+#include <sys/time.h>
+#include <sys/stat.h>
+#include <unistd.h>
+
+#include "validate.h"
+size_t os_vm_page_size;
+
+#if defined GENCGC /* unlikely ... */
+#error SBCL PPC does not work with the GENCGC
+#include "gencgc.h"
+#endif
+
+os_context_register_t *
+os_context_register_addr(os_context_t *context, int offset)
+{
+ return &((context->uc_mcontext.regs)->gpr[offset]);
+}
+
+os_context_register_t *
+os_context_pc_addr(os_context_t *context)
+{
+ return &((context->uc_mcontext.regs)->nip);
+}
+
+os_context_register_t *
+os_context_lr_addr(os_context_t *context)
+{
+ return &((context->uc_mcontext.regs)->link);
+}
+
+sigset_t *
+os_context_sigmask_addr(os_context_t *context)
+{
+ return &context->uc_sigmask;
+}
+
+void os_flush_icache(os_vm_address_t address, os_vm_size_t length)
+{
+ /* see ppc-arch.c */
+ ppc_flush_icache(address,length);
+}
+
--- /dev/null
+#ifndef _PPC_LINUX_OS_H
+#define _PPC_LINUX_OS_H
+
+typedef struct ucontext os_context_t;
+
+static inline os_context_t *arch_os_get_context(void **void_context) {
+ return (os_context_t *) *void_context;
+}
+
+#endif /* _PPC_LINUX_OS_H */
--- /dev/null
+#define REG(num) num
+#define NREGS 32
+
+#define reg_ZERO REG(0) /* Should always contain 0 in lisp */
+#define reg_NSP REG(1) /* The number/C stack pointer */
+#define reg_POLL REG(2) /* Lisp preemption/Mystery SVR4 ABI reg */
+#define reg_NL0 REG(3) /* FF param/result 1 */
+#define reg_NL1 REG(4) /* FF param/result 2 */
+#define reg_NL2 REG(5) /* FF param 3 */
+#define reg_NL3 REG(6)
+#define reg_NL4 REG(7)
+#define reg_NL5 REG(8)
+#define reg_NL6 REG(9) /* Last (7th) FF param */
+#define reg_FDEFN REG(10) /* was NL7 until recently -dan */
+#define reg_NARGS REG(11)
+#define reg_NFP REG(12) /* Lisp may save around FF-call */
+#define reg_CFUNC REG(13) /* Silly to blow a reg on FF-name */
+#define reg_BSP REG(14) /* Binding stack pointer */
+#define reg_CFP REG(15) /* Control/value stack frame pointer */
+#define reg_CSP REG(16) /* Control/value stack top */
+#define reg_ALLOC REG(17) /* (Global) dynamic free pointer */
+#define reg_NULL REG(18) /* NIL and globals nearby */
+#define reg_CODE REG(19) /* Current function object */
+#define reg_CNAME REG(20) /* Current function name */
+#define reg_LEXENV REG(21) /* And why burn a register for this ? */
+#define reg_OCFP REG(22) /* The caller's reg_CFP */
+#define reg_LRA REG(23) /* Tagged lisp return address */
+#define reg_A0 REG(24) /* First function arg/return value */
+#define reg_A1 REG(25) /* Second. */
+#define reg_A2 REG(26) /* */
+#define reg_A3 REG(27) /* Last of (only) 4 arg regs */
+#define reg_L0 REG(28) /* Tagged temp regs */
+#define reg_L1 REG(29)
+#define reg_L2 REG(30) /* Last lisp temp reg */
+#define reg_LIP REG(31) /* Lisp Interior Pointer, e.g., locative */
+
+#define REGNAMES \
+ "ZERO", "NSP", "???", "NL0", \
+ "NL1", "NL2", "NL3P", "NL4", \
+ "NL5", "NL6", "FDEFN", "NARGS", \
+ "NFP", "CFUNC" "BSP", "CFP", \
+ "CSP", "ALLOC", "NULL", "CODE", \
+ "CNAME", "LEXENV", "OCFP", "LRA", \
+ "A0", "A1", "A2", "A3", \
+ "L0", "L1", "L2", "LIP"
+
+#define BOXED_REGISTERS { \
+ reg_FDEFN, reg_CODE, reg_CNAME, reg_LEXENV, reg_OCFP, reg_LRA, \
+ reg_A0, reg_A1, reg_A2, reg_A3, \
+ reg_L0, reg_L1, reg_L2 \
+}
projects / sbcl.git / commitdiff