123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848 |
- /* $Header$ */
- #include <stdio.h>
- #include <varargs.h>
- #include <assert.h>
- #include <alloc.h>
- #include <out.h>
- #include "operator.h"
- #include "position.h"
- #include "file.h"
- #include "idf.h"
- #include "tree.h"
- #include "message.h"
- #include "scope.h"
- #include "symbol.h"
- #include "langdep.h"
- #include "type.h"
- #include "expr.h"
- extern FILE *db_out;
- t_lineno currline;
- static t_lineno listline;
- extern long pointer_size;
- extern char *strrindex();
- extern int interrupted;
- extern int stop_reason;
- p_tree print_command;
- static int wsize = 10;
- /*VARARGS1*/
- p_tree
- mknode(va_alist)
- va_dcl
- {
- va_list ap;
- register p_tree p = new_tree();
- va_start(ap);
- {
- register int i, na;
- p->t_oper = va_arg(ap, int);
- switch(p->t_oper) {
- case OP_NAME:
- case OP_HELP:
- p->t_idf = va_arg(ap, struct idf *);
- p->t_str = va_arg(ap, char *);
- break;
- case OP_STRING:
- p->t_sval = va_arg(ap, char *);
- break;
- case OP_REAL:
- p->t_fval = va_arg(ap, double);
- break;
- case OP_AT:
- p->t_lino = va_arg(ap, long);
- p->t_filename = va_arg(ap, char *);
- break;
- case OP_INTEGER:
- p->t_ival = va_arg(ap, long);
- break;
- default:
- na = nargs(p->t_oper);
- assert(na <= MAXARGS);
- for (i = 0; i < na; i++) {
- p->t_args[i] = va_arg(ap, p_tree);
- }
- break;
- }
- }
- va_end(ap);
- return p;
- }
- freenode(p)
- register p_tree p;
- {
- register int na, i;
- if (! p) return;
- na = nargs(p->t_oper);
- assert(na <= MAXARGS);
- for (i = 0; i < na; i++) {
- freenode(p->t_args[i]);
- }
- free_tree(p);
- }
- static t_addr
- get_addr_from_node(p)
- p_tree p;
- {
- t_addr a = ILL_ADDR;
- register p_symbol sym;
- if (! p) return NO_ADDR;
- if (p->t_address != 0) return p->t_address;
- switch(p->t_oper) {
- case OP_AT:
- if (! p->t_filename &&
- (! listfile || ! (p->t_filename = listfile->sy_idf->id_text))) {
- error("no current file");
- break;
- }
- a = get_addr_from_position(&(p->t_pos));
- if (a == ILL_ADDR) {
- error("could not determine address of \"%s\":%d",
- p->t_filename, p->t_lino);
- break;
- }
- p->t_address = a;
- break;
-
- case OP_IN:
- a = get_addr_from_node(p->t_args[0]);
- if (p->t_args[1]) {
- p_scope sc;
- a = get_addr_from_node(p->t_args[1]);
- sc = base_scope(get_scope_from_addr(a));
- sym = identify(p->t_args[0], FUNCTION|PROC|MODULE);
- if (! sym->sy_name.nm_scope ||
- ! sym->sy_name.nm_scope->sc_bp_opp) {
- error("could not determine address of \"%s\"", p->t_str);
- a = ILL_ADDR;
- break;
- }
- if (sc->sc_definedby != sym) {
- error("inconsistent address");
- a = ILL_ADDR;
- break;
- }
- }
- p->t_address = a;
- break;
- case OP_NAME:
- case OP_SELECT:
- sym = identify(p, FUNCTION|PROC|MODULE);
- if (! sym) {
- break;
- }
- if (! sym->sy_name.nm_scope || ! sym->sy_name.nm_scope->sc_bp_opp) {
- error("could not determine address of \"%s\"", p->t_str);
- break;
- }
- a = sym->sy_name.nm_scope->sc_bp_opp;
- break;
- default:
- assert(0);
- }
- return a;
- }
- print_node(p, top_level)
- register p_tree p;
- {
- if (!p) return;
- switch(p->t_oper) {
- case OP_LIST:
- fputs("list ", db_out);
- if (p->t_args[0]) {
- print_node(p->t_args[0], 0);
- if (p->t_args[1]) {
- if (p->t_args[1]->t_ival >= 0) {
- fputs(", ", db_out);
- print_node(p->t_args[1], 0);
- }
- else {
- if (p->t_args[1]->t_ival < -100000000) {
- fputs("-", db_out);
- }
- else print_node(p->t_args[1], 0);
- }
- }
- }
- break;
- case OP_PRINT:
- fputs("print ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_ENABLE:
- fputs("enable ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_DISABLE:
- fputs("disable ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_DISPLAY:
- fputs("display ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_LINK:
- print_node(p->t_args[0], 0);
- fputs(", ", db_out);
- print_node(p->t_args[1], 0);
- break;
- case OP_FILE:
- fputs("file ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_SET:
- fputs("set ", db_out);
- print_node(p->t_args[0], 0);
- fputs(" to ", db_out);
- print_node(p->t_args[1], 0);
- break;
- case OP_FIND:
- fputs("find ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_WHICH:
- fputs("which ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_DELETE:
- fputs("delete ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_REGS:
- fputs("regs ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_NEXT:
- fputs("next ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_STEP:
- fputs("step ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_STATUS:
- fputs("status", db_out);
- break;
- case OP_DUMP:
- fputs("dump ", db_out);
- print_position(p->t_address, 1);
- break;
- case OP_RESTORE:
- fputs("restore ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_WHERE:
- fputs("where ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_HELP:
- fputs("help ", db_out);
- print_node(p->t_args[0], 0);
- break;
- case OP_CONT:
- fputs("cont", db_out);
- if (p->t_args[0]) {
- fprintf(db_out, " %ld", p->t_args[0]->t_ival);
- }
- if (p->t_args[1]) {
- fputs(" ", db_out);
- print_node(p->t_args[1], 0);
- }
- break;
- case OP_WHEN:
- fputs("when ", db_out);
- if (p->t_address != NO_ADDR) {
- print_position(p->t_address, 1);
- }
- else print_node(p->t_args[0], 0);
- if (p->t_args[1]) {
- fputs(" if ", db_out);
- print_node(p->t_args[1], 0);
- }
- p = p->t_args[2];
- fputs(" { ", db_out);
- while (p && p->t_oper == OP_LINK) {
- print_node(p->t_args[0], 0);
- fputs("; ", db_out);
- p = p->t_args[1];
- }
- print_node(p, 0);
- fputs(" }", db_out);
- break;
- case OP_STOP:
- fputs("stop ", db_out);
- if (p->t_address != NO_ADDR) {
- print_position(p->t_address, 1);
- }
- else print_node(p->t_args[0], 0);
- if (p->t_args[1]) {
- fputs(" if ", db_out);
- print_node(p->t_args[1], 0);
- }
- break;
- case OP_TRACE:
- fputs("trace ", db_out);
- if (p->t_args[2]) {
- fputs("on ", db_out);
- print_node(p->t_args[2], 0);
- fputs(" ", db_out);
- }
- if (p->t_address != NO_ADDR) {
- print_position(p->t_address, 1);
- }
- else print_node(p->t_args[0], 0);
- if (p->t_args[1]) {
- fputs(" if ", db_out);
- print_node(p->t_args[1], 0);
- }
- break;
- case OP_AT:
- fprintf(db_out, "at \"%s\":%ld", p->t_filename, p->t_lino);
- break;
- case OP_IN:
- fputs("in ", db_out);
- print_node(p->t_args[0], 0);
- fputs(" ", db_out);
- print_node(p->t_args[1], 0);
- break;
- case OP_SELECT:
- print_node(p->t_args[0], 0);
- fputs("`", db_out);
- print_node(p->t_args[1], 0);
- break;
- case OP_NAME:
- fputs(p->t_str, db_out);
- break;
- case OP_INTEGER:
- fprintf(db_out, currlang->decint_fmt, p->t_ival);
- break;
- case OP_STRING:
- (*currlang->printstring)(p->t_sval, strlen(p->t_sval));
- break;
- case OP_REAL:
- fprintf(db_out, currlang->real_fmt, p->t_fval);
- break;
- case OP_FORMAT:
- print_node(p->t_args[0], 0);
- fputs("\\", db_out);
- print_node(p->t_args[1], 0);
- break;
- case OP_UNOP:
- case OP_BINOP:
- (*currlang->printop)(p);
- break;
- default:
- assert(0);
- }
- if (top_level) fputs("\n", db_out);
- }
- int
- repeatable(com)
- p_tree com;
- {
- switch(com->t_oper) {
- case OP_CONT:
- com->t_args[0]->t_ival = 1;
- freenode(com->t_args[1]);
- com->t_args[1] = 0;
- return 1;
- case OP_NEXT:
- case OP_STEP:
- freenode(com->t_args[0]);
- com->t_args[0] = 0;
- return 1;
- case OP_LIST:
- freenode(com->t_args[0]);
- com->t_args[0] = 0;
- freenode(com->t_args[1]);
- com->t_args[1] = 0;
- return 1;
- }
- return 0;
- }
- int
- in_status(com)
- p_tree com;
- {
- switch(com->t_oper) {
- case OP_STOP:
- case OP_WHEN:
- case OP_TRACE:
- case OP_DUMP:
- case OP_DISPLAY:
- return 1;
- }
- return 0;
- }
- eval(p)
- p_tree p;
- {
- if (p && operators[p->t_oper].op_fun) (*operators[p->t_oper].op_fun)(p);
- }
- do_list(p)
- p_tree p;
- {
- int l1, l2;
- if (p->t_args[1]) {
- l2 = p->t_args[1]->t_ival;
- if (l2 >= 0) {
- if (l2 == 0) l2 = 1;
- wsize = l2;
- }
- }
- else l2 = wsize;
- if (! p->t_args[0]) {
- l1 = listline;
- if (! l1) {
- listline = currline - (wsize/2);
- l1 = listline;
- }
- }
- else {
- if (p->t_args[0]->t_oper == OP_INTEGER) {
- l1 = p->t_args[0]->t_ival;
- }
- else {
- t_addr a = get_addr_from_node(p->t_args[0]);
- p_position pos;
- if (a == ILL_ADDR) {
- return;
- }
- pos = get_position_from_addr(a);
- newfile(str2idf(pos->filename, 1));
- l1 = pos->lineno - (l2 > 0 ? l2 : wsize)/2;
- if (l1 < 1) l1 = 1;
- }
- }
- if (listfile) {
- if (l2 < 0) {
- l2 = -l2;
- if (l1 > l2) l2 = 1;
- else l2 -= l1 - 1;
- }
- lines(listfile->sy_file, l1, l2);
- listline = l1 + l2;
- }
- else error("no current file");
- }
- do_file(p)
- p_tree p;
- {
- FILE *f;
- if (p->t_args[0]) {
- if ((f = fopen(p->t_args[0]->t_str, "r")) == NULL) {
- error("could not open %s", p->t_args[0]->t_str);
- return;
- }
- fclose(f);
- newfile(p->t_args[0]->t_idf);
- }
- else if (listfile) fprintf(db_out, "%s\n", listfile->sy_idf->id_text);
- else error("no current file");
- }
- newfile(id)
- register struct idf *id;
- {
- register p_symbol sym = Lookup(id, PervasiveScope, FILESYM);
- if (listfile != sym) listline = 1;
- listfile = sym;
- if (! listfile) {
- listline = 1;
- listfile = add_file(id->id_text);
- listfile->sy_file->f_scope = FileScope;
- }
- find_language(strrindex(id->id_text, '.'));
- }
- setstop(p, kind)
- p_tree p;
- int kind;
- {
- t_addr a = get_addr_from_node(p->t_args[0]);
- if (a == ILL_ADDR) return 0;
- p->t_address = a;
- if (a != NO_ADDR) {
- if (! set_or_clear_breakpoint(a, kind)) {
- return 0;
- }
- }
- return 1;
- }
- do_stop(p)
- p_tree p;
- {
- if (! setstop(p, SETBP)) {
- return;
- }
- add_to_item_list(p);
- }
- settrace(p, kind)
- p_tree p;
- int kind;
- {
- t_addr a, e;
- a = get_addr_from_node(p->t_args[0]);
- if (a == NO_ADDR) return 1;
- if (a == ILL_ADDR) return 0;
- if (p->t_args[0]->t_oper == OP_AT) {
- e = a;
- p->t_address = a;
- }
- else {
- p_scope sc = get_next_scope_from_addr(a+1);
- if (sc) e = sc->sc_start - 1;
- else e = 0xffffffff;
- }
- return set_or_clear_trace(a, e, kind);
- }
- do_trace(p)
- p_tree p;
- {
- p->t_address = NO_ADDR;
- if (! settrace(p, SETTRACE)) {
- return;
- }
- add_to_item_list(p);
- }
- static
- able(p, kind)
- p_tree p;
- int kind;
- {
- if (!p) {
- if (stop_reason) {
- able_item(stop_reason, kind);
- }
- else {
- error("no current stopping point");
- }
- return;
- }
- switch(p->t_oper) {
- case OP_LINK:
- able(p->t_args[0], kind);
- able(p->t_args[1], kind);
- break;
- case OP_INTEGER:
- able_item((int)p->t_ival, kind);
- break;
- default:
- assert(0);
- }
- }
- do_enable(p)
- p_tree p;
- {
- able(p->t_args[0], 0);
- }
- do_disable(p)
- p_tree p;
- {
- able(p->t_args[0], 1);
- }
- do_continue(p)
- p_tree p;
- {
- int count;
- if (p) {
- count = p->t_args[0]->t_ival;
- if (p->t_args[1]) {
- t_addr a = get_addr_from_position(&(p->t_args[1]->t_pos));
- p_scope sc = get_scope_from_addr(a);
- if (a == ILL_ADDR || base_scope(sc) != base_scope(CurrentScope)) {
- error("cannot continue at line %d",
- p->t_args[1]->t_lino);
- return;
- }
- if (! set_pc(a)) {
- return;
- }
- }
- }
- else count = 1;
- while (count--) {
- if (! send_cont(count==0)) {
- break;
- }
- }
- if (count > 0) {
- fprintf(db_out, "Only %d breakpoints skipped\n",
- p->t_args[0]->t_ival - count);
- }
- }
- do_step(p)
- p_tree p;
- {
- p = p->t_args[0];
- if (! do_single_step(SETSS, p ? p->t_ival : 1L)) {
- }
- }
- do_next(p)
- p_tree p;
- {
- p = p->t_args[0];
- if (! do_single_step(SETSSF, p? p->t_ival : 1L)) {
- }
- }
- extern t_addr *get_EM_regs();
- do_regs(p)
- p_tree p;
- {
- t_addr *buf;
- int n = 0;
- p = p->t_args[0];
- if (p) n = p->t_ival;
- if (! (buf = get_EM_regs(n))) {
- return;
- }
- fprintf(db_out, "EM registers %d levels back:\n", n);
- fprintf(db_out, "\tLocalBase =\t0x%lx\n\tArgumentBase =\t0x%lx\n",
- (long) buf[LB_OFF], (long) buf[AB_OFF]);
- fprintf(db_out, "\tProgramCounter=\t0x%lx\n\tHeapPointer = \t0x%lx\n",
- (long) buf[PC_OFF],
- (long) buf[HP_OFF]);
- fprintf(db_out, "\tStackPointer =\t0x%lx\n", (long) buf[SP_OFF]);
- }
- /*ARGSUSED*/
- do_where(p)
- p_tree p;
- {
- int i = 0;
- unsigned int cnt;
- unsigned int maxcnt = 0xffff;
- p_scope sc;
- t_addr *buf;
- t_addr PC;
- p = p->t_args[0];
- if (p && p->t_ival < 0) {
- for (;;) {
- buf = get_EM_regs(i++);
- if (! buf || ! buf[AB_OFF]) break;
- PC = buf[PC_OFF];
- sc = base_scope(get_scope_from_addr(PC));
- if (! sc || sc->sc_start > PC) break;
- if (interrupted) return;
- }
- i--;
- maxcnt = - p->t_ival;
- i -= maxcnt;
- if (i < 0) i = 0;
- }
- else if (p) maxcnt = p->t_ival;
- for (cnt = maxcnt; cnt != 0; cnt--) {
- t_addr AB;
- if (interrupted) return;
- if (! (buf = get_EM_regs(i++))) break;
- AB = buf[AB_OFF];
- PC = buf[PC_OFF];
- if (! AB) break;
- sc = base_scope(get_scope_from_addr(PC));
- if (! sc || sc->sc_start > PC) break;
- fprintf(db_out, "%s(", sc->sc_definedby->sy_idf->id_text);
- print_params(sc->sc_definedby->sy_type, AB, has_static_link(sc));
- fputs(") ", db_out);
- print_position(PC, 0);
- fputs("\n", db_out);
- }
- }
- extern p_tree remove_from_item_list();
- do_delete(p)
- p_tree p;
- {
- switch(p->t_oper) {
- case OP_DELETE:
- if (! p->t_args[0]) {
- if (stop_reason) {
- remove_from_item_list(stop_reason);
- stop_reason = 0;
- }
- else {
- error("no current stopping point");
- }
- }
- else do_delete(p->t_args[0]);
- break;
- case OP_LINK:
- do_delete(p->t_args[0]);
- do_delete(p->t_args[1]);
- break;
- case OP_INTEGER:
- p = remove_from_item_list((int) p->t_ival);
- if (p) switch(p->t_oper) {
- case OP_WHEN:
- case OP_STOP:
- setstop(p, CLRBP);
- break;
- case OP_TRACE:
- settrace(p, CLRTRACE);
- break;
- case OP_DUMP:
- free_dump(p);
- }
- freenode(p);
- break;
- default:
- assert(0);
- }
- }
- do_print(p)
- p_tree p;
- {
- char *buf = 0;
- char *format = 0;
- long size;
- p_type tp;
- switch(p->t_oper) {
- case OP_PRINT:
- if (p->t_args[0] == 0) {
- p = print_command;
- if (p == 0) {
- error("no previous print command");
- break;
- }
- }
- else if (p != print_command) {
- /* freenode(print_command); No, could be in when-list */
- print_command = p;
- }
- /* fall through */
- case OP_DISPLAY:
- do_print(p->t_args[0]);
- break;
- case OP_LINK:
- do_print(p->t_args[0]);
- do_print(p->t_args[1]);
- break;
- default:
- if (interrupted || ! eval_expr(p, &buf, &size, &tp)) return;
- print_node(p, 0);
- fputs(" = ", db_out);
- if (p->t_oper == OP_FORMAT) {
- format = p->t_args[1]->t_str;
- }
- print_val(tp, size, buf, 0, 0, format);
- if (buf) free(buf);
- fputs("\n", db_out);
- break;
- }
- }
- do_set(p)
- p_tree p;
- {
- char *buf = 0;
- long size, size2;
- p_type tp, tp2;
- t_addr a;
- if (interrupted || ! eval_desig(p->t_args[0], &a, &size, &tp) ||
- ! eval_expr(p->t_args[1], &buf, &size2, &tp2) ||
- ! convert(&buf, &size2, &tp2, tp, size)) {
- if (buf) free(buf);
- return;
- }
- if (interrupted) {
- free(buf);
- return;
- }
- set_bytes(size, buf, a);
- free(buf);
- }
- perform(p, a)
- register p_tree p;
- t_addr a;
- {
- switch(p->t_oper) {
- case OP_WHEN:
- if (p->t_args[1] && ! eval_cond(p->t_args[1])) break;
- p = p->t_args[2];
- while (p && p->t_oper == OP_LINK) {
- if (interrupted) return;
- if (p->t_args[0]) eval(p->t_args[0]);
- p = p->t_args[1];
- }
- if (interrupted) return;
- if (p) eval(p);
- break;
- case OP_TRACE:
- if (p->t_args[0] && p->t_args[0]->t_oper == OP_IN) {
- register p_scope sc = base_scope(CurrentScope);
-
- if (sc != get_scope_from_addr(p->t_args[0]->t_address)) {
- break;
- }
- }
- if (interrupted) return;
- if (p->t_args[1] && ! eval_cond(p->t_args[1])) break;
- list_position(get_position_from_addr(a));
- if (p->t_args[2]) do_print(p->t_args[2]);
- break;
- default:
- assert(0);
- }
- }
- list_position(pos)
- p_position pos;
- {
- newfile(str2idf(pos->filename, 1));
- currfile = listfile;
- currline = pos->lineno;
- lines(currfile->sy_file, (int)currline, (int)1);
- listline = 0;
- }
|