1 /*
2 * Copyright (c) 2021 Calvin Rose
3 *
4 * Permission is hereby granted, free of charge, to any person obtaining a copy
5 * of this software and associated documentation files (the "Software"), to
6 * deal in the Software without restriction, including without limitation the
7 * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
8 * sell copies of the Software, and to permit persons to whom the Software is
9 * furnished to do so, subject to the following conditions:
10 *
11 * The above copyright notice and this permission notice shall be included in
12 * all copies or substantial portions of the Software.
13 *
14 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
15 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
16 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
17 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
18 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
19 * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
20 * IN THE SOFTWARE.
21 */
22
23 #ifndef JANET_AMALG
24 #include "features.h"
25 #include <janet.h>
26 #include "gc.h"
27 #include "state.h"
28 #include "util.h"
29 #include "vector.h"
30 #endif
31
32 /* Implements functionality to build a debugger from within janet.
33 * The repl should also be able to serve as pretty featured debugger
34 * out of the box. */
35
36 /* Add a break point to a function */
janet_debug_break(JanetFuncDef * def,int32_t pc)37 void janet_debug_break(JanetFuncDef *def, int32_t pc) {
38 if (pc >= def->bytecode_length || pc < 0)
39 janet_panic("invalid bytecode offset");
40 def->bytecode[pc] |= 0x80;
41 }
42
43 /* Remove a break point from a function */
janet_debug_unbreak(JanetFuncDef * def,int32_t pc)44 void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
45 if (pc >= def->bytecode_length || pc < 0)
46 janet_panic("invalid bytecode offset");
47 def->bytecode[pc] &= ~((uint32_t)0x80);
48 }
49
50 /*
51 * Find a location for a breakpoint given a source file an
52 * location.
53 */
janet_debug_find(JanetFuncDef ** def_out,int32_t * pc_out,const uint8_t * source,int32_t sourceLine,int32_t sourceColumn)54 void janet_debug_find(
55 JanetFuncDef **def_out, int32_t *pc_out,
56 const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) {
57 /* Scan the heap for right func def */
58 JanetGCObject *current = janet_vm.blocks;
59 /* Keep track of the best source mapping we have seen so far */
60 int32_t besti = -1;
61 int32_t best_line = -1;
62 int32_t best_column = -1;
63 JanetFuncDef *best_def = NULL;
64 while (NULL != current) {
65 if ((current->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_FUNCDEF) {
66 JanetFuncDef *def = (JanetFuncDef *)(current);
67 if (def->sourcemap &&
68 def->source &&
69 !janet_string_compare(source, def->source)) {
70 /* Correct source file, check mappings. The chosen
71 * pc index is the instruction closest to the given line column, but
72 * not after. */
73 int32_t i;
74 for (i = 0; i < def->bytecode_length; i++) {
75 int32_t line = def->sourcemap[i].line;
76 int32_t column = def->sourcemap[i].column;
77 if (line <= sourceLine && line >= best_line) {
78 if (column <= sourceColumn &&
79 (line > best_line || column > best_column)) {
80 best_line = line;
81 best_column = column;
82 besti = i;
83 best_def = def;
84 }
85 }
86 }
87 }
88 }
89 current = current->data.next;
90 }
91 if (best_def) {
92 *def_out = best_def;
93 *pc_out = besti;
94 } else {
95 janet_panic("could not find breakpoint");
96 }
97 }
98
janet_stacktrace(JanetFiber * fiber,Janet err)99 void janet_stacktrace(JanetFiber *fiber, Janet err) {
100 const char *prefix = janet_checktype(err, JANET_NIL) ? NULL : "";
101 janet_stacktrace_ext(fiber, err, prefix);
102 }
103
104 /* Error reporting. This can be emulated from within Janet, but for
105 * consitency with the top level code it is defined once. */
janet_stacktrace_ext(JanetFiber * fiber,Janet err,const char * prefix)106 void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
107
108 int32_t fi;
109 const char *errstr = (const char *)janet_to_string(err);
110 JanetFiber **fibers = NULL;
111 int wrote_error = !prefix;
112
113 int print_color = janet_truthy(janet_dyn("err-color"));
114 if (print_color) janet_eprintf("\x1b[31m");
115
116 while (fiber) {
117 janet_v_push(fibers, fiber);
118 fiber = fiber->child;
119 }
120
121 for (fi = janet_v_count(fibers) - 1; fi >= 0; fi--) {
122 fiber = fibers[fi];
123 int32_t i = fiber->frame;
124 while (i > 0) {
125 JanetCFunRegistry *reg = NULL;
126 JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
127 JanetFuncDef *def = NULL;
128 i = frame->prevframe;
129
130 /* Print prelude to stack frame */
131 if (!wrote_error) {
132 JanetFiberStatus status = janet_fiber_status(fiber);
133 janet_eprintf("%s%s: %s\n",
134 prefix,
135 janet_status_names[status],
136 errstr);
137 wrote_error = 1;
138 }
139
140 janet_eprintf(" in");
141
142 if (frame->func) {
143 def = frame->func->def;
144 janet_eprintf(" %s", def->name ? (const char *)def->name : "<anonymous>");
145 if (def->source) {
146 janet_eprintf(" [%s]", (const char *)def->source);
147 }
148 } else {
149 JanetCFunction cfun = (JanetCFunction)(frame->pc);
150 if (cfun) {
151 reg = janet_registry_get(cfun);
152 if (NULL != reg && NULL != reg->name) {
153 if (reg->name_prefix) {
154 janet_eprintf(" %s/%s", reg->name_prefix, reg->name);
155 } else {
156 janet_eprintf(" %s", reg->name);
157 }
158 if (NULL != reg->source_file) {
159 janet_eprintf(" [%s]", reg->source_file);
160 }
161 } else {
162 janet_eprintf(" <cfunction>");
163 }
164 }
165 }
166 if (frame->flags & JANET_STACKFRAME_TAILCALL)
167 janet_eprintf(" (tailcall)");
168 if (frame->func && frame->pc) {
169 int32_t off = (int32_t)(frame->pc - def->bytecode);
170 if (def->sourcemap) {
171 JanetSourceMapping mapping = def->sourcemap[off];
172 janet_eprintf(" on line %d, column %d", mapping.line, mapping.column);
173 } else {
174 janet_eprintf(" pc=%d", off);
175 }
176 } else if (NULL != reg) {
177 /* C Function */
178 if (reg->source_line > 0) {
179 janet_eprintf(" on line %d", (long) reg->source_line);
180 }
181 }
182 janet_eprintf("\n");
183 }
184 }
185
186 if (print_color) janet_eprintf("\x1b[0m");
187
188 janet_v_free(fibers);
189 }
190
191 /*
192 * CFuns
193 */
194
195 /* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
196 * Takes a source file name and byte offset. */
helper_find(int32_t argc,Janet * argv,JanetFuncDef ** def,int32_t * bytecode_offset)197 static void helper_find(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
198 janet_fixarity(argc, 3);
199 const uint8_t *source = janet_getstring(argv, 0);
200 int32_t line = janet_getinteger(argv, 1);
201 int32_t col = janet_getinteger(argv, 2);
202 janet_debug_find(def, bytecode_offset, source, line, col);
203 }
204
205 /* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
206 * Takes a function and byte offset*/
helper_find_fun(int32_t argc,Janet * argv,JanetFuncDef ** def,int32_t * bytecode_offset)207 static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
208 janet_arity(argc, 1, 2);
209 JanetFunction *func = janet_getfunction(argv, 0);
210 int32_t offset = (argc == 2) ? janet_getinteger(argv, 1) : 0;
211 *def = func->def;
212 *bytecode_offset = offset;
213 }
214
215 JANET_CORE_FN(cfun_debug_break,
216 "(debug/break source line col)",
217 "Sets a breakpoint in `source` at a given line and column. "
218 "Will throw an error if the breakpoint location "
219 "cannot be found. For example\n\n"
220 "\t(debug/break \"core.janet\" 10 4)\n\n"
221 "will set a breakpoint at line 10, 4th column of the file core.janet.") {
222 JanetFuncDef *def;
223 int32_t offset;
224 helper_find(argc, argv, &def, &offset);
225 janet_debug_break(def, offset);
226 return janet_wrap_nil();
227 }
228
229 JANET_CORE_FN(cfun_debug_unbreak,
230 "(debug/unbreak source line column)",
231 "Remove a breakpoint with a source key at a given line and column. "
232 "Will throw an error if the breakpoint "
233 "cannot be found.") {
234 JanetFuncDef *def;
235 int32_t offset = 0;
236 helper_find(argc, argv, &def, &offset);
237 janet_debug_unbreak(def, offset);
238 return janet_wrap_nil();
239 }
240
241 JANET_CORE_FN(cfun_debug_fbreak,
242 "(debug/fbreak fun &opt pc)",
243 "Set a breakpoint in a given function. pc is an optional offset, which "
244 "is in bytecode instructions. fun is a function value. Will throw an error "
245 "if the offset is too large or negative.") {
246 JanetFuncDef *def;
247 int32_t offset = 0;
248 helper_find_fun(argc, argv, &def, &offset);
249 janet_debug_break(def, offset);
250 return janet_wrap_nil();
251 }
252
253 JANET_CORE_FN(cfun_debug_unfbreak,
254 "(debug/unfbreak fun &opt pc)",
255 "Unset a breakpoint set with debug/fbreak.") {
256 JanetFuncDef *def;
257 int32_t offset;
258 helper_find_fun(argc, argv, &def, &offset);
259 janet_debug_unbreak(def, offset);
260 return janet_wrap_nil();
261 }
262
263 JANET_CORE_FN(cfun_debug_lineage,
264 "(debug/lineage fib)",
265 "Returns an array of all child fibers from a root fiber. This function "
266 "is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
267 "the fiber handling the error can see which fiber raised the signal. This function should "
268 "be used mostly for debugging purposes.") {
269 janet_fixarity(argc, 1);
270 JanetFiber *fiber = janet_getfiber(argv, 0);
271 JanetArray *array = janet_array(0);
272 while (fiber) {
273 janet_array_push(array, janet_wrap_fiber(fiber));
274 fiber = fiber->child;
275 }
276 return janet_wrap_array(array);
277 }
278
279 /* Extract info from one stack frame */
doframe(JanetStackFrame * frame)280 static Janet doframe(JanetStackFrame *frame) {
281 int32_t off;
282 JanetTable *t = janet_table(3);
283 JanetFuncDef *def = NULL;
284 if (frame->func) {
285 janet_table_put(t, janet_ckeywordv("function"), janet_wrap_function(frame->func));
286 def = frame->func->def;
287 if (def->name) {
288 janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(def->name));
289 }
290 } else {
291 JanetCFunction cfun = (JanetCFunction)(frame->pc);
292 if (cfun) {
293 JanetCFunRegistry *reg = janet_registry_get(cfun);
294 if (NULL != reg->name) {
295 if (NULL != reg->name_prefix) {
296 janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(janet_formatc("%s/%s", reg->name_prefix, reg->name)));
297 } else {
298 janet_table_put(t, janet_ckeywordv("name"), janet_cstringv(reg->name));
299 }
300 if (NULL != reg->source_file) {
301 janet_table_put(t, janet_ckeywordv("source"), janet_cstringv(reg->source_file));
302 }
303 if (reg->source_line > 0) {
304 janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(reg->source_line));
305 janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(1));
306 }
307 }
308 }
309 janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
310 }
311 if (frame->flags & JANET_STACKFRAME_TAILCALL) {
312 janet_table_put(t, janet_ckeywordv("tail"), janet_wrap_true());
313 }
314 if (frame->func && frame->pc) {
315 Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
316 JanetArray *slots;
317 off = (int32_t)(frame->pc - def->bytecode);
318 janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
319 if (def->sourcemap) {
320 JanetSourceMapping mapping = def->sourcemap[off];
321 janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(mapping.line));
322 janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(mapping.column));
323 }
324 if (def->source) {
325 janet_table_put(t, janet_ckeywordv("source"), janet_wrap_string(def->source));
326 }
327 /* Add stack arguments */
328 slots = janet_array(def->slotcount);
329 safe_memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
330 slots->count = def->slotcount;
331 janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
332 }
333 return janet_wrap_table(t);
334 }
335
336 JANET_CORE_FN(cfun_debug_stack,
337 "(debug/stack fib)",
338 "Gets information about the stack as an array of tables. Each table "
339 "in the array contains information about a stack frame. The top-most, current "
340 "stack frame is the first table in the array, and the bottom-most stack frame "
341 "is the last value. Each stack frame contains some of the following attributes:\n\n"
342 "* :c - true if the stack frame is a c function invocation\n\n"
343 "* :column - the current source column of the stack frame\n\n"
344 "* :function - the function that the stack frame represents\n\n"
345 "* :line - the current source line of the stack frame\n\n"
346 "* :name - the human-friendly name of the function\n\n"
347 "* :pc - integer indicating the location of the program counter\n\n"
348 "* :source - string with the file path or other identifier for the source code\n\n"
349 "* :slots - array of all values in each slot\n\n"
350 "* :tail - boolean indicating a tail call") {
351 janet_fixarity(argc, 1);
352 JanetFiber *fiber = janet_getfiber(argv, 0);
353 JanetArray *array = janet_array(0);
354 {
355 int32_t i = fiber->frame;
356 JanetStackFrame *frame;
357 while (i > 0) {
358 frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
359 janet_array_push(array, doframe(frame));
360 i = frame->prevframe;
361 }
362 }
363 return janet_wrap_array(array);
364 }
365
366 JANET_CORE_FN(cfun_debug_stacktrace,
367 "(debug/stacktrace fiber &opt err prefix)",
368 "Prints a nice looking stacktrace for a fiber. Can optionally provide "
369 "an error value to print the stack trace with. If `err` is nil or not "
370 "provided, and no prefix is given, will skip the error line. Returns the fiber.") {
371 janet_arity(argc, 1, 3);
372 JanetFiber *fiber = janet_getfiber(argv, 0);
373 Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
374 const char *prefix = janet_optcstring(argv, argc, 2, NULL);
375 janet_stacktrace_ext(fiber, x, prefix);
376 return argv[0];
377 }
378
379 JANET_CORE_FN(cfun_debug_argstack,
380 "(debug/arg-stack fiber)",
381 "Gets all values currently on the fiber's argument stack. Normally, "
382 "this should be empty unless the fiber signals while pushing arguments "
383 "to make a function call. Returns a new array.") {
384 janet_fixarity(argc, 1);
385 JanetFiber *fiber = janet_getfiber(argv, 0);
386 JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
387 memcpy(array->data, fiber->data + fiber->stackstart, array->capacity * sizeof(Janet));
388 array->count = array->capacity;
389 return janet_wrap_array(array);
390 }
391
392 JANET_CORE_FN(cfun_debug_step,
393 "(debug/step fiber &opt x)",
394 "Run a fiber for one virtual instruction of the Janet machine. Can optionally "
395 "pass in a value that will be passed as the resuming value. Returns the signal value, "
396 "which will usually be nil, as breakpoints raise nil signals.") {
397 janet_arity(argc, 1, 2);
398 JanetFiber *fiber = janet_getfiber(argv, 0);
399 Janet out = janet_wrap_nil();
400 janet_step(fiber, argc == 1 ? janet_wrap_nil() : argv[1], &out);
401 return out;
402 }
403
404 /* Module entry point */
janet_lib_debug(JanetTable * env)405 void janet_lib_debug(JanetTable *env) {
406 JanetRegExt debug_cfuns[] = {
407 JANET_CORE_REG("debug/break", cfun_debug_break),
408 JANET_CORE_REG("debug/unbreak", cfun_debug_unbreak),
409 JANET_CORE_REG("debug/fbreak", cfun_debug_fbreak),
410 JANET_CORE_REG("debug/unfbreak", cfun_debug_unfbreak),
411 JANET_CORE_REG("debug/arg-stack", cfun_debug_argstack),
412 JANET_CORE_REG("debug/stack", cfun_debug_stack),
413 JANET_CORE_REG("debug/stacktrace", cfun_debug_stacktrace),
414 JANET_CORE_REG("debug/lineage", cfun_debug_lineage),
415 JANET_CORE_REG("debug/step", cfun_debug_step),
416 JANET_REG_END
417 };
418 janet_core_cfuns_ext(env, NULL, debug_cfuns);
419 }
420