Skip to content
alpha-arch.c 8.8 KiB
Newer Older
ram's avatar
ram committed
/*

 This code was written as part of the CMU Common Lisp project at
 Carnegie Mellon University, and has been placed in the public domain.

*/

hallgren's avatar
hallgren committed
#include <stdio.h>
pw's avatar
pw committed
#include <string.h>
hallgren's avatar
hallgren committed

#include "lisp.h"
#include "globals.h"
#include "validate.h"
#include "os.h"
#include "internals.h"
#include "arch.h"
#include "lispregs.h"
#include "signal.h"
#include "alloc.h"
#include "interrupt.h"
#include "interr.h"
#include "breakpoint.h"

extern char call_into_lisp_LRA[], call_into_lisp_end[];

hallgren's avatar
hallgren committed
#define BREAKPOINT_INST 0

hallgren's avatar
hallgren committed
{
    if (mmap((os_vm_address_t) call_into_lisp_LRA_page, OS_VM_DEFAULT_PAGESIZE,
	     OS_VM_PROT_ALL, MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, -1, 0)
	== (os_vm_address_t) - 1)
	perror("mmap");
    memcpy(call_into_lisp_LRA_page, call_into_lisp_LRA, OS_VM_DEFAULT_PAGESIZE);
    os_flush_icache((os_vm_address_t) call_into_lisp_LRA_page,
		    OS_VM_DEFAULT_PAGESIZE);
    return NULL;
hallgren's avatar
hallgren committed
}

os_vm_address_t
arch_get_bad_addr(int sig, int code, struct sigcontext * scp)
hallgren's avatar
hallgren committed
{
    unsigned int badinst;
hallgren's avatar
hallgren committed

    if ((scp->sc_pc & 3) != 0)
	return NULL;
hallgren's avatar
hallgren committed

    if ((scp->sc_pc < READ_ONLY_SPACE_START ||
	 scp->sc_pc >= READ_ONLY_SPACE_START + READ_ONLY_SPACE_SIZE) &&
	((lispobj *) scp->sc_pc < current_dynamic_space ||
	 (lispobj *) scp->sc_pc >= current_dynamic_space + dynamic_space_size))
	return NULL;
hallgren's avatar
hallgren committed

    badinst = *(unsigned int *) scp->sc_pc;
hallgren's avatar
hallgren committed

    if (((badinst >> 27) != 0x16)	/* STL or STQ */
	&&((badinst >> 27) != 0x13))	/* STS or STT */
	return NULL;		/* Otherwise forget about address */
hallgren's avatar
hallgren committed

    return (os_vm_address_t) (scp->sc_regs[(badinst >> 16) & 0x1f] +
			      (badinst & 0xffff));
hallgren's avatar
hallgren committed
}

void
arch_skip_instruction(scp)
     struct sigcontext *scp;
hallgren's avatar
hallgren committed
{
hallgren's avatar
hallgren committed
}

unsigned char *
arch_internal_error_arguments(struct sigcontext *scp)
hallgren's avatar
hallgren committed
{
    return (unsigned char *) (scp->sc_pc + 4);
hallgren's avatar
hallgren committed
}

boolean
arch_pseudo_atomic_atomic(struct sigcontext *scp)
hallgren's avatar
hallgren committed
{
    return (scp->sc_regs[reg_ALLOC] & 1);
hallgren's avatar
hallgren committed
}

void
arch_set_pseudo_atomic_interrupted(struct sigcontext *scp)
hallgren's avatar
hallgren committed
{
pw's avatar
pw committed
#ifdef __linux__
    scp->sc_regs[reg_ALLOC] |= (1 << 63);
pw's avatar
pw committed
#else
    scp->sc_regs[reg_ALLOC] |= 2;
pw's avatar
pw committed
#endif
hallgren's avatar
hallgren committed
}

unsigned long
arch_install_breakpoint(void *pc)
hallgren's avatar
hallgren committed
{
    unsigned int *ptr = (unsigned int *) pc;
    unsigned long result = (unsigned long) *ptr;

    *ptr = BREAKPOINT_INST;

    os_flush_icache((os_vm_address_t) ptr, sizeof(unsigned long));
hallgren's avatar
hallgren committed
}

