"Fossies" - the Fresh Open Source Software Archive

Member "bc-1.06.95/bc/storage.c" (5 Sep 2006, 22869 Bytes) of package /linux/misc/old/bc-1.06.95.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "storage.c" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 1.06.95_vs_1.07.

    1 /*  This file is part of GNU bc.
    2 
    3     Copyright (C) 1991-1994, 1997, 2006 Free Software Foundation, Inc.
    4 
    5     This program is free software; you can redistribute it and/or modify
    6     it under the terms of the GNU General Public License as published by
    7     the Free Software Foundation; either version 2 of the License , or
    8     (at your option) any later version.
    9 
   10     This program is distributed in the hope that it will be useful,
   11     but WITHOUT ANY WARRANTY; without even the implied warranty of
   12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   13     GNU General Public License for more details.
   14 
   15     You should have received a copy of the GNU General Public License
   16     along with this program; see the file COPYING.  If not, write to:
   17       The Free Software Foundation, Inc.
   18       Foundation, Inc.  51 Franklin Street, Fifth Floor,
   19       Boston, MA 02110-1301  USA
   20 
   21     You may contact the author by:
   22        e-mail:  philnelson@acm.org
   23       us-mail:  Philip A. Nelson
   24                 Computer Science Department, 9062
   25                 Western Washington University
   26                 Bellingham, WA 98226-9062
   27        
   28 *************************************************************************/
   29 
   30 /* storage.c:  Code and data storage manipulations.  This includes labels. */
   31 
   32 #include "bcdefs.h"
   33 #include "proto.h"
   34 
   35 
   36 /* Initialize the storage at the beginning of the run. */
   37 
   38 void
   39 init_storage ()
   40 {
   41 
   42   /* Functions: we start with none and ask for more. */
   43   f_count = 0;
   44   more_functions ();
   45   f_names[0] = (char *)"(main)";
   46 
   47   /* Variables. */
   48   v_count = 0;
   49   more_variables ();
   50   
   51   /* Arrays. */
   52   a_count = 0;
   53   more_arrays ();
   54 
   55   /* Other things... */
   56   ex_stack = NULL;
   57   fn_stack = NULL;
   58   i_base = 10;
   59   o_base = 10;
   60   scale  = 0;
   61 #if defined(READLINE) || defined(LIBEDIT)
   62   n_history = -1;   
   63 #endif
   64   c_code = FALSE;
   65   bc_init_numbers();
   66 }
   67 
   68 /* Three functions for increasing the number of functions, variables, or
   69    arrays that are needed.  This adds another 32 of the requested object. */
   70 
   71 void
   72 more_functions (VOID)
   73 {
   74   int old_count;
   75   int indx;
   76   bc_function *old_f;
   77   bc_function *f;
   78   char **old_names;
   79 
   80   /* Save old information. */
   81   old_count = f_count;
   82   old_f = functions;
   83   old_names = f_names;
   84 
   85   /* Add a fixed amount and allocate new space. */
   86   f_count += STORE_INCR;
   87   functions = (bc_function *) bc_malloc (f_count*sizeof (bc_function));
   88   f_names = (char **) bc_malloc (f_count*sizeof (char *));
   89 
   90   /* Copy old ones. */
   91   for (indx = 0; indx < old_count; indx++)
   92     {
   93       functions[indx] = old_f[indx];
   94       f_names[indx] = old_names[indx];
   95     }
   96 
   97   /* Initialize the new ones. */
   98   for (; indx < f_count; indx++)
   99     {
  100       f = &functions[indx];
  101       f->f_defined = FALSE;
  102       f->f_body = (char *) bc_malloc (BC_START_SIZE);
  103       f->f_body_size = BC_START_SIZE;
  104       f->f_code_size = 0;
  105       f->f_label = NULL;
  106       f->f_autos = NULL;
  107       f->f_params = NULL;
  108     }
  109 
  110   /* Free the old elements. */
  111   if (old_count != 0)
  112     {
  113       free (old_f);
  114       free (old_names);
  115     }
  116 }
  117 
  118 void
  119 more_variables ()
  120 {
  121   int indx;
  122   int old_count;
  123   bc_var **old_var;
  124   char **old_names;
  125 
  126   /* Save the old values. */
  127   old_count = v_count;
  128   old_var = variables;
  129   old_names = v_names;
  130 
  131   /* Increment by a fixed amount and allocate. */
  132   v_count += STORE_INCR;
  133   variables = (bc_var **) bc_malloc (v_count*sizeof(bc_var *));
  134   v_names = (char **) bc_malloc (v_count*sizeof(char *));
  135 
  136   /* Copy the old variables. */
  137   for (indx = 3; indx < old_count; indx++)
  138     {
  139       variables[indx] = old_var[indx];
  140       v_names[indx] = old_names[indx];
  141     }
  142 
  143   /* Initialize the new elements. */
  144   for (; indx < v_count; indx++)
  145     variables[indx] = NULL;
  146 
  147   /* Free the old elements. */
  148   if (old_count != 0)
  149     {
  150       free (old_var);
  151       free (old_names);
  152     }
  153 }
  154 
  155 void
  156 more_arrays ()
  157 {
  158   int indx;
  159   int old_count;
  160   bc_var_array **old_ary;
  161   char **old_names;
  162 
  163   /* Save the old values. */
  164   old_count = a_count;
  165   old_ary = arrays;
  166   old_names = a_names;
  167 
  168   /* Increment by a fixed amount and allocate. */
  169   a_count += STORE_INCR;
  170   arrays = (bc_var_array **) bc_malloc (a_count*sizeof(bc_var_array *));
  171   a_names = (char **) bc_malloc (a_count*sizeof(char *));
  172 
  173   /* Copy the old arrays. */
  174   for (indx = 1; indx < old_count; indx++)
  175     {
  176       arrays[indx] = old_ary[indx];
  177       a_names[indx] = old_names[indx];
  178     }
  179 
  180 
  181   /* Initialize the new elements. */
  182   for (; indx < v_count; indx++)
  183     arrays[indx] = NULL;
  184 
  185   /* Free the old elements. */
  186   if (old_count != 0)
  187     {
  188       free (old_ary);
  189       free (old_names);
  190     }
  191 }
  192 
  193 
  194 /* clear_func clears out function FUNC and makes it ready to redefine. */
  195 
  196 void
  197 clear_func (func)
  198      int func;
  199 {
  200   bc_function *f;
  201   bc_label_group *lg;
  202 
  203   /* Set the pointer to the function. */
  204   f = &functions[func];
  205   f->f_defined = FALSE;
  206   /* XXX restore f_body to initial size??? */
  207   f->f_code_size = 0;
  208   if (f->f_autos != NULL)
  209     {
  210       free_args (f->f_autos);
  211       f->f_autos = NULL;
  212     }
  213   if (f->f_params != NULL)
  214     {
  215       free_args (f->f_params);
  216       f->f_params = NULL;
  217     }
  218   while (f->f_label != NULL)
  219     {
  220       lg = f->f_label->l_next;
  221       free (f->f_label);
  222       f->f_label = lg;
  223     }
  224 }
  225 
  226 
  227 /*  Pop the function execution stack and return the top. */
  228 
  229 int
  230 fpop()
  231 {
  232   fstack_rec *temp;
  233   int retval;
  234   
  235   if (fn_stack != NULL)
  236     {
  237       temp = fn_stack;
  238       fn_stack = temp->s_next;
  239       retval = temp->s_val;
  240       free (temp);
  241     }
  242   else
  243     {
  244       retval = 0;
  245       rt_error ("function stack underflow, contact maintainer.");
  246     }
  247   return (retval);
  248 }
  249 
  250 
  251 /* Push VAL on to the function stack. */
  252 
  253 void
  254 fpush (val)
  255      int val;
  256 {
  257   fstack_rec *temp;
  258   
  259   temp = (fstack_rec *) bc_malloc (sizeof (fstack_rec));
  260   temp->s_next = fn_stack;
  261   temp->s_val = val;
  262   fn_stack = temp;
  263 }
  264 
  265 
  266 /* Pop and discard the top element of the regular execution stack. */
  267 
  268 void
  269 pop ()
  270 {
  271   estack_rec *temp;
  272   
  273   if (ex_stack != NULL)
  274     {
  275       temp = ex_stack;
  276       ex_stack = temp->s_next;
  277       bc_free_num (&temp->s_num);
  278       free (temp);
  279     }
  280 }
  281 
  282 
  283 /* Push a copy of NUM on to the regular execution stack. */
  284 
  285 void
  286 push_copy (num)
  287      bc_num num;
  288 {
  289   estack_rec *temp;
  290 
  291   temp = (estack_rec *) bc_malloc (sizeof (estack_rec));
  292   temp->s_num = bc_copy_num (num);
  293   temp->s_next = ex_stack;
  294   ex_stack = temp;
  295 }
  296 
  297 
  298 /* Push NUM on to the regular execution stack.  Do NOT push a copy. */
  299 
  300 void
  301 push_num (num)
  302      bc_num num;
  303 {
  304   estack_rec *temp;
  305 
  306   temp = (estack_rec *) bc_malloc (sizeof (estack_rec));
  307   temp->s_num = num;
  308   temp->s_next = ex_stack;
  309   ex_stack = temp;
  310 }
  311 
  312 
  313 /* Make sure the ex_stack has at least DEPTH elements on it.
  314    Return TRUE if it has at least DEPTH elements, otherwise
  315    return FALSE. */
  316 
  317 char
  318 check_stack (depth)
  319      int depth;
  320 {
  321   estack_rec *temp;
  322 
  323   temp = ex_stack;
  324   while ((temp != NULL) && (depth > 0))
  325     {
  326       temp = temp->s_next;
  327       depth--;
  328     }
  329   if (depth > 0)
  330     {
  331       rt_error ("Stack error.");
  332       return FALSE;
  333     }
  334   return TRUE;
  335 }
  336 
  337 
  338 /* The following routines manipulate simple variables and
  339    array variables. */
  340 
  341 /* get_var returns a pointer to the variable VAR_NAME.  If one does not
  342    exist, one is created. */
  343 
  344 bc_var *
  345 get_var (var_name)
  346      int var_name;
  347 {
  348   bc_var *var_ptr;
  349 
  350   var_ptr = variables[var_name];
  351   if (var_ptr == NULL)
  352     {
  353       var_ptr = variables[var_name] = (bc_var *) bc_malloc (sizeof (bc_var));
  354       bc_init_num (&var_ptr->v_value);
  355     }
  356   return var_ptr;
  357 }
  358 
  359 
  360 /* get_array_num returns the address of the bc_num in the array
  361    structure.  If more structure is requried to get to the index,
  362    this routine does the work to create that structure. VAR_INDEX
  363    is a zero based index into the arrays storage array. INDEX is
  364    the index into the bc array. */
  365 
  366 bc_num *
  367 get_array_num (var_index, idx)
  368      int var_index;
  369      long  idx;
  370 {
  371   bc_var_array *ary_ptr;
  372   bc_array *a_var;
  373   bc_array_node *temp;
  374   int log, ix, ix1;
  375   int sub [NODE_DEPTH];
  376 
  377   /* Get the array entry. */
  378   ary_ptr = arrays[var_index];
  379   if (ary_ptr == NULL)
  380     {
  381       ary_ptr = arrays[var_index] =
  382     (bc_var_array *) bc_malloc (sizeof (bc_var_array));
  383       ary_ptr->a_value = NULL;
  384       ary_ptr->a_next = NULL;
  385       ary_ptr->a_param = FALSE;
  386     }
  387 
  388   a_var = ary_ptr->a_value;
  389   if (a_var == NULL) {
  390     a_var = ary_ptr->a_value = (bc_array *) bc_malloc (sizeof (bc_array));
  391     a_var->a_tree = NULL;
  392     a_var->a_depth = 0;
  393   }
  394 
  395   /* Get the index variable. */
  396   sub[0] = idx & NODE_MASK;
  397   ix = idx >> NODE_SHIFT;
  398   log = 1;
  399   while (ix > 0 || log < a_var->a_depth)
  400     {
  401       sub[log] = ix & NODE_MASK;
  402       ix >>= NODE_SHIFT;
  403       log++;
  404     }
  405   
  406   /* Build any tree that is necessary. */
  407   while (log > a_var->a_depth)
  408     {
  409       temp = (bc_array_node *) bc_malloc (sizeof(bc_array_node));
  410       if (a_var->a_depth != 0)
  411     {
  412       temp->n_items.n_down[0] = a_var->a_tree;
  413       for (ix=1; ix < NODE_SIZE; ix++)
  414         temp->n_items.n_down[ix] = NULL;
  415     }
  416       else
  417     {
  418       for (ix=0; ix < NODE_SIZE; ix++)
  419         temp->n_items.n_num[ix] = bc_copy_num(_zero_);
  420     }
  421       a_var->a_tree = temp;
  422       a_var->a_depth++;
  423     }
  424   
  425   /* Find the indexed variable. */
  426   temp = a_var->a_tree;
  427   while ( log-- > 1)
  428     {
  429       ix1 = sub[log];
  430       if (temp->n_items.n_down[ix1] == NULL)
  431     {
  432       temp->n_items.n_down[ix1] =
  433         (bc_array_node *) bc_malloc (sizeof(bc_array_node));
  434       temp = temp->n_items.n_down[ix1];
  435       if (log > 1)
  436         for (ix=0; ix < NODE_SIZE; ix++)
  437           temp->n_items.n_down[ix] = NULL;
  438       else
  439         for (ix=0; ix < NODE_SIZE; ix++)
  440           temp->n_items.n_num[ix] = bc_copy_num(_zero_);
  441     }
  442       else
  443     temp = temp->n_items.n_down[ix1];
  444     }
  445   
  446   /* Return the address of the indexed variable. */
  447   return &(temp->n_items.n_num[sub[0]]);
  448 }
  449 
  450 
  451 /* Store the top of the execution stack into VAR_NAME.  
  452    This includes the special variables ibase, obase, and scale. */
  453 
  454 void
  455 store_var (var_name)
  456      int var_name;
  457 {
  458   bc_var *var_ptr;
  459   long temp;
  460   char toobig;
  461 
  462   if (var_name > 3)
  463     {
  464       /* It is a simple variable. */
  465       var_ptr = get_var (var_name);
  466       if (var_ptr != NULL)
  467     {
  468       bc_free_num(&var_ptr->v_value);
  469       var_ptr->v_value = bc_copy_num (ex_stack->s_num);
  470     }
  471     }
  472   else
  473     {
  474       /* It is a special variable... */
  475       toobig = FALSE;
  476       temp = 0;
  477       if (bc_is_neg (ex_stack->s_num))
  478     {
  479       switch (var_name)
  480         {
  481         case 0:
  482           rt_warn ("negative ibase, set to 2");
  483           temp = 2;
  484           break;
  485         case 1:
  486           rt_warn ("negative obase, set to 2");
  487           temp = 2;
  488           break;
  489         case 2:
  490           rt_warn ("negative scale, set to 0");
  491           temp = 0;
  492           break;
  493 #if defined(READLINE) || defined(LIBEDIT)
  494         case 3:
  495           temp = -1;
  496           break;
  497 #endif
  498         }
  499     }
  500       else
  501     {
  502       temp = bc_num2long (ex_stack->s_num);
  503       if (!bc_is_zero (ex_stack->s_num) && temp == 0)
  504         toobig = TRUE;
  505     }
  506       switch (var_name)
  507     {
  508     case 0:
  509       if (temp < 2 && !toobig)
  510         {
  511           i_base = 2;
  512           rt_warn ("ibase too small, set to 2");
  513         }
  514       else
  515         if (temp > 16 || toobig)
  516           {
  517         i_base = 16;
  518         rt_warn ("ibase too large, set to 16");
  519           }
  520         else
  521           i_base = (int) temp;
  522       break;
  523 
  524     case 1:
  525       if (temp < 2 && !toobig)
  526         {
  527           o_base = 2;
  528           rt_warn ("obase too small, set to 2");
  529         }
  530       else
  531         if (temp > BC_BASE_MAX || toobig)
  532           {
  533         o_base = BC_BASE_MAX;
  534         rt_warn ("obase too large, set to %d", BC_BASE_MAX);
  535           }
  536         else
  537           o_base = (int) temp;
  538       break;
  539 
  540     case 2:
  541       /*  WARNING:  The following if statement may generate a compiler
  542           warning if INT_MAX == LONG_MAX.  This is NOT a problem. */
  543       if (temp > BC_SCALE_MAX || toobig )
  544         {
  545           scale = BC_SCALE_MAX;
  546           rt_warn ("scale too large, set to %d", BC_SCALE_MAX);
  547         }
  548       else
  549         scale = (int) temp;
  550       break;
  551 
  552 #if defined(READLINE) || defined(LIBEDIT)
  553     case 3:
  554       if (toobig)
  555         {
  556           temp = -1;
  557           rt_warn ("history too large, set to unlimited");
  558           UNLIMIT_HISTORY;
  559         }
  560       else
  561         {
  562           n_history = temp;
  563           if (temp < 0)
  564         UNLIMIT_HISTORY;
  565           else
  566         HISTORY_SIZE(n_history);
  567         }
  568 #endif
  569     }
  570     }
  571 }
  572 
  573 
  574 /* Store the top of the execution stack into array VAR_NAME. 
  575    VAR_NAME is the name of an array, and the next to the top
  576    of stack for the index into the array. */
  577 
  578 void
  579 store_array (var_name)
  580      int var_name;
  581 {
  582   bc_num *num_ptr;
  583   long idx;
  584 
  585   if (!check_stack(2)) return;
  586   idx = bc_num2long (ex_stack->s_next->s_num);
  587   if (idx < 0 || idx > BC_DIM_MAX ||
  588       (idx == 0 && !bc_is_zero(ex_stack->s_next->s_num))) 
  589     rt_error ("Array %s subscript out of bounds.", a_names[var_name]);
  590   else
  591     {
  592       num_ptr = get_array_num (var_name, idx);
  593       if (num_ptr != NULL)
  594     {
  595       bc_free_num (num_ptr);
  596       *num_ptr = bc_copy_num (ex_stack->s_num);
  597       bc_free_num (&ex_stack->s_next->s_num);
  598       ex_stack->s_next->s_num = ex_stack->s_num;
  599       bc_init_num (&ex_stack->s_num);
  600       pop();
  601     }
  602     }
  603 }
  604 
  605 
  606 /*  Load a copy of VAR_NAME on to the execution stack.  This includes
  607     the special variables ibase, obase and scale.  */
  608 
  609 void
  610 load_var (var_name)
  611      int var_name;
  612 {
  613   bc_var *var_ptr;
  614 
  615   switch (var_name)
  616     {
  617 
  618     case 0:
  619       /* Special variable ibase. */
  620       push_copy (_zero_);
  621       bc_int2num (&ex_stack->s_num, i_base);
  622       break;
  623 
  624     case 1:
  625       /* Special variable obase. */
  626       push_copy (_zero_);
  627       bc_int2num (&ex_stack->s_num, o_base);
  628       break;
  629 
  630     case 2:
  631       /* Special variable scale. */
  632       push_copy (_zero_);
  633       bc_int2num (&ex_stack->s_num, scale);
  634       break;
  635 
  636 #if defined(READLINE) || defined(LIBEDIT)
  637     case 3:
  638       /* Special variable history. */
  639       push_copy (_zero_);
  640       bc_int2num (&ex_stack->s_num, n_history);
  641       break;
  642 #endif
  643 
  644     default:
  645       /* It is a simple variable. */
  646       var_ptr = variables[var_name];
  647       if (var_ptr != NULL)
  648     push_copy (var_ptr->v_value);
  649       else
  650     push_copy (_zero_);
  651     }
  652 }
  653 
  654 
  655 /*  Load a copy of VAR_NAME on to the execution stack.  This includes
  656     the special variables ibase, obase and scale.  */
  657 
  658 void
  659 load_array (var_name)
  660      int var_name;
  661 {
  662   bc_num *num_ptr;
  663   long   idx;
  664 
  665   if (!check_stack(1)) return;
  666   idx = bc_num2long (ex_stack->s_num);
  667   if (idx < 0 || idx > BC_DIM_MAX ||
  668      (idx == 0 && !bc_is_zero(ex_stack->s_num))) 
  669     rt_error ("Array %s subscript out of bounds.", a_names[var_name]);
  670   else
  671     {
  672       num_ptr = get_array_num (var_name, idx);
  673       if (num_ptr != NULL)
  674     {
  675       pop();
  676       push_copy (*num_ptr);
  677     }
  678     }
  679 }
  680 
  681 
  682 /* Decrement VAR_NAME by one.  This includes the special variables
  683    ibase, obase, and scale. */
  684 
  685 void
  686 decr_var (var_name)
  687      int var_name;
  688 {
  689   bc_var *var_ptr;
  690 
  691   switch (var_name)
  692     {
  693 
  694     case 0: /* ibase */
  695       if (i_base > 2)
  696     i_base--;
  697       else
  698     rt_warn ("ibase too small in --");
  699       break;
  700       
  701     case 1: /* obase */
  702       if (o_base > 2)
  703     o_base--;
  704       else
  705     rt_warn ("obase too small in --");
  706       break;
  707 
  708     case 2: /* scale */
  709       if (scale > 0)
  710     scale--;
  711       else
  712     rt_warn ("scale can not be negative in -- ");
  713       break;
  714 
  715 #if defined(READLINE) || defined(LIBEDIT)
  716     case 3: /* history */
  717       n_history--;
  718       if (n_history >= 0)
  719     HISTORY_SIZE(n_history);
  720       else
  721     {
  722       n_history = -1;
  723       rt_warn ("history is negative, set to unlimited");
  724       UNLIMIT_HISTORY;
  725     }
  726 #endif
  727 
  728     default: /* It is a simple variable. */
  729       var_ptr = get_var (var_name);
  730       if (var_ptr != NULL)
  731     bc_sub (var_ptr->v_value,_one_,&var_ptr->v_value, 0);
  732     }
  733 }
  734 
  735 
  736 /* Decrement VAR_NAME by one.  VAR_NAME is an array, and the top of
  737    the execution stack is the index and it is popped off the stack. */
  738 
  739 void
  740 decr_array (var_name)
  741      int var_name;
  742 {
  743   bc_num *num_ptr;
  744   long   idx;
  745 
  746   /* It is an array variable. */
  747   if (!check_stack (1)) return;
  748   idx = bc_num2long (ex_stack->s_num);
  749   if (idx < 0 || idx > BC_DIM_MAX ||
  750      (idx == 0 && !bc_is_zero (ex_stack->s_num))) 
  751     rt_error ("Array %s subscript out of bounds.", a_names[var_name]);
  752   else
  753     {
  754       num_ptr = get_array_num (var_name, idx);
  755       if (num_ptr != NULL)
  756     {
  757       pop ();
  758       bc_sub (*num_ptr, _one_, num_ptr, 0);
  759     }
  760     }
  761 }
  762 
  763 
  764 /* Increment VAR_NAME by one.  This includes the special variables
  765    ibase, obase, and scale. */
  766 
  767 void
  768 incr_var (var_name)
  769      int var_name;
  770 {
  771   bc_var *var_ptr;
  772 
  773   switch (var_name)
  774     {
  775 
  776     case 0: /* ibase */
  777       if (i_base < 16)
  778     i_base++;
  779       else
  780     rt_warn ("ibase too big in ++");
  781       break;
  782 
  783     case 1: /* obase */
  784       if (o_base < BC_BASE_MAX)
  785     o_base++;
  786       else
  787     rt_warn ("obase too big in ++");
  788       break;
  789 
  790     case 2:
  791       if (scale < BC_SCALE_MAX)
  792     scale++;
  793       else
  794     rt_warn ("Scale too big in ++");
  795       break;
  796 
  797 #if defined(READLINE) || defined(LIBEDIT)
  798     case 3: /* history */
  799       n_history++;
  800       if (n_history > 0)
  801     HISTORY_SIZE(n_history);
  802       else
  803     {
  804       n_history = -1;
  805       rt_warn ("history set to unlimited");
  806       UNLIMIT_HISTORY;
  807     }
  808 #endif
  809 
  810     default:  /* It is a simple variable. */
  811       var_ptr = get_var (var_name);
  812       if (var_ptr != NULL)
  813     bc_add (var_ptr->v_value, _one_, &var_ptr->v_value, 0);
  814 
  815     }
  816 }
  817 
  818 
  819 /* Increment VAR_NAME by one.  VAR_NAME is an array and top of
  820    execution stack is the index and is popped off the stack. */
  821 
  822 void
  823 incr_array (var_name)
  824      int var_name;
  825 {
  826   bc_num *num_ptr;
  827   long   idx;
  828 
  829   if (!check_stack (1)) return;
  830   idx = bc_num2long (ex_stack->s_num);
  831   if (idx < 0 || idx > BC_DIM_MAX ||
  832       (idx == 0 && !bc_is_zero (ex_stack->s_num))) 
  833     rt_error ("Array %s subscript out of bounds.", a_names[var_name]);
  834   else
  835     {
  836       num_ptr = get_array_num (var_name, idx);
  837       if (num_ptr != NULL)
  838     {
  839       pop ();
  840       bc_add (*num_ptr, _one_, num_ptr, 0);
  841     }
  842     }
  843 }
  844 
  845 
  846 /* Routines for processing autos variables and parameters. */
  847 
  848 /* NAME is an auto variable that needs to be pushed on its stack. */
  849 
  850 void
  851 auto_var (name)
  852      int name;
  853 {
  854   bc_var *v_temp;
  855   bc_var_array *a_temp;
  856   int ix;
  857 
  858   if (name > 0)
  859     {
  860       /* A simple variable. */
  861       ix = name;
  862       v_temp = (bc_var *) bc_malloc (sizeof (bc_var));
  863       v_temp->v_next = variables[ix];
  864       bc_init_num (&v_temp->v_value);
  865       variables[ix] = v_temp;
  866     }
  867   else
  868     {
  869       /* An array variable. */
  870       ix = -name;
  871       a_temp = (bc_var_array *) bc_malloc (sizeof (bc_var_array));
  872       a_temp->a_next = arrays[ix];
  873       a_temp->a_value = NULL;
  874       a_temp->a_param = FALSE;
  875       arrays[ix] = a_temp;
  876     } 
  877 }
  878 
  879 
  880 /* Free_a_tree frees everything associated with an array variable tree.
  881    This is used when popping an array variable off its auto stack.  */
  882 
  883 void
  884 free_a_tree ( root, depth )
  885      bc_array_node *root;
  886      int depth;
  887 {
  888   int ix;
  889 
  890   if (root != NULL)
  891     {
  892       if (depth > 1)
  893     for (ix = 0; ix < NODE_SIZE; ix++)
  894       free_a_tree (root->n_items.n_down[ix], depth-1);
  895       else
  896     for (ix = 0; ix < NODE_SIZE; ix++)
  897       bc_free_num ( &(root->n_items.n_num[ix]));
  898       free (root);
  899     }
  900 }
  901 
  902 
  903 /* LIST is an NULL terminated list of varible names that need to be
  904    popped off their auto stacks. */
  905 
  906 void
  907 pop_vars (list)
  908      arg_list *list;
  909 {
  910   bc_var *v_temp;
  911   bc_var_array *a_temp;
  912   int    ix;
  913 
  914   while (list != NULL)
  915     {
  916       ix = list->av_name;
  917       if (ix > 0)
  918     {
  919       /* A simple variable. */
  920       v_temp = variables[ix];
  921       if (v_temp != NULL)
  922         {
  923           variables[ix] = v_temp->v_next;
  924           bc_free_num (&v_temp->v_value);
  925           free (v_temp);
  926         }
  927     }
  928       else
  929     {
  930       /* An array variable. */
  931       ix = -ix;
  932       a_temp = arrays[ix];
  933       if (a_temp != NULL)
  934         {
  935           arrays[ix] = a_temp->a_next;
  936           if (!a_temp->a_param && a_temp->a_value != NULL)
  937         {
  938           free_a_tree (a_temp->a_value->a_tree,
  939                    a_temp->a_value->a_depth);
  940           free (a_temp->a_value);
  941         }
  942           free (a_temp);
  943         }
  944     } 
  945       list = list->next;
  946     }
  947 }
  948 
  949 /* COPY_NODE: Copies an array node for a call by value parameter. */
  950 bc_array_node *
  951 copy_tree (ary_node, depth)
  952      bc_array_node *ary_node;
  953      int depth;
  954 {
  955   bc_array_node *res = (bc_array_node *) bc_malloc (sizeof(bc_array_node));
  956   int i;
  957 
  958   if (depth > 1)
  959     for (i=0; i<NODE_SIZE; i++)
  960       if (ary_node->n_items.n_down[i] != NULL)
  961     res->n_items.n_down[i] =
  962       copy_tree (ary_node->n_items.n_down[i], depth - 1);
  963       else
  964     res->n_items.n_down[i] = NULL;
  965   else
  966     for (i=0; i<NODE_SIZE; i++)
  967       if (ary_node->n_items.n_num[i] != NULL)
  968     res->n_items.n_num[i] = bc_copy_num (ary_node->n_items.n_num[i]);
  969       else
  970     res->n_items.n_num[i] = NULL;
  971   return res;
  972 }
  973 
  974 /* COPY_ARRAY: Copies an array for a call by value array parameter. 
  975    ARY is the pointer to the bc_array structure. */
  976 
  977 bc_array *
  978 copy_array (ary)
  979      bc_array *ary;
  980 {
  981   bc_array *res = (bc_array *) bc_malloc (sizeof(bc_array));
  982   res->a_depth = ary->a_depth;
  983   res->a_tree = copy_tree (ary->a_tree, ary->a_depth);
  984   return (res);
  985 }
  986 
  987 
  988 /* A call is being made to FUNC.  The call types are at PC.  Process
  989    the parameters by doing an auto on the parameter variable and then
  990    store the value at the new variable or put a pointer the the array
  991    variable. */
  992 
  993 void
  994 process_params (progctr, func)
  995      program_counter *progctr;
  996      int func;
  997 {
  998   char ch;
  999   arg_list *params;
 1000   int ix, ix1;
 1001   bc_var *v_temp;
 1002   bc_var_array *a_src, *a_dest;
 1003   bc_num *n_temp;
 1004   
 1005   /* Get the parameter names from the function. */
 1006   params = functions[func].f_params;
 1007 
 1008   while ((ch = byte(progctr)) != ':')
 1009     {
 1010       if (params != NULL)
 1011     {
 1012       if ((ch == '0') && params->av_name > 0)
 1013         {
 1014           /* A simple variable. */
 1015           ix = params->av_name;
 1016           v_temp = (bc_var *) bc_malloc (sizeof(bc_var));
 1017           v_temp->v_next = variables[ix];
 1018           v_temp->v_value = ex_stack->s_num;
 1019           bc_init_num (&ex_stack->s_num);
 1020           variables[ix] = v_temp;
 1021         }
 1022       else
 1023         if ((ch == '1') && (params->av_name < 0))
 1024           {
 1025         /* The variables is an array variable. */
 1026     
 1027         /* Compute source index and make sure some structure exists. */
 1028         ix = (int) bc_num2long (ex_stack->s_num);
 1029         n_temp = get_array_num (ix, 0);    
 1030     
 1031         /* Push a new array and Compute Destination index */
 1032         auto_var (params->av_name);  
 1033         ix1 = -params->av_name;
 1034 
 1035         /* Set up the correct pointers in the structure. */
 1036         if (ix == ix1) 
 1037           a_src = arrays[ix]->a_next;
 1038         else
 1039           a_src = arrays[ix];
 1040         a_dest = arrays[ix1];
 1041         if (params->arg_is_var)
 1042           {
 1043             a_dest->a_param = TRUE;
 1044             a_dest->a_value = a_src->a_value;
 1045           }
 1046         else
 1047           {
 1048             a_dest->a_param = FALSE;
 1049             a_dest->a_value = copy_array (a_src->a_value);
 1050           }
 1051           }
 1052         else
 1053           {
 1054         if (params->av_name < 0)
 1055           rt_error ("Parameter type mismatch parameter %s.",
 1056                 a_names[-params->av_name]);
 1057         else
 1058           rt_error ("Parameter type mismatch, parameter %s.",
 1059                 v_names[params->av_name]);
 1060         params++;
 1061           }
 1062       pop ();
 1063     }
 1064       else
 1065     {
 1066         rt_error ("Parameter number mismatch");
 1067         return;
 1068     }
 1069       params = params->next;
 1070     }
 1071   if (params != NULL) 
 1072     rt_error ("Parameter number mismatch");
 1073 }