bd9025df6939c360d3561c7d709c1a194f2be778
[projects/cmucl/cmucl.git] / src / lisp / breakpoint.c
1 /*
2
3  $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/breakpoint.c,v 1.26 2008/09/12 21:09:07 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 #include <signal.h>
12
13 #include "lisp.h"
14 #include "os.h"
15 #include "internals.h"
16 #include "interrupt.h"
17 #include "arch.h"
18 #include "lispregs.h"
19 #include "globals.h"
20 #include "alloc.h"
21 #include "breakpoint.h"
22 #if defined GENCGC
23 #include "gencgc.h"
24 #endif
25
26 /*
27  * See MAKE-BOGUS-LRA in code/debug-int.lisp for these values.
28  *
29  * Ideally, internals.h should have the correct values.  We leave
30  * these defaults here for now.
31  */
32 #ifndef REAL_LRA_SLOT
33 #define REAL_LRA_SLOT 0
34 #endif
35
36 #ifndef KNOWN_RETURN_P_SLOT
37 #ifndef i386
38 #define KNOWN_RETURN_P_SLOT 1
39 #else
40 #define KNOWN_RETURN_P_SLOT 2
41 #endif
42 #endif
43
44 #ifndef BOGUS_LRA_CONSTANTS
45 #ifndef i386
46 #define BOGUS_LRA_CONSTANTS 2
47 #else
48 #define BOGUS_LRA_CONSTANTS 3
49 #endif
50 #endif
51
52
53 static void *
54 compute_pc(lispobj code_obj, int pc_offset)
55 {
56     struct code *code;
57
58     code = (struct code *) PTR(code_obj);
59     return (void *) ((char *) code + HeaderValue(code->header) * sizeof(lispobj)
60                      + pc_offset);
61 }
62
63 unsigned long
64 breakpoint_install(lispobj code_obj, int pc_offset)
65 {
66     return arch_install_breakpoint(compute_pc(code_obj, pc_offset));
67 }
68
69 void
70 breakpoint_remove(lispobj code_obj, int pc_offset, unsigned long orig_inst)
71 {
72     arch_remove_breakpoint(compute_pc(code_obj, pc_offset), orig_inst);
73 }
74
75 void
76 breakpoint_do_displaced_inst(os_context_t * scp, unsigned long orig_inst)
77 {
78 #if !defined(hpux) && !defined(irix) && !defined(i386)
79     undo_fake_foreign_function_call(scp);
80 #endif
81     arch_do_displaced_inst(scp, orig_inst);
82 }
83
84 #if !defined(i386)
85 static lispobj
86 find_code(os_context_t * scp)
87 {
88 #ifdef reg_CODE
89     lispobj code = SC_REG(scp, reg_CODE), header;
90
91     if (LowtagOf(code) != type_OtherPointer)
92         return NIL;
93
94     header = *(lispobj *) (code - type_OtherPointer);
95
96     if (TypeOf(header) == type_CodeHeader)
97         return code;
98     else
99         return code - HeaderValue(header) * sizeof(lispobj);
100 #else
101     return NIL;
102 #endif
103 }
104 #endif
105
106 #if defined(i386)
107 static lispobj
108 find_code(os_context_t * scp)
109 {
110     lispobj *codeptr = component_ptr_from_pc((lispobj *) SC_PC(scp));
111
112     if (codeptr == NULL)
113         return NIL;
114     else
115         return (lispobj) codeptr | type_OtherPointer;
116 }
117 #endif
118
119 #if (defined(DARWIN) && defined(__ppc__)) || (defined(sparc))
120 /*
121  * During a function-end-breakpoint, the pc is sometimes less than the
122  * code address, which bypasses the function end stuff.  Then the
123  * offset is zero for a function-end-breakpoint, and we can't find the
124  * breakpoint data, causing an error during tracing.  But we know this
125  * is a function-end breakpoint, because function_end is set to true.
126  *
127  * (This condition of pc < code address seems to occur only if a GC
128  * happens during tracing.  I guess the function-end code object
129  * sometimes gets moved to a lower address than the corresponding
130  * code.)
131  *
132  * Hence this replacement looks at the function end flag first
133  * to see if it is a function-end breakpoint and does the function-end
134  * stuff anyway.  If not, we do the normal stuff.
135  */
136 static int
137 compute_offset(os_context_t * scp, lispobj code, boolean function_end)
138 {
139     if (code == NIL)
140         return 0;
141     if (function_end) {
142         /*
143          * We're in a function end breakpoint.  Compute the
144          * offset from the (known) breakpoint location and the
145          * beginning of the breakpoint guts.  (See *-assem.S.)
146          *
147          * Then make the offset negative so the caller knows
148          * that the offset is not from the code object.
149          */
150         extern char function_end_breakpoint_trap;
151         extern char function_end_breakpoint_guts;
152         int offset;
153             
154         offset =
155             &function_end_breakpoint_trap -
156             &function_end_breakpoint_guts;
157 #if 0
158         fprintf(stderr, "compute_offset\n");
159         fprintf(stderr, " function end offset  = %d\n", offset);
160 #endif
161         return make_fixnum(-offset);
162     } else {
163         unsigned long code_start;
164         struct code *codeptr = (struct code *) PTR(code);
165         unsigned long pc = SC_PC(scp);
166
167         code_start = (unsigned long) codeptr
168             + HeaderValue(codeptr->header) * sizeof(lispobj);
169 #if 0
170         fprintf(stderr, "compute_offset\n");
171         fprintf(stderr, " pc = %d\n", pc);
172         fprintf(stderr, " code_start = %d\n", code_start);
173         fprintf(stderr, " function_end = %d\n", function_end);
174 #endif
175         if (pc < code_start) {
176             return 0;
177         } else {
178             int offset = pc - code_start;
179
180 #if 0
181             fprintf(stderr, " offset = %d\n", offset);
182             fprintf(stderr, " codeptr->code_size = %d\n", codeptr->code_size);
183             fprintf(stderr, " function_end = %d\n", function_end);
184 #endif
185             if (offset >= codeptr->code_size) {
186                 return 0;
187             } else {
188                 return make_fixnum(offset);
189             }
190         }
191     }
192 }
193 #else
194 static int
195 compute_offset(os_context_t * scp, lispobj code, boolean function_end)
196 {
197     if (code == NIL)
198         return 0;
199     else {
200         unsigned long code_start;
201         struct code *codeptr = (struct code *) PTR(code);
202
203 #ifdef parisc
204         unsigned long pc = SC_PC(scp) & ~3;
205 #else
206         unsigned long pc = SC_PC(scp);
207 #endif
208
209         code_start = (unsigned long) codeptr
210             + HeaderValue(codeptr->header) * sizeof(lispobj);
211         if (pc < code_start)
212             return 0;
213         else {
214             int offset = pc - code_start;
215
216             if (offset >= codeptr->code_size) {
217                 return 0;
218             } else {
219                 return make_fixnum(offset);
220             }
221         }
222     }
223 }
224 #endif
225
226 #ifndef i386
227 void
228 handle_breakpoint(int signal, int subcode, os_context_t * scp)
229 {
230     lispobj code;
231
232     fake_foreign_function_call(scp);
233
234     code = find_code(scp);
235
236 #if 0
237     fprintf(stderr, "handle_breakpoint\n");
238     fprintf(stderr, " offset = %d\n", compute_offset(scp, code, 0));
239 #endif    
240     funcall3(SymbolFunction(HANDLE_BREAKPOINT),
241              compute_offset(scp, code, 0), code, alloc_sap(scp));
242
243     undo_fake_foreign_function_call(scp);
244 }
245 #else
246 void
247 handle_breakpoint(int signal, int subcode, os_context_t * scp)
248 {
249     lispobj code, scp_sap = alloc_sap(scp);
250
251     fake_foreign_function_call(scp);
252
253     code = find_code(scp);
254
255     /*
256      * Don't disallow recursive breakpoint traps.  Otherwise, we can't
257      * use debugger breakpoints anywhere in here.
258      */
259
260     sigprocmask(SIG_SETMASK, &scp->uc_sigmask, NULL);
261     funcall3(SymbolFunction(HANDLE_BREAKPOINT),
262              compute_offset(scp, code, 0), code, scp_sap);
263
264     undo_fake_foreign_function_call(scp);
265 }
266 #endif
267
268 #ifndef i386
269 void *
270 handle_function_end_breakpoint(int signal, int subcode, os_context_t * scp)
271 {
272     lispobj code, lra;
273     struct code *codeptr;
274     int offset;
275     int known_return_p;
276     
277     fake_foreign_function_call(scp);
278
279     code = find_code(scp);
280     codeptr = (struct code *) PTR(code);
281     offset = compute_offset(scp, code, 1);
282 #if 0
283     printf("handle_function_end:\n");
284     printf(" code    = 0x%08x\n", code);
285     printf(" codeptr = %p\n", codeptr);
286     printf(" offset  = %d\n", fixnum_value(offset));
287     fflush(stdout);
288 #endif
289
290     if (offset < 0) {
291         /*
292          * We were in the function end breakpoint.  Which means we are
293          * in a bogus LRA, so compute where the code-component of this
294          * bogus lra object starts.  Adjust code, and codeptr
295          * appropriately so the breakpoint handler can do the right
296          * thing.
297          */
298         unsigned int pc;
299
300         pc = SC_PC(scp);
301
302         offset = -offset;
303         /*
304          * Some magic here.  pc points to the trap instruction.  The
305          * offset gives us where the function_end_breakpoint_guts
306          * begins.  But we need to back up some more to get to the
307          * code-component object.  See MAKE-BOGUS-LRA in
308          * debug-int.lisp
309          */
310         code = pc - fixnum_value(offset);
311         code -= sizeof(struct code) + BOGUS_LRA_CONSTANTS * sizeof(lispobj);
312
313         code += type_OtherPointer;
314         codeptr = (struct code *) PTR(code);
315 #if 0
316         printf("  pc   = 0x%08x\n", pc);
317         printf("  code    = 0x%08x\n", code);
318         printf("  codeptr = %p\n", codeptr);
319         fflush(stdout);
320 #endif
321     }
322
323     lra = codeptr->constants[REAL_LRA_SLOT];
324
325     known_return_p = codeptr->constants[KNOWN_RETURN_P_SLOT] != NIL;
326     
327     {
328         lispobj *args = current_control_stack_pointer;
329
330         /*
331          * Because HANDLE_BREAKPOINT can GC, the LRA could move, and
332          * we need to know where it went so we can return to the
333          * correct place.  We do this by saving the LRA on the Lisp
334          * stack.  If GC moves the LRA, the stack entry will get
335          * updated appropriately too.
336          */
337         current_control_stack_pointer += 1;
338         args[0] = lra;
339
340         funcall3(SymbolFunction(HANDLE_BREAKPOINT), offset, code, alloc_sap(scp));
341
342         /*
343          * Breakpoint handling done.  Get the (possibly changed) LRA
344          * value off the stack so we know where to return to.
345          */
346         lra = args[0];
347         current_control_stack_pointer -= 1;
348
349 #ifdef reg_CODE 
350         /*
351          * With the known-return convention, we definitely do NOT want
352          * to mangle the CODE register because it isn't pointing to
353          * the bogus LRA but to the actual routine.
354          */
355         if (!known_return_p) {
356             SC_REG(scp, reg_CODE) = lra;
357         }
358 #endif
359     }
360
361     undo_fake_foreign_function_call(scp);
362     return (void *) (lra - type_OtherPointer + sizeof(lispobj));
363 }
364 #else
365 void *
366 handle_function_end_breakpoint(int signal, int subcode, os_context_t * scp)
367 {
368     lispobj code, scp_sap = alloc_sap(scp);
369     struct code *codeptr;
370
371     fake_foreign_function_call(scp);
372
373     code = find_code(scp);
374     codeptr = (struct code *) PTR(code);
375
376     /*
377      * Don't disallow recursive breakpoint traps.  Otherwise, we can't
378      * use debugger breakpoints anywhere in here.
379      */
380
381     sigprocmask(SIG_SETMASK, &scp->uc_sigmask, NULL);
382     funcall3(SymbolFunction(HANDLE_BREAKPOINT),
383              compute_offset(scp, code, 1), code, scp_sap);
384
385     undo_fake_foreign_function_call(scp);
386
387     return compute_pc(codeptr->constants[REAL_LRA_SLOT],
388                       fixnum_value(codeptr->constants[REAL_LRA_SLOT + 1]));
389 }
390 #endif