contrib/bc/bc/storage.c

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