0.7.1.46:
[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 pseudo-atomic-trap */
161   if (((badinst >> 30) == 2) && (((badinst >> 19) & 0x3f) == 0x3a)
162       && (((badinst >> 13) & 1) == 1) && ((badinst & 0x7f) == PSEUDO_ATOMIC_TRAP))
163     {
164       unsigned int previnst;
165       previnst = pc[-1];
166       /*
167        * Check to see if the previous instruction was an andcc alloc-tn,
168        * 3, zero-tn instruction.
169        */
170       if (((previnst >> 30) == 2) && (((previnst >> 19) & 0x3f) == 0x11)
171           && (((previnst >> 14) & 0x1f) == reg_ALLOC)
172           && (((previnst >> 25) & 0x1f) == reg_ZERO)
173           && (((previnst >> 13) & 1) == 1)
174           && ((previnst & 0x1fff) == 3))
175         {
176           result = 1;
177         }
178       else
179         {
180           fprintf(stderr, "Oops!  Got a PSEUDO-ATOMIC-TRAP without a preceeding andcc!\n");
181         }
182     }
183   return result;
184 }
185
186 static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context)
187 {
188   os_context_t *context = arch_os_get_context(&void_context);
189
190   sigprocmask(SIG_SETMASK, &context->si_mask, 0);
191
192   if ((siginfo->si_code) == ILL_ILLOPC
193 #ifdef linux
194       || (early_kernel && (siginfo->si_code == 2))
195 #endif
196       ) {
197     int trap;
198     unsigned int inst;
199     unsigned int* pc = (unsigned int*) siginfo->si_addr;
200
201     inst = *pc;
202     trap = inst & 0x3fffff;
203     
204     switch (trap) {
205     case trap_PendingInterrupt:
206       arch_skip_instruction(context);
207       interrupt_handle_pending(context);
208       break;
209
210     case trap_Halt:
211       fake_foreign_function_call(context);
212       lose("%%primitive halt called; the party is over.\n");
213       
214     case trap_Error:
215     case trap_Cerror:
216       interrupt_internal_error(signal, siginfo, context, trap == trap_Cerror);
217       break;
218
219     case trap_Breakpoint:
220       handle_breakpoint(signal, siginfo, context);
221       break;
222
223     case trap_FunEndBreakpoint:
224       *os_context_pc_addr(context) = (int) handle_fun_end_breakpoint(signal, siginfo, context);
225       context->si_regs.npc = *os_context_pc_addr(context) + 4;
226       break;
227
228     case trap_AfterBreakpoint:
229       *skipped_break_addr = trap_Breakpoint;
230       skipped_break_addr = NULL;
231       *(unsigned long *) os_context_pc_addr(context) = displaced_after_inst;
232       /* context->sigmask = orig_sigmask; */
233       os_flush_icache((os_vm_address_t) os_context_pc_addr(context), sizeof(unsigned long));
234       break;
235       
236     default:
237       interrupt_handle_now(signal, siginfo, context);
238       break;
239     }
240   }
241   else if ((siginfo->si_code) == ILL_ILLTRP
242 #ifdef linux
243            || (early_kernel && (siginfo->si_code) == 192)
244 #endif
245            ) {
246     if (pseudo_atomic_trap_p(context)) {
247       /* A trap instruction from a pseudo-atomic.  We just need
248          to fixup up alloc-tn to remove the interrupted flag,
249          skip over the trap instruction, and then handle the
250          pending interrupt(s). */
251       *os_context_register_addr(context, reg_ALLOC) &= ~7;
252       arch_skip_instruction(context);
253       interrupt_handle_pending(context);
254     }
255     else {
256       interrupt_internal_error(signal, siginfo, context, 0);
257     }
258   }
259   else {
260     interrupt_handle_now(signal, siginfo, context);
261   }
262 }
263
264 static void sigemt_handler(int signal, siginfo_t *siginfo, void *void_context)
265 {
266   unsigned long badinst;
267   boolean subtract, immed;
268   int rd, rs1, op1, rs2, op2, result;
269   os_context_t *context = arch_os_get_context(&void_context);
270
271   badinst = *(unsigned long *)os_context_pc_addr(context);
272   if ((badinst >> 30) != 2 || ((badinst >> 20) & 0x1f) != 0x11) {
273     /* It wasn't a tagged add.  Pass the signal into lisp. */
274     interrupt_handle_now(signal, siginfo, context);
275     return;
276   }
277
278   fprintf(stderr, "SIGEMT trap handler with tagged op instruction!\n");
279   
280   /* Extract the parts of the inst. */
281   subtract = badinst & (1<<19);
282   rs1 = (badinst>>14) & 0x1f;
283   op1 = *os_context_register_addr(context, rs1);
284   
285   /* If the first arg is $ALLOC then it is really a signal-pending note */
286   /* for the pseudo-atomic noise. */
287   if (rs1 == reg_ALLOC) {
288     /* Perform the op anyway. */
289     op2 = badinst & 0x1fff;
290     if (op2 & (1<<12))
291       op2 |= -1<<13;
292     if (subtract)
293       result = op1 - op2;
294     else
295       result = op1 + op2;
296     *os_context_register_addr(context, reg_ALLOC) = result & ~7;
297     arch_skip_instruction(context);
298     interrupt_handle_pending(context);
299     return;
300   }
301
302   if ((op1 & 3) != 0) {
303     /* The first arg wan't a fixnum. */
304     interrupt_internal_error(signal, siginfo, context, 0);
305     return;
306   }
307
308   if (immed = badinst & (1<<13)) {
309     op2 = badinst & 0x1fff;
310     if (op2 & (1<<12))
311       op2 |= -1<<13;
312   }
313   else {
314     rs2 = badinst & 0x1f;
315     op2 = *os_context_register_addr(context, rs2);
316   }
317
318   if ((op2 & 3) != 0) {
319     /* The second arg wan't a fixnum. */
320     interrupt_internal_error(signal, siginfo, context, 0);
321     return;
322   }
323
324   rd = (badinst>>25) & 0x1f;
325   if (rd != 0) {
326     /* Don't bother computing the result unless we are going to use it. */
327     if (subtract)
328       result = (op1>>2) - (op2>>2);
329     else
330       result = (op1>>2) + (op2>>2);
331     
332     dynamic_space_free_pointer =
333       (lispobj *) *os_context_register_addr(context, reg_ALLOC);
334
335     *os_context_register_addr(context, rd) = alloc_number(result);
336     
337     *os_context_register_addr(context, reg_ALLOC) =
338       (unsigned long) dynamic_space_free_pointer;
339   }
340
341   arch_skip_instruction(context);
342 }
343
344 void arch_install_interrupt_handlers()
345 {
346   undoably_install_low_level_interrupt_handler(SIGILL , sigill_handler);
347   undoably_install_low_level_interrupt_handler(SIGEMT, sigemt_handler);
348 }
349
350 \f
351 extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
352
353 lispobj funcall0(lispobj function)
354 {
355     lispobj *args = current_control_stack_pointer;
356
357     return call_into_lisp(function, args, 0);
358 }
359
360 lispobj funcall1(lispobj function, lispobj arg0)
361 {
362     lispobj *args = current_control_stack_pointer;
363
364     current_control_stack_pointer += 1;
365     args[0] = arg0;
366
367     return call_into_lisp(function, args, 1);
368 }
369
370 lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1)
371 {
372     lispobj *args = current_control_stack_pointer;
373
374     current_control_stack_pointer += 2;
375     args[0] = arg0;
376     args[1] = arg1;
377
378     return call_into_lisp(function, args, 2);
379 }
380
381 lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
382 {
383     lispobj *args = current_control_stack_pointer;
384
385     current_control_stack_pointer += 3;
386     args[0] = arg0;
387     args[1] = arg1;
388     args[2] = arg2;
389
390     return call_into_lisp(function, args, 3);
391 }