1.0.7.33: better handling of ASSOC and MEMBER on empty lists
[sbcl.git] / src / runtime / ppc-arch.c
1 /*
2  * This software is part of the SBCL system. See the README file for
3  * more information.
4  *
5  * This software is derived from the CMU CL system, which was
6  * written at Carnegie Mellon University and released into the
7  * public domain. The software is in the public domain and is
8  * provided with absolutely no warranty. See the COPYING and CREDITS
9  * files for more information.
10  */
11
12 #include <stdio.h>
13
14 #include "sbcl.h"
15 #include "arch.h"
16 #include "globals.h"
17 #include "validate.h"
18 #include "os.h"
19 #include "lispregs.h"
20 #include "signal.h"
21 #include "interrupt.h"
22 #include "interr.h"
23 #include "breakpoint.h"
24 #include "alloc.h"
25
26 #if defined(LISP_FEATURE_GENCGC)
27 #include "gencgc-alloc-region.h"
28 #endif
29
30   /* The header files may not define PT_DAR/PT_DSISR.  This definition
31      is correct for all versions of ppc linux >= 2.0.30
32
33      As of DR2.1u4, MkLinux doesn't pass these registers to signal
34      handlers correctly; a patch is necessary in order to (partially)
35      correct this.
36
37      Even with the patch, the DSISR may not have its 'write' bit set
38      correctly (it tends not to be set if the fault was caused by
39      something other than a protection violation.)
40
41      Caveat callers.  */
42
43 #if defined (LISP_FEATURE_DARWIN) || defined(LISP_FEATURE_LINUX)
44 #ifndef PT_DAR
45 #define PT_DAR          41
46 #endif
47
48 #ifndef PT_DSISR
49 #define PT_DSISR        42
50 #endif
51 #endif
52
53 void arch_init() {
54 }
55
56 os_vm_address_t
57 arch_get_bad_addr(int sig, siginfo_t *code, os_context_t *context)
58 {
59     os_vm_address_t addr;
60
61 #if defined(LISP_FEATURE_NETBSD)
62     addr = (os_vm_address_t) (code->si_addr);
63 #else
64     addr = (os_vm_address_t) (*os_context_register_addr(context,PT_DAR));
65 #endif
66     return addr;
67 }
68
69
70 void
71 arch_skip_instruction(os_context_t *context)
72 {
73     char** pcptr;
74     pcptr = (char**) os_context_pc_addr(context);
75     *pcptr += 4;
76 }
77
78 unsigned char *
79 arch_internal_error_arguments(os_context_t *context)
80 {
81     return (unsigned char *)(*os_context_pc_addr(context)+4);
82 }
83
84
85 boolean
86 arch_pseudo_atomic_atomic(os_context_t *context)
87 {
88     /* FIXME: this foreign_function_call_active test is dubious at
89      * best. If a foreign call is made in a pseudo atomic section
90      * (?) or more likely a pseudo atomic section is in a foreign
91      * call then an interrupt is executed immediately. Maybe it
92      * has to do with C code not maintaining pseudo atomic
93      * properly. MG - 2005-08-10
94      *
95      * The foreign_function_call_active used to live at each call-site
96      * to arch_pseudo_atomic_atomic, but this seems clearer.
97      * --NS 2007-05-15 */
98     return (!foreign_function_call_active)
99         && ((*os_context_register_addr(context,reg_ALLOC)) & 4);
100 }
101
102 void
103 arch_set_pseudo_atomic_interrupted(os_context_t *context)
104 {
105     *os_context_register_addr(context,reg_ALLOC) |= 1;
106 }
107
108 void
109 arch_clear_pseudo_atomic_interrupted(os_context_t *context)
110 {
111     *os_context_register_addr(context,reg_ALLOC) &= ~1;
112 }
113
114 unsigned int
115 arch_install_breakpoint(void *pc)
116 {
117     unsigned int *ptr = (unsigned int *)pc;
118     unsigned int result = *ptr;
119     *ptr = (3<<26) | (5 << 21) | trap_Breakpoint;
120     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int));
121     return result;
122 }
123
124 void
125 arch_remove_breakpoint(void *pc, unsigned int orig_inst)
126 {
127     *(unsigned int *)pc = orig_inst;
128     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int));
129 }
130
131 /*
132  * Perform the instruction that we overwrote with a breakpoint.  As we
133  * don't have a single-step facility, this means we have to:
134  * - put the instruction back
135  * - put a second breakpoint at the following instruction,
136  *   set after_breakpoint and continue execution.
137  *
138  * When the second breakpoint is hit (very shortly thereafter, we hope)
139  * sigtrap_handler gets called again, but follows the AfterBreakpoint
140  * arm, which
141  * - puts a bpt back in the first breakpoint place (running across a
142  *   breakpoint shouldn't cause it to be uninstalled)
143  * - replaces the second bpt with the instruction it was meant to be
144  * - carries on
145  *
146  * Clear?
147  */
148 static unsigned int *skipped_break_addr, displaced_after_inst;
149 static sigset_t orig_sigmask;
150
151 void
152 arch_do_displaced_inst(os_context_t *context, unsigned int orig_inst)
153 {
154     /* not sure how we ensure that we get the breakpoint reinstalled
155      * after doing this -dan */
156     unsigned int *pc = (unsigned int *)(*os_context_pc_addr(context));
157
158     orig_sigmask = *os_context_sigmask_addr(context);
159     sigaddset_blockable(os_context_sigmask_addr(context));
160
161     *pc = orig_inst;
162     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int));
163     skipped_break_addr = pc;
164
165     /* FIXME: we should apparently be installing the after-breakpoint
166      * here, but would need to find the next instruction address for
167      * it first. alpha-arch.c shows how to do it. --NS 2007-04-02 */
168 }
169
170 #ifdef LISP_FEATURE_GENCGC
171 /*
172  * Return non-zero if the current instruction is an allocation trap
173  */
174 static int
175 allocation_trap_p(os_context_t * context)
176 {
177     int result;
178     unsigned int *pc;
179     unsigned inst;
180     unsigned opcode;
181     unsigned src;
182     unsigned dst;
183
184     result = 0;
185
186     /*
187      * First, the instruction has to be a TWLGE temp, NL3, which has the
188      * format.
189      * | 6| 5| 5 | 5 | 10|1|  width
190      * |31|5 |dst|src|  4|0|  field
191      */
192     pc = (unsigned int *) (*os_context_pc_addr(context));
193     inst = *pc;
194
195 #if 0
196     fprintf(stderr, "allocation_trap_p at %p:  inst = 0x%08x\n", pc, inst);
197 #endif
198
199     opcode = inst >> 26;
200     src = (inst >> 11) & 0x1f;
201     dst = (inst >> 16) & 0x1f;
202     if ((opcode == 31) && (src == reg_NL3) && (5 == ((inst >> 21) & 0x1f))
203         && (4 == ((inst >> 1) & 0x3ff))) {
204         /*
205          * We got the instruction.  Now, look back to make sure it was
206          * proceeded by what we expected.  2 instructions back should be
207          * an ADD or ADDI instruction.
208          */
209         unsigned int add_inst;
210
211         add_inst = pc[-3];
212 #if 0
213         fprintf(stderr, "   add inst at %p:  inst = 0x%08x\n",
214                 pc - 3, add_inst);
215 #endif
216         opcode = add_inst >> 26;
217         if ((opcode == 31) && (266 == ((add_inst >> 1) & 0x1ff))) {
218             return 1;
219         } else if ((opcode == 14)) {
220             return 1;
221         } else {
222             fprintf(stderr,
223                     "Whoa! Got allocation trap but could not find ADD or ADDI instruction: 0x%08x in the proper place\n",
224                     add_inst);
225         }
226     }
227     return 0;
228 }
229
230 extern struct alloc_region boxed_region;
231
232 void
233 handle_allocation_trap(os_context_t * context)
234 {
235     unsigned int *pc;
236     unsigned int inst;
237     unsigned int target, target_ptr, end_addr;
238     unsigned int opcode;
239     int size;
240     boolean were_in_lisp;
241     char *memory;
242
243     target = 0;
244     size = 0;
245
246 #if 0
247     fprintf(stderr, "In handle_allocation_trap\n");
248 #endif
249
250     /* I don't think it's possible for us NOT to be in lisp when we get
251      * here.  Remove this later? */
252     were_in_lisp = !foreign_function_call_active;
253
254     if (were_in_lisp) {
255         fake_foreign_function_call(context);
256     } else {
257         fprintf(stderr, "**** Whoa! allocation trap and we weren't in lisp!\n");
258     }
259
260     /*
261      * Look at current instruction: TWNE temp, NL3. We're here because
262      * temp > NL3 and temp is the end of the allocation, and NL3 is
263      * current-region-end-addr.
264      *
265      * We need to adjust temp and alloc-tn.
266      */
267
268     pc = (unsigned int *) (*os_context_pc_addr(context));
269     inst = pc[0];
270     end_addr = (inst >> 11) & 0x1f;
271     target = (inst >> 16) & 0x1f;
272
273     target_ptr = *os_context_register_addr(context, target);
274
275 #if 0
276     fprintf(stderr, "handle_allocation_trap at %p:\n", pc);
277     fprintf(stderr, "boxed_region.free_pointer: %p\n", boxed_region.free_pointer);
278     fprintf(stderr, "boxed_region.end_addr: %p\n", boxed_region.end_addr);
279     fprintf(stderr, "target reg: %d, end_addr reg: %d\n", target, end_addr);
280     fprintf(stderr, "target: %x\n", *os_context_register_addr(context, target));
281     fprintf(stderr, "end_addr: %x\n", *os_context_register_addr(context, end_addr));
282 #endif
283
284 #if 0
285     fprintf(stderr, "handle_allocation_trap at %p:\n", pc);
286     fprintf(stderr, "  trap inst = 0x%08x\n", inst);
287     fprintf(stderr, "  target reg = %s\n", lisp_register_names[target]);
288 #endif
289
290     /*
291      * Go back and look at the add/addi instruction.  The second src arg
292      * is the size of the allocation.  Get it and call alloc to allocate
293      * new space.
294      */
295     inst = pc[-3];
296     opcode = inst >> 26;
297 #if 0
298     fprintf(stderr, "  add inst  = 0x%08x, opcode = %d\n", inst, opcode);
299 #endif
300     if (opcode == 14) {
301         /*
302          * ADDI temp-tn, alloc-tn, size
303          *
304          * Extract the size
305          */
306         size = (inst & 0xffff);
307     } else if (opcode == 31) {
308         /*
309          * ADD temp-tn, alloc-tn, size-tn
310          *
311          * Extract the size
312          */
313         int reg;
314
315         reg = (inst >> 11) & 0x1f;
316 #if 0
317         fprintf(stderr, "  add, reg = %s\n", lisp_register_names[reg]);
318 #endif
319         size = *os_context_register_addr(context, reg);
320
321     }
322
323 #if 0
324     fprintf(stderr, "Alloc %d to %s\n", size, lisp_register_names[target]);
325 #endif
326
327 #if INLINE_ALLOC_DEBUG
328     if ((((unsigned long)boxed_region.end_addr + size) / PAGE_SIZE) ==
329         (((unsigned long)boxed_region.end_addr) / PAGE_SIZE)) {
330       fprintf(stderr,"*** possibly bogus trap allocation of %d bytes at %p\n",
331               size, target_ptr);
332       fprintf(stderr, "    dynamic_space_free_pointer: %p, boxed_region.end_addr %p\n",
333               dynamic_space_free_pointer, boxed_region.end_addr);
334     }
335 #endif
336
337 #if 0
338     fprintf(stderr, "Ready to alloc\n");
339     fprintf(stderr, "free_pointer = 0x%08x\n",
340             dynamic_space_free_pointer);
341 #endif
342
343     /*
344      * alloc-tn was incremented by size.  Need to decrement it by size
345      * to restore its original value. This is not true on GENCGC
346      * anymore. d_s_f_p and reg_alloc get out of sync, but the p_a
347      * bits stay intact and we set it to the proper value when it
348      * needs to be. Keep this comment here for the moment in case
349      * somebody tries to figure out what happened here.
350      */
351     /*    dynamic_space_free_pointer =
352         (lispobj *) ((long) dynamic_space_free_pointer - size);
353     */
354 #if 0
355     fprintf(stderr, "free_pointer = 0x%08x new\n",
356             dynamic_space_free_pointer);
357 #endif
358
359     memory = (char *) alloc(size);
360
361 #if 0
362     fprintf(stderr, "alloc returned %p\n", memory);
363     fprintf(stderr, "free_pointer = 0x%08x\n",
364             dynamic_space_free_pointer);
365 #endif
366
367     /*
368      * The allocation macro wants the result to point to the end of the
369      * object!
370      */
371     memory += size;
372
373 #if 0
374     fprintf(stderr, "object end at %p\n", memory);
375 #endif
376
377     *os_context_register_addr(context, target) = (unsigned long) memory;
378     *os_context_register_addr(context, reg_ALLOC) =
379       (unsigned long) dynamic_space_free_pointer
380       | (*os_context_register_addr(context, reg_ALLOC)
381          & LOWTAG_MASK);
382
383     if (were_in_lisp) {
384         undo_fake_foreign_function_call(context);
385     }
386
387
388 }
389 #endif
390
391 void
392 arch_handle_breakpoint(os_context_t *context)
393 {
394     handle_breakpoint(context);
395 }
396
397 void
398 arch_handle_fun_end_breakpoint(os_context_t *context)
399 {
400     *os_context_pc_addr(context)
401         =(int)handle_fun_end_breakpoint(context);
402 }
403
404 void
405 arch_handle_after_breakpoint(os_context_t *context)
406 {
407     *skipped_break_addr = trap_Breakpoint;
408     skipped_break_addr = NULL;
409     *(unsigned int *)*os_context_pc_addr(context)
410         = displaced_after_inst;
411     *os_context_sigmask_addr(context)= orig_sigmask;
412     os_flush_icache((os_vm_address_t) *os_context_pc_addr(context),
413                     sizeof(unsigned int));
414 }
415
416 void
417 arch_handle_single_step_trap(os_context_t *context, int trap)
418 {
419     unsigned int code = *((u32 *)(*os_context_pc_addr(context)));
420     int register_offset = code >> 5 & 0x1f;
421     handle_single_step_trap(context, trap, register_offset);
422     arch_skip_instruction(context);
423 }
424
425 static void
426 sigtrap_handler(int signal, siginfo_t *siginfo, void *void_context)
427 {
428     unsigned int code;
429     os_context_t *context = void_context;
430
431 #ifdef LISP_FEATURE_LINUX
432     os_restore_fp_control(context);
433 #endif
434     code=*((u32 *)(*os_context_pc_addr(context)));
435     if (code == ((3 << 26) | (0x18 << 21) | (reg_NL3 << 16))) {
436         arch_clear_pseudo_atomic_interrupted(context);
437         arch_skip_instruction(context);
438         /* interrupt or GC was requested in PA; now we're done with the
439            PA section we may as well get around to it */
440         interrupt_handle_pending(context);
441         return;
442     }
443
444 #ifdef LISP_FEATURE_GENCGC
445     /* Is this an allocation trap? */
446     if (allocation_trap_p(context)) {
447         handle_allocation_trap(context);
448         arch_skip_instruction(context);
449 #ifdef LISP_FEATURE_DARWIN
450         DARWIN_FIX_CONTEXT(context);
451 #endif
452         return;
453     }
454 #endif
455
456     if ((code >> 16) == ((3 << 10) | (6 << 5))) {
457         /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */
458         int trap = code & 0x1f;
459         handle_trap(context,trap);
460
461 #ifdef LISP_FEATURE_DARWIN
462         DARWIN_FIX_CONTEXT(context);
463 #endif
464         return;
465     }
466     if (((code >> 26) == 3) && (((code >> 21) & 31) == 24)) {
467         interrupt_internal_error(context, 0);
468 #ifdef LISP_FEATURE_DARWIN
469         DARWIN_FIX_CONTEXT(context);
470 #endif
471         return;
472     }
473
474     interrupt_handle_now(signal, (siginfo_t *)code, context);
475 #ifdef LISP_FEATURE_DARWIN
476     /* Work around G5 bug */
477     DARWIN_FIX_CONTEXT(context);
478 #endif
479 }
480
481
482 void arch_install_interrupt_handlers()
483 {
484     undoably_install_low_level_interrupt_handler(SIGILL, sigtrap_handler);
485     undoably_install_low_level_interrupt_handler(SIGTRAP, sigtrap_handler);
486 }
487
488 void
489 ppc_flush_icache(os_vm_address_t address, os_vm_size_t length)
490 {
491   os_vm_address_t end = (os_vm_address_t) ((int)(address+length+(32-1)) &~(32-1));
492   extern void ppc_flush_cache_line(os_vm_address_t);
493
494   while (address < end) {
495     ppc_flush_cache_line(address);
496     address += 32;
497   }
498 }
499
500 #ifdef LISP_FEATURE_LINKAGE_TABLE
501
502 /* Linkage tables for PowerPC
503  *
504  * Linkage entry size is 16, because we need at least 4 instructions to
505  * implement a jump.
506  */
507
508 /*
509  * Define the registers to use in the linkage jump table. Can be the
510  * same. Some care must be exercised when choosing these. It has to be
511  * a register that is not otherwise being used. reg_NFP is a good
512  * choice. call_into_c trashes reg_NFP without preserving it, so we can
513  * trash it in the linkage jump table.
514  */
515 #define LINKAGE_TEMP_REG        reg_NFP
516 #define LINKAGE_ADDR_REG        reg_NFP
517
518 /*
519  * Insert the necessary jump instructions at the given address.
520  */
521 void
522 arch_write_linkage_table_jmp(void* reloc_addr, void *target_addr)
523 {
524   /*
525    * Make JMP to function entry.
526    *
527    * The instruction sequence is:
528    *
529    *        addis 13, 0, (hi part of addr)
530    *        ori   13, 13, (low part of addr)
531    *        mtctr 13
532    *        bctr
533    *
534    */
535   int* inst_ptr;
536   unsigned long hi;                   /* Top 16 bits of address */
537   unsigned long lo;                   /* Low 16 bits of address */
538   unsigned int inst;
539
540   inst_ptr = (int*) reloc_addr;
541
542   /*
543    * Split the target address into hi and lo parts for the sethi
544    * instruction.  hi is the top 22 bits.  lo is the low 10 bits.
545    */
546   hi = (unsigned long) target_addr;
547   lo = hi & 0xffff;
548   hi >>= 16;
549
550   /*
551    * addis 13, 0, (hi part)
552    */
553
554   inst = (15 << 26) | (LINKAGE_TEMP_REG << 21) | (0 << 16) | hi;
555   *inst_ptr++ = inst;
556
557   /*
558    * ori 13, 13, (lo part)
559    */
560
561   inst = (24 << 26) | (LINKAGE_TEMP_REG << 21) | (LINKAGE_TEMP_REG << 16) | lo;
562   *inst_ptr++ = inst;
563
564   /*
565    * mtctr 13
566    */
567
568   inst = (31 << 26) | (LINKAGE_TEMP_REG << 21) | (9 << 16) | (467 << 1);
569   *inst_ptr++ = inst;
570
571   /*
572    * bctr
573    */
574
575   inst = (19 << 26) | (20 << 21) | (528 << 1);
576   *inst_ptr++ = inst;
577
578
579   *inst_ptr++ = inst;
580
581   os_flush_icache((os_vm_address_t) reloc_addr, (char*) inst_ptr - (char*) reloc_addr);
582 }
583
584 void
585 arch_write_linkage_table_ref(void * reloc_addr, void *target_addr)
586 {
587     *(unsigned long *)reloc_addr = (unsigned long)target_addr;
588 }
589
590 #endif