gnu/usr.bin/bc/storage.c

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