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