/* -*- Mode: c++ -*-
 * $Id: s.xotclTrace.c 1.3 01/02/22 20:35:58-00:00 neumann $
 *  
 *  Extended Object Tcl (XOTcl)
 *
 *  Copyright (C) 1999-2000 Gustaf Neumann, Uwe Zdun
 *
 *
 *  xotclTrace.c --
 *  
 *  Tracing facilities for XOTcl
 *  
 */

#include "xotclInt.h"

void
XOTclStackTrace (Tcl_Interp* in) {
  Interp *iPtr = (Interp *) in;
  CallFrame *f = iPtr->framePtr, *v = iPtr->varFramePtr;
  Tcl_Obj* varCmdObj;

  XOTclNewObj(varCmdObj);
  fprintf (stderr, "     TCL STACK: ");
  if (f == 0) fprintf(stderr, "- ");
  while (f) {
    Tcl_Obj* cmdObj;
    XOTclNewObj(cmdObj);
    if (f && f->isProcCallFrame && f->procPtr && f->procPtr->cmdPtr) {
      Tcl_GetCommandFullName(in, (Tcl_Command)  f->procPtr->cmdPtr, cmdObj);
      if (cmdObj) {
	fprintf(stderr, " %s (%d)", ObjStr(cmdObj), f->level);
      }
      DECR_REF_COUNT(cmdObj);
    } else fprintf(stderr, "- ");

    f = f->callerPtr;
    if (f) fprintf(stderr, ",");
  }

  fprintf (stderr, " VARFRAME: ");
  if (v && v->isProcCallFrame && v->procPtr && v->procPtr->cmdPtr) {
    Tcl_GetCommandFullName(in, (Tcl_Command)  v->procPtr->cmdPtr, varCmdObj);
    if (varCmdObj) {
      fprintf(stderr, " %s (%d)\n", ObjStr(varCmdObj), v->level);
    }
  } else fprintf(stderr, "- \n");
  DECR_REF_COUNT(varCmdObj);
}

void
XOTclCallStackTrace (Tcl_Interp* in) {
  XOTclCallStack *cs = &RUNTIME_STATE(in)->cs;
  XOTclCallStackContent *csc;

  fprintf (stderr, "     XOTCL CALLSTACK: \n");
  for (csc = &cs->content[1]; csc <= cs->top; csc++) {
    fprintf(stderr, "       ");
    if (csc->self)
      fprintf(stderr, "OBJ: %s, ", ObjStr(csc->self->cmdName));
    if (csc->cl)
      fprintf(stderr, "CL: %s, ", className(csc->cl));
    fprintf(stderr, "PROC: %s, ", csc->procName);

    if (csc->frameCut > 0)
      fprintf(stderr, "--frame cutted (%d) ", csc->frameCut);

    if (csc->destroyedCmd)
      fprintf(stderr, "--destroyed cmd set (%p) ", 
	      csc->destroyedCmd);

    fprintf(stderr, "\n");
  }
}

void
XOTclFilterTrace (Tcl_Interp* in) {
  Tcl_HashSearch hSrch;
  Tcl_HashTable* filterList =
    &RUNTIME_STATE(in)->filterList;
  Tcl_HashEntry* hPtr = filterList ?
	  Tcl_FirstHashEntry(filterList, &hSrch) : 0;

  fprintf(stderr, "     Filters: \n");
  if (hPtr == 0)
    fprintf(stderr, "-");

  while (hPtr != 0) {
    Tcl_Obj* cmdObj;
    Command* cmdPtr = (Command*) Tcl_GetHashKey(filterList, hPtr);
    if (cmdPtr && !cmdPtr->cmdEpoch) {
      XOTclNewObj(cmdObj);
      Tcl_GetCommandFullName(in,
			     (Tcl_Command) cmdPtr,
			     cmdObj);
      if (cmdObj) {
	XOTclFilterListEntry* entry = (XOTclFilterListEntry*) Tcl_GetHashValue (hPtr);
	if (entry) {
	  XOTclObjList* o = entry->activeObjs;
	  fprintf(stderr, "       %s <%d> active on: ", ObjStr(cmdObj), entry->count);
	  if (o == 0)
	    fprintf(stderr, "-");
	  else
	    while (o) {
	      fprintf(stderr, "%s, ", ObjStr(o->objPtr->cmdName));
	      o = o->next;
	    }
	}
      }
      DECR_REF_COUNT(cmdObj);
      fprintf(stderr, "\n");
    }
    hPtr = Tcl_NextHashEntry(&hSrch);
  }
}

/* helper function to print the vars dynamically created on a
   callframe
static void printLocalTable (CallFrame* c) {
  Tcl_HashEntry* entryPtr;
  Tcl_HashTable *localVarTablePtr = c->varTablePtr;
  Tcl_HashSearch search;

  fprintf(stderr, "LocalVars:");

  if (localVarTablePtr != NULL) {
    for (entryPtr = Tcl_FirstHashEntry(localVarTablePtr, &search);
	 entryPtr != NULL;
	 entryPtr = Tcl_NextHashEntry(&search)) {
      char* varName = Tcl_GetHashKey(localVarTablePtr, entryPtr);
      fprintf(stderr, " %s,", varName);
    }
  }
  fprintf(stderr,"\n");
}
*/

int
XOTcl_TraceObjCmd(ClientData cd, Tcl_Interp *in, int objc, Tcl_Obj *CONST objv[]) {
  char* option;
  if (objc != 2)
    return XOTclObjErrArgCnt(in, NULL, "xotcltrace");

  option = ObjStr(objv[1]);
  if (strcmp(option,"stack") == 0) {
    XOTclStackTrace(in);
    return TCL_OK;
  }
  if (strcmp(option,"callstack") == 0) {
    XOTclCallStackTrace(in);
    return TCL_OK;
  }
  if (strcmp(option,"filters") == 0) {
    XOTclFilterTrace(in);
    return TCL_OK;
  }
  return XOTclVarErrMsg(in, "xotcltrace: unknown option", (char*) NULL);
}
