src/lisp/hppa-arch.c

   1 /*
   2
   3  This code was written as part of the CMU Common Lisp project at
   4  Carnegie Mellon University, and has been placed in the public domain.
   5
   6 */
   7
   8 #include <stdio.h>
   9 #include <machine/trap.h>
  10
  11 #include "lisp.h"
  12 #include "globals.h"
  13 #include "validate.h"
  14 #include "os.h"
  15 #include "arch.h"
  16 #include "lispregs.h"
  17 #include "signal.h"
  18 #include "internals.h"
  19 #include "breakpoint.h"
  20
  21 char *
  22 arch_init(void)
  23 {
  24     return NULL;
  25 }
  26
  27 os_vm_address_t
  28 arch_get_bad_addr(int signal, int code, struct sigcontext * scp)
  29 {
  30 #ifdef hpux
  31     struct save_state *state;
  32     os_vm_address_t addr;
  33
  34     state = (struct save_state *) (&(scp->sc_sl.sl_ss));
  35
  36     if (state == NULL)
  37         return NULL;
  38
  39     /* Check the instruction address first. */
  40     addr = (os_vm_address_t) ((unsigned long) scp->sc_pcoq_head & ~3);
  41     if (addr < (os_vm_address_t) 0x1000)
  42         return addr;
  43
  44     /* Otherwise, it must have been a data fault. */
  45     return (os_vm_address_t) state->ss_cr21;
  46 #else
  47     struct hp800_thread_state *state;
  48     os_vm_address_t addr;
  49
  50     state = (struct hp800_thread_state *) (scp->sc_ap);
  51
  52     if (state == NULL)
  53         return NULL;
  54
  55     /* Check the instruction address first. */
  56     addr = scp->sc_pcoqh & ~3;
  57     if (addr < 0x1000)
  58         return addr;
  59
  60     /* Otherwise, it must have been a data fault. */
  61     return state->cr21;
  62 #endif
  63 }
  64
  65 unsigned char *
  66 arch_internal_error_arguments(struct sigcontext *scp)
  67 {
  68 #ifdef hpux
  69     return (unsigned char *) ((scp->sc_pcoq_head & ~0x3) + 4);
  70 #else
  71     return (unsigned char *) ((scp->sc_pcoqh & ~0x3) + 4);
  72 #endif
  73 }
  74
  75 boolean
  76 arch_pseudo_atomic_atomic(struct sigcontext *scp)
  77 {
  78     /* Pseudo-atomic-atomic is implemented by oring 0x4 into ALLOC. */
  79
  80     if (SC_REG(scp, reg_ALLOC) & 0x4)
  81         return TRUE;
  82     else
  83         return FALSE;
  84 }
  85
  86 void
  87 arch_set_pseudo_atomic_interrupted(struct sigcontext *scp)
  88 {
  89     /* Pseudo-atomic-atomic is implemented by oring 0x1 into ALLOC. */
  90
  91     SC_REG(scp, reg_ALLOC) |= 1;
  92 }
  93
  94 void
  95 arch_skip_instruction(struct sigcontext *scp)
  96 {
  97     /* Skip the offending instruction */
  98 #ifdef hpux
  99     scp->sc_pcoq_head = scp->sc_pcoq_tail;
 100     scp->sc_pcoq_tail += 4;
 101 #else
 102     scp->sc_pcoqh = scp->sc_pcoqt;
 103     scp->sc_pcoqt += 4;
 104 #endif
 105 }
 106
 107 unsigned long
 108 arch_install_breakpoint(void *pc)
 109 {
 110     unsigned long *ulpc = (unsigned long *) pc;
 111     unsigned long orig_inst = *ulpc;
 112
 113     *ulpc = trap_Breakpoint;
 114     os_flush_icache((os_vm_address_t) pc, sizeof(*ulpc));
 115     return orig_inst;
 116 }
 117
 118 void
 119 arch_remove_breakpoint(void *pc, unsigned long orig_inst)
 120 {
 121     unsigned long *ulpc = (unsigned long *) pc;
 122
 123     *ulpc = orig_inst;
 124     os_flush_icache((os_vm_address_t) pc, sizeof(*ulpc));
 125 }
 126
 127 #ifdef hpux
 128 extern void SingleStepTraps();
 129 static unsigned long *BreakpointAddr = NULL;
 130 static unsigned long NextPc = NULL;
 131 #endif
 132
 133 void
 134 arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst)
 135 {
 136 #ifdef hpux
 137     /* We change the next-pc to point to a breakpoint instruction, restore */
 138     /* the original instruction, and exit.  We would like to be able to */
 139     /* sigreturn, but we can't, because this is hpux. */
 140     unsigned long *pc = (unsigned long *) (SC_PC(scp) & ~3);
 141
 142     NextPc = SC_NPC(scp);
 143     SC_NPC(scp) = (unsigned) SingleStepTraps | (SC_NPC(scp) & 3);
 144
 145     BreakpointAddr = pc;
 146     *pc = orig_inst;
 147     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
 148 #else
 149     /* We set the recovery counter to cover one instruction, put the */
 150     /* original instruction back in, and then resume.  We will then trap */
 151     /* after executing that one instruction, at which time we can put */
 152     /* the breakpoint back in. */
 153
 154     ((struct hp800_thread_state *) scp->sc_ap)->cr0 = 1;
 155     scp->sc_ps |= 0x10;
 156     *(unsigned long *) SC_PC(scp) = orig_inst;
 157
 158     sigreturn(scp);
 159 #endif
 160 }
 161
 162 #ifdef hpux
 163 static void
 164 restore_breakpoint(struct sigcontext *scp)
 165 {
 166     /* We just single-stepped over an instruction that we want to replace */
 167     /* with a breakpoint.  So we put the breakpoint back in, and tweek the */
 168     /* state so that we will continue as if nothing happened. */
 169
 170     if (NextPc == NULL)
 171         lose("SingleStepBreakpoint trap at strange time.");
 172
 173     if ((SC_PC(scp) & ~3) == (unsigned long) SingleStepTraps) {
 174         /* The next instruction was not nullified. */
 175         SC_PC(scp) = NextPc;
 176         if ((SC_NPC(scp) & ~3) == (unsigned long) SingleStepTraps + 4) {
 177             /* The instruction we just stepped over was not a branch, so */
 178             /* we need to fix it up.  If it was a branch, it will point to */
 179             /* the correct place. */
 180             SC_NPC(scp) = NextPc + 4;
 181         }
 182     } else {
 183         /* The next instruction was nullified, so we want to skip it. */
 184         SC_PC(scp) = NextPc + 4;
 185         SC_NPC(scp) = NextPc + 8;
 186     }
 187     NextPc = NULL;
 188
 189     if (BreakpointAddr) {
 190         *BreakpointAddr = trap_Breakpoint;
 191         os_flush_icache((os_vm_address_t) BreakpointAddr,
 192
 193                         sizeof(unsigned long));
 194         BreakpointAddr = NULL;
 195     }
 196 }
 197 #endif
 198
 199 static void
 200 sigtrap_handler(int signal, int code, struct sigcontext *scp)
 201 {
 202     unsigned long bad_inst;
 203
 204     sigsetmask(scp->sc_mask);
 205
 206 #if 0
 207     printf("sigtrap_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh,
 208            SC_REG(scp, reg_ALLOC));
 209 #endif
 210
 211 #ifdef hpux
 212     bad_inst = *(unsigned long *) (scp->sc_pcoq_head & ~3);
 213 #else
 214     bad_inst = *(unsigned long *) (scp->sc_pcoqh & ~3);
 215 #endif
 216
 217     if (bad_inst & 0xfc001fe0)
 218         interrupt_handle_now(signal, code, scp);
 219     else {
 220         int im5 = bad_inst & 0x1f;
 221
 222         switch (im5) {
 223           case trap_Halt:
 224               fake_foreign_function_call(scp);
 225               lose("%%primitive halt called; the party is over.\n");
 226
 227           case trap_PendingInterrupt:
 228               arch_skip_instruction(scp);
 229               interrupt_handle_pending(scp);
 230               break;
 231
 232           case trap_Error:
 233           case trap_Cerror:
 234               interrupt_internal_error(signal, code, scp, im5 == trap_Cerror);
 235               break;
 236
 237           case trap_Breakpoint:
 238               sigsetmask(scp->sc_mask);
 239               handle_breakpoint(signal, code, scp);
 240               break;
 241
 242           case trap_FunctionEndBreakpoint:
 243               sigsetmask(scp->sc_mask);
 244               {
 245                   unsigned long pc;
 246
 247                   pc = (unsigned long)
 248                       handle_function_end_breakpoint(signal, code, scp);
 249 #ifdef hpux
 250                   scp->sc_pcoq_head = pc;
 251                   scp->sc_pcoq_tail = pc + 4;
 252 #else
 253                   scp->sc_pcoqh = pc;
 254                   scp->sc_pcoqt = pc + 4;
 255 #endif
 256               }
 257               break;
 258
 259           case trap_SingleStepBreakpoint:
 260               restore_breakpoint(scp);
 261               break;
 262
 263           default:
 264               interrupt_handle_now(signal, code, scp);
 265               break;
 266         }
 267     }
 268 }
 269
 270 static void
 271 sigfpe_handler(int signal, int code, struct sigcontext *scp)
 272 {
 273     unsigned long badinst;
 274     int opcode, r1, r2, t;
 275     long op1, op2, res;
 276
 277 #if 0
 278     printf("sigfpe_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh,
 279            SC_REG(scp, reg_ALLOC));
 280 #endif
 281
 282     switch (code) {
 283       case I_OVFLO:
 284           badinst = *(unsigned long *) (SC_PC(scp) & ~3);
 285           opcode = badinst >> 26;
 286
 287           if (opcode == 2) {
 288               /* reg/reg inst. */
 289               r1 = (badinst >> 16) & 0x1f;
 290               op1 = fixnum_value(SC_REG(scp, r1));
 291               r2 = (badinst >> 21) & 0x1f;
 292               op2 = fixnum_value(SC_REG(scp, r2));
 293               t = badinst & 0x1f;
 294
 295               switch ((badinst >> 5) & 0x7f) {
 296                 case 0x70:
 297                     /* Add and trap on overflow. */
 298                     res = op1 + op2;
 299                     break;
 300
 301                 case 0x60:
 302                     /* Subtract and trap on overflow. */
 303                     res = op1 - op2;
 304                     break;
 305
 306                 default:
 307                     goto not_interesting;
 308               }
 309           } else if ((opcode & 0x37) == 0x25 && (badinst & (1 << 11))) {
 310               /* Add or subtract immediate. */
 311               op1 = ((badinst >> 3) & 0xff) | ((-badinst & 1) << 8);
 312               r2 = (badinst >> 16) & 0x1f;
 313               op2 = fixnum_value(SC_REG(scp, r1));
 314               t = (badinst >> 21) & 0x1f;
 315               if (opcode == 0x2d)
 316                   res = op1 + op2;
 317               else
 318                   res = op1 - op2;
 319           } else
 320               goto not_interesting;
 321
 322           current_dynamic_space_free_pointer =
 323               (lispobj *) SC_REG(scp, reg_ALLOC);
 324           SC_REG(scp, t) = alloc_number(res);
 325           SC_REG(scp, reg_ALLOC)
 326               = (unsigned long) current_dynamic_space_free_pointer;
 327           arch_skip_instruction(scp);
 328
 329           break;
 330
 331       case I_COND:
 332           badinst = *(unsigned long *) (SC_PC(scp) & ~3);
 333           if ((badinst & 0xfffff800) ==
 334               (0xb000e000 | reg_ALLOC << 21 | reg_ALLOC << 16)) {
 335               /* It is an ADDIT,OD i,ALLOC,ALLOC instruction that trapped. */
 336               /* That means that it is the end of a pseudo-atomic.  So do the */
 337               /* add stripping off the pseudo-atomic-interrupted bit, and then */
 338               /* tell the machine-independent code to process the pseudo- */
 339               /* atomic. */
 340               int immed = (badinst >> 1) & 0x3ff;
 341
 342               if (badinst & 1)
 343                   immed |= -1 << 10;
 344               SC_REG(scp, reg_ALLOC) += (immed - 1);
 345               arch_skip_instruction(scp);
 346               interrupt_handle_pending(scp);
 347               break;
 348           }
 349           /* else drop-through. */
 350       default:
 351         not_interesting:
 352           interrupt_handle_now(signal, code, scp);
 353     }
 354 }
 355
 356 void
 357 arch_install_interrupt_handlers(void)
 358 {
 359 #ifdef hpux
 360     interrupt_install_low_level_handler(SIGILL, sigtrap_handler);
 361 #endif
 362     interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler);
 363     interrupt_install_low_level_handler(SIGFPE, sigfpe_handler);
 364 }
 365
 366 lispobj
 367 funcall0(lispobj function)
 368 {
 369     lispobj *args = current_control_stack_pointer;
 370
 371     return call_into_lisp(function, args, 0);
 372 }
 373
 374 lispobj
 375 funcall1(lispobj function, lispobj arg0)
 376 {
 377     lispobj *args = current_control_stack_pointer;
 378
 379     current_control_stack_pointer += 1;
 380     args[0] = arg0;
 381
 382     return call_into_lisp(function, args, 1);
 383 }
 384
 385 lispobj
 386 funcall2(lispobj function, lispobj arg0, lispobj arg1)
 387 {
 388     lispobj *args = current_control_stack_pointer;
 389
 390     current_control_stack_pointer += 2;
 391     args[0] = arg0;
 392     args[1] = arg1;
 393
 394     return call_into_lisp(function, args, 2);
 395 }
 396
 397 lispobj
 398 funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
 399 {
 400     lispobj *args = current_control_stack_pointer;
 401
 402     current_control_stack_pointer += 3;
 403     args[0] = arg0;
 404     args[1] = arg1;
 405     args[2] = arg2;
 406
 407     return call_into_lisp(function, args, 3);
 408 }