0.7.13.28:
[sbcl.git] / src / runtime / ppc-arch.c
1 #include <stdio.h>
2
3 #include "arch.h"
4 #include "sbcl.h"
5 #include "globals.h"
6 #include "validate.h"
7 #include "os.h"
8 #include "lispregs.h"
9 #include "signal.h"
10 #include "interrupt.h"
11 #include "interr.h"
12
13   /* The header files may not define PT_DAR/PT_DSISR.  This definition
14      is correct for all versions of ppc linux >= 2.0.30
15
16      As of DR2.1u4, MkLinux doesn't pass these registers to signal
17      handlers correctly; a patch is necessary in order to (partially)
18      correct this.
19
20      Even with the patch, the DSISR may not have its 'write' bit set
21      correctly (it tends not to be set if the fault was caused by
22      something other than a protection violation.)
23      
24      Caveat callers.  */
25
26 #ifndef PT_DAR
27 #define PT_DAR          41
28 #endif
29
30 #ifndef PT_DSISR
31 #define PT_DSISR        42
32 #endif
33
34 void arch_init()
35 {
36 }
37
38 os_vm_address_t 
39 arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context)
40 {
41     unsigned long badinstr;
42     unsigned int *pc =  (unsigned int *)(*os_context_pc_addr(context));
43     int instclass;
44     os_vm_address_t addr;
45     
46     
47     /* Make sure it's not the pc thats bogus, and that it was lisp code */
48     /* that caused the fault. */
49     if ((((unsigned long)pc) & 3) != 0 ||
50         ((pc < READ_ONLY_SPACE_START ||
51           pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) &&
52          ((lispobj *)pc < current_dynamic_space &&
53           (lispobj *)pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE)))
54         return 0;
55     
56     
57     addr = (os_vm_address_t) (*os_context_register_addr(context,PT_DAR));
58     return addr;
59 }
60       
61
62 void 
63 arch_skip_instruction(os_context_t *context)
64 {
65     ((char*)*os_context_pc_addr(context)) +=4; 
66 }
67
68 unsigned char *
69 arch_internal_error_arguments(os_context_t *context)
70 {
71     return (unsigned char *)(*os_context_pc_addr(context)+4);
72 }
73
74
75 boolean 
76 arch_pseudo_atomic_atomic(os_context_t *context)
77 {
78     return ((*os_context_register_addr(context,reg_ALLOC)) & 4);
79 }
80
81 #define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000
82
83 void 
84 arch_set_pseudo_atomic_interrupted(os_context_t *context)
85 {
86     *os_context_register_addr(context,reg_NL3) 
87         += PSEUDO_ATOMIC_INTERRUPTED_BIAS;
88 }
89
90 unsigned long 
91 arch_install_breakpoint(void *pc)
92 {
93     unsigned long *ptr = (unsigned long *)pc;
94     unsigned long result = *ptr;
95     *ptr = (3<<26) | (5 << 21) | trap_Breakpoint;
96     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
97     return result;
98 }
99
100 void 
101 arch_remove_breakpoint(void *pc, unsigned long orig_inst)
102 {
103     *(unsigned long *)pc = orig_inst;
104     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
105 }
106
107 static unsigned long *skipped_break_addr, displaced_after_inst;
108 static sigset_t orig_sigmask;
109
110 void 
111 arch_do_displaced_inst(os_context_t *context,unsigned int orig_inst)
112 {
113     /* not sure how we ensure that we get the breakpoint reinstalled
114      * after doing this -dan */
115     unsigned long *pc = (unsigned long *)(*os_context_pc_addr(context));
116     
117     orig_sigmask = *os_context_sigmask_addr(context);
118     sigaddset_blockable(os_context_sigmask_addr(context));
119     
120     *pc = orig_inst;
121     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
122     skipped_break_addr = pc;
123 }
124
125 static void 
126 sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context)
127 {
128     int badinst;
129     u32 code;
130     sigset_t *mask;
131 #ifdef LISP_FEATURE_LINUX
132     os_restore_fp_control(context);
133 #endif
134     mask=(os_context_sigmask_addr(context));
135     sigsetmask(mask); 
136     code=*((u32 *)(*os_context_pc_addr(context)));
137     if (code == ((3 << 26) | (16 << 21) | (reg_ALLOC << 16))) {
138         /* twlti reg_ALLOC,0 - check for deferred interrupt */
139         *os_context_register_addr(context,reg_ALLOC) 
140             -= PSEUDO_ATOMIC_INTERRUPTED_BIAS;
141         arch_skip_instruction(context);
142         /* interrupt or GC was requested in PA; now we're done with the
143            PA section we may as well get around to it */
144         interrupt_handle_pending(context);
145         return;
146         
147     }
148     if ((code >> 16) == ((3 << 10) | (6 << 5))) {
149         /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */
150         int trap = code & 0x1f, extra = (code >> 5) & 0x1f;
151         
152         switch (trap) {
153         case trap_Halt:
154             fake_foreign_function_call(context);
155             lose("%%primitive halt called; the party is over.\n");
156             
157         case trap_Error:
158         case trap_Cerror:
159             interrupt_internal_error(signal, code, context, trap == trap_Cerror);
160             break;
161             
162         case trap_PendingInterrupt:
163           /* when do we run this branch instead of the twlti code above? */
164             arch_skip_instruction(context);
165             interrupt_handle_pending(context);
166             break;
167             
168         case trap_Breakpoint:
169             handle_breakpoint(signal, code, context);
170             break;
171             
172         case trap_FunEndBreakpoint:
173             *os_context_pc_addr(context)
174                 =(int)handle_fun_end_breakpoint(signal, code, context);
175             break;
176             
177         case trap_AfterBreakpoint:
178             *skipped_break_addr = trap_Breakpoint;
179             skipped_break_addr = NULL;
180             *(unsigned long *)*os_context_pc_addr(context) 
181                 = displaced_after_inst;
182             *os_context_sigmask_addr(context)= orig_sigmask;
183  
184             os_flush_icache((os_vm_address_t) *os_context_pc_addr(context),
185                             sizeof(unsigned long));
186             break;
187             
188         default:
189             interrupt_handle_now(signal, code, context);
190             break;
191         }
192     }
193     if (((code >> 26) == 3) && (((code >> 21) & 31) == 24)) {
194         interrupt_internal_error(signal, code, context, 0);
195     }
196     
197     interrupt_handle_now(signal, code, context);
198 }
199
200
201 void arch_install_interrupt_handlers()
202 {
203     undoably_install_low_level_interrupt_handler(SIGILL,sigtrap_handler);
204     undoably_install_low_level_interrupt_handler(SIGTRAP,sigtrap_handler);
205 }
206
207
208 extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs);
209
210 lispobj funcall0(lispobj function)
211 {
212     lispobj *args = current_control_stack_pointer;
213
214     return call_into_lisp(function, args, 0);
215 }
216
217 lispobj funcall1(lispobj function, lispobj arg0)
218 {
219     lispobj *args = current_control_stack_pointer;
220
221     current_control_stack_pointer += 1;
222     args[0] = arg0;
223
224     return call_into_lisp(function, args, 1);
225 }
226
227 lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1)
228 {
229     lispobj *args = current_control_stack_pointer;
230
231     current_control_stack_pointer += 2;
232     args[0] = arg0;
233     args[1] = arg1;
234
235     return call_into_lisp(function, args, 2);
236 }
237
238 lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
239 {
240     lispobj *args = current_control_stack_pointer;
241
242     current_control_stack_pointer += 3;
243     args[0] = arg0;
244     args[1] = arg1;
245     args[2] = arg2;
246
247     return call_into_lisp(function, args, 3);
248 }
249
250 void
251 ppc_flush_icache(os_vm_address_t address, os_vm_size_t length)
252 {
253   os_vm_address_t end = (os_vm_address_t) ((int)(address+length+(32-1)) &~(32-1));
254   extern void ppc_flush_cache_line(os_vm_address_t);
255
256   while (address < end) {
257     ppc_flush_cache_line(address);
258     address += 32;
259   }
260 }