/* Agent Tcl
 * Bob Gray
 * 25 January 1995
 * 
 * *** ADAPTED FROM THE STANDARD TCL DISTRIBUTION ***
 *
 * tclStackRun.c --
 *
 *      This file contains the new version of Tcl_Eval which is
 *      based on an explit execution stack rather than recursive
 *      calls. 
 *
 * Copyright (c) 1995, Robert S. Gray, Dartmouth College
 * Copyright (c) 1987-1993 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"
#ifndef TCL_GENERIC_ONLY
#include "tclPort.h"
#endif

#define NUM_CHARS 200

static char copyStorage[NUM_CHARS];

static Command *TclFindCommand 
  _ANSI_ARGS_((Interp *iPtr, Stack *stack, Stack_Element *element));

static void TclEvalError 
  _ANSI_ARGS_((Interp *iPtr, Stack_Element *stack_command, char *ellipsis));

/*
 * Tcl_AllowExceptions ---
 *
 *   Allow a "break" or "continue" at the top level (on the next call to Tcl_Eval)
 *   
 */

void Tcl_AllowExceptions (interp)
     Tcl_Interp *interp;
{
  Interp *iPtr = (Interp *) interp;
  iPtr -> evalFlags |= TCL_ALLOW_EXCEPTIONS;
}

/*
 * TclPartialResetResult
 *
 * Reset the result string and code (but leave the error flags untouched)
 *
 */

void TclPartialResetResult (iPtr)
     Interp *iPtr;
{  
  Tcl_FreeResult ((Tcl_Interp *) iPtr);
  iPtr -> result = iPtr -> resultSpace;
  iPtr -> resultSpace[0] = 0;
  iPtr -> resultCode = TCL_OK;
}
  
/*
 *-----------------------------------------------------------------
 *
 *  TclEvalError ---
 *
 *     Record information about the errors that occur during Tcl_Eval
 *
 *-----------------------------------------------------------------
 */

static void TclEvalError (iPtr, stack_command, ellipsis)
     Interp *iPtr;
     Stack_Element *stack_command;
     char *ellipsis;
{
  Tcl_Interp *interp = (Tcl_Interp *) iPtr; 
  int result         = iPtr -> resultCode;

    /* handle errors that occur on the top stack command */

  if (iPtr -> execution_stack.top == 0)
  {
    if (result == TCL_RETURN) 
    {
      result = TclUpdateReturnInfo (iPtr);
    }
    else if ((result != TCL_OK) && (result != TCL_ERROR) && !(stack_command -> evalFlags & TCL_ALLOW_EXCEPTIONS))
    {
      Tcl_ResetResult (interp);

      if (result == TCL_BREAK)
      { 
	iPtr -> result = "invoked \"break\" outside of a loop";
      }
      else if (result == TCL_CONTINUE) 
      {
	iPtr -> result = "invoked \"continue\" outside of a loop";
      }
      else 
      {
	iPtr -> result = iPtr -> resultSpace;
	sprintf(iPtr -> resultSpace, "command returned bad code: %d", result);
      }

      result = TCL_ERROR;
    }
  }

    /* record information about what was being executed when the error */
    /* occurred if there was an error                                  */

  if ((result == TCL_PERMIT) || ((result == TCL_ERROR) && !(iPtr -> flags & ERR_ALREADY_LOGGED))) 
  {
    int numChars;
    register char *p;

      /* compute the line number where the error occurred */

    iPtr -> errorLine = 1;

    for (p = stack_command -> cmd; p != stack_command -> cmdStart; p++)
      if (*p == '\n') 
	iPtr -> errorLine++;

      /* figure out how much of the command to print in the error message  */
      /* (up to a certain number of characters or up to the first newline) */

    numChars = stack_command -> rest - stack_command -> cmdStart;

    if (numChars > NUM_CHARS - 50) {
      numChars = NUM_CHARS-50;
      ellipsis = " ...";
    }

    if (!(iPtr->flags & ERR_IN_PROGRESS)) {
      sprintf(copyStorage, "\n    while executing\n\"%.*s%s\"", numChars, stack_command -> cmdStart, ellipsis);
    } else {
      sprintf(copyStorage, "\n    invoked from within\n\"%.*s%s\"", numChars, stack_command -> cmdStart, ellipsis);
    }
	
    Tcl_AddErrorInfo(interp, copyStorage);
    iPtr->flags &= ~ERR_ALREADY_LOGGED;

  } else {

    iPtr -> flags &= ~ERR_ALREADY_LOGGED;
  }

  iPtr -> resultCode = result;
}

