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