1 /*
2 * symbol - global and local symbol routines
3 *
4 * Copyright (C) 1999-2007,2021 David I. Bell and Ernest Bowen
5 *
6 * Primary author: David I. Bell
7 *
8 * Calc is open software; you can redistribute it and/or modify it under
9 * the terms of the version 2.1 of the GNU Lesser General Public License
10 * as published by the Free Software Foundation.
11 *
12 * Calc is distributed in the hope that it will be useful, but WITHOUT
13 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
15 * Public License for more details.
16 *
17 * A copy of version 2.1 of the GNU Lesser General Public License is
18 * distributed with calc under the filename COPYING-LGPL. You should have
19 * received a copy with calc; if not, write to Free Software Foundation, Inc.
20 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
21 *
22 * Under source code control: 1990/02/15 01:48:23
23 * File existed as early as: before 1990
24 *
25 * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
26 */
27
28
29 #include <stdio.h>
30 #include "calc.h"
31 #include "token.h"
32 #include "symbol.h"
33 #include "str.h"
34 #include "opcodes.h"
35 #include "func.h"
36
37
38 #include "banned.h" /* include after system header <> includes */
39
40
41 #define HASHSIZE 37 /* size of hash table */
42
43 E_FUNC FILE *f_open(char *name, char *mode);
44
45 STATIC int filescope; /* file scope level for static variables */
46 STATIC int funcscope; /* function scope level for static variables */
47 STATIC STRINGHEAD localnames; /* list of local variable names */
48 STATIC STRINGHEAD globalnames; /* list of global variable names */
49 STATIC STRINGHEAD paramnames; /* list of parameter variable names */
50 STATIC GLOBAL *globalhash[HASHSIZE]; /* hash table for globals */
51
52 S_FUNC void printtype(VALUE *);
53 S_FUNC void unscope(void);
54 S_FUNC void addstatic(GLOBAL *);
55 STATIC long staticcount = 0;
56 STATIC long staticavail = 0;
57 STATIC GLOBAL **statictable;
58
59
60 /*
61 * Hash a symbol name so we can find it in the hash table.
62 * Args are the symbol name and the symbol name size.
63 */
64 #define HASHSYM(n, s) ((unsigned)((n)[0]*123 + (n)[s-1]*135 + (s)*157) % \
65 HASHSIZE)
66
67
68 /*
69 * Initialize the global symbol table.
70 */
71 void
initglobals(void)72 initglobals(void)
73 {
74 int i; /* index counter */
75
76 for (i = 0; i < HASHSIZE; i++)
77 globalhash[i] = NULL;
78 initstr(&globalnames);
79 filescope = SCOPE_STATIC;
80 funcscope = 0;
81 }
82
83
84 /*
85 * Define a possibly new global variable which may or may not be static.
86 * If it did not already exist, it is created with a value of zero.
87 * The address of the global symbol structure is returned.
88 *
89 * given:
90 * name name of global variable
91 * isstatic TRUE if symbol is static
92 */
93 GLOBAL *
addglobal(char * name,BOOL isstatic)94 addglobal(char *name, BOOL isstatic)
95 {
96 GLOBAL *sp; /* current symbol pointer */
97 GLOBAL **hp; /* hash table head address */
98 size_t len; /* length of string */
99 int newfilescope; /* file scope being looked for */
100 int newfuncscope; /* function scope being looked for */
101
102 newfilescope = SCOPE_GLOBAL;
103 newfuncscope = 0;
104 if (isstatic) {
105 newfilescope = filescope;
106 newfuncscope = funcscope;
107 }
108 len = strlen(name);
109 if (len <= 0)
110 return NULL;
111 hp = &globalhash[HASHSYM(name, len)];
112 for (sp = *hp; sp; sp = sp->g_next) {
113 if ((sp->g_len == len) &&
114 (strncmp(sp->g_name, name, len+1) == 0)
115 && (sp->g_filescope == newfilescope)
116 && (sp->g_funcscope == newfuncscope))
117 return sp;
118 }
119 sp = (GLOBAL *) malloc(sizeof(GLOBAL));
120 if (sp == NULL)
121 return sp;
122 sp->g_name = addstr(&globalnames, name);
123 sp->g_len = len;
124 sp->g_filescope = newfilescope;
125 sp->g_funcscope = newfuncscope;
126 sp->g_value.v_num = qlink(&_qzero_);
127 sp->g_value.v_type = V_NUM;
128 sp->g_value.v_subtype = V_NOSUBTYPE;
129 sp->g_next = *hp;
130 *hp = sp;
131 return sp;
132 }
133
134
135 /*
136 * Look for the highest-scope global variable with a specified name.
137 * Returns the address of the variable or NULL according as the search
138 * succeeds or fails.
139 */
140 GLOBAL *
findglobal(char * name)141 findglobal(char *name)
142 {
143 GLOBAL *sp; /* current symbol pointer */
144 GLOBAL *bestsp; /* found symbol with highest scope */
145 size_t len; /* length of string */
146
147 bestsp = NULL;
148 len = strlen(name);
149 for (sp = globalhash[HASHSYM(name, len)]; sp != NULL; sp = sp->g_next) {
150 if ((sp->g_len == len) &&
151 (strncmp(sp->g_name, name, len+1) == 0)) {
152 if ((bestsp == NULL) ||
153 (sp->g_filescope > bestsp->g_filescope) ||
154 (sp->g_funcscope > bestsp->g_funcscope))
155 bestsp = sp;
156 }
157 }
158 return bestsp;
159 }
160
161
162 /*
163 * Return the name of a global variable given its address.
164 *
165 * given:
166 * sp address of global pointer
167 */
168 char *
globalname(GLOBAL * sp)169 globalname(GLOBAL *sp)
170 {
171 if (sp)
172 return sp->g_name;
173 return "";
174 }
175
176
177 /*
178 * Show the value of all real-number valued global variables, displaying
179 * only the head and tail of very large numerators and denominators.
180 * Static variables are not included.
181 */
182 void
showglobals(void)183 showglobals(void)
184 {
185 GLOBAL **hp; /* hash table head address */
186 register GLOBAL *sp; /* current global symbol pointer */
187 long count; /* number of global variables shown */
188
189 count = 0;
190 for (hp = &globalhash[HASHSIZE-1]; hp >= globalhash; hp--) {
191 for (sp = *hp; sp; sp = sp->g_next) {
192 if (sp->g_value.v_type != V_NUM)
193 continue;
194 if (count++ == 0) {
195 printf("\nName Digits Value\n");
196 printf( "---- ------ -----\n");
197 }
198 printf("%-8s", sp->g_name);
199 if (sp->g_filescope != SCOPE_GLOBAL)
200 printf(" (s)");
201 fitprint(sp->g_value.v_num, 50);
202 printf("\n");
203 }
204 }
205 if (count == 0) {
206 printf("No real-valued global variables\n");
207 }
208 putchar('\n');
209 }
210
211
212 void
showallglobals(void)213 showallglobals(void)
214 {
215 GLOBAL **hp; /* hash table head address */
216 register GLOBAL *sp; /* current global symbol pointer */
217 long count; /* number of global variables shown */
218
219 count = 0;
220 for (hp = &globalhash[HASHSIZE-1]; hp >= globalhash; hp--) {
221 for (sp = *hp; sp; sp = sp->g_next) {
222 if (count++ == 0) {
223 printf("\nName Level Type\n");
224 printf( "---- ----- -----\n");
225 }
226 printf("%-8s%4d ", sp->g_name, sp->g_filescope);
227 printtype(&sp->g_value);
228 printf("\n");
229 }
230 }
231 if (count > 0)
232 printf("\nNumber: %ld\n", count);
233 else
234 printf("No global variables\n");
235 }
236
237
238 S_FUNC void
printtype(VALUE * vp)239 printtype(VALUE *vp)
240 {
241 int type;
242 char *s;
243
244 type = vp->v_type;
245 if (type < 0) {
246 printf("Error %d", -type);
247 return;
248 }
249 switch (type) {
250 case V_NUM:
251 printf("real = ");
252 fitprint(vp->v_num, 32);
253 return;
254 case V_COM:
255 printf("complex = ");
256 fitprint(vp->v_com->real, 8);
257 if (!vp->v_com->imag->num.sign)
258 printf("+");
259 fitprint(vp->v_com->imag, 8);
260 printf("i");
261 return;
262 case V_STR:
263 printf("string = \"");
264 fitstring(vp->v_str->s_str, vp->v_str->s_len, 50);
265 printf("\"");
266 return;
267 case V_NULL:
268 s = "null";
269 break;
270 case V_MAT:
271 s = "matrix";
272 break;
273 case V_LIST:
274 s = "list";
275 break;
276 case V_ASSOC:
277 s = "association";
278 break;
279 case V_OBJ:
280 printf("%s ", objtypename(
281 vp->v_obj->o_actions->oa_index));
282 s = "object";
283 break;
284 case V_FILE:
285 s = "file id";
286 break;
287 case V_RAND:
288 s = "subtractive 100 random state";
289 break;
290 case V_RANDOM:
291 s = "Blum random state";
292 break;
293 case V_CONFIG:
294 s = "config state";
295 break;
296 case V_HASH:
297 s = "hash state";
298 break;
299 case V_BLOCK:
300 s = "unnamed block";
301 break;
302 case V_NBLOCK:
303 s = "named block";
304 break;
305 case V_VPTR:
306 s = "value pointer";
307 break;
308 case V_OPTR:
309 s = "octet pointer";
310 break;
311 case V_SPTR:
312 s = "string pointer";
313 break;
314 case V_NPTR:
315 s = "number pointer";
316 break;
317 default:
318 s = "???";
319 break;
320 }
321 printf("%s", s);
322 }
323
324
325 /*
326 * Write all normal global variables to an output file.
327 * Note: Currently only simple types are saved.
328 * Returns nonzero on error.
329 */
330 int
writeglobals(char * name)331 writeglobals(char *name)
332 {
333 FILE *fp;
334 GLOBAL **hp; /* hash table head address */
335 register GLOBAL *sp; /* current global symbol pointer */
336 int savemode; /* saved output mode */
337 E_FUNC void math_setfp(FILE *fp);
338
339 fp = f_open(name, "w");
340 if (fp == NULL)
341 return 1;
342 math_setfp(fp);
343 for (hp = &globalhash[HASHSIZE-1]; hp >= globalhash; hp--) {
344 for (sp = *hp; sp; sp = sp->g_next) {
345 switch (sp->g_value.v_type) {
346 case V_NUM:
347 case V_COM:
348 case V_STR:
349 break;
350 default:
351 continue;
352 }
353 math_fmt("%s = ", sp->g_name);
354 savemode = math_setmode(MODE_HEX);
355 printvalue(&sp->g_value, PRINT_UNAMBIG);
356 math_setmode(savemode);
357 math_str(";\n");
358 }
359 }
360 math_setfp(stdout);
361 if (fclose(fp))
362 return 1;
363 return 0;
364 }
365
366
367 /*
368 * Free all non-null global and visible static variables
369 */
370 void
freeglobals(void)371 freeglobals(void)
372 {
373 GLOBAL **hp; /* hash table head address */
374 GLOBAL *sp; /* current global symbol pointer */
375 long count; /* number of global variables freed */
376
377 /*
378 * We prevent the hp pointer from walking behind globalhash
379 * by stopping one short of the end and running the loop one
380 * more time.
381 *
382 * We could stop the loop with just hp >= globalhash, but stopping
383 * short and running the loop one last time manually helps make
384 * code checkers such as insure happy.
385 */
386 count = 0;
387 for (hp = &globalhash[HASHSIZE-1]; hp > globalhash; hp--) {
388 for (sp = *hp; sp; sp = sp->g_next) {
389 if (sp->g_value.v_type != V_NULL) {
390 freevalue(&sp->g_value);
391 count++;
392 }
393 }
394 }
395 /* run the loop manually one last time */
396 for (sp = *hp; sp; sp = sp->g_next) {
397 if (sp->g_value.v_type != V_NULL) {
398 freevalue(&sp->g_value);
399 count++;
400 }
401 }
402 }
403
404 /*
405 * Free all invisible static variables
406 */
407 void
freestatics(void)408 freestatics(void)
409 {
410 GLOBAL **stp;
411 GLOBAL *sp;
412 long count;
413
414 stp = statictable;
415 count = staticcount;
416 while (count-- > 0) {
417 sp = *stp++;
418 freevalue(&sp->g_value);
419 }
420 }
421
422
423 /*
424 * Reset the file and function scope levels back to the original values.
425 * This is called on errors to forget any static variables which were being
426 * defined.
427 */
428 void
resetscopes(void)429 resetscopes(void)
430 {
431 filescope = SCOPE_STATIC;
432 funcscope = 0;
433 unscope();
434 }
435
436
437 /*
438 * Enter a new file scope level so that newly defined static variables
439 * will have the appropriate scope, and so that previously defined static
440 * variables will temporarily be unaccessible. This should only be called
441 * when the function scope level is zero.
442 */
443 void
enterfilescope(void)444 enterfilescope(void)
445 {
446 filescope++;
447 funcscope = 0;
448 }
449
450
451 /*
452 * Exit from a file scope level. This deletes from the global symbol table
453 * all of the static variables that were defined within this file scope level.
454 * The function scope level is also reset to zero.
455 */
456 void
exitfilescope(void)457 exitfilescope(void)
458 {
459 if (filescope > SCOPE_STATIC)
460 filescope--;
461 funcscope = 0;
462 unscope();
463 }
464
465
466 /*
467 * Enter a new function scope level within the current file scope level.
468 * This allows newly defined static variables to override previously defined
469 * static variables in the same file scope level.
470 */
471 void
enterfuncscope(void)472 enterfuncscope(void)
473 {
474 funcscope++;
475 }
476
477
478 /*
479 * Exit from a function scope level. This deletes static symbols which were
480 * defined within the current function scope level, and makes previously
481 * defined symbols with the same name within the same file scope level
482 * accessible again.
483 */
484 void
exitfuncscope(void)485 exitfuncscope(void)
486 {
487 if (funcscope > 0)
488 funcscope--;
489 unscope();
490 }
491
492
493 /*
494 * To end the scope of any static variable with identifier id when
495 * id is being declared as global, or when id is declared as static and the
496 * variable is at the same file and function level.
497 */
498 void
endscope(char * name,BOOL isglobal)499 endscope(char *name, BOOL isglobal)
500 {
501 GLOBAL *sp;
502 GLOBAL *prevsp;
503 GLOBAL **hp;
504 size_t len;
505
506 len = strlen(name);
507 prevsp = NULL;
508 hp = &globalhash[HASHSYM(name, len)];
509 for (sp = *hp; sp; sp = sp->g_next) {
510 if (sp->g_len == len && !strcmp(sp->g_name, name) &&
511 sp->g_filescope > SCOPE_GLOBAL) {
512 if (isglobal || (sp->g_filescope == filescope &&
513 sp->g_funcscope == funcscope)) {
514 addstatic(sp);
515 if (prevsp)
516 prevsp->g_next = sp->g_next;
517 else
518 *hp = sp->g_next;
519 continue;
520 }
521 }
522 prevsp = sp;
523 }
524 }
525
526 /*
527 * To store in a table a static variable whose scope is being ended
528 */
529 void
addstatic(GLOBAL * sp)530 addstatic(GLOBAL *sp)
531 {
532 GLOBAL **stp;
533
534 if (staticavail <= 0) {
535 if (staticcount <= 0)
536 stp = (GLOBAL **) malloc(20 * sizeof(GLOBAL *));
537 else
538 stp = (GLOBAL **) realloc(statictable,
539 (20 + staticcount) * sizeof(GLOBAL *));
540 if (stp == NULL) {
541 math_error("Cannot allocate static-variable table");
542 /*NOTREACHED*/
543 }
544 statictable = stp;
545 staticavail = 20;
546 }
547 statictable[staticcount++] = sp;
548 staticavail--;
549 }
550
551 /*
552 * To display all static variables whose scope has been ended
553 */
554 void
showstatics(void)555 showstatics(void)
556 {
557 long count;
558 GLOBAL **stp;
559 GLOBAL *sp;
560
561 for (count = 0, stp = statictable; count < staticcount; count++) {
562 sp = *stp++;
563 if (count == 0) {
564 printf("\nName Scopes Type\n");
565 printf( "---- ------ -----\n");
566 }
567 printf("%-8s", sp->g_name);
568 printf("%3d", sp->g_filescope);
569 printf("%3d ", sp->g_funcscope);
570 printtype(&sp->g_value);
571 printf("\n");
572 }
573 if (count > 0)
574 printf("\nNumber: %ld\n", count);
575 else
576 printf("No un-scoped static variables\n");
577 }
578
579 /*
580 * Remove all the symbols from the global symbol table which have file or
581 * function scopes larger than the current scope levels. Their memory
582 * remains allocated since their values still actually exist.
583 */
584 S_FUNC void
unscope(void)585 unscope(void)
586 {
587 GLOBAL **hp; /* hash table head address */
588 register GLOBAL *sp; /* current global symbol pointer */
589 GLOBAL *prevsp; /* previous kept symbol pointer */
590
591 /*
592 * We prevent the hp pointer from walking behind globalhash
593 * by stopping one short of the end and running the loop one
594 * more time.
595 *
596 * We could stop the loop with just hp >= globalhash, but stopping
597 * short and running the loop one last time manually helps make
598 * code checkers such as insure happy.
599 */
600 for (hp = &globalhash[HASHSIZE-1]; hp > globalhash; hp--) {
601 prevsp = NULL;
602 for (sp = *hp; sp; sp = sp->g_next) {
603 if ((sp->g_filescope == SCOPE_GLOBAL) ||
604 (sp->g_filescope < filescope) ||
605 ((sp->g_filescope == filescope) &&
606 (sp->g_funcscope <= funcscope))) {
607 prevsp = sp;
608 continue;
609 }
610
611 /*
612 * This symbol needs removing.
613 */
614 addstatic(sp);
615 if (prevsp)
616 prevsp->g_next = sp->g_next;
617 else
618 *hp = sp->g_next;
619 }
620 }
621 /* run the loop manually one last time */
622 prevsp = NULL;
623 for (sp = *hp; sp; sp = sp->g_next) {
624 if ((sp->g_filescope == SCOPE_GLOBAL) ||
625 (sp->g_filescope < filescope) ||
626 ((sp->g_filescope == filescope) &&
627 (sp->g_funcscope <= funcscope))) {
628 prevsp = sp;
629 continue;
630 }
631
632 /*
633 * This symbol needs removing.
634 */
635 addstatic(sp);
636 if (prevsp)
637 prevsp->g_next = sp->g_next;
638 else
639 *hp = sp->g_next;
640 }
641 }
642
643
644 /*
645 * Initialize the local and parameter symbol table information.
646 */
647 void
initlocals(void)648 initlocals(void)
649 {
650 initstr(&localnames);
651 initstr(¶mnames);
652 curfunc->f_localcount = 0;
653 curfunc->f_paramcount = 0;
654 }
655
656
657 /*
658 * Add a possibly new local variable definition.
659 * Returns the index of the variable into the local symbol table.
660 * Minus one indicates the symbol could not be added.
661 *
662 * given:
663 * name name of local variable
664 */
665 long
addlocal(char * name)666 addlocal(char *name)
667 {
668 long index; /* current symbol index */
669
670 index = findstr(&localnames, name);
671 if (index >= 0)
672 return index;
673 index = localnames.h_count;
674 (void) addstr(&localnames, name);
675 curfunc->f_localcount++;
676 return index;
677 }
678
679
680 /*
681 * Find a local variable name and return its index.
682 * Returns minus one if the variable name is not defined.
683 *
684 * given:
685 * name name of local variable
686 */
687 long
findlocal(char * name)688 findlocal(char *name)
689 {
690 return findstr(&localnames, name);
691 }
692
693
694 /*
695 * Return the name of a local variable.
696 */
697 char *
localname(long n)698 localname(long n)
699 {
700 return namestr(&localnames, n);
701 }
702
703
704 /*
705 * Add a possibly new parameter variable definition.
706 * Returns the index of the variable into the parameter symbol table.
707 * Minus one indicates the symbol could not be added.
708 *
709 * given:
710 * name name of parameter variable
711 */
712 long
addparam(char * name)713 addparam(char *name)
714 {
715 long index; /* current symbol index */
716
717 index = findstr(¶mnames, name);
718 if (index >= 0)
719 return index;
720 index = paramnames.h_count;
721 (void) addstr(¶mnames, name);
722 curfunc->f_paramcount++;
723 return index;
724 }
725
726
727 /*
728 * Find a parameter variable name and return its index.
729 * Returns minus one if the variable name is not defined.
730 *
731 * given:
732 * name name of parameter variable
733 */
734 long
findparam(char * name)735 findparam(char *name)
736 {
737 return findstr(¶mnames, name);
738 }
739
740
741 /*
742 * Return the name of a parameter variable.
743 */
744 char *
paramname(long n)745 paramname(long n)
746 {
747 return namestr(¶mnames, n);
748 }
749
750
751 /*
752 * Return the type of a variable name.
753 * This is either local, parameter, global, static, or undefined.
754 *
755 * given:
756 * name variable name to find
757 */
758 int
symboltype(char * name)759 symboltype(char *name)
760 {
761 GLOBAL *sp;
762
763 if (findparam(name) >= 0)
764 return SYM_PARAM;
765 if (findlocal(name) >= 0)
766 return SYM_LOCAL;
767 sp = findglobal(name);
768 if (sp) {
769 if (sp->g_filescope == SCOPE_GLOBAL)
770 return SYM_GLOBAL;
771 return SYM_STATIC;
772 }
773 return SYM_UNDEFINED;
774 }
775
776 /* END CODE */
777