Merge from vendor branch LIBSTDC++:
[dragonfly.git] / 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 }