/* ScummVM - Graphic Adventure Engine * * ScummVM is the legal property of its developers, whose names * are too numerous to list here. Please refer to the COPYRIGHT * file distributed with this source distribution. * * 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, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * */ #include "glk/tads/tads2/debug.h" #include "glk/tads/tads2/list.h" #include "glk/tads/tads2/run.h" #include "glk/tads/tads2/vocabulary.h" #include "glk/tads/os_glk.h" namespace Glk { namespace TADS { namespace TADS2 { /* add a string to the history buffer */ void dbgaddhist(dbgcxdef *ctx, char *buf, int l) { char *p; int dell; if (ctx->dbgcxhstf + l + 1 >= ctx->dbgcxhstl) { /* delete first lines until we have enough space */ for (dell = 0, p = ctx->dbgcxhstp ; *p || dell < l ; ++p, ++dell) ; if (*p) ++p; memmove(ctx->dbgcxhstp, ctx->dbgcxhstp + dell, (size_t)(ctx->dbgcxhstf - dell)); ctx->dbgcxhstf -= dell; } memcpy(ctx->dbgcxhstp + ctx->dbgcxhstf, buf, (size_t)l); ctx->dbgcxhstf += l; } /* callback for dbgent - saves history line to a char buffer */ static void dbgent1(void *ctx0, const char *str, int strl) { char **ctx = (char **)ctx0; memcpy(*ctx, str, (size_t)strl); *ctx += strl; } void dbgent(dbgcxdef *ctx, runsdef *bp, objnum self, objnum target, prpnum prop, int binum, int argc) { dbgfdef *p; ++(ctx->dbgcxdep); /* increment actual depth */ if (ctx->dbgcxfcn == DBGMAXFRAME) { --(ctx->dbgcxfcn); /* back to top frame */ memmove(ctx->dbgcxfrm, ctx->dbgcxfrm + 1, (size_t)((DBGMAXFRAME - 1) * sizeof(dbgfdef))); } p = &ctx->dbgcxfrm[ctx->dbgcxfcn]; ++(ctx->dbgcxfcn); /* increment frame pointer */ p->dbgfbp = bp; p->dbgfself = self; p->dbgftarg = target; p->dbgfprop = prop; p->dbgfbif = binum; p->dbgfargc = argc; p->dbgffr = 0; /* no frame has yet been recorded */ p->dbgflin = 0; /* save call history */ if (ctx->dbgcxflg & DBGCXFTRC) { char buf[128]; char *tmp; int l; tmp = buf; dbgstktr(ctx, dbgent1, &tmp, -1, TRUE, FALSE); if ((l = (tmp - buf)) > 0 && buf[l-1] == '\n') --l; buf[l++] = '\0'; dbgaddhist(ctx, buf, l); } } void dbglv(dbgcxdef *ctx, int exittype) { --(ctx->dbgcxdep); /* decrement actual depth */ if (ctx->dbgcxfcn) --(ctx->dbgcxfcn); /* decrement frame pointer */ /* * if we're in STEP OUT/OVER mode, and the target context is level * 0, and we're now at level 0, it means that we are stepping out of * a routine called directly by the system and the debugger is * supposed to break when that happens -- return to single-stepping * mode so that we break into the debugger the next time the system * calls a method */ if ((ctx->dbgcxflg & DBGCXFSS) != 0 && (ctx->dbgcxflg & DBGCXFSO) != 0 && ctx->dbgcxsof == 0 && ctx->dbgcxdep == 0) { /* * stepping out/over at level 0 - go to normal single-step mode * (clear the out/over flag) */ ctx->dbgcxflg &= ~DBGCXFSO; } /* record exit in call history if appropriate */ if (ctx->dbgcxflg & DBGCXFTRC) { char buf[128]; char *p; switch(exittype) { case DBGEXVAL: if (ctx->dbgcxfcn > 1) { memset(buf, ' ', (size_t)(ctx->dbgcxfcn - 1)); dbgaddhist(ctx, buf, (int)ctx->dbgcxfcn - 1); } memcpy(buf, " => ", (size_t)4); p = buf + 4; dbgpval(ctx, ctx->dbgcxrun->runcxsp - 1, dbgent1, &p, TRUE); *p++ = '\0'; dbgaddhist(ctx, buf, (int)(p - buf)); break; case DBGEXPASS: memcpy(buf, " [pass]", (size_t)8); dbgaddhist(ctx, buf, 8); break; } } } /* get a symbol name; returns length of name */ int dbgnam(dbgcxdef *ctx, char *outbuf, int typ, int val) { toksdef sym; if (!ctx->dbgcxtab || !ctx->dbgcxtab->tokthhsh) { memcpy(outbuf, "", (size_t)17); return(17); } if (tokthfind((toktdef *)ctx->dbgcxtab, typ, val, &sym)) { memcpy(outbuf, sym.toksnam, (size_t)sym.tokslen); return(sym.tokslen); } else if (typ == TOKSTOBJ) { if ((mcmon)val == MCMONINV) { memcpy(outbuf, "", 16); return 16; } else { sprintf(outbuf, "", val); return strlen(outbuf); } } else { memcpy(outbuf, "", (size_t)9); return(9); } } /* send a buffer value (as from a list) to ui callback for display */ static void dbgpbval(dbgcxdef *ctx, dattyp typ, const uchar *val, void (*dispfn)(void *, const char *, int), void *dispctx) { char buf[TOKNAMMAX + 1]; const char *p = buf; uint len; switch(typ) { case DAT_NUMBER: sprintf(buf, "%ld", (long)osrp4s(val)); len = strlen(buf); break; case DAT_OBJECT: len = dbgnam(ctx, buf, TOKSTOBJ, osrp2(val)); break; case DAT_SSTRING: len = osrp2(val) - 2; p = (const char *)val + 2; break; case DAT_NIL: p = "nil"; len = 3; break; case DAT_LIST: (*dispfn)(dispctx, "[", 1); len = osrp2(val) - 2; p = (const char *)val + 2; while (len) { dbgpbval(ctx, (dattyp)*p, (const uchar *)(p + 1), dispfn, dispctx); lstadv((uchar **)&p, &len); if (len) (*dispfn)(dispctx, " ", 1); } (*dispfn)(dispctx, "]", 1); len = 0; break; case DAT_TRUE: p = "true"; len = 4; break; case DAT_FNADDR: (*dispfn)(dispctx, "&", 1); len = dbgnam(ctx, buf, TOKSTFUNC, osrp2(val)); break; case DAT_PROPNUM: (*dispfn)(dispctx, "&", 1); len = dbgnam(ctx, buf, TOKSTPROP, osrp2(val)); break; default: p = "[unknown type]"; len = 14; break; } if (typ == DAT_SSTRING) (*dispfn)(dispctx, "'", 1); if (len) (*dispfn)(dispctx, p, len); if (typ == DAT_SSTRING) (*dispfn)(dispctx, "'", 1); } /* send a value to ui callback for display */ void dbgpval(dbgcxdef *ctx, runsdef *val, void (*dispfn)(void *ctx, const char *str, int strl), void *dispctx, int showtype) { uchar buf[TOKNAMMAX + 1]; uint len; const uchar *p = buf; const char *typ = 0; switch(val->runstyp) { case DAT_NUMBER: sprintf((char *)buf, "%ld", val->runsv.runsvnum); len = strlen((char *)buf); typ = "number"; break; case DAT_OBJECT: len = dbgnam(ctx, (char *)buf, TOKSTOBJ, val->runsv.runsvobj); typ = "object"; break; case DAT_SSTRING: len = osrp2(val->runsv.runsvstr) - 2; p = val->runsv.runsvstr + 2; typ = "string"; break; case DAT_NIL: p = (const uchar *)"nil"; len = 3; break; case DAT_LIST: { if (showtype) (*dispfn)(dispctx, "list: ", 6); (*dispfn)(dispctx, "[", 1); len = osrp2(val->runsv.runsvstr) - 2; uchar *up = val->runsv.runsvstr + 2; while (len) { dbgpbval(ctx, (dattyp)*up, (const uchar *)(up + 1), dispfn, dispctx); lstadv(&up, &len); if (len) (*dispfn)(dispctx, " ", 1); } (*dispfn)(dispctx, "]", 1); len = 0; p = up; break; } case DAT_TRUE: p = (const uchar *)"true"; len = 4; break; case DAT_FNADDR: len = dbgnam(ctx, (char *)buf, TOKSTFUNC, val->runsv.runsvobj); typ = "function pointer"; break; case DAT_PROPNUM: len = dbgnam(ctx, (char *)buf, TOKSTPROP, val->runsv.runsvprp); typ = "property pointer"; break; default: p = (const uchar *)"[unknown type]"; len = 14; break; } /* show the type prefix if desired, or add a quote if it's a string */ if (typ && showtype) { /* show the type prefix */ (*dispfn)(dispctx, typ, (int)strlen(typ)); (*dispfn)(dispctx, ": ", 2); } else if (val->runstyp == DAT_SSTRING) { /* it's a string, and we're not showing a type - add a quote */ (*dispfn)(dispctx, "'", 1); } /* * if possible, null-terminate the buffer - do this only if the * length is actually within the buffer, which won't be the case if * the text comes from someplace outside the buffer (which is the * case if it's a string, for example) */ if (len < sizeof(buf)) buf[len] = '\0'; /* display a "&" prefix if it's an address of some kind */ if (val->runstyp == DAT_PROPNUM || val->runstyp == DAT_FNADDR) (*dispfn)(dispctx, "&", 1); /* display the text */ if (len != 0) (*dispfn)(dispctx, (const char *)p, len); /* add a closing quote if it's a string and we showed an open quote */ if (val->runstyp == DAT_SSTRING && !(typ && showtype)) (*dispfn)(dispctx, "'", 1); } void dbgstktr(dbgcxdef *ctx, void (*dispfn)(void *ctx, const char *str, int strl), void *dispctx, int level, int toponly, int include_markers) { dbgfdef *f; int i; int j; int k; char buf[128]; char *p; char c; for (i = ctx->dbgcxfcn, j = ctx->dbgcxdep, f = &ctx->dbgcxfrm[i-1] ; i ; --f, --j, --i) { p = buf; if (toponly) { int v = (i < 50 ? i : 50); if (v > 1) { memset(buf, ' ', (size_t)(v - 1)); dbgaddhist(ctx, buf, v-1); } } else if (include_markers) { c = (i == level + 1 ? '*' : ' '); sprintf(buf, "%3d%c ", j, c); p += 4; } if (f->dbgftarg == MCMONINV) p += dbgnam(ctx, p, TOKSTBIFN, f->dbgfbif); else p += dbgnam(ctx, p, (f->dbgfself == MCMONINV ? TOKSTFUNC : TOKSTOBJ), (int)f->dbgftarg); if (f->dbgfself != MCMONINV && f->dbgfself != f->dbgftarg) { memcpy(p, "dbgfself); *p++ = '>'; } if (f->dbgfprop) { *p++ = '.'; p += dbgnam(ctx, p, TOKSTPROP, (int)f->dbgfprop); } /* display what we have so far */ *p++ = '\0'; (*dispfn)(dispctx, buf, (int)strlen(buf)); /* display arguments if there are any */ if (f->dbgfself == MCMONINV || f->dbgfargc != 0) { (*dispfn)(dispctx, "(", 1); for (k = 0 ; k < f->dbgfargc ; ++k) { dbgpval(ctx, f->dbgfbp - k - 2, dispfn, dispctx, FALSE); if (k + 1 < f->dbgfargc) (*dispfn)(dispctx, ", ", 2); } (*dispfn)(dispctx, ")", 1); } /* send out a newline, then move on to next frame */ (*dispfn)(dispctx, "\n", 1); /* we're done if doing one function only */ if (toponly) break; } } static void dbgdsdisp(void *ctx, const char *buf, int bufl) { if (buf[0] == '\n') tioflush((tiocxdef *)ctx); else tioputslen((tiocxdef *)ctx, (const char *)buf, bufl); } /* dump the stack */ void dbgds(dbgcxdef *ctx) { /* don't do stack dumps if we're running from the debugger command line */ if (ctx->dbgcxflg & DBGCXFIND) return; tioflush(ctx->dbgcxtio); tioshow(ctx->dbgcxtio); dbgstktr(ctx, dbgdsdisp, ctx->dbgcxtio, -1, FALSE, TRUE); tioflush(ctx->dbgcxtio); ctx->dbgcxfcn = ctx->dbgcxdep = 0; } /* get information about the currently executing source line */ void dbglget(dbgcxdef *ctx, uchar *buf) { dbglgetlvl(ctx, buf, 0); } /* * Get information about a source line at a particular stack level into * the buffer; leaves out frame info. level 0 is the currently * executing line, 1 is the first enclosing level, and so on. */ int dbglgetlvl(dbgcxdef *ctx, uchar *buf, int level) { uchar *linrec; uchar *obj; dbgfdef *fr; /* make sure the level is valid */ if (level > ctx->dbgcxfcn - 1) return 1; /* get the frame at the given level */ fr = &ctx->dbgcxfrm[ctx->dbgcxfcn - level - 1]; /* if we're in an intrinsic, go to enclosing frame */ if (fr->dbgftarg == MCMONINV) --fr; /* make sure we've encountered an OPCLINE in this frame */ if (fr->dbgflin == 0) return 1; /* we need to read from the target object - lock it */ obj = mcmlck(ctx->dbgcxmem, (mcmon)fr->dbgftarg); linrec = obj + fr->dbgflin; memcpy(buf, linrec + 3, (size_t)(*linrec - 3)); /* no longer need the target object locked */ mcmunlck(ctx->dbgcxmem, (mcmon)fr->dbgftarg); /* success */ return 0; } /* tell the line source the location of the current line being compiled */ void dbgclin(tokcxdef *tokctx, objnum objn, uint ofs) { uchar buf[4]; /* package the information and send it to the line source */ oswp2(buf, objn); oswp2(buf + 2, ofs); lincmpinf(tokctx->tokcxlin, buf); } } // End of namespace TADS2 } // End of namespace TADS } // End of namespace Glk