Clean up RCS ids
[projects/cmucl/cmucl.git] / src / lisp / alpha-arch.c
1 /*
2
3  This code was written as part of the CMU Common Lisp project at
4  Carnegie Mellon University, and has been placed in the public domain.
5
6 */
7
8 #include <stdio.h>
9 #include <string.h>
10
11 #include "lisp.h"
12 #include "globals.h"
13 #include "validate.h"
14 #include "os.h"
15 #include "internals.h"
16 #include "arch.h"
17 #include "lispregs.h"
18 #include "signal.h"
19 #include "alloc.h"
20 #include "interrupt.h"
21 #include "interr.h"
22 #include "breakpoint.h"
23
24 extern char call_into_lisp_LRA[], call_into_lisp_end[];
25
26 #define BREAKPOINT_INST 0
27
28 char *
29 arch_init(void)
30 {
31     if (mmap((os_vm_address_t) call_into_lisp_LRA_page, OS_VM_DEFAULT_PAGESIZE,
32              OS_VM_PROT_ALL, MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, -1, 0)
33         == (os_vm_address_t) - 1)
34         perror("mmap");
35     memcpy(call_into_lisp_LRA_page, call_into_lisp_LRA, OS_VM_DEFAULT_PAGESIZE);
36     os_flush_icache((os_vm_address_t) call_into_lisp_LRA_page,
37                     OS_VM_DEFAULT_PAGESIZE);
38     return NULL;
39 }
40
41 os_vm_address_t
42 arch_get_bad_addr(int sig, int code, struct sigcontext * scp)
43 {
44     unsigned int badinst;
45
46     if ((scp->sc_pc & 3) != 0)
47         return NULL;
48
49     if ((scp->sc_pc < READ_ONLY_SPACE_START ||
50          scp->sc_pc >= READ_ONLY_SPACE_START + READ_ONLY_SPACE_SIZE) &&
51         ((lispobj *) scp->sc_pc < current_dynamic_space ||
52          (lispobj *) scp->sc_pc >= current_dynamic_space + dynamic_space_size))
53         return NULL;
54
55     badinst = *(unsigned int *) scp->sc_pc;
56
57     if (((badinst >> 27) != 0x16)       /* STL or STQ */
58         &&((badinst >> 27) != 0x13))    /* STS or STT */
59         return NULL;            /* Otherwise forget about address */
60
61     return (os_vm_address_t) (scp->sc_regs[(badinst >> 16) & 0x1f] +
62                               (badinst & 0xffff));
63 }
64
65 void
66 arch_skip_instruction(scp)
67      struct sigcontext *scp;
68 {
69     scp->sc_pc = +4;
70 }
71
72 unsigned char *
73 arch_internal_error_arguments(struct sigcontext *scp)
74 {
75     return (unsigned char *) (scp->sc_pc + 4);
76 }
77
78 boolean
79 arch_pseudo_atomic_atomic(struct sigcontext *scp)
80 {
81     return (scp->sc_regs[reg_ALLOC] & 1);
82 }
83
84 void
85 arch_set_pseudo_atomic_interrupted(struct sigcontext *scp)
86 {
87 #ifdef __linux__
88     scp->sc_regs[reg_ALLOC] |= (1 << 63);
89 #else
90     scp->sc_regs[reg_ALLOC] |= 2;
91 #endif
92 }
93
94 unsigned long
95 arch_install_breakpoint(void *pc)
96 {
97     unsigned int *ptr = (unsigned int *) pc;
98     unsigned long result = (unsigned long) *ptr;
99
100     *ptr = BREAKPOINT_INST;
101
102     os_flush_icache((os_vm_address_t) ptr, sizeof(unsigned long));
103
104     return result;
105 }
106
107 void
108 arch_remove_breakpoint(void *pc, unsigned long orig_inst)
109 {
110     unsigned int *ptr = (unsigned int) pc;
111
112     *ptr = orig_inst;
113     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
114 }
115
116 static unsigned int *skipped_break_addr, displaced_after_inst, after_breakpoint;
117
118 static sigset_t orig_sigmask;
119
120 unsigned int
121 emulate_branch(struct sigcontext *scp, unsigned long orig_inst)
122 {
123     int op = orig_inst >> 26;
124     int reg_a = (orig_inst >> 21) & 0x1f;
125     int reg_b = (orig_inst >> 16) & 0x1f;
126     int fn = orig_inst & 0xffff;
127     int disp =
128
129         (orig_inst & (1 << 20)) ? orig_inst | (-1 << 21) : orig_inst & 0x1fffff;
130     int next_pc = scp->sc_pc;
131     int branch = NULL;
132
133     switch (op) {
134       case 0x1a:                /* jmp, jsr, jsr_coroutine, ret */
135           scp->sc_regs[reg_a] = scp->sc_pc;
136           scp->sc_pc = scp->sc_regs[reg_b] & ~3;
137           break;
138       case 0x30:                /* br */
139           scp->sc_regs[reg_a] = scp->sc_pc;
140           branch = 1;
141           break;
142       case 0x31:                /* fbeq */
143           if (scp->sc_fpregs[reg_a] == 0)
144               branch = 1;
145           break;
146       case 0x32:                /* fblt */
147           if (scp->sc_fpregs[reg_a] < 0)
148               branch = 1;
149           break;
150       case 0x33:                /* fble */
151           if (scp->sc_fpregs[reg_a] <= 0)
152               branch = 1;
153           break;
154       case 0x34:                /* bsr */
155           scp->sc_regs[reg_a] = scp->sc_pc;
156           branch = 1;
157           break;
158       case 0x35:                /* fbne */
159           if (scp->sc_regs[reg_a] != 0)
160               branch = 1;
161           break;
162       case 0x36:                /* fbge */
163           if (scp->sc_fpregs[reg_a] >= 0)
164               branch = 1;
165           break;
166       case 0x37:                /* fbgt */
167           if (scp->sc_fpregs[reg_a] > 0)
168               branch = 1;
169           break;
170       case 0x38:                /* blbc */
171           if ((scp->sc_regs[reg_a] & 1) == 0)
172               branch = 1;
173           break;
174       case 0x39:                /* beq */
175           if (scp->sc_regs[reg_a] == 0)
176               branch = 1;
177           break;
178       case 0x3a:                /* blt */
179           if (scp->sc_regs[reg_a] < 0)
180               branch = 1;
181           break;
182       case 0x3b:                /* ble */
183           if (scp->sc_regs[reg_a] <= 0)
184               branch = 1;
185           break;
186       case 0x3c:                /* blbs */
187           if ((scp->sc_regs[reg_a] & 1) != 0)
188               branch = 1;
189           break;
190       case 0x3d:                /* bne */
191           if (scp->sc_regs[reg_a] != 0)
192               branch = 1;
193           break;
194       case 0x3e:                /* bge */
195           if (scp->sc_regs[reg_a] >= 0)
196               branch = 1;
197           break;
198       case 0x3f:                /* bgt */
199           if (scp->sc_regs[reg_a] > 0)
200               branch = 1;
201           break;
202     }
203     if (branch)
204         next_pc += disp * 4;
205     return next_pc;
206 }
207
208 void
209 arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst)
210 {
211     unsigned int *pc = scp->sc_pc;
212     unsigned int *next_pc;
213     unsigned int next_inst;
214     int op = orig_inst >> 26;;
215
216 #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6))
217     orig_sigmask = context->uc_sigmask;
218     FILLBLOCKSET(&context->uc_sigmask);
219 #else
220     {
221         sigset_t temp;
222
223         sigemptyset(&temp);
224         orig_sigmask.__val[0] = scp->uc_sigmask;
225         temp.__val[0] = scp->uc_sigmask;
226         FILLBLOCKSET(&temp);
227
228         scp->uc_sigmask = temp.__val[0];
229     }
230 #endif
231
232     /* Figure out where the displaced inst is going */
233     if (op == 0x1a || op & 0xf == 0x30) /* branch...ugh */
234         next_pc = (unsigned int *) emulate_branch(scp, orig_inst);
235     else
236         next_pc = pc + 1;
237
238     /* Put the original instruction back. */
239     *pc = orig_inst;
240     os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long));
241
242     skipped_break_addr = pc;
243
244     /* set the after breakpoint */
245     displaced_after_inst = *next_pc;
246     *next_pc = BREAKPOINT_INST;
247     after_breakpoint = 1;
248     os_flush_icache((os_vm_address_t) next_pc, sizeof(unsigned long));
249
250     sigreturn(scp);
251 }
252
253 #define AfterBreakpoint 100
254
255 static void
256 sigtrap_handler(int signal, int code, struct sigcontext *scp)
257 {
258     /* Don't disallow recursive breakpoint traps.  Otherwise, we can't */
259     /* use debugger breakpoints anywhere in here. */
260     sigsetmask(scp->sc_mask);
261
262     if (*(unsigned int *) (scp->sc_pc - 4) == BREAKPOINT_INST) {
263         if (after_breakpoint)
264             code = AfterBreakpoint;
265         else
266             code = trap_Breakpoint;
267     } else
268         code = *(u32 *) scp->sc_pc;
269
270     switch (code) {
271       case trap_PendingInterrupt:
272           arch_skip_instruction(scp);
273           interrupt_handle_pending(scp);
274           break;
275
276       case trap_Halt:
277           fake_foreign_function_call(scp);
278           lose("%%primitive halt called; the party is over.\n");
279
280       case trap_Error:
281       case trap_Cerror:
282           interrupt_internal_error(signal, code, scp, code == trap_Cerror);
283           break;
284
285       case trap_Breakpoint:
286           scp->sc_pc -= 4;
287           handle_breakpoint(signal, code, scp);
288           break;
289
290       case trap_FunctionEndBreakpoint:
291           scp->sc_pc -= 4;
292           scp->sc_pc = (int) handle_function_end_breakpoint(signal, code, scp);
293           break;
294
295       case AfterBreakpoint:
296           scp->sc_pc -= 4;
297           *skipped_break_addr = BREAKPOINT_INST;
298           os_flush_icache((os_vm_address_t) skipped_break_addr,
299
300                           sizeof(unsigned long));
301           skipped_break_addr = NULL;
302           *(unsigned int *) scp->sc_pc = displaced_after_inst;
303           os_flush_icache((os_vm_address_t) scp->sc_pc, sizeof(unsigned long));
304
305 #if  !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6))
306           scp->sc_mask = orig_sigmask;
307 #else
308           scp->sc_mask = orig_sigmask.__val[0];
309 #endif
310           after_breakpoint = NULL;
311           break;
312
313       default:
314           interrupt_handle_now(signal, code, scp);
315           break;
316     }
317 }
318
319 static void
320 sigfpe_handler(int signal, int code, struct sigcontext *scp)
321 {
322 }
323
324 void
325 arch_install_interrupt_handlers(void)
326 {
327     interrupt_install_low_level_handler(SIGILL, sigtrap_handler);
328     interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler);
329     interrupt_install_low_level_handler(SIGFPE, sigfpe_handler);
330 }
331
332 extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs);
333
334 lispobj
335 funcall0(lispobj function)
336 {
337     lispobj *args = current_control_stack_pointer;
338
339     return call_into_lisp(function, args, 0);
340 }
341
342 lispobj
343 funcall1(lispobj function, lispobj arg0)
344 {
345     lispobj *args = current_control_stack_pointer;
346
347     current_control_stack_pointer += 1;
348     args[0] = arg0;
349
350     return call_into_lisp(function, args, 1);
351 }
352
353 lispobj
354 funcall2(lispobj function, lispobj arg0, lispobj arg1)
355 {
356     lispobj *args = current_control_stack_pointer;
357
358     current_control_stack_pointer += 2;
359     args[0] = arg0;
360     args[1] = arg1;
361
362     return call_into_lisp(function, args, 2);
363 }
364
365 lispobj
366 funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2)
367 {
368     lispobj *args = current_control_stack_pointer;
369
370     current_control_stack_pointer += 3;
371     args[0] = arg0;
372     args[1] = arg1;
373     args[2] = arg2;
374
375     return call_into_lisp(function, args, 3);
376 }
377
378
379 /* This is apparently called by emulate_branch, but isn't defined.  So */
380 /* just do nothing and hope it works... */
381
382 void
383 cacheflush(void)
384 {
385 }