void
arch_remove_breakpoint(void *pc, unsigned long orig_inst)
hallgren's avatar
hallgren committed
{
    unsigned int *ptr = (unsigned int) pc;

    *ptr = orig_inst;
    os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
hallgren's avatar
hallgren committed
}

static unsigned int *skipped_break_addr, displaced_after_inst, after_breakpoint;
pw's avatar
pw committed

static sigset_t orig_sigmask;
hallgren's avatar
hallgren committed

hallgren's avatar
hallgren committed
unsigned int
emulate_branch(struct sigcontext *scp, unsigned long orig_inst)
hallgren's avatar
hallgren committed
{
    int op = orig_inst >> 26;
    int reg_a = (orig_inst >> 21) & 0x1f;
    int reg_b = (orig_inst >> 16) & 0x1f;
    int fn = orig_inst & 0xffff;
    int disp =

	(orig_inst & (1 << 20)) ? orig_inst | (-1 << 21) : orig_inst & 0x1fffff;
    int next_pc = scp->sc_pc;
    int branch = NULL;

    switch (op) {
      case 0x1a:		/* jmp, jsr, jsr_coroutine, ret */
	  scp->sc_regs[reg_a] = scp->sc_pc;
	  scp->sc_pc = scp->sc_regs[reg_b] & ~3;
	  break;
      case 0x30:		/* br */
	  scp->sc_regs[reg_a] = scp->sc_pc;
	  branch = 1;
	  break;
      case 0x31:		/* fbeq */
	  if (scp->sc_fpregs[reg_a] == 0)
	      branch = 1;
	  break;
      case 0x32:		/* fblt */
	  if (scp->sc_fpregs[reg_a] < 0)
	      branch = 1;
	  break;
      case 0x33:		/* fble */
	  if (scp->sc_fpregs[reg_a] <= 0)
	      branch = 1;
	  break;
      case 0x34:		/* bsr */
	  scp->sc_regs[reg_a] = scp->sc_pc;
	  branch = 1;
	  break;
      case 0x35:		/* fbne */
	  if (scp->sc_regs[reg_a] != 0)
	      branch = 1;
	  break;
      case 0x36:		/* fbge */
	  if (scp->sc_fpregs[reg_a] >= 0)
	      branch = 1;
	  break;
      case 0x37:		/* fbgt */
	  if (scp->sc_fpregs[reg_a] > 0)
	      branch = 1;
	  break;
      case 0x38:		/* blbc */
	  if ((scp->sc_regs[reg_a] & 1) == 0)
	      branch = 1;
	  break;
      case 0x39:		/* beq */
	  if (scp->sc_regs[reg_a] == 0)
	      branch = 1;
	  break;
      case 0x3a:		/* blt */
	  if (scp->sc_regs[reg_a] < 0)
	      branch = 1;
	  break;
      case 0x3b:		/* ble */
	  if (scp->sc_regs[reg_a] <= 0)
	      branch = 1;
	  break;
      case 0x3c:		/* blbs */
	  if ((scp->sc_regs[reg_a] & 1) != 0)
	      branch = 1;
	  break;
      case 0x3d:		/* bne */
	  if (scp->sc_regs[reg_a] != 0)
	      branch = 1;
	  break;
      case 0x3e:		/* bge */
	  if (scp->sc_regs[reg_a] >= 0)
	      branch = 1;
	  break;
      case 0x3f:		/* bgt */
	  if (scp->sc_regs[reg_a] > 0)
	      branch = 1;
	  break;
    }
    if (branch)
	next_pc += disp * 4;
    return next_pc;
void
arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst)
hallgren's avatar
hallgren committed
{
    unsigned int *pc = scp->sc_pc;
    unsigned int *next_pc;
    unsigned int next_inst;
    int op = orig_inst >> 26;;

pw's avatar
pw committed
#if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6))
    orig_sigmask = context->uc_sigmask;
    FILLBLOCKSET(&context->uc_sigmask);
pw's avatar
pw committed
#else
    {
	sigset_t temp;

	sigemptyset(&temp);
	orig_sigmask.__val[0] = scp->uc_sigmask;
	temp.__val[0] = scp->uc_sigmask;
	FILLBLOCKSET(&temp);

	scp->uc_sigmask = temp.__val[0];
    }
pw's avatar
pw committed
#endif
    /* Figure out where the displaced inst is going */
    if (op == 0x1a || op & 0xf == 0x30)	/* branch...ugh */
	next_pc = (unsigned int *) emulate_branch(scp, orig_inst);
    else
	next_pc = pc + 1;
    /* Put the original instruction back. */
    *pc = orig_inst;
    os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
    skipped_break_addr = pc;
    /* set the after breakpoint */
    displaced_after_inst = *next_pc;
    *next_pc = BREAKPOINT_INST;
    after_breakpoint = 1;
    os_flush_icache((os_vm_address_t) next_pc, sizeof(unsigned long));

    sigreturn(scp);
hallgren's avatar
hallgren committed
}

