src/lisp/os.h:
[projects/cmucl/cmucl.git] / src / lisp / x86-arch.c
1 /* x86-arch.c -*- Mode: C; comment-column: 40 -*-
2  *
3  * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-arch.c,v 1.43 2010/12/26 16:04:43 rswindells Exp $ 
4  *
5  */
6
7 #include <stdio.h>
8 #include <stdlib.h>
9
10 #include "lisp.h"
11 #include "globals.h"
12 #include "validate.h"
13 #include "os.h"
14 #include "internals.h"
15 #include "arch.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
23 #define BREAKPOINT_INST 0xcc    /* INT3 */
24
25 unsigned long fast_random_state = 1;
26
27 #if defined(SOLARIS)
28 /*
29  * Use the /dev/cpu/self/cpuid interface on Solaris.  We could use the
30  * same method below, but the Sun C compiler miscompiles the inline
31  * assembly.
32  */
33
34 #include <sys/types.h>
35 #include <sys/stat.h>
36 #include <fcntl.h>
37 #include <unistd.h>
38 #include <string.h>
39 #include <errno.h>
40
41 void cpuid(int level, unsigned int* a, unsigned int* b,
42            unsigned int* c, unsigned int* d)
43 {
44     int device;
45     uint32_t regs[4];
46     static const char devname[] = "/dev/cpu/self/cpuid";
47
48         *a = *b = *c = *d = 0;
49     if ((device = open(devname, O_RDONLY)) == -1) {
50         perror(devname);
51         goto exit;
52     }
53
54     if (pread(device, regs, sizeof(regs), 1) != sizeof(regs)) {
55         perror(devname);
56         goto exit;
57     }
58
59     *a = regs[0];
60     *b = regs[1];
61     *c = regs[2];
62     *d = regs[3];
63
64   exit:
65     (void) close(device);
66
67     return;
68 }
69
70 #else
71 #define __cpuid(level, a, b, c, d)                      \
72   __asm__ ("xchgl\t%%ebx, %1\n\t"                       \
73            "cpuid\n\t"                                  \
74            "xchgl\t%%ebx, %1\n\t"                       \
75            : "=a" (a), "=r" (b), "=c" (c), "=d" (d)     \
76            : "0" (level))
77
78 void cpuid(int level, unsigned int* a, unsigned int* b,
79            unsigned int* c, unsigned int* d)
80 {
81     unsigned int eax, ebx, ecx, edx;
82     
83     __cpuid(level, eax, ebx, ecx, edx);
84
85     *a = eax;
86     *b = ebx;
87     *c = ecx;
88     *d = edx;
89 }
90 #endif
91
92 int
93 arch_support_sse2(void)
94 {
95     unsigned int eax, ebx, ecx, edx;
96
97     cpuid(1, &eax, &ebx, &ecx, &edx);
98
99     /* Return non-zero if SSE2 is supported */
100     return edx & 0x4000000;
101 }
102
103 char *
104 arch_init(fpu_mode_t mode)
105 {
106     int have_sse2;
107
108     have_sse2 = arch_support_sse2() && os_support_sse2();
109     
110     switch (mode) {
111       case AUTO:
112           if (have_sse2) {
113               return "lisp-sse2.core";
114           } else {
115               return "lisp-x87.core";
116           }
117           break;
118       case X87:
119           return "lisp-x87.core";
120           break;
121       case SSE2:
122           return "lisp-sse2.core";
123           break;
124       default:
125           abort();
126     }
127 }
128 \f
129
130
131 /*
132  * Assuming we get here via an INT3 xxx instruction, the PC now
133  * points to the interrupt code (lisp value) so we just move past
134  * it. Skip the code, then if the code is an error-trap or
135  * Cerror-trap then skip the data bytes that follow.
136  */
137
138 void
139 arch_skip_instruction(os_context_t * context)
140 {
141     int vlen, code;
142
143     DPRINTF(0, (stderr, "[arch_skip_inst at %lx>]\n", SC_PC(context)));
144
145     /* Get and skip the lisp error code. */
146     code = *(char *) SC_PC(context)++;
147     switch (code) {
148       case trap_Error:
149       case trap_Cerror:
150           /* Lisp error arg vector length */
151           vlen = *(char *) SC_PC(context)++;
152           /* Skip lisp error arg data bytes */
153           while (vlen-- > 0)
154               SC_PC(context)++;
155           break;
156
157       case trap_Breakpoint:
158       case trap_FunctionEndBreakpoint:
159           break;
160
161       case trap_PendingInterrupt:
162       case trap_Halt:
163           /* Only needed to skip the Code. */
164           break;
165
166       default:
167           fprintf(stderr, "[arch_skip_inst invalid code %d\n]\n", code);
168           break;
169     }
170
171     DPRINTF(0, (stderr, "[arch_skip_inst resuming at %lx>]\n", SC_PC(context)));
172 }
173
174 unsigned char *
175 arch_internal_error_arguments(os_context_t * context)
176 {
177     return (unsigned char *) (SC_PC(context) + 1);
178 }
179
180 boolean
181 arch_pseudo_atomic_atomic(os_context_t * context)
182 {
183     return SymbolValue(PSEUDO_ATOMIC_ATOMIC);
184 }
185
186 void
187 arch_set_pseudo_atomic_interrupted(os_context_t * context)
188 {
189     SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1));
190 }
191 \f
192
193
194 unsigned long
195 arch_install_breakpoint(void *pc)
196 {
197     unsigned long result = *(unsigned long *) pc;
198
199     *(char *) pc = BREAKPOINT_INST;     /* x86 INT3       */
200     *((char *) pc + 1) = trap_Breakpoint;       /* Lisp trap code */
201
202     return result;
203 }
204
205 void
206 arch_remove_breakpoint(void *pc, unsigned long orig_inst)
207 {
208     *((char *) pc) = orig_inst & 0xff;
209     *((char *) pc + 1) = (orig_inst & 0xff00) >> 8;
210 }
211 \f
212
213
214 /*
215  * When single stepping single_stepping holds the original instruction
216  * pc location.
217  */
218
219 unsigned int *single_stepping = NULL;
220
221 #ifndef __linux__
222 unsigned int single_step_save1;
223 unsigned int single_step_save2;
224 unsigned int single_step_save3;
225 #endif
226
227 void
228 arch_do_displaced_inst(os_context_t * context, unsigned long orig_inst)
229 {
230     unsigned int *pc = (unsigned int *) SC_PC(context);
231
232     /*
233      * Put the original instruction back.
234      */
235
236     *((char *) pc) = orig_inst & 0xff;
237     *((char *) pc + 1) = (orig_inst & 0xff00) >> 8;
238
239 #ifdef SC_EFLAGS
240     /* Enable single-stepping */
241     SC_EFLAGS(context) |= 0x100;
242 #else
243
244     /*
245      * Install helper instructions for the single step:
246      *    nop; nop; nop; pushf; or [esp],0x100; popf.
247      *
248      * The or instruction enables the trap flag which enables
249      * single-stepping.  So when the popf instruction is run, we start
250      * single-stepping and stop on the next instruction.
251      */
252
253     DPRINTF(0, (stderr, "Installing helper instructions\n"));
254     
255     single_step_save1 = *(pc - 3);
256     single_step_save2 = *(pc - 2);
257     single_step_save3 = *(pc - 1);
258     *(pc - 3) = 0x9c909090;
259     *(pc - 2) = 0x00240c81;
260     *(pc - 1) = 0x9d000001;
261 #endif
262
263     single_stepping = (unsigned int *) pc;
264
265 #ifndef SC_EFLAGS
266     /*
267      * pc - 9 points to the pushf instruction that we installed for
268      * the helper.
269      */
270     
271     DPRINTF(0, (stderr, " Setting pc to pushf instruction at %p\n", (void*) ((char*) pc - 9)));
272     SC_PC(context) = (int)((char *) pc - 9);
273 #endif
274 }
275 \f
276
277 void
278 sigtrap_handler(HANDLER_ARGS)
279 {
280     unsigned int trap;
281     os_context_t* os_context = (os_context_t *) context;
282 #if 0
283     fprintf(stderr, "x86sigtrap: %8x %x\n",
284             SC_PC(os_os_context), *(unsigned char *) (SC_PC(os_context) - 1));
285     fprintf(stderr, "sigtrap(%d %d %x)\n", signal, CODE(code), os_context);
286 #endif
287
288     if (single_stepping && (signal == SIGTRAP)) {
289 #if 0
290         fprintf(stderr, "* Single step trap %p\n", single_stepping);
291 #endif
292
293 #ifdef SC_EFLAGS
294         /* Disable single-stepping */
295         SC_EFLAGS(os_context) ^= 0x100;
296 #else
297         /* Un-install single step helper instructions. */
298         *(single_stepping - 3) = single_step_save1;
299         *(single_stepping - 2) = single_step_save2;
300         *(single_stepping - 1) = single_step_save3;
301         DPRINTF(0, (stderr, "Uninstalling helper instructions\n"));
302 #endif
303
304         /*
305          * Re-install the breakpoint if possible.
306          */
307         if ((int) SC_PC(os_context) == (int) single_stepping + 1)
308             fprintf(stderr, "* Breakpoint not re-install\n");
309         else {
310             char *ptr = (char *) single_stepping;
311
312             ptr[0] = BREAKPOINT_INST;   /* x86 INT3 */
313             ptr[1] = trap_Breakpoint;
314         }
315
316         single_stepping = NULL;
317         return;
318     }
319
320     /* This is just for info in case monitor wants to print an approx */
321     current_control_stack_pointer = (unsigned long *) SC_SP(os_context);
322
323     RESTORE_FPU(os_context);
324
325     /*
326      * On entry %eip points just after the INT3 byte and aims at the
327      * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a
328      * number of bytes will follow, the first is the length of the byte
329      * arguments to follow.
330      */
331
332     trap = *(unsigned char *) SC_PC(os_context);
333
334     switch (trap) {
335       case trap_PendingInterrupt:
336           DPRINTF(0, (stderr, "<trap Pending Interrupt.>\n"));
337           arch_skip_instruction(os_context);
338           interrupt_handle_pending(os_context);
339           break;
340
341       case trap_Halt:
342           {
343               FPU_STATE(fpu_state);
344               save_fpu_state(fpu_state);
345
346               fake_foreign_function_call(os_context);
347               lose("%%primitive halt called; the party is over.\n");
348               undo_fake_foreign_function_call(os_context);
349
350               restore_fpu_state(fpu_state);
351               arch_skip_instruction(os_context);
352               break;
353           }
354
355       case trap_Error:
356       case trap_Cerror:
357           DPRINTF(0, (stderr, "<trap Error %x>\n", CODE(code)));
358           interrupt_internal_error(signal, code, os_context, CODE(code) == trap_Cerror);
359           break;
360
361       case trap_Breakpoint:
362 #if 0
363           fprintf(stderr, "*C break\n");
364 #endif
365           SC_PC(os_context) -= 1;
366
367           handle_breakpoint(signal, CODE(code), os_context);
368 #if 0
369           fprintf(stderr, "*C break return\n");
370 #endif
371           break;
372
373       case trap_FunctionEndBreakpoint:
374           SC_PC(os_context) -= 1;
375           SC_PC(os_context) =
376               (int) handle_function_end_breakpoint(signal, CODE(code), os_context);
377           break;
378
379 #ifdef trap_DynamicSpaceOverflowWarning
380       case trap_DynamicSpaceOverflowWarning:
381           interrupt_handle_space_overflow(SymbolFunction
382                                           (DYNAMIC_SPACE_OVERFLOW_WARNING_HIT),
383                                           os_context);
384           break;
385 #endif
386 #ifdef trap_DynamicSpaceOverflowError
387       case trap_DynamicSpaceOverflowError:
388           interrupt_handle_space_overflow(SymbolFunction
389                                           (DYNAMIC_SPACE_OVERFLOW_ERROR_HIT),
390                                           os_context);
391           break;
392 #endif
393       default:
394           DPRINTF(0,
395                   (stderr, "[C--trap default %d %d %p]\n", signal, CODE(code),
396                    os_context));
397           interrupt_handle_now(signal, code, os_context);
398           break;
399     }
400 }
401
402 void
403 arch_install_interrupt_handlers(void)
404 {
405     interrupt_install_low_level_handler(SIGILL, sigtrap_handler);
406     interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler);
407 }
408 \f
409
410 extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs);
411
412 /* These next four functions are an interface to the 
413  * Lisp call-in facility. Since this is C we can know
414  * nothing about the calling environment. The control
415  * stack might be the C stack if called from the monitor
416  * or the Lisp stack if called as a result of an interrupt
417  * or maybe even a separate stack. The args are most likely
418  * on that stack but could be in registers depending on
419  * what the compiler likes. So I try to package up the
420  * args into a portable vector and let the assembly language
421  * call-in function figure it out.
422  */
423
424 lispobj
425 funcall0(lispobj function)
426 {
427     lispobj *args = NULL;
428
429     return call_into_lisp(function, args, 0);
430 }
431
432 lispobj
433 funcall1(lispobj function, lispobj arg0)
434 {
435     lispobj args[1];
436
437     args[0] = arg0;
438     return call_into_lisp(function, args, 1);
439 }
440
441 lispobj
442 funcall2(lispobj function, lispobj arg0, lispobj arg1)
443 {
444     lispobj args[2];
445
446     args[0] = arg0;
447     args[1] = arg1;
448     return call_into_lisp(function, args, 2);
449 }
450
451 lispobj
452 funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
453 {
454     lispobj args[3];
455
456     args[0] = arg0;
457     args[1] = arg1;
458     args[2] = arg2;
459     return call_into_lisp(function, args, 3);
460 }
461
462 #ifdef LINKAGE_TABLE
463
464 #ifndef LinkageEntrySize
465 #define LinkageEntrySize 8
466 #endif
467
468 void
469 arch_make_linkage_entry(long linkage_entry, void *target_addr, long type)
470 {
471     char *reloc_addr = (char *) (FOREIGN_LINKAGE_SPACE_START
472
473                                  + linkage_entry * LinkageEntrySize);
474
475     if (type == 1) {            /* code reference */
476         /* Make JMP to function entry. */
477         /* JMP offset is calculated from next instruction. */
478         long offset = (char *) target_addr - (reloc_addr + 5);
479         int i;
480
481         *reloc_addr++ = 0xe9;   /* opcode for JMP rel32 */
482         for (i = 0; i < 4; i++) {
483             *reloc_addr++ = offset & 0xff;
484             offset >>= 8;
485         }
486         /* write a nop for good measure. */
487         *reloc_addr = 0x90;
488     } else if (type == 2) {
489         *(unsigned long *) reloc_addr = (unsigned long) target_addr;
490     }
491 }
492
493 /* Make a call to the first function in the linkage table, which is
494    resolve_linkage_tramp. */
495 void
496 arch_make_lazy_linkage(long linkage_entry)
497 {
498     char *reloc_addr = (char *) (FOREIGN_LINKAGE_SPACE_START
499
500                                  + linkage_entry * LinkageEntrySize);
501     long offset = (char *) (FOREIGN_LINKAGE_SPACE_START) - (reloc_addr + 5);
502     int i;
503
504     *reloc_addr++ = 0xe8;       /* opcode for CALL rel32 */
505     for (i = 0; i < 4; i++) {
506         *reloc_addr++ = offset & 0xff;
507         offset >>= 8;
508     }
509     /* write a nop for good measure. */
510     *reloc_addr = 0x90;
511 }
512
513 /* Get linkage entry.  The initial instruction in the linkage
514    entry is a CALL; the return address we're passed points to the next
515    instruction. */
516
517 long
518 arch_linkage_entry(unsigned long retaddr)
519 {
520     return ((retaddr - 5) - FOREIGN_LINKAGE_SPACE_START) / LinkageEntrySize;
521 }
522 #endif /* LINKAGE_TABLE */
523
524 int ieee754_rem_pio2(double x, double *y0, double *y1)
525 {
526   extern int __ieee754_rem_pio2(double x, double *y);
527
528   double y[2];
529   int n;
530
531   n = __ieee754_rem_pio2(x, y);
532   *y0 = y[0];
533   *y1 = y[1];
534
535   return n;
536 }
537
538