Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / amd64-arch.c
1 /* x86-arch.c -*- Mode: C; comment-column: 40 -*-
2  *
3  *
4  */
5
6 #include <stdio.h>
7
8 #include "lisp.h"
9 #include "globals.h"
10 #include "validate.h"
11 #include "os.h"
12 #include "internals.h"
13 #include "arch.h"
14 #include "lispregs.h"
15 #include "signal.h"
16 #include "alloc.h"
17 #include "interrupt.h"
18 #include "interr.h"
19 #include "breakpoint.h"
20
21 #define BREAKPOINT_INST 0xcc    /* INT3 */
22
23 unsigned long fast_random_state = 1;
24
25 char *
26 arch_init(fpu_mode_t mode)
27 {
28     return "lisp.core";
29 }
30 \f
31
32
33 /*
34  * Assuming we get here via an INT3 xxx instruction, the PC now
35  * points to the interrupt code (lisp value) so we just move past
36  * it. Skip the code, then if the code is an error-trap or
37  * Cerror-trap then skip the data bytes that follow.
38  */
39
40 void
41 arch_skip_instruction(struct sigcontext *context)
42 {
43     int vlen, code;
44
45     DPRINTF(0, (stderr, "[arch_skip_inst at %x>]\n", context->sc_pc));
46
47     /* Get and skip the lisp error code. */
48     code = *(char *) context->sc_pc++;
49     switch (code) {
50       case trap_Error:
51       case trap_Cerror:
52           /* Lisp error arg vector length */
53           vlen = *(char *) context->sc_pc++;
54           /* Skip lisp error arg data bytes */
55           while (vlen-- > 0)
56               ((char *) context->sc_pc)++;
57           break;
58
59       case trap_Breakpoint:
60       case trap_FunctionEndBreakpoint:
61           break;
62
63       case trap_PendingInterrupt:
64       case trap_Halt:
65           /* Only needed to skip the Code. */
66           break;
67
68       default:
69           fprintf(stderr, "[arch_skip_inst invalid code %d\n]\n", code);
70           break;
71     }
72
73     DPRINTF(0, (stderr, "[arch_skip_inst resuming at %x>]\n", context->sc_pc));
74 }
75
76 unsigned char *
77 arch_internal_error_arguments(struct sigcontext *context)
78 {
79     return (unsigned char *) (context->sc_pc + 1);
80 }
81
82 boolean
83 arch_pseudo_atomic_atomic(struct sigcontext *context)
84 {
85     return SymbolValue(PSEUDO_ATOMIC_ATOMIC);
86 }
87
88 void
89 arch_set_pseudo_atomic_interrupted(struct sigcontext *context)
90 {
91     SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1));
92 }
93 \f
94
95
96 unsigned long
97 arch_install_breakpoint(void *pc)
98 {
99     unsigned long result = *(unsigned long *) pc;
100
101     *(char *) pc = BREAKPOINT_INST;     /* x86 INT3       */
102     *((char *) pc + 1) = trap_Breakpoint;       /* Lisp trap code */
103
104     return result;
105 }
106
107 void
108 arch_remove_breakpoint(void *pc, unsigned long orig_inst)
109 {
110     *((char *) pc) = orig_inst & 0xff;
111     *((char *) pc + 1) = (orig_inst & 0xff00) >> 8;
112 }
113 \f
114
115
116 /*
117  * When single stepping single_stepping holds the original instruction
118  * pc location.
119  */
120
121 unsigned int *single_stepping = NULL;
122
123 #ifndef __linux__
124 unsigned int single_step_save1;
125 unsigned int single_step_save2;
126 unsigned int single_step_save3;
127 #endif
128
129 void
130 arch_do_displaced_inst(struct sigcontext *context, unsigned long orig_inst)
131 {
132     unsigned int *pc = (unsigned int *) context->sc_pc;
133
134     /*
135      * Put the original instruction back.
136      */
137
138     *((char *) pc) = orig_inst & 0xff;
139     *((char *) pc + 1) = (orig_inst & 0xff00) >> 8;
140
141 #ifdef __linux__
142     context->eflags |= 0x100;
143 #else
144
145     /*
146      * Install helper instructions for the single step:
147      *    pushf; or [esp],0x100; popf.
148      */
149
150     single_step_save1 = *(pc - 3);
151     single_step_save2 = *(pc - 2);
152     single_step_save3 = *(pc - 1);
153     *(pc - 3) = 0x9c909090;
154     *(pc - 2) = 0x00240c81;
155     *(pc - 1) = 0x9d000001;
156 #endif
157
158     single_stepping = (unsigned int *) pc;
159
160 #ifndef __linux__
161     (unsigned int *) context->sc_pc = (char *) pc - 9;
162 #endif
163 }
164 \f
165
166 void
167 sigtrap_handler(HANDLER_ARGS)
168 {
169     unsigned int trap;
170
171 #ifdef __linux__
172     GET_CONTEXT
173 #endif
174 #if 0
175         fprintf(stderr, "x86sigtrap: %8x %x\n",
176                 context->sc_pc, *(unsigned char *) (context->sc_pc - 1));
177     fprintf(stderr, "sigtrap(%d %d %x)\n", signal, code, context);
178 #endif
179
180     if (single_stepping && (signal == SIGTRAP)) {
181 #if 0
182         fprintf(stderr, "* Single step trap %x\n", single_stepping);
183 #endif
184
185 #ifndef __linux__
186         /* Un-install single step helper instructions. */
187         *(single_stepping - 3) = single_step_save1;
188         *(single_stepping - 2) = single_step_save2;
189         *(single_stepping - 1) = single_step_save3;
190 #else
191         context->eflags ^= 0x100;
192 #endif
193
194         /*
195          * Re-install the breakpoint if possible.
196          */
197
198         if ((int) context->sc_pc == (int) single_stepping + 1)
199             fprintf(stderr, "* Breakpoint not re-install\n");
200         else {
201             char *ptr = (char *) single_stepping;
202
203             ptr[0] = BREAKPOINT_INST;   /* x86 INT3 */
204             ptr[1] = trap_Breakpoint;
205         }
206
207         single_stepping = NULL;
208         return;
209     }
210
211     /* This is just for info in case monitor wants to print an approx */
212     current_control_stack_pointer = (unsigned long *) context->sc_sp;
213
214 #if defined(__linux__) && (defined(i386) || defined(__x86_64))
215     /*
216      * Restore the FPU control word, setting the rounding mode to nearest.
217      */
218
219     if (contextstruct.fpstate)
220 #if defined(__x86_64)
221         setfpucw(contextstruct.fpstate->cwd & ~0xc00);
222 #else
223         setfpucw(contextstruct.fpstate->cw & ~0xc00);
224 #endif
225 #endif
226
227     /*
228      * On entry %eip points just after the INT3 byte and aims at the
229      * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a
230      * number of bytes will follow, the first is the length of the byte
231      * arguments to follow.
232      */
233
234     trap = *(unsigned char *) (context->sc_pc);
235
236     switch (trap) {
237       case trap_PendingInterrupt:
238           DPRINTF(0, (stderr, "<trap Pending Interrupt.>\n"));
239           arch_skip_instruction(context);
240           interrupt_handle_pending(context);
241           break;
242
243       case trap_Halt:
244           {
245 #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
246               int fpu_state[27];
247
248               fpu_save(fpu_state);
249 #endif
250               fake_foreign_function_call(context);
251               lose("%%primitive halt called; the party is over.\n");
252               undo_fake_foreign_function_call(context);
253 #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
254               fpu_restore(fpu_state);
255 #endif
256               arch_skip_instruction(context);
257               break;
258           }
259
260       case trap_Error:
261       case trap_Cerror:
262           DPRINTF(0, (stderr, "<trap Error %d>\n", code));
263 #ifdef __linux__
264           interrupt_internal_error(signal, contextstruct, code == trap_Cerror);
265 #else
266           interrupt_internal_error(signal, code, context, code == trap_Cerror);
267 #endif
268           break;
269
270       case trap_Breakpoint:
271 #if 0
272           fprintf(stderr, "*C break\n");
273 #endif
274           (char *) context->sc_pc -= 1;
275           handle_breakpoint(signal, code, context);
276 #if 0
277           fprintf(stderr, "*C break return\n");
278 #endif
279           break;
280
281       case trap_FunctionEndBreakpoint:
282           (char *) context->sc_pc -= 1;
283           context->sc_pc =
284               (int) handle_function_end_breakpoint(signal, code, context);
285           break;
286
287 #ifdef DYNAMIC_SPACE_OVERFLOW_WARNING_HIT
288       case trap_DynamicSpaceOverflowWarning:
289           interrupt_handle_space_overflow(SymbolFunction
290                                           (DYNAMIC_SPACE_OVERFLOW_WARNING_HIT),
291                                           context);
292           break;
293 #endif
294 #ifdef DYNAMIC_SPACE_OVERFLOW_ERROR_HIT
295       case trap_DynamicSpaceOverflowError:
296           interrupt_handle_space_overflow(SymbolFunction
297                                           (DYNAMIC_SPACE_OVERFLOW_ERROR_HIT),
298                                           context);
299           break;
300 #endif
301       default:
302           DPRINTF(0,
303                   (stderr, "[C--trap default %d %d %x]\n", signal, code,
304                    context));
305 #ifdef __linux__
306           interrupt_handle_now(signal, contextstruct);
307 #else
308           interrupt_handle_now(signal, code, context);
309 #endif
310           break;
311     }
312 }
313
314 void
315 arch_install_interrupt_handlers(void)
316 {
317     interrupt_install_low_level_handler(SIGILL, sigtrap_handler);
318     interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler);
319 }
320 \f
321
322 extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs);
323
324 /* These next four functions are an interface to the 
325  * Lisp call-in facility. Since this is C we can know
326  * nothing about the calling environment. The control
327  * stack might be the C stack if called from the monitor
328  * or the Lisp stack if called as a result of an interrupt
329  * or maybe even a separate stack. The args are most likely
330  * on that stack but could be in registers depending on
331  * what the compiler likes. So I try to package up the
332  * args into a portable vector and let the assembly language
333  * call-in function figure it out.
334  */
335
336 lispobj
337 funcall0(lispobj function)
338 {
339     lispobj *args = NULL;
340
341     return call_into_lisp(function, args, 0);
342 }
343
344 lispobj
345 funcall1(lispobj function, lispobj arg0)
346 {
347     lispobj args[1];
348
349     args[0] = arg0;
350     return call_into_lisp(function, args, 1);
351 }
352
353 lispobj
354 funcall2(lispobj function, lispobj arg0, lispobj arg1)
355 {
356     lispobj args[2];
357
358     args[0] = arg0;
359     args[1] = arg1;
360     return call_into_lisp(function, args, 2);
361 }
362
363 lispobj
364 funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
365 {
366     lispobj args[3];
367
368     args[0] = arg0;
369     args[1] = arg1;
370     args[2] = arg2;
371     return call_into_lisp(function, args, 3);
372 }
373
374 #ifdef LINKAGE_TABLE
375
376 #ifndef LinkageEntrySize
377 #define LinkageEntrySize 16
378 #endif
379
380 void
381 arch_make_linkage_entry(long linkage_entry, void *target_addr, long type)
382 {
383     char *reloc_addr = (char *) (FOREIGN_LINKAGE_SPACE_START
384
385                                  + linkage_entry * LinkageEntrySize);
386
387     if (type == 1) {            /* code reference */
388         /* Make JMP to function entry. */
389         long offset = (char *) target_addr;
390         int i;
391
392         /* %r11 is a temp register */
393         *reloc_addr++ = 0x49;   /* opcode for MOV */
394         *reloc_addr++ = 0xbb;   /* %r11 */
395         for (i = 0; i < 8; i++) {
396             *reloc_addr++ = offset & 0xff;
397             offset >>= 8;
398         }
399         *reloc_addr++ = 0x41;   /* jmpq */
400         *reloc_addr++ = 0xff;
401         *reloc_addr++ = 0xe3;   /* %r11 */
402         /* write a nop for good measure. */
403         *reloc_addr = 0x90;
404     } else if (type == 2) {
405         *(unsigned long *) reloc_addr = (unsigned long) target_addr;
406     }
407 }
408
409 /* Make a call to the first function in the linkage table, which is
410    resolve_linkage_tramp. */
411 void
412 arch_make_lazy_linkage(long linkage_entry)
413 {
414     char *reloc_addr = (char *) (FOREIGN_LINKAGE_SPACE_START
415
416                                  + linkage_entry * LinkageEntrySize);
417     long offset = (char *) (FOREIGN_LINKAGE_SPACE_START) - (reloc_addr + 5);
418     int i;
419
420     *reloc_addr++ = 0xe8;       /* opcode for CALL rel32 */
421     for (i = 0; i < 4; i++) {
422         *reloc_addr++ = offset & 0xff;
423         offset >>= 8;
424     }
425     /* write a nop for good measure. */
426     *reloc_addr = 0x90;
427 }
428
429 /* Get linkage entry.  The initial instruction in the linkage
430    entry is a CALL; the return address we're passed points to the next
431    instruction. */
432
433 long
434 arch_linkage_entry(unsigned long retaddr)
435 {
436     return ((retaddr - 5) - FOREIGN_LINKAGE_SPACE_START) / LinkageEntrySize;
437 }
438 #endif /* LINKAGE_TABLE */