/[cmucl]/src/lisp/hppa-arch.c
ViewVC logotype

Contents of /src/lisp/hppa-arch.c

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5