/* Agent Tcl
 * Bob Gray
 * 25 January 1995
 *
 * *** NOT PART OF THE STANDARD TCL DISTRIBUTION ***
 *
 * This is part of the code that is used to capture and restore the interal
 * state of an executing Tcl script. 
 * 
 * tclStack.c --
 *
 *      This file contains the procedures that maintain the execution
 *      stack of the TCL program.
 *
 * Copyright (c) 1995, Robert S. Gray, Dartmouth College
 *
 * See the file "agent.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#define DEFAULT_SLOTS 20

/* Procedure TclInitStack

   Purpose:

     Input:

    Output:
*/

void TclInitStack (stack)
     Stack *stack;
{
  int i;    /* loop counter */

  stack -> top     = -1;
  stack -> n_slots = DEFAULT_SLOTS;
  stack -> slots   = (Stack_Element **) ckalloc (DEFAULT_SLOTS * sizeof (Stack_Element *));

  for (i = 0; i < DEFAULT_SLOTS; i++) {
    stack -> slots[i] = (Stack_Element *) ckalloc (sizeof(Stack_Element));
  }
}

/* TclPushStack

   Purpose:
 
     Input:
 
    Output: 
*/

void TclPushStack (stack, flag, cmd, freeProc)
     Stack *stack;
     int flag;
     char *cmd;
     Tcl_FreeProc *freeProc;
{
  int i;
  char *new_cmd;
  Stack_Element *element; 

  stack -> top++;

    /* double the stack size if we have run out of slots */

  if (stack -> top >= stack -> n_slots) {
     int i;
     int new_slots = 2 * stack -> n_slots;
     Stack_Element **old_slots = stack -> slots;

     stack -> slots = (Stack_Element **) ckalloc (new_slots * sizeof(Stack_Element *));

     for (i = 0; i < stack -> n_slots; i++) {
       stack -> slots[i] = old_slots[i];
     }

     for (; i < new_slots; i++) {
       stack -> slots[i] = (Stack_Element *) ckalloc (sizeof(Stack_Element));
     }

     stack -> n_slots = new_slots;
     ckfree ((char *) old_slots);
  } 
  
    /* initialize the new stack element */
 
  element                     = stack -> slots[stack -> top];
  element -> flag             = flag;
  element -> substitution     = 0;
  element -> termChar         = '\0';
  element -> evalFlags        = 0;
  element -> commandFlags     = 0;
  element -> argc             = 0;
  element -> argv             = element -> argStore;
  element -> pv.buffer        = element -> copyStore;
  element -> pv.next          = element -> copyStore;
  element -> pv.end           = element -> copyStore + ST_CHARS - 1;
  element -> pv.clientData    = (ClientData) NULL;   
  element -> pv.expandProc    = TclExpandParseValue;
  element -> commandProc      = NULL;
  element -> commandData      = (ClientData) NULL;

  if (freeProc == TCL_DYNAMIC) {
    new_cmd = cmd;
    element -> freeProc = (Tcl_FreeProc *) free;
  } else if (freeProc == TCL_VOLATILE) {
    new_cmd = (char *) ckalloc (strlen(cmd) + 1);
    strcpy (new_cmd, cmd);
    element -> freeProc = (Tcl_FreeProc *) free;
  } else {
    new_cmd = cmd;
    element -> freeProc = freeProc;
  } 

  element -> cmd              = new_cmd;
  element -> cmdStart         = new_cmd;
  element -> rest             = new_cmd;
}

/* Procedure TclPopStack

   Purpose:

     Input:

    Output:
*/

void TclPopStack (stack)
     Stack *stack;
{
  if (stack -> top >= 0)
  {
    Stack_Element *element = stack -> slots[stack -> top];
    Tcl_FreeProc *freeProc = element -> freeProc;

    if (element -> pv.buffer != element -> copyStore)
      ckfree ((char *) element -> pv.buffer); 

    if (element -> argv != element -> argStore)
      ckfree ((char *) element -> argv);

    if (freeProc != TCL_STATIC)
      (*freeProc)(element -> cmd);

    stack -> top--;
  }

}

/* Stack_NewHandler

   Purpose: Change the flag and handler of the command at the top of the
            stack

     Input: interp  = the current interpreter
            flag    = new flag
            handler = new handler

    Output: The procedure returns TCL_ERROR if the stack is empty, if the
            flag is CMD_START or CMD_REST_OF_SCRIPT or if the handler is NULL.
            Otherwise the procedure returns TCL_OK and changes the flag and
            handler of the command at the top of the stack.
*/

int Stack_NewHandler (interp, flag, handler)
	Tcl_Interp *interp;
	int flag;
	Tcl_CmdProc *handler;
{
  register Stack_Element *element;
  register Interp *iPtr = (Interp *) interp; 
  register Stack *stack = &iPtr -> execution_stack;
  register int top      = stack -> top;

  if (top < 0) {
    return TCL_ERROR;
  } else if (handler == (Tcl_CmdProc *) NULL) {
    return TCL_ERROR;
  } else if ((flag == CMD_START) || (flag == CMD_REST_OF_SCRIPT)) {
    return TCL_ERROR;
  }

  element                = stack -> slots[top];
  element -> flag        = flag;
  element -> commandProc = handler;
  return TCL_OK;
}

/* Stack_Push

   Purpose: Push a Tcl command onto the stack

     Input: interp  = the current interpreter
            command = text of the command
            dealloc = procedure that should be used to deallocate the text
                   
    Output: The procedure pushs the command onto the stack.
*/

void Stack_Push (interp, command, dealloc)
	Tcl_Interp *interp;
	char *command;
	Tcl_FreeProc *dealloc;
{
  register Interp *iPtr = (Interp *) interp;
  register Stack *stack = &iPtr -> execution_stack; 
  TclPushStack (stack, CMD_REST_OF_SCRIPT, command, dealloc);
}
 
/* Stack_Pop

   Purpose: Indicate the the topmost stack element should be popped as soon
            as control returns to Tcl_Eval

     Input: interp = the current interpreter

    Output: The procedure returns TCL_ERROR if the stack is empty.
	    Otherwise the procedure returns TCL_OK and indicates that the
            topmost stack element should be popped as soon as control
            returns to Tcl_Eval.
*/

int Stack_Pop (interp)
	Tcl_Interp *interp;
{
  register Interp *iPtr = (Interp *) interp; 
  register Stack *stack = &iPtr -> execution_stack;
  register int top      = stack -> top;

  if (top < 0) {
    return TCL_ERROR;
  } 

  stack -> slots[top] -> flag = CMD_REST_OF_SCRIPT;
  return TCL_OK;
}

/* Stack_GetFlag

   Purpose: Get the flag associated with the topmost stack element

     Input: interp = the current interpreter

    Output: The procedure returns TCL_ERROR if the stack is empty.
            Otherwise the procedure returns TCL_OK and sets "*flag"
            to the flag of the topmost stack element.
*/

int Stack_GetFlag (interp, flag)
	Tcl_Interp *interp;
	int *flag;
{
  register Interp *iPtr = (Interp *) interp; 
  register Stack *stack = &iPtr -> execution_stack;
  register int top      = stack -> top;

  if (top < 0) {
    return TCL_ERROR;
  } 

  *flag = stack -> slots[top] -> flag;
  return TCL_OK;
} 
