/* Agent Tcl
 * Bob Gray
 * 25 January 1995
 * 
 * *** ADAPTED FROM THE STANDARD TCL DISTRIBUTION ***
 *
 * tclStackUnixCmd.c --
 *
 *      All of the UNIX-specific  command routines -- e.g. Tcl_SourceCmd -- 
 *      that must examine or change the execution stack have been moved into
 *      this file.  
 *
 * Copyright (c) 1995 Robert S. Gray, Dartmouth College
 * Copyright (c) 1988-1994 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "agent.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */ 

#include "tclInt.h"
#include "tclPort.h"

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SourceCmd --
 *
 *	This procedure is invoked to process the "source" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

#define CMD_SourceBody 1
 
static int TclSourceBody (dummy, interp, argc, argv)
     ClientData dummy;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  Interp *iPtr           = (Interp *) interp;
  Stack *stack           = &iPtr -> execution_stack;
  Stack_Element *element = stack -> slots[stack -> top];
  int result             = iPtr -> resultCode;
  char *parentScript;

    /* handle errors */

  if (result == TCL_RETURN)
  {
    result = TclUpdateReturnInfo (iPtr);
  }
  else if (result == TCL_ERROR)
  {
    char msg[200];
    sprintf (msg, "\n    (file \"%.150s\" line %d)", argv[1], interp -> errorLine);
    Tcl_AddErrorInfo (interp, msg);
  }

    /* restore the name of the parent script */

  ckfree ((char *) iPtr -> scriptFile);

  if ((parentScript = get_state_variable (interp, "parent_script")) == NULL) {
    iPtr -> scriptFile = NULL;
  } else {
    iPtr -> scriptFile = ckalloc ((long) strlen(parentScript) + 1);
    strcpy (iPtr -> scriptFile, parentScript);
  }  

    /* move on to the rest of the script */
  
  element -> flag = CMD_REST_OF_SCRIPT;
  return result; 
}

int Tcl_SourceCmd (dummy, interp, argc, argv)
     ClientData dummy;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  char *cmdBuffer;  
  Interp *iPtr           = (Interp *) interp;
  Stack *stack           = &iPtr -> execution_stack;
  Stack_Element *element = stack -> slots[stack -> top];

  if (element -> flag == CMD_SourceBody)
  {
    return TclSourceBody (dummy, interp, argc, argv);
  }
  else
  {
    if (argc != 2) 
    {
      Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " fileName\"", (char *) NULL);
      return TCL_ERROR;
    }

    if ((cmdBuffer = Tcl_LoadFile (interp, argv[1])) == NULL)
    {
      return TCL_ERROR;
    }

    if (iPtr -> scriptFile != NULL)
    {
      if (set_state_variable (interp, "parent_script", iPtr -> scriptFile) == NULL)
      {
        Tcl_AppendResult (interp, "unable to save the name of the parent script", (char *) NULL);
        return TCL_ERROR;
      }
    }

    iPtr -> scriptFile = ckalloc ((long) strlen(argv[1]) + 1);
    strcpy (iPtr -> scriptFile, argv[1]);
 
    element -> flag        = CMD_SourceBody;
    element -> commandProc = TclSourceBody;
    TclPushStack (stack, CMD_REST_OF_SCRIPT, cmdBuffer, TCL_DYNAMIC);
    return TCL_OK;        
  } 
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_TimeCmd --
 *
 *	This procedure is invoked to process the "time" Tcl command.
 *	See the user documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */

#define CMD_TimeBody 1

typedef struct TimeData
{
  int count;              /* how many times to execute the command */
  int iter;               /* current iteration number              */
#if NO_GETTOD
  long start;             /* start time                            */
#else
  struct timeval start;   /* start time                            */
#endif
} TimeData;
     
static int TclTimeBody (data, interp, argc, argv)
     ClientData data;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  Interp *iPtr       = (Interp *) interp;
  TimeData *timeData = (TimeData *) data;
  int result         = iPtr -> resultCode;

  if (result != TCL_OK) 
  {
     if (result == TCL_ERROR)
     {
       char msg[60];
       sprintf(msg, "\n    (\"time\" body line %d)", interp->errorLine);
       Tcl_AddErrorInfo(interp, msg);
     }

     ckfree ((char *) timeData);
     return result;
  }
  
  timeData -> iter -= 1;
  if (timeData -> iter != 0)
  {
    Stack *stack = &iPtr -> execution_stack;
    TclPushStack (stack, CMD_REST_OF_SCRIPT, argv[1], TCL_STATIC);
    return TCL_OK;
  }
  else   
  {
    Stack *stack           = &iPtr -> execution_stack;
    Stack_Element *element = stack -> slots[stack -> top];
    double timePer;
    int micros;
#if NO_GETTOD
    long stop;
    long start = timeData -> start;
    struct tms dummy2;
#else
    struct timezone tz;
    struct timeval *start = &timeData -> start;
    struct timeval stop;
#endif

#if NO_GETTOD
    stop = times(&dummy2);
    timePer = (((double) (stop - start))*1000000.0)/CLK_TCK;
#else
    gettimeofday(&stop, &tz);
    micros = (stop.tv_sec - start -> tv_sec)*1000000 + (stop.tv_usec - start -> tv_usec);
    timePer = micros;
#endif

    Tcl_ResetResult(interp);
    sprintf(interp->result, "%.0f microseconds per iteration", timePer / timeData -> count);
    element -> flag = CMD_REST_OF_SCRIPT;
    ckfree ((char *) timeData);
    return TCL_OK;
  }
}

int Tcl_TimeCmd (dummy, interp, argc, argv)
     ClientData dummy;
     Tcl_Interp *interp;
     int argc;
     char **argv;
{
  Interp *iPtr           = (Interp *) interp;
  Stack *stack           = &iPtr -> execution_stack;
  Stack_Element *element = stack -> slots[stack -> top];    

  if (element -> flag == CMD_TimeBody)
    return TclTimeBody (dummy, interp, argc, argv);
  else
  {
    int count;
    TimeData *data;
#if NO_GETTOD
    struct tms dummy2;
#else
    struct timezone tz;
#endif

    if (argc == 2) 
    {
      count = 1;
    }
    else if (argc == 3) 
    {
      if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK)
        return TCL_ERROR;
 
      if (count == 0)
      {
        Tcl_SetResult (interp, "Zero iterations take no time!", TCL_STATIC);
        return TCL_OK;
      }
    }
    else 
    {
      Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " command ?count?\"", (char *) NULL);
      return TCL_ERROR;
    }

    data = (TimeData *) ckalloc ((unsigned) sizeof(TimeData)); 
    data -> count = count;
    data -> iter  = count;
#if NO_GETTOD
    data -> start = times(&dummy2);
#else
    gettimeofday(&data -> start, &tz);
#endif

    element -> flag        = CMD_TimeBody;
    element -> commandProc = TclTimeBody;
    element -> commandData = (ClientData) data;
    TclPushStack (stack, CMD_REST_OF_SCRIPT, argv[1], TCL_STATIC);
    return TCL_OK;
  }
}