hallgren's avatar
hallgren committed
#define AfterBreakpoint 100

static void
sigtrap_handler(int signal, int code, struct sigcontext *scp)
hallgren's avatar
hallgren committed
{
    /* Don't disallow recursive breakpoint traps.  Otherwise, we can't */
    /* use debugger breakpoints anywhere in here. */
    sigsetmask(scp->sc_mask);

    if (*(unsigned int *) (scp->sc_pc - 4) == BREAKPOINT_INST) {
	if (after_breakpoint)
	    code = AfterBreakpoint;
	else
	    code = trap_Breakpoint;
    } else
	code = *(u32 *) scp->sc_pc;
hallgren's avatar
hallgren committed

    switch (code) {
      case trap_PendingInterrupt:
	  arch_skip_instruction(scp);
	  interrupt_handle_pending(scp);
	  break;
hallgren's avatar
hallgren committed

      case trap_Halt:
	  fake_foreign_function_call(scp);
	  lose("%%primitive halt called; the party is over.\n");
hallgren's avatar
hallgren committed

      case trap_Error:
      case trap_Cerror:
	  interrupt_internal_error(signal, code, scp, code == trap_Cerror);
	  break;
hallgren's avatar
hallgren committed

      case trap_Breakpoint:
	  scp->sc_pc -= 4;
	  handle_breakpoint(signal, code, scp);
	  break;
hallgren's avatar
hallgren committed

      case trap_FunctionEndBreakpoint:
	  scp->sc_pc -= 4;
	  scp->sc_pc = (int) handle_function_end_breakpoint(signal, code, scp);
	  break;
hallgren's avatar
hallgren committed

      case AfterBreakpoint:
	  scp->sc_pc -= 4;
	  *skipped_break_addr = BREAKPOINT_INST;
	  os_flush_icache((os_vm_address_t) skipped_break_addr,

			  sizeof(unsigned long));
	  skipped_break_addr = NULL;
	  *(unsigned int *) scp->sc_pc = displaced_after_inst;
	  os_flush_icache((os_vm_address_t) scp->sc_pc, sizeof(unsigned long));

pw's avatar
pw committed
#if  !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6))
	  scp->sc_mask = orig_sigmask;
pw's avatar
pw committed
#else
	  scp->sc_mask = orig_sigmask.__val[0];
pw's avatar
pw committed
#endif
	  after_breakpoint = NULL;
	  break;
hallgren's avatar
hallgren committed
      default:
	  interrupt_handle_now(signal, code, scp);
	  break;
hallgren's avatar
hallgren committed
    }
}

static void
sigfpe_handler(int signal, int code, struct sigcontext *scp)
hallgren's avatar
hallgren committed
{
}

arch_install_interrupt_handlers(void)
hallgren's avatar
hallgren committed
{
    interrupt_install_low_level_handler(SIGILL, sigtrap_handler);
    interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler);
    interrupt_install_low_level_handler(SIGFPE, sigfpe_handler);
hallgren's avatar
hallgren committed
}

extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs);
hallgren's avatar
hallgren committed

lispobj
funcall0(lispobj function)
hallgren's avatar
hallgren committed
{
    lispobj *args = current_control_stack_pointer;

    return call_into_lisp(function, args, 0);
}

lispobj
funcall1(lispobj function, lispobj arg0)
hallgren's avatar
hallgren committed
{
    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)
hallgren's avatar
hallgren committed
{
    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)
hallgren's avatar
hallgren committed
{
    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);
}


/* This is apparently called by emulate_branch, but isn't defined.  So */
/* just do nothing and hope it works... */

hallgren's avatar
hallgren committed
{
}