Blame bc/storage.c

Packit 70b277
/*  This file is part of GNU bc.
Packit 70b277
Packit 70b277
    Copyright (C) 1991-1994, 1997, 2006, 2008, 2012-2017 Free Software Foundation, Inc.
Packit 70b277
Packit 70b277
    This program is free software; you can redistribute it and/or modify
Packit 70b277
    it under the terms of the GNU General Public License as published by
Packit 70b277
    the Free Software Foundation; either version 3 of the License , or
Packit 70b277
    (at your option) any later version.
Packit 70b277
Packit 70b277
    This program is distributed in the hope that it will be useful,
Packit 70b277
    but WITHOUT ANY WARRANTY; without even the implied warranty of
Packit 70b277
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Packit 70b277
    GNU General Public License for more details.
Packit 70b277
Packit 70b277
    You should have received a copy of the GNU General Public License
Packit 70b277
    along with this program; see the file COPYING.  If not, see
Packit 70b277
    <http://www.gnu.org/licenses>.
Packit 70b277
Packit 70b277
    You may contact the author by:
Packit 70b277
       e-mail:  philnelson@acm.org
Packit 70b277
      us-mail:  Philip A. Nelson
Packit 70b277
                Computer Science Department, 9062
Packit 70b277
                Western Washington University
Packit 70b277
                Bellingham, WA 98226-9062
Packit 70b277
       
Packit 70b277
*************************************************************************/
Packit 70b277
Packit 70b277
/* storage.c:  Code and data storage manipulations.  This includes labels. */
Packit 70b277
Packit 70b277
#include "bcdefs.h"
Packit 70b277
#include "proto.h"
Packit 70b277
Packit 70b277
/* Local prototypes */
Packit 70b277
static bc_array_node *copy_tree (bc_array_node *ary_node, int depth);
Packit 70b277
static bc_array *copy_array (bc_array *ary);
Packit 70b277
Packit 70b277
Packit 70b277
/* Initialize the storage at the beginning of the run. */
Packit 70b277
Packit 70b277
void
Packit 70b277
init_storage (void)
Packit 70b277
{
Packit 70b277
Packit 70b277
  /* Functions: we start with none and ask for more. */
Packit 70b277
  f_count = 0;
Packit 70b277
  more_functions ();
Packit 70b277
  f_names[0] = strdup("(main)");
Packit 70b277
Packit 70b277
  /* Variables. */
Packit 70b277
  v_count = 0;
Packit 70b277
  more_variables ();
Packit 70b277
  
Packit 70b277
  /* Arrays. */
Packit 70b277
  a_count = 0;
Packit 70b277
  more_arrays ();
Packit 70b277
Packit 70b277
  /* Other things... */
Packit 70b277
  ex_stack = NULL;
Packit 70b277
  fn_stack = NULL;
Packit 70b277
  i_base = 10;
Packit 70b277
  o_base = 10;
Packit 70b277
  scale  = 0;
Packit 70b277
#if defined(READLINE) || defined(LIBEDIT)
Packit 70b277
  n_history = -1;	
Packit 70b277
#endif
Packit 70b277
  c_code = FALSE;
Packit 70b277
  bc_init_numbers();
Packit 70b277
}
Packit 70b277
Packit 70b277
/* Three functions for increasing the number of functions, variables, or
Packit 70b277
   arrays that are needed.  This adds another 32 of the requested object. */
