Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / hppa-arch.c
CommitLineData
82a2bc67 1/*
2
82a2bc67 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
c4f89427 8#include <stdio.h>
c4f89427 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
9a8c1c2f 21char *
22arch_init(void)
c4f89427 23{
24 return NULL;
25}
26
9a8c1c2f 27os_vm_address_t
28arch_get_bad_addr(int signal, int code, struct sigcontext * scp)
c4f89427 29{
b926a238 30#ifdef hpux
31 struct save_state *state;
32 os_vm_address_t addr;
33
9a8c1c2f 34 state = (struct save_state *) (&(scp->sc_sl.sl_ss));
b926a238 35
36 if (state == NULL)
37 return NULL;
38
39 /* Check the instruction address first. */
9a8c1c2f 40 addr = (os_vm_address_t) ((unsigned long) scp->sc_pcoq_head & ~3);
41 if (addr < (os_vm_address_t) 0x1000)
b926a238 42 return addr;
43
44 /* Otherwise, it must have been a data fault. */
9a8c1c2f 45 return (os_vm_address_t) state->ss_cr21;
b926a238 46#else
c4f89427 47 struct hp800_thread_state *state;
48 os_vm_address_t addr;
49
9a8c1c2f 50 state = (struct hp800_thread_state *) (scp->sc_ap);
c4f89427 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;
b926a238 62#endif
c4f89427 63}
64
9a8c1c2f 65unsigned char *
66arch_internal_error_arguments(struct sigcontext *scp)
c4f89427 67{
b926a238 68#ifdef hpux
9a8c1c2f 69 return (unsigned char *) ((scp->sc_pcoq_head & ~0x3) + 4);
b926a238 70#else
9a8c1c2f 71 return (unsigned char *) ((scp->sc_pcoqh & ~0x3) + 4);
b926a238 72#endif
c4f89427 73}
74
9a8c1c2f 75boolean
76arch_pseudo_atomic_atomic(struct sigcontext *scp)
c4f89427 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
9a8c1c2f 86void
87arch_set_pseudo_atomic_interrupted(struct sigcontext *scp)
c4f89427 88{
89 /* Pseudo-atomic-atomic is implemented by oring 0x1 into ALLOC. */
90
91 SC_REG(scp, reg_ALLOC) |= 1;
92}
93
9a8c1c2f 94void
95arch_skip_instruction(struct sigcontext *scp)
c4f89427 96{
97 /* Skip the offending instruction */
b926a238 98#ifdef hpux
99 scp->sc_pcoq_head = scp->sc_pcoq_tail;
100 scp->sc_pcoq_tail += 4;
101#else
c4f89427 102 scp->sc_pcoqh = scp->sc_pcoqt;
103 scp->sc_pcoqt += 4;
b926a238 104#endif
c4f89427 105}
106
9a8c1c2f 107unsigned long
108arch_install_breakpoint(void *pc)
c4f89427 109{
9a8c1c2f 110 unsigned long *ulpc = (unsigned long *) pc;
c4f89427 111 unsigned long orig_inst = *ulpc;
112
113 *ulpc = trap_Breakpoint;
9a8c1c2f 114 os_flush_icache((os_vm_address_t) pc, sizeof(*ulpc));
c4f89427 115 return orig_inst;
116}
117
9a8c1c2f 118void
119arch_remove_breakpoint(void *pc, unsigned long orig_inst)
c4f89427 120{
9a8c1c2f 121 unsigned long *ulpc = (unsigned long *) pc;
c4f89427 122
123 *ulpc = orig_inst;
9a8c1c2f 124 os_flush_icache((os_vm_address_t) pc, sizeof(*ulpc));
c4f89427 125}
126
1a13dcc2 127#ifdef hpux
128extern void SingleStepTraps();
129static unsigned long *BreakpointAddr = NULL;
130static unsigned long NextPc = NULL;
131#endif
132
9a8c1c2f 133void
134arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst)
c4f89427 135{
1a13dcc2 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. */
9a8c1c2f 140 unsigned long *pc = (unsigned long *) (SC_PC(scp) & ~3);
1a13dcc2 141
142 NextPc = SC_NPC(scp);
9a8c1c2f 143 SC_NPC(scp) = (unsigned) SingleStepTraps | (SC_NPC(scp) & 3);
1a13dcc2 144
145 BreakpointAddr = pc;
146 *pc = orig_inst;
9a8c1c2f 147 os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
1a13dcc2 148#else
c4f89427 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
9a8c1c2f 154 ((struct hp800_thread_state *) scp->sc_ap)->cr0 = 1;
c4f89427 155 scp->sc_ps |= 0x10;
9a8c1c2f 156 *(unsigned long *) SC_PC(scp) = orig_inst;
c4f89427 157
c4f89427 158 sigreturn(scp);
b926a238 159#endif
c4f89427 160}
161
1a13dcc2 162#ifdef hpux
9a8c1c2f 163static void
164restore_breakpoint(struct sigcontext *scp)
1a13dcc2 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
9a8c1c2f 173 if ((SC_PC(scp) & ~3) == (unsigned long) SingleStepTraps) {
1a13dcc2 174 /* The next instruction was not nullified. */
175 SC_PC(scp) = NextPc;
9a8c1c2f 176 if ((SC_NPC(scp) & ~3) == (unsigned long) SingleStepTraps + 4) {
1a13dcc2 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 }
9a8c1c2f 182 } else {
1a13dcc2 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;
9a8c1c2f 191 os_flush_icache((os_vm_address_t) BreakpointAddr,
192
1a13dcc2 193 sizeof(unsigned long));
194 BreakpointAddr = NULL;
195 }
196}
197#endif
198
9a8c1c2f 199static void
200sigtrap_handler(int signal, int code, struct sigcontext *scp)
c4f89427 201{
202 unsigned long bad_inst;
203
204 sigsetmask(scp->sc_mask);
205
5a3ea4db 206#if 0
207 printf("sigtrap_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh,
9a8c1c2f 208 SC_REG(scp, reg_ALLOC));
5a3ea4db 209#endif
c4f89427 210
b926a238 211#ifdef hpux
9a8c1c2f 212 bad_inst = *(unsigned long *) (scp->sc_pcoq_head & ~3);
b926a238 213#else
9a8c1c2f 214 bad_inst = *(unsigned long *) (scp->sc_pcoqh & ~3);
b926a238 215#endif
c4f89427 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:
9a8c1c2f 224 fake_foreign_function_call(scp);
225 lose("%%primitive halt called; the party is over.\n");
c4f89427 226
6e1801ca 227 case trap_PendingInterrupt:
9a8c1c2f 228 arch_skip_instruction(scp);
229 interrupt_handle_pending(scp);
230 break;
6e1801ca 231
c4f89427 232 case trap_Error:
233 case trap_Cerror:
9a8c1c2f 234 interrupt_internal_error(signal, code, scp, im5 == trap_Cerror);
235 break;
c4f89427 236
237 case trap_Breakpoint:
9a8c1c2f 238 sigsetmask(scp->sc_mask);
239 handle_breakpoint(signal, code, scp);
240 break;
c4f89427 241
242 case trap_FunctionEndBreakpoint:
9a8c1c2f 243 sigsetmask(scp->sc_mask);
244 {
245 unsigned long pc;
246
247 pc = (unsigned long)
248 handle_function_end_breakpoint(signal, code, scp);
b926a238 249#ifdef hpux
9a8c1c2f 250 scp->sc_pcoq_head = pc;
251 scp->sc_pcoq_tail = pc + 4;
b926a238 252#else
9a8c1c2f 253 scp->sc_pcoqh = pc;
254 scp->sc_pcoqt = pc + 4;
b926a238 255#endif
9a8c1c2f 256 }
257 break;
1a13dcc2 258
259 case trap_SingleStepBreakpoint:
9a8c1c2f 260 restore_breakpoint(scp);
261 break;
c4f89427 262
263 default:
9a8c1c2f 264 interrupt_handle_now(signal, code, scp);
265 break;
c4f89427 266 }
267 }
268}
269
9a8c1c2f 270static void
271sigfpe_handler(int signal, int code, struct sigcontext *scp)
c4f89427 272{
f5a60c0a 273 unsigned long badinst;
274 int opcode, r1, r2, t;
275 long op1, op2, res;
276
5a3ea4db 277#if 0
278 printf("sigfpe_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh,
9a8c1c2f 279 SC_REG(scp, reg_ALLOC));
5a3ea4db 280#endif
281
f5a60c0a 282 switch (code) {
283 case I_OVFLO:
9a8c1c2f 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;
f5a60c0a 330
331 case I_COND:
9a8c1c2f 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. */
f5a60c0a 350 default:
9a8c1c2f 351 not_interesting:
352 interrupt_handle_now(signal, code, scp);
f5a60c0a 353 }
c4f89427 354}
355
9a8c1c2f 356void
357arch_install_interrupt_handlers(void)
c4f89427 358{
b926a238 359#ifdef hpux
9a8c1c2f 360 interrupt_install_low_level_handler(SIGILL, sigtrap_handler);
b926a238 361#endif
9a8c1c2f 362 interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler);
363 interrupt_install_low_level_handler(SIGFPE, sigfpe_handler);
c4f89427 364}
365
9a8c1c2f 366lispobj
367funcall0(lispobj function)
c4f89427 368{
369 lispobj *args = current_control_stack_pointer;
370
371 return call_into_lisp(function, args, 0);
372}
373
9a8c1c2f 374lispobj
375funcall1(lispobj function, lispobj arg0)
c4f89427 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
9a8c1c2f 385lispobj
386funcall2(lispobj function, lispobj arg0, lispobj arg1)
c4f89427 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
9a8c1c2f 397lispobj
398funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
c4f89427 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}