0.7.1.20:
[sbcl.git] / src / runtime / sparc-arch.c
1 /*
2
3  $Header$
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
12 #include "runtime.h"
13 #include "arch.h"
14 #include "sbcl.h"
15 #include "globals.h"
16 #include "validate.h"
17 #include "os.h"
18 #include "lispregs.h"
19 #include "signal.h"
20 #include "alloc.h"
21 #include "interrupt.h"
22 #include "interr.h"
23 #include "breakpoint.h"
24 #include "monitor.h"
25
26 #ifdef linux
27 extern int early_kernel;
28 #endif
29
30 void arch_init(void)
31 {
32     return;
33 }
34
35 os_vm_address_t arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context)
36 {
37     unsigned long badinst;
38     unsigned long *pc;
39     int rs1; 
40
41     pc = (unsigned long *)(*os_context_pc_addr(context));
42
43     /* On the sparc, we have to decode the instruction. */
44
45     /* Make sure it's not the pc thats bogus, and that it was lisp code */
46     /* that caused the fault. */
47     if ((unsigned long) pc & 3) {
48       /* Unaligned */
49       return NULL;
50     }
51     if ((pc < READ_ONLY_SPACE_START || 
52          pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) &&
53         (pc < current_dynamic_space ||
54          pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE)) {
55       return NULL;
56     }
57
58     badinst = *pc;
59
60     if ((badinst >> 30) != 3)
61         /* All load/store instructions have op = 11 (binary) */
62         return 0;
63
64     rs1 = (badinst>>14)&0x1f;
65
66     if (badinst & (1<<13)) {
67         /* r[rs1] + simm(13) */
68         int simm13 = badinst & 0x1fff;
69
70         if (simm13 & (1<<12))
71             simm13 |= -1<<13;
72
73         return (os_vm_address_t)
74           (*os_context_register_addr(context, rs1)+simm13);
75     }
76     else {
77         /* r[rs1] + r[rs2] */
78         int rs2 = badinst & 0x1f;
79
80         return (os_vm_address_t)
81           (*os_context_register_addr(context, rs1) + 
82            *os_context_register_addr(context, rs2));
83     }
84 }
85
86 void arch_skip_instruction(os_context_t *context)
87 {
88   ((char *) *os_context_pc_addr(context)) = ((char *) *os_context_npc_addr(context));
89   context->si_regs.npc += 4;
90 }
91
92 unsigned char *arch_internal_error_arguments(os_context_t *context)
93 {
94   return (unsigned char *)(*os_context_pc_addr(context) + 4);
95 }
96
97 boolean arch_pseudo_atomic_atomic(os_context_t *context)
98 {
99   return ((*os_context_register_addr(context,reg_ALLOC)) & 4);
100 }
101
102 void arch_set_pseudo_atomic_interrupted(os_context_t *context)
103 {
104   *os_context_register_addr(context,reg_ALLOC) |=  1;
105 }
106
107 unsigned long arch_install_breakpoint(void *pc)
108 {
109   unsigned long *ptr = (unsigned long *)pc;
110   unsigned long result = *ptr;
111   *ptr = trap_Breakpoint;
112   
113   os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
114   
115   return result;
116 }
117
118 void arch_remove_breakpoint(void *pc, unsigned long orig_inst)
119 {
120   *(unsigned long *)pc = orig_inst;
121   os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
122 }
123
124 static unsigned long *skipped_break_addr, displaced_after_inst;
125 static sigset_t orig_sigmask;
126
127 void arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
128 {
129   unsigned long *pc = (unsigned long *)(*os_context_pc_addr(context));
130   /* FIXME */
131   unsigned long *npc = &context->si_regs.npc;
132
133   /*  orig_sigmask = context->sigmask;
134       sigemptyset(&context->sigmask); */
135   /* FIXME!!! */
136   /* FILLBLOCKSET(&context->uc_sigmask);*/
137
138   *pc = orig_inst;
139   os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
140   skipped_break_addr = pc;
141   displaced_after_inst = *npc;
142   *npc = trap_AfterBreakpoint;
143   os_flush_icache((os_vm_address_t) npc, sizeof(unsigned long));
144
145   /* How much is this not going to work? */
146   sigreturn(context);
147 }
148
149 static int pseudo_atomic_trap_p(os_context_t *context)
150 {
151   unsigned int* pc;
152   unsigned int badinst;
153   int result;
154   
155   
156   pc = (unsigned int*) *os_context_pc_addr(context);
157   badinst = *pc;
158   result = 0;
159
160   /* Check to see if the current instruction is a trap #x40 */
161   /* FIXME: As written, this will not work when someone comes to port
162      this to Solaris. We have chosen trap 0x40 on SPARC Linux because
163      trap 0x10, used in CMUCL/Solaris, generates a sigtrap rather than
164      a sigill. This number should not be hardcoded, but should come,
165      if possible, from src/compiler/target/parms.lisp via sbcl.h --
166      CSR */
167   if (((badinst >> 30) == 2) && (((badinst >> 19) & 0x3f) == 0x3a)
168       && (((badinst >> 13) & 1) == 1) && ((badinst & 0x7f) == 0x40))
169     {
170       unsigned int previnst;
171       previnst = pc[-1];
172       /*
173        * Check to see if the previous instruction was an andcc alloc-tn,
174        * 3, zero-tn instruction.
175        */
176       if (((previnst >> 30) == 2) && (((previnst >> 19) & 0x3f) == 0x11)
177           && (((previnst >> 14) & 0x1f) == reg_ALLOC)
178           && (((previnst >> 25) & 0x1f) == reg_ZERO)
179           && (((previnst >> 13) & 1) == 1)
180           && ((previnst & 0x1fff) == 3))
181         {
182           result = 1;
183         }
184       else
185         {
186           /* FIXME: in the light of the comment above, this fprintf is
187              bogus. CSR */
188           fprintf(stderr, "Oops!  Got a trap 16 without a preceeding andcc!\n");
189         }
190     }
191   return result;
192 }
193
194 static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context)
195 {
196   os_context_t *context = arch_os_get_context(&void_context);
197
198   sigprocmask(SIG_SETMASK, &context->si_mask, 0);
199
200   if ((siginfo->si_code) == ILL_ILLOPC
201 #ifdef linux
202       || (early_kernel && (siginfo->si_code == 2))
203 #endif
204       ) {
205     int trap;
206     unsigned int inst;
207     unsigned int* pc = (unsigned int*) siginfo->si_addr;
208
209     inst = *pc;
210     trap = inst & 0x3fffff;
211     
212     switch (trap) {
213     case trap_PendingInterrupt:
214       arch_skip_instruction(context);
215       interrupt_handle_pending(context);
216       break;
217
218     case trap_Halt:
219       fake_foreign_function_call(context);
220       lose("%%primitive halt called; the party is over.\n");
221       
222     case trap_Error:
223     case trap_Cerror:
224       interrupt_internal_error(signal, siginfo, context, trap == trap_Cerror);
225       break;
226
227     case trap_Breakpoint:
228       handle_breakpoint(signal, siginfo, context);
229       break;
230
231     case trap_FunEndBreakpoint:
232       *os_context_pc_addr(context) = (int) handle_fun_end_breakpoint(signal, siginfo, context);
233       context->si_regs.npc = *os_context_pc_addr(context) + 4;
234       break;
235
236     case trap_AfterBreakpoint:
237       *skipped_break_addr = trap_Breakpoint;
238       skipped_break_addr = NULL;
239       *(unsigned long *) os_context_pc_addr(context) = displaced_after_inst;
240       /* context->sigmask = orig_sigmask; */
241       os_flush_icache((os_vm_address_t) os_context_pc_addr(context), sizeof(unsigned long));
242       break;
243       
244     default:
245       interrupt_handle_now(signal, siginfo, context);
246       break;
247     }
248   }
249   else if ((siginfo->si_code) == ILL_ILLTRP
250 #ifdef linux
251            || (early_kernel && (siginfo->si_code) == 192)
252 #endif
253            ) {
254     if (pseudo_atomic_trap_p(context)) {
255       /* A trap instruction from a pseudo-atomic.  We just need
256          to fixup up alloc-tn to remove the interrupted flag,
257          skip over the trap instruction, and then handle the
258          pending interrupt(s). */
259       *os_context_register_addr(context, reg_ALLOC) &= ~7;
260       arch_skip_instruction(context);
261       interrupt_handle_pending(context);
262     }
263     else {
264       interrupt_internal_error(signal, siginfo, context, 0);
265     }
266   }
267   else {
268     interrupt_handle_now(signal, siginfo, context);
269   }
270 }
271
272 static void sigemt_handler(int signal, siginfo_t *siginfo, void *void_context)
273 {
274   unsigned long badinst;
275   boolean subtract, immed;
276   int rd, rs1, op1, rs2, op2, result;
277   os_context_t *context = arch_os_get_context(&void_context);
278
279   badinst = *(unsigned long *)os_context_pc_addr(context);
280   if ((badinst >> 30) != 2 || ((badinst >> 20) & 0x1f) != 0x11) {
281     /* It wasn't a tagged add.  Pass the signal into lisp. */
282     interrupt_handle_now(signal, siginfo, context);
283     return;
284   }
285
286   fprintf(stderr, "SIGEMT trap handler with tagged op instruction!\n");
287   
288   /* Extract the parts of the inst. */
289   subtract = badinst & (1<<19);
290   rs1 = (badinst>>14) & 0x1f;
291   op1 = *os_context_register_addr(context, rs1);
292   
293   /* If the first arg is $ALLOC then it is really a signal-pending note */
294   /* for the pseudo-atomic noise. */
295   if (rs1 == reg_ALLOC) {
296     /* Perform the op anyway. */
297     op2 = badinst & 0x1fff;
298     if (op2 & (1<<12))
299       op2 |= -1<<13;
300     if (subtract)
301       result = op1 - op2;
302     else
303       result = op1 + op2;
304     *os_context_register_addr(context, reg_ALLOC) = result & ~7;
305     arch_skip_instruction(context);
306     interrupt_handle_pending(context);
307     return;
308   }
309
310   if ((op1 & 3) != 0) {
311     /* The first arg wan't a fixnum. */
312     interrupt_internal_error(signal, siginfo, context, 0);
313     return;
314   }
315
316   if (immed = badinst & (1<<13)) {
317     op2 = badinst & 0x1fff;
318     if (op2 & (1<<12))
319       op2 |= -1<<13;
320   }
321   else {
322     rs2 = badinst & 0x1f;
323     op2 = *os_context_register_addr(context, rs2);
324   }
325
326   if ((op2 & 3) != 0) {
327     /* The second arg wan't a fixnum. */
328     interrupt_internal_error(signal, siginfo, context, 0);
329     return;
330   }
331
332   rd = (badinst>>25) & 0x1f;
333   if (rd != 0) {
334     /* Don't bother computing the result unless we are going to use it. */
335     if (subtract)
336       result = (op1>>2) - (op2>>2);
337     else
338       result = (op1>>2) + (op2>>2);
339     
340     dynamic_space_free_pointer =
341       (lispobj *) *os_context_register_addr(context, reg_ALLOC);
342
343     *os_context_register_addr(context, rd) = alloc_number(result);
344     
345     *os_context_register_addr(context, reg_ALLOC) =
346       (unsigned long) dynamic_space_free_pointer;
347   }
348
349   arch_skip_instruction(context);
350 }
351
352 void arch_install_interrupt_handlers()
353 {
354   undoably_install_low_level_interrupt_handler(SIGILL , sigill_handler);
355   undoably_install_low_level_interrupt_handler(SIGEMT, sigemt_handler);
356 }
357
358 \f
359 extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
360
361 lispobj funcall0(lispobj function)
362 {
363     lispobj *args = current_control_stack_pointer;
364
365     return call_into_lisp(function, args, 0);
366 }
367
368 lispobj funcall1(lispobj function, lispobj arg0)
369 {
370     lispobj *args = current_control_stack_pointer;
371
372     current_control_stack_pointer += 1;
373     args[0] = arg0;
374
375     return call_into_lisp(function, args, 1);
376 }
377
378 lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1)
379 {
380     lispobj *args = current_control_stack_pointer;
381
382     current_control_stack_pointer += 2;
383     args[0] = arg0;
384     args[1] = arg1;
385
386     return call_into_lisp(function, args, 2);
387 }
388
389 lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
390 {
391     lispobj *args = current_control_stack_pointer;
392
393     current_control_stack_pointer += 3;
394     args[0] = arg0;
395     args[1] = arg1;
396     args[2] = arg2;
397
398     return call_into_lisp(function, args, 3);
399 }