Packit 70b277
Packit 70b277
void
Packit 70b277
more_functions (void)
Packit 70b277
{
Packit 70b277
  int old_count;
Packit 70b277
  int indx;
Packit 70b277
  bc_function *old_f;
Packit 70b277
  bc_function *f;
Packit 70b277
  char **old_names;
Packit 70b277
Packit 70b277
  /* Save old information. */
Packit 70b277
  old_count = f_count;
Packit 70b277
  old_f = functions;
Packit 70b277
  old_names = f_names;
Packit 70b277
Packit 70b277
  /* Add a fixed amount and allocate new space. */
Packit 70b277
  f_count += STORE_INCR;
Packit 70b277
  functions = bc_malloc (f_count*sizeof (bc_function));
Packit 70b277
  f_names = bc_malloc (f_count*sizeof (char *));
Packit 70b277
Packit 70b277
  /* Copy old ones. */
Packit 70b277
  for (indx = 0; indx < old_count; indx++)
Packit 70b277
    {
Packit 70b277
      functions[indx] = old_f[indx];
Packit 70b277
      f_names[indx] = old_names[indx];
Packit 70b277
    }
Packit 70b277
Packit 70b277
  /* Initialize the new ones. */
Packit 70b277
  for (; indx < f_count; indx++)
Packit 70b277
    {
Packit 70b277
      f = &functions[indx];
Packit 70b277
      f->f_defined = FALSE;
Packit 70b277
      f->f_void = FALSE;
Packit 70b277
      f->f_body = bc_malloc (BC_START_SIZE);
Packit 70b277
      f->f_body_size = BC_START_SIZE;
Packit 70b277
      f->f_code_size = 0;
Packit 70b277
      f->f_label = NULL;
Packit 70b277
      f->f_autos = NULL;
Packit 70b277
      f->f_params = NULL;
Packit 70b277
    }
Packit 70b277
Packit 70b277
  /* Free the old elements. */
Packit 70b277
  if (old_count != 0)
Packit 70b277
    {
Packit 70b277
      free (old_f);
Packit 70b277
      free (old_names);
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
void
Packit 70b277
more_variables (void)
Packit 70b277
{
Packit 70b277
  int indx;
Packit 70b277
  int old_count;
Packit 70b277
  bc_var **old_var;
Packit 70b277
  char **old_names;
Packit 70b277
Packit 70b277
  /* Save the old values. */
Packit 70b277
  old_count = v_count;
Packit 70b277
  old_var = variables;
Packit 70b277
  old_names = v_names;
Packit 70b277
Packit 70b277
  /* Increment by a fixed amount and allocate. */
Packit 70b277
  v_count += STORE_INCR;
Packit 70b277
  variables = bc_malloc (v_count*sizeof(bc_var *));
Packit 70b277
  v_names = bc_malloc (v_count*sizeof(char *));
Packit 70b277
Packit 70b277
  /* Copy the old variables. */
Packit 70b277
  for (indx = 3; indx < old_count; indx++)
Packit 70b277
    {
Packit 70b277
      variables[indx] = old_var[indx];
Packit 70b277
      v_names[indx] = old_names[indx];
Packit 70b277
    }
Packit 70b277
Packit 70b277
  /* Initialize the new elements. */
Packit 70b277
  for (; indx < v_count; indx++)
Packit 70b277
    variables[indx] = NULL;
Packit 70b277
Packit 70b277
  /* Free the old elements. */
Packit 70b277
  if (old_count != 0)
Packit 70b277
    {
Packit 70b277
      free (old_var);
Packit 70b277
      free (old_names);
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
void
Packit 70b277
more_arrays (void)
Packit 70b277
{
Packit 70b277
  int indx;
Packit 70b277
  int old_count;
Packit 70b277
  bc_var_array **old_ary;
Packit 70b277
  char **old_names;
Packit 70b277
Packit 70b277
  /* Save the old values. */
Packit 70b277
  old_count = a_count;
Packit 70b277
  old_ary = arrays;
Packit 70b277
  old_names = a_names;
Packit 70b277
Packit 70b277
  /* Increment by a fixed amount and allocate. */
Packit 70b277
  a_count += STORE_INCR;
Packit 70b277
  arrays = bc_malloc (a_count*sizeof(bc_var_array *));
Packit 70b277
  a_names = bc_malloc (a_count*sizeof(char *));
Packit 70b277
Packit 70b277
  /* Copy the old arrays. */
Packit 70b277
  for (indx = 1; indx < old_count; indx++)
Packit 70b277
    {
Packit 70b277
      arrays[indx] = old_ary[indx];
Packit 70b277
      a_names[indx] = old_names[indx];
Packit 70b277
    }
Packit 70b277
Packit 70b277
Packit 70b277
  /* Initialize the new elements. */
Packit 70b277
  for (; indx < a_count; indx++)
Packit 70b277
    arrays[indx] = NULL;
Packit 70b277
Packit 70b277
  /* Free the old elements. */
Packit 70b277
  if (old_count != 0)
Packit 70b277
    {
Packit 70b277
      free (old_ary);
Packit 70b277
      free (old_names);
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* clear_func clears out function FUNC and makes it ready to redefine. */
Packit 70b277
Packit 70b277
void
Packit 70b277
clear_func (int func)
Packit 70b277
{
Packit 70b277
  bc_function *f;
Packit 70b277
  bc_label_group *lg;
Packit 70b277
Packit 70b277
  /* Set the pointer to the function. */
Packit 70b277
  f = &functions[func];
Packit 70b277
  f->f_defined = FALSE;
Packit 70b277
  /* XXX restore f_body to initial size??? */
Packit 70b277
  f->f_code_size = 0;
Packit 70b277
  if (f->f_autos != NULL)
Packit 70b277
    {
Packit 70b277
      free_args (f->f_autos);
Packit 70b277
      f->f_autos = NULL;
Packit 70b277
    }
Packit 70b277
  if (f->f_params != NULL)
Packit 70b277
    {
Packit 70b277
      free_args (f->f_params);
Packit 70b277
      f->f_params = NULL;
Packit 70b277
    }
Packit 70b277
  while (f->f_label != NULL)
Packit 70b277
    {
Packit 70b277
      lg = f->f_label->l_next;
Packit 70b277
      free (f->f_label);
Packit 70b277
      f->f_label = lg;
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/*  Pop the function execution stack and return the top. */
Packit 70b277
Packit 70b277
int
Packit 70b277
fpop(void)
Packit 70b277
{
Packit 70b277
  fstack_rec *temp;
Packit 70b277
  int retval;
Packit 70b277
  
Packit 70b277
  if (fn_stack != NULL)
Packit 70b277
    {
Packit 70b277
      temp = fn_stack;
Packit 70b277
      fn_stack = temp->s_next;
Packit 70b277
      retval = temp->s_val;
Packit 70b277
      free (temp);
Packit 70b277
    }
Packit 70b277
  else
Packit 70b277
    {
Packit 70b277
      retval = 0;
Packit 70b277
      rt_error ("function stack underflow, contact maintainer.");
Packit 70b277
    }
Packit 70b277
  return (retval);
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Push VAL on to the function stack. */
Packit 70b277
Packit 70b277
void
Packit 70b277
fpush (int val)
Packit 70b277
{
Packit 70b277
  fstack_rec *temp;
Packit 70b277
  
Packit 70b277
  temp = bc_malloc (sizeof (fstack_rec));
Packit 70b277
  temp->s_next = fn_stack;
Packit 70b277
  temp->s_val = val;
Packit 70b277
  fn_stack = temp;
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Pop and discard the top element of the regular execution stack. */
Packit 70b277
Packit 70b277
void
Packit 70b277
pop (void)
Packit 70b277
{
Packit 70b277
  estack_rec *temp;
Packit 70b277
  
Packit 70b277
  if (ex_stack != NULL)
Packit 70b277
    {
Packit 70b277
      temp = ex_stack;
Packit 70b277
      ex_stack = temp->s_next;
Packit 70b277
      bc_free_num (&temp->s_num);
Packit 70b277
      free (temp);
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Push a copy of NUM on to the regular execution stack. */
Packit 70b277
Packit 70b277
void
Packit 70b277
push_copy (bc_num num)
Packit 70b277
{
Packit 70b277
  estack_rec *temp;
Packit 70b277
Packit 70b277
  temp = bc_malloc (sizeof (estack_rec));
Packit 70b277
  temp->s_num = bc_copy_num (num);
Packit 70b277
  temp->s_next = ex_stack;
Packit 70b277
  ex_stack = temp;
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Push NUM on to the regular execution stack.  Do NOT push a copy. */
Packit 70b277
Packit 70b277
void
Packit 70b277
push_num (bc_num num)
Packit 70b277
{
Packit 70b277
  estack_rec *temp;
Packit 70b277
Packit 70b277
  temp = bc_malloc (sizeof (estack_rec));
Packit 70b277
  temp->s_num = num;
Packit 70b277
  temp->s_next = ex_stack;
Packit 70b277
  ex_stack = temp;
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Make sure the ex_stack has at least DEPTH elements on it.
Packit 70b277
   Return TRUE if it has at least DEPTH elements, otherwise
Packit 70b277
   return FALSE. */
Packit 70b277
Packit 70b277
char
Packit 70b277
check_stack (int depth)
Packit 70b277
{
Packit 70b277
  estack_rec *temp;
Packit 70b277
Packit 70b277
  temp = ex_stack;
Packit 70b277
  while ((temp != NULL) && (depth > 0))
Packit 70b277
    {
Packit 70b277
      temp = temp->s_next;
Packit 70b277
      depth--;
Packit 70b277
    }
Packit 70b277
  if (depth > 0)
Packit 70b277
    {
Packit 70b277
      rt_error ("Stack error.");
Packit 70b277
      return FALSE;
Packit 70b277
    }
Packit 70b277
  return TRUE;
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* The following routines manipulate simple variables and
Packit 70b277
   array variables. */
Packit 70b277
Packit 70b277
/* get_var returns a pointer to the variable VAR_NAME.  If one does not
Packit 70b277
   exist, one is created. */
Packit 70b277
Packit 70b277
bc_var *
Packit 70b277
get_var (int var_name)
Packit 70b277
{
Packit 70b277
  bc_var *var_ptr;
Packit 70b277
Packit 70b277
  var_ptr = variables[var_name];
Packit 70b277
  if (var_ptr == NULL)
Packit 70b277
    {
Packit 70b277
      var_ptr = variables[var_name] = bc_malloc (sizeof (bc_var));
Packit 70b277
      bc_init_num (&var_ptr->v_value);
Packit 70b277
    }
Packit 70b277
  return var_ptr;
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* get_array_num returns the address of the bc_num in the array
Packit 70b277
   structure.  If more structure is requried to get to the index,
Packit 70b277
   this routine does the work to create that structure. VAR_INDEX
Packit 70b277
   is a zero based index into the arrays storage array. INDEX is
Packit 70b277
   the index into the bc array. */
Packit 70b277
Packit 70b277
bc_num *
Packit 70b277
get_array_num (int var_index, unsigned long idx)
Packit 70b277
{
Packit 70b277
  bc_var_array *ary_ptr;
Packit 70b277
  bc_array *a_var;
Packit 70b277
  bc_array_node *temp;
Packit 70b277
  int log;
Packit 70b277
  unsigned int ix, ix1;
Packit 70b277
  int sub [NODE_DEPTH];
Packit 70b277
Packit 70b277
  /* Get the array entry. */
Packit 70b277
  ary_ptr = arrays[var_index];
Packit 70b277
  if (ary_ptr == NULL)
Packit 70b277
    {
Packit 70b277
      ary_ptr = arrays[var_index] = bc_malloc (sizeof (bc_var_array));
Packit 70b277
      ary_ptr->a_value = NULL;
Packit 70b277
      ary_ptr->a_next = NULL;
Packit 70b277
      ary_ptr->a_param = FALSE;
Packit 70b277
    }
Packit 70b277
Packit 70b277
  a_var = ary_ptr->a_value;
Packit 70b277
  if (a_var == NULL) {
Packit 70b277
    a_var = ary_ptr->a_value = bc_malloc (sizeof (bc_array));
Packit 70b277
    a_var->a_tree = NULL;
Packit 70b277
    a_var->a_depth = 0;
Packit 70b277
  }
Packit 70b277
Packit 70b277
  /* Get the index variable. */
Packit 70b277
  sub[0] = idx & NODE_MASK;
Packit 70b277
  ix = idx >> NODE_SHIFT;
Packit 70b277
  log = 1;
Packit 70b277
  while (ix > 0 || log < a_var->a_depth)
Packit 70b277
    {
Packit 70b277
      sub[log] = ix & NODE_MASK;
Packit 70b277
      ix >>= NODE_SHIFT;
Packit 70b277
      log++;
Packit 70b277
    }
Packit 70b277
  
Packit 70b277
  /* Build any tree that is necessary. */
Packit 70b277
  while (log > a_var->a_depth)
Packit 70b277
    {
Packit 70b277
      temp = bc_malloc (sizeof(bc_array_node));
Packit 70b277
      if (a_var->a_depth != 0)
Packit 70b277
	{
Packit 70b277
	  temp->n_items.n_down[0] = a_var->a_tree;
Packit 70b277
	  for (ix=1; ix < NODE_SIZE; ix++)
Packit 70b277
	    temp->n_items.n_down[ix] = NULL;
Packit 70b277
	}
Packit 70b277
      else
Packit 70b277
	{
Packit 70b277
	  for (ix=0; ix < NODE_SIZE; ix++)
Packit 70b277
	    temp->n_items.n_num[ix] = bc_copy_num(_zero_);
Packit 70b277
	}
Packit 70b277
      a_var->a_tree = temp;
Packit 70b277
      a_var->a_depth++;
Packit 70b277
    }
Packit 70b277
  
Packit 70b277
  /* Find the indexed variable. */
Packit 70b277
  temp = a_var->a_tree;
Packit 70b277
  while ( log-- > 1)
Packit 70b277
    {
Packit 70b277
      ix1 = sub[log];
Packit 70b277
      if (temp->n_items.n_down[ix1] == NULL)
Packit 70b277
	{
Packit 70b277
	  temp->n_items.n_down[ix1] = bc_malloc (sizeof(bc_array_node));
Packit 70b277
	  temp = temp->n_items.n_down[ix1];
Packit 70b277
	  if (log > 1)
Packit 70b277
	    for (ix=0; ix < NODE_SIZE; ix++)
Packit 70b277
	      temp->n_items.n_down[ix] = NULL;
Packit 70b277
	  else
Packit 70b277
	    for (ix=0; ix < NODE_SIZE; ix++)
Packit 70b277
	      temp->n_items.n_num[ix] = bc_copy_num(_zero_);
Packit 70b277
	}
Packit 70b277
      else
Packit 70b277
	temp = temp->n_items.n_down[ix1];
Packit 70b277
    }
Packit 70b277
  
Packit 70b277
  /* Return the address of the indexed variable. */
Packit 70b277
  return &(temp->n_items.n_num[sub[0]]);
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Store the top of the execution stack into VAR_NAME.  
Packit 70b277
   This includes the special variables ibase, obase, and scale. */
Packit 70b277
Packit 70b277
void
Packit 70b277
store_var (int var_name)
Packit 70b277
{
Packit 70b277
  bc_var *var_ptr;
Packit 70b277
  long temp;
Packit 70b277
  char toobig;
Packit 70b277
Packit 70b277
  if (var_name > 3)
Packit 70b277
    {
Packit 70b277
      /* It is a simple variable. */
Packit 70b277
      var_ptr = get_var (var_name);
Packit 70b277
      if (var_ptr != NULL)
Packit 70b277
	{
Packit 70b277
	  bc_free_num(&var_ptr->v_value);
Packit 70b277
	  var_ptr->v_value = bc_copy_num (ex_stack->s_num);
Packit 70b277
	}
Packit 70b277
    }
Packit 70b277
  else
Packit 70b277
    {
Packit 70b277
      /* It is a special variable... */
Packit 70b277
      toobig = FALSE;
Packit 70b277
      temp = 0;
Packit 70b277
      if (bc_is_neg (ex_stack->s_num))
Packit 70b277
	{
Packit 70b277
	  switch (var_name)
Packit 70b277
	    {
Packit 70b277
	    case 0:
Packit 70b277
	      rt_warn ("negative ibase, set to 2");
Packit 70b277
	      temp = 2;
Packit 70b277
	      break;
Packit 70b277
	    case 1:
Packit 70b277
	      rt_warn ("negative obase, set to 2");
Packit 70b277
	      temp = 2;
Packit 70b277
	      break;
Packit 70b277
	    case 2:
Packit 70b277
	      rt_warn ("negative scale, set to 0");
Packit 70b277
	      temp = 0;
Packit 70b277
	      break;
Packit 70b277
#if defined(READLINE) || defined(LIBEDIT)
Packit 70b277
	    case 3:
Packit 70b277
	      temp = -1;
Packit 70b277
	      break;
Packit 70b277
#endif
Packit 70b277
	    }
Packit 70b277
	}
Packit 70b277
      else
Packit 70b277
	{
Packit 70b277
	  temp = bc_num2long (ex_stack->s_num);
Packit 70b277
	  if (!bc_is_zero (ex_stack->s_num) && temp == 0)
Packit 70b277
	    toobig = TRUE;
Packit 70b277
	}
Packit 70b277
      switch (var_name)
Packit 70b277
	{
Packit 70b277
	case 0:
Packit 70b277
	  if (temp < 2 && !toobig)
Packit 70b277
	    {
Packit 70b277
	      i_base = 2;
Packit 70b277
	      rt_warn ("ibase too small, set to 2");
Packit 70b277
	    }
Packit 70b277
	  else
Packit 70b277
	    if (temp > 16 || toobig)
Packit 70b277
	      {
Packit 70b277
	        if (std_only)
Packit 70b277
                  {
Packit 70b277
		    i_base = 16;  
Packit 70b277
		    rt_warn ("ibase too large, set to 16");
Packit 70b277
                  } 
Packit 70b277
                else if (temp > 36 || toobig) 
Packit 70b277
                  {
Packit 70b277
		    i_base = 36;
Packit 70b277
		    rt_warn ("ibase too large, set to 36");
Packit 70b277
                  }
Packit 70b277
                else
Packit 70b277
                  { 
Packit 70b277
                     if (temp >= 16 && warn_not_std)
Packit 70b277
                       rt_warn ("ibase larger than 16 is non-standard");
Packit 70b277
		     i_base = temp;
Packit 70b277
                  }
Packit 70b277
	      }
Packit 70b277
	    else
Packit 70b277
	      i_base = (int) temp;
Packit 70b277
	  break;
Packit 70b277
Packit 70b277
	case 1:
Packit 70b277
	  if (temp < 2 && !toobig)
Packit 70b277
	    {
Packit 70b277
	      o_base = 2;
Packit 70b277
	      rt_warn ("obase too small, set to 2");
Packit 70b277
	    }
Packit 70b277
	  else
Packit 70b277
	    if (temp > BC_BASE_MAX || toobig)
Packit 70b277
	      {
Packit 70b277
		o_base = BC_BASE_MAX;
Packit 70b277
		rt_warn ("obase too large, set to %d", BC_BASE_MAX);
Packit 70b277
	      }
Packit 70b277
	    else
Packit 70b277
	      o_base = (int) temp;
Packit 70b277
	  break;
Packit 70b277
Packit 70b277
	case 2:
Packit 70b277
	  /*  WARNING:  The following if statement may generate a compiler
Packit 70b277
	      warning if INT_MAX == LONG_MAX.  This is NOT a problem. */
Packit 70b277
	  if (temp > BC_SCALE_MAX || toobig )
Packit 70b277
	    {
Packit 70b277
	      scale = BC_SCALE_MAX;
Packit 70b277
	      rt_warn ("scale too large, set to %d", BC_SCALE_MAX);
Packit 70b277
	    }
Packit 70b277
	  else
Packit 70b277
	    scale = (int) temp;
Packit 70b277
	  break;
Packit 70b277
Packit 70b277
#if defined(READLINE) || defined(LIBEDIT)
Packit 70b277
	case 3:
Packit 70b277
	  if (toobig)
Packit 70b277
	    {
Packit 70b277
	      temp = -1;
Packit 70b277
	      rt_warn ("history too large, set to unlimited");
Packit 70b277
	      UNLIMIT_HISTORY;
Packit 70b277
	    }
Packit 70b277
	  else
Packit 70b277
	    {
Packit 70b277
	      n_history = temp;
Packit 70b277
	      if (temp < 0)
Packit 70b277
		UNLIMIT_HISTORY;
Packit 70b277
	      else
Packit 70b277
		HISTORY_SIZE(n_history);
Packit 70b277
	    }
Packit 70b277
#endif
Packit 70b277
	}
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Store the top of the execution stack into array VAR_NAME. 
Packit 70b277
   VAR_NAME is the name of an array, and the next to the top
Packit 70b277
   of stack for the index into the array. */
Packit 70b277
Packit 70b277
void
Packit 70b277
store_array (int var_name)
Packit 70b277
{
Packit 70b277
  bc_num *num_ptr;
Packit 70b277
  long idx;
Packit 70b277
Packit 70b277
  if (!check_stack(2)) return;
Packit 70b277
  idx = bc_num2long (ex_stack->s_next->s_num);
Packit 70b277
  if (idx < 0 || idx > BC_DIM_MAX ||
Packit 70b277
      (idx == 0 && !bc_is_zero(ex_stack->s_next->s_num))) 
Packit 70b277
    rt_error ("Array %s subscript out of bounds.", a_names[var_name]);
Packit 70b277
  else
Packit 70b277
    {
Packit 70b277
      num_ptr = get_array_num (var_name, idx);
Packit 70b277
      if (num_ptr != NULL)
Packit 70b277
	{
Packit 70b277
	  bc_free_num (num_ptr);
Packit 70b277
	  *num_ptr = bc_copy_num (ex_stack->s_num);
Packit 70b277
	  bc_free_num (&ex_stack->s_next->s_num);
Packit 70b277
	  ex_stack->s_next->s_num = ex_stack->s_num;
Packit 70b277
	  bc_init_num (&ex_stack->s_num);
Packit 70b277
	  pop();
Packit 70b277
	}
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/*  Load a copy of VAR_NAME on to the execution stack.  This includes
Packit 70b277
    the special variables ibase, obase and scale.  */
Packit 70b277
Packit 70b277
void
Packit 70b277
load_var (int var_name)
Packit 70b277
{
Packit 70b277
  bc_var *var_ptr;
Packit 70b277
Packit 70b277
  switch (var_name)
Packit 70b277
    {
Packit 70b277
Packit 70b277
    case 0:
Packit 70b277
      /* Special variable ibase. */
Packit 70b277
      push_copy (_zero_);
Packit 70b277
      bc_int2num (&ex_stack->s_num, i_base);
Packit 70b277
      break;
Packit 70b277
Packit 70b277
    case 1:
Packit 70b277
      /* Special variable obase. */
Packit 70b277
      push_copy (_zero_);
Packit 70b277
      bc_int2num (&ex_stack->s_num, o_base);
Packit 70b277
      break;
Packit 70b277
Packit 70b277
    case 2:
Packit 70b277
      /* Special variable scale. */
Packit 70b277
      push_copy (_zero_);
Packit 70b277
      bc_int2num (&ex_stack->s_num, scale);
Packit 70b277
      break;
Packit 70b277
Packit 70b277
#if defined(READLINE) || defined(LIBEDIT)
Packit 70b277
    case 3:
Packit 70b277
      /* Special variable history. */
Packit 70b277
      push_copy (_zero_);
Packit 70b277
      bc_int2num (&ex_stack->s_num, n_history);
Packit 70b277
      break;
Packit 70b277
#endif
Packit 70b277
Packit 70b277
    default:
Packit 70b277
      /* It is a simple variable. */
Packit 70b277
      var_ptr = variables[var_name];
Packit 70b277
      if (var_ptr != NULL)
Packit 70b277
	push_copy (var_ptr->v_value);
Packit 70b277
      else
Packit 70b277
	push_copy (_zero_);
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/*  Load a copy of VAR_NAME on to the execution stack.  This includes
Packit 70b277
    the special variables ibase, obase and scale.  */
Packit 70b277
Packit 70b277
void
Packit 70b277
load_array (int var_name)
Packit 70b277
{
Packit 70b277
  bc_num *num_ptr;
Packit 70b277
  long   idx;
Packit 70b277
Packit 70b277
  if (!check_stack(1)) return;
Packit 70b277
  idx = bc_num2long (ex_stack->s_num);
Packit 70b277
  if (idx < 0 || idx > BC_DIM_MAX ||
Packit 70b277
     (idx == 0 && !bc_is_zero(ex_stack->s_num))) 
Packit 70b277
    rt_error ("Array %s subscript out of bounds.", a_names[var_name]);
Packit 70b277
  else
Packit 70b277
    {
Packit 70b277
      num_ptr = get_array_num (var_name, idx);
Packit 70b277
      if (num_ptr != NULL)
Packit 70b277
	{
Packit 70b277
	  pop();
Packit 70b277
	  push_copy (*num_ptr);
Packit 70b277
	}
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Decrement VAR_NAME by one.  This includes the special variables
Packit 70b277
   ibase, obase, and scale. */
Packit 70b277
Packit 70b277
void
Packit 70b277
decr_var (int var_name)
Packit 70b277
{
Packit 70b277
  bc_var *var_ptr;
Packit 70b277
Packit 70b277
  switch (var_name)
Packit 70b277
    {
Packit 70b277
Packit 70b277
    case 0: /* ibase */
Packit 70b277
      if (i_base > 2)
Packit 70b277
	i_base--;
Packit 70b277
      else
Packit 70b277
	rt_warn ("ibase too small in --");
Packit 70b277
      break;
Packit 70b277
      
Packit 70b277
    case 1: /* obase */
Packit 70b277
      if (o_base > 2)
Packit 70b277
	o_base--;
Packit 70b277
      else
Packit 70b277
	rt_warn ("obase too small in --");
Packit 70b277
      break;
Packit 70b277
Packit 70b277
    case 2: /* scale */
Packit 70b277
      if (scale > 0)
Packit 70b277
	scale--;
Packit 70b277
      else
Packit 70b277
	rt_warn ("scale can not be negative in -- ");
Packit 70b277
      break;
Packit 70b277
Packit 70b277
#if defined(READLINE) || defined(LIBEDIT)
Packit 70b277
    case 3: /* history */
Packit 70b277
      n_history--;
Packit 70b277
      if (n_history >= 0)
Packit 70b277
	HISTORY_SIZE(n_history);
Packit 70b277
      else
Packit 70b277
	{
Packit 70b277
	  n_history = -1;
Packit 70b277
	  rt_warn ("history is negative, set to unlimited");
Packit 70b277
	  UNLIMIT_HISTORY;
Packit 70b277
	}
Packit 70b277
      break;
Packit 70b277
#endif
Packit 70b277
Packit 70b277
    default: /* It is a simple variable. */
Packit 70b277
      var_ptr = get_var (var_name);
Packit 70b277
      if (var_ptr != NULL)
Packit 70b277
	bc_sub (var_ptr->v_value,_one_,&var_ptr->v_value, 0);
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Decrement VAR_NAME by one.  VAR_NAME is an array, and the top of
Packit 70b277
   the execution stack is the index and it is popped off the stack. */
Packit 70b277
Packit 70b277
void
Packit 70b277
decr_array (int var_name)
Packit 70b277
{
Packit 70b277
  bc_num *num_ptr;
Packit 70b277
  long   idx;
Packit 70b277
Packit 70b277
  /* It is an array variable. */
Packit 70b277
  if (!check_stack (1)) return;
Packit 70b277
  idx = bc_num2long (ex_stack->s_num);
Packit 70b277
  if (idx < 0 || idx > BC_DIM_MAX ||
Packit 70b277
     (idx == 0 && !bc_is_zero (ex_stack->s_num))) 
Packit 70b277
    rt_error ("Array %s subscript out of bounds.", a_names[var_name]);
Packit 70b277
  else
Packit 70b277
    {
Packit 70b277
      num_ptr = get_array_num (var_name, idx);
Packit 70b277
      if (num_ptr != NULL)
Packit 70b277
	{
Packit 70b277
	  pop ();
Packit 70b277
	  bc_sub (*num_ptr, _one_, num_ptr, 0);
Packit 70b277
	}
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Increment VAR_NAME by one.  This includes the special variables
Packit 70b277
   ibase, obase, and scale. */
Packit 70b277
Packit 70b277
void
Packit 70b277
incr_var (int var_name)
Packit 70b277
{
Packit 70b277
  bc_var *var_ptr;
Packit 70b277
Packit 70b277
  switch (var_name)
Packit 70b277
    {
Packit 70b277
Packit 70b277
    case 0: /* ibase */
Packit 70b277
      if (i_base < 16)
Packit 70b277
	i_base++;
Packit 70b277
      else
Packit 70b277
	rt_warn ("ibase too big in ++");
Packit 70b277
      break;
Packit 70b277
Packit 70b277
    case 1: /* obase */
Packit 70b277
      if (o_base < BC_BASE_MAX)
Packit 70b277
	o_base++;
Packit 70b277
      else
Packit 70b277
	rt_warn ("obase too big in ++");
Packit 70b277
      break;
Packit 70b277
Packit 70b277
    case 2:
Packit 70b277
      if (scale < BC_SCALE_MAX)
Packit 70b277
	scale++;
Packit 70b277
      else
Packit 70b277
	rt_warn ("Scale too big in ++");
Packit 70b277
      break;
Packit 70b277
Packit 70b277
#if defined(READLINE) || defined(LIBEDIT)
Packit 70b277
    case 3: /* history */
Packit 70b277
      n_history++;
Packit 70b277
      if (n_history > 0)
Packit 70b277
	HISTORY_SIZE(n_history);
Packit 70b277
      else
Packit 70b277
	{
Packit 70b277
	  n_history = -1;
Packit 70b277
	  rt_warn ("history set to unlimited");
Packit 70b277
	  UNLIMIT_HISTORY;
Packit 70b277
	}
Packit 70b277
      break;	
Packit 70b277
#endif
Packit 70b277
Packit 70b277
    default:  /* It is a simple variable. */
Packit 70b277
      var_ptr = get_var (var_name);
Packit 70b277
      if (var_ptr != NULL)
Packit 70b277
	bc_add (var_ptr->v_value, _one_, &var_ptr->v_value, 0);
Packit 70b277
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Increment VAR_NAME by one.  VAR_NAME is an array and top of
Packit 70b277
   execution stack is the index and is popped off the stack. */
Packit 70b277
Packit 70b277
void
Packit 70b277
incr_array (int var_name)
Packit 70b277
{
Packit 70b277
  bc_num *num_ptr;
Packit 70b277
  long   idx;
Packit 70b277
Packit 70b277
  if (!check_stack (1)) return;
Packit 70b277
  idx = bc_num2long (ex_stack->s_num);
Packit 70b277
  if (idx < 0 || idx > BC_DIM_MAX ||
Packit 70b277
      (idx == 0 && !bc_is_zero (ex_stack->s_num))) 
Packit 70b277
    rt_error ("Array %s subscript out of bounds.", a_names[var_name]);
Packit 70b277
  else
Packit 70b277
    {
Packit 70b277
      num_ptr = get_array_num (var_name, idx);
Packit 70b277
      if (num_ptr != NULL)
Packit 70b277
	{
Packit 70b277
	  pop ();
Packit 70b277
	  bc_add (*num_ptr, _one_, num_ptr, 0);
Packit 70b277
	}
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Routines for processing autos variables and parameters. */
Packit 70b277
Packit 70b277
/* NAME is an auto variable that needs to be pushed on its stack. */
Packit 70b277
Packit 70b277
void
Packit 70b277
auto_var (int name)
Packit 70b277
{
Packit 70b277
  bc_var *v_temp;
Packit 70b277
  bc_var_array *a_temp;
Packit 70b277
  int ix;
Packit 70b277
Packit 70b277
  if (name > 0)
Packit 70b277
    {
Packit 70b277
      /* A simple variable. */
Packit 70b277
      ix = name;
Packit 70b277
      v_temp = bc_malloc (sizeof (bc_var));
Packit 70b277
      v_temp->v_next = variables[ix];
Packit 70b277
      bc_init_num (&v_temp->v_value);
Packit 70b277
      variables[ix] = v_temp;
Packit 70b277
    }
Packit 70b277
  else
Packit 70b277
    {
Packit 70b277
      /* An array variable. */
Packit 70b277
      ix = -name;
Packit 70b277
      a_temp = bc_malloc (sizeof (bc_var_array));
Packit 70b277
      a_temp->a_next = arrays[ix];
Packit 70b277
      a_temp->a_value = NULL;
Packit 70b277
      a_temp->a_param = FALSE;
Packit 70b277
      arrays[ix] = a_temp;
Packit 70b277
    } 
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* Free_a_tree frees everything associated with an array variable tree.
Packit 70b277
   This is used when popping an array variable off its auto stack.  */
Packit 70b277
Packit 70b277
void
Packit 70b277
free_a_tree (bc_array_node *root, int depth)
Packit 70b277
{
Packit 70b277
  int ix;
Packit 70b277
Packit 70b277
  if (root != NULL)
Packit 70b277
    {
Packit 70b277
      if (depth > 1)
Packit 70b277
	for (ix = 0; ix < NODE_SIZE; ix++)
Packit 70b277
	  free_a_tree (root->n_items.n_down[ix], depth-1);
Packit 70b277
      else
Packit 70b277
	for (ix = 0; ix < NODE_SIZE; ix++)
Packit 70b277
	  bc_free_num ( &(root->n_items.n_num[ix]));
Packit 70b277
      free (root);
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* LIST is an NULL terminated list of varible names that need to be
Packit 70b277
   popped off their auto stacks. */
Packit 70b277
Packit 70b277
void
Packit 70b277
pop_vars (arg_list *list)
Packit 70b277
{
Packit 70b277
  bc_var *v_temp;
Packit 70b277
  bc_var_array *a_temp;
Packit 70b277
  int    ix;
Packit 70b277
Packit 70b277
  while (list != NULL)
Packit 70b277
    {
Packit 70b277
      ix = list->av_name;
Packit 70b277
      if (ix > 0)
Packit 70b277
	{
Packit 70b277
	  /* A simple variable. */
Packit 70b277
	  v_temp = variables[ix];
Packit 70b277
	  if (v_temp != NULL)
Packit 70b277
	    {
Packit 70b277
	      variables[ix] = v_temp->v_next;
Packit 70b277
	      bc_free_num (&v_temp->v_value);
Packit 70b277
	      free (v_temp);
Packit 70b277
	    }
Packit 70b277
	}
Packit 70b277
      else
Packit 70b277
	{
Packit 70b277
	  /* An array variable. */
Packit 70b277
	  ix = -ix;
Packit 70b277
	  a_temp = arrays[ix];
Packit 70b277
	  if (a_temp != NULL)
Packit 70b277
	    {
Packit 70b277
	      arrays[ix] = a_temp->a_next;
Packit 70b277
	      if (!a_temp->a_param && a_temp->a_value != NULL)
Packit 70b277
		{
Packit 70b277
		  free_a_tree (a_temp->a_value->a_tree,
Packit 70b277
			       a_temp->a_value->a_depth);
Packit 70b277
		  free (a_temp->a_value);
Packit 70b277
		}
Packit 70b277
	      free (a_temp);
Packit 70b277
	    }
Packit 70b277
	} 
Packit 70b277
      list = list->next;
Packit 70b277
    }
Packit 70b277
}
Packit 70b277
Packit 70b277
/* COPY_NODE: Copies an array node for a call by value parameter. */
Packit 70b277
static bc_array_node *
Packit 70b277
copy_tree (bc_array_node *ary_node, int depth)
Packit 70b277
{
Packit 70b277
  bc_array_node *res = bc_malloc (sizeof(bc_array_node));
Packit 70b277
  int i;
Packit 70b277
Packit 70b277
  if (depth > 1)
Packit 70b277
    for (i=0; i
Packit 70b277
      if (ary_node->n_items.n_down[i] != NULL)
Packit 70b277
	res->n_items.n_down[i] =
Packit 70b277
	  copy_tree (ary_node->n_items.n_down[i], depth - 1);
Packit 70b277
      else
Packit 70b277
	res->n_items.n_down[i] = NULL;
Packit 70b277
  else
Packit 70b277
    for (i=0; i
Packit 70b277
      if (ary_node->n_items.n_num[i] != NULL)
Packit 70b277
	res->n_items.n_num[i] = bc_copy_num (ary_node->n_items.n_num[i]);
Packit 70b277
      else
Packit 70b277
	res->n_items.n_num[i] = NULL;
Packit 70b277
  return res;
Packit 70b277
}
Packit 70b277
Packit 70b277
/* COPY_ARRAY: Copies an array for a call by value array parameter. 
Packit 70b277
   ARY is the pointer to the bc_array structure. */
Packit 70b277
Packit 70b277
static bc_array *
Packit 70b277
copy_array (bc_array *ary)
Packit 70b277
{
Packit 70b277
  bc_array *res = bc_malloc (sizeof(bc_array));
Packit 70b277
  res->a_depth = ary->a_depth;
Packit 70b277
  res->a_tree = copy_tree (ary->a_tree, ary->a_depth);
Packit 70b277
  return (res);
Packit 70b277
}
Packit 70b277
Packit 70b277
Packit 70b277
/* A call is being made to FUNC.  The call types are at PC.  Process
Packit 70b277
   the parameters by doing an auto on the parameter variable and then
Packit 70b277
   store the value at the new variable or put a pointer the the array
Packit 70b277
   variable. */
Packit 70b277
Packit 70b277
void
Packit 70b277
process_params (program_counter *progctr, int func)
Packit 70b277
{
Packit 70b277
  char ch;
Packit 70b277
  arg_list *params;
Packit 70b277
  int ix, ix1;
Packit 70b277
  bc_var *v_temp;
Packit 70b277
  bc_var_array *a_src, *a_dest;
Packit 70b277
  
Packit 70b277
  /* Get the parameter names from the function. */
Packit 70b277
  params = functions[func].f_params;
Packit 70b277
Packit 70b277
  while ((ch = byte(progctr)) != ':')
Packit 70b277
    {
Packit 70b277
      if (params != NULL)
Packit 70b277
	{
Packit 70b277
	  if ((ch == '0') && params->av_name > 0)
Packit 70b277
	    {
Packit 70b277
	      /* A simple variable. */
Packit 70b277
	      ix = params->av_name;
Packit 70b277
	      v_temp = bc_malloc (sizeof(bc_var));
Packit 70b277
	      v_temp->v_next = variables[ix];
Packit 70b277
	      v_temp->v_value = ex_stack->s_num;
Packit 70b277
	      bc_init_num (&ex_stack->s_num);
Packit 70b277
	      variables[ix] = v_temp;
Packit 70b277
	    }
Packit 70b277
	  else
Packit 70b277
	    if ((ch == '1') && (params->av_name < 0))
Packit 70b277
	      {
Packit 70b277
		/* The variables is an array variable. */
Packit 70b277
	
Packit 70b277
		/* Compute source index and make sure some structure exists. */
Packit 70b277
		ix = (int) bc_num2long (ex_stack->s_num);
Packit 70b277
		(void) get_array_num (ix, 0);    
Packit 70b277
	
Packit 70b277
		/* Push a new array and Compute Destination index */
Packit 70b277
		auto_var (params->av_name);  
Packit 70b277
		ix1 = -params->av_name;
Packit 70b277
Packit 70b277
		/* Set up the correct pointers in the structure. */
Packit 70b277
		if (ix == ix1) 
Packit 70b277
		  a_src = arrays[ix]->a_next;
Packit 70b277
		else
Packit 70b277
		  a_src = arrays[ix];
Packit 70b277
		a_dest = arrays[ix1];
Packit 70b277
		if (params->arg_is_var)
Packit 70b277
		  {
Packit 70b277
		    a_dest->a_param = TRUE;
Packit 70b277
		    a_dest->a_value = a_src->a_value;
Packit 70b277
		  }
Packit 70b277
		else
Packit 70b277
		  {
Packit 70b277
		    a_dest->a_param = FALSE;
Packit 70b277
		    a_dest->a_value = copy_array (a_src->a_value);
Packit 70b277
		  }
Packit 70b277
	      }
Packit 70b277
	    else
Packit 70b277
	      {
Packit 70b277
		if (params->av_name < 0)
Packit 70b277
		  rt_error ("Parameter type mismatch parameter %s.",
Packit 70b277
			    a_names[-params->av_name]);
Packit 70b277
		else
Packit 70b277
		  rt_error ("Parameter type mismatch, parameter %s.",
Packit 70b277
			    v_names[params->av_name]);
Packit 70b277
		params++;
Packit 70b277
	      }
Packit 70b277
	  pop ();
Packit 70b277
	}
Packit 70b277
      else
Packit 70b277
	{
Packit 70b277
	    rt_error ("Parameter number mismatch");
Packit 70b277
	    return;
Packit 70b277
	}
Packit 70b277
      params = params->next;
Packit 70b277
    }
Packit 70b277
  if (params != NULL) 
Packit 70b277
    rt_error ("Parameter number mismatch");
Packit 70b277
}