0.7.5.13:
[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 LISP_FEATURE_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     ((char *) *os_context_npc_addr(context)) += 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     unsigned long *npc = (unsigned long *)(*os_context_npc_addr(context));
131
132   /*  orig_sigmask = context->sigmask;
133       sigemptyset(&context->sigmask); */
134   /* FIXME!!! */
135   /* FILLBLOCKSET(&context->uc_sigmask);*/
136
137     *pc = orig_inst;
138     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
139     skipped_break_addr = pc;
140     displaced_after_inst = *npc;
141     *npc = trap_AfterBreakpoint;
142     os_flush_icache((os_vm_address_t) npc, sizeof(unsigned long));
143     
144 }
145
146 static int pseudo_atomic_trap_p(os_context_t *context)
147 {
148     unsigned int* pc;
149     unsigned int badinst;
150     int result;
151     
152     
153     pc = (unsigned int*) *os_context_pc_addr(context);
154     badinst = *pc;
155     result = 0;
156     
157     /* Check to see if the current instruction is a pseudo-atomic-trap */
158     if (((badinst >> 30) == 2) && (((badinst >> 19) & 0x3f) == 0x3a)
159         && (((badinst >> 13) & 1) == 1) && ((badinst & 0x7f) == PSEUDO_ATOMIC_TRAP))
160         {
161             unsigned int previnst;
162             previnst = pc[-1];
163             /*
164              * Check to see if the previous instruction was an andcc alloc-tn,
165              * 3, zero-tn instruction.
166              */
167             if (((previnst >> 30) == 2) && (((previnst >> 19) & 0x3f) == 0x11)
168                 && (((previnst >> 14) & 0x1f) == reg_ALLOC)
169                 && (((previnst >> 25) & 0x1f) == reg_ZERO)
170                 && (((previnst >> 13) & 1) == 1)
171                 && ((previnst & 0x1fff) == 3))
172                 {
173                     result = 1;
174                 }
175             else
176                 {
177                     fprintf(stderr, "Oops!  Got a PSEUDO-ATOMIC-TRAP without a preceeding andcc!\n");
178                 }
179         }
180     return result;
181 }
182
183 static void sigill_handler(int signal, siginfo_t *siginfo, void *void_context)
184 {
185     os_context_t *context = arch_os_get_context(&void_context);
186 #ifdef LISP_FEATURE_LINUX
187     /* FIXME: Check that this is necessary -- CSR, 2002-07-15 */
188     os_restore_fp_control(context);
189 #endif
190     sigprocmask(SIG_SETMASK, os_context_sigmask_addr(context), 0);
191     
192     if ((siginfo->si_code) == ILL_ILLOPC
193 #ifdef LISP_FEATURE_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             *os_context_npc_addr(context) = *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 LISP_FEATURE_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 #ifdef LISP_FEATURE_LINUX
271     os_restore_fp_control(context);
272 #endif
273     
274     badinst = *(unsigned long *)os_context_pc_addr(context);
275     if ((badinst >> 30) != 2 || ((badinst >> 20) & 0x1f) != 0x11) {
276         /* It wasn't a tagged add.  Pass the signal into lisp. */
277         interrupt_handle_now(signal, siginfo, context);
278         return;
279     }
280     
281     fprintf(stderr, "SIGEMT trap handler with tagged op instruction!\n");
282     
283     /* Extract the parts of the inst. */
284     subtract = badinst & (1<<19);
285     rs1 = (badinst>>14) & 0x1f;
286     op1 = *os_context_register_addr(context, rs1);
287     
288     /* If the first arg is $ALLOC then it is really a signal-pending note */
289     /* for the pseudo-atomic noise. */
290     if (rs1 == reg_ALLOC) {
291         /* Perform the op anyway. */
292         op2 = badinst & 0x1fff;
293         if (op2 & (1<<12))
294             op2 |= -1<<13;
295         if (subtract)
296             result = op1 - op2;
297         else
298             result = op1 + op2;
299         *os_context_register_addr(context, reg_ALLOC) = result & ~7;
300         arch_skip_instruction(context);
301         interrupt_handle_pending(context);
302         return;
303     }
304     
305     if ((op1 & 3) != 0) {
306         /* The first arg wan't a fixnum. */
307         interrupt_internal_error(signal, siginfo, context, 0);
308         return;
309     }
310     
311     if (immed = badinst & (1<<13)) {
312         op2 = badinst & 0x1fff;
313         if (op2 & (1<<12))
314             op2 |= -1<<13;
315     }
316     else {
317         rs2 = badinst & 0x1f;
318         op2 = *os_context_register_addr(context, rs2);
319     }
320     
321     if ((op2 & 3) != 0) {
322         /* The second arg wan't a fixnum. */
323         interrupt_internal_error(signal, siginfo, context, 0);
324         return;
325     }
326     
327     rd = (badinst>>25) & 0x1f;
328     if (rd != 0) {
329         /* Don't bother computing the result unless we are going to use it. */
330         if (subtract)
331             result = (op1>>2) - (op2>>2);
332         else
333             result = (op1>>2) + (op2>>2);
334         
335         dynamic_space_free_pointer =
336             (lispobj *) *os_context_register_addr(context, reg_ALLOC);
337         
338         *os_context_register_addr(context, rd) = alloc_number(result);
339         
340         *os_context_register_addr(context, reg_ALLOC) =
341             (unsigned long) dynamic_space_free_pointer;
342     }
343     
344     arch_skip_instruction(context);
345 }
346
347 void arch_install_interrupt_handlers()
348 {
349     undoably_install_low_level_interrupt_handler(SIGILL , sigill_handler);
350     undoably_install_low_level_interrupt_handler(SIGEMT, sigemt_handler);
351 }
352
353 \f
354 extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
355
356 lispobj funcall0(lispobj function)
357 {
358     lispobj *args = current_control_stack_pointer;
359
360     return call_into_lisp(function, args, 0);
361 }
362
363 lispobj funcall1(lispobj function, lispobj arg0)
364 {
365     lispobj *args = current_control_stack_pointer;
366
367     current_control_stack_pointer += 1;
368     args[0] = arg0;
369
370     return call_into_lisp(function, args, 1);
371 }
372
373 lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1)
374 {
375     lispobj *args = current_control_stack_pointer;
376
377     current_control_stack_pointer += 2;
378     args[0] = arg0;
379     args[1] = arg1;
380
381     return call_into_lisp(function, args, 2);
382 }
383
384 lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
385 {
386     lispobj *args = current_control_stack_pointer;
387
388     current_control_stack_pointer += 3;
389     args[0] = arg0;
390     args[1] = arg1;
391     args[2] = arg2;
392
393     return call_into_lisp(function, args, 3);
394 }
395