/*
 *-----------------------------------------------------------------
 *
 * Tcl_Eval --
 *
 *	Parse and execute a command in the Tcl language.
 *
 * Results:
 *	The return value is one of the return codes defined in tcl.hd
 *	(such as TCL_OK), and interp->result contains a string value
 *	to supplement the return code.  The value of interp->result
 *	will persist only until the next call to Tcl_Eval:  copy it or
 *	lose it! *TermPtr is filled in with the character just after
 *	the last one that was part of the command (usually a NULL
 *	character or a closing bracket).
 *
 *-----------------------------------------------------------------
 */

static Command *TclFindCommand (iPtr, stack, element)
	Interp *iPtr;
	Stack *stack;
	Stack_Element *element;
{
  Tcl_Interp *interp = (Tcl_Interp *) iPtr;
  Tcl_HashEntry *hPtr;
  Command *command;
  int i;

    /* find the command */

  hPtr = Tcl_FindHashEntry(&iPtr -> commandTable, element -> argv[0]);
 
    /* find the "unknown" command if the command was not found */

  if (hPtr == NULL) {
    if ((hPtr = Tcl_FindHashEntry (&iPtr -> commandTable, "unknown")) == NULL) {
      Tcl_ResetResult(interp);
      Tcl_AppendResult(interp, "invalid command name \"", element -> argv[0], "\"", (char *) NULL);
      return NULL;
    }

    for (i = element -> argc; i >= 0; i--) {
      element -> argv[i+1] = element -> argv[i];
    }

    element -> argv[0] = "unknown";
    element -> argc++;
  }

    /* set the command flags */

  command = (Command *) Tcl_GetHashValue (hPtr);

  if (stack -> top == 0) {
    element -> commandFlags = 
	command -> commandFlag;
  } else {
    Stack_Element *previous =
	stack -> slots[stack -> top - 1];
    element -> commandFlags = 
	(command -> commandFlag) & (previous -> commandFlags);
  }

  return (command);
}

