/* Copyright (C) 2019 Nunuhara Cabbage * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, see . */ #define VM_PRIVATE #include #include #include #include "system4/ain.h" #include "system4/file.h" #include "system4/instructions.h" #include "system4/string.h" #include "system4/utfsjis.h" #include "vm.h" #include "vm/heap.h" #include "vm/page.h" #include "debugger.h" #include "little_endian.h" struct variable { enum ain_data_type data_type; int struct_type; char *name; int varno; union vm_value *value; }; static void free_variable(struct variable *v) { free(v->name); free(v); } static char *to_utf(const char *sjis) { return sjis2utf(sjis, strlen(sjis)); } static const char *vm_value_string(union vm_value *v) { return to_utf(heap[v->i].s->text); } static struct page *get_page(int pageno) { if (!page_index_valid(pageno)) return NULL; return heap_get_page(pageno); } static struct variable *get_global_by_name(const char *name) { for (int i = 0; i < ain->nr_globals; i++) { if (!strcmp(ain->globals[i].name, name)) { struct variable *v = malloc(sizeof(struct variable)); v->data_type = ain->globals[i].type.data; v->struct_type = ain->globals[i].type.struc; v->name = to_utf(ain->globals[i].name); v->varno = i; v->value = &heap[0].page->values[i]; return v; } } return NULL; } static struct variable *get_local_by_name(const char *name) { struct page *page = local_page(); struct ain_function *f = &ain->functions[page->index]; for (int i = 0; i < f->nr_vars; i++) { if (!strcmp(f->vars[i].name, name)) { struct variable *v = malloc(sizeof(struct variable)); v->data_type = f->vars[i].type.data; v->struct_type = f->vars[i].type.struc; v->name = to_utf(ain->globals[i].name); v->varno = i; v->value = &page->values[i]; return v; } } return NULL; } static const char *variable_name(struct page *page, int varno) { switch (page->type) { case GLOBAL_PAGE: return ain->globals[varno].name; case LOCAL_PAGE: return ain->functions[page->index].vars[varno].name; case STRUCT_PAGE: return ain->structures[page->index].members[varno].name; case ARRAY_PAGE: return "array member"; case DELEGATE_PAGE: return "delegate member"; } return "unknown"; } static struct variable *page_ref(struct page *page, int i) { if (i < 0 || i >= page->nr_vars) return NULL; struct variable *v = malloc(sizeof(struct variable)); v->data_type = variable_type(page, i, &v->struct_type, NULL); v->name = to_utf(variable_name(page, i)); v->varno = i; v->value = &page->values[i]; return v; } static sexp dbg_ctx; static void set_parameter(const char *param, sexp value) { sexp_eval(dbg_ctx, sexp_list2(dbg_ctx, sexp_intern(dbg_ctx, param, -1), value), NULL); } static void dbg_scm_breakpoint_handler(struct breakpoint *bp) { set_parameter("breakpoint-count", sexp_make_integer(dbg_ctx, bp->count++)); // TODO: breakpoint-function parameter with function name, argument count, etc. if ((sexp)bp->data == SEXP_FALSE) { NOTICE("%s", bp->message); dbg_scm_repl(); } else { sexp_apply(dbg_ctx, (sexp)bp->data, SEXP_NULL); } } static void set_function_breakpoint(const char *name, sexp handler) { if (handler == SEXP_FALSE) { dbg_set_function_breakpoint(name, NULL, NULL); return; } if (!sexp_procedurep(handler)) { DBG_ERROR("Breakpoint handler must be a procedure or #f"); return; } if (dbg_set_function_breakpoint(name, dbg_scm_breakpoint_handler, handler)) { sexp_preserve_object(dbg_ctx, handler); } } static void set_address_breakpoint(uint32_t address, sexp handler) { if (handler == SEXP_FALSE) { dbg_set_address_breakpoint(address, NULL, NULL); return; } if (!sexp_procedurep(handler)) { DBG_ERROR("Breakpoint handler must be a procedure or #f"); return; } if (dbg_set_address_breakpoint(address, dbg_scm_breakpoint_handler, handler)) { sexp_preserve_object(dbg_ctx, handler); } } static struct page *frame_page(int i) { if (i < 0 || i >= call_stack_ptr) return NULL; return get_page(call_stack[call_stack_ptr - (i+1)].page_slot); } // XXX: chibi-ffi doesn't support anonymous structs #define _page_struct_type array.struct_type #define _page_rank array.rank // autogenerated with `chibi-ffi src/debug-ffi.stub` #include "debug-ffi.c" void dbg_scm_init(void) { if (!dbg_enabled) return; dbg_ctx = sexp_make_eval_context(NULL, NULL, NULL, 0, 0); sexp_load_standard_env(dbg_ctx, NULL, SEXP_SEVEN); sexp_load_standard_ports(dbg_ctx, NULL, stdin, stdout, stderr, 1); sexp_init_library(dbg_ctx, NULL, 0, sexp_context_env(dbg_ctx), sexp_version, SEXP_ABI_IDENTIFIER); sexp_eval_string(dbg_ctx, "(import (scheme base))", -1, NULL); sexp_eval_string(dbg_ctx, "(import (chibi repl))", -1, NULL); sexp_eval_string(dbg_ctx, "(define *prompt* (make-parameter \"dbg(scm)> \"))", -1, NULL); sexp_eval_string(dbg_ctx, "(define breakpoint-count (make-parameter 0))", -1, NULL); sexp_eval_string(dbg_ctx, "(define (repl-make-prompt m) (*prompt*))", -1, NULL); if (file_exists("./debugger.scm")) sexp_eval_string(dbg_ctx, "(load \"./debugger.scm\")", -1, NULL); else sexp_eval_string(dbg_ctx, "(load \"" XSYS4_DATA_DIR "/debugger.scm\")", -1, NULL); } void dbg_scm_fini(void) { if (!dbg_enabled) return; sexp_destroy_context(dbg_ctx); } void dbg_scm_repl(void) { if (!dbg_enabled) return; NOTICE("Entering the Scheme debugger REPL. Type '\\exit' to exit."); sexp_eval_string(dbg_ctx, "(repl 'escape: #\\\\ 'make-prompt: repl-make-prompt)", -1, NULL); }