2 * vim:ts=8:sw=3:sts=8:noexpandtab:cino=>5n-3f0^-2{2
5 * Function and variable definition and declaration, statement parser.
7 * Copyright (c) ITB CompuPhase, 1997-2003
9 * This software is provided "as-is", without any express or implied
10 * warranty. In no event will the authors be held liable for any
11 * damages arising from the use of this software. Permission is granted
12 * to anyone to use this software for any purpose, including commercial
13 * applications, and to alter it and redistribute it freely, subject to
14 * the following restrictions:
16 * 1. The origin of this software must not be misrepresented;
17 * you must not claim that you wrote the original software.
18 * If you use this software in a product, an acknowledgment in the
19 * product documentation would be appreciated but is not required.
20 * 2. Altered source versions must be plainly marked as such, and
21 * must not be misrepresented as being the original software.
22 * 3. This notice may not be removed or altered from any source
28 * vim:ts=8:sw=3:sts=8:noexpandtab:cino=>5n-3f0^-2{2
49 #endif /* HAVE_EVIL */
51 #include "embryo_cc_osdefs.h"
52 #include "embryo_cc_sc.h"
53 #include "embryo_cc_prefix.h"
55 #define VERSION_STR "2.4"
56 #define VERSION_INT 240
58 static void resetglobals(void);
59 static void initglobals(void);
60 static void setopt(int argc, char **argv,
61 char *iname, char *oname,
62 char *pname, char *rname);
63 static void setconfig(char *root);
64 static void about(void);
65 static void setconstants(void);
66 static void parse(void);
67 static void dumplits(void);
68 static void dumpzero(int count);
69 static void declfuncvar(int tok, char *symname,
71 int fstatic, int fstock, int fconst);
72 static void declglb(char *firstname, int firsttag,
73 int fpublic, int fstatic, int stock, int fconst);
74 static int declloc(int fstatic);
75 static void decl_const(int table);
76 static void decl_enum(int table);
77 static cell needsub(int *tag);
78 static void initials(int ident, int tag,
79 cell * size, int dim[], int numdim);
80 static cell initvector(int ident, int tag, cell size, int fillzero);
81 static cell init(int ident, int *tag);
82 static void funcstub(int native);
83 static int newfunc(char *firstname, int firsttag,
84 int fpublic, int fstatic, int stock);
85 static int declargs(symbol * sym);
86 static void doarg(char *name, int ident, int offset,
87 int tags[], int numtags,
88 int fpublic, int fconst, arginfo * arg);
89 static void reduce_referrers(symbol * root);
90 static int testsymbols(symbol * root, int level,
91 int testlabs, int testconst);
92 static void destructsymbols(symbol * root, int level);
93 static constvalue *find_constval_byval(constvalue * table, cell val);
94 static void statement(int *lastindent, int allow_decl);
95 static void compound(void);
96 static void doexpr(int comma, int chkeffect,
97 int allowarray, int mark_endexpr,
98 int *tag, int chkfuncresult);
99 static void doassert(void);
100 static void doexit(void);
101 static void test(int label, int parens, int invert);
102 static void doif(void);
103 static void dowhile(void);
104 static void dodo(void);
105 static void dofor(void);
106 static void doswitch(void);
107 static void dogoto(void);
108 static void dolabel(void);
109 static symbol *fetchlab(char *name);
110 static void doreturn(void);
111 static void dobreak(void);
112 static void docont(void);
113 static void dosleep(void);
114 static void addwhile(int *ptr);
115 static void delwhile(void);
116 static int *readwhile(void);
118 static int lastst = 0; /* last executed statement type */
119 static int nestlevel = 0; /* number of active (open) compound statements */
120 static int rettype = 0; /* the type that a "return" expression should have */
121 static int skipinput = 0; /* number of lines to skip from the first input file */
122 static int wq[wqTABSZ]; /* "while queue", internal stack for nested loops */
123 static int *wqptr; /* pointer to next entry */
124 static char binfname[_MAX_PATH]; /* binary file name */
127 main(int argc, char *argv[], char *env[] __UNUSED__)
129 char argv0[_MAX_PATH];
132 snprintf(argv0, _MAX_PATH, "%s", argv[0]);
133 /* Linux stores the name of the program in argv[0], but not the path.
134 * To adjust this, I store a string with the path in argv[0]. To do
135 * so, I try to get the current path with getcwd(), and if that fails
136 * I search for the PWD= setting in the environment.
138 if (NULL != getcwd(argv0, _MAX_PATH))
141 snprintf(argv0 + i, _MAX_PATH - i, "/%s", argv[0]);
145 char *pwd = getenv("PWD");
148 snprintf(argv0, _MAX_PATH, "%s/%s", pwd, argv[0]);
150 argv[0] = argv0; /* set location to new first parameter */
152 e_prefix_determine(argv0);
154 return sc_compile(argc, argv);
158 sc_error(int number, char *message, char *filename, int firstline,
159 int lastline, va_list argptr)
161 static char *prefix[3] = { "error", "fatal error", "warning" };
167 pre = prefix[number / 100];
169 fprintf(stderr, "%s(%d -- %d) : %s %03d: ", filename, firstline,
170 lastline, pre, number);
172 fprintf(stderr, "%s(%d) : %s %03d: ", filename, lastline, pre,
175 vfprintf(stderr, message, argptr);
181 sc_opensrc(char *filename)
183 return fopen(filename, "rb");
187 sc_closesrc(void *handle)
189 assert(handle != NULL);
190 fclose((FILE *) handle);
194 sc_resetsrc(void *handle, void *position)
196 assert(handle != NULL);
197 fsetpos((FILE *) handle, (fpos_t *) position);
201 sc_readsrc(void *handle, char *target, int maxchars)
203 return fgets(target, maxchars, (FILE *) handle);
207 sc_getpossrc(void *handle)
209 static fpos_t lastpos; /* may need to have a LIFO stack of
212 fgetpos((FILE *) handle, &lastpos);
217 sc_eofsrc(void *handle)
219 return feof((FILE *) handle);
225 return fdopen(fd, "w+");
229 sc_closeasm(void *handle)
232 fclose((FILE *) handle);
236 sc_resetasm(void *handle)
238 fflush((FILE *) handle);
239 fseek((FILE *) handle, 0, SEEK_SET);
243 sc_writeasm(void *handle, char *st)
245 return fputs(st, (FILE *) handle) >= 0;
249 sc_readasm(void *handle, char *target, int maxchars)
251 return fgets(target, maxchars, (FILE *) handle);
255 sc_openbin(char *filename)
257 return fopen(filename, "wb");
261 sc_closebin(void *handle, int deletefile)
263 fclose((FILE *) handle);
269 sc_resetbin(void *handle)
271 fflush((FILE *) handle);
272 fseek((FILE *) handle, 0, SEEK_SET);
276 sc_writebin(void *handle, void *buffer, int size)
278 return (int)fwrite(buffer, 1, size, (FILE *) handle) == size;
282 sc_lengthbin(void *handle)
284 return ftell((FILE *) handle);
287 /* "main" of the compiler
290 sc_compile(int argc, char *argv[])
292 int entry, i, jmpcode, fd_out;
294 char incfname[_MAX_PATH];
295 char reportname[_MAX_PATH];
299 int lcl_packstr, lcl_needsemicolon, lcl_tabsize;
302 /* set global variables to their initial value */
306 errorset(sEXPRRELEASE);
309 /* make sure that we clean up on a fatal error; do this before the
310 * first call to error(). */
311 if ((jmpcode = setjmp(errbuf)) != 0)
314 /* allocate memory for fixed tables */
315 inpfname = (char *)malloc(_MAX_PATH);
316 litq = (cell *) malloc(litmax * sizeof(cell));
318 error(103); /* insufficient memory */
320 error(103); /* insufficient memory */
322 setopt(argc, argv, inpfname, binfname, incfname, reportname);
324 /* open the output file */
327 tmpdir = getenv("TMPDIR");
328 if (!tmpdir) tmpdir = "/tmp";
330 tmpdir = (char *)evil_tmpdir_get();
331 #endif /* ! HAVE_EVIL */
333 snprintf(outfname, _MAX_PATH, "%s/embryo_cc.asm-tmp-XXXXXX", tmpdir);
334 fd_out = mkstemp(outfname);
336 error(101, outfname);
338 unlink (outfname); /* kill this file as soon as it's (f)close'd */
340 setconfig(argv[0]); /* the path to the include files */
341 lcl_ctrlchar = sc_ctrlchar;
342 lcl_packstr = sc_packstr;
343 lcl_needsemicolon = sc_needsemicolon;
344 lcl_tabsize = sc_tabsize;
345 inpf = inpf_org = (FILE *) sc_opensrc(inpfname);
347 error(100, inpfname);
349 outf = (FILE *) sc_openasm(fd_out); /* first write to assembler
350 * file (may be temporary) */
352 error(101, outfname);
353 /* immediately open the binary file, for other programs to check */
354 binf = (FILE *) sc_openbin(binfname);
356 error(101, binfname);
357 setconstants(); /* set predefined constants and tagnames */
358 for (i = 0; i < skipinput; i++) /* skip lines in the input file */
359 if (sc_readsrc(inpf, pline, sLINEMAX) != NULL)
360 fline++; /* keep line number up to date */
362 sc_status = statFIRST;
363 /* do the first pass through the file */
364 inpfmark = sc_getpossrc(inpf);
365 if (incfname[0] != '\0')
367 if (strcmp(incfname, sDEF_PREFIX) == 0)
369 plungefile(incfname, FALSE, TRUE); /* parse "default.inc" */
373 if (!plungequalifiedfile(incfname)) /* parse "prefix" include
375 error(100, incfname); /* cannot read from ... (fatal error) */
378 preprocess(); /* fetch first line */
379 parse(); /* process all input */
382 sc_status = statWRITE; /* set, to enable warnings */
384 /* ??? for re-parsing the listing file instead of the original source
385 * file (and doing preprocessing twice):
386 * - close input file, close listing file
387 * - re-open listing file for reading (inpf)
388 * - open assembler file (outf)
391 /* reset "defined" flag of all functions and global variables */
392 reduce_referrers(&glbtab);
393 delete_symbols(&glbtab, 0, TRUE, FALSE);
394 #if !defined NO_DEFINE
398 sc_ctrlchar = lcl_ctrlchar;
399 sc_packstr = lcl_packstr;
400 sc_needsemicolon = lcl_needsemicolon;
401 sc_tabsize = lcl_tabsize;
403 /* reset the source file */
406 sc_resetsrc(inpf, inpfmark); /* reset file position */
407 fline = skipinput; /* reset line number */
408 lexinit(); /* clear internal flags of lex() */
409 sc_status = statWRITE; /* allow to write --this variable was reset
410 * by resetglobals() */
412 setfile(inpfname, fnumber);
413 if (incfname[0] != '\0')
415 if (strcmp(incfname, sDEF_PREFIX) == 0)
416 plungefile(incfname, FALSE, TRUE); /* parse "default.inc" (again) */
418 plungequalifiedfile(incfname); /* parse implicit include
421 preprocess(); /* fetch first line */
422 parse(); /* process all input */
423 /* inpf is already closed when readline() attempts to pop of a file */
424 writetrailer(); /* write remaining stuff */
426 entry = testsymbols(&glbtab, 0, TRUE, FALSE); /* test for unused
427 * or undefined functions and variables */
429 error(13); /* no entry point (no public functions) */
432 if (inpf != NULL) /* main source file is not closed, do it now */
434 /* write the binary file (the file is already open) */
435 if (errnum == 0 && jmpcode == 0)
437 assert(binf != NULL);
438 sc_resetasm(outf); /* flush and loop back, for reading */
439 assemble(binf, outf); /* assembler file is now input */
444 sc_closebin(binf, errnum != 0);
446 if (inpfname != NULL)
452 assert(jmpcode != 0 || loctab.next == NULL); /* on normal flow,
454 * should already have been deleted */
455 delete_symbols(&loctab, 0, TRUE, TRUE); /* delete local variables
456 * if not yet done (i.e.
457 * on a fatal error) */
458 delete_symbols(&glbtab, 0, TRUE, TRUE);
459 delete_consttable(&tagname_tab);
460 delete_consttable(&libname_tab);
463 #if !defined NO_DEFINE
468 printf("\n%d Error%s.\n", errnum, (errnum > 1) ? "s" : "");
471 else if (warnnum != 0)
473 printf("\n%d Warning%s.\n", warnnum, (warnnum > 1) ? "s" : "");
484 sc_addconstant(char *name, cell value, int tag)
486 errorset(sFORCESET); /* make sure error engine is silenced */
487 sc_status = statIDLE;
488 add_constant(name, value, sGLOBAL, tag);
493 sc_addtag(char *name)
501 /* no tagname was given, check for one */
502 if (lex(&val, &name) != tLABEL)
505 return 0; /* untagged */
510 ptr = tagname_tab.next;
513 tag = (int)(ptr->value & TAGMASK);
514 if (strcmp(name, ptr->name) == 0)
515 return tag; /* tagname is known, return its sequence number */
516 tag &= (int)~FIXEDTAG;
522 /* tagname currently unknown, add it */
523 tag = last + 1; /* guaranteed not to exist already */
525 tag |= (int)FIXEDTAG;
526 append_constval(&tagname_tab, name, (cell) tag, 0);
533 /* reset the subset of global variables that is modified by the
535 curfunc = NULL; /* pointer to current function */
536 lastst = 0; /* last executed statement type */
537 nestlevel = 0; /* number of active (open) compound statements */
538 rettype = 0; /* the type that a "return" expression should have */
539 litidx = 0; /* index to literal table */
540 stgidx = 0; /* index to the staging buffer */
541 labnum = 0; /* number of (internal) labels */
542 staging = 0; /* true if staging output */
543 declared = 0; /* number of local cells declared */
544 glb_declared = 0; /* number of global cells declared */
545 code_idx = 0; /* number of bytes with generated code */
546 ntv_funcid = 0; /* incremental number of native function */
547 curseg = 0; /* 1 if currently parsing CODE, 2 if parsing DATA */
548 freading = FALSE; /* no input file ready yet */
549 fline = 0; /* the line number in the current file */
550 fnumber = 0; /* the file number in the file table (debugging) */
551 fcurrent = 0; /* current file being processed (debugging) */
552 intest = 0; /* true if inside a test */
553 sideeffect = 0; /* true if an expression causes a side-effect */
554 stmtindent = 0; /* current indent of the statement */
555 indent_nowarn = TRUE; /* do not skip warning "217 loose indentation" */
556 sc_allowtags = TRUE; /* allow/detect tagnames */
557 sc_status = statIDLE;
565 skipinput = 0; /* number of lines to skip from the first
567 sc_ctrlchar = CTRL_CHAR; /* the escape character */
568 litmax = sDEF_LITMAX; /* current size of the literal table */
569 errnum = 0; /* number of errors */
570 warnnum = 0; /* number of warnings */
571 /* sc_debug=sCHKBOUNDS; by default: bounds checking+assertions */
572 sc_debug = 0; /* by default: no debug */
573 charbits = 8; /* a "char" is 8 bits */
574 sc_packstr = FALSE; /* strings are unpacked by default */
575 /* sc_compress=TRUE; compress output bytecodes */
576 sc_compress = FALSE; /* compress output bytecodes */
577 sc_needsemicolon = FALSE; /* semicolon required to terminate
580 sc_stksize = sDEF_AMXSTACK; /* default stack size */
581 sc_tabsize = 8; /* assume a TAB is 8 spaces */
582 sc_rationaltag = 0; /* assume no support for rational numbers */
583 rational_digits = 0; /* number of fractional digits */
585 outfname[0] = '\0'; /* output file name */
586 inpf = NULL; /* file read from */
587 inpfname = NULL; /* pointer to name of the file currently
589 outf = NULL; /* file written to */
590 litq = NULL; /* the literal queue */
591 glbtab.next = NULL; /* clear global variables/constants table */
592 loctab.next = NULL; /* " local " / " " */
593 tagname_tab.next = NULL; /* tagname table */
594 libname_tab.next = NULL; /* library table (#pragma library "..."
597 pline[0] = '\0'; /* the line read from the input file */
598 lptr = NULL; /* points to the current position in "pline" */
599 curlibrary = NULL; /* current library */
600 inpf_org = NULL; /* main source file */
602 wqptr = wq; /* initialize while queue pointer */
607 parseoptions(int argc, char **argv, char *iname, char *oname,
608 char *pname __UNUSED__, char *rname __UNUSED__)
614 /* use embryo include dir always */
615 snprintf(str, sizeof(str), "%s/include/", e_prefix_data_get());
619 for (i = 1; i < argc; i++)
621 if (!strcmp (argv[i], "-i") && (i + 1 < argc) && *argv[i + 1])
623 /* include directory */
625 strncpy(str, argv[i], sizeof(str));
628 if (str[len - 1] != DIRSEP_CHAR)
630 str[len] = DIRSEP_CHAR;
636 else if (!strcmp (argv[i], "-o") && (i + 1 < argc) && *argv[i + 1])
640 strcpy(oname, argv[i]); /* FIXME */
642 else if (!strcmp (argv[i], "-S") && (i + 1 < argc) && *argv[i + 1])
646 stack_size = atoi(argv[i]);
649 sc_stksize = (cell) stack_size;
656 strcpy(iname, argv[i]); /* FIXME */
660 /* only allow one input filename */
667 setopt(int argc, char **argv, char *iname, char *oname,
668 char *pname, char *rname)
674 strcpy(pname, sDEF_PREFIX);
676 parseoptions(argc, argv, iname, oname, pname, rname);
677 if (iname[0] == '\0')
682 setconfig(char *root)
684 char path[_MAX_PATH];
688 /* add the default "include" directory */
691 /* path + filename (hopefully) */
692 strncpy(path, root, sizeof(path) - 1);
693 path[sizeof(path) - 1] = 0;
695 /* terminate just behind last \ or : */
696 if ((ptr = strrchr(path, DIRSEP_CHAR)) != NULL
697 || (ptr = strchr(path, ':')) != NULL)
699 /* If there was no terminating "\" or ":",
700 * the filename probably does not
701 * contain the path; so we just don't add it
702 * to the list in that case
705 if (strlen(path) < (sizeof(path) - 1 - 7))
707 strcat(path, "include");
710 path[len] = DIRSEP_CHAR;
711 path[len + 1] = '\0';
719 printf("Usage: embryo_cc <filename> [options]\n\n");
720 printf("Options:\n");
723 (" -A<num> alignment in bytes of the data segment and the\
727 (" -a output assembler code (skip code generation\
731 (" -C[+/-] compact encoding for output file (default=%c)\n",
732 sc_compress ? '+' : '-');
733 printf(" -c8 [default] a character is 8-bits\
734 (ASCII/ISO Latin-1)\n");
736 printf(" -c16 a character is 16-bits (Unicode)\n");
737 #if defined dos_setdrive
738 printf(" -Dpath active directory path\n");
741 (" -d0 no symbolic information, no run-time checks\n");
742 printf(" -d1 [default] run-time checks, no symbolic\
745 (" -d2 full debug information and dynamic checking\n");
746 printf(" -d3 full debug information, dynamic checking,\
749 printf(" -i <name> path for include files\n");
751 printf(" -l create list file (preprocess only)\n");
753 printf(" -o <name> set base name of output file\n");
756 (" -P[+/-] strings are \"packed\" by default (default=%c)\n",
757 sc_packstr ? '+' : '-');
758 printf(" -p<name> set name of \"prefix\" file\n");
763 (" -S <num> stack/heap size in cells (default=%d, min=65)\n",
766 printf(" -s<num> skip lines from the input file\n");
768 (" -t<num> TAB indent size (in character positions)\n");
769 printf(" -\\ use '\\' for escape characters\n");
770 printf(" -^ use '^' for escape characters\n");
771 printf(" -;[+/-] require a semicolon to end each statement\
772 (default=%c)\n", sc_needsemicolon ? '+' : '-');
775 (" sym=val define constant \"sym\" with value \"val\"\n");
776 printf(" sym= define constant \"sym\" with value 0\n");
778 longjmp(errbuf, 3); /* user abort */
786 assert(sc_status == statIDLE);
787 append_constval(&tagname_tab, "_", 0, 0); /* "untagged" */
788 append_constval(&tagname_tab, "bool", 1, 0);
790 add_constant("true", 1, sGLOBAL, 1); /* boolean flags */
791 add_constant("false", 0, sGLOBAL, 1);
792 add_constant("EOS", 0, sGLOBAL, 0); /* End Of String, or '\0' */
793 add_constant("cellbits", 32, sGLOBAL, 0);
794 add_constant("cellmax", INT_MAX, sGLOBAL, 0);
795 add_constant("cellmin", INT_MIN, sGLOBAL, 0);
796 add_constant("charbits", charbits, sGLOBAL, 0);
797 add_constant("charmin", 0, sGLOBAL, 0);
798 add_constant("charmax", (charbits == 16) ? 0xffff : 0xff, sGLOBAL, 0);
800 add_constant("__Small", VERSION_INT, sGLOBAL, 0);
803 if ((sc_debug & (sCHKBOUNDS | sSYMBOLIC)) == (sCHKBOUNDS | sSYMBOLIC))
805 else if ((sc_debug & sCHKBOUNDS) == sCHKBOUNDS)
807 add_constant("debug", debug, sGLOBAL, 0);
810 /* parse - process all input text
812 * At this level, only static declarations and function definitions
818 int tok, tag, fconst, fstock, fstatic;
824 /* first try whether a declaration possibly is native or public */
825 tok = lex(&val, &str); /* read in (new) token */
832 fconst = matchtoken(tCONST);
833 declglb(NULL, 0, FALSE, FALSE, FALSE, fconst);
836 /* This can be a static function or a static global variable;
837 * we know which of the two as soon as we have parsed up to the
838 * point where an opening paranthesis of a function would be
839 * expected. To back out after deciding it was a declaration of
840 * a static variable after all, we have to store the symbol name
843 fstock = matchtoken(tSTOCK);
844 fconst = matchtoken(tCONST);
845 tag = sc_addtag(NULL);
846 tok = lex(&val, &str);
847 if (tok == tNATIVE || tok == tPUBLIC)
849 error(42); /* invalid combination of class specifiers */
852 declfuncvar(tok, str, tag, FALSE, TRUE, fstock, fconst);
861 /* This can be a public function or a public variable;
862 * see the comment above (for static functions/variables)
865 fconst = matchtoken(tCONST);
866 tag = sc_addtag(NULL);
867 tok = lex(&val, &str);
868 if (tok == tNATIVE || tok == tSTOCK || tok == tSTATIC)
870 error(42); /* invalid combination of class specifiers */
873 declfuncvar(tok, str, tag, TRUE, FALSE, FALSE, fconst);
876 /* This can be a stock function or a stock *global) variable;
877 * see the comment above (for static functions/variables) for
880 fstatic = matchtoken(tSTATIC);
881 fconst = matchtoken(tCONST);
882 tag = sc_addtag(NULL);
883 tok = lex(&val, &str);
884 if (tok == tNATIVE || tok == tPUBLIC)
886 error(42); /* invalid combination of class specifiers */
889 declfuncvar(tok, str, tag, FALSE, fstatic, TRUE, fconst);
895 if (!newfunc(NULL, -1, FALSE, FALSE, FALSE))
897 error(10); /* illegal function or declaration */
898 lexclr(TRUE); /* drop the rest of the line */
902 funcstub(TRUE); /* create a dummy function */
908 error(54); /* unmatched closing brace */
911 error(55); /* start of function body without function header */
916 error(10); /* illegal function or declaration */
917 lexclr(TRUE); /* drop the rest of the line */
925 * Dump the literal pool (strings etc.)
927 * Global references: litidx (referred to only)
937 /* should be in the data segment */
940 j = 16; /* 16 values per line */
941 while (j && k < litidx)
943 outval(litq[k], FALSE);
947 if (j == 0 || k >= litidx)
948 stgwrite("\n"); /* force a newline after 10 dumps */
949 /* Note: stgwrite() buffers a line until it is complete. It recognizes
950 * the end of line as a sequence of "\n\0", so something like "\n\t"
951 * so should not be passed to stgwrite().
959 * Dump zero's for default initial values
975 stgwrite((i == 0 || count == 0) ? "\n" : " ");
976 if (i == 0 && count > 0)
982 aligndata(int numbytes)
984 if ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
986 while ((((glb_declared + litidx) * sizeof(cell)) % numbytes) != 0)
993 declfuncvar(int tok, char *symname, int tag, int fpublic, int fstatic,
994 int fstock, int fconst)
996 char name[sNAMEMAX + 1];
998 if (tok != tSYMBOL && tok != tOPERATOR)
1001 error(20, symname); /* invalid symbol name */
1004 if (tok == tOPERATOR)
1007 if (!newfunc(NULL, tag, fpublic, fstatic, fstock))
1008 error(10); /* illegal function or declaration */
1012 assert(strlen(symname) <= sNAMEMAX);
1013 strcpy(name, symname);
1014 if (fconst || !newfunc(name, tag, fpublic, fstatic, fstock))
1015 declglb(name, tag, fpublic, fstatic, fstock, fconst);
1016 /* if not a static function, try a static variable */
1020 /* declglb - declare global symbols
1022 * Declare a static (global) variable. Global variables are stored in
1025 * global references: glb_declared (altered)
1028 declglb(char *firstname, int firsttag, int fpublic, int fstatic,
1029 int stock, int fconst)
1031 int ident, tag, ispublic;
1032 int idxtag[sDIMEN_MAX];
1033 char name[sNAMEMAX + 1];
1034 cell val, size, cidx;
1036 int dim[sDIMEN_MAX];
1045 filenum = fcurrent; /* save file number at the start of the
1049 size = 1; /* single size (no array) */
1050 numdim = 0; /* no dimensions */
1052 if (firstname != NULL)
1054 assert(strlen(firstname) <= sNAMEMAX);
1055 strcpy(name, firstname); /* save symbol name */
1061 tag = sc_addtag(NULL);
1062 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1063 error(20, str); /* invalid symbol name */
1064 assert(strlen(str) <= sNAMEMAX);
1065 strcpy(name, str); /* save symbol name */
1067 sym = findglb(name);
1069 sym = findconst(name);
1070 if (sym != NULL && (sym->usage & uDEFINE) != 0)
1071 error(21, name); /* symbol already defined */
1073 if (name[0] == PUBLIC_CHAR)
1075 ispublic = TRUE; /* implicitly public variable */
1076 if (stock || fstatic)
1077 error(42); /* invalid combination of class specifiers */
1079 while (matchtoken('['))
1082 if (numdim == sDIMEN_MAX)
1084 error(53); /* exceeding maximum number of dimensions */
1087 if (numdim > 0 && dim[numdim - 1] == 0)
1088 error(52); /* only last dimension may be variable length */
1089 size = needsub(&idxtag[numdim]); /* get size; size==0 for
1091 #if INT_MAX < LONG_MAX
1093 error(105); /* overflow, exceeding capacity */
1096 error(56, name); /* arrays cannot be public */
1097 dim[numdim++] = (int)size;
1099 /* if this variable is never used (which can be detected only in
1100 * the second stage), shut off code generation; make an exception
1101 * for public variables
1103 cidx = 0; /* only to avoid a compiler warning */
1104 if (sc_status == statWRITE && sym != NULL
1105 && (sym->usage & (uREAD | uWRITTEN | uPUBLIC)) == 0)
1107 sc_status = statSKIP;
1110 glbdecl = glb_declared;
1113 defsymbol(name, ident, sGLOBAL, sizeof(cell) * glb_declared, tag);
1114 begdseg(); /* real (initialized) data in data segment */
1115 assert(litidx == 0); /* literal queue should be empty */
1119 aligndata(sc_dataalign);
1120 dumplits(); /* dump the literal queue */
1121 sc_alignnext = FALSE;
1122 litidx = 0; /* global initial data is dumped, so restart at zero */
1124 initials(ident, tag, &size, dim, numdim); /* stores values in
1125 * the literal queue */
1128 dumplits(); /* dump the literal queue */
1129 dumpzero((int)size - litidx);
1132 { /* define only if not yet defined */
1134 addvariable(name, sizeof(cell) * glb_declared, ident, sGLOBAL,
1135 tag, dim, numdim, idxtag);
1138 { /* if declared but not yet defined, adjust the
1139 * variable's address */
1140 sym->addr = sizeof(cell) * glb_declared;
1141 sym->usage |= uDEFINE;
1144 sym->usage |= uPUBLIC;
1146 sym->usage |= uCONST;
1148 sym->usage |= uSTOCK;
1150 sym->fnumber = filenum;
1151 if (ident == iARRAY)
1152 for (level = 0; level < numdim; level++)
1153 symbolrange(level, dim[level]);
1154 if (sc_status == statSKIP)
1156 sc_status = statWRITE;
1158 assert(glb_declared == glbdecl);
1162 glb_declared += (int)size; /* add total number of cells */
1165 while (matchtoken(',')); /* enddo *//* more? */
1166 needtoken(tTERM); /* if not comma, must be semicolumn */
1169 /* declloc - declare local symbols
1171 * Declare local (automatic) variables. Since these variables are
1172 * relative to the STACK, there is no switch to the DATA segment.
1173 * These variables cannot be initialized either.
1175 * global references: declared (altered)
1176 * funcstatus (referred to only)
1179 declloc(int fstatic)
1182 int idxtag[sDIMEN_MAX];
1183 char name[sNAMEMAX + 1];
1187 value lval = { NULL, 0, 0, 0, 0, NULL };
1189 int dim[sDIMEN_MAX];
1193 fconst = matchtoken(tCONST);
1198 numdim = 0; /* no dimensions */
1199 tag = sc_addtag(NULL);
1200 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1201 error(20, str); /* invalid symbol name */
1202 assert(strlen(str) <= sNAMEMAX);
1203 strcpy(name, str); /* save symbol name */
1204 if (name[0] == PUBLIC_CHAR)
1205 error(56, name); /* local variables cannot be public */
1206 /* Note: block locals may be named identical to locals at higher
1207 * compound blocks (as with standard C); so we must check (and add)
1208 * the "nesting level" of local variables to verify the
1209 * multi-definition of symbols.
1211 if ((sym = findloc(name)) != NULL && sym->compound == nestlevel)
1212 error(21, name); /* symbol already defined */
1213 /* Although valid, a local variable whose name is equal to that
1214 * of a global variable or to that of a local variable at a lower
1215 * level might indicate a bug.
1217 if (((sym = findloc(name)) != NULL && sym->compound != nestlevel)
1218 || findglb(name) != NULL)
1219 error(219, name); /* variable shadows another symbol */
1220 while (matchtoken('['))
1223 if (numdim == sDIMEN_MAX)
1225 error(53); /* exceeding maximum number of dimensions */
1228 if (numdim > 0 && dim[numdim - 1] == 0)
1229 error(52); /* only last dimension may be variable length */
1230 size = needsub(&idxtag[numdim]); /* get size; size==0 for "var[]" */
1231 #if INT_MAX < LONG_MAX
1233 error(105); /* overflow, exceeding capacity */
1235 dim[numdim++] = (int)size;
1237 if (ident == iARRAY || fstatic)
1241 aligndata(sc_dataalign);
1242 sc_alignnext = FALSE;
1244 cur_lit = litidx; /* save current index in the literal table */
1245 initials(ident, tag, &size, dim, numdim);
1247 return ident; /* error message already given */
1251 /* reserve memory (on the stack) for the variable */
1254 /* write zeros for uninitialized fields */
1255 while (litidx < cur_lit + size)
1258 addvariable(name, (cur_lit + glb_declared) * sizeof(cell),
1259 ident, sSTATIC, tag, dim, numdim, idxtag);
1260 defsymbol(name, ident, sSTATIC,
1261 (cur_lit + glb_declared) * sizeof(cell), tag);
1265 declared += (int)size; /* variables are put on stack,
1266 * adjust "declared" */
1268 addvariable(name, -declared * sizeof(cell), ident, sLOCAL, tag,
1269 dim, numdim, idxtag);
1270 defsymbol(name, ident, sLOCAL, -declared * sizeof(cell), tag);
1271 modstk(-(int)size * sizeof(cell));
1273 /* now that we have reserved memory for the variable, we can
1274 * proceed to initialize it */
1275 sym->compound = nestlevel; /* for multiple declaration/shadowing */
1277 sym->usage |= uCONST;
1278 if (ident == iARRAY)
1279 for (level = 0; level < numdim; level++)
1280 symbolrange(level, dim[level]);
1282 { /* static variables already initialized */
1283 if (ident == iVARIABLE)
1285 /* simple variable, also supports initialization */
1286 int ctag = tag; /* set to "tag" by default */
1287 int explicit_init = FALSE; /* is the variable explicitly
1289 if (matchtoken('='))
1291 doexpr(FALSE, FALSE, FALSE, FALSE, &ctag, TRUE);
1292 explicit_init = TRUE;
1296 const1(0); /* uninitialized variable, set to zero */
1298 /* now try to save the value (still in PRI) in the variable */
1300 lval.ident = iVARIABLE;
1303 check_userop(NULL, ctag, lval.tag, 2, NULL, &ctag);
1305 endexpr(TRUE); /* full expression ends after the store */
1306 if (!matchtag(tag, ctag, TRUE))
1307 error(213); /* tag mismatch */
1308 /* if the variable was not explicitly initialized, reset the
1309 * "uWRITTEN" flag that store() set */
1311 sym->usage &= ~uWRITTEN;
1316 if (litidx - cur_lit < size)
1317 fillarray(sym, size * sizeof(cell), 0);
1318 if (cur_lit < litidx)
1320 /* check whether the complete array is set to a single value;
1321 * if it is, more compact code can be generated */
1322 cell first = litq[cur_lit];
1325 for (i = cur_lit; i < litidx && litq[i] == first; i++)
1329 /* all values are the same */
1330 fillarray(sym, (litidx - cur_lit) * sizeof(cell),
1332 litidx = cur_lit; /* reset literal table */
1336 /* copy the literals to the array */
1337 const1((cur_lit + glb_declared) * sizeof(cell));
1338 copyarray(sym, (litidx - cur_lit) * sizeof(cell));
1344 while (matchtoken(',')); /* enddo *//* more? */
1345 needtoken(tTERM); /* if not comma, must be semicolumn */
1350 calc_arraysize(int dim[], int numdim, int cur)
1354 return dim[cur] + (dim[cur] * calc_arraysize(dim, numdim, cur + 1));
1359 * Initialize global objects and local arrays.
1360 * size==array cells (count), if 0 on input, the routine counts
1361 * the number of elements
1362 * tag==required tagname id (not the returned tag)
1364 * Global references: litidx (altered)
1367 initials(int ident, int tag, cell * size, int dim[], int numdim)
1370 int curlit = litidx;
1373 if (!matchtoken('='))
1375 if (ident == iARRAY && dim[numdim - 1] == 0)
1377 /* declared as "myvar[];" which is senseless (note: this *does* make
1378 * sense in the case of a iREFARRAY, which is a function parameter)
1380 error(9); /* array has zero length -> invalid size */
1384 /* initialize the indirection tables */
1386 #error Array algorithms for more than 2 dimensions are not implemented
1388 assert(numdim == 2);
1389 *size = calc_arraysize(dim, numdim, 0);
1390 for (d = 0; d < dim[0]; d++)
1391 stowlit((dim[0] + d * (dim[1] - 1)) * sizeof(cell));
1396 if (ident == iVARIABLE)
1400 if (!matchtag(tag, ctag, TRUE))
1401 error(213); /* tag mismatch */
1408 *size = initvector(ident, tag, dim[0], FALSE);
1414 /* The simple algorithm below only works for arrays with one or
1415 * two dimensions. This should be some recursive algorithm.
1417 if (dim[numdim - 1] != 0)
1418 /* set size to (known) full size */
1419 *size = calc_arraysize(dim, numdim, 0);
1420 /* dump indirection tables */
1421 for (d = 0; d < dim[0]; d++)
1423 /* now dump individual vectors */
1426 for (d = 0; d < dim[0]; d++)
1428 litq[curlit + d] = offs * sizeof(cell);
1429 dsize = initvector(ident, tag, dim[1], TRUE);
1433 if (matchtoken('{') || matchtoken(tSTRING))
1434 /* expect a '{' or a string */
1445 *size = litidx - curlit; /* number of elements defined */
1449 * Initialize a single dimensional array
1452 initvector(int ident, int tag, cell size, int fillzero)
1454 cell prev1 = 0, prev2 = 0;
1457 int curlit = litidx;
1459 assert(ident == iARRAY || ident == iREFARRAY);
1460 if (matchtoken('{'))
1464 if (matchtoken('}'))
1465 { /* to allow for trailing ',' after the initialization */
1469 if ((ellips = matchtoken(tELLIPS)) != 0)
1472 prev1 = init(ident, &ctag);
1473 if (!matchtag(tag, ctag, TRUE))
1474 error(213); /* tag mismatch */
1476 while (matchtoken(',')); /* do */
1482 if (!matchtag(tag, ctag, TRUE))
1483 error(213); /* tagname mismatch */
1485 /* fill up the literal queue with a series */
1489 ((litidx - curlit) == 1) ? (cell) 0 : prev1 - prev2;
1490 if (size == 0 || (litidx - curlit) == 0)
1491 error(41); /* invalid ellipsis, array size unknown */
1492 else if ((litidx - curlit) == (int)size)
1493 error(18); /* initialisation data exceeds declared size */
1494 while ((litidx - curlit) < (int)size)
1500 if (fillzero && size > 0)
1502 while ((litidx - curlit) < (int)size)
1507 size = litidx - curlit; /* number of elements defined */
1509 else if (litidx - curlit > (int)size)
1510 { /* e.g. "myvar[3]={1,2,3,4};" */
1511 error(18); /* initialisation data exceeds declared size */
1512 litidx = (int)size + curlit; /* avoid overflow in memory moves */
1519 * Evaluate one initializer.
1522 init(int ident, int *tag)
1526 if (matchtoken(tSTRING))
1528 /* lex() automatically stores strings in the literal table (and
1529 * increases "litidx") */
1530 if (ident == iVARIABLE)
1532 error(6); /* must be assigned to an array */
1533 litidx = 1; /* reset literal queue */
1537 else if (constexpr(&i, tag))
1539 stowlit(i); /* store expression result in literal table */
1546 * Get required array size
1554 if (matchtoken(']')) /* we've already seen "[" */
1555 return 0; /* null size (like "char msg[]") */
1556 constexpr(&val, tag); /* get value (must be constant expression) */
1559 error(9); /* negative array size is invalid; assumed zero */
1563 return val; /* return array size */
1566 /* decl_const - declare a single constant
1570 decl_const(int vclass)
1572 char constname[sNAMEMAX + 1];
1578 tag = sc_addtag(NULL);
1579 if (lex(&val, &str) != tSYMBOL) /* read in (new) token */
1580 error(20, str); /* invalid symbol name */
1581 symbolline = fline; /* save line where symbol was found */
1582 strcpy(constname, str); /* save symbol name */
1584 constexpr(&val, &exprtag); /* get value */
1586 /* add_constant() checks for duplicate definitions */
1587 if (!matchtag(tag, exprtag, FALSE))
1589 /* temporarily reset the line number to where the symbol was
1591 int orgfline = fline;
1594 error(213); /* tagname mismatch */
1597 add_constant(constname, val, vclass, tag);
1600 /* decl_enum - declare enumerated constants
1604 decl_enum(int vclass)
1606 char enumname[sNAMEMAX + 1], constname[sNAMEMAX + 1];
1607 cell val, value, size;
1609 int tok, tag, explicittag;
1610 cell increment, multiplier;
1612 /* get an explicit tag, if any (we need to remember whether an
1613 * explicit tag was passed, even if that explicit tag was "_:", so we
1614 * cannot call sc_addtag() here
1616 if (lex(&val, &str) == tLABEL)
1618 tag = sc_addtag(str);
1625 explicittag = FALSE;
1628 /* get optional enum name (also serves as a tag if no explicit
1630 if (lex(&val, &str) == tSYMBOL)
1631 { /* read in (new) token */
1632 strcpy(enumname, str); /* save enum name (last constant) */
1634 tag = sc_addtag(enumname);
1638 lexpush(); /* analyze again */
1642 /* get increment and multiplier */
1645 if (matchtoken('('))
1647 if (matchtoken(taADD))
1649 constexpr(&increment, NULL);
1651 else if (matchtoken(taMULT))
1653 constexpr(&multiplier, NULL);
1655 else if (matchtoken(taSHL))
1657 constexpr(&val, NULL);
1665 /* go through all constants */
1666 value = 0; /* default starting value */
1669 if (matchtoken('}'))
1670 { /* quick exit if '}' follows ',' */
1674 tok = lex(&val, &str); /* read in (new) token */
1675 if (tok != tSYMBOL && tok != tLABEL)
1676 error(20, str); /* invalid symbol name */
1677 strcpy(constname, str); /* save symbol name */
1678 size = increment; /* default increment of 'val' */
1679 if (tok == tLABEL || matchtoken(':'))
1680 constexpr(&size, NULL); /* get size */
1681 if (matchtoken('='))
1682 constexpr(&value, NULL); /* get value */
1683 /* add_constant() checks whether a variable (global or local) or
1684 * a constant with the same name already exists */
1685 add_constant(constname, value, vclass, tag);
1686 if (multiplier == 1)
1689 value *= size * multiplier;
1691 while (matchtoken(','));
1692 needtoken('}'); /* terminates the constant list */
1693 matchtoken(';'); /* eat an optional ; */
1695 /* set the enum name to the last value plus one */
1696 if (enumname[0] != '\0')
1697 add_constant(enumname, value, vclass, tag);
1701 * Finds a function in the global symbol table or creates a new entry.
1702 * It does some basic processing and error checking.
1705 fetchfunc(char *name, int tag)
1711 if ((sc_debug & sSYMBOLIC) != 0)
1713 offset += opcodes(1) + opargs(3) + nameincells(name);
1714 /* ^^^ The address for the symbol is the code address. But the
1715 * "symbol" instruction itself generates code. Therefore the
1716 * offset is pre-adjusted to the value it will have after the
1717 * symbol instruction.
1720 if ((sym = findglb(name)) != 0)
1721 { /* already in symbol table? */
1722 if (sym->ident != iFUNCTN)
1724 error(21, name); /* yes, but not as a function */
1725 return NULL; /* make sure the old symbol is not damaged */
1727 else if ((sym->usage & uDEFINE) != 0)
1729 error(21, name); /* yes, and it's already defined */
1731 else if ((sym->usage & uNATIVE) != 0)
1733 error(21, name); /* yes, and it is an native */
1735 assert(sym->vclass == sGLOBAL);
1736 if ((sym->usage & uDEFINE) == 0)
1738 /* as long as the function stays undefined, update the address
1746 /* don't set the "uDEFINE" flag; it may be a prototype */
1747 sym = addsym(name, offset, iFUNCTN, sGLOBAL, tag, 0);
1748 /* assume no arguments */
1749 sym->dim.arglist = (arginfo *) malloc(1 * sizeof(arginfo));
1750 sym->dim.arglist[0].ident = 0;
1751 /* set library ID to NULL (only for native functions) */
1757 /* This routine adds symbolic information for each argument.
1764 /* At this point, no local variables have been declared. All
1765 * local symbols are function arguments.
1770 assert(sym->ident != iLABEL);
1771 assert(sym->vclass == sLOCAL);
1772 defsymbol(sym->name, sym->ident, sLOCAL, sym->addr, sym->tag);
1773 if (sym->ident == iREFARRAY)
1779 symbolrange(sub->dim.array.level, sub->dim.array.length);
1780 sub = finddepend(sub);
1788 operatorname(char *name)
1794 assert(name != NULL);
1796 /* check the operator */
1797 opertok = lex(&val, &str);
1810 name[0] = (char)opertok;
1833 error(61); /* operator cannot be redefined
1834 * (or bad operator name) */
1842 operatoradjust(int opertok, symbol * sym, char *opername, int resulttag)
1844 int tags[2] = { 0, 0 };
1847 char tmpname[sNAMEMAX + 1];
1853 /* count arguments and save (first two) tags */
1854 while (arg = &sym->dim.arglist[count], arg->ident != 0)
1858 if (arg->numtags > 1)
1859 error(65, count + 1); /* function argument may only have
1861 else if (arg->numtags == 1)
1862 tags[count] = arg->tags[0];
1864 if (opertok == '~' && count == 0)
1866 if (arg->ident != iREFARRAY)
1867 error(73, arg->name); /* must be an array argument */
1871 if (arg->ident != iVARIABLE)
1872 error(66, arg->name); /* must be non-reference argument */
1874 if (arg->hasdefault)
1875 error(59, arg->name); /* arguments of an operator may not
1876 * have a default value */
1880 /* for '!', '++' and '--', count must be 1
1881 * for '-', count may be 1 or 2
1882 * for '=', count must be 1, and the resulttag is also important
1883 * for all other (binary) operators and the special '~'
1884 * operator, count must be 2
1893 error(62); /* number or placement of the operands does
1894 * not fit the operator */
1897 if (count != 1 && count != 2)
1898 error(62); /* number or placement of the operands does
1899 * not fit the operator */
1903 error(62); /* number or placement of the operands does
1904 * not fit the operator */
1908 && ((opertok != '=' && tags[1] == 0) || (opertok == '=' && resulttag == 0)))
1909 error(64); /* cannot change predefined operators */
1911 /* change the operator name */
1912 assert(opername[0] != '\0');
1913 operator_symname(tmpname, opername, tags[0], tags[1], count, resulttag);
1914 if ((oldsym = findglb(tmpname)) != NULL)
1918 if ((oldsym->usage & uDEFINE) != 0)
1920 char errname[2 * sNAMEMAX + 16];
1922 funcdisplayname(errname, tmpname);
1923 error(21, errname); /* symbol already defined */
1925 sym->usage |= oldsym->usage; /* copy flags from the previous
1927 for (i = 0; i < oldsym->numrefers; i++)
1928 if (oldsym->refer[i] != NULL)
1929 refer_symbol(sym, oldsym->refer[i]);
1930 delete_symbol(&glbtab, oldsym);
1932 if ((sc_debug & sSYMBOLIC) != 0)
1933 sym->addr += nameincells(tmpname) - nameincells(sym->name);
1934 strcpy(sym->name, tmpname);
1935 sym->hash = namehash(sym->name); /* calculate new hash */
1937 /* operators should return a value, except the '~' operator */
1939 sym->usage |= uRETVALUE;
1945 check_operatortag(int opertok, int resulttag, char *opername)
1947 assert(opername != NULL && opername[0] != '\0');
1957 if (resulttag != sc_addtag("bool"))
1959 error(63, opername, "bool:"); /* operator X requires
1960 * a "bool:" result tag */
1967 error(63, opername, "_:"); /* operator "~" requires
1968 * a "_:" result tag */
1977 tag2str(char *dest, int tag)
1981 sprintf(dest, "0%x", tag);
1982 return isdigit(dest[1]) ? &dest[1] : dest;
1986 operator_symname(char *symname, char *opername, int tag1, int tag2,
1987 int numtags, int resulttag)
1989 char tagstr1[10], tagstr2[10];
1992 assert(numtags >= 1 && numtags <= 2);
1993 opertok = (opername[1] == '\0') ? opername[0] : 0;
1995 sprintf(symname, "%s%s%s", tag2str(tagstr1, resulttag), opername,
1996 tag2str(tagstr2, tag1));
1997 else if (numtags == 1 || opertok == '~')
1998 sprintf(symname, "%s%s", opername, tag2str(tagstr1, tag1));
2000 sprintf(symname, "%s%s%s", tag2str(tagstr1, tag1), opername,
2001 tag2str(tagstr2, tag2));
2006 parse_funcname(char *fname, int *tag1, int *tag2, char *opname)
2011 /* tags are only positive, so if the function name starts with a '-',
2012 * the operator is an unary '-' or '--' operator.
2022 *tag1 = (int)strtol(fname, &ptr, 16);
2023 unary = ptr == fname; /* unary operator if it doesn't start
2024 * with a tag name */
2026 assert(!unary || *tag1 == 0);
2027 assert(*ptr != '\0');
2028 for (name = opname; !isdigit(*ptr);)
2031 *tag2 = (int)strtol(ptr, NULL, 16);
2036 funcdisplayname(char *dest, char *funcname)
2040 constvalue *tagsym[2];
2043 if (isalpha(*funcname) || *funcname == '_' || *funcname == PUBLIC_CHAR
2044 || *funcname == '\0')
2046 if (dest != funcname)
2047 strcpy(dest, funcname);
2051 unary = parse_funcname(funcname, &tags[0], &tags[1], opname);
2052 tagsym[1] = find_constval_byval(&tagname_tab, tags[1]);
2053 assert(tagsym[1] != NULL);
2056 sprintf(dest, "operator%s(%s:)", opname, tagsym[1]->name);
2060 tagsym[0] = find_constval_byval(&tagname_tab, tags[0]);
2061 /* special case: the assignment operator has the return value
2063 if (opname[0] == '=' && opname[1] == '\0')
2064 sprintf(dest, "%s:operator%s(%s:)", tagsym[0]->name, opname,
2067 sprintf(dest, "operator%s(%s:,%s:)", opname, tagsym[0]->name,
2074 funcstub(int native)
2079 char symbolname[sNAMEMAX + 1];
2085 litidx = 0; /* clear the literal pool */
2087 tag = sc_addtag(NULL);
2088 tok = lex(&val, &str);
2091 if (tok == tPUBLIC || tok == tSTOCK || tok == tSTATIC ||
2092 (tok == tSYMBOL && *str == PUBLIC_CHAR))
2093 error(42); /* invalid combination of class specifiers */
2097 if (tok == tPUBLIC || tok == tSTATIC)
2098 tok = lex(&val, &str);
2100 if (tok == tOPERATOR)
2102 opertok = operatorname(symbolname);
2104 return; /* error message already given */
2105 check_operatortag(opertok, tag, symbolname);
2109 if (tok != tSYMBOL && freading)
2111 error(10); /* illegal function or declaration */
2114 strcpy(symbolname, str);
2116 needtoken('('); /* only functions may be native/forward */
2118 sym = fetchfunc(symbolname, tag); /* get a pointer to the
2124 sym->usage = uNATIVE | uRETVALUE | uDEFINE;
2125 sym->x.lib = curlibrary;
2129 /* "declargs()" found the ")" */
2130 if (!operatoradjust(opertok, sym, symbolname, tag))
2131 sym->usage &= ~uDEFINE;
2132 /* for a native operator, also need to specify an "exported"
2133 * function name; for a native function, this is optional
2140 lexpush(); /* push back, for matchtoken() to retrieve again */
2142 if (matchtoken('='))
2144 /* allow number or symbol */
2145 if (matchtoken(tSYMBOL))
2147 tokeninfo(&val, &str);
2148 if (strlen(str) > sEXPMAX)
2150 error(220, str, sEXPMAX);
2151 str[sEXPMAX] = '\0';
2153 insert_alias(sym->name, str);
2157 constexpr(&val, NULL);
2160 * ?? Must mark this address, so that it won't be generated again
2161 * and it won't be written to the output file. At the moment,
2162 * I have assumed that this syntax is only valid if val < 0.
2163 * To properly mix "normal" native functions and indexed native
2164 * functions, one should use negative indices anyway.
2165 * Special code for a negative index in sym->addr exists in
2166 * SC4.C (ffcall()) and in SC6.C (the loops for counting the
2167 * number of native variables and for writing them).
2174 litidx = 0; /* clear the literal pool */
2175 /* clear local variables queue */
2176 delete_symbols(&loctab, 0, TRUE, TRUE);
2179 /* newfunc - begin a function
2181 * This routine is called from "parse" and tries to make a function
2182 * out of the following text
2184 * Global references: funcstatus,lastst,litidx
2187 * declared (altered)
2188 * glb_declared (altered)
2189 * sc_alignnext (altered)
2192 newfunc(char *firstname, int firsttag, int fpublic, int fstatic, int stock)
2195 int argcnt, tok, tag, funcline;
2196 int opertok, opererror;
2197 char symbolname[sNAMEMAX + 1];
2199 cell val, cidx, glbdecl;
2202 litidx = 0; /* clear the literal pool ??? */
2204 lastst = 0; /* no statement yet */
2205 cidx = 0; /* just to avoid compiler warnings */
2207 filenum = fcurrent; /* save file number at start of declaration */
2209 if (firstname != NULL)
2211 assert(strlen(firstname) <= sNAMEMAX);
2212 strcpy(symbolname, firstname); /* save symbol name */
2217 tag = (firsttag >= 0) ? firsttag : sc_addtag(NULL);
2218 tok = lex(&val, &str);
2220 if (tok == tNATIVE || (tok == tPUBLIC && stock))
2221 error(42); /* invalid combination of class specifiers */
2222 if (tok == tOPERATOR)
2224 opertok = operatorname(symbolname);
2226 return TRUE; /* error message already given */
2227 check_operatortag(opertok, tag, symbolname);
2231 if (tok != tSYMBOL && freading)
2233 error(20, str); /* invalid symbol name */
2236 assert(strlen(str) <= sNAMEMAX);
2237 strcpy(symbolname, str);
2240 /* check whether this is a function or a variable declaration */
2241 if (!matchtoken('('))
2243 /* so it is a function, proceed */
2244 funcline = fline; /* save line at which the function is defined */
2245 if (symbolname[0] == PUBLIC_CHAR)
2247 fpublic = TRUE; /* implicitly public function */
2249 error(42); /* invalid combination of class specifiers */
2251 sym = fetchfunc(symbolname, tag); /* get a pointer to the
2256 sym->usage |= uPUBLIC;
2258 sym->fnumber = filenum;
2259 /* declare all arguments */
2260 argcnt = declargs(sym);
2261 opererror = !operatoradjust(opertok, sym, symbolname, tag);
2262 if (strcmp(symbolname, uMAINFUNC) == 0)
2265 error(5); /* "main()" function may not have any arguments */
2266 sym->usage |= uREAD; /* "main()" is the program's entry point:
2269 /* "declargs()" found the ")"; if a ";" appears after this, it was a
2271 if (matchtoken(';'))
2273 if (!sc_needsemicolon)
2274 error(218); /* old style prototypes used with optional
2276 delete_symbols(&loctab, 0, TRUE, TRUE); /* prototype is done;
2277 * forget everything */
2280 /* so it is not a prototype, proceed */
2281 /* if this is a function that is not referred to (this can only be
2282 * detected in the second stage), shut code generation off */
2283 if (sc_status == statWRITE && (sym->usage & uREAD) == 0)
2285 sc_status = statSKIP;
2287 glbdecl = glb_declared;
2290 sym->usage |= uDEFINE; /* set the definition flag */
2292 sym->usage |= uREAD; /* public functions are always "used" */
2294 sym->usage |= uSTOCK;
2295 if (opertok != 0 && opererror)
2296 sym->usage &= ~uDEFINE;
2297 defsymbol(sym->name, iFUNCTN, sGLOBAL,
2298 code_idx + opcodes(1) + opargs(3) + nameincells(sym->name), tag);
2299 /* ^^^ The address for the symbol is the code address. But the
2300 * "symbol" instruction itself generates code. Therefore the
2301 * offset is pre-adjusted to the value it will have after the
2302 * symbol instruction.
2304 startfunc(sym->name); /* creates stack frame */
2305 if ((sc_debug & sSYMBOLIC) != 0)
2306 setline(funcline, fcurrent);
2309 alignframe(sc_dataalign);
2310 sc_alignnext = FALSE;
2312 declared = 0; /* number of local cells */
2313 rettype = (sym->usage & uRETVALUE); /* set "return type" variable */
2315 define_args(); /* add the symbolic info for the function arguments */
2316 statement(NULL, FALSE);
2317 if ((rettype & uRETVALUE) != 0)
2318 sym->usage |= uRETVALUE;
2321 /* This happens only in a very special (and useless) case, where a
2322 * function has only a single statement in its body (no compound
2323 * block) and that statement declares a new variable
2325 modstk((int)declared * sizeof(cell)); /* remove all local
2329 if ((lastst != tRETURN) && (lastst != tGOTO))
2333 if ((sym->usage & uRETVALUE) != 0)
2335 char symname[2 * sNAMEMAX + 16]; /* allow space for user
2336 * defined operators */
2337 funcdisplayname(symname, sym->name);
2338 error(209, symname); /* function should return a value */
2343 { /* if there are literals defined */
2344 glb_declared += litidx;
2345 begdseg(); /* flip to DATA segment */
2346 dumplits(); /* dump literal strings */
2349 testsymbols(&loctab, 0, TRUE, TRUE); /* test for unused arguments
2351 delete_symbols(&loctab, 0, TRUE, TRUE); /* clear local variables
2353 assert(loctab.next == NULL);
2355 if (sc_status == statSKIP)
2357 sc_status = statWRITE;
2359 glb_declared = glbdecl;
2365 argcompare(arginfo * a1, arginfo * a2)
2369 result = strcmp(a1->name, a2->name) == 0;
2371 result = a1->ident == a2->ident;
2373 result = a1->usage == a2->usage;
2375 result = a1->numtags == a2->numtags;
2380 for (i = 0; i < a1->numtags && result; i++)
2381 result = a1->tags[i] == a2->tags[i];
2384 result = a1->hasdefault == a2->hasdefault;
2387 if (a1->ident == iREFARRAY)
2390 result = a1->defvalue.array.size == a2->defvalue.array.size;
2393 a1->defvalue.array.arraysize == a2->defvalue.array.arraysize;
2394 /* also check the dimensions of both arrays */
2396 result = a1->numdim == a2->numdim;
2397 for (level = 0; result && level < a1->numdim; level++)
2398 result = a1->dim[level] == a2->dim[level];
2399 /* ??? should also check contents of the default array
2400 * (these troubles go away in a 2-pass compiler that forbids
2401 * double declarations, but Small currently does not forbid them)
2408 if ((a1->hasdefault & uSIZEOF) != 0
2409 || (a1->hasdefault & uTAGOF) != 0)
2410 result = a1->hasdefault == a2->hasdefault
2411 && strcmp(a1->defvalue.size.symname,
2412 a2->defvalue.size.symname) == 0
2413 && a1->defvalue.size.level == a2->defvalue.size.level;
2415 result = a1->defvalue.val == a2->defvalue.val;
2419 result = a1->defvalue_tag == a2->defvalue_tag;
2426 * This routine adds an entry in the local symbol table for each
2427 * argument found in the argument list.
2428 * It returns the number of arguments.
2431 declargs(symbol * sym)
2435 int argcnt, oldargcnt, tok, tags[MAXTAGS], numtags;
2437 arginfo arg, *arglist;
2438 char name[sNAMEMAX + 1];
2439 int ident, fpublic, fconst;
2442 /* if the function is already defined earlier, get the number of
2443 * arguments of the existing definition
2446 if ((sym->usage & uPROTOTYPED) != 0)
2447 while (sym->dim.arglist[oldargcnt].ident != 0)
2449 argcnt = 0; /* zero aruments up to now */
2453 fpublic = (sym->usage & uPUBLIC) != 0;
2454 /* the '(' parantheses has already been parsed */
2455 if (!matchtoken(')'))
2458 { /* there are arguments; process them */
2459 /* any legal name increases argument count (and stack offset) */
2460 tok = lex(&val, &ptr);
2467 if (ident != iVARIABLE || numtags > 0)
2468 error(1, "-identifier-", "&");
2472 if (ident != iVARIABLE || numtags > 0)
2473 error(1, "-identifier-", "const");
2478 error(1, "-identifier-", "-tagname-");
2479 tags[0] = sc_addtag(ptr);
2484 error(1, "-identifier-", "-tagname-");
2486 while (numtags < MAXTAGS)
2488 if (!matchtoken('_') && !needtoken(tSYMBOL))
2490 tokeninfo(&val, &ptr);
2491 tags[numtags++] = sc_addtag(ptr);
2492 if (matchtoken('}'))
2497 tok = tLABEL; /* for outer loop:
2498 * flag that we have seen a tagname */
2501 if (argcnt >= sMAXARGS)
2502 error(45); /* too many function arguments */
2503 strcpy(name, ptr); /* save symbol name */
2504 if (name[0] == PUBLIC_CHAR)
2505 error(56, name); /* function arguments cannot be public */
2507 tags[numtags++] = 0; /* default tag */
2509 * base + 0*sizeof(cell) == previous "base"
2510 * base + 1*sizeof(cell) == function return address
2511 * base + 2*sizeof(cell) == number of arguments
2512 * base + 3*sizeof(cell) == first argument of the function
2513 * So the offset of each argument is:
2514 * "(argcnt+3) * sizeof(cell)".
2516 doarg(name, ident, (argcnt + 3) * sizeof(cell), tags, numtags,
2517 fpublic, fconst, &arg);
2518 if (fpublic && arg.hasdefault)
2519 error(59, name); /* arguments of a public function may not
2520 * have a default value */
2521 if ((sym->usage & uPROTOTYPED) == 0)
2523 /* redimension the argument list, add the entry */
2525 (arginfo *) realloc(sym->dim.arglist,
2526 (argcnt + 2) * sizeof(arginfo));
2527 if (sym->dim.arglist == 0)
2528 error(103); /* insufficient memory */
2529 sym->dim.arglist[argcnt] = arg;
2530 sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
2535 /* check the argument with the earlier definition */
2536 if (argcnt > oldargcnt
2537 || !argcompare(&sym->dim.arglist[argcnt], &arg))
2538 error(25); /* function definition does not match prototype */
2539 /* may need to free default array argument and the tag list */
2540 if (arg.ident == iREFARRAY && arg.hasdefault)
2541 free(arg.defvalue.array.data);
2542 else if (arg.ident == iVARIABLE
2543 && ((arg.hasdefault & uSIZEOF) != 0
2544 || (arg.hasdefault & uTAGOF) != 0))
2545 free(arg.defvalue.size.symname);
2554 if (ident != iVARIABLE)
2555 error(10); /* illegal function or declaration */
2557 tags[numtags++] = 0; /* default tag */
2558 if ((sym->usage & uPROTOTYPED) == 0)
2560 /* redimension the argument list, add the entry iVARARGS */
2562 (arginfo *) realloc(sym->dim.arglist,
2563 (argcnt + 2) * sizeof(arginfo));
2564 if (sym->dim.arglist == 0)
2565 error(103); /* insufficient memory */
2566 sym->dim.arglist[argcnt + 1].ident = 0; /* keep the list
2568 sym->dim.arglist[argcnt].ident = iVARARGS;
2569 sym->dim.arglist[argcnt].hasdefault = FALSE;
2570 sym->dim.arglist[argcnt].defvalue.val = 0;
2571 sym->dim.arglist[argcnt].defvalue_tag = 0;
2572 sym->dim.arglist[argcnt].numtags = numtags;
2573 sym->dim.arglist[argcnt].tags =
2574 (int *)malloc(numtags * sizeof tags[0]);
2575 if (sym->dim.arglist[argcnt].tags == NULL)
2576 error(103); /* insufficient memory */
2577 memcpy(sym->dim.arglist[argcnt].tags, tags,
2578 numtags * sizeof tags[0]);
2582 if (argcnt > oldargcnt
2583 || sym->dim.arglist[argcnt].ident != iVARARGS)
2584 error(25); /* function definition does not match prototype */
2589 error(10); /* illegal function or declaration */
2592 while (tok == '&' || tok == tLABEL || tok == tCONST || (tok != tELLIPS && matchtoken(','))); /* more? */
2593 /* if the next token is not ",", it should be ")" */
2596 /* resolve any "sizeof" arguments (now that all arguments are known) */
2597 assert(sym->dim.arglist != NULL);
2598 arglist = sym->dim.arglist;
2599 for (idx = 0; idx < argcnt && arglist[idx].ident != 0; idx++)
2601 if ((arglist[idx].hasdefault & uSIZEOF) != 0
2602 || (arglist[idx].hasdefault & uTAGOF) != 0)
2606 /* Find the argument with the name mentioned after the "sizeof".
2607 * Note that we cannot use findloc here because we need the
2608 * arginfo struct, not the symbol.
2610 ptr = arglist[idx].defvalue.size.symname;
2612 altidx < argcnt && strcmp(ptr, arglist[altidx].name) != 0;
2615 if (altidx >= argcnt)
2617 error(17, ptr); /* undefined symbol */
2621 /* check the level against the number of dimensions */
2622 /* the level must be zero for "tagof" values */
2623 assert(arglist[idx].defvalue.size.level == 0
2624 || (arglist[idx].hasdefault & uSIZEOF) != 0);
2625 if (arglist[idx].defvalue.size.level > 0
2626 && arglist[idx].defvalue.size.level >=
2627 arglist[altidx].numdim)
2628 error(28); /* invalid subscript */
2629 if (arglist[altidx].ident != iREFARRAY)
2631 assert(arglist[altidx].ident == iVARIABLE
2632 || arglist[altidx].ident == iREFERENCE);
2633 error(223, ptr); /* redundant sizeof */
2639 sym->usage |= uPROTOTYPED;
2640 errorset(sRESET); /* reset error flag (clear the "panic mode") */
2644 /* doarg - declare one argument type
2646 * this routine is called from "declargs()" and adds an entry in the
2647 * local symbol table for one argument. "fpublic" indicates whether
2648 * the function for this argument list is public.
2649 * The arguments themselves are never public.
2652 doarg(char *name, int ident, int offset, int tags[], int numtags,
2653 int fpublic, int fconst, arginfo * arg)
2657 int idxtag[sDIMEN_MAX];
2659 strcpy(arg->name, name);
2660 arg->hasdefault = FALSE; /* preset (most common case) */
2661 arg->defvalue.val = 0; /* clear */
2662 arg->defvalue_tag = 0;
2664 if (matchtoken('['))
2666 if (ident == iREFERENCE)
2667 error(67, name); /*illegal declaration ("&name[]" is unsupported) */
2670 if (arg->numdim == sDIMEN_MAX)
2672 error(53); /* exceeding maximum number of dimensions */
2675 /* there is no check for non-zero major dimensions here, only if
2676 * the array parameter has a default value, we enforce that all
2677 * array dimensions, except the last, are non-zero
2679 size = needsub(&idxtag[arg->numdim]); /* may be zero here,
2680 *it is a pointer anyway */
2681 #if INT_MAX < LONG_MAX
2683 error(105); /* overflow, exceeding capacity */
2685 arg->dim[arg->numdim] = (int)size;
2688 while (matchtoken('['));
2689 ident = iREFARRAY; /* "reference to array" (is a pointer) */
2690 if (matchtoken('='))
2694 lexpush(); /* initials() needs the "=" token again */
2695 assert(numtags > 0);
2696 /* for the moment, when a default value is given for the array,
2697 * all dimension sizes, except the last, must be non-zero
2698 * (function initials() requires to know the major dimensions)
2700 for (level = 0; level < arg->numdim - 1; level++)
2701 if (arg->dim[level] == 0)
2702 error(52); /* only last dimension may be variable length */
2703 initials(ident, tags[0], &size, arg->dim, arg->numdim);
2704 assert(size >= litidx);
2705 /* allocate memory to hold the initial values */
2706 arg->defvalue.array.data = (cell *) malloc(litidx * sizeof(cell));
2707 if (arg->defvalue.array.data != NULL)
2711 memcpy(arg->defvalue.array.data, litq, litidx * sizeof(cell));
2712 arg->hasdefault = TRUE; /* argument has default value */
2713 arg->defvalue.array.size = litidx;
2714 arg->defvalue.array.addr = -1;
2715 /* calulate size to reserve on the heap */
2716 arg->defvalue.array.arraysize = 1;
2717 for (i = 0; i < arg->numdim; i++)
2718 arg->defvalue.array.arraysize *= arg->dim[i];
2719 if (arg->defvalue.array.arraysize < arg->defvalue.array.size)
2720 arg->defvalue.array.arraysize = arg->defvalue.array.size;
2722 litidx = 0; /* reset */
2727 if (matchtoken('='))
2729 unsigned char size_tag_token;
2731 assert(ident == iVARIABLE || ident == iREFERENCE);
2732 arg->hasdefault = TRUE; /* argument has a default value */
2734 (unsigned char)(matchtoken(tSIZEOF) ? uSIZEOF : 0);
2735 if (size_tag_token == 0)
2737 (unsigned char)(matchtoken(tTAGOF) ? uTAGOF : 0);
2738 if (size_tag_token != 0)
2742 if (ident == iREFERENCE)
2743 error(66, name); /* argument may not be a reference */
2745 while (matchtoken('('))
2747 if (needtoken(tSYMBOL))
2749 /* save the name of the argument whose size id to take */
2753 tokeninfo(&val, &name);
2754 if ((arg->defvalue.size.symname =
2755 strdup(name)) == NULL)
2756 error(103); /* insufficient memory */
2757 arg->defvalue.size.level = 0;
2758 if (size_tag_token == uSIZEOF)
2760 while (matchtoken('['))
2762 arg->defvalue.size.level += (short)1;
2766 if (ident == iVARIABLE) /* make sure we set this only if
2767 * not a reference */
2768 arg->hasdefault |= size_tag_token; /* uSIZEOF or uTAGOF */
2770 while (paranthese--)
2775 constexpr(&arg->defvalue.val, &arg->defvalue_tag);
2776 assert(numtags > 0);
2777 if (!matchtag(tags[0], arg->defvalue_tag, TRUE))
2778 error(213); /* tagname mismatch */
2782 arg->ident = (char)ident;
2783 arg->usage = (char)(fconst ? uCONST : 0);
2784 arg->numtags = numtags;
2785 arg->tags = (int *)malloc(numtags * sizeof tags[0]);
2786 if (arg->tags == NULL)
2787 error(103); /* insufficient memory */
2788 memcpy(arg->tags, tags, numtags * sizeof tags[0]);
2789 argsym = findloc(name);
2792 error(21, name); /* symbol already defined */
2796 if ((argsym = findglb(name)) != NULL && argsym->ident != iFUNCTN)
2797 error(219, name); /* variable shadows another symbol */
2798 /* add details of type and address */
2799 assert(numtags > 0);
2800 argsym = addvariable(name, offset, ident, sLOCAL, tags[0],
2801 arg->dim, arg->numdim, idxtag);
2802 argsym->compound = 0;
2803 if (ident == iREFERENCE)
2804 argsym->usage |= uREAD; /* because references are passed back */
2806 argsym->usage |= uREAD; /* arguments of public functions
2807 * are always "used" */
2809 argsym->usage |= uCONST;
2814 count_referrers(symbol * entry)
2819 for (i = 0; i < entry->numrefers; i++)
2820 if (entry->refer[i] != NULL)
2825 /* Every symbol has a referrer list, that contains the functions that
2826 * use the symbol. Now, if function "apple" is accessed by functions
2827 * "banana" and "citron", but neither function "banana" nor "citron" are
2828 * used by anyone else, then, by inference, function "apple" is not used
2831 reduce_referrers(symbol * root)
2839 for (sym = root->next; sym != NULL; sym = sym->next)
2841 if (sym->parent != NULL)
2842 continue; /* hierarchical data type */
2843 if (sym->ident == iFUNCTN
2844 && (sym->usage & uNATIVE) == 0
2845 && (sym->usage & uPUBLIC) == 0
2846 && strcmp(sym->name, uMAINFUNC) != 0
2847 && count_referrers(sym) == 0)
2849 sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
2850 * there is no referrer */
2851 /* find all symbols that are referred by this symbol */
2852 for (ref = root->next; ref != NULL; ref = ref->next)
2854 if (ref->parent != NULL)
2855 continue; /* hierarchical data type */
2856 assert(ref->refer != NULL);
2857 for (i = 0; i < ref->numrefers && ref->refer[i] != sym;
2860 if (i < ref->numrefers)
2862 assert(ref->refer[i] == sym);
2863 ref->refer[i] = NULL;
2868 else if ((sym->ident == iVARIABLE || sym->ident == iARRAY)
2869 && (sym->usage & uPUBLIC) == 0
2870 && sym->parent == NULL && count_referrers(sym) == 0)
2872 sym->usage &= ~(uREAD | uWRITTEN); /* erase usage bits if
2873 * there is no referrer */
2876 /* after removing a symbol, check whether more can be removed */
2878 while (restart > 0);
2881 /* testsymbols - test for unused local or global variables
2883 * "Public" functions are excluded from the check, since these
2884 * may be exported to other object modules.
2885 * Labels are excluded from the check if the argument 'testlabs'
2886 * is 0. Thus, labels are not tested until the end of the function.
2887 * Constants may also be excluded (convenient for global constants).
2889 * When the nesting level drops below "level", the check stops.
2891 * The function returns whether there is an "entry" point for the file.
2892 * This flag will only be 1 when browsing the global symbol table.
2895 testsymbols(symbol * root, int level, int testlabs, int testconst)
2897 char symname[2 * sNAMEMAX + 16];
2900 symbol *sym = root->next;
2902 while (sym != NULL && sym->compound >= level)
2909 if ((sym->usage & uDEFINE) == 0)
2910 error(19, sym->name); /* not a label: ... */
2911 else if ((sym->usage & uREAD) == 0)
2912 error(203, sym->name); /* symbol isn't used: ... */
2916 if ((sym->usage & (uDEFINE | uREAD | uNATIVE | uSTOCK)) == uDEFINE)
2918 funcdisplayname(symname, sym->name);
2919 if (symname[0] != '\0')
2920 error(203, symname); /* symbol isn't used ...
2921 * (and not native/stock) */
2923 if ((sym->usage & uPUBLIC) != 0
2924 || strcmp(sym->name, uMAINFUNC) == 0)
2925 entry = TRUE; /* there is an entry point */
2928 if (testconst && (sym->usage & uREAD) == 0)
2929 error(203, sym->name); /* symbol isn't used: ... */
2933 if (sym->parent != NULL)
2934 break; /* hierarchical data type */
2935 if ((sym->usage & (uWRITTEN | uREAD | uSTOCK | uPUBLIC)) == 0)
2936 error(203, sym->name); /* symbol isn't used (and not stock
2938 else if ((sym->usage & (uREAD | uSTOCK | uPUBLIC)) == 0)
2939 error(204, sym->name); /* value assigned to symbol is
2941 #if 0 /*// ??? not sure whether it is a good idea to
2942 * force people use "const" */
2943 else if ((sym->usage & (uWRITTEN | uPUBLIC | uCONST)) == 0
2944 && sym->ident == iREFARRAY)
2945 error(214, sym->name); /* make array argument "const" */
2955 calc_array_datasize(symbol * sym, cell * offset)
2959 assert(sym != NULL);
2960 assert(sym->ident == iARRAY || sym->ident == iREFARRAY);
2961 length = sym->dim.array.length;
2962 if (sym->dim.array.level > 0)
2965 calc_array_datasize(finddepend(sym), offset);
2967 *offset = length * (*offset + sizeof(cell));
2969 length *= length * sublength;
2982 destructsymbols(symbol * root, int level)
2985 int savepri = FALSE;
2986 symbol *sym = root->next;
2988 while (sym != NULL && sym->compound >= level)
2990 if (sym->ident == iVARIABLE || sym->ident == iARRAY)
2992 char symbolname[16];
2996 /* check that the '~' operator is defined for this tag */
2997 operator_symname(symbolname, "~", sym->tag, 0, 1, 0);
2998 if ((opsym = findglb(symbolname)) != NULL)
3000 /* save PRI, in case of a return statment */
3003 push1(); /* right-hand operand is in PRI */
3006 /* if the variable is an array, get the number of elements */
3007 if (sym->ident == iARRAY)
3009 elements = calc_array_datasize(sym, &offset);
3010 /* "elements" can be zero when the variable is declared like
3011 * new mytag: myvar[2][] = { {1, 2}, {3, 4} }
3012 * one should declare all dimensions!
3015 error(46, sym->name); /* array size is unknown */
3023 /* call the '~' operator */
3025 addconst(offset); /*add offset to array data to the address */
3027 pushval(2 * sizeof(cell)); /* 2 parameters */
3029 if (sc_status != statSKIP)
3030 markusage(opsym, uREAD); /* do not mark as "used" when this
3031 * call itself is skipped */
3032 if (opsym->x.lib != NULL)
3033 opsym->x.lib->value += 1; /* increment "usage count"
3039 /* restore PRI, if it was saved */
3045 insert_constval(constvalue * prev, constvalue * next, char *name,
3046 cell val, short index)
3050 if ((cur = (constvalue *) malloc(sizeof(constvalue))) == NULL)
3051 error(103); /* insufficient memory (fatal error) */
3052 memset(cur, 0, sizeof(constvalue));
3053 strcpy(cur->name, name);
3062 append_constval(constvalue * table, char *name, cell val, short index)
3064 constvalue *cur, *prev;
3066 /* find the end of the constant table */
3067 for (prev = table, cur = table->next; cur != NULL;
3068 prev = cur, cur = cur->next)
3070 return insert_constval(prev, NULL, name, val, index);
3074 find_constval(constvalue * table, char *name, short index)
3076 constvalue *ptr = table->next;
3080 if (strcmp(name, ptr->name) == 0 && ptr->index == index)
3088 find_constval_byval(constvalue * table, cell val)
3090 constvalue *ptr = table->next;
3094 if (ptr->value == val)
3101 #if 0 /* never used */
3103 delete_constval(constvalue * table, char *name)
3105 constvalue *prev = table;
3106 constvalue *cur = prev->next;
3110 if (strcmp(name, cur->name) == 0)
3112 prev->next = cur->next;
3124 delete_consttable(constvalue * table)
3126 constvalue *cur = table->next, *next;
3134 memset(table, 0, sizeof(constvalue));
3139 * Adds a symbol to the #define symbol table.
3142 add_constant(char *name, cell val, int vclass, int tag)
3146 /* Test whether a global or local symbol with the same name exists. Since
3147 * constants are stored in the symbols table, this also finds previously
3148 * defind constants. */
3149 sym = findglb(name);
3151 sym = findloc(name);
3154 /* silently ignore redefinitions of constants with the same value */
3155 if (sym->ident == iCONSTEXPR)
3157 if (sym->addr != val)
3158 error(201, name); /* redefinition of constant (different value) */
3162 error(21, name); /* symbol already defined */
3167 /* constant doesn't exist yet, an entry must be created */
3168 sym = addsym(name, val, iCONSTEXPR, vclass, tag, uDEFINE);
3169 if (sc_status == statIDLE)
3170 sym->usage |= uPREDEF;
3173 /* statement - The Statement Parser
3175 * This routine is called whenever the parser needs to know what
3176 * statement it encounters (i.e. whenever program syntax requires a
3180 statement(int *lastindent, int allow_decl)
3188 error(36); /* empty statement */
3193 tok = lex(&val, &st);
3195 setline(fline, fcurrent);
3196 /* lex() has set stmtindent */
3197 if (lastindent != NULL && tok != tLABEL)
3200 if (*lastindent >= 0 && *lastindent != stmtindent &&
3201 !indent_nowarn && sc_tabsize > 0)
3202 error(217); /* loose indentation */
3204 *lastindent = stmtindent;
3205 indent_nowarn = TRUE; /* if warning was blocked, re-enable it */
3220 error(3); /* declaration only valid in a block */
3231 error(3); /* declaration only valid in a block */
3235 if (!matchtoken('}')) /* {} is the empty statement */
3237 /* lastst (for "last statement") does not change */
3240 error(36); /* empty statement */
3264 error(14); /* not in switch */
3304 default: /* non-empty expression */
3305 lexpush(); /* analyze token later */
3306 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE);
3316 cell save_decl = declared;
3319 nestlevel += 1; /* increase compound statement level */
3320 while (matchtoken('}') == 0)
3321 { /* repeat until compound statement is closed */
3324 needtoken('}'); /* gives error: "expected token }" */
3330 && (lastst == tRETURN || lastst == tBREAK
3331 || lastst == tCONTINUE))
3332 error(225); /* unreachable code */
3333 statement(&indent, TRUE); /* do a statement */
3337 if (lastst != tRETURN)
3338 destructsymbols(&loctab, nestlevel);
3339 if (lastst != tRETURN && lastst != tGOTO)
3340 /* delete local variable space */
3341 modstk((int)(declared - save_decl) * sizeof(cell));
3343 testsymbols(&loctab, nestlevel, FALSE, TRUE); /* look for unused
3345 declared = save_decl;
3346 delete_symbols(&loctab, nestlevel, FALSE, TRUE);
3347 /* erase local symbols, but
3348 * retain block local labels
3349 * (within the function) */
3351 nestlevel -= 1; /* decrease compound statement level */
3356 * Global references: stgidx (referred to only)
3359 doexpr(int comma, int chkeffect, int allowarray, int mark_endexpr,
3360 int *tag, int chkfuncresult)
3362 int constant, index, ident;
3363 int localstaging = FALSE;
3368 stgset(TRUE); /* start stage-buffering */
3369 localstaging = TRUE;
3370 assert(stgidx == 0);
3373 errorset(sEXPRMARK);
3376 /* on second round through, mark the end of the previous expression */
3377 if (index != stgidx)
3380 ident = expression(&constant, &val, tag, chkfuncresult);
3381 if (!allowarray && (ident == iARRAY || ident == iREFARRAY))
3382 error(33, "-unknown-"); /* array must be indexed */
3383 if (chkeffect && !sideeffect)
3384 error(215); /* expression has no effect */
3386 while (comma && matchtoken(',')); /* more? */
3388 endexpr(TRUE); /* optionally, mark the end of the expression */
3389 errorset(sEXPRRELEASE);
3393 stgset(FALSE); /* stop staging */
3400 constexpr(cell * val, int *tag)
3402 int constant, index;
3405 stgset(TRUE); /* start stage-buffering */
3406 stgget(&index, &cidx); /* mark position in code generator */
3407 errorset(sEXPRMARK);
3408 expression(&constant, val, tag, FALSE);
3409 stgdel(index, cidx); /* scratch generated code */
3410 stgset(FALSE); /* stop stage-buffering */
3412 error(8); /* must be constant expression */
3413 errorset(sEXPRRELEASE);
3419 * In the case a "simple assignment" operator ("=") is used within a
3420 * test, * the warning "possibly unintended assignment" is displayed.
3421 * This routine sets the global variable "intest" to true, it is
3422 * restored upon termination. In the case the assignment was intended,
3423 * use parantheses around the expression to avoid the warning;
3424 * primary() sets "intest" to 0.
3426 * Global references: intest (altered, but restored upon termination)
3429 test(int label, int parens, int invert)
3433 value lval = { NULL, 0, 0, 0, 0, NULL };
3434 int localstaging = FALSE;
3438 stgset(TRUE); /* start staging */
3439 localstaging = TRUE;
3441 stgget(&index, &cidx); /* should start at zero if started
3447 /* FIXME: 64bit unsafe! putting an int on a stack of void *'s */
3448 pushstk((stkitem) intest);
3454 stgget(&index, &cidx); /* mark position (of last expression) in
3458 tok = matchtoken(',');
3462 while (tok); /* do */
3465 if (lval.ident == iARRAY || lval.ident == iREFARRAY)
3468 (lval.sym->name != NULL) ? lval.sym->name : "-unknown-";
3469 error(33, ptr); /* array must be indexed */
3471 if (lval.ident == iCONSTEXPR)
3472 { /* constant expression */
3473 intest = (int)(long)popstk(); /* restore stack */
3474 stgdel(index, cidx);
3476 { /* code always executed */
3477 error(206); /* redundant test: always non-zero */
3481 error(205); /* redundant code: never executed */
3486 stgout(0); /* write "jumplabel" code */
3487 stgset(FALSE); /* stop staging */
3491 if (lval.tag != 0 && lval.tag != sc_addtag("bool"))
3492 if (check_userop(lneg, lval.tag, 0, 1, NULL, &lval.tag))
3493 invert = !invert; /* user-defined ! operator inverted result */
3495 jmp_ne0(label); /* jump to label if true (different from 0) */
3497 jmp_eq0(label); /* jump to label if false (equal to 0) */
3498 endexpr(TRUE); /* end expression (give optimizer a chance) */
3499 intest = (int)(long)popstk(); /* double typecast to avoid warning
3500 * with Microsoft C */
3503 stgout(0); /* output queue from the very beginning (see
3504 * assert() when localstaging is set to TRUE) */
3505 stgset(FALSE); /* stop staging */
3515 ifindent = stmtindent; /* save the indent of the "if" instruction */
3516 flab1 = getlabel(); /* get label number for false branch */
3517 test(flab1, TRUE, FALSE); /*get expression, branch to flab1 if false */
3518 statement(NULL, FALSE); /* if true, do a statement */
3519 if (matchtoken(tELSE) == 0)
3521 setlabel(flab1); /* no, simple if..., print false label */
3525 /* to avoid the "dangling else" error, we want a warning if the "else"
3526 * has a lower indent than the matching "if" */
3528 if (stmtindent < ifindent && sc_tabsize > 0)
3529 error(217); /* loose indentation */
3532 if ((lastst != tRETURN) && (lastst != tGOTO))
3534 setlabel(flab1); /* print false label */
3535 statement(NULL, FALSE); /* do "else" clause */
3536 setlabel(flab2); /* print true label */
3543 int wq[wqSIZE]; /* allocate local queue */
3545 addwhile(wq); /* add entry to queue for "break" */
3546 setlabel(wq[wqLOOP]); /* loop label */
3547 /* The debugger uses the "line" opcode to be able to "break" out of
3548 * a loop. To make sure that each loop has a line opcode, even for the
3549 * tiniest loop, set it below the top of the loop */
3550 setline(fline, fcurrent);
3551 test(wq[wqEXIT], TRUE, FALSE); /* branch to wq[wqEXIT] if false */
3552 statement(NULL, FALSE); /* if so, do a statement */
3553 jumplabel(wq[wqLOOP]); /* and loop to "while" start */
3554 setlabel(wq[wqEXIT]); /* exit label */
3555 delwhile(); /* delete queue entry */
3559 * Note that "continue" will in this case not jump to the top of the
3560 * loop, but to the end: just before the TRUE-or-FALSE testing code.
3565 int wq[wqSIZE], top;
3567 addwhile(wq); /* see "dowhile" for more info */
3568 top = getlabel(); /* make a label first */
3569 setlabel(top); /* loop label */
3570 statement(NULL, FALSE);
3572 setlabel(wq[wqLOOP]); /* "continue" always jumps to WQLOOP. */
3573 setline(fline, fcurrent);
3574 test(wq[wqEXIT], TRUE, FALSE);
3576 setlabel(wq[wqEXIT]);
3584 int wq[wqSIZE], skiplab;
3586 int save_nestlevel, index;
3589 save_decl = declared;
3590 save_nestlevel = nestlevel;
3593 skiplab = getlabel();
3595 if (matchtoken(';') == 0)
3597 /* new variable declarations are allowed here */
3598 if (matchtoken(tNEW))
3600 /* The variable in expr1 of the for loop is at a
3601 * 'compound statement' level of it own.
3604 declloc(FALSE); /* declare local variable */
3608 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 1 */
3612 /* Adjust the "declared" field in the "while queue", in case that
3613 * local variables were declared in the first expression of the
3614 * "for" loop. These are deleted in separately, so a "break" or a
3615 * "continue" must ignore these fields.
3618 assert(ptr != NULL);
3619 ptr[wqBRK] = (int)declared;
3620 ptr[wqCONT] = (int)declared;
3621 jumplabel(skiplab); /* skip expression 3 1st time */
3622 setlabel(wq[wqLOOP]); /* "continue" goes to this label: expr3 */
3623 setline(fline, fcurrent);
3624 /* Expressions 2 and 3 are reversed in the generated code:
3625 * expression 3 precedes expression 2.
3626 * When parsing, the code is buffered and marks for
3627 * the start of each expression are insterted in the buffer.
3630 stgset(TRUE); /* start staging */
3631 assert(stgidx == 0);
3633 stgmark(sSTARTREORDER);
3634 stgmark((char)(sEXPRSTART + 0)); /* mark start of 2nd expression
3636 setlabel(skiplab); /*jump to this point after 1st expression */
3637 if (matchtoken(';') == 0)
3639 test(wq[wqEXIT], FALSE, FALSE); /* expression 2
3640 *(jump to wq[wqEXIT] if false) */
3643 stgmark((char)(sEXPRSTART + 1)); /* mark start of 3th expression
3645 if (matchtoken(')') == 0)
3647 doexpr(TRUE, TRUE, TRUE, TRUE, NULL, FALSE); /* expression 3 */
3650 stgmark(sENDREORDER); /* mark end of reversed evaluation */
3652 stgset(FALSE); /* stop staging */
3653 statement(NULL, FALSE);
3654 jumplabel(wq[wqLOOP]);
3655 setlabel(wq[wqEXIT]);
3658 assert(nestlevel >= save_nestlevel);
3659 if (nestlevel > save_nestlevel)
3661 /* Clean up the space and the symbol table for the local
3662 * variable in "expr1".
3664 destructsymbols(&loctab, nestlevel);
3665 modstk((int)(declared - save_decl) * sizeof(cell));
3666 declared = save_decl;
3667 delete_symbols(&loctab, nestlevel, FALSE, TRUE);
3668 nestlevel = save_nestlevel; /* reset 'compound statement'
3673 /* The switch statement is incompatible with its C sibling:
3674 * 1. the cases are not drop through
3675 * 2. only one instruction may appear below each case, use a compound
3676 * instruction to execute multiple instructions
3677 * 3. the "case" keyword accepts a comma separated list of values to
3678 * match, it also accepts a range using the syntax "1 .. 4"
3681 * PRI = expression result
3682 * param = table offset (code segment)
3688 int lbl_table, lbl_exit, lbl_case;
3689 int tok, swdefault, casecount;
3692 constvalue caselist = { NULL, "", 0, 0 }; /*case list starts empty */
3693 constvalue *cse, *csp;
3694 char labelname[sNAMEMAX + 1];
3697 doexpr(TRUE, FALSE, FALSE, TRUE, NULL, FALSE); /* evaluate
3698 * switch expression */
3700 /* generate the code for the switch statement, the label is the
3701 * address of the case table (to be generated later).
3703 lbl_table = getlabel();
3704 lbl_case = 0; /* just to avoid a compiler warning */
3705 ffswitch(lbl_table);
3708 lbl_exit = getlabel(); /*get label number for jumping out of switch */
3713 tok = lex(&val, &str); /* read in (new) token */
3717 if (swdefault != FALSE)
3718 error(15); /* "default" case must be last in switch
3720 lbl_case = getlabel();
3721 sc_allowtags = FALSE; /* do not allow tagnames here */
3726 /* ??? enforce/document that, in a switch, a statement cannot
3727 * start an opening brace (marks the start of a compound
3728 * statement) and search for the right-most colon before that
3730 * Now, by replacing the ':' by a special COLON token, you can
3731 * parse all expressions until that special token.
3734 constexpr(&val, NULL);
3735 /* Search the insertion point (the table is kept in sorted
3736 * order, so that advanced abstract machines can sift the
3737 * case table with a binary search). Check for duplicate
3738 * case values at the same time.
3740 for (csp = &caselist, cse = caselist.next;
3741 cse != NULL && cse->value < val;
3742 csp = cse, cse = cse->next)
3744 if (cse != NULL && cse->value == val)
3745 error(40, val); /* duplicate "case" label */
3746 /* Since the label is stored as a string in the
3747 * "constvalue", the size of an identifier must
3748 * be at least 8, as there are 8
3749 * hexadecimal digits in a 32-bit number.
3752 #error Length of identifier (sNAMEMAX) too small.
3754 insert_constval(csp, cse, itoh(lbl_case), val, 0);
3755 if (matchtoken(tDBLDOT))
3759 constexpr(&end, NULL);
3761 error(50); /* invalid range */
3762 while (++val <= end)
3765 /* find the new insertion point */
3766 for (csp = &caselist, cse = caselist.next;
3767 cse != NULL && cse->value < val;
3768 csp = cse, cse = cse->next)
3770 if (cse != NULL && cse->value == val)
3771 error(40, val); /* duplicate "case" label */
3772 insert_constval(csp, cse, itoh(lbl_case), val, 0);
3776 while (matchtoken(','));
3777 needtoken(':'); /* ':' ends the case */
3778 sc_allowtags = TRUE; /* reset */
3780 statement(NULL, FALSE);
3781 jumplabel(lbl_exit);
3784 if (swdefault != FALSE)
3785 error(16); /* multiple defaults in switch */
3786 lbl_case = getlabel();
3790 statement(NULL, FALSE);
3791 /* Jump to lbl_exit, even thouh this is the last clause in the
3792 *switch, because the jump table is generated between the last
3793 * clause of the switch and the exit label.
3795 jumplabel(lbl_exit);
3798 /* nothing, but avoid dropping into "default" */
3802 indent_nowarn = TRUE; /* disable this check */
3803 tok = '}'; /* break out of the loop after an error */
3809 /* verify that the case table is sorted (unfortunatly, duplicates can
3810 * occur; there really shouldn't be duplicate cases, but the compiler
3811 * may not crash or drop into an assertion for a user error). */
3812 for (cse = caselist.next; cse != NULL && cse->next != NULL; cse = cse->next)
3813 ; /* empty. no idea whether this is correct, but we MUST NOT do
3814 * the setlabel(lbl_table) call in the loop body. doing so breaks
3815 * switch statements that only have one case statement following.
3819 /* generate the table here, before lbl_exit (general jump target) */
3820 setlabel(lbl_table);
3822 if (swdefault == FALSE)
3824 /* store lbl_exit as the "none-matched" label in the switch table */
3825 strcpy(labelname, itoh(lbl_exit));
3829 /* lbl_case holds the label of the "default" clause */
3830 strcpy(labelname, itoh(lbl_case));
3832 ffcase(casecount, labelname, TRUE);
3833 /* generate the rest of the table */
3834 for (cse = caselist.next; cse != NULL; cse = cse->next)
3835 ffcase(cse->value, cse->name, FALSE);
3838 delete_consttable(&caselist); /* clear list of case labels */
3846 value lval = { NULL, 0, 0, 0, 0, NULL };
3848 if ((sc_debug & sCHKBOUNDS) != 0)
3850 flab1 = getlabel(); /* get label number for "OK" branch */
3851 test(flab1, FALSE, TRUE); /* get expression and branch
3852 * to flab1 if true */
3853 setline(fline, fcurrent); /* make sure we abort on the correct
3855 ffabort(xASSERTION);
3860 stgset(TRUE); /* start staging */
3861 stgget(&index, &cidx); /* mark position in code generator */
3866 stgdel(index, cidx); /* just scrap the code */
3868 while (matchtoken(','));
3869 stgset(FALSE); /* stop staging */
3881 if (lex(&val, &st) == tSYMBOL)
3884 jumplabel((int)sym->addr);
3885 sym->usage |= uREAD; /* set "uREAD" bit */
3887 * // ??? if the label is defined (check sym->usage & uDEFINE), check
3888 * // sym->compound (nesting level of the label) against nestlevel;
3889 * // if sym->compound < nestlevel, call the destructor operator
3894 error(20, st); /* illegal symbol name */
3906 tokeninfo(&val, &st); /* retrieve label name again */
3907 if (find_constval(&tagname_tab, st, 0) != NULL)
3908 error(221, st); /* label name shadows tagname */
3910 setlabel((int)sym->addr);
3911 /* since one can jump around variable declarations or out of compound
3912 * blocks, the stack must be manually adjusted
3914 setstk(-declared * sizeof(cell));
3915 sym->usage |= uDEFINE; /* label is now defined */
3920 * Finds a label from the (local) symbol table or adds one to it.
3921 * Labels are local in scope.
3923 * Note: The "_usage" bit is set to zero. The routines that call
3924 * "fetchlab()" must set this bit accordingly.
3927 fetchlab(char *name)
3931 sym = findloc(name); /* labels are local in scope */
3934 if (sym->ident != iLABEL)
3935 error(19, sym->name); /* not a label: ... */
3939 sym = addsym(name, getlabel(), iLABEL, sLOCAL, 0, 0);
3940 sym->x.declared = (int)declared;
3941 sym->compound = nestlevel;
3948 * Global references: rettype (altered)
3955 if (matchtoken(tTERM) == 0)
3957 if ((rettype & uRETNONE) != 0)
3958 error(208); /* mix "return;" and "return value;" */
3959 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
3961 rettype |= uRETVALUE; /* function returns a value */
3962 /* check tagname with function tagname */
3963 assert(curfunc != NULL);
3964 if (!matchtag(curfunc->tag, tag, TRUE))
3965 error(213); /* tagname mismatch */
3969 /* this return statement contains no expression */
3971 if ((rettype & uRETVALUE) != 0)
3973 char symname[2 * sNAMEMAX + 16]; /* allow space for user
3974 * defined operators */
3975 assert(curfunc != NULL);
3976 funcdisplayname(symname, curfunc->name);
3977 error(209, symname); /* function should return a value */
3979 rettype |= uRETNONE; /* function does not return anything */
3981 destructsymbols(&loctab, 0); /*call destructor for *all* locals */
3982 modstk((int)declared * sizeof(cell)); /* end of function, remove
3983 *all* * local variables*/
3992 ptr = readwhile(); /* readwhile() gives an error if not in loop */
3996 destructsymbols(&loctab, nestlevel);
3997 modstk(((int)declared - ptr[wqBRK]) * sizeof(cell));
3998 jumplabel(ptr[wqEXIT]);
4006 ptr = readwhile(); /* readwhile() gives an error if not in loop */
4010 destructsymbols(&loctab, nestlevel);
4011 modstk(((int)declared - ptr[wqCONT]) * sizeof(cell));
4012 jumplabel(ptr[wqLOOP]);
4018 /* find the tag by value in the table, then set the top bit to mark it
4025 assert((tag & PUBLICTAG) == 0);
4026 for (ptr = tagname_tab.next;
4027 ptr != NULL && tag != (int)(ptr->value & TAGMASK); ptr = ptr->next)
4030 ptr->value |= PUBLICTAG;
4039 if (matchtoken(tTERM) == 0)
4041 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
4050 destructsymbols(&loctab, 0); /* call destructor for *all* locals */
4059 if (matchtoken(tTERM) == 0)
4061 doexpr(TRUE, FALSE, FALSE, TRUE, &tag, FALSE);
4078 ptr[wqBRK] = (int)declared; /* stack pointer (for "break") */
4079 ptr[wqCONT] = (int)declared; /* for "continue", possibly adjusted later */
4080 ptr[wqLOOP] = getlabel();
4081 ptr[wqEXIT] = getlabel();
4082 if (wqptr >= (wq + wqTABSZ - wqSIZE))
4083 error(102, "loop table"); /* loop table overflow (too many active loops) */
4086 { /* copy "ptr" to while queue table */
4106 error(24); /* out of context */
4111 return (wqptr - wqSIZE);