0.9.2.18: various error &co reporting improvements and build tweaks
[sbcl.git] / src / runtime / mips-arch.c
1 /*
2
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
8 #include <stdio.h>
9
10 #include "sbcl.h"
11 #include "runtime.h"
12 #include "arch.h"
13 #include "globals.h"
14 #include "validate.h"
15 #include "os.h"
16 #include "lispregs.h"
17 #include "signal.h"
18 #include "alloc.h"
19 #include "interrupt.h"
20 #include "interr.h"
21 #include "breakpoint.h"
22 #include "monitor.h"
23
24 #include "genesis/constants.h"
25
26 void
27 arch_init()
28 {
29     return;
30 }
31
32 os_vm_address_t
33 arch_get_bad_addr(int signam, siginfo_t *siginfo, os_context_t *context)
34 {
35     /* Classic CMUCL comment:
36
37        Finding the bad address on the mips is easy. */
38     return (os_vm_address_t) siginfo->si_addr;
39 }
40
41 static unsigned int
42 emulate_branch(os_context_t *context, unsigned int inst)
43 {
44     unsigned int opcode = inst >> 26;
45     unsigned int r1 = (inst >> 21) & 0x1f;
46     unsigned int r2 = (inst >> 16) & 0x1f;
47     unsigned int r3 = (inst >> 11) & 0x1f;
48     unsigned int disp = ((inst&(1<<15)) ? inst | (-1 << 16) : inst&0x7fff) << 2;
49     unsigned int jtgt = (*os_context_pc_addr(context) & ~0x0fffffff) | (inst&0x3ffffff) << 2;
50     unsigned int tgt = *os_context_pc_addr(context);
51
52     switch(opcode) {
53     case 0x0: /* jr, jalr */
54         switch(inst & 0x3f) {
55         case 0x08: /* jr */
56             tgt = *os_context_register_addr(context, r1);
57             break;
58         case 0x09: /* jalr */
59             tgt = *os_context_register_addr(context, r1);
60             *os_context_register_addr(context, r3)
61                 = *os_context_pc_addr(context) + 4;
62             break;
63         }
64         break;
65     case 0x1: /* bltz, bgez, bltzal, bgezal */
66         switch((inst >> 16) & 0x1f) {
67         case 0x00: /* bltz */
68             if(*os_context_register_addr(context, r1) < 0)
69                 tgt += disp;
70             break;
71         case 0x01: /* bgez */
72             if(*os_context_register_addr(context, r1) >= 0)
73                 tgt += disp;
74             break;
75         case 0x10: /* bltzal */
76             if(*os_context_register_addr(context, r1) < 0)
77                 tgt += disp;
78             *os_context_register_addr(context, 31)
79                 = *os_context_pc_addr(context) + 4;
80             break;
81         case 0x11: /* bgezal */
82             if(*os_context_register_addr(context, r1) >= 0)
83                 tgt += disp;
84             *os_context_register_addr(context, 31)
85                 = *os_context_pc_addr(context) + 4;
86             break;
87         }
88         break;
89     case 0x4: /* beq */
90         if(*os_context_register_addr(context, r1)
91            == *os_context_register_addr(context, r2))
92             tgt += disp;
93         break;
94     case 0x5: /* bne */
95         if(*os_context_register_addr(context, r1) 
96            != *os_context_register_addr(context, r2))
97             tgt += disp;
98         break;
99     case 0x6: /* blez */
100         if(*os_context_register_addr(context, r1)
101            <= *os_context_register_addr(context, r2))
102             tgt += disp;
103         break;
104     case 0x7: /* bgtz */
105         if(*os_context_register_addr(context, r1)
106            > *os_context_register_addr(context, r2))
107             tgt += disp;
108         break;
109     case 0x2: /* j */
110         tgt = jtgt;
111         break;
112     case 0x3: /* jal */
113         tgt = jtgt;
114         *os_context_register_addr(context, 31)
115             = *os_context_pc_addr(context) + 4;
116         break;
117     }
118     return tgt;
119 }
120
121 void
122 arch_skip_instruction(os_context_t *context)
123 {
124     /* Skip the offending instruction */
125     if (os_context_bd_cause(context)) {
126         /* Currently, we never get here, because Linux' support for
127            bd_cause seems not terribly solid (c.f os_context_bd_cause
128            in mips-linux-os.c).  If a port to Irix comes along, this
129            code will be executed, because presumably Irix' support is
130            better (it can hardly be worse).  We lose() to remind the
131            porter to review this code.  -- CSR, 2002-09-06 */
132         lose("bd_cause branch taken; review code for new OS?\n");
133         *os_context_pc_addr(context)
134             = emulate_branch(context, *os_context_pc_addr(context));
135     } else
136         *os_context_pc_addr(context) += 4;
137 }
138
139 unsigned char *
140 arch_internal_error_arguments(os_context_t *context)
141 {
142     if (os_context_bd_cause(context))
143         return (unsigned char *)(*os_context_pc_addr(context) + 8);
144     else
145         return (unsigned char *)(*os_context_pc_addr(context) + 4);
146 }
147
148 boolean
149 arch_pseudo_atomic_atomic(os_context_t *context)
150 {
151     return *os_context_register_addr(context, reg_ALLOC) & 1;
152 }
153
154 void
155 arch_set_pseudo_atomic_interrupted(os_context_t *context)
156 {
157     *os_context_register_addr(context, reg_NL4) |= -1LL<<31;
158 }
159
160 unsigned long
161 arch_install_breakpoint(void *pc)
162 {
163     unsigned int *ptr = (unsigned int *)pc;
164     unsigned long result = (unsigned long) *ptr;
165
166     *ptr = (trap_Breakpoint << 16) | 0xd;
167     os_flush_icache((os_vm_address_t)ptr, sizeof(unsigned int));
168
169     return result;
170 }
171
172 void
173 arch_remove_breakpoint(void *pc, unsigned long orig_inst)
174 {
175     unsigned int *ptr = (unsigned int *)pc;
176
177     *ptr = (unsigned int) orig_inst;
178     os_flush_icache((os_vm_address_t)ptr, sizeof(unsigned int));
179 }
180
181 static unsigned int *skipped_break_addr, displaced_after_inst;
182 static sigset_t orig_sigmask;
183
184 void
185 arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
186 {
187     unsigned int *pc = (unsigned int *)*os_context_pc_addr(context);
188     unsigned int *break_pc, *next_pc;
189     unsigned int next_inst;
190     int opcode;
191
192     orig_sigmask = *os_context_sigmask_addr(context);
193     sigaddset_blockable(os_context_sigmask_addr(context));
194
195     /* Figure out where the breakpoint is, and what happens next. */
196     if (os_context_bd_cause(context)) {
197         break_pc = pc+1;
198         next_inst = *pc;
199     }
200     else {
201         break_pc = pc;
202         next_inst = orig_inst;
203     }
204
205     /* Put the original instruction back. */
206     arch_remove_breakpoint(break_pc, orig_inst);
207     skipped_break_addr = break_pc;
208
209     /* Figure out where it goes. */
210     opcode = next_inst >> 26;
211     if (opcode == 1 || ((opcode & 0x3c) == 0x4) || ((next_inst & 0xf00e0000) == 0x80000000))
212         next_pc = (unsigned int *)emulate_branch(context, next_inst);
213     else
214         next_pc = pc+1;
215
216     displaced_after_inst = arch_install_breakpoint(next_pc);
217 }
218
219 static void
220 sigill_handler(int signal, siginfo_t *info, void *void_context)
221 {
222     os_context_t *context = arch_os_get_context(&void_context);
223
224     fake_foreign_function_call(context);
225     monitor_or_something();
226 }
227
228 static void
229 sigtrap_handler(int signal, siginfo_t *info, void *void_context)
230 {
231     os_context_t *context = arch_os_get_context(&void_context);
232     unsigned int code;
233
234     code = ((*(int *) (*os_context_pc_addr(context))) >> 16) & 0x1f;
235
236     switch (code) {
237     case trap_Halt:
238         fake_foreign_function_call(context);
239         lose("%%primitive halt called; the party is over.\n");
240
241     case trap_PendingInterrupt:
242         arch_skip_instruction(context);
243         interrupt_handle_pending(context);
244         break;
245
246     case trap_Error:
247     case trap_Cerror:
248         interrupt_internal_error(signal, info, context, code==trap_Cerror);
249         break;
250
251     case trap_Breakpoint:
252         handle_breakpoint(signal, info, context);
253         break;
254
255     case trap_FunEndBreakpoint:
256         *os_context_pc_addr(context) = (int)handle_fun_end_breakpoint(signal, info, context);
257         os_flush_icache((os_vm_address_t)*os_context_pc_addr(context), sizeof(unsigned int));
258         break;
259
260     case trap_AfterBreakpoint:
261         arch_remove_breakpoint(os_context_pc_addr(context), displaced_after_inst);
262         displaced_after_inst = arch_install_breakpoint(skipped_break_addr);
263         *os_context_sigmask_addr(context) = orig_sigmask;
264         break;
265
266     case 0x10:
267         /* Clear the pseudo-atomic flag */
268         *os_context_register_addr(context, reg_NL4) &= ~(-1LL<<31);
269         arch_skip_instruction(context);
270         interrupt_handle_pending(context);
271         return;
272         
273     default:
274         interrupt_handle_now(signal, info, context);
275         break;
276     }
277 }
278
279 #define FIXNUM_VALUE(lispobj) (((int)lispobj) >> N_FIXNUM_TAG_BITS)
280
281 static void
282 sigfpe_handler(int signal, siginfo_t *info, void *void_context)
283 {
284     unsigned int bad_inst;
285     unsigned int op, rs, rt, rd, funct, dest = 32;
286     int immed;
287     unsigned int result;
288     os_context_t *context = arch_os_get_context(&void_context);
289
290     if (os_context_bd_cause(context))
291         bad_inst = *(unsigned int *)(*os_context_pc_addr(context) + 4);
292     else
293         bad_inst = *(unsigned int *)(*os_context_pc_addr(context));
294
295     op = (bad_inst >> 26) & 0x3f;
296     rs = (bad_inst >> 21) & 0x1f;
297     rt = (bad_inst >> 16) & 0x1f;
298     rd = (bad_inst >> 11) & 0x1f;
299     funct = bad_inst & 0x3f;
300     immed = (((int)(bad_inst & 0xffff)) << 16) >> 16;
301
302     switch (op) {
303     case 0x0: /* SPECIAL */
304         switch (funct) {
305         case 0x20: /* ADD */
306             /* FIXME: Hopefully, this whole section can just go away,
307                with the rewrite of pseudo-atomic and the deletion of
308                overflow VOPs */
309             /* Check to see if this is really a pa_interrupted hit */
310             if (rs == reg_ALLOC && rt == reg_NL4) {
311                 *os_context_register_addr(context, reg_ALLOC)
312                     += *os_context_register_addr(context, reg_NL4) &= ~(-1LL<<31);
313                 arch_skip_instruction(context);
314                 interrupt_handle_pending(context);
315                 return;
316             }
317             result = FIXNUM_VALUE(*os_context_register_addr(context, rs))
318                 + FIXNUM_VALUE(*os_context_register_addr(context, rt));
319             dest = rd;
320             break;
321             
322         case 0x22: /* SUB */
323             result = FIXNUM_VALUE(*os_context_register_addr(context, rs))
324                 - FIXNUM_VALUE(*os_context_register_addr(context, rt));
325             dest = rd;
326             break;
327         }
328         break;
329         
330     case 0x8: /* ADDI */
331         result = FIXNUM_VALUE(*os_context_register_addr(context,rs)) + (immed>>2);
332         dest = rt;
333         break;
334     }
335     
336     if (dest < 32) {
337         dynamic_space_free_pointer =
338             (lispobj *) *os_context_register_addr(context,reg_ALLOC);
339
340         *os_context_register_addr(context,dest) = alloc_number(result);
341
342         *os_context_register_addr(context, reg_ALLOC) =
343             (unsigned int) dynamic_space_free_pointer;
344
345         arch_skip_instruction(context);
346         
347     }
348     else
349         interrupt_handle_now(signal, info, context);
350 }
351
352 void
353 arch_install_interrupt_handlers()
354 {    
355     undoably_install_low_level_interrupt_handler(SIGILL,sigill_handler);
356     undoably_install_low_level_interrupt_handler(SIGTRAP,sigtrap_handler);
357     undoably_install_low_level_interrupt_handler(SIGFPE,sigfpe_handler);
358 }
359
360 extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
361
362 lispobj
363 funcall0(lispobj function)
364 {
365     lispobj *args = current_control_stack_pointer;
366
367     return call_into_lisp(function, args, 0);
368 }
369
370 lispobj
371 funcall1(lispobj function, lispobj arg0)
372 {
373     lispobj *args = current_control_stack_pointer;
374
375     current_control_stack_pointer += 1;
376     args[0] = arg0;
377
378     return call_into_lisp(function, args, 1);
379 }
380
381 lispobj
382 funcall2(lispobj function, lispobj arg0, lispobj arg1)
383 {
384     lispobj *args = current_control_stack_pointer;
385
386     current_control_stack_pointer += 2;
387     args[0] = arg0;
388     args[1] = arg1;
389
390     return call_into_lisp(function, args, 2);
391 }
392
393 lispobj
394 funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
395 {
396     lispobj *args = current_control_stack_pointer;
397
398     current_control_stack_pointer += 3;
399     args[0] = arg0;
400     args[1] = arg1;
401     args[2] = arg2;
402
403     return call_into_lisp(function, args, 3);
404 }