bda94998caa8f2c545bce712c1145ff177e469e5
[projects/cmucl/cmucl.git] / src / lisp / ppc-arch.c
1 /*
2
3  $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.14 2008/11/12 15:04:24 rtoy Rel $
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 "arch.h"
13 #include "lisp.h"
14 #include "internals.h"
15 #include "globals.h"
16 #include "validate.h"
17 #include "os.h"
18 #include "lispregs.h"
19 #include "signal.h"
20 #include "interrupt.h"
21 #include "interr.h"
22
23   /* The header files may not define PT_DAR/PT_DSISR.  This definition
24      is correct for all versions of ppc linux >= 2.0.30
25
26      As of DR2.1u4, MkLinux doesn't pass these registers to signal
27      handlers correctly; a patch is necessary in order to (partially)
28      correct this.
29
30      Even with the patch, the DSISR may not have its 'write' bit set
31      correctly (it tends not to be set if the fault was caused by
32      something other than a protection violation.)
33
34      Caveat callers.  */
35
36 #ifndef PT_DAR
37 #define PT_DAR          41
38 #endif
39
40 #ifndef PT_DSISR
41 #define PT_DSISR        42
42 #endif
43
44 /* 
45  * A macro to generate the instruction
46  *
47  * twllei r0, code
48  *
49  * This is what the ppc port uses to signal various traps like
50  * breakpoints and stuff.
51  */
52 #define TWLLEI_R0(code) ((3<<26) | (6 << 21) | code)
53
54 char *
55 arch_init(fpu_mode_t mode)
56 {
57     return "lisp.core";
58 }
59
60 os_vm_address_t arch_get_bad_addr(HANDLER_ARGS)
61 {
62     os_context_t *os_context = (os_context_t *) context;
63     os_vm_address_t addr;
64
65     addr = (os_vm_address_t) SC_REG(os_context, PT_DAR);
66     return addr;
67 }
68
69
70 void
71 arch_skip_instruction(os_context_t * context)
72 {
73     /* Skip the offending instruction */
74     SC_PC(context) += 4;
75 }
76
77 unsigned char *
78 arch_internal_error_arguments(os_context_t * scp)
79 {
80     return (unsigned char *) (SC_PC(scp) + 4);
81 }
82
83 boolean arch_pseudo_atomic_atomic(os_context_t * scp)
84 {
85     return (SC_REG(scp, reg_ALLOC) & 4);
86 }
87
88 #define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000
89
90 void
91 arch_set_pseudo_atomic_interrupted(os_context_t * scp)
92 {
93 #if 0
94     SC_REG(scp, reg_NL3) += PSEUDO_ATOMIC_INTERRUPTED_BIAS;
95 #else
96     SC_REG(scp, reg_ALLOC) |= 1;
97 #endif
98 }
99
100 unsigned long
101 arch_install_breakpoint(void *pc)
102 {
103     unsigned long *ptr = (unsigned long *) pc;
104     unsigned long result = *ptr;
105
106     /* 
107      * Insert a twllei r0, trap_Breakpoint instruction.
108      */
109     *ptr = TWLLEI_R0(trap_Breakpoint);
110     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
111
112     return result;
113 }
114
115 void
116 arch_remove_breakpoint(void *pc, unsigned long orig_inst)
117 {
118     *(unsigned long *) pc = orig_inst;
119     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
120 }
121
122 static unsigned long *skipped_break_addr, displaced_after_inst;
123 static sigset_t orig_sigmask;
124
125 void
126 arch_do_displaced_inst(os_context_t * scp, unsigned long orig_inst)
127 {
128     unsigned int *pc = (unsigned int *) SC_PC(scp);
129
130     orig_sigmask = scp->uc_sigmask;
131     sigemptyset(&scp->uc_sigmask);
132     FILLBLOCKSET(&scp->uc_sigmask);
133
134     /* Put the original instruction back */
135     *pc = orig_inst;
136     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int));
137
138     skipped_break_addr = (unsigned long) pc;
139
140     /*
141      * Replace the next instruction with a 
142      * twllei r0, trap_AfterBreakpoint 
143      */
144     displaced_after_inst = *++pc;
145     *pc = TWLLEI_R0(trap_AfterBreakpoint);
146     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int));
147
148     sigreturn(scp);
149 }
150
151 #ifdef GENCGC
152 /*
153  * Return non-zero if the current instruction is an allocation trap
154  */
155 static int
156 allocation_trap_p(os_context_t * context)
157 {
158     int result;
159     unsigned int *pc;
160     unsigned inst;
161     unsigned opcode;
162     unsigned src;
163     unsigned dst;
164
165     result = 0;
166
167     /*
168      * First, the instruction has to be a TWLGE temp, NL3, which as the
169      * format.
170      * | 6| 5| 5 | 5 | 10|1|  width
171      * |31|5 |dst|src|  4|0|  field
172      */
173     pc = (unsigned int *) SC_PC(context);
174     inst = *pc;
175
176 #if 0
177     fprintf(stderr, "allocation_trap_p at %p:  inst = 0x%08x\n", pc, inst);
178 #endif
179
180     opcode = inst >> 26;
181     src = (inst >> 11) & 0x1f;
182     dst = (inst >> 16) & 0x1f;
183     if ((opcode == 31) && (src == reg_NL3) && (5 == ((inst >> 21) & 0x1f))
184         && (4 == ((inst >> 1) & 0x3ff))) {
185         /*
186          * We got the instruction.  Now, look back to make sure it was
187          * proceeded by what we expected.  2 instructions back should be
188          * an ADD or ADDI instruction.
189          */
190         unsigned int add_inst;
191
192         add_inst = pc[-2];
193 #if 0
194         fprintf(stderr, "   add inst at %p:  inst = 0x%08x\n",
195                 pc - 2, add_inst);
196 #endif
197         opcode = add_inst >> 26;
198         if ((opcode == 31) && (266 == ((add_inst >> 1) & 0x1ff))) {
199             return 1;
200         } else if ((opcode == 14)) {
201             return 1;
202         } else {
203             fprintf(stderr,
204                     "Whoa! Got allocation trap not preceeded by an ADD or ADDI instruction: 0x%08x\n",
205                     add_inst);
206         }
207     }
208     return 0;
209 }
210
211 /*
212  * Use this function to enable the minimum number of signals we need
213  * when our trap handler needs to call Lisp code that might cons.  For
214  * consing to work with gencgc, we need to be able to trap the SIGILL
215  * signal to perform allocation.
216  */
217 void
218 enable_some_signals(void)
219 {
220     sigset_t sigs;
221
222 #if 0
223     fprintf(stderr, "Enabling some signals\n");
224 #endif
225 #if 0
226     sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0);
227 #else
228     sigemptyset(&sigs);
229     sigaddset(&sigs, SIGILL);
230     sigaddset(&sigs, SIGBUS);
231     sigprocmask(SIG_UNBLOCK, &sigs, NULL);
232 #endif
233 #if 0
234     fprintf(stderr, "Some signals enabled\n");
235 #endif
236 }
237
238 void
239 handle_allocation_trap(os_context_t * context)
240 {
241     unsigned int *pc;
242     unsigned int inst;
243     unsigned int or_inst;
244     unsigned int target;
245     unsigned int opcode;
246     int size;
247     int immed;
248     boolean were_in_lisp;
249     char *memory;
250     sigset_t block;
251
252     target = 0;
253     size = 0;
254
255 #if 0
256     fprintf(stderr, "In handle_allocation_trap\n");
257 #endif
258     /*
259      * I don't think it's possible for us NOT to be in lisp when we get
260      * here.  Remove this later?
261      */
262     were_in_lisp = !foreign_function_call_active;
263
264     if (were_in_lisp) {
265         fake_foreign_function_call(context);
266     } else {
267         fprintf(stderr, "**** Whoa! allocation trap and we weren't in lisp!\n");
268     }
269
270     /*
271      * Look at current instruction: TWNE temp, NL3. We're here because
272      * temp > NL3 and temp is the end of the allocation, and NL3 is
273      * current-region-end-addr.
274      *
275      * We need to adjust temp and alloc-tn.
276      */
277
278     pc = (unsigned int *) SC_PC(context);
279     inst = pc[0];
280     target = (inst >> 16) & 0x1f;
281
282 #if 0
283     fprintf(stderr, "handle_allocation_trap at %p:\n", pc);
284     fprintf(stderr, "  trap inst = 0x%08x\n", inst);
285     fprintf(stderr, "  target reg = %s\n", lisp_register_names[target]);
286 #endif
287     /*
288      * Go back and look at the add/addi instruction.  The second src arg
289      * is the size of the allocation.  Get it and call alloc to allocate
290      * new space.
291      */
292     inst = pc[-2];
293     opcode = inst >> 26;
294 #if 0
295     fprintf(stderr, "  add inst  = 0x%08x, opcode = %d\n", inst, opcode);
296 #endif
297     if (opcode == 14) {
298         /*
299          * ADDI temp-tn, alloc-tn, size 
300          *
301          * Extract the size
302          */
303         size = (inst & 0xffff);
304     } else if (opcode == 31) {
305         /*
306          * ADD temp-tn, alloc-tn, size-tn
307          *
308          * Extract the size
309          */
310         int reg;
311
312         reg = (inst >> 11) & 0x1f;
313 #if 0
314         fprintf(stderr, "  add, reg = %s\n", lisp_register_names[reg]);
315 #endif
316         size = SC_REG(context, reg);
317     }
318 #if 0
319     fprintf(stderr, "Alloc %d to %s\n", size, lisp_register_names[target]);
320 #endif
321
322     /*
323      * Well, maybe not.  sigill_handler probably shouldn't be unblocking
324      * all signals.  So, let's enable just the signals we need.  Since
325      * alloc might call GC, we need to have SIGILL enabled so we can do
326      * allocation.  Do we need more?
327      */
328     enable_some_signals();
329
330 #if 0
331     fprintf(stderr, "Ready to alloc\n");
332     fprintf(stderr, "free_pointer = 0x%08x\n",
333             current_dynamic_space_free_pointer);
334 #endif
335     /*
336      * alloc-tn was incremented by size.  Need to decrement it by size to restore it's original value.
337      */
338     current_dynamic_space_free_pointer =
339         (lispobj *) ((long) current_dynamic_space_free_pointer - size);
340 #if 0
341     fprintf(stderr, "free_pointer = 0x%08x new\n",
342             current_dynamic_space_free_pointer);
343 #endif
344
345     memory = (char *) alloc(size);
346
347 #if 0
348     fprintf(stderr, "alloc returned %p\n", memory);
349     fprintf(stderr, "free_pointer = 0x%08x\n",
350             current_dynamic_space_free_pointer);
351 #endif
352
353     /* 
354      * The allocation macro wants the result to point to the end of the
355      * object!
356      */
357     memory += size;
358 #if 0
359     fprintf(stderr, "object end at %p\n", memory);
360 #endif
361     SC_REG(context, target) = (unsigned long) memory;
362     SC_REG(context, reg_ALLOC) =
363         (unsigned long) current_dynamic_space_free_pointer;
364
365     if (were_in_lisp) {
366         undo_fake_foreign_function_call(context);
367     }
368
369
370 }
371 #endif
372
373 static void
374 sigill_handler(HANDLER_ARGS)
375 {
376     os_context_t *os_context = (os_context_t *) context;
377     int badinst;
378     int opcode;
379
380     sigprocmask(SIG_SETMASK, &os_context->uc_sigmask, 0);
381     opcode = *((int *) SC_PC(os_context));
382
383 #if 0
384     printf("SIGILL entry:  opcode = 0x%08x\n", opcode);
385     fflush(stdout);
386 #endif
387
388     if (opcode == ((3 << 26) | (0x18 << 21) | (reg_NL3 << 16))) {
389         /* Got a twnei reg_NL3,0 - check for deferred interrupt */
390 #if 1
391         /* Clear the pseudo-atomic-interrupted bit */
392         SC_REG(os_context, reg_ALLOC) &= ~1;
393 #else
394         (SC_REG(os_context, reg_ALLOC) -= PSEUDO_ATOMIC_INTERRUPTED_BIAS);
395 #endif
396         arch_skip_instruction(os_context);
397         interrupt_handle_pending(os_context);
398 #ifdef DARWIN
399         /* Work around G5 bug; fix courtesy gbyers via chandler */
400         sigreturn(os_context);
401 #endif
402         return;
403     }
404
405     /* Is this an allocation trap? */
406 #ifdef GENCGC
407     if (allocation_trap_p(os_context)) {
408         handle_allocation_trap(os_context);
409         arch_skip_instruction(os_context);
410 #ifdef DARWIN
411         sigreturn(os_context);
412 #endif
413         return;
414     }
415 #endif
416
417     if ((opcode >> 16) == ((3 << 10) | (6 << 5))) {
418         /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */
419         int trap = opcode & 0x1f, extra = (opcode >> 5) & 0x1f;
420
421 #if 0
422         printf("SIGILL:  TWLLEI, code = %d\n", trap);
423         fflush(stdout);
424 #endif
425
426         switch (trap) {
427           case trap_Halt:
428               fake_foreign_function_call(os_context);
429               lose("%%primitive halt called; the party is over.\n");
430
431           case trap_Error:
432           case trap_Cerror:
433               interrupt_internal_error(signal, code, os_context,
434                                        trap == trap_Cerror);
435               break;
436
437           case trap_PendingInterrupt:
438               arch_skip_instruction(os_context);
439               interrupt_handle_pending(os_context);
440               break;
441
442           case trap_Breakpoint:
443 #if 0
444               printf("trap_Breakpoint\n");
445               fflush(stdout);
446 #endif
447               handle_breakpoint(signal, code, os_context);
448               break;
449
450           case trap_FunctionEndBreakpoint:
451 #if 0
452               printf("trap_FunctionEndBreakpoint\n");
453               fflush(stdout);
454 #endif
455               SC_PC(os_context) =
456                   (int) handle_function_end_breakpoint(signal, code, os_context);
457               break;
458
459           case trap_AfterBreakpoint:
460 #if 0
461               fprintf(stderr, "trap_AfterBreakpoint: break_addr = %p\n",
462                       skipped_break_addr);
463               fprintf(stderr, " CSP  = %p\n",
464                       (void *) SC_REG(os_context, reg_CSP));
465               fprintf(stderr, " CFP  = %p\n",
466                       (void *) SC_REG(os_context, reg_CFP));
467               fprintf(stderr, " OCFP = %p\n",
468                       (void *) SC_REG(os_context, reg_OCFP));
469 #endif
470               /* Put our breakpoint instruction back in */
471               *skipped_break_addr = TWLLEI_R0(trap_Breakpoint);
472               skipped_break_addr = NULL;
473               *(unsigned long *) SC_PC(os_context) = displaced_after_inst;
474               os_context->uc_sigmask = orig_sigmask;
475
476               os_flush_icache((os_vm_address_t) SC_PC(os_context),
477                               sizeof(unsigned long));
478               break;
479
480           default:
481               interrupt_handle_now(signal, code, os_context);
482               break;
483         }
484 #ifdef DARWIN
485         /* Work around G5 bug; fix courtesy gbyers via chandler */
486         sigreturn(os_context);
487 #endif
488         return;
489     }
490     if (((opcode >> 26) == 3) && (((opcode >> 21) & 31) == 24)) {
491         interrupt_internal_error(signal, code, os_context, 0);
492 #ifdef DARWIN
493         /* Work around G5 bug; fix courtesy gbyers via chandler */
494         sigreturn(os_context);
495 #endif
496         return;
497     }
498
499     interrupt_handle_now(signal, code, os_context);
500 #ifdef DARWIN
501     /* Work around G5 bug; fix courtesy gbyers via chandler */
502     sigreturn(os_context);
503 #endif
504 }
505
506
507 void
508 arch_install_interrupt_handlers(void)
509 {
510     interrupt_install_low_level_handler(SIGILL, sigill_handler);
511     interrupt_install_low_level_handler(SIGTRAP, sigill_handler);
512 }
513
514
515 extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs);
516
517 lispobj
518 funcall0(lispobj function)
519 {
520     lispobj *args = current_control_stack_pointer;
521
522     return call_into_lisp(function, args, 0);
523 }
524
525 lispobj
526 funcall1(lispobj function, lispobj arg0)
527 {
528     lispobj *args = current_control_stack_pointer;
529
530     current_control_stack_pointer += 1;
531     args[0] = arg0;
532
533     return call_into_lisp(function, args, 1);
534 }
535
536 lispobj
537 funcall2(lispobj function, lispobj arg0, lispobj arg1)
538 {
539     lispobj *args = current_control_stack_pointer;
540
541     current_control_stack_pointer += 2;
542     args[0] = arg0;
543     args[1] = arg1;
544
545     return call_into_lisp(function, args, 2);
546 }
547
548 lispobj
549 funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
550 {
551     lispobj *args = current_control_stack_pointer;
552
553     current_control_stack_pointer += 3;
554     args[0] = arg0;
555     args[1] = arg1;
556     args[2] = arg2;
557
558     return call_into_lisp(function, args, 3);
559 }
560
561 void
562 ppc_flush_icache(os_vm_address_t address, os_vm_size_t length)
563 {
564     os_vm_address_t end =
565         (os_vm_address_t) ((int) (address + length + (32 - 1)) & ~(32 - 1));
566     extern void ppc_flush_cache_line(os_vm_address_t);
567
568     while (address < end) {
569         ppc_flush_cache_line(address);
570         address += 32;
571     }
572 }
573
574 #ifdef LINKAGE_TABLE
575 /* Linkage tables for PowerPC
576  *
577  * Linkage entry size is 16, because we need at least 4 instructions to
578  * implement a jump.
579  */
580
581 /*
582  * This had better match lisp::target-foreign-linkage-entry-size in
583  * ppco/parms.lisp!  Each entry is 6 instructions long, so at least
584  * 24 bytes.
585  */
586 #ifndef LinkageEntrySize
587 #define LinkageEntrySize (8*4)
588 #endif
589
590 /*
591  * Define the registers to use in the linkage jump table. Can be the
592  * same. Some care must be exercised when choosing these. It has to be
593  * a register that is not otherwise being used. reg_NFP is a good
594  * choice. call_into_c trashes reg_NFP without preserving it, so we can
595  * trash it in the linkage jump table.
596  */
597 #define LINKAGE_TEMP_REG        reg_NFP
598 #define LINKAGE_ADDR_REG        reg_A0
599
600 /*
601  * Insert the necessary jump instructions at the given address.
602  */
603 void
604 arch_make_jump_entry(void *reloc_addr, void *target_addr)
605 {
606     /*
607      * Make JMP to function entry.
608      *
609      * The instruction sequence is:
610      *
611      *        addis temp, 0, (hi part of reloc)
612      *        ori   temp, temp, (lo part of reloc)
613      *        addis addr, 0, (hi part of addr)
614      *        ori   addr, addr, (low part of addr)
615      *        mtctr addr
616      *        bctr
617      *        
618      */
619     int *inst_ptr;
620     unsigned long hi;           /* Top 16 bits of address */
621     unsigned long lo;           /* Low 16 bits of address */
622     unsigned int inst;
623
624     inst_ptr = (int *) reloc_addr;
625
626     /*
627      * Split the target address into hi and lo parts for the addis/ori
628      * instructions.
629      */
630     hi = (unsigned long) reloc_addr;
631     lo = hi & 0xffff;
632     hi >>= 16;
633
634     /*
635      * addis 3, 0, (hi part)
636      */
637     inst = (15 << 26) | (LINKAGE_ADDR_REG << 21) | (0 << 16) | hi;
638     *inst_ptr++ = inst;
639
640     /*
641      * ori 3, 3, (lo part)
642      */
643
644     inst =
645         (24 << 26) | (LINKAGE_ADDR_REG << 21) | (LINKAGE_ADDR_REG << 16) | lo;
646     *inst_ptr++ = inst;
647
648     /*
649      * Split the target address into hi and lo parts for the addis/ori
650      * instructions.
651      */
652
653     hi = (unsigned long) target_addr;
654     lo = hi & 0xffff;
655     hi >>= 16;
656
657     /*
658      * addis 13, 0, (hi part)
659      */
660
661     inst = (15 << 26) | (LINKAGE_TEMP_REG << 21) | (0 << 16) | hi;
662     *inst_ptr++ = inst;
663
664     /*
665      * ori 13, 13, (lo part)
666      */
667
668     inst =
669         (24 << 26) | (LINKAGE_TEMP_REG << 21) | (LINKAGE_TEMP_REG << 16) | lo;
670     *inst_ptr++ = inst;
671
672     /*
673      * mtctr 13
674      */
675
676     inst = (31 << 26) | (LINKAGE_TEMP_REG << 21) | (9 << 16) | (467 << 1);
677     *inst_ptr++ = inst;
678
679     /*
680      * bctr
681      */
682
683     inst = (19 << 26) | (20 << 21) | (528 << 1);
684     *inst_ptr++ = inst;
685
686
687     *inst_ptr++ = inst;
688
689     os_flush_icache((os_vm_address_t) reloc_addr,
690                     (char *) inst_ptr - (char *) reloc_addr);
691 }
692
693 void
694 arch_make_linkage_entry(long linkage_entry, void *target_addr, long type)
695 {
696     int *reloc_addr = (int *) (FOREIGN_LINKAGE_SPACE_START
697
698                                + linkage_entry * LinkageEntrySize);
699
700     if (type == 1) {            /* code reference */
701         arch_make_jump_entry(reloc_addr, target_addr);
702     } else if (type == 2) {
703         *(unsigned long *) reloc_addr = (unsigned long) target_addr;
704     }
705 }
706
707 /* Make a the entry a jump to resolve_linkage_tramp. */
708
709 extern void resolve_linkage_tramp(void);
710
711 void
712 arch_make_lazy_linkage(long linkage_entry)
713 {
714     arch_make_linkage_entry(linkage_entry, (void *) resolve_linkage_tramp, 1);
715 }
716
717 /* Get linkage entry.  We're given the return address which should be
718    the address of the jmpl instruction (2nd word) of the linkage
719    entry.  Figure out which entry this address belong to. */
720
721 long
722 arch_linkage_entry(unsigned long retaddr)
723 {
724     return (retaddr - (FOREIGN_LINKAGE_SPACE_START))
725         / LinkageEntrySize;
726 }
727 #endif
728
729 int ieee754_rem_pio2(double x, double *y0, double *y1)
730 {
731   extern int __ieee754_rem_pio2(double x, double *y);
732
733   double y[2];
734   int n;
735
736   n = __ieee754_rem_pio2(x, y);
737   *y0 = y[0];
738   *y1 = y[1];
739
740   return n;
741 }