int Tcl_Eval (interp, cmd)
     Tcl_Interp *interp;
     char *cmd;
{
  int i;                  /* loop counter                                    */
  int newTop;             /* old top of the stack                            */
  char temp[8];           /* scratch area                                    */
  Command *cmdPtr;        /* command information                             */
  Trace *tracePtr;        /* command trace information                       */
  char *oldBuffer;        /* old buffer space                                */ 
  int stack_level;        /* current stack level                             */
  register char *src;     /* current character in command                    */
  register char c;        /* current character in command                    */
  char *termPtr;          /* character after last one in command             */
  int argSize;            /* current number of slots in the argument list    */ 
  int result;             /* result code                                     */


     /* get the stack */
 
  register Interp *iPtr = (Interp *) interp;
  Stack *stack = &iPtr -> execution_stack;
  Stack_Element *stack_command;

     /* push the command onto the stack OR run until stack empty */

   if (cmd == NULL) {
     newTop = 0;
   } else {
     TclPushStack (stack, CMD_REST_OF_SCRIPT, cmd, TCL_STATIC);
     newTop                     = stack -> top;    
     stack_command              = stack -> slots[newTop];
     stack_command -> evalFlags = iPtr -> evalFlags;
     iPtr -> evalFlags          = 0;

     if (stack_command -> evalFlags & TCL_BRACKET_TERM) {
       stack_command -> termChar = ']';
     }

     TclPartialResetResult (iPtr);
   }

     /* outer loop iterates until we are finished with the command */

   while (stack -> top >= newTop) 
   {
     stack_command = stack -> slots[stack -> top];
     src           = stack_command -> rest;

       /* are we in the middle of a command substitution? */
 
     if (stack_command -> substitution != 0) { 
       sprintf (temp, "%d", stack_command -> substitution);
       set_state_variable (interp, temp, iPtr -> result);
       stack_command -> substitution = 0; 
     } else if (stack_command -> flag == CMD_START) {
       stack_command -> flag = CMD_REST_OF_SCRIPT;
     } 

       /* move on to the rest of the script or execute current command */

     if (stack_command -> flag == CMD_REST_OF_SCRIPT) {

         /* move up the stack if there was an error */

       if (iPtr -> resultCode != TCL_OK) {
	 unset_all_state_variables (interp);
         TclEvalError (iPtr, stack_command, "");
         TclPopStack (stack);
         continue;
       }

         /* check the nesting depth */

       if (stack -> top > iPtr -> maxNestingDepth) {
         sprintf (temp, "%d", iPtr -> maxNestingDepth);
         Tcl_AppendResult (interp, "more than ", temp, "items on the stack (runaway recursion?)", (char *) NULL);
	 iPtr -> resultCode = TCL_ERROR;
	 unset_all_state_variables (interp);
         TclEvalError (iPtr, stack_command, "");
         TclPopStack (stack);
         continue;
       }

 	  /* skim off leading white space and comments */

       while (1)
       {
         c = *src;

         while ((CHAR_TYPE(c) == TCL_SPACE) || (c == ';') || (c == '\n')) 
         {	  
            src++;
            c = *src;
         }
      
	 if (c != '#') break;
 
	 for (src++; *src != 0; src++) 
           if ((*src == '\n') && (src[-1] != '\\')) 
           {
	     src++;
	     break;
	   }
       }	

          /* update the stack pointers */

       stack_command -> cmdStart = src;
       stack_command -> rest     = src;

          /*  move up stack if we have reached terminator */  

        if (*src == stack_command -> termChar) {
          unset_all_state_variables (interp);
          TclPopStack (stack);
          continue;
        }
  
         /* parse the words of the command (generate argc and argv) */

        argSize                   = ST_ARGS;
	oldBuffer                 = stack_command -> pv.buffer;
        stack_command -> pv.next  = stack_command -> pv.buffer;
	stack_command -> argc     = 0;

        if (stack -> top == 0) {
          stack_command -> commandFlags = TCL_INTERRUPT;
        } else {
          Stack_Element *previous = stack -> slots[stack -> top - 1];
          stack_command -> commandFlags = previous -> commandFlags;
        }

	while (1) 
        {
          int newArgs, maxArgs;
	    char **newArgv;
	    int i;

	    /*
	     * Note:  the "- 2" below guarantees that we won't use the
	     * last two argv slots here.  One is for a NULL pointer to
	     * mark the end of the list, and the other is to leave room
	     * for inserting the command name "unknown" as the first
	     * argument (see below).
	     */

	    maxArgs = argSize - stack_command -> argc - 2;
   
	    iPtr -> resultCode = 
		TclParseWords((Tcl_Interp *) iPtr, src, 
                    stack_command -> evalFlags,
		    maxArgs, &termPtr, &newArgs, 
                    &stack_command -> argv[stack_command -> argc], 
                    &stack_command -> pv);

	    src = termPtr;


	    if (iPtr -> resultCode != TCL_OK)
               break;

	    /*
	     * Careful!  Buffer space may have gotten reallocated while
	     * parsing words.  If this happened, be sure to update all
	     * of the older argv pointers to refer to the new space.
	     */

	    if (oldBuffer != stack_command -> pv.buffer) 
            {
		int i;

		for (i = 0; i < stack_command -> argc; i++) {
		    stack_command -> argv[i] += 
                       (stack_command -> pv.buffer - oldBuffer);
		}
		oldBuffer = stack_command -> pv.buffer;
	    }
	    stack_command -> argc += newArgs;
	    if (newArgs < maxArgs) {
		stack_command -> argv[stack_command -> argc] = (char *) NULL;
		break;
	    }

	    /*
	     * Args didn't all fit in the current array.  Make it bigger.
	     */

	    argSize *= 2;
	    newArgv = (char **)
		    ckalloc((unsigned) argSize * sizeof(char *));
	    for (i = 0; i < stack_command -> argc; i++) {
		newArgv[i] = stack_command -> argv[i];
	    }
	    if (stack_command -> argv != stack_command -> argStore) {
		ckfree((char *) stack_command -> argv);
	    }
	    stack_command -> argv = newArgv;
	}

          /* unset the state variables associated with the substitutions */

        unset_all_state_variables (interp);
        stack_command -> substitution = 0;
        stack_command -> rest = src;

	  /* move up stack on error */

        if (iPtr -> resultCode != TCL_OK) {
          TclEvalError (iPtr, stack_command, "...");
          TclPopStack (stack);
          continue;
        }

          /* move to rest of command on empty command */
 
	if ((stack_command -> argc == 0) || iPtr -> noEval) {
	  continue;
        }

        stack_command -> argv[stack_command -> argc] = NULL;

          /* record history if desired */

        if (stack_command -> evalFlags & TCL_RECORD_BOUNDS) {
          iPtr -> evalFirst = stack_command -> cmdStart;
          iPtr -> evalLast  = stack_command -> rest - 1;
        }
 
	  /* find the procedure to execute this command */

        if ((cmdPtr = TclFindCommand (iPtr, stack, stack_command)) == NULL) {
          iPtr -> resultCode = TCL_ERROR;
          TclEvalError (iPtr, stack_command, "");
          TclPopStack (stack); 
          continue;
        }         

        stack_command -> flag        = CMD_START;
        stack_command -> commandProc = cmdPtr -> proc;
        stack_command -> commandData = cmdPtr -> clientData;

	  /* call trace procedures */

	for (tracePtr = iPtr->tracePtr; tracePtr != NULL; tracePtr = tracePtr->nextPtr) 
        {
	  char saved;

	  if ((tracePtr -> level < iPtr -> execution_stack.top) && (tracePtr -> level != -1))
	    continue;

          saved = *src;
          *src = 0;

	  (*tracePtr->proc)(tracePtr->clientData, interp, 
	      iPtr->execution_stack.top,
	      stack_command -> cmdStart,
	      stack_command -> commandProc, stack_command -> commandData,
              stack_command -> argc, stack_command -> argv);

	  *src = saved;
	}

          /* make sure that we have an empty result */

        TclPartialResetResult (iPtr);
        iPtr -> cmdCount++;
      }
      else if (stack_command -> commandProc == NULL)
      {
        if ((cmdPtr = TclFindCommand (iPtr, stack, stack_command)) == NULL) {
          iPtr -> resultCode = TCL_ERROR;
          TclPopStack (stack); 
          continue;
        }         

        stack_command -> commandProc = cmdPtr -> proc;
        stack_command -> commandData = cmdPtr -> clientData;
      }
         
        /* invoke the command procedure */

      stack_level = stack -> top;
      iPtr -> resultCode = (*stack_command->commandProc) (stack_command->commandData, interp, stack_command -> argc, stack_command -> argv);

        /* unset the state variables associated with substitutions */

      unset_subst_state (interp, stack_command -> substitution, stack_level);
      stack_command -> substitution = 0;

        /* handle asynchronous handlers */

      if (tcl_AsyncReady) {
        iPtr -> resultCode = Tcl_AsyncInvoke(interp, iPtr -> resultCode);
      }

      if (iPtr -> resultCode != TCL_OK) {
        unset_all_state_variables (interp);
        TclEvalError (iPtr, stack_command, "");
        TclPopStack (stack);
      }
    } 

    /* delete the interpreter if the DELETED flag is set */

  result = iPtr -> resultCode;

  if ((iPtr -> flags & DELETED) && (stack -> top == -1)) {
    Tcl_DeleteInterp (interp);
  } else {
    iPtr -> termPtr = src;
  }

  return (result);
}
