aboutsummaryrefslogtreecommitdiffstatshomepage
path: root/libraries/embryo/src/bin/embryo_cc_sc1.c
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/embryo/src/bin/embryo_cc_sc1.c')
-rw-r--r--libraries/embryo/src/bin/embryo_cc_sc1.c4079
1 files changed, 4079 insertions, 0 deletions
diff --git a/libraries/embryo/src/bin/embryo_cc_sc1.c b/libraries/embryo/src/bin/embryo_cc_sc1.c
new file mode 100644
index 0000000..b28b6f3
--- /dev/null
+++ b/libraries/embryo/src/bin/embryo_cc_sc1.c
@@ -0,0 +1,4079 @@
1/* Small compiler
2 * Function and variable definition and declaration, statement parser.
3 *
4 * Copyright (c) ITB CompuPhase, 1997-2003
5 *
6 * This software is provided "as-is", without any express or implied
7 * warranty. In no event will the authors be held liable for any
8 * damages arising from the use of this software. Permission is granted
9 * to anyone to use this software for any purpose, including commercial
10 * applications, and to alter it and redistribute it freely, subject to
11 * the following restrictions:
12 *
13 * 1. The origin of this software must not be misrepresented;
14 * you must not claim that you wrote the original software.
15 * If you use this software in a product, an acknowledgment in the
16 * product documentation would be appreciated but is not required.
17 * 2. Altered source versions must be plainly marked as such, and
18 * must not be misrepresented as being the original software.
19 * 3. This notice may not be removed or altered from any source
20 * distribution.
21 * Version: $Id: embryo_cc_sc1.c 61433 2011-07-16 23:19:02Z caro $
22 */
23
24
25#ifdef HAVE_CONFIG_H
26# include <config.h>
27#endif
28
29#include <assert.h>
30#include <ctype.h>
31#include <limits.h>
32#include <stdarg.h>
33#include <stdio.h>
34#include <stdlib.h>
35#include <string.h>
36
37#ifdef HAVE_UNISTD_H
38# include <unistd.h>
39#endif
40
41#ifdef HAVE_EVIL
42# include <Evil.h>
43#endif /* HAVE_EVIL */
44
45#include "embryo_cc_sc.h"
46#include "embryo_cc_prefix.h"
47
48#define VERSION_STR "2.4"
49#define VERSION_INT 240
50
51static void resetglobals(void);
52static void initglobals(void);
53static void setopt(int argc, char **argv,
54 char *iname, char *oname,
55 char *pname, char *rname);
56static void setconfig(char *root);
57static void about(void);
58static void setconstants(void);
59static void parse(void);
60static void dumplits(void);
61static void dumpzero(int count);
62static void declfuncvar(int tok, char *symname,
63 int tag, int fpublic,
64 int fstatic, int fstock, int fconst);
65static void declglb(char *firstname, int firsttag,
66 int fpublic, int fstatic, int stock, int fconst);
67static int declloc(int fstatic);
68static void decl_const(int table);
69static void decl_enum(int table);
70static cell needsub(int *tag);
71static void initials(int ident, int tag,
72 cell * size, int dim[], int numdim);
73static cell initvector(int ident, int tag, cell size, int fillzero);
74static cell init(int ident, int *tag);
75static void funcstub(int native);
76static int newfunc(char *firstname, int firsttag,
77 int fpublic, int fstatic, int stock);
78static int declargs(symbol * sym);
79static void doarg(char *name, int ident, int offset,
80 int tags[], int numtags,
81 int fpublic, int fconst, arginfo * arg);
82static void reduce_referrers(symbol * root);
83static int testsymbols(symbol * root, int level,
84 int testlabs, int testconst);
85static void destructsymbols(symbol * root, int level);
86static constvalue *find_constval_byval(constvalue * table, cell val);
87static void statement(int *lastindent, int allow_decl);
88static void compound(void);
89static void doexpr(int comma, int chkeffect,
90 int allowarray, int mark_endexpr,
91 int *tag, int chkfuncresult);
92static void doassert(void);
93static void doexit(void);
94static void test(int label, int parens, int invert);
95static void doif(void);
96static void dowhile(void);
97static void dodo(void);
98static void dofor(void);
99static void doswitch(void);
100static void dogoto(void);
101static void dolabel(void);
102static symbol *fetchlab(char *name);
103static void doreturn(void);
104static void dobreak(void);
105static void docont(void);
106static void dosleep(void);
107static void addwhile(int *ptr);
108static void delwhile(void);
109static int *readwhile(void);
110
111static int lastst = 0; /* last executed statement type */
112static int nestlevel = 0; /* number of active (open) compound statements */
113static int rettype = 0; /* the type that a "return" expression should have */
114static int skipinput = 0; /* number of lines to skip from the first input file */
115static int wq[wqTABSZ]; /* "while queue", internal stack for nested loops */
116static int *wqptr; /* pointer to next entry */
117static char binfname[PATH_MAX]; /* binary file name */
118
119int
120main(int argc, char *argv[], char *env[] __UNUSED__)
121{
122 e_prefix_determine(argv[0]);
123 return sc_compile(argc, argv);
124}
125
126int
127sc_error(int number, char *message, char *filename, int firstline,
128 int lastline, va_list argptr)
129{
130 static char *prefix[3] = { "error", "fatal error", "warning" };
131
132 if (number != 0)
133 {
134 char *pre;
135
136 pre = prefix[number / 100];
137 if (firstline >= 0)
138 fprintf(stderr, "%s(%d -- %d) : %s %03d: ", filename, firstline,
139 lastline, pre, number);
140 else
141 fprintf(stderr, "%s(%d) : %s %03d: ", filename, lastline, pre,
142 number);
143 } /* if */
144 vfprintf(stderr, message, argptr);
145 fflush(stderr);
146 return 0;
147}
148
149void *
150sc_opensrc(char *filename)
151{
152 return fopen(filename, "rb");
153}
154
155void
156sc_closesrc(void *handle)
157{
158 assert(handle != NULL);
159 fclose((FILE *) handle);
160}
161
162void
163sc_resetsrc(void *handle, void *position)
164{
165 assert(handle != NULL);
166 fsetpos((FILE *) handle, (fpos_t *) position);
167}
168
169char *
170sc_readsrc(void *handle, char *target, int maxchars)
171{
172 return fgets(target, maxchars, (FILE *) handle);
173}
174
175void *
176sc_getpossrc(void *handle)
177{
178 static fpos_t lastpos; /* may need to have a LIFO stack of
179 * such positions */
180
181 fgetpos((FILE *) handle, &lastpos);
182 return &lastpos;
183}
184
185int
186sc_eofsrc(void *handle)
187{
188 return feof((FILE *) handle);
189}
190
191void *
192sc_openasm(int fd)
193{
194 return fdopen(fd, "w+");
195}
196
197void
198sc_closeasm(void *handle)
199{
200 if (handle)
201 fclose((FILE *) handle);
202}
203
204void
205sc_resetasm(void *handle)
206{
207 fflush((FILE *) handle);
208 fseek((FILE *) handle, 0, SEEK_SET);
209}
210
211int
212sc_writeasm(void *handle, char *st)
213{
214 return fputs(st, (FILE *) handle) >= 0;
215}
216
217char *
218sc_readasm(void *handle, char *target, int maxchars)
219{
220 return fgets(target, maxchars, (FILE *) handle);
221}
222
223void *
224sc_openbin(char *filename)
225{
226 return fopen(filename, "wb");
227}
228
229void
230sc_closebin(void *handle, int deletefile)
231{
232 fclose((FILE *) handle);
233 if (deletefile)
234 unlink(binfname);
235}
236
237void
238sc_resetbin(void *handle)
239{
240 fflush((FILE *) handle);
241 fseek((FILE *) handle, 0, SEEK_SET);
242}
243
244int
245sc_writebin(void *handle, void *buffer, int size)
246{
247 return (int)fwrite(buffer, 1, size, (FILE *) handle) == size;
248}
249
250long
251sc_lengthbin(void *handle)
252{
253 return ftell((FILE *) handle);
254}
255
256/* "main" of the compiler
257 */
258int
259sc_compile(int argc, char *argv[])
260{
261 int entry, i, jmpcode, fd_out;
262 int retcode;
263 char incfname[PATH_MAX];
264 char reportname[PATH_MAX];
265 FILE *binf;
266 void *inpfmark;
267 char lcl_ctrlchar;
268 int lcl_packstr, lcl_needsemicolon, lcl_tabsize;
269 char *tmpdir;
270
271 /* set global variables to their initial value */
272 binf = NULL;
273 initglobals();
274 errorset(sRESET);
275 errorset(sEXPRRELEASE);
276 lexinit();
277
278 /* make sure that we clean up on a fatal error; do this before the
279 * first call to error(). */
280 if ((jmpcode = setjmp(errbuf)) != 0)
281 goto cleanup;
282
283 /* allocate memory for fixed tables */
284 inpfname = (char *)malloc(PATH_MAX);
285 litq = (cell *) malloc(litmax * sizeof(cell));
286 if (!litq)
287 error(103); /* insufficient memory */
288 if (!phopt_init())
289 error(103); /* insufficient memory */
290
291 setopt(argc, argv, inpfname, binfname, incfname, reportname);
292
293 /* open the output file */
294
295#ifndef HAVE_EVIL
296 tmpdir = getenv("TMPDIR");
297 if (!tmpdir) tmpdir = "/tmp";
298#else
299 tmpdir = (char *)evil_tmpdir_get();
300#endif /* ! HAVE_EVIL */
301
302 snprintf(outfname, PATH_MAX, "%s/embryo_cc.asm-tmp-XXXXXX", tmpdir);
303 fd_out = mkstemp(outfname);
304 if (fd_out < 0)
305 error(101, outfname);
306
307 setconfig(argv[0]); /* the path to the include files */
308 lcl_ctrlchar = sc_ctrlchar;
309 lcl_packstr = sc_packstr;
310 lcl_needsemicolon = sc_needsemicolon;
311 lcl_tabsize = sc_tabsize;
312 inpf = inpf_org = (FILE *) sc_opensrc(inpfname);
313 if (!inpf)
314 error(100, inpfname);
315 freading = TRUE;
316 outf = (FILE *) sc_openasm(fd_out); /* first write to assembler
317 * file (may be temporary) */
318 if (!outf)
319 error(101, outfname);
320 /* immediately open the binary file, for other programs to check */
321 binf = (FILE *) sc_openbin(binfname);
322 if (!binf)
323 error(101, binfname);
324 setconstants(); /* set predefined constants and tagnames */
325 for (i = 0; i < skipinput; i++) /* skip lines in the input file */
326 if (sc_readsrc(inpf, pline, sLINEMAX))
327 fline++; /* keep line number up to date */
328 skipinput = fline;
329 sc_status = statFIRST;
330 /* do the first pass through the file */
331 inpfmark = sc_getpossrc(inpf);
332 if (incfname[0] != '\0')
333 {
334 if (strcmp(incfname, sDEF_PREFIX) == 0)
335 {
336 plungefile(incfname, FALSE, TRUE); /* parse "default.inc" */
337 }
338 else
339 {
340 if (!plungequalifiedfile(incfname)) /* parse "prefix" include
341 * file */
342 error(100, incfname); /* cannot read from ... (fatal error) */
343 } /* if */
344 } /* if */
345 preprocess(); /* fetch first line */
346 parse(); /* process all input */
347
348 /* second pass */
349 sc_status = statWRITE; /* set, to enable warnings */
350
351 /* ??? for re-parsing the listing file instead of the original source
352 * file (and doing preprocessing twice):
353 * - close input file, close listing file
354 * - re-open listing file for reading (inpf)
355 * - open assembler file (outf)
356 */
357
358 /* reset "defined" flag of all functions and global variables */
359 reduce_referrers(&glbtab);
360 delete_symbols(&glbtab, 0, TRUE, FALSE);
361#if !defined NO_DEFINE
362 delete_substtable();
363#endif
364 resetglobals();
365 sc_ctrlchar = lcl_ctrlchar;
366 sc_packstr = lcl_packstr;
367 sc_needsemicolon = lcl_needsemicolon;
368 sc_tabsize = lcl_tabsize;
369 errorset(sRESET);
370 /* reset the source file */
371 inpf = inpf_org;
372 freading = TRUE;
373 sc_resetsrc(inpf, inpfmark); /* reset file position */
374 fline = skipinput; /* reset line number */
375 lexinit(); /* clear internal flags of lex() */
376 sc_status = statWRITE; /* allow to write --this variable was reset
377 * by resetglobals() */
378 writeleader();
379 setfile(inpfname, fnumber);
380 if (incfname[0] != '\0')
381 {
382 if (strcmp(incfname, sDEF_PREFIX) == 0)
383 plungefile(incfname, FALSE, TRUE); /* parse "default.inc" (again) */
384 else
385 plungequalifiedfile(incfname); /* parse implicit include
386 * file (again) */
387 } /* if */
388 preprocess(); /* fetch first line */
389 parse(); /* process all input */
390 /* inpf is already closed when readline() attempts to pop of a file */
391 writetrailer(); /* write remaining stuff */
392
393 entry = testsymbols(&glbtab, 0, TRUE, FALSE); /* test for unused
394 * or undefined functions and variables */
395 if (!entry)
396 error(13); /* no entry point (no public functions) */
397
398 cleanup:
399 if (inpf) /* main source file is not closed, do it now */
400 sc_closesrc(inpf);
401 /* write the binary file (the file is already open) */
402 if (errnum == 0 && jmpcode == 0)
403 {
404 assert(binf != NULL);
405 sc_resetasm(outf); /* flush and loop back, for reading */
406 assemble(binf, outf); /* assembler file is now input */
407 } /* if */
408 if (outf)
409 sc_closeasm(outf);
410 unlink (outfname);
411 if (binf)
412 sc_closebin(binf, errnum != 0);
413
414 if (inpfname)
415 free(inpfname);
416 if (litq)
417 free(litq);
418 phopt_cleanup();
419 stgbuffer_cleanup();
420 assert(jmpcode != 0 || loctab.next == NULL); /* on normal flow,
421 * local symbols
422 * should already have been deleted */
423 delete_symbols(&loctab, 0, TRUE, TRUE); /* delete local variables
424 * if not yet done (i.e.
425 * on a fatal error) */
426 delete_symbols(&glbtab, 0, TRUE, TRUE);
427 delete_consttable(&tagname_tab);
428 delete_consttable(&libname_tab);
429 delete_aliastable();
430 delete_pathtable();
431#if !defined NO_DEFINE
432 delete_substtable();
433#endif
434 if (errnum != 0)
435 {
436 printf("\n%d Error%s.\n", errnum, (errnum > 1) ? "s" : "");
437 retcode = 2;
438 }
439 else if (warnnum != 0)
440 {
441 printf("\n%d Warning%s.\n", warnnum, (warnnum > 1) ? "s" : "");
442 retcode = 1;
443 }
444 else
445 {
446 retcode = jmpcode;
447 } /* if */
448 return retcode;
449}
450
451int
452sc_addconstant(char *name, cell value, int tag)
453{
454 errorset(sFORCESET); /* make sure error engine is silenced */
455 sc_status = statIDLE;
456 add_constant(name, value, sGLOBAL, tag);
457 return 1;
458}
459
460int
461sc_addtag(char *name)
462{
463 cell val;
464 constvalue *ptr;
465 int last, tag;
466
467 if (!name)
468 {
469 /* no tagname was given, check for one */
470 if (lex(&val, &name) != tLABEL)
471 {
472 lexpush();
473 return 0; /* untagged */
474 } /* if */
475 } /* if */
476
477 last = 0;
478 ptr = tagname_tab.next;
479 while (ptr)
480 {
481 tag = (int)(ptr->value & TAGMASK);
482 if (strcmp(name, ptr->name) == 0)
483 return tag; /* tagname is known, return its sequence number */
484 tag &= (int)~FIXEDTAG;
485 if (tag > last)
486 last = tag;
487 ptr = ptr->next;
488 } /* while */
489
490 /* tagname currently unknown, add it */
491 tag = last + 1; /* guaranteed not to exist already */
492 if (isupper(*name))
493 tag |= (int)FIXEDTAG;
494 append_constval(&tagname_tab, name, (cell) tag, 0);
495 return tag;
496}
497
498static void
499resetglobals(void)
500{
501 /* reset the subset of global variables that is modified by the
502 * first pass */
503 curfunc = NULL; /* pointer to current function */
504 lastst = 0; /* last executed statement type */
505 nestlevel = 0; /* number of active (open) compound statements */
506 rettype = 0; /* the type that a "return" expression should have */
507 litidx = 0; /* index to literal table */
508 stgidx = 0; /* index to the staging buffer */
509 labnum = 0; /* number of (internal) labels */
510 staging = 0; /* true if staging output */
511 declared = 0; /* number of local cells declared */
512 glb_declared = 0; /* number of global cells declared */
513 code_idx = 0; /* number of bytes with generated code */
514 ntv_funcid = 0; /* incremental number of native function */
515 curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */
516 freading = FALSE; /* no input file ready yet */
517 fline = 0; /* the line number in the current file */
518 fnumber = 0; /* the file number in the file table (debugging) */
519 fcurrent = 0; /* current file being processed (debugging) */
520 intest = 0; /* true if inside a test */
521 sideeffect = 0; /* true if an expression causes a side-effect */
522 stmtindent = 0; /* current indent of the statement */
523 indent_nowarn = TRUE; /* do not skip warning "217 loose indentation" */
524 sc_allowtags = TRUE; /* allow/detect tagnames */
525 sc_status = statIDLE;
526}
527
528static void
529initglobals(void)
530{
531 resetglobals();
532
533 skipinput = 0; /* number of lines to skip from the first
534 * input file */
535 sc_ctrlchar = CTRL_CHAR; /* the escape character */
536 litmax = sDEF_LITMAX; /* current size of the literal table */
537 errnum = 0; /* number of errors */
538 warnnum = 0; /* number of warnings */
539/* sc_debug=sCHKBOUNDS; by default: bounds checking+assertions */
540 sc_debug = 0; /* by default: no debug */
541 charbits = 8; /* a "char" is 8 bits */
542 sc_packstr = FALSE; /* strings are unpacked by default */
543/* sc_compress=TRUE; compress output bytecodes */
544 sc_compress = FALSE; /* compress output bytecodes */
545 sc_needsemicolon = FALSE; /* semicolon required to terminate
546 * expressions? */
547 sc_dataalign = 4;
548 sc_stksize = sDEF_AMXSTACK; /* default stack size */
549 sc_tabsize = 8; /* assume a TAB is 8 spaces */
550 sc_rationaltag = 0; /* assume no support for rational numbers */
551 rational_digits = 0; /* number of fractional digits */
552
553 outfname[0] = '\0'; /* output file name */
554 inpf = NULL; /* file read from */
555 inpfname = NULL; /* pointer to name of the file currently
556 * read from */
557 outf = NULL; /* file written to */
558 litq = NULL; /* the literal queue */
559 glbtab.next = NULL; /* clear global variables/constants table */
560 loctab.next = NULL; /* " local " / " " */
561 tagname_tab.next = NULL; /* tagname table */
562 libname_tab.next = NULL; /* library table (#pragma library "..."
563 * syntax) */
564
565 pline[0] = '\0'; /* the line read from the input file */
566 lptr = NULL; /* points to the current position in "pline" */
567 curlibrary = NULL; /* current library */
568 inpf_org = NULL; /* main source file */
569
570 wqptr = wq; /* initialize while queue pointer */
571
572}
573
574static void
575parseoptions(int argc, char **argv, char *iname, char *oname,
576 char *pname __UNUSED__, char *rname __UNUSED__)
577{
578 char str[PATH_MAX];
579 int i, stack_size;
580 size_t len;
581
582 /* use embryo include dir always */
583 snprintf(str, sizeof(str), "%s/include/", e_prefix_data_get());
584 insert_path(str);
585 insert_path("./");
586
587 for (i = 1; i < argc; i++)
588 {
589 if (!strcmp (argv[i], "-i") && (i + 1 < argc) && *argv[i + 1])
590 {
591 /* include directory */
592 i++;
593 strncpy(str, argv[i], sizeof(str));
594
595 len = strlen(str);
596 if (str[len - 1] != DIRSEP_CHAR)
597 {
598 str[len] = DIRSEP_CHAR;
599 str[len + 1] = '\0';
600 }
601
602 insert_path(str);
603 }
604 else if (!strcmp (argv[i], "-o") && (i + 1 < argc) && *argv[i + 1])
605 {
606 /* output file */
607 i++;
608 strcpy(oname, argv[i]); /* FIXME */
609 }
610 else if (!strcmp (argv[i], "-S") && (i + 1 < argc) && *argv[i + 1])
611 {
612 /* stack size */
613 i++;
614 stack_size = atoi(argv[i]);
615
616 if (stack_size > 64)
617 sc_stksize = (cell) stack_size;
618 else
619 about();
620 }
621 else if (!*iname)
622 {
623 /* input file */
624 strcpy(iname, argv[i]); /* FIXME */
625 }
626 else
627 {
628 /* only allow one input filename */
629 about();
630 }
631 }
632}
633
634static void
635setopt(int argc, char **argv, char *iname, char *oname,
636 char *pname, char *rname)
637{
638 *iname = '\0';
639 *oname = '\0';
640 *pname = '\0';
641 *rname = '\0';
642 strcpy(pname, sDEF_PREFIX);
643
644 parseoptions(argc, argv, iname, oname, pname, rname);
645 if (iname[0] == '\0')
646 about();
647}
648
649static void
650setconfig(char *root)
651{
652 char path[PATH_MAX];
653 char *ptr;
654 int len;
655
656 /* add the default "include" directory */
657 if (root)
658 {
659 /* path + filename (hopefully) */
660 strncpy(path, root, sizeof(path) - 1);
661 path[sizeof(path) - 1] = 0;
662 }
663/* terminate just behind last \ or : */
664 if ((ptr = strrchr(path, DIRSEP_CHAR))
665 || (ptr = strchr(path, ':')))
666 {
667 /* If there was no terminating "\" or ":",
668 * the filename probably does not
669 * contain the path; so we just don't add it
670 * to the list in that case
671 */
672 *(ptr + 1) = '\0';
673 if (strlen(path) < (sizeof(path) - 1 - 7))
674 {
675 strcat(path, "include");
676 }
677 len = strlen(path);
678 path[len] = DIRSEP_CHAR;
679 path[len + 1] = '\0';
680 insert_path(path);
681 } /* if */
682}
683
684static void
685about(void)
686{
687 printf("Usage: embryo_cc <filename> [options]\n\n");
688 printf("Options:\n");
689#if 0
690 printf
691 (" -A<num> alignment in bytes of the data segment and the\
692 stack\n");
693
694 printf
695 (" -a output assembler code (skip code generation\
696 pass)\n");
697
698 printf
699 (" -C[+/-] compact encoding for output file (default=%c)\n",
700 sc_compress ? '+' : '-');
701 printf(" -c8 [default] a character is 8-bits\
702 (ASCII/ISO Latin-1)\n");
703
704 printf(" -c16 a character is 16-bits (Unicode)\n");
705#if defined dos_setdrive
706 printf(" -Dpath active directory path\n");
707#endif
708 printf
709 (" -d0 no symbolic information, no run-time checks\n");
710 printf(" -d1 [default] run-time checks, no symbolic\
711 information\n");
712 printf
713 (" -d2 full debug information and dynamic checking\n");
714 printf(" -d3 full debug information, dynamic checking,\
715 no optimization\n");
716#endif
717 printf(" -i <name> path for include files\n");
718#if 0
719 printf(" -l create list file (preprocess only)\n");
720#endif
721 printf(" -o <name> set base name of output file\n");
722#if 0
723 printf
724 (" -P[+/-] strings are \"packed\" by default (default=%c)\n",
725 sc_packstr ? '+' : '-');
726 printf(" -p<name> set name of \"prefix\" file\n");
727 if (!waitkey())
728 longjmp(errbuf, 3);
729#endif
730 printf
731 (" -S <num> stack/heap size in cells (default=%d, min=65)\n",
732 (int)sc_stksize);
733#if 0
734 printf(" -s<num> skip lines from the input file\n");
735 printf
736 (" -t<num> TAB indent size (in character positions)\n");
737 printf(" -\\ use '\\' for escape characters\n");
738 printf(" -^ use '^' for escape characters\n");
739 printf(" -;[+/-] require a semicolon to end each statement\
740 (default=%c)\n", sc_needsemicolon ? '+' : '-');
741
742 printf
743 (" sym=val define constant \"sym\" with value \"val\"\n");
744 printf(" sym= define constant \"sym\" with value 0\n");
745#endif
746 longjmp(errbuf, 3); /* user abort */
747}
748
749static void
750setconstants(void)
751{
752 int debug;
753
754 assert(sc_status == statIDLE);
755 append_constval(&tagname_tab, "_", 0, 0); /* "untagged" */
756 append_constval(&tagname_tab, "bool", 1, 0);
757
758 add_constant("true", 1, sGLOBAL, 1); /* boolean flags */
759 add_constant("false", 0, sGLOBAL, 1);
760 add_constant("EOS", 0, sGLOBAL, 0); /* End Of String, or '\0' */
761 add_constant("cellbits", 32, sGLOBAL, 0);
762 add_constant("cellmax", INT_MAX, sGLOBAL, 0);
763 add_constant("cellmin", INT_MIN, sGLOBAL, 0);
764 add_constant("charbits", charbits, sGLOBAL, 0);
765 add_constant("charmin", 0, sGLOBAL, 0);
766 add_constant("charmax", (charbits == 16) ? 0xffff : 0xff, sGLOBAL, 0);
767
768 add_constant("__Small", VERSION_INT, sGLOBAL, 0);
769
770 debug = 0;
771 if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC)) == (sCHKBOUNDS | sSYMBOLIC))
772 debug = 2;
773 else if ((sc_debug & sCHKBOUNDS) == sCHKBOUNDS)
774 debug = 1;
775 add_constant("debug", debug, sGLOBAL, 0);
776}
777
778/* parse - process all input text
779 *
780 * At this level, only static declarations and function definitions
781 * are legal.
782 */
783static void
784parse(void)
785{
786 int tok, tag, fconst, fstock, fstatic;
787 cell val;
788 char *str;
789
790 while (freading)
791 {
792 /* first try whether a declaration possibly is native or public */
793 tok = lex(&val, &str); /* read in (new) token */
794 switch (tok)
795 {
796 case 0:
797 /* ignore zero's */
798 break;
799 case tNEW:
800 fconst = matchtoken(tCONST);
801 declglb(NULL, 0, FALSE, FALSE, FALSE, fconst);
802 break;
803 case tSTATIC:
804 /* This can be a static function or a static global variable;
805 * we know which of the two as soon as we have parsed up to the
806 * point where an opening parenthesis of a function would be
807 * expected. To back out after deciding it was a declaration of
808 * a static variable after all, we have to store the symbol name
809 * and tag.
810 */
811 fstock = matchtoken(tSTOCK);
812 fconst = matchtoken(tCONST);
813 tag = sc_addtag(NULL);
814 tok = lex(&val, &str);
815 if (tok == tNATIVE || tok == tPUBLIC)
816 {
817 error(42); /* invalid combination of class specifiers */
818 break;
819 } /* if */
820 declfuncvar(tok, str, tag, FALSE, TRUE, fstock, fconst);
821 break;
822 case tCONST:
823 decl_const(sGLOBAL);
824 break;
825 case tENUM:
826 decl_enum(sGLOBAL);
827 break;
828 case tPUBLIC:
829 /* This can be a public function or a public variable;
830 * see the comment above (for static functions/variables)
831 * for details.
832 */
833 fconst = matchtoken(tCONST);
834 tag = sc_addtag(NULL);
835 tok = lex(&val, &str);
836 if (tok == tNATIVE || tok == tSTOCK || tok == tSTATIC)
837 {
838 error(42); /* invalid combination of class specifiers */
839 break;
840 } /* if */
841 declfuncvar(tok, str, tag, TRUE, FALSE, FALSE, fconst);
842 break;
843 case tSTOCK:
844 /* This can be a stock function or a stock *global) variable;
845 * see the comment above (for static functions/variables) for
846 * details.
847 */
848 fstatic = matchtoken(tSTATIC);
849 fconst = matchtoken(tCONST);
850 tag = sc_addtag(NULL);
851 tok = lex(&val, &str);
852 if (tok == tNATIVE || tok == tPUBLIC)
853 {
854 error(42); /* invalid combination of class specifiers */
855 break;
856 } /* if */
857 declfuncvar(tok, str, tag, FALSE, fstatic, TRUE, fconst);
858 break;
859 case tLABEL:
860 case tSYMBOL:
861 case tOPERATOR:
862 lexpush();
863 if (!newfunc(NULL, -1, FALSE, FALSE, FALSE))
864 {
865 error(10); /* illegal function or declaration */
866 lexclr(TRUE); /* drop the rest of the line */
867 } /* if */
868 break;
869 case tNATIVE:
870 funcstub(TRUE); /* create a dummy function */
871 break;
872 case tFORWARD:
873 funcstub(FALSE);
874 break;
875 case '}':
876 error(54); /* unmatched closing brace */
877 break;
878 case '{':
879 error(55); /* start of function body without function header */
880 break;
881 default:
882 if (freading)
883 {
884 error(10); /* illegal function or declaration */
885 lexclr(TRUE); /* drop the rest of the line */
886 } /* if */
887 } /* switch */
888 } /* while */
889}
890
891/* dumplits
892 *
893 * Dump the literal pool (strings etc.)
894 *
895 * Global references: litidx (referred to only)
896 */
897static void
898dumplits(void)
899{
900 int j, k;
901
902 k = 0;
903 while (k < litidx)
904 {
905 /* should be in the data segment */
906 assert(curseg == 2);
907 defstorage();
908 j = 16; /* 16 values per line */
909 while (j && k < litidx)
910 {
911 outval(litq[k], FALSE);
912 stgwrite(" ");
913 k++;
914 j--;
915 if (j == 0 || k >= litidx)
916 stgwrite("\n"); /* force a newline after 10 dumps */
917 /* Note: stgwrite() buffers a line until it is complete. It recognizes
918 * the end of line as a sequence of "\n\0", so something like "\n\t"
919 * so should not be passed to stgwrite().
920 */
921 } /* while */
922 } /* while */
923}
924
925/* dumpzero
926 *
927 * Dump zero's for default initial values
928 */
929static void
930dumpzero(int count)
931{
932 int i;
933
934 if (count <= 0)
935 return;
936 assert(curseg == 2);
937 defstorage();
938 i = 0;
939 while (count-- > 0)
940 {
941 outval(0, FALSE);
942 i = (i + 1) % 16;
943 stgwrite((i == 0 || count == 0) ? "\n" : " ");
944 if (i == 0 && count > 0)
945 defstorage();
946 } /* while */
947}
948
949static void
950aligndata(int numbytes)
951{
952 if ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
953 {
954 while ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
955 stowlit(0);
956 } /* if */
957
958}
959
960static void
961declfuncvar(int tok, char *symname, int tag, int fpublic, int fstatic,
962 int fstock, int fconst)
963{
964 char name[sNAMEMAX + 1];
965
966 if (tok != tSYMBOL && tok != tOPERATOR)
967 {
968 if (freading)
969 error(20, symname); /* invalid symbol name */
970 return;
971 } /* if */
972 if (tok == tOPERATOR)
973 {
974 lexpush();
975 if (!newfunc(NULL, tag, fpublic, fstatic, fstock))
976 error(10); /* illegal function or declaration */
977 }
978 else
979 {
980 assert(strlen(symname) <= sNAMEMAX);
981 strcpy(name, symname);
982 if (fconst || !newfunc(name, tag, fpublic, fstatic, fstock))
983 declglb(name, tag, fpublic, fstatic, fstock, fconst);
984 /* if not a static function, try a static variable */
985 } /* if */
986}
987
988/* declglb - declare global symbols
989 *
990 * Declare a static (global) variable. Global variables are stored in
991 * the DATA segment.
992 *
993 * global references: glb_declared (altered)
994 */
995static void
996declglb(char *firstname, int firsttag, int fpublic, int fstatic,
997 int stock, int fconst)
998{
999 int ident, tag, ispublic;
1000 int idxtag[sDIMEN_MAX];
1001 char name[sNAMEMAX + 1];
1002 cell val, size, cidx;
1003 char *str;
1004 int dim[sDIMEN_MAX];
1005 int numdim, level;
1006 int filenum;
1007 symbol *sym;
1008
1009#if !defined NDEBUG
1010 cell glbdecl = 0;
1011#endif
1012
1013 filenum = fcurrent; /* save file number at the start of the
1014 * declaration */
1015 do
1016 {
1017 size = 1; /* single size (no array) */
1018 numdim = 0; /* no dimensions */
1019 ident = iVARIABLE;
1020 if (firstname)
1021 {
1022 assert(strlen(firstname) <= sNAMEMAX);
1023 strcpy(name, firstname); /* save symbol name */
1024 tag = firsttag;
1025 firstname = NULL;
1026 }
1027 else
1028 {
1029 tag = sc_addtag(NULL);
1030 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1031 error(20, str); /* invalid symbol name */
1032 assert(strlen(str) <= sNAMEMAX);
1033 strcpy(name, str); /* save symbol name */
1034 } /* if */
1035 sym = findglb(name);
1036 if (!sym)
1037 sym = findconst(name);
1038 if (sym && (sym->usage & uDEFINE) != 0)
1039 error(21, name); /* symbol already defined */
1040 ispublic = fpublic;
1041 if (name[0] == PUBLIC_CHAR)
1042 {
1043 ispublic = TRUE; /* implicitly public variable */
1044 if (stock || fstatic)
1045 error(42); /* invalid combination of class specifiers */
1046 } /* if */
1047 while (matchtoken('['))
1048 {
1049 ident = iARRAY;
1050 if (numdim == sDIMEN_MAX)
1051 {
1052 error(53); /* exceeding maximum number of dimensions */
1053 return;
1054 } /* if */
1055 if (numdim > 0 && dim[numdim - 1] == 0)
1056 error(52); /* only last dimension may be variable length */
1057 size = needsub(&idxtag[numdim]); /* get size; size==0 for
1058 * "var[]" */
1059#if INT_MAX < LONG_MAX
1060 if (size > INT_MAX)
1061 error(105); /* overflow, exceeding capacity */
1062#endif
1063 if (ispublic)
1064 error(56, name); /* arrays cannot be public */
1065 dim[numdim++] = (int)size;
1066 } /* while */
1067 /* if this variable is never used (which can be detected only in
1068 * the second stage), shut off code generation; make an exception
1069 * for public variables
1070 */
1071 cidx = 0; /* only to avoid a compiler warning */
1072 if (sc_status == statWRITE && sym
1073 && (sym->usage & (uREAD | uWRITTEN | uPUBLIC)) == 0)
1074 {
1075 sc_status = statSKIP;
1076 cidx = code_idx;
1077#if !defined NDEBUG
1078 glbdecl = glb_declared;
1079#endif
1080 } /* if */
1081 defsymbol(name, ident, sGLOBAL, sizeof(cell) * glb_declared, tag);
1082 begdseg(); /* real (initialized) data in data segment */
1083 assert(litidx == 0); /* literal queue should be empty */
1084 if (sc_alignnext)
1085 {
1086 litidx = 0;
1087 aligndata(sc_dataalign);
1088 dumplits(); /* dump the literal queue */
1089 sc_alignnext = FALSE;
1090 litidx = 0; /* global initial data is dumped, so restart at zero */
1091 } /* if */
1092 initials(ident, tag, &size, dim, numdim); /* stores values in
1093 * the literal queue */
1094 if (numdim == 1)
1095 dim[0] = (int)size;
1096 dumplits(); /* dump the literal queue */
1097 dumpzero((int)size - litidx);
1098 litidx = 0;
1099 if (!sym)
1100 { /* define only if not yet defined */
1101 sym =
1102 addvariable(name, sizeof(cell) * glb_declared, ident, sGLOBAL,
1103 tag, dim, numdim, idxtag);
1104 }
1105 else
1106 { /* if declared but not yet defined, adjust the
1107 * variable's address */
1108 sym->addr = sizeof(cell) * glb_declared;
1109 sym->usage |= uDEFINE;
1110 } /* if */
1111 if (ispublic)
1112 sym->usage |= uPUBLIC;
1113 if (fconst)
1114 sym->usage |= uCONST;
1115 if (stock)
1116 sym->usage |= uSTOCK;
1117 if (fstatic)
1118 sym->fnumber = filenum;
1119 if (ident == iARRAY)
1120 for (level = 0; level < numdim; level++)
1121 symbolrange(level, dim[level]);
1122 if (sc_status == statSKIP)
1123 {
1124 sc_status = statWRITE;
1125 code_idx = cidx;
1126 assert(glb_declared == glbdecl);
1127 }
1128 else
1129 {
1130 glb_declared += (int)size; /* add total number of cells */
1131 } /* if */
1132 }
1133 while (matchtoken(',')); /* enddo *//* more? */
1134 needtoken(tTERM); /* if not comma, must be semicolumn */
1135}
1136
1137/* declloc - declare local symbols
1138 *
1139 * Declare local (automatic) variables. Since these variables are
1140 * relative to the STACK, there is no switch to the DATA segment.
1141 * These variables cannot be initialized either.
1142 *
1143 * global references: declared (altered)
1144 * funcstatus (referred to only)
1145 */
1146static int
1147declloc(int fstatic)
1148{
1149 int ident, tag;
1150 int idxtag[sDIMEN_MAX];
1151 char name[sNAMEMAX + 1];
1152 symbol *sym;
1153 cell val, size;
1154 char *str;
1155 value lval = { NULL, 0, 0, 0, 0, NULL };
1156 int cur_lit = 0;
1157 int dim[sDIMEN_MAX];
1158 int numdim, level;
1159 int fconst;
1160
1161 fconst = matchtoken(tCONST);
1162 do
1163 {
1164 ident = iVARIABLE;
1165 size = 1;
1166 numdim = 0; /* no dimensions */
1167 tag = sc_addtag(NULL);
1168 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1169 error(20, str); /* invalid symbol name */
1170 assert(strlen(str) <= sNAMEMAX);
1171 strcpy(name, str); /* save symbol name */
1172 if (name[0] == PUBLIC_CHAR)
1173 error(56, name); /* local variables cannot be public */
1174 /* Note: block locals may be named identical to locals at higher
1175 * compound blocks (as with standard C); so we must check (and add)
1176 * the "nesting level" of local variables to verify the
1177 * multi-definition of symbols.
1178 */
1179 if ((sym = findloc(name)) && sym->compound == nestlevel)
1180 error(21, name); /* symbol already defined */
1181 /* Although valid, a local variable whose name is equal to that
1182 * of a global variable or to that of a local variable at a lower
1183 * level might indicate a bug.
1184 */
1185 if (((sym = findloc(name)) && sym->compound != nestlevel)
1186 || findglb(name))
1187 error(219, name); /* variable shadows another symbol */
1188 while (matchtoken('['))
1189 {
1190 ident = iARRAY;
1191 if (numdim == sDIMEN_MAX)
1192 {
1193 error(53); /* exceeding maximum number of dimensions */
1194 return ident;
1195 } /* if */
1196 if (numdim > 0 && dim[numdim - 1] == 0)
1197 error(52); /* only last dimension may be variable length */
1198 size = needsub(&idxtag[numdim]); /* get size; size==0 for "var[]" */
1199#if INT_MAX < LONG_MAX
1200 if (size > INT_MAX)
1201 error(105); /* overflow, exceeding capacity */
1202#endif
1203 dim[numdim++] = (int)size;
1204 } /* while */
1205 if (ident == iARRAY || fstatic)
1206 {
1207 if (sc_alignnext)
1208 {
1209 aligndata(sc_dataalign);
1210 sc_alignnext = FALSE;
1211 } /* if */
1212 cur_lit = litidx; /* save current index in the literal table */
1213 initials(ident, tag, &size, dim, numdim);
1214 if (size == 0)
1215 return ident; /* error message already given */
1216 if (numdim == 1)
1217 dim[0] = (int)size;
1218 } /* if */
1219 /* reserve memory (on the stack) for the variable */
1220 if (fstatic)
1221 {
1222 /* write zeros for uninitialized fields */
1223 while (litidx < cur_lit + size)
1224 stowlit(0);
1225 sym =
1226 addvariable(name, (cur_lit + glb_declared) * sizeof(cell),
1227 ident, sSTATIC, tag, dim, numdim, idxtag);
1228 defsymbol(name, ident, sSTATIC,
1229 (cur_lit + glb_declared) * sizeof(cell), tag);
1230 }
1231 else
1232 {
1233 declared += (int)size; /* variables are put on stack,
1234 * adjust "declared" */
1235 sym =
1236 addvariable(name, -declared * sizeof(cell), ident, sLOCAL, tag,
1237 dim, numdim, idxtag);
1238 defsymbol(name, ident, sLOCAL, -declared * sizeof(cell), tag);
1239 modstk(-(int)size * sizeof(cell));
1240 } /* if */
1241 /* now that we have reserved memory for the variable, we can
1242 * proceed to initialize it */
1243 sym->compound = nestlevel; /* for multiple declaration/shadowing */
1244 if (fconst)
1245 sym->usage |= uCONST;
1246 if (ident == iARRAY)
1247 for (level = 0; level < numdim; level++)
1248 symbolrange(level, dim[level]);
1249 if (!fstatic)
1250 { /* static variables already initialized */
1251 if (ident == iVARIABLE)
1252 {
1253 /* simple variable, also supports initialization */
1254 int ctag = tag; /* set to "tag" by default */
1255 int explicit_init = FALSE; /* is the variable explicitly
1256 * initialized? */
1257 if (matchtoken('='))
1258 {
1259 doexpr(FALSE, FALSE, FALSE, FALSE, &ctag, TRUE);
1260 explicit_init = TRUE;
1261 }
1262 else
1263 {
1264 const1(0); /* uninitialized variable, set to zero */
1265 } /* if */
1266 /* now try to save the value (still in PRI) in the variable */
1267 lval.sym = sym;
1268 lval.ident = iVARIABLE;
1269 lval.constval = 0;
1270 lval.tag = tag;
1271 check_userop(NULL, ctag, lval.tag, 2, NULL, &ctag);
1272 store(&lval);
1273 endexpr(TRUE); /* full expression ends after the store */
1274 if (!matchtag(tag, ctag, TRUE))
1275 error(213); /* tag mismatch */
1276 /* if the variable was not explicitly initialized, reset the
1277 * "uWRITTEN" flag that store() set */
1278 if (!explicit_init)
1279 sym->usage &= ~uWRITTEN;
1280 }
1281 else
1282 {
1283 /* an array */
1284 if (litidx - cur_lit < size)
1285 fillarray(sym, size * sizeof(cell), 0);
1286 if (cur_lit < litidx)
1287 {
1288 /* check whether the complete array is set to a single value;
1289 * if it is, more compact code can be generated */
1290 cell first = litq[cur_lit];
1291 int i;
1292
1293 for (i = cur_lit; i < litidx && litq[i] == first; i++)
1294 /* nothing */ ;
1295 if (i == litidx)
1296 {
1297 /* all values are the same */
1298 fillarray(sym, (litidx - cur_lit) * sizeof(cell),
1299 first);
1300 litidx = cur_lit; /* reset literal table */
1301 }
1302 else
1303 {
1304 /* copy the literals to the array */
1305 const1((cur_lit + glb_declared) * sizeof(cell));
1306 copyarray(sym, (litidx - cur_lit) * sizeof(cell));
1307 } /* if */
1308 } /* if */
1309 } /* if */
1310 } /* if */
1311 }
1312 while (matchtoken(',')); /* enddo *//* more? */
1313 needtoken(tTERM); /* if not comma, must be semicolumn */
1314 return ident;
1315}
1316
1317static cell
1318calc_arraysize(int dim[], int numdim, int cur)
1319{
1320 if (cur == numdim)
1321 return 0;
1322 return dim[cur] + (dim[cur] * calc_arraysize(dim, numdim, cur + 1));
1323}
1324
1325/* initials
1326 *
1327 * Initialize global objects and local arrays.
1328 * size==array cells (count), if 0 on input, the routine counts
1329 * the number of elements
1330 * tag==required tagname id (not the returned tag)
1331 *
1332 * Global references: litidx (altered)
1333 */
1334static void
1335initials(int ident, int tag, cell * size, int dim[], int numdim)
1336{
1337 int ctag;
1338 int curlit = litidx;
1339 int d;
1340
1341 if (!matchtoken('='))
1342 {
1343 if (ident == iARRAY && dim[numdim - 1] == 0)
1344 {
1345 /* declared as "myvar[];" which is senseless (note: this *does* make
1346 * sense in the case of a iREFARRAY, which is a function parameter)
1347 */
1348 error(9); /* array has zero length -> invalid size */
1349 } /* if */
1350 if (numdim > 1)
1351 {
1352 /* initialize the indirection tables */
1353#if sDIMEN_MAX>2
1354#error Array algorithms for more than 2 dimensions are not implemented
1355#endif
1356 assert(numdim == 2);
1357 *size = calc_arraysize(dim, numdim, 0);
1358 for (d = 0; d < dim[0]; d++)
1359 stowlit((dim[0] + d * (dim[1] - 1)) * sizeof(cell));
1360 } /* if */
1361 return;
1362 } /* if */
1363
1364 if (ident == iVARIABLE)
1365 {
1366 assert(*size == 1);
1367 init(ident, &ctag);
1368 if (!matchtag(tag, ctag, TRUE))
1369 error(213); /* tag mismatch */
1370 }
1371 else
1372 {
1373 assert(numdim > 0);
1374 if (numdim == 1)
1375 {
1376 *size = initvector(ident, tag, dim[0], FALSE);
1377 }
1378 else
1379 {
1380 cell offs, dsize;
1381
1382 /* The simple algorithm below only works for arrays with one or
1383 * two dimensions. This should be some recursive algorithm.
1384 */
1385 if (dim[numdim - 1] != 0)
1386 /* set size to (known) full size */
1387 *size = calc_arraysize(dim, numdim, 0);
1388 /* dump indirection tables */
1389 for (d = 0; d < dim[0]; d++)
1390 stowlit(0);
1391 /* now dump individual vectors */
1392 needtoken('{');
1393 offs = dim[0];
1394 for (d = 0; d < dim[0]; d++)
1395 {
1396 litq[curlit + d] = offs * sizeof(cell);
1397 dsize = initvector(ident, tag, dim[1], TRUE);
1398 offs += dsize - 1;
1399 if (d + 1 < dim[0])
1400 needtoken(',');
1401 if (matchtoken('{') || matchtoken(tSTRING))
1402 /* expect a '{' or a string */
1403 lexpush();
1404 else
1405 break;
1406 } /* for */
1407 matchtoken(',');
1408 needtoken('}');
1409 } /* if */
1410 } /* if */
1411
1412 if (*size == 0)
1413 *size = litidx - curlit; /* number of elements defined */
1414}
1415
1416/* initvector
1417 * Initialize a single dimensional array
1418 */
1419static cell
1420initvector(int ident, int tag, cell size, int fillzero)
1421{
1422 cell prev1 = 0, prev2 = 0;
1423 int ctag;
1424 int ellips = FALSE;
1425 int curlit = litidx;
1426
1427 assert(ident == iARRAY || ident == iREFARRAY);
1428 if (matchtoken('{'))
1429 {
1430 do
1431 {
1432 if (matchtoken('}'))
1433 { /* to allow for trailing ',' after the initialization */
1434 lexpush();
1435 break;
1436 } /* if */
1437 if ((ellips = matchtoken(tELLIPS)) != 0)
1438 break;
1439 prev2 = prev1;
1440 prev1 = init(ident, &ctag);
1441 if (!matchtag(tag, ctag, TRUE))
1442 error(213); /* tag mismatch */
1443 }
1444 while (matchtoken(',')); /* do */
1445 needtoken('}');
1446 }
1447 else
1448 {
1449 init(ident, &ctag);
1450 if (!matchtag(tag, ctag, TRUE))
1451 error(213); /* tagname mismatch */
1452 } /* if */
1453 /* fill up the literal queue with a series */
1454 if (ellips)
1455 {
1456 cell step =
1457 ((litidx - curlit) == 1) ? (cell) 0 : prev1 - prev2;
1458 if (size == 0 || (litidx - curlit) == 0)
1459 error(41); /* invalid ellipsis, array size unknown */
1460 else if ((litidx - curlit) == (int)size)
1461 error(18); /* initialisation data exceeds declared size */
1462 while ((litidx - curlit) < (int)size)
1463 {
1464 prev1 += step;
1465 stowlit(prev1);
1466 } /* while */
1467 } /* if */
1468 if (fillzero && size > 0)
1469 {
1470 while ((litidx - curlit) < (int)size)
1471 stowlit(0);
1472 } /* if */
1473 if (size == 0)
1474 {
1475 size = litidx - curlit; /* number of elements defined */
1476 }
1477 else if (litidx - curlit > (int)size)
1478 { /* e.g. "myvar[3]={1,2,3,4};" */
1479 error(18); /* initialisation data exceeds declared size */
1480 litidx = (int)size + curlit; /* avoid overflow in memory moves */
1481 } /* if */
1482 return size;
1483}
1484
1485/* init
1486 *
1487 * Evaluate one initializer.
1488 */
1489static cell
1490init(int ident, int *tag)
1491{
1492 cell i = 0;
1493
1494 if (matchtoken(tSTRING))
1495 {
1496 /* lex() automatically stores strings in the literal table (and
1497 * increases "litidx") */
1498 if (ident == iVARIABLE)
1499 {
1500 error(6); /* must be assigned to an array */
1501 litidx = 1; /* reset literal queue */
1502 } /* if */
1503 *tag = 0;
1504 }
1505 else if (constexpr(&i, tag))
1506 {
1507 stowlit(i); /* store expression result in literal table */
1508 } /* if */
1509 return i;
1510}
1511
1512/* needsub
1513 *
1514 * Get required array size
1515 */
1516static cell
1517needsub(int *tag)
1518{
1519 cell val;
1520
1521 *tag = 0;
1522 if (matchtoken(']')) /* we've already seen "[" */
1523 return 0; /* null size (like "char msg[]") */
1524 constexpr(&val, tag); /* get value (must be constant expression) */
1525 if (val < 0)
1526 {
1527 error(9); /* negative array size is invalid; assumed zero */
1528 val = 0;
1529 } /* if */
1530 needtoken(']');
1531 return val; /* return array size */
1532}
1533
1534/* decl_const - declare a single constant
1535 *
1536 */
1537static void
1538decl_const(int vclass)
1539{
1540 char constname[sNAMEMAX + 1];
1541 cell val;
1542 char *str;
1543 int tag, exprtag;
1544 int symbolline;
1545
1546 tag = sc_addtag(NULL);
1547 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1548 error(20, str); /* invalid symbol name */
1549 symbolline = fline; /* save line where symbol was found */
1550 strcpy(constname, str); /* save symbol name */
1551 needtoken('=');
1552 constexpr(&val, &exprtag); /* get value */
1553 needtoken(tTERM);
1554 /* add_constant() checks for duplicate definitions */
1555 if (!matchtag(tag, exprtag, FALSE))
1556 {
1557 /* temporarily reset the line number to where the symbol was
1558 * defined */
1559 int orgfline = fline;
1560
1561 fline = symbolline;
1562 error(213); /* tagname mismatch */
1563 fline = orgfline;
1564 } /* if */
1565 add_constant(constname, val, vclass, tag);
1566}
1567
1568/* decl_enum - declare enumerated constants
1569 *
1570 */
1571static void
1572decl_enum(int vclass)
1573{
1574 char enumname[sNAMEMAX + 1], constname[sNAMEMAX + 1];
1575 cell val, value, size;
1576 char *str;
1577 int tok, tag, explicittag;
1578 cell increment, multiplier;
1579
1580 /* get an explicit tag, if any (we need to remember whether an
1581 * explicit tag was passed, even if that explicit tag was "_:", so we
1582 * cannot call sc_addtag() here
1583 */
1584 if (lex(&val, &str) == tLABEL)
1585 {
1586 tag = sc_addtag(str);
1587 explicittag = TRUE;
1588 }
1589 else
1590 {
1591 lexpush();
1592 tag = 0;
1593 explicittag = FALSE;
1594 } /* if */
1595
1596 /* get optional enum name (also serves as a tag if no explicit
1597 * tag was set) */
1598 if (lex(&val, &str) == tSYMBOL)
1599 { /* read in (new) token */
1600 strcpy(enumname, str); /* save enum name (last constant) */
1601 if (!explicittag)
1602 tag = sc_addtag(enumname);
1603 }
1604 else
1605 {
1606 lexpush(); /* analyze again */
1607 enumname[0] = '\0';
1608 } /* if */
1609
1610 /* get increment and multiplier */
1611 increment = 1;
1612 multiplier = 1;
1613 if (matchtoken('('))
1614 {
1615 if (matchtoken(taADD))
1616 {
1617 constexpr(&increment, NULL);
1618 }
1619 else if (matchtoken(taMULT))
1620 {
1621 constexpr(&multiplier, NULL);
1622 }
1623 else if (matchtoken(taSHL))
1624 {
1625 constexpr(&val, NULL);
1626 while (val-- > 0)
1627 multiplier *= 2;
1628 } /* if */
1629 needtoken(')');
1630 } /* if */
1631
1632 needtoken('{');
1633 /* go through all constants */
1634 value = 0; /* default starting value */
1635 do
1636 {
1637 if (matchtoken('}'))
1638 { /* quick exit if '}' follows ',' */
1639 lexpush();
1640 break;
1641 } /* if */
1642 tok = lex(&val, &str); /* read in (new) token */
1643 if (tok != tSYMBOL && tok != tLABEL)
1644 error(20, str); /* invalid symbol name */
1645 strcpy(constname, str); /* save symbol name */
1646 size = increment; /* default increment of 'val' */
1647 if (tok == tLABEL || matchtoken(':'))
1648 constexpr(&size, NULL); /* get size */
1649 if (matchtoken('='))
1650 constexpr(&value, NULL); /* get value */
1651 /* add_constant() checks whether a variable (global or local) or
1652 * a constant with the same name already exists */
1653 add_constant(constname, value, vclass, tag);
1654 if (multiplier == 1)
1655 value += size;
1656 else
1657 value *= size * multiplier;
1658 }
1659 while (matchtoken(','));
1660 needtoken('}'); /* terminates the constant list */
1661 matchtoken(';'); /* eat an optional ; */
1662
1663 /* set the enum name to the last value plus one */
1664 if (enumname[0] != '\0')
1665 add_constant(enumname, value, vclass, tag);
1666}
1667
1668/*
1669 * Finds a function in the global symbol table or creates a new entry.
1670 * It does some basic processing and error checking.
1671 */
1672symbol *
1673fetchfunc(char *name, int tag)
1674{
1675 symbol *sym;
1676 cell offset;
1677
1678 offset = code_idx;
1679 if ((sc_debug & sSYMBOLIC) != 0)
1680 {
1681 offset += opcodes(1) + opargs(3) + nameincells(name);
1682 /* ^^^ The address for the symbol is the code address. But the
1683 * "symbol" instruction itself generates code. Therefore the
1684 * offset is pre-adjusted to the value it will have after the
1685 * symbol instruction.
1686 */
1687 } /* if */
1688 if ((sym = findglb(name)))
1689 { /* already in symbol table? */
1690 if (sym->ident != iFUNCTN)
1691 {
1692 error(21, name); /* yes, but not as a function */
1693 return NULL; /* make sure the old symbol is not damaged */
1694 }
1695 else if ((sym->usage & uDEFINE) != 0)
1696 {
1697 error(21, name); /* yes, and it's already defined */
1698 }
1699 else if ((sym->usage & uNATIVE) != 0)
1700 {
1701 error(21, name); /* yes, and it is an native */
1702 } /* if */
1703 assert(sym->vclass == sGLOBAL);
1704 if ((sym->usage & uDEFINE) == 0)
1705 {
1706 /* as long as the function stays undefined, update the address
1707 * and the tag */
1708 sym->addr = offset;
1709 sym->tag = tag;
1710 } /* if */
1711 }
1712 else
1713 {
1714 /* don't set the "uDEFINE" flag; it may be a prototype */
1715 sym = addsym(name, offset, iFUNCTN, sGLOBAL, tag, 0);
1716 /* assume no arguments */
1717 sym->dim.arglist = (arginfo *) malloc(1 * sizeof(arginfo));
1718 sym->dim.arglist[0].ident = 0;
1719 /* set library ID to NULL (only for native functions) */
1720 sym->x.lib = NULL;
1721 } /* if */
1722 return sym;
1723}
1724
1725/* This routine adds symbolic information for each argument.
1726 */
1727static void
1728define_args(void)
1729{
1730 symbol *sym;
1731
1732 /* At this point, no local variables have been declared. All
1733 * local symbols are function arguments.
1734 */
1735 sym = loctab.next;
1736 while (sym)
1737 {
1738 assert(sym->ident != iLABEL);
1739 assert(sym->vclass == sLOCAL);
1740 defsymbol(sym->name, sym->ident, sLOCAL, sym->addr, sym->tag);
1741 if (sym->ident == iREFARRAY)
1742 {
1743 symbol *sub = sym;
1744
1745 while (sub)
1746 {
1747 symbolrange(sub->dim.array.level, sub->dim.array.length);
1748 sub = finddepend(sub);
1749 } /* while */
1750 } /* if */
1751 sym = sym->next;
1752 } /* while */
1753}
1754
1755static int
1756operatorname(char *name)
1757{
1758 int opertok;
1759 char *str;
1760 cell val;
1761
1762 assert(name != NULL);
1763
1764 /* check the operator */
1765 opertok = lex(&val, &str);
1766 switch (opertok)
1767 {
1768 case '+':
1769 case '-':
1770 case '*':
1771 case '/':
1772 case '%':
1773 case '>':
1774 case '<':
1775 case '!':
1776 case '~':
1777 case '=':
1778 name[0] = (char)opertok;
1779 name[1] = '\0';
1780 break;
1781 case tINC:
1782 strcpy(name, "++");
1783 break;
1784 case tDEC:
1785 strcpy(name, "--");
1786 break;
1787 case tlEQ:
1788 strcpy(name, "==");
1789 break;
1790 case tlNE:
1791 strcpy(name, "!=");
1792 break;
1793 case tlLE:
1794 strcpy(name, "<=");
1795 break;
1796 case tlGE:
1797 strcpy(name, ">=");
1798 break;
1799 default:
1800 name[0] = '\0';
1801 error(61); /* operator cannot be redefined
1802 * (or bad operator name) */
1803 return 0;
1804 } /* switch */
1805
1806 return opertok;
1807}
1808
1809static int
1810operatoradjust(int opertok, symbol * sym, char *opername, int resulttag)
1811{
1812 int tags[2] = { 0, 0 };
1813 int count = 0;
1814 arginfo *arg;
1815 char tmpname[sNAMEMAX + 1];
1816 symbol *oldsym;
1817
1818 if (opertok == 0)
1819 return TRUE;
1820
1821 /* count arguments and save (first two) tags */
1822 while (arg = &sym->dim.arglist[count], arg->ident != 0)
1823 {
1824 if (count < 2)
1825 {
1826 if (arg->numtags > 1)
1827 error(65, count + 1); /* function argument may only have
1828 * a single tag */
1829 else if (arg->numtags == 1)
1830 tags[count] = arg->tags[0];
1831 } /* if */
1832 if (opertok == '~' && count == 0)
1833 {
1834 if (arg->ident != iREFARRAY)
1835 error(73, arg->name); /* must be an array argument */
1836 }
1837 else
1838 {
1839 if (arg->ident != iVARIABLE)
1840 error(66, arg->name); /* must be non-reference argument */
1841 } /* if */
1842 if (arg->hasdefault)
1843 error(59, arg->name); /* arguments of an operator may not
1844 * have a default value */
1845 count++;
1846 } /* while */
1847
1848 /* for '!', '++' and '--', count must be 1
1849 * for '-', count may be 1 or 2
1850 * for '=', count must be 1, and the resulttag is also important
1851 * for all other (binary) operators and the special '~'
1852 * operator, count must be 2
1853 */
1854 switch (opertok)
1855 {
1856 case '!':
1857 case '=':
1858 case tINC:
1859 case tDEC:
1860 if (count != 1)
1861 error(62); /* number or placement of the operands does
1862 * not fit the operator */
1863 break;
1864 case '-':
1865 if (count != 1 && count != 2)
1866 error(62); /* number or placement of the operands does
1867 * not fit the operator */
1868 break;
1869 default:
1870 if (count != 2)
1871 error(62); /* number or placement of the operands does
1872 * not fit the operator */
1873 } /* switch */
1874
1875 if (tags[0] == 0
1876 && ((opertok != '=' && tags[1] == 0) || (opertok == '=' && resulttag == 0)))
1877 error(64); /* cannot change predefined operators */
1878
1879 /* change the operator name */
1880 assert(opername[0] != '\0');
1881 operator_symname(tmpname, opername, tags[0], tags[1], count, resulttag);
1882 if ((oldsym = findglb(tmpname)))
1883 {
1884 int i;
1885
1886 if ((oldsym->usage & uDEFINE) != 0)
1887 {
1888 char errname[2 * sNAMEMAX + 16];
1889
1890 funcdisplayname(errname, tmpname);
1891 error(21, errname); /* symbol already defined */
1892 } /* if */
1893 sym->usage |= oldsym->usage; /* copy flags from the previous
1894 * definition */
1895 for (i = 0; i < oldsym->numrefers; i++)
1896 if (oldsym->refer[i])
1897 refer_symbol(sym, oldsym->refer[i]);
1898 delete_symbol(&glbtab, oldsym);
1899 } /* if */
1900 if ((sc_debug & sSYMBOLIC) != 0)
1901 sym->addr += nameincells(tmpname) - nameincells(sym->name);
1902 strcpy(sym->name, tmpname);
1903 sym->hash = namehash(sym->name); /* calculate new hash */
1904
1905 /* operators should return a value, except the '~' operator */
1906 if (opertok != '~')
1907 sym->usage |= uRETVALUE;
1908
1909 return TRUE;
1910}
1911
1912static int
1913check_operatortag(int opertok, int resulttag, char *opername)
1914{
1915 assert(opername != NULL && opername[0] != '\0');
1916 switch (opertok)
1917 {
1918 case '!':
1919 case '<':
1920 case '>':
1921 case tlEQ:
1922 case tlNE:
1923 case tlLE:
1924 case tlGE:
1925 if (resulttag != sc_addtag("bool"))
1926 {
1927 error(63, opername, "bool:"); /* operator X requires
1928 * a "bool:" result tag */
1929 return FALSE;
1930 } /* if */
1931 break;
1932 case '~':
1933 if (resulttag != 0)
1934 {
1935 error(63, opername, "_:"); /* operator "~" requires
1936 * a "_:" result tag */
1937 return FALSE;
1938 } /* if */
1939 break;
1940 } /* switch */
1941 return TRUE;
1942}
1943
1944static char *
1945tag2str(char *dest, int tag)
1946{
1947 tag &= TAGMASK;
1948 assert(tag >= 0);
1949 sprintf(dest, "0%x", tag);
1950 return isdigit(dest[1]) ? &dest[1] : dest;
1951}
1952
1953char *
1954operator_symname(char *symname, char *opername, int tag1, int tag2,
1955 int numtags, int resulttag)
1956{
1957 char tagstr1[10], tagstr2[10];
1958 int opertok;
1959
1960 assert(numtags >= 1 && numtags <= 2);
1961 opertok = (opername[1] == '\0') ? opername[0] : 0;
1962 if (opertok == '=')
1963 sprintf(symname, "%s%s%s", tag2str(tagstr1, resulttag), opername,
1964 tag2str(tagstr2, tag1));
1965 else if (numtags == 1 || opertok == '~')
1966 sprintf(symname, "%s%s", opername, tag2str(tagstr1, tag1));
1967 else
1968 sprintf(symname, "%s%s%s", tag2str(tagstr1, tag1), opername,
1969 tag2str(tagstr2, tag2));
1970 return symname;
1971}
1972
1973static int
1974parse_funcname(char *fname, int *tag1, int *tag2, char *opname)
1975{
1976 char *ptr, *name;
1977 int unary;
1978
1979 /* tags are only positive, so if the function name starts with a '-',
1980 * the operator is an unary '-' or '--' operator.
1981 */
1982 if (*fname == '-')
1983 {
1984 *tag1 = 0;
1985 unary = TRUE;
1986 ptr = fname;
1987 }
1988 else
1989 {
1990 *tag1 = (int)strtol(fname, &ptr, 16);
1991 unary = ptr == fname; /* unary operator if it doesn't start
1992 * with a tag name */
1993 } /* if */
1994 assert(!unary || *tag1 == 0);
1995 assert(*ptr != '\0');
1996 for (name = opname; !isdigit(*ptr);)
1997 *name++ = *ptr++;
1998 *name = '\0';
1999 *tag2 = (int)strtol(ptr, NULL, 16);
2000 return unary;
2001}
2002
2003char *
2004funcdisplayname(char *dest, char *funcname)
2005{
2006 int tags[2];
2007 char opname[10];
2008 constvalue *tagsym[2];
2009 int unary;
2010
2011 if (isalpha(*funcname) || *funcname == '_' || *funcname == PUBLIC_CHAR
2012 || *funcname == '\0')
2013 {
2014 if (dest != funcname)
2015 strcpy(dest, funcname);
2016 return dest;
2017 } /* if */
2018
2019 unary = parse_funcname(funcname, &tags[0], &tags[1], opname);
2020 tagsym[1] = find_constval_byval(&tagname_tab, tags[1]);
2021 assert(tagsym[1] != NULL);
2022 if (unary)
2023 {
2024 sprintf(dest, "operator%s(%s:)", opname, tagsym[1]->name);
2025 }
2026 else
2027 {
2028 tagsym[0] = find_constval_byval(&tagname_tab, tags[0]);
2029 /* special case: the assignment operator has the return value
2030 * as the 2nd tag */
2031 if (opname[0] == '=' && opname[1] == '\0')
2032 sprintf(dest, "%s:operator%s(%s:)", tagsym[0]->name, opname,
2033 tagsym[1]->name);
2034 else
2035 sprintf(dest, "operator%s(%s:,%s:)", opname, tagsym[0]->name,
2036 tagsym[1]->name);
2037 } /* if */
2038 return dest;
2039}
2040
2041static void
2042funcstub(int native)
2043{
2044 int tok, tag;
2045 char *str;
2046 cell val;
2047 char symbolname[sNAMEMAX + 1];
2048 symbol *sym;
2049 int opertok;
2050
2051 opertok = 0;
2052 lastst = 0;
2053 litidx = 0; /* clear the literal pool */
2054
2055 tag = sc_addtag(NULL);
2056 tok = lex(&val, &str);
2057 if (native)
2058 {
2059 if (tok == tPUBLIC || tok == tSTOCK || tok == tSTATIC ||
2060 (tok == tSYMBOL && *str == PUBLIC_CHAR))
2061 error(42); /* invalid combination of class specifiers */
2062 }
2063 else
2064 {
2065 if (tok == tPUBLIC || tok == tSTATIC)
2066 tok = lex(&val, &str);
2067 } /* if */
2068 if (tok == tOPERATOR)
2069 {
2070 opertok = operatorname(symbolname);
2071 if (opertok == 0)
2072 return; /* error message already given */
2073 check_operatortag(opertok, tag, symbolname);
2074 }
2075 else
2076 {
2077 if (tok != tSYMBOL && freading)
2078 {
2079 error(10); /* illegal function or declaration */
2080 return;
2081 } /* if */
2082 strcpy(symbolname, str);
2083 } /* if */
2084 needtoken('('); /* only functions may be native/forward */
2085
2086 sym = fetchfunc(symbolname, tag); /* get a pointer to the
2087 * function entry */
2088 if (!sym)
2089 return;
2090 if (native)
2091 {
2092 sym->usage = uNATIVE | uRETVALUE | uDEFINE;
2093 sym->x.lib = curlibrary;
2094 } /* if */
2095
2096 declargs(sym);
2097 /* "declargs()" found the ")" */
2098 if (!operatoradjust(opertok, sym, symbolname, tag))
2099 sym->usage &= ~uDEFINE;
2100 /* for a native operator, also need to specify an "exported"
2101 * function name; for a native function, this is optional
2102 */
2103 if (native)
2104 {
2105 if (opertok != 0)
2106 {
2107 needtoken('=');
2108 lexpush(); /* push back, for matchtoken() to retrieve again */
2109 } /* if */
2110 if (matchtoken('='))
2111 {
2112 /* allow number or symbol */
2113 if (matchtoken(tSYMBOL))
2114 {
2115 tokeninfo(&val, &str);
2116 if (strlen(str) > sEXPMAX)
2117 {
2118 error(220, str, sEXPMAX);
2119 str[sEXPMAX] = '\0';
2120 } /* if */
2121 insert_alias(sym->name, str);
2122 }
2123 else
2124 {
2125 constexpr(&val, NULL);
2126 sym->addr = val;
2127 /*
2128 * ?? Must mark this address, so that it won't be generated again
2129 * and it won't be written to the output file. At the moment,
2130 * I have assumed that this syntax is only valid if val < 0.
2131 * To properly mix "normal" native functions and indexed native
2132 * functions, one should use negative indices anyway.
2133 * Special code for a negative index in sym->addr exists in
2134 * SC4.C (ffcall()) and in SC6.C (the loops for counting the
2135 * number of native variables and for writing them).
2136 */
2137 } /* if */
2138 } /* if */
2139 } /* if */
2140 needtoken(tTERM);
2141
2142 litidx = 0; /* clear the literal pool */
2143 /* clear local variables queue */
2144 delete_symbols(&loctab, 0, TRUE, TRUE);
2145}
2146
2147/* newfunc - begin a function
2148 *
2149 * This routine is called from "parse" and tries to make a function
2150 * out of the following text
2151 *
2152 * Global references: funcstatus,lastst,litidx
2153 * rettype (altered)
2154 * curfunc (altered)
2155 * declared (altered)
2156 * glb_declared (altered)
2157 * sc_alignnext (altered)
2158 */
2159static int
2160newfunc(char *firstname, int firsttag, int fpublic, int fstatic, int stock)
2161{
2162 symbol *sym;
2163 int argcnt, tok, tag, funcline;
2164 int opertok, opererror;
2165 char symbolname[sNAMEMAX + 1];
2166 char *str;
2167 cell val, cidx, glbdecl;
2168 int filenum;
2169
2170 litidx = 0; /* clear the literal pool ??? */
2171 opertok = 0;
2172 lastst = 0; /* no statement yet */
2173 cidx = 0; /* just to avoid compiler warnings */
2174 glbdecl = 0;
2175 filenum = fcurrent; /* save file number at start of declaration */
2176
2177 if (firstname)
2178 {
2179 assert(strlen(firstname) <= sNAMEMAX);
2180 strcpy(symbolname, firstname); /* save symbol name */
2181 tag = firsttag;
2182 }
2183 else
2184 {
2185 tag = (firsttag >= 0) ? firsttag : sc_addtag(NULL);
2186 tok = lex(&val, &str);
2187 assert(!fpublic);
2188 if (tok == tNATIVE || (tok == tPUBLIC && stock))
2189 error(42); /* invalid combination of class specifiers */
2190 if (tok == tOPERATOR)
2191 {
2192 opertok = operatorname(symbolname);
2193 if (opertok == 0)
2194 return TRUE; /* error message already given */
2195 check_operatortag(opertok, tag, symbolname);
2196 }
2197 else
2198 {
2199 if (tok != tSYMBOL && freading)
2200 {
2201 error(20, str); /* invalid symbol name */
2202 return FALSE;
2203 } /* if */
2204 assert(strlen(str) <= sNAMEMAX);
2205 strcpy(symbolname, str);
2206 } /* if */
2207 } /* if */
2208 /* check whether this is a function or a variable declaration */
2209 if (!matchtoken('('))
2210 return FALSE;
2211 /* so it is a function, proceed */
2212 funcline = fline; /* save line at which the function is defined */
2213 if (symbolname[0] == PUBLIC_CHAR)
2214 {
2215 fpublic = TRUE; /* implicitly public function */
2216 if (stock)
2217 error(42); /* invalid combination of class specifiers */
2218 } /* if */
2219 sym = fetchfunc(symbolname, tag); /* get a pointer to the
2220 * function entry */
2221 if (!sym)
2222 return TRUE;
2223 if (fpublic)
2224 sym->usage |= uPUBLIC;
2225 if (fstatic)
2226 sym->fnumber = filenum;
2227 /* declare all arguments */
2228 argcnt = declargs(sym);
2229 opererror = !operatoradjust(opertok, sym, symbolname, tag);
2230 if (strcmp(symbolname, uMAINFUNC) == 0)
2231 {
2232 if (argcnt > 0)
2233 error(5); /* "main()" function may not have any arguments */
2234 sym->usage |= uREAD; /* "main()" is the program's entry point:
2235 * always used */
2236 } /* if */
2237 /* "declargs()" found the ")"; if a ";" appears after this, it was a
2238 * prototype */
2239 if (matchtoken(';'))
2240 {
2241 if (!sc_needsemicolon)
2242 error(218); /* old style prototypes used with optional
2243 * semicolumns */
2244 delete_symbols(&loctab, 0, TRUE, TRUE); /* prototype is done;
2245 * forget everything */
2246 return TRUE;
2247 } /* if */
2248 /* so it is not a prototype, proceed */
2249 /* if this is a function that is not referred to (this can only be
2250 * detected in the second stage), shut code generation off */
2251 if (sc_status == statWRITE && (sym->usage & uREAD) == 0)
2252 {
2253 sc_status = statSKIP;
2254 cidx = code_idx;
2255 glbdecl = glb_declared;
2256 } /* if */
2257 begcseg();
2258 sym->usage |= uDEFINE; /* set the definition flag */
2259 if (fpublic)
2260 sym->usage |= uREAD; /* public functions are always "used" */
2261 if (stock)
2262 sym->usage |= uSTOCK;
2263 if (opertok != 0 && opererror)
2264 sym->usage &= ~uDEFINE;
2265 defsymbol(sym->name, iFUNCTN, sGLOBAL,
2266 code_idx + opcodes(1) + opargs(3) + nameincells(sym->name), tag);
2267 /* ^^^ The address for the symbol is the code address. But the
2268 * "symbol" instruction itself generates code. Therefore the
2269 * offset is pre-adjusted to the value it will have after the
2270 * symbol instruction.
2271 */
2272 startfunc(sym->name); /* creates stack frame */
2273 if ((sc_debug & sSYMBOLIC) != 0)
2274 setline(funcline, fcurrent);
2275 if (sc_alignnext)
2276 {
2277 alignframe(sc_dataalign);
2278 sc_alignnext = FALSE;
2279 } /* if */
2280 declared = 0; /* number of local cells */
2281 rettype = (sym->usage & uRETVALUE); /* set "return type" variable */
2282 curfunc = sym;
2283 define_args(); /* add the symbolic info for the function arguments */
2284 statement(NULL, FALSE);
2285 if ((rettype & uRETVALUE) != 0)
2286 sym->usage |= uRETVALUE;
2287 if (declared != 0)
2288 {
2289 /* This happens only in a very special (and useless) case, where a
2290 * function has only a single statement in its body (no compound
2291 * block) and that statement declares a new variable
2292 */
2293 modstk((int)declared * sizeof(cell)); /* remove all local
2294 * variables */
2295 declared = 0;
2296 } /* if */
2297 if ((lastst != tRETURN) && (lastst != tGOTO))
2298 {
2299 const1(0);
2300 ffret();
2301 if ((sym->usage & uRETVALUE) != 0)
2302 {
2303 char symname[2 * sNAMEMAX + 16]; /* allow space for user
2304 * defined operators */
2305 funcdisplayname(symname, sym->name);
2306 error(209, symname); /* function should return a value */
2307 } /* if */
2308 } /* if */
2309 endfunc();
2310 if (litidx)
2311 { /* if there are literals defined */
2312 glb_declared += litidx;
2313 begdseg(); /* flip to DATA segment */
2314 dumplits(); /* dump literal strings */
2315 litidx = 0;
2316 } /* if */
2317 testsymbols(&loctab, 0, TRUE, TRUE); /* test for unused arguments
2318 * and labels */
2319 delete_symbols(&loctab, 0, TRUE, TRUE); /* clear local variables
2320 * queue */
2321 assert(loctab.next == NULL);
2322 curfunc = NULL;
2323 if (sc_status == statSKIP)
2324 {
2325 sc_status = statWRITE;
2326 code_idx = cidx;
2327 glb_declared = glbdecl;
2328 } /* if */
2329 return TRUE;
2330}
2331
2332static int
2333argcompare(arginfo * a1, arginfo * a2)
2334{
2335 int result, level;
2336
2337 result = strcmp(a1->name, a2->name) == 0;
2338 if (result)
2339 result = a1->ident == a2->ident;
2340 if (result)
2341 result = a1->usage == a2->usage;
2342 if (result)
2343 result = a1->numtags == a2->numtags;
2344 if (result)
2345 {
2346 int i;
2347
2348 for (i = 0; i < a1->numtags && result; i++)
2349 result = a1->tags[i] == a2->tags[i];
2350 } /* if */
2351 if (result)
2352 result = a1->hasdefault == a2->hasdefault;
2353 if (a1->hasdefault)
2354 {
2355 if (a1->ident == iREFARRAY)
2356 {
2357 if (result)
2358 result = a1->defvalue.array.size == a2->defvalue.array.size;
2359 if (result)
2360 result =
2361 a1->defvalue.array.arraysize == a2->defvalue.array.arraysize;
2362 /* also check the dimensions of both arrays */
2363 if (result)
2364 result = a1->numdim == a2->numdim;
2365 for (level = 0; result && level < a1->numdim; level++)
2366 result = a1->dim[level] == a2->dim[level];
2367 /* ??? should also check contents of the default array
2368 * (these troubles go away in a 2-pass compiler that forbids
2369 * double declarations, but Small currently does not forbid them)
2370 */
2371 }
2372 else
2373 {
2374 if (result)
2375 {
2376 if ((a1->hasdefault & uSIZEOF) != 0
2377 || (a1->hasdefault & uTAGOF) != 0)
2378 result = a1->hasdefault == a2->hasdefault
2379 && strcmp(a1->defvalue.size.symname,
2380 a2->defvalue.size.symname) == 0
2381 && a1->defvalue.size.level == a2->defvalue.size.level;
2382 else
2383 result = a1->defvalue.val == a2->defvalue.val;
2384 } /* if */
2385 } /* if */
2386 if (result)
2387 result = a1->defvalue_tag == a2->defvalue_tag;
2388 } /* if */
2389 return result;
2390}
2391
2392/* declargs()
2393 *
2394 * This routine adds an entry in the local symbol table for each
2395 * argument found in the argument list.
2396 * It returns the number of arguments.
2397 */
2398static int
2399declargs(symbol * sym)
2400{
2401#define MAXTAGS 16
2402 char *ptr;
2403 int argcnt, oldargcnt, tok, tags[MAXTAGS], numtags;
2404 cell val;
2405 arginfo arg, *arglist;
2406 char name[sNAMEMAX + 1];
2407 int ident, fpublic, fconst;
2408 int idx;
2409
2410 /* if the function is already defined earlier, get the number of
2411 * arguments of the existing definition
2412 */
2413 oldargcnt = 0;
2414 if ((sym->usage & uPROTOTYPED) != 0)
2415 while (sym->dim.arglist[oldargcnt].ident != 0)
2416 oldargcnt++;
2417 argcnt = 0; /* zero aruments up to now */
2418 ident = iVARIABLE;
2419 numtags = 0;
2420 fconst = FALSE;
2421 fpublic = (sym->usage & uPUBLIC) != 0;
2422 /* the '(' parantheses has already been parsed */
2423 if (!matchtoken(')'))
2424 {
2425 do
2426 { /* there are arguments; process them */
2427 /* any legal name increases argument count (and stack offset) */
2428 tok = lex(&val, &ptr);
2429 switch (tok)
2430 {
2431 case 0:
2432 /* nothing */
2433 break;
2434 case '&':
2435 if (ident != iVARIABLE || numtags > 0)
2436 error(1, "-identifier-", "&");
2437 ident = iREFERENCE;
2438 break;
2439 case tCONST:
2440 if (ident != iVARIABLE || numtags > 0)
2441 error(1, "-identifier-", "const");
2442 fconst = TRUE;
2443 break;
2444 case tLABEL:
2445 if (numtags > 0)
2446 error(1, "-identifier-", "-tagname-");
2447 tags[0] = sc_addtag(ptr);
2448 numtags = 1;
2449 break;
2450 case '{':
2451 if (numtags > 0)
2452 error(1, "-identifier-", "-tagname-");
2453 numtags = 0;
2454 while (numtags < MAXTAGS)
2455 {
2456 if (!matchtoken('_') && !needtoken(tSYMBOL))
2457 break;
2458 tokeninfo(&val, &ptr);
2459 tags[numtags++] = sc_addtag(ptr);
2460 if (matchtoken('}'))
2461 break;
2462 needtoken(',');
2463 } /* for */
2464 needtoken(':');
2465 tok = tLABEL; /* for outer loop:
2466 * flag that we have seen a tagname */
2467 break;
2468 case tSYMBOL:
2469 if (argcnt >= sMAXARGS)
2470 error(45); /* too many function arguments */
2471 strcpy(name, ptr); /* save symbol name */
2472 if (name[0] == PUBLIC_CHAR)
2473 error(56, name); /* function arguments cannot be public */
2474 if (numtags == 0)
2475 tags[numtags++] = 0; /* default tag */
2476 /* Stack layout:
2477 * base + 0*sizeof(cell) == previous "base"
2478 * base + 1*sizeof(cell) == function return address
2479 * base + 2*sizeof(cell) == number of arguments
2480 * base + 3*sizeof(cell) == first argument of the function
2481 * So the offset of each argument is:
2482 * "(argcnt+3) * sizeof(cell)".
2483 */
2484 doarg(name, ident, (argcnt + 3) * sizeof(cell), tags, numtags,
2485 fpublic, fconst, &arg);
2486 if (fpublic && arg.hasdefault)
2487 error(59, name); /* arguments of a public function may not
2488 * have a default value */
2489 if ((sym->usage & uPROTOTYPED) == 0)
2490 {
2491 /* redimension the argument list, add the entry */
2492 sym->dim.arglist =
2493 (arginfo *) realloc(sym->dim.arglist,
2494 (argcnt + 2) * sizeof(arginfo));
2495 if (!sym->dim.arglist)
2496 error(103); /* insufficient memory */
2497 sym->dim.arglist[argcnt] = arg;
2498 sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
2499 * terminated */
2500 }
2501 else
2502 {
2503 /* check the argument with the earlier definition */
2504 if (argcnt > oldargcnt
2505 || !argcompare(&sym->dim.arglist[argcnt], &arg))
2506 error(25); /* function definition does not match prototype */
2507 /* may need to free default array argument and the tag list */
2508 if (arg.ident == iREFARRAY && arg.hasdefault)
2509 free(arg.defvalue.array.data);
2510 else if (arg.ident == iVARIABLE
2511 && ((arg.hasdefault & uSIZEOF) != 0
2512 || (arg.hasdefault & uTAGOF) != 0))
2513 free(arg.defvalue.size.symname);
2514 free(arg.tags);
2515 } /* if */
2516 argcnt++;
2517 ident = iVARIABLE;
2518 numtags = 0;
2519 fconst = FALSE;
2520 break;
2521 case tELLIPS:
2522 if (ident != iVARIABLE)
2523 error(10); /* illegal function or declaration */
2524 if (numtags == 0)
2525 tags[numtags++] = 0; /* default tag */
2526 if ((sym->usage & uPROTOTYPED) == 0)
2527 {
2528 /* redimension the argument list, add the entry iVARARGS */
2529 sym->dim.arglist =
2530 (arginfo *) realloc(sym->dim.arglist,
2531 (argcnt + 2) * sizeof(arginfo));
2532 if (!sym->dim.arglist)
2533 error(103); /* insufficient memory */
2534 sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
2535 * terminated */
2536 sym->dim.arglist[argcnt].ident = iVARARGS;
2537 sym->dim.arglist[argcnt].hasdefault = FALSE;
2538 sym->dim.arglist[argcnt].defvalue.val = 0;
2539 sym->dim.arglist[argcnt].defvalue_tag = 0;
2540 sym->dim.arglist[argcnt].numtags = numtags;
2541 sym->dim.arglist[argcnt].tags =
2542 (int *)malloc(numtags * sizeof tags[0]);
2543 if (!sym->dim.arglist[argcnt].tags)
2544 error(103); /* insufficient memory */
2545 memcpy(sym->dim.arglist[argcnt].tags, tags,
2546 numtags * sizeof tags[0]);
2547 }
2548 else
2549 {
2550 if (argcnt > oldargcnt
2551 || sym->dim.arglist[argcnt].ident != iVARARGS)
2552 error(25); /* function definition does not match prototype */
2553 } /* if */
2554 argcnt++;
2555 break;
2556 default:
2557 error(10); /* illegal function or declaration */
2558 } /* switch */
2559 }
2560 while (tok == '&' || tok == tLABEL || tok == tCONST || (tok != tELLIPS && matchtoken(','))); /* more? */
2561 /* if the next token is not ",", it should be ")" */
2562 needtoken(')');
2563 } /* if */
2564 /* resolve any "sizeof" arguments (now that all arguments are known) */
2565 assert(sym->dim.arglist != NULL);
2566 arglist = sym->dim.arglist;
2567 for (idx = 0; idx < argcnt && arglist[idx].ident != 0; idx++)
2568 {
2569 if ((arglist[idx].hasdefault & uSIZEOF) != 0
2570 || (arglist[idx].hasdefault & uTAGOF) != 0)
2571 {
2572 int altidx;
2573
2574 /* Find the argument with the name mentioned after the "sizeof".
2575 * Note that we cannot use findloc here because we need the
2576 * arginfo struct, not the symbol.
2577 */
2578 ptr = arglist[idx].defvalue.size.symname;
2579 for (altidx = 0;
2580 altidx < argcnt && strcmp(ptr, arglist[altidx].name) != 0;
2581 altidx++)
2582 /* nothing */ ;
2583 if (altidx >= argcnt)
2584 {
2585 error(17, ptr); /* undefined symbol */
2586 }
2587 else
2588 {
2589 /* check the level against the number of dimensions */
2590 /* the level must be zero for "tagof" values */
2591 assert(arglist[idx].defvalue.size.level == 0
2592 || (arglist[idx].hasdefault & uSIZEOF) != 0);
2593 if (arglist[idx].defvalue.size.level > 0
2594 && arglist[idx].defvalue.size.level >=
2595 arglist[altidx].numdim)
2596 error(28); /* invalid subscript */
2597 if (arglist[altidx].ident != iREFARRAY)
2598 {
2599 assert(arglist[altidx].ident == iVARIABLE
2600 || arglist[altidx].ident == iREFERENCE);
2601 error(223, ptr); /* redundant sizeof */
2602 } /* if */
2603 } /* if */
2604 } /* if */
2605 } /* for */
2606
2607 sym->usage |= uPROTOTYPED;
2608 errorset(sRESET); /* reset error flag (clear the "panic mode") */
2609 return argcnt;
2610}
2611
2612/* doarg - declare one argument type
2613 *
2614 * this routine is called from "declargs()" and adds an entry in the
2615 * local symbol table for one argument. "fpublic" indicates whether
2616 * the function for this argument list is public.
2617 * The arguments themselves are never public.
2618 */
2619static void
2620doarg(char *name, int ident, int offset, int tags[], int numtags,
2621 int fpublic, int fconst, arginfo * arg)
2622{
2623 symbol *argsym;
2624 cell size;
2625 int idxtag[sDIMEN_MAX];
2626
2627 strcpy(arg->name, name);
2628 arg->hasdefault = FALSE; /* preset (most common case) */
2629 arg->defvalue.val = 0; /* clear */
2630 arg->defvalue_tag = 0;
2631 arg->numdim = 0;
2632 if (matchtoken('['))
2633 {
2634 if (ident == iREFERENCE)
2635 error(67, name); /*illegal declaration ("&name[]" is unsupported) */
2636 do
2637 {
2638 if (arg->numdim == sDIMEN_MAX)
2639 {
2640 error(53); /* exceeding maximum number of dimensions */
2641 return;
2642 } /* if */
2643 /* there is no check for non-zero major dimensions here, only if
2644 * the array parameter has a default value, we enforce that all
2645 * array dimensions, except the last, are non-zero
2646 */
2647 size = needsub(&idxtag[arg->numdim]); /* may be zero here,
2648 *it is a pointer anyway */
2649#if INT_MAX < LONG_MAX
2650 if (size > INT_MAX)
2651 error(105); /* overflow, exceeding capacity */
2652#endif
2653 arg->dim[arg->numdim] = (int)size;
2654 arg->numdim += 1;
2655 }
2656 while (matchtoken('['));
2657 ident = iREFARRAY; /* "reference to array" (is a pointer) */
2658 if (matchtoken('='))
2659 {
2660 int level;
2661
2662 lexpush(); /* initials() needs the "=" token again */
2663 assert(numtags > 0);
2664 /* for the moment, when a default value is given for the array,
2665 * all dimension sizes, except the last, must be non-zero
2666 * (function initials() requires to know the major dimensions)
2667 */
2668 for (level = 0; level < arg->numdim - 1; level++)
2669 if (arg->dim[level] == 0)
2670 error(52); /* only last dimension may be variable length */
2671 initials(ident, tags[0], &size, arg->dim, arg->numdim);
2672 assert(size >= litidx);
2673 /* allocate memory to hold the initial values */
2674 arg->defvalue.array.data = (cell *) malloc(litidx * sizeof(cell));
2675 if (arg->defvalue.array.data)
2676 {
2677 int i;
2678
2679 memcpy(arg->defvalue.array.data, litq, litidx * sizeof(cell));
2680 arg->hasdefault = TRUE; /* argument has default value */
2681 arg->defvalue.array.size = litidx;
2682 arg->defvalue.array.addr = -1;
2683 /* calculate size to reserve on the heap */
2684 arg->defvalue.array.arraysize = 1;
2685 for (i = 0; i < arg->numdim; i++)
2686 arg->defvalue.array.arraysize *= arg->dim[i];
2687 if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
2688 arg->defvalue.array.arraysize = arg->defvalue.array.size;
2689 } /* if */
2690 litidx = 0; /* reset */
2691 } /* if */
2692 }
2693 else
2694 {
2695 if (matchtoken('='))
2696 {
2697 unsigned char size_tag_token;
2698
2699 assert(ident == iVARIABLE || ident == iREFERENCE);
2700 arg->hasdefault = TRUE; /* argument has a default value */
2701 size_tag_token =
2702 (unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
2703 if (size_tag_token == 0)
2704 size_tag_token =
2705 (unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
2706 if (size_tag_token != 0)
2707 {
2708 int paranthese;
2709
2710 if (ident == iREFERENCE)
2711 error(66, name); /* argument may not be a reference */
2712 paranthese = 0;
2713 while (matchtoken('('))
2714 paranthese++;
2715 if (needtoken(tSYMBOL))
2716 {
2717 /* save the name of the argument whose size id to take */
2718 char *name;
2719 cell val;
2720
2721 tokeninfo(&val, &name);
2722 if (!(arg->defvalue.size.symname = strdup(name)))
2723 error(103); /* insufficient memory */
2724 arg->defvalue.size.level = 0;
2725 if (size_tag_token == uSIZEOF)
2726 {
2727 while (matchtoken('['))
2728 {
2729 arg->defvalue.size.level += (short)1;
2730 needtoken(']');
2731 } /* while */
2732 } /* if */
2733 if (ident == iVARIABLE) /* make sure we set this only if
2734 * not a reference */
2735 arg->hasdefault |= size_tag_token; /* uSIZEOF or uTAGOF */
2736 } /* if */
2737 while (paranthese--)
2738 needtoken(')');
2739 }
2740 else
2741 {
2742 constexpr(&arg->defvalue.val, &arg->defvalue_tag);
2743 assert(numtags > 0);
2744 if (!matchtag(tags[0], arg->defvalue_tag, TRUE))
2745 error(213); /* tagname mismatch */
2746 } /* if */
2747 } /* if */
2748 } /* if */
2749 arg->ident = (char)ident;
2750 arg->usage = (char)(fconst ? uCONST : 0);
2751 arg->numtags = numtags;
2752 arg->tags = (int *)malloc(numtags * sizeof tags[0]);
2753 if (!arg->tags)
2754 error(103); /* insufficient memory */
2755 memcpy(arg->tags, tags, numtags * sizeof tags[0]);
2756 argsym = findloc(name);
2757 if (argsym)
2758 {
2759 error(21, name); /* symbol already defined */
2760 }
2761 else
2762 {
2763 if ((argsym = findglb(name)) && argsym->ident != iFUNCTN)
2764 error(219, name); /* variable shadows another symbol */
2765 /* add details of type and address */
2766 assert(numtags > 0);
2767 argsym = addvariable(name, offset, ident, sLOCAL, tags[0],
2768 arg->dim, arg->numdim, idxtag);
2769 argsym->compound = 0;
2770 if (ident == iREFERENCE)
2771 argsym->usage |= uREAD; /* because references are passed back */
2772 if (fpublic)
2773 argsym->usage |= uREAD; /* arguments of public functions
2774 * are always "used" */
2775 if (fconst)
2776 argsym->usage |= uCONST;
2777 } /* if */
2778}
2779
2780static int
2781count_referrers(symbol * entry)
2782{
2783 int i, count;
2784
2785 count = 0;
2786 for (i = 0; i < entry->numrefers; i++)
2787 if (entry->refer[i])
2788 count++;
2789 return count;
2790}
2791
2792/* Every symbol has a referrer list, that contains the functions that
2793 * use the symbol. Now, if function "apple" is accessed by functions
2794 * "banana" and "citron", but neither function "banana" nor "citron" are
2795 * used by anyone else, then, by inference, function "apple" is not used
2796 * either. */
2797static void
2798reduce_referrers(symbol * root)
2799{
2800 int i, restart;
2801 symbol *sym, *ref;
2802
2803 do
2804 {
2805 restart = 0;
2806 for (sym = root->next; sym; sym = sym->next)
2807 {
2808 if (sym->parent)
2809 continue; /* hierarchical data type */
2810 if (sym->ident == iFUNCTN
2811 && (sym->usage & uNATIVE) == 0
2812 && (sym->usage & uPUBLIC) == 0
2813 && strcmp(sym->name, uMAINFUNC) != 0
2814 && count_referrers(sym) == 0)
2815 {
2816 sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
2817 * there is no referrer */
2818 /* find all symbols that are referred by this symbol */
2819 for (ref = root->next; ref; ref = ref->next)
2820 {
2821 if (ref->parent)
2822 continue; /* hierarchical data type */
2823 assert(ref->refer != NULL);
2824 for (i = 0; i < ref->numrefers && ref->refer[i] != sym;
2825 i++)
2826 /* nothing */ ;
2827 if (i < ref->numrefers)
2828 {
2829 assert(ref->refer[i] == sym);
2830 ref->refer[i] = NULL;
2831 restart++;
2832 } /* if */
2833 } /* for */
2834 }
2835 else if ((sym->ident == iVARIABLE || sym->ident == iARRAY)
2836 && (sym->usage & uPUBLIC) == 0
2837 && !sym->parent && count_referrers(sym) == 0)
2838 {
2839 sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
2840 * there is no referrer */
2841 } /* if */
2842 } /* for */
2843 /* after removing a symbol, check whether more can be removed */
2844 }
2845 while (restart > 0);
2846}
2847
2848/* testsymbols - test for unused local or global variables
2849 *
2850 * "Public" functions are excluded from the check, since these
2851 * may be exported to other object modules.
2852 * Labels are excluded from the check if the argument 'testlabs'
2853 * is 0. Thus, labels are not tested until the end of the function.
2854 * Constants may also be excluded (convenient for global constants).
2855 *
2856 * When the nesting level drops below "level", the check stops.
2857 *
2858 * The function returns whether there is an "entry" point for the file.
2859 * This flag will only be 1 when browsing the global symbol table.
2860 */
2861static int
2862testsymbols(symbol * root, int level, int testlabs, int testconst)
2863{
2864 char symname[2 * sNAMEMAX + 16];
2865 int entry = FALSE;
2866
2867 symbol *sym = root->next;
2868
2869 while (sym && sym->compound >= level)
2870 {
2871 switch (sym->ident)
2872 {
2873 case iLABEL:
2874 if (testlabs)
2875 {
2876 if ((sym->usage & uDEFINE) == 0)
2877 error(19, sym->name); /* not a label: ... */
2878 else if ((sym->usage & uREAD) == 0)
2879 error(203, sym->name); /* symbol isn't used: ... */
2880 } /* if */
2881 break;
2882 case iFUNCTN:
2883 if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK)) == uDEFINE)
2884 {
2885 funcdisplayname(symname, sym->name);
2886 if (symname[0] != '\0')
2887 error(203, symname); /* symbol isn't used ...
2888 * (and not native/stock) */
2889 } /* if */
2890 if ((sym->usage & uPUBLIC) != 0
2891 || strcmp(sym->name, uMAINFUNC) == 0)
2892 entry = TRUE; /* there is an entry point */
2893 break;
2894 case iCONSTEXPR:
2895 if (testconst && (sym->usage & uREAD) == 0)
2896 error(203, sym->name); /* symbol isn't used: ... */
2897 break;
2898 default:
2899 /* a variable */
2900 if (sym->parent)
2901 break; /* hierarchical data type */
2902 if ((sym->usage & (uWRITTEN | uREAD | uSTOCK | uPUBLIC)) == 0)
2903 error(203, sym->name); /* symbol isn't used (and not stock
2904 * or public) */
2905 else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC)) == 0)
2906 error(204, sym->name); /* value assigned to symbol is
2907 * never used */
2908#if 0 /*// ??? not sure whether it is a good idea to
2909 * force people use "const" */
2910 else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST)) == 0
2911 && sym->ident == iREFARRAY)
2912 error(214, sym->name); /* make array argument "const" */
2913#endif
2914 } /* if */
2915 sym = sym->next;
2916 } /* while */
2917
2918 return entry;
2919}
2920
2921static cell
2922calc_array_datasize(symbol * sym, cell * offset)
2923{
2924 cell length;
2925
2926 assert(sym != NULL);
2927 assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
2928 length = sym->dim.array.length;
2929 if (sym->dim.array.level > 0)
2930 {
2931 cell sublength =
2932 calc_array_datasize(finddepend(sym), offset);
2933 if (offset)
2934 *offset = length * (*offset + sizeof(cell));
2935 if (sublength > 0)
2936 length *= length * sublength;
2937 else
2938 length = 0;
2939 }
2940 else
2941 {
2942 if (offset)
2943 *offset = 0;
2944 } /* if */
2945 return length;
2946}
2947
2948static void
2949destructsymbols(symbol * root, int level)
2950{
2951 cell offset = 0;
2952 int savepri = FALSE;
2953 symbol *sym = root->next;
2954
2955 while (sym && sym->compound >= level)
2956 {
2957 if (sym->ident == iVARIABLE || sym->ident == iARRAY)
2958 {
2959 char symbolname[16];
2960 symbol *opsym;
2961 cell elements;
2962
2963 /* check that the '~' operator is defined for this tag */
2964 operator_symname(symbolname, "~", sym->tag, 0, 1, 0);
2965 if ((opsym = findglb(symbolname)))
2966 {
2967 /* save PRI, in case of a return statement */
2968 if (!savepri)
2969 {
2970 push1(); /* right-hand operand is in PRI */
2971 savepri = TRUE;
2972 } /* if */
2973 /* if the variable is an array, get the number of elements */
2974 if (sym->ident == iARRAY)
2975 {
2976 elements = calc_array_datasize(sym, &offset);
2977 /* "elements" can be zero when the variable is declared like
2978 * new mytag: myvar[2][] = { {1, 2}, {3, 4} }
2979 * one should declare all dimensions!
2980 */
2981 if (elements == 0)
2982 error(46, sym->name); /* array size is unknown */
2983 }
2984 else
2985 {
2986 elements = 1;
2987 offset = 0;
2988 } /* if */
2989 pushval(elements);
2990 /* call the '~' operator */
2991 address(sym);
2992 addconst(offset); /*add offset to array data to the address */
2993 push1();
2994 pushval(2 * sizeof(cell)); /* 2 parameters */
2995 ffcall(opsym, 1);
2996 if (sc_status != statSKIP)
2997 markusage(opsym, uREAD); /* do not mark as "used" when this
2998 * call itself is skipped */
2999 if (opsym->x.lib)
3000 opsym->x.lib->value += 1; /* increment "usage count"
3001 * of the library */
3002 } /* if */
3003 } /* if */
3004 sym = sym->next;
3005 } /* while */
3006 /* restore PRI, if it was saved */
3007 if (savepri)
3008 pop1();
3009}
3010
3011static constvalue *
3012insert_constval(constvalue * prev, constvalue * next, char *name,
3013 cell val, short index)
3014{
3015 constvalue *cur;
3016
3017 if (!(cur = (constvalue *)malloc(sizeof(constvalue))))
3018 error(103); /* insufficient memory (fatal error) */
3019 memset(cur, 0, sizeof(constvalue));
3020 strcpy(cur->name, name);
3021 cur->value = val;
3022 cur->index = index;
3023 cur->next = next;
3024 prev->next = cur;
3025 return cur;
3026}
3027
3028constvalue *
3029append_constval(constvalue * table, char *name, cell val, short index)
3030{
3031 constvalue *cur, *prev;
3032
3033 /* find the end of the constant table */
3034 for (prev = table, cur = table->next; cur;
3035 prev = cur, cur = cur->next)
3036 /* nothing */ ;
3037 return insert_constval(prev, NULL, name, val, index);
3038}
3039
3040constvalue *
3041find_constval(constvalue * table, char *name, short index)
3042{
3043 constvalue *ptr = table->next;
3044
3045 while (ptr)
3046 {
3047 if (strcmp(name, ptr->name) == 0 && ptr->index == index)
3048 return ptr;
3049 ptr = ptr->next;
3050 } /* while */
3051 return NULL;
3052}
3053
3054static constvalue *
3055find_constval_byval(constvalue * table, cell val)
3056{
3057 constvalue *ptr = table->next;
3058
3059 while (ptr)
3060 {
3061 if (ptr->value == val)
3062 return ptr;
3063 ptr = ptr->next;
3064 } /* while */
3065 return NULL;
3066}
3067
3068#if 0 /* never used */
3069static int
3070delete_constval(constvalue * table, char *name)
3071{
3072 constvalue *prev = table;
3073 constvalue *cur = prev->next;
3074
3075 while (cur != NULL)
3076 {
3077 if (strcmp(name, cur->name) == 0)
3078 {
3079 prev->next = cur->next;
3080 free(cur);
3081 return TRUE;
3082 } /* if */
3083 prev = cur;
3084 cur = cur->next;
3085 } /* while */
3086 return FALSE;
3087}
3088#endif
3089
3090void
3091delete_consttable(constvalue * table)
3092{
3093 constvalue *cur = table->next, *next;
3094
3095 while (cur)
3096 {
3097 next = cur->next;
3098 free(cur);
3099 cur = next;
3100 } /* while */
3101 memset(table, 0, sizeof(constvalue));
3102}
3103
3104/* add_constant
3105 *
3106 * Adds a symbol to the #define symbol table.
3107 */
3108void
3109add_constant(char *name, cell val, int vclass, int tag)
3110{
3111 symbol *sym;
3112
3113 /* Test whether a global or local symbol with the same name exists. Since
3114 * constants are stored in the symbols table, this also finds previously
3115 * defind constants. */
3116 sym = findglb(name);
3117 if (!sym)
3118 sym = findloc(name);
3119 if (sym)
3120 {
3121 /* silently ignore redefinitions of constants with the same value */
3122 if (sym->ident == iCONSTEXPR)
3123 {
3124 if (sym->addr != val)
3125 error(201, name); /* redefinition of constant (different value) */
3126 }
3127 else
3128 {
3129 error(21, name); /* symbol already defined */
3130 } /* if */
3131 return;
3132 } /* if */
3133
3134 /* constant doesn't exist yet, an entry must be created */
3135 sym = addsym(name, val, iCONSTEXPR, vclass, tag, uDEFINE);
3136 if (sc_status == statIDLE)
3137 sym->usage |= uPREDEF;
3138}
3139
3140/* statement - The Statement Parser
3141 *
3142 * This routine is called whenever the parser needs to know what
3143 * statement it encounters (i.e. whenever program syntax requires a
3144 * statement).
3145 */
3146static void
3147statement(int *lastindent, int allow_decl)
3148{
3149 int tok;
3150 cell val;
3151 char *st;
3152
3153 if (!freading)
3154 {
3155 error(36); /* empty statement */
3156 return;
3157 } /* if */
3158 errorset(sRESET);
3159
3160 tok = lex(&val, &st);
3161 if (tok != '{')
3162 setline(fline, fcurrent);
3163 /* lex() has set stmtindent */
3164 if (lastindent && tok != tLABEL)
3165 {
3166#if 0
3167 if (*lastindent >= 0 && *lastindent != stmtindent &&
3168 !indent_nowarn && sc_tabsize > 0)
3169 error(217); /* loose indentation */
3170#endif
3171 *lastindent = stmtindent;
3172 indent_nowarn = TRUE; /* if warning was blocked, re-enable it */
3173 } /* if */
3174 switch (tok)
3175 {
3176 case 0:
3177 /* nothing */
3178 break;
3179 case tNEW:
3180 if (allow_decl)
3181 {
3182 declloc(FALSE);
3183 lastst = tNEW;
3184 }
3185 else
3186 {
3187 error(3); /* declaration only valid in a block */
3188 } /* if */
3189 break;
3190 case tSTATIC:
3191 if (allow_decl)
3192 {
3193 declloc(TRUE);
3194 lastst = tNEW;
3195 }
3196 else
3197 {
3198 error(3); /* declaration only valid in a block */
3199 } /* if */
3200 break;
3201 case '{':
3202 if (!matchtoken('}')) /* {} is the empty statement */
3203 compound();
3204 /* lastst (for "last statement") does not change */
3205 break;
3206 case ';':
3207 error(36); /* empty statement */
3208 break;
3209 case tIF:
3210 doif();
3211 lastst = tIF;
3212 break;
3213 case tWHILE:
3214 dowhile();
3215 lastst = tWHILE;
3216 break;
3217 case tDO:
3218 dodo();
3219 lastst = tDO;
3220 break;
3221 case tFOR:
3222 dofor();
3223 lastst = tFOR;
3224 break;
3225 case tSWITCH:
3226 doswitch();
3227 lastst = tSWITCH;
3228 break;
3229 case tCASE:
3230 case tDEFAULT:
3231 error(14); /* not in switch */
3232 break;
3233 case tGOTO:
3234 dogoto();
3235 lastst = tGOTO;
3236 break;
3237 case tLABEL:
3238 dolabel();
3239 lastst = tLABEL;
3240 break;
3241 case tRETURN:
3242 doreturn();
3243 lastst = tRETURN;
3244 break;
3245 case tBREAK:
3246 dobreak();
3247 lastst = tBREAK;
3248 break;
3249 case tCONTINUE:
3250 docont();
3251 lastst = tCONTINUE;
3252 break;
3253 case tEXIT:
3254 doexit();
3255 lastst = tEXIT;
3256 break;
3257 case tASSERT:
3258 doassert();
3259 lastst = tASSERT;
3260 break;
3261 case tSLEEP:
3262 dosleep();
3263 lastst = tSLEEP;
3264 break;
3265 case tCONST:
3266 decl_const(sLOCAL);
3267 break;
3268 case tENUM:
3269 decl_enum(sLOCAL);
3270 break;
3271 default: /* non-empty expression */
3272 lexpush(); /* analyze token later */
3273 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE);
3274 needtoken(tTERM);
3275 lastst = tEXPR;
3276 } /* switch */
3277}
3278
3279static void
3280compound(void)
3281{
3282 int indent = -1;
3283 cell save_decl = declared;
3284 int count_stmt = 0;
3285
3286 nestlevel += 1; /* increase compound statement level */
3287 while (matchtoken('}') == 0)
3288 { /* repeat until compound statement is closed */
3289 if (!freading)
3290 {
3291 needtoken('}'); /* gives error: "expected token }" */
3292 break;
3293 }
3294 else
3295 {
3296 if (count_stmt > 0
3297 && (lastst == tRETURN || lastst == tBREAK
3298 || lastst == tCONTINUE))
3299 error(225); /* unreachable code */
3300 statement(&indent, TRUE); /* do a statement */
3301 count_stmt++;
3302 } /* if */
3303 } /* while */
3304 if (lastst != tRETURN)
3305 destructsymbols(&loctab, nestlevel);
3306 if (lastst != tRETURN && lastst != tGOTO)
3307 /* delete local variable space */
3308 modstk((int)(declared - save_decl) * sizeof(cell));
3309
3310 testsymbols(&loctab, nestlevel, FALSE, TRUE); /* look for unused
3311 * block locals */
3312 declared = save_decl;
3313 delete_symbols(&loctab, nestlevel, FALSE, TRUE);
3314 /* erase local symbols, but
3315 * retain block local labels
3316 * (within the function) */
3317
3318 nestlevel -= 1; /* decrease compound statement level */
3319}
3320
3321/* doexpr
3322 *
3323 * Global references: stgidx (referred to only)
3324 */
3325static void
3326doexpr(int comma, int chkeffect, int allowarray, int mark_endexpr,
3327 int *tag, int chkfuncresult)
3328{
3329 int constant, index, ident;
3330 int localstaging = FALSE;
3331 cell val;
3332
3333 if (!staging)
3334 {
3335 stgset(TRUE); /* start stage-buffering */
3336 localstaging = TRUE;
3337 assert(stgidx == 0);
3338 } /* if */
3339 index = stgidx;
3340 errorset(sEXPRMARK);
3341 do
3342 {
3343 /* on second round through, mark the end of the previous expression */
3344 if (index != stgidx)
3345 endexpr(TRUE);
3346 sideeffect = FALSE;
3347 ident = expression(&constant, &val, tag, chkfuncresult);
3348 if (!allowarray && (ident == iARRAY || ident == iREFARRAY))
3349 error(33, "-unknown-"); /* array must be indexed */
3350 if (chkeffect && !sideeffect)
3351 error(215); /* expression has no effect */
3352 }
3353 while (comma && matchtoken(',')); /* more? */
3354 if (mark_endexpr)
3355 endexpr(TRUE); /* optionally, mark the end of the expression */
3356 errorset(sEXPRRELEASE);
3357 if (localstaging)
3358 {
3359 stgout(index);
3360 stgset(FALSE); /* stop staging */
3361 } /* if */
3362}
3363
3364/* constexpr
3365 */
3366int
3367constexpr(cell * val, int *tag)
3368{
3369 int constant, index;
3370 cell cidx;
3371
3372 stgset(TRUE); /* start stage-buffering */
3373 stgget(&index, &cidx); /* mark position in code generator */
3374 errorset(sEXPRMARK);
3375 expression(&constant, val, tag, FALSE);
3376 stgdel(index, cidx); /* scratch generated code */
3377 stgset(FALSE); /* stop stage-buffering */
3378 if (constant == 0)
3379 error(8); /* must be constant expression */
3380 errorset(sEXPRRELEASE);
3381 return constant;
3382}
3383
3384/* test
3385 *
3386 * In the case a "simple assignment" operator ("=") is used within a
3387 * test, * the warning "possibly unintended assignment" is displayed.
3388 * This routine sets the global variable "intest" to true, it is
3389 * restored upon termination. In the case the assignment was intended,
3390 * use parantheses around the expression to avoid the warning;
3391 * primary() sets "intest" to 0.
3392 *
3393 * Global references: intest (altered, but restored upon termination)
3394 */
3395static void
3396test(int label, int parens, int invert)
3397{
3398 int index, tok;
3399 cell cidx;
3400 value lval = { NULL, 0, 0, 0, 0, NULL };
3401 int localstaging = FALSE;
3402
3403 if (!staging)
3404 {
3405 stgset(TRUE); /* start staging */
3406 localstaging = TRUE;
3407#if !defined NDEBUG
3408 stgget(&index, &cidx); /* should start at zero if started
3409 * locally */
3410 assert(index == 0);
3411#endif
3412 } /* if */
3413
3414 pushstk((stkitem) intest);
3415 intest = 1;
3416 if (parens)
3417 needtoken('(');
3418 do
3419 {
3420 stgget(&index, &cidx); /* mark position (of last expression) in
3421 * code generator */
3422 if (hier14(&lval))
3423 rvalue(&lval);
3424 tok = matchtoken(',');
3425 if (tok)
3426 endexpr(TRUE);
3427 }
3428 while (tok); /* do */
3429 if (parens)
3430 needtoken(')');
3431 if (lval.ident == iARRAY || lval.ident == iREFARRAY)
3432 {
3433 char *ptr =
3434 (lval.sym->name) ? lval.sym->name : "-unknown-";
3435 error(33, ptr); /* array must be indexed */
3436 } /* if */
3437 if (lval.ident == iCONSTEXPR)
3438 { /* constant expression */
3439 intest = (int)(long)popstk(); /* restore stack */
3440 stgdel(index, cidx);
3441 if (lval.constval)
3442 { /* code always executed */
3443 error(206); /* redundant test: always non-zero */
3444 }
3445 else
3446 {
3447 error(205); /* redundant code: never executed */
3448 jumplabel(label);
3449 } /* if */
3450 if (localstaging)
3451 {
3452 stgout(0); /* write "jumplabel" code */
3453 stgset(FALSE); /* stop staging */
3454 } /* if */
3455 return;
3456 } /* if */
3457 if (lval.tag != 0 && lval.tag != sc_addtag("bool"))
3458 if (check_userop(lneg, lval.tag, 0, 1, NULL, &lval.tag))
3459 invert = !invert; /* user-defined ! operator inverted result */
3460 if (invert)
3461 jmp_ne0(label); /* jump to label if true (different from 0) */
3462 else
3463 jmp_eq0(label); /* jump to label if false (equal to 0) */
3464 endexpr(TRUE); /* end expression (give optimizer a chance) */
3465 intest = (int)(long)popstk(); /* double typecast to avoid warning
3466 * with Microsoft C */
3467 if (localstaging)
3468 {
3469 stgout(0); /* output queue from the very beginning (see
3470 * assert() when localstaging is set to TRUE) */
3471 stgset(FALSE); /* stop staging */
3472 } /* if */
3473}
3474
3475static void
3476doif(void)
3477{
3478 int flab1, flab2;
3479 int ifindent;
3480
3481 ifindent = stmtindent; /* save the indent of the "if" instruction */
3482 flab1 = getlabel(); /* get label number for false branch */
3483 test(flab1, TRUE, FALSE); /*get expression, branch to flab1 if false */
3484 statement(NULL, FALSE); /* if true, do a statement */
3485 if (matchtoken(tELSE) == 0)
3486 { /* if...else ? */
3487 setlabel(flab1); /* no, simple if..., print false label */
3488 }
3489 else
3490 {
3491 /* to avoid the "dangling else" error, we want a warning if the "else"
3492 * has a lower indent than the matching "if" */
3493#if 0
3494 if (stmtindent < ifindent && sc_tabsize > 0)
3495 error(217); /* loose indentation */
3496#endif
3497 flab2 = getlabel();
3498 if ((lastst != tRETURN) && (lastst != tGOTO))
3499 jumplabel(flab2);
3500 setlabel(flab1); /* print false label */
3501 statement(NULL, FALSE); /* do "else" clause */
3502 setlabel(flab2); /* print true label */
3503 } /* endif */
3504}
3505
3506static void
3507dowhile(void)
3508{
3509 int wq[wqSIZE]; /* allocate local queue */
3510
3511 addwhile(wq); /* add entry to queue for "break" */
3512 setlabel(wq[wqLOOP]); /* loop label */
3513 /* The debugger uses the "line" opcode to be able to "break" out of
3514 * a loop. To make sure that each loop has a line opcode, even for the
3515 * tiniest loop, set it below the top of the loop */
3516 setline(fline, fcurrent);
3517 test(wq[wqEXIT], TRUE, FALSE); /* branch to wq[wqEXIT] if false */
3518 statement(NULL, FALSE); /* if so, do a statement */
3519 jumplabel(wq[wqLOOP]); /* and loop to "while" start */
3520 setlabel(wq[wqEXIT]); /* exit label */
3521 delwhile(); /* delete queue entry */
3522}
3523
3524/*
3525 * Note that "continue" will in this case not jump to the top of the
3526 * loop, but to the end: just before the TRUE-or-FALSE testing code.
3527 */
3528static void
3529dodo(void)
3530{
3531 int wq[wqSIZE], top;
3532
3533 addwhile(wq); /* see "dowhile" for more info */
3534 top = getlabel(); /* make a label first */
3535 setlabel(top); /* loop label */
3536 statement(NULL, FALSE);
3537 needtoken(tWHILE);
3538 setlabel(wq[wqLOOP]); /* "continue" always jumps to WQLOOP. */
3539 setline(fline, fcurrent);
3540 test(wq[wqEXIT], TRUE, FALSE);
3541 jumplabel(top);
3542 setlabel(wq[wqEXIT]);
3543 delwhile();
3544 needtoken(tTERM);
3545}
3546
3547static void
3548dofor(void)
3549{
3550 int wq[wqSIZE], skiplab;
3551 cell save_decl;
3552 int save_nestlevel, index;
3553 int *ptr;
3554
3555 save_decl = declared;
3556 save_nestlevel = nestlevel;
3557
3558 addwhile(wq);
3559 skiplab = getlabel();
3560 needtoken('(');
3561 if (matchtoken(';') == 0)
3562 {
3563 /* new variable declarations are allowed here */
3564 if (matchtoken(tNEW))
3565 {
3566 /* The variable in expr1 of the for loop is at a
3567 * 'compound statement' level of it own.
3568 */
3569 nestlevel++;
3570 declloc(FALSE); /* declare local variable */
3571 }
3572 else
3573 {
3574 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 1 */
3575 needtoken(';');
3576 } /* if */
3577 } /* if */
3578 /* Adjust the "declared" field in the "while queue", in case that
3579 * local variables were declared in the first expression of the
3580 * "for" loop. These are deleted in separately, so a "break" or a
3581 * "continue" must ignore these fields.
3582 */
3583 ptr = readwhile();
3584 assert(ptr != NULL);
3585 ptr[wqBRK] = (int)declared;
3586 ptr[wqCONT] = (int)declared;
3587 jumplabel(skiplab); /* skip expression 3 1st time */
3588 setlabel(wq[wqLOOP]); /* "continue" goes to this label: expr3 */
3589 setline(fline, fcurrent);
3590 /* Expressions 2 and 3 are reversed in the generated code:
3591 * expression 3 precedes expression 2.
3592 * When parsing, the code is buffered and marks for
3593 * the start of each expression are insterted in the buffer.
3594 */
3595 assert(!staging);
3596 stgset(TRUE); /* start staging */
3597 assert(stgidx == 0);
3598 index = stgidx;
3599 stgmark(sSTARTREORDER);
3600 stgmark((char)(sEXPRSTART + 0)); /* mark start of 2nd expression
3601 * in stage */
3602 setlabel(skiplab); /*jump to this point after 1st expression */
3603 if (matchtoken(';') == 0)
3604 {
3605 test(wq[wqEXIT], FALSE, FALSE); /* expression 2
3606 *(jump to wq[wqEXIT] if false) */
3607 needtoken(';');
3608 } /* if */
3609 stgmark((char)(sEXPRSTART + 1)); /* mark start of 3th expression
3610 * in stage */
3611 if (matchtoken(')') == 0)
3612 {
3613 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 3 */
3614 needtoken(')');
3615 } /* if */
3616 stgmark(sENDREORDER); /* mark end of reversed evaluation */
3617 stgout(index);
3618 stgset(FALSE); /* stop staging */
3619 statement(NULL, FALSE);
3620 jumplabel(wq[wqLOOP]);
3621 setlabel(wq[wqEXIT]);
3622 delwhile();
3623
3624 assert(nestlevel >= save_nestlevel);
3625 if (nestlevel > save_nestlevel)
3626 {
3627 /* Clean up the space and the symbol table for the local
3628 * variable in "expr1".
3629 */
3630 destructsymbols(&loctab, nestlevel);
3631 modstk((int)(declared - save_decl) * sizeof(cell));
3632 declared = save_decl;
3633 delete_symbols(&loctab, nestlevel, FALSE, TRUE);
3634 nestlevel = save_nestlevel; /* reset 'compound statement'
3635 * nesting level */
3636 } /* if */
3637}
3638
3639/* The switch statement is incompatible with its C sibling:
3640 * 1. the cases are not drop through
3641 * 2. only one instruction may appear below each case, use a compound
3642 * instruction to execute multiple instructions
3643 * 3. the "case" keyword accepts a comma separated list of values to
3644 * match, it also accepts a range using the syntax "1 .. 4"
3645 *
3646 * SWITCH param
3647 * PRI = expression result
3648 * param = table offset (code segment)
3649 *
3650 */
3651static void
3652doswitch(void)
3653{
3654 int lbl_table, lbl_exit, lbl_case;
3655 int tok, swdefault, casecount;
3656 cell val;
3657 char *str;
3658 constvalue caselist = { NULL, "", 0, 0 }; /*case list starts empty */
3659 constvalue *cse, *csp;
3660 char labelname[sNAMEMAX + 1];
3661
3662 needtoken('(');
3663 doexpr(TRUE, FALSE, FALSE, TRUE, NULL, FALSE); /* evaluate
3664 * switch expression */
3665 needtoken(')');
3666 /* generate the code for the switch statement, the label is the
3667 * address of the case table (to be generated later).
3668 */
3669 lbl_table = getlabel();
3670 lbl_case = 0; /* just to avoid a compiler warning */
3671 ffswitch(lbl_table);
3672
3673 needtoken('{');
3674 lbl_exit = getlabel(); /*get label number for jumping out of switch */
3675 swdefault = FALSE;
3676 casecount = 0;
3677 do
3678 {
3679 tok = lex(&val, &str); /* read in (new) token */
3680 switch (tok)
3681 {
3682 case tCASE:
3683 if (swdefault != FALSE)
3684 error(15); /* "default" case must be last in switch
3685 * statement */
3686 lbl_case = getlabel();
3687 sc_allowtags = FALSE; /* do not allow tagnames here */
3688 do
3689 {
3690 casecount++;
3691
3692 /* ??? enforce/document that, in a switch, a statement cannot
3693 * start an opening brace (marks the start of a compound
3694 * statement) and search for the right-most colon before that
3695 * statement.
3696 * Now, by replacing the ':' by a special COLON token, you can
3697 * parse all expressions until that special token.
3698 */
3699
3700 constexpr(&val, NULL);
3701 /* Search the insertion point (the table is kept in sorted
3702 * order, so that advanced abstract machines can sift the
3703 * case table with a binary search). Check for duplicate
3704 * case values at the same time.
3705 */
3706 for (csp = &caselist, cse = caselist.next;
3707 cse && cse->value < val;
3708 csp = cse, cse = cse->next)
3709 /* nothing */ ;
3710 if (cse && cse->value == val)
3711 error(40, val); /* duplicate "case" label */
3712 /* Since the label is stored as a string in the
3713 * "constvalue", the size of an identifier must
3714 * be at least 8, as there are 8
3715 * hexadecimal digits in a 32-bit number.
3716 */
3717#if sNAMEMAX < 8
3718#error Length of identifier (sNAMEMAX) too small.
3719#endif
3720 insert_constval(csp, cse, itoh(lbl_case), val, 0);
3721 if (matchtoken(tDBLDOT))
3722 {
3723 cell end;
3724
3725 constexpr(&end, NULL);
3726 if (end <= val)
3727 error(50); /* invalid range */
3728 while (++val <= end)
3729 {
3730 casecount++;
3731 /* find the new insertion point */
3732 for (csp = &caselist, cse = caselist.next;
3733 cse && cse->value < val;
3734 csp = cse, cse = cse->next)
3735 /* nothing */ ;
3736 if (cse && cse->value == val)
3737 error(40, val); /* duplicate "case" label */
3738 insert_constval(csp, cse, itoh(lbl_case), val, 0);
3739 } /* if */
3740 } /* if */
3741 }
3742 while (matchtoken(','));
3743 needtoken(':'); /* ':' ends the case */
3744 sc_allowtags = TRUE; /* reset */
3745 setlabel(lbl_case);
3746 statement(NULL, FALSE);
3747 jumplabel(lbl_exit);
3748 break;
3749 case tDEFAULT:
3750 if (swdefault != FALSE)
3751 error(16); /* multiple defaults in switch */
3752 lbl_case = getlabel();
3753 setlabel(lbl_case);
3754 needtoken(':');
3755 swdefault = TRUE;
3756 statement(NULL, FALSE);
3757 /* Jump to lbl_exit, even thouh this is the last clause in the
3758 *switch, because the jump table is generated between the last
3759 * clause of the switch and the exit label.
3760 */
3761 jumplabel(lbl_exit);
3762 break;
3763 case '}':
3764 /* nothing, but avoid dropping into "default" */
3765 break;
3766 default:
3767 error(2);
3768 indent_nowarn = TRUE; /* disable this check */
3769 tok = '}'; /* break out of the loop after an error */
3770 } /* switch */
3771 }
3772 while (tok != '}');
3773
3774#if !defined NDEBUG
3775 /* verify that the case table is sorted (unfortunately, duplicates can
3776 * occur; there really shouldn't be duplicate cases, but the compiler
3777 * may not crash or drop into an assertion for a user error). */
3778 for (cse = caselist.next; cse && cse->next; cse = cse->next)
3779 ; /* empty. no idea whether this is correct, but we MUST NOT do
3780 * the setlabel(lbl_table) call in the loop body. doing so breaks
3781 * switch statements that only have one case statement following.
3782 */
3783#endif
3784
3785 /* generate the table here, before lbl_exit (general jump target) */
3786 setlabel(lbl_table);
3787
3788 if (swdefault == FALSE)
3789 {
3790 /* store lbl_exit as the "none-matched" label in the switch table */
3791 strcpy(labelname, itoh(lbl_exit));
3792 }
3793 else
3794 {
3795 /* lbl_case holds the label of the "default" clause */
3796 strcpy(labelname, itoh(lbl_case));
3797 } /* if */
3798 ffcase(casecount, labelname, TRUE);
3799 /* generate the rest of the table */
3800 for (cse = caselist.next; cse; cse = cse->next)
3801 ffcase(cse->value, cse->name, FALSE);
3802
3803 setlabel(lbl_exit);
3804 delete_consttable(&caselist); /* clear list of case labels */
3805}
3806
3807static void
3808doassert(void)
3809{
3810 int flab1, index;
3811 cell cidx;
3812 value lval = { NULL, 0, 0, 0, 0, NULL };
3813
3814 if ((sc_debug & sCHKBOUNDS) != 0)
3815 {
3816 flab1 = getlabel(); /* get label number for "OK" branch */
3817 test(flab1, FALSE, TRUE); /* get expression and branch
3818 * to flab1 if true */
3819 setline(fline, fcurrent); /* make sure we abort on the correct
3820 * line number */
3821 ffabort(xASSERTION);
3822 setlabel(flab1);
3823 }
3824 else
3825 {
3826 stgset(TRUE); /* start staging */
3827 stgget(&index, &cidx); /* mark position in code generator */
3828 do
3829 {
3830 if (hier14(&lval))
3831 rvalue(&lval);
3832 stgdel(index, cidx); /* just scrap the code */
3833 }
3834 while (matchtoken(','));
3835 stgset(FALSE); /* stop staging */
3836 } /* if */
3837 needtoken(tTERM);
3838}
3839
3840static void
3841dogoto(void)
3842{
3843 char *st;
3844 cell val;
3845 symbol *sym;
3846
3847 if (lex(&val, &st) == tSYMBOL)
3848 {
3849 sym = fetchlab(st);
3850 jumplabel((int)sym->addr);
3851 sym->usage |= uREAD; /* set "uREAD" bit */
3852 /*
3853 * // ??? if the label is defined (check sym->usage & uDEFINE), check
3854 * // sym->compound (nesting level of the label) against nestlevel;
3855 * // if sym->compound < nestlevel, call the destructor operator
3856 */
3857 }
3858 else
3859 {
3860 error(20, st); /* illegal symbol name */
3861 } /* if */
3862 needtoken(tTERM);
3863}
3864
3865static void
3866dolabel(void)
3867{
3868 char *st;
3869 cell val;
3870 symbol *sym;
3871
3872 tokeninfo(&val, &st); /* retrieve label name again */
3873 if (find_constval(&tagname_tab, st, 0))
3874 error(221, st); /* label name shadows tagname */
3875 sym = fetchlab(st);
3876 setlabel((int)sym->addr);
3877 /* since one can jump around variable declarations or out of compound
3878 * blocks, the stack must be manually adjusted
3879 */
3880 setstk(-declared * sizeof(cell));
3881 sym->usage |= uDEFINE; /* label is now defined */
3882}
3883
3884/* fetchlab
3885 *
3886 * Finds a label from the (local) symbol table or adds one to it.
3887 * Labels are local in scope.
3888 *
3889 * Note: The "_usage" bit is set to zero. The routines that call
3890 * "fetchlab()" must set this bit accordingly.
3891 */
3892static symbol *
3893fetchlab(char *name)
3894{
3895 symbol *sym;
3896
3897 sym = findloc(name); /* labels are local in scope */
3898 if (sym)
3899 {
3900 if (sym->ident != iLABEL)
3901 error(19, sym->name); /* not a label: ... */
3902 }
3903 else
3904 {
3905 sym = addsym(name, getlabel(), iLABEL, sLOCAL, 0, 0);
3906 sym->x.declared = (int)declared;
3907 sym->compound = nestlevel;
3908 } /* if */
3909 return sym;
3910}
3911
3912/* doreturn
3913 *
3914 * Global references: rettype (altered)
3915 */
3916static void
3917doreturn(void)
3918{
3919 int tag;
3920
3921 if (matchtoken(tTERM) == 0)
3922 {
3923 if ((rettype & uRETNONE) != 0)
3924 error(208); /* mix "return;" and "return value;" */
3925 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
3926 needtoken(tTERM);
3927 rettype |= uRETVALUE; /* function returns a value */
3928 /* check tagname with function tagname */
3929 assert(curfunc != NULL);
3930 if (!matchtag(curfunc->tag, tag, TRUE))
3931 error(213); /* tagname mismatch */
3932 }
3933 else
3934 {
3935 /* this return statement contains no expression */
3936 const1(0);
3937 if ((rettype & uRETVALUE) != 0)
3938 {
3939 char symname[2 * sNAMEMAX + 16]; /* allow space for user
3940 * defined operators */
3941 assert(curfunc != NULL);
3942 funcdisplayname(symname, curfunc->name);
3943 error(209, symname); /* function should return a value */
3944 } /* if */
3945 rettype |= uRETNONE; /* function does not return anything */
3946 } /* if */
3947 destructsymbols(&loctab, 0); /*call destructor for *all* locals */
3948 modstk((int)declared * sizeof(cell)); /* end of function, remove
3949 *all* * local variables*/
3950 ffret();
3951}
3952
3953static void
3954dobreak(void)
3955{
3956 int *ptr;
3957
3958 ptr = readwhile(); /* readwhile() gives an error if not in loop */
3959 needtoken(tTERM);
3960 if (!ptr)
3961 return;
3962 destructsymbols(&loctab, nestlevel);
3963 modstk(((int)declared - ptr[wqBRK]) * sizeof(cell));
3964 jumplabel(ptr[wqEXIT]);
3965}
3966
3967static void
3968docont(void)
3969{
3970 int *ptr;
3971
3972 ptr = readwhile(); /* readwhile() gives an error if not in loop */
3973 needtoken(tTERM);
3974 if (!ptr)
3975 return;
3976 destructsymbols(&loctab, nestlevel);
3977 modstk(((int)declared - ptr[wqCONT]) * sizeof(cell));
3978 jumplabel(ptr[wqLOOP]);
3979}
3980
3981void
3982exporttag(int tag)
3983{
3984 /* find the tag by value in the table, then set the top bit to mark it
3985 * "public"
3986 */
3987 if (tag != 0)
3988 {
3989 constvalue *ptr;
3990
3991 assert((tag & PUBLICTAG) == 0);
3992 for (ptr = tagname_tab.next;
3993 ptr && tag != (int)(ptr->value & TAGMASK); ptr = ptr->next)
3994 /* nothing */ ;
3995 if (ptr)
3996 ptr->value |= PUBLICTAG;
3997 } /* if */
3998}
3999
4000static void
4001doexit(void)
4002{
4003 int tag = 0;
4004
4005 if (matchtoken(tTERM) == 0)
4006 {
4007 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
4008 needtoken(tTERM);
4009 }
4010 else
4011 {
4012 const1(0);
4013 } /* if */
4014 const2(tag);
4015 exporttag(tag);
4016 destructsymbols(&loctab, 0); /* call destructor for *all* locals */
4017 ffabort(xEXIT);
4018}
4019
4020static void
4021dosleep(void)
4022{
4023 int tag = 0;
4024
4025 if (matchtoken(tTERM) == 0)
4026 {
4027 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
4028 needtoken(tTERM);
4029 }
4030 else
4031 {
4032 const1(0);
4033 } /* if */
4034 const2(tag);
4035 exporttag(tag);
4036 ffabort(xSLEEP);
4037}
4038
4039static void
4040addwhile(int *ptr)
4041{
4042 int k;
4043
4044 ptr[wqBRK] = (int)declared; /* stack pointer (for "break") */
4045 ptr[wqCONT] = (int)declared; /* for "continue", possibly adjusted later */
4046 ptr[wqLOOP] = getlabel();
4047 ptr[wqEXIT] = getlabel();
4048 if (wqptr >= (wq + wqTABSZ - wqSIZE))
4049 error(102, "loop table"); /* loop table overflow (too many active loops) */
4050 k = 0;
4051 while (k < wqSIZE)
4052 { /* copy "ptr" to while queue table */
4053 *wqptr = *ptr;
4054 wqptr += 1;
4055 ptr += 1;
4056 k += 1;
4057 } /* while */
4058}
4059
4060static void
4061delwhile(void)
4062{
4063 if (wqptr > wq)
4064 wqptr -= wqSIZE;
4065}
4066
4067static int *
4068readwhile(void)
4069{
4070 if (wqptr <= wq)
4071 {
4072 error(24); /* out of context */
4073 return NULL;
4074 }
4075 else
4076 {
4077 return (wqptr - wqSIZE);
4078 } /* if */
4079}
generated by cgit v1.1 at 2024-07-12 03:16:21 +0000