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