?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
modified: SpatialOmicsCoord.py
[GalaxyCodeBases.git] / c_cpp / etc / calc / codegen.c
blob14450f0a1bd7b8d20773363e36b1f70d2533ea69
1 /*
2 * codegen - module to generate opcodes from the input tokens
3 *
4 * Copyright (C) 1999-2007 David I. Bell and Ernest Bowen
5 *
6 * Primary author: David I. Bell
7 *
8 * Calc is open software; you can redistribute it and/or modify it under
9 * the terms of the version 2.1 of the GNU Lesser General Public License
10 * as published by the Free Software Foundation.
11 *
12 * Calc is distributed in the hope that it will be useful, but WITHOUT
13 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
15 * Public License for more details.
16 *
17 * A copy of version 2.1 of the GNU Lesser General Public License is
18 * distributed with calc under the filename COPYING-LGPL. You should have
19 * received a copy with calc; if not, write to Free Software Foundation, Inc.
20 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
21 *
22 * @(#) $Revision: 30.4 $
23 * @(#) $Id: codegen.c,v 30.4 2013/08/11 08:41:38 chongo Exp $
24 * @(#) $Source: /usr/local/src/bin/calc/RCS/codegen.c,v $
25 *
26 * Under source code control: 1990/02/15 01:48:13
27 * File existed as early as: before 1990
28 *
29 * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
30 */
31
32
33 #include <stdio.h>
34 #include "have_unistd.h"
35 #if defined(HAVE_UNISTD_H)
36 #include <unistd.h>
37 #endif
38
39 #include "lib_calc.h"
40 #include "calc.h"
41 #include "token.h"
42 #include "symbol.h"
43 #include "label.h"
44 #include "opcodes.h"
45 #include "str.h"
46 #include "func.h"
47 #include "conf.h"
48
49 #if defined(_WIN32) && !defined(__CYGWIN__)
50 # include <direct.h>
51 #endif
52
53 STATIC BOOL rdonce; /* TRUE => do not reread this file */
54
55 FUNC *curfunc;
56
57 S_FUNC int getsymvalue(char *name, VALUE *v_p);
58 S_FUNC int getfilename(char *name, size_t namelen, BOOL *once);
59 S_FUNC BOOL getid(char *buf);
60 S_FUNC void getshowstatement(void);
61 S_FUNC void getfunction(void);
62 S_FUNC void ungetfunction(void);
63 S_FUNC void getbody(LABEL *contlabel, LABEL *breaklabel,
64 LABEL *nextcaselabel, LABEL *defaultlabel);
65 S_FUNC int getdeclarations(int symtype);
66 S_FUNC int getsimpledeclaration (int symtype);
67 S_FUNC int getonevariable (int symtype);
68 S_FUNC void getstatement(LABEL *contlabel, LABEL *breaklabel,
69 LABEL *nextcaselabel, LABEL *defaultlabel);
70 S_FUNC void getobjdeclaration(int symtype);
71 S_FUNC void getoneobj(long index, int symtype);
72 S_FUNC void getobjvars(char *name, int symtype);
73 S_FUNC void getmatdeclaration(int symtype);
74 S_FUNC void getonematrix(int symtype);
75 S_FUNC void creatematrix(void);
76 S_FUNC void getsimplebody(void);
77 S_FUNC void getcondition(void);
78 S_FUNC void getmatargs(void);
79 S_FUNC void getelement(void);
80 S_FUNC void usesymbol(char *name, int autodef);
81 S_FUNC void definesymbol(char *name, int symtype);
82 S_FUNC void getcallargs(char *name);
83 S_FUNC void do_changedir(void);
84 S_FUNC int getexprlist(void);
85 S_FUNC int getopassignment(void);
86 S_FUNC int getassignment(void);
87 S_FUNC int getaltcond(void);
88 S_FUNC int getorcond(void);
89 S_FUNC int getandcond(void);
90 S_FUNC int getrelation(void);
91 S_FUNC int getsum(void);
92 S_FUNC int getproduct(void);
93 S_FUNC int getorexpr(void);
94 S_FUNC int getandexpr(void);
95 S_FUNC int getshiftexpr(void);
96 S_FUNC int getreference(void);
97 S_FUNC int getincdecexpr(void);
98 S_FUNC int getterm(void);
99 S_FUNC int getidexpr(BOOL okmat, int autodef);
100 S_FUNC long getinitlist(void);
101
102 #define INDICALLOC 8
103
104 STATIC int quickindices[INDICALLOC];
105 STATIC int * newindices;
106 STATIC int * indices;
107 STATIC int maxindices;
108
109
110 /*
111 * Read all the commands from an input file.
112 * These are either declarations, or else are commands to execute now.
113 * In general, commands are terminated by newlines or semicolons.
114 * Exceptions are function definitions and escaped newlines.
115 * Commands are read and executed until the end of file.
116 * The toplevel flag indicates whether we are at the top interactive level.
117 */
118 void
119 getcommands(BOOL toplevel)
120 {
121 char name[MAXCMD+1+1]; /* program name */
122
123 /* firewall */
124 name[0] = '\0';
125 name[MAXCMD+1] = '\0';
126 abort_now = FALSE;
127
128 /* getcommands */
129 if (!toplevel)
130 enterfilescope();
131 for (;;) {
132 int i;
133 (void) tokenmode(TM_NEWLINES);
134 switch (gettoken()) {
135
136 case T_DEFINE:
137 getfunction();
138 break;
139
140 case T_EOF:
141 if (!toplevel)
142 exitfilescope();
143 return;
144
145 case T_HELP:
146 for (i=1;;i++) {
147 switch(getfilename(name, MAXCMD+1, NULL)) {
148 case 1:
149 case -1:
150 if(i == 1) {
151 strcpy(name, DEFAULTCALCHELP);
152 givehelp(name);
153 }
154 break;
155 case 0:
156 givehelp(name);
157 continue;
158 default:
159 break;
160 }
161 break;
162 }
163 break;
164
165 case T_READ:
166 if (!allow_read) {
167 scanerror(T_NULL,
168 "read command disallowed by -m mode\n");
169 break;
170 }
171 for (;;) {
172 int open_ret;
173
174 if (getfilename(name, MAXCMD+1, &rdonce))
175 break;
176 open_ret = opensearchfile(name,calcpath,
177 CALCEXT,rdonce);
178 switch (open_ret) {
179 case 0:
180 getcommands(FALSE);
181 closeinput();
182 continue;
183 case 1:
184 /* prev read and -once was given */
185 continue;
186 case -2:
187 scanerror(T_NULL,
188 "Maximum input depth reached");
189 break;
190 default:
191 scanerror(T_NULL,
192 "Cannot open \"%s\"", name);
193 continue;
194 }
195 break;
196 }
197 break;
198
199 case T_WRITE:
200 if (!allow_write) {
201 scanerror(T_NULL,
202 "write command disallowed by -m mode\n");
203 break;
204 }
205 if (getfilename(name, MAXCMD+1, NULL))
206 break;
207 if (writeglobals(name)) {
208 scanerror(T_NULL,
209 "Error writing \"%s\"\n", name);
210 }
211 break;
212
213 case T_CD:
214 do_changedir();
215 break;
216 case T_NEWLINE:
217 case T_SEMICOLON:
218 break;
219
220 default:
221 rescantoken();
222 initstack();
223 if (evaluate(FALSE))
224 updateoldvalue(curfunc);
225 freefunc(curfunc);
226 if (abort_now) {
227 if (!stdin_tty)
228 run_state = RUN_EXIT;
229 else if (run_state < RUN_PRE_TOP_LEVEL)
230 run_state = RUN_PRE_TOP_LEVEL;
231 if (calc_use_scanerr_jmpbuf != 0) {
232 longjmp(calc_scanerr_jmpbuf, 30);
233 } else {
234 fprintf(stderr,
235 "calc_scanerr_jmpbuf not setup, exiting code 30\n");
236 libcalc_call_me_last();
237 exit(30);
238 }
239 }
240 }
241 }
242 }
243
244
245 /*
246 * Evaluate a line of statements.
247 * This is done by treating the current line as a function body,
248 * compiling it, and then executing it. Returns TRUE if the line
249 * successfully compiled and executed. The last expression result
250 * is saved in the f_savedvalue element of the current function.
251 * The nestflag variable should be FALSE for the outermost evaluation
252 * level, and TRUE for all other calls (such as the 'eval' function).
253 * The function name begins with an asterisk to indicate specialness.
254 *
255 * given:
256 * nestflag TRUE if this is a nested evaluation
257 */
258 BOOL
259 evaluate(BOOL nestflag)
260 {
261 char *funcname;
262 int loop = 1; /* 0 => end the main while loop */
263
264 funcname = (nestflag ? "**" : "*");
265 beginfunc(funcname, nestflag);
266 if (gettoken() == T_LEFTBRACE) {
267 getbody(NULL_LABEL, NULL_LABEL, NULL_LABEL, NULL_LABEL);
268 } else {
269 if (nestflag)
270 (void) tokenmode(TM_DEFAULT);
271 rescantoken();
272 while (loop) {
273 switch (gettoken()) {
274 case T_SEMICOLON:
275 break;
276 case T_NEWLINE:
277 case T_EOF:
278 loop = 0;
279 break;
280
281 default:
282 rescantoken();
283 getstatement(NULL_LABEL, NULL_LABEL,
284 NULL_LABEL, NULL_LABEL);
285 }
286 }
287 }
288 addop(OP_UNDEF);
289 addop(OP_RETURN);
290 checklabels();
291 if (errorcount)
292 return FALSE;
293 calculate(curfunc, 0);
294 return TRUE;
295 }
296
297 /*
298 * Undefine one or more functions
299 */
300 S_FUNC void
301 ungetfunction(void)
302 {
303 char *name;
304 int type;
305
306 for (;;) {
307 switch (gettoken()) {
308 case T_COMMA:
309 continue;
310 case T_SYMBOL:
311 name = tokensymbol();
312 type = getbuiltinfunc(name);
313 if (type >= 0) {
314 warning(
315 "Cannot undefine builtin function \"%s\"", name);
316 continue;
317 }
318 rmuserfunc(name);
319 continue;
320 case T_MULT:
321 rmalluserfunc();
322 continue;
323 case T_STATIC:
324 if (gettoken() != T_SYMBOL) {
325 scanerror(T_SEMICOLON,
326 "Non-identifier following \"undefine static\"");
327 return;
328 }
329 name = tokensymbol();
330 endscope(name, FALSE);
331 continue;
332
333 case T_NEWLINE:
334 case T_SEMICOLON:
335 case T_EOF:
336 rescantoken();
337 return;
338 default:
339 scanerror(T_SEMICOLON, "Non-name arg for undefine");
340 return;
341 }
342 }
343 }
344
345
346 /*
347 * Get a function declaration.
348 * func = name '(' '' | name [ ',' name] ... ')' simplebody
349 * | name '(' '' | name [ ',' name] ... ')' body.
350 */
351 S_FUNC void
352 getfunction(void)
353 {
354 char *name; /* parameter name */
355 int type; /* type of token read */
356 LABEL label;
357 long index;
358
359 (void) tokenmode(TM_DEFAULT);
360 if (gettoken() != T_SYMBOL) {
361 scanerror(T_NULL, "Function name was expected");
362 return;
363 }
364 name = tokensymbol();
365 type = getbuiltinfunc(name);
366 if (type >= 0) {
367 scanerror(T_SEMICOLON, "Using builtin function name");
368 return;
369 }
370 beginfunc(name, FALSE);
371 enterfuncscope();
372 if (gettoken() != T_LEFTPAREN) {
373 scanerror(T_SEMICOLON,
374 "Left parenthesis expected for function");
375 return;
376 }
377 index = 0;
378 for (;;) {
379 type = gettoken();
380 if (type == T_RIGHTPAREN)
381 break;
382 if (type != T_SYMBOL) {
383 scanerror(T_COMMA,
384 "Using non-identifier as function parameter");
385 return;
386 }
387 name = tokensymbol();
388 switch (symboltype(name)) {
389 case SYM_UNDEFINED:
390 case SYM_GLOBAL:
391 case SYM_STATIC:
392 index = addparam(name);
393 break;
394 default:
395 scanerror(T_NULL,
396 "Parameter \"%s\" is already defined",
397 name);
398 }
399 type = gettoken();
400 if (type == T_ASSIGN) {
401 clearlabel(&label);
402 addopone(OP_PARAMADDR, index);
403 addoplabel(OP_JUMPNN, &label);
404 getopassignment();
405 addop(OP_ASSIGNPOP);
406 setlabel(&label);
407 type = gettoken();
408 }
409
410 if (type == T_RIGHTPAREN)
411 break;
412 if (type != T_COMMA) {
413 scanerror(T_COMMA,
414 "Using other than comma to separate parameters");
415 return;
416 }
417 }
418 switch (gettoken()) {
419 case T_ASSIGN:
420 getsimplebody();
421 break;
422 case T_LEFTBRACE:
423 getbody(NULL_LABEL, NULL_LABEL, NULL_LABEL,
424 NULL_LABEL);
425 break;
426 default:
427 scanerror(T_NULL,
428 "Left brace or equals sign expected for function");
429 return;
430 }
431 endfunc();
432 exitfuncscope();
433 }
434
435
436 /*
437 * Get a simple assignment style body for a function declaration.
438 * simplebody = '=' assignment '\n'.
439 */
440 S_FUNC void
441 getsimplebody(void)
442 {
443 (void) tokenmode(TM_NEWLINES);
444 (void) getexprlist();
445 addop(OP_RETURN);
446 }
447
448
449 /*
450 * Get the body of a function, or a subbody of a function.
451 * body = '{' [ declarations ] ... [ statement ] ... '}'
452 * | [ declarations ] ... [statement ] ... '\n'
453 */
454 /*ARGSUSED*/
455 S_FUNC void
456 getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel,
457 LABEL *defaultlabel)
458 {
459 int oldmode;
460
461 oldmode = tokenmode(TM_DEFAULT);
462 while (TRUE) {
463 switch (gettoken()) {
464 case T_RIGHTBRACE:
465 (void) tokenmode(oldmode);
466 return;
467
468 case T_EOF:
469 scanerror(T_NULL, "End-of-file in function body");
470 return;
471
472 default:
473 rescantoken();
474 getstatement(contlabel, breaklabel,
475 nextcaselabel, defaultlabel);
476 }
477 }
478 }
479
480
481 /*
482 * Get a line of possible local, global, or static variable declarations.
483 * declarations = { LOCAL | GLOBAL | STATIC } onedeclaration
484 * [ ',' onedeclaration ] ... ';'.
485 */
486 S_FUNC int
487 getdeclarations(int symtype)
488 {
489 int res = 0;
490
491 while (TRUE) {
492 switch (gettoken()) {
493 case T_COMMA:
494 continue;
495
496 case T_NEWLINE:
497 case T_SEMICOLON:
498 case T_RIGHTBRACE:
499 case T_EOF:
500 rescantoken();
501 return res;
502
503 case T_SYMBOL:
504 addopone(OP_DEBUG, linenumber());
505 rescantoken();
506 if (getsimpledeclaration(symtype))
507 res = 1;
508 break;
509
510 case T_MAT:
511 addopone(OP_DEBUG, linenumber());
512 getmatdeclaration(symtype);
513 res = 1;
514 break;
515
516 case T_OBJ:
517 addopone(OP_DEBUG, linenumber());
518 getobjdeclaration(symtype);
519 addop(OP_POP);
520 res = 1;
521 break;
522
523 default:
524 scanerror(T_SEMICOLON,
525 "Bad syntax in declaration statement");
526 return res;
527 }
528 }
529 }
530
531
532 /*
533 * Get declaration of a sequence of simple identifiers, as in
534 * global a, b = 1, c d = 2, d;
535 * Subsequences end with "," or at end of line; spaces indicate
536 * repeated assignment, e.g. "c d = 2" has the effect of "c = 2, d = 2".
537 */
538 S_FUNC int
539 getsimpledeclaration(int symtype)
540 {
541 int res = 0;
542
543 for (;;) {
544 switch (gettoken()) {
545 case T_SYMBOL:
546 rescantoken();
547 if (getonevariable(symtype)) {
548 res = 1;
549 addop(OP_POP);
550 }
551 continue;
552 case T_COMMA:
553 continue;
554 default:
555 rescantoken();
556 return res;
557 }
558 }
559 }
560
561
562 /*
563 * Get one variable in a sequence of simple identifiers.
564 * Returns 1 if the subsequence in which the variable occurs ends with
565 * an assignment, e.g. for the variables b, c, d, in
566 * S_FUNC a, b = 1, c d = 2, d;
567 */
568 S_FUNC int
569 getonevariable(int symtype)
570 {
571 char *name;
572 int res = 0;
573
574 switch(gettoken()) {
575 case T_SYMBOL:
576 name = addliteral(tokensymbol());
577 res = getonevariable(symtype);
578 definesymbol(name, symtype);
579 if (res) {
580 usesymbol(name, 0);
581 addop(OP_ASSIGNBACK);
582 }
583 return res;
584 case T_ASSIGN:
585 getopassignment();
586 rescantoken();
587 return 1;
588 default:
589 rescantoken();
590 return 0;
591 }
592 }
593
594 /*
595 * Get a statement.
596 * statement = IF condition statement [ELSE statement]
597 * | FOR '(' [assignment] ';' [assignment] ';' [assignment] ')' statement
598 * | WHILE condition statement
599 * | DO statement WHILE condition ';'
600 * | SWITCH condition '{' [caseclause] ... '}'
601 * | CONTINUE ';'
602 * | BREAK ';'
603 * | RETURN assignment ';'
604 * | GOTO label ';'
605 * | PRINT assignment [, assignment ] ... ';'
606 * | QUIT [ string ] ';'
607 * | ABORT [ string ] ';'
608 * | SHOW item ';'
609 * | body
610 * | assignment ';'
611 * | label ':' statement
612 * | ';'.
613 *
614 * given:
615 * contlabel label for continue statement
616 * breaklabel label for break statement
617 * nextcaselabel label for next case statement
618 * defaultlabel label for default case
619 */
620 S_FUNC void
621 getstatement(LABEL *contlabel, LABEL *breaklabel,
622 LABEL *nextcaselabel, LABEL *defaultlabel)
623 {
624 LABEL label;
625 LABEL label1, label2, label3, label4; /* locations for jumps */
626 int type;
627 BOOL printeol;
628 int oldmode;
629
630 addopone(OP_DEBUG, linenumber());
631 switch (gettoken()) {
632 case T_NEWLINE:
633 case T_SEMICOLON:
634 return;
635
636 case T_GLOBAL:
637 (void) getdeclarations(SYM_GLOBAL);
638 break;
639
640 case T_STATIC:
641 clearlabel(&label);
642 addoplabel(OP_INITSTATIC, &label);
643 if (getdeclarations(SYM_STATIC))
644 setlabel(&label);
645 else
646 curfunc->f_opcodecount -= 2;
647 break;
648
649 case T_LOCAL:
650 (void) getdeclarations(SYM_LOCAL);
651 break;
652
653 case T_UNDEFINE:
654 ungetfunction();
655 break;
656
657 case T_RIGHTBRACE:
658 scanerror(T_NULL, "Extraneous right brace");
659 return;
660
661 case T_CONTINUE:
662 if (contlabel == NULL_LABEL) {
663 scanerror(T_SEMICOLON,
664 "CONTINUE not within FOR, WHILE, or DO");
665 return;
666 }
667 addoplabel(OP_JUMP, contlabel);
668 break;
669
670 case T_BREAK:
671 if (breaklabel == NULL_LABEL) {
672 scanerror(T_SEMICOLON,
673 "BREAK not within FOR, WHILE, or DO");
674 return;
675 }
676 addoplabel(OP_JUMP, breaklabel);
677 break;
678
679 case T_GOTO:
680 if (gettoken() != T_SYMBOL) {
681 scanerror(T_SEMICOLON, "Missing label in goto");
682 return;
683 }
684 addop(OP_JUMP);
685 addlabel(tokensymbol());
686 break;
687
688 case T_RETURN:
689 switch (gettoken()) {
690 case T_NEWLINE:
691 case T_SEMICOLON:
692 addop(OP_UNDEF);
693 addop(OP_RETURN);
694 return;
695 default:
696 rescantoken();
697 (void) getexprlist();
698 if (curfunc->f_name[0] == '*')
699 addop(OP_SAVE);
700 addop(OP_RETURN);
701 }
702 break;
703
704 case T_LEFTBRACE:
705 getbody(contlabel, breaklabel, nextcaselabel, defaultlabel);
706 return;
707
708 case T_IF:
709 clearlabel(&label1);
710 clearlabel(&label2);
711 getcondition();
712 switch(gettoken()) {
713 case T_CONTINUE:
714 if (contlabel == NULL_LABEL) {
715 scanerror(T_SEMICOLON,
716 "CONTINUE not within FOR, "
717 "WHILE, or DO");
718 return;
719 }
720 addoplabel(OP_JUMPNZ, contlabel);
721 break;
722 case T_BREAK:
723 if (breaklabel == NULL_LABEL) {
724 scanerror(T_SEMICOLON,
725 "BREAK not within FOR, "
726 "WHILE, or DO");
727 return;
728 }
729 addoplabel(OP_JUMPNZ, breaklabel);
730 break;
731 case T_GOTO:
732 if (gettoken() != T_SYMBOL) {
733 scanerror(T_SEMICOLON,
734 "Missing label in goto");
735 return;
736 }
737 addop(OP_JUMPNZ);
738 addlabel(tokensymbol());
739 break;
740 default:
741 addoplabel(OP_JUMPZ, &label1);
742 rescantoken();
743 getstatement(contlabel, breaklabel,
744 NULL_LABEL, NULL_LABEL);
745 if (gettoken() != T_ELSE) {
746 setlabel(&label1);
747 rescantoken();
748 return;
749 }
750 addoplabel(OP_JUMP, &label2);
751 setlabel(&label1);
752 getstatement(contlabel, breaklabel,
753 NULL_LABEL, NULL_LABEL);
754 setlabel(&label2);
755 return;
756 }
757 if (gettoken() != T_SEMICOLON) /* This makes ';' optional */
758 rescantoken();
759 if (gettoken() != T_ELSE) {
760 rescantoken();
761 return;
762 }
763 getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
764 return;
765
766 case T_FOR: /* for (a; b; c) x */
767 oldmode = tokenmode(TM_DEFAULT);
768 clearlabel(&label1);
769 clearlabel(&label2);
770 clearlabel(&label3);
771 clearlabel(&label4);
772 contlabel = NULL_LABEL;
773 breaklabel = &label4;
774 if (gettoken() != T_LEFTPAREN) {
775 (void) tokenmode(oldmode);
776 scanerror(T_SEMICOLON, "Left parenthesis expected");
777 return;
778 }
779 if (gettoken() != T_SEMICOLON) { /* have 'a' part */
780 rescantoken();
781 (void) getexprlist();
782 addop(OP_POP);
783 if (gettoken() != T_SEMICOLON) {
784 (void) tokenmode(oldmode);
785 scanerror(T_SEMICOLON, "Missing semicolon");
786 return;
787 }
788 }
789 if (gettoken() != T_SEMICOLON) { /* have 'b' part */
790 setlabel(&label1);
791 contlabel = &label1;
792 rescantoken();
793 (void) getexprlist();
794 addoplabel(OP_JUMPNZ, &label3);
795 addoplabel(OP_JUMP, breaklabel);
796 if (gettoken() != T_SEMICOLON) {
797 (void) tokenmode(oldmode);
798 scanerror(T_SEMICOLON, "Missing semicolon");
799 return;
800 }
801 }
802 if (gettoken() != T_RIGHTPAREN) { /* have 'c' part */
803 if (label1.l_offset < 0)
804 addoplabel(OP_JUMP, &label3);
805 setlabel(&label2);
806 contlabel = &label2;
807 rescantoken();
808 (void) getexprlist();
809 addop(OP_POP);
810 if (label1.l_offset >= 0)
811 addoplabel(OP_JUMP, &label1);
812 if (gettoken() != T_RIGHTPAREN) {
813 (void) tokenmode(oldmode);
814 scanerror(T_SEMICOLON,
815 "Right parenthesis expected");
816 return;
817 }
818 }
819 setlabel(&label3);
820 if (contlabel == NULL_LABEL)
821 contlabel = &label3;
822 (void) tokenmode(oldmode);
823 getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
824 addoplabel(OP_JUMP, contlabel);
825 setlabel(breaklabel);
826 return;
827
828 case T_WHILE:
829 oldmode = tokenmode(TM_DEFAULT);
830 contlabel = &label1;
831 clearlabel(contlabel);
832 setlabel(contlabel);
833 getcondition();
834 (void) tokenmode(oldmode);
835 if (gettoken() != T_SEMICOLON) {
836 breaklabel = &label2;
837 clearlabel(breaklabel);
838 addoplabel(OP_JUMPZ, breaklabel);
839 rescantoken();
840 getstatement(contlabel, breaklabel,
841 NULL_LABEL, NULL_LABEL);
842 addoplabel(OP_JUMP, contlabel);
843 setlabel(breaklabel);
844 } else {
845 addoplabel(OP_JUMPNZ, contlabel);
846 }
847 return;
848
849 case T_DO:
850 oldmode = tokenmode(TM_DEFAULT);
851 contlabel = &label1;
852 breaklabel = &label2;
853 clearlabel(contlabel);
854 clearlabel(breaklabel);
855 clearlabel(&label3);
856 setlabel(&label3);
857 getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
858 if (gettoken() != T_WHILE) {
859 (void) tokenmode(oldmode);
860 scanerror(T_SEMICOLON,
861 "WHILE keyword expected for DO statement");
862 return;
863 }
864 setlabel(contlabel);
865 getcondition();
866 addoplabel(OP_JUMPNZ, &label3);
867 setlabel(breaklabel);
868 (void) tokenmode(oldmode);
869 return;
870
871 case T_SWITCH:
872 oldmode = tokenmode(TM_DEFAULT);
873 breaklabel = &label1;
874 nextcaselabel = &label2;
875 defaultlabel = &label3;
876 clearlabel(breaklabel);
877 clearlabel(nextcaselabel);
878 clearlabel(defaultlabel);
879 getcondition();
880 if (gettoken() != T_LEFTBRACE) {
881 (void) tokenmode(oldmode);
882 scanerror(T_SEMICOLON,
883 "Missing left brace for switch statement");
884 return;
885 }
886 addoplabel(OP_JUMP, nextcaselabel);
887 rescantoken();
888 getstatement(contlabel, breaklabel,
889 nextcaselabel, defaultlabel);
890 addoplabel(OP_JUMP, breaklabel);
891 setlabel(nextcaselabel);
892 if (defaultlabel->l_offset > 0)
893 addoplabel(OP_JUMP, defaultlabel);
894 else
895 addop(OP_POP);
896 setlabel(breaklabel);
897 (void) tokenmode(oldmode);
898 return;
899
900 case T_CASE:
901 if (nextcaselabel == NULL_LABEL) {
902 scanerror(T_SEMICOLON,
903 "CASE not within SWITCH statement");
904 return;
905 }
906 clearlabel(&label1);
907 addoplabel(OP_JUMP, &label1);
908 setlabel(nextcaselabel);
909 clearlabel(nextcaselabel);
910 (void) getexprlist();
911 if (gettoken() != T_COLON) {
912 scanerror(T_SEMICOLON,
913 "Colon expected after CASE expression");
914 return;
915 }
916 addoplabel(OP_CASEJUMP, nextcaselabel);
917 setlabel(&label1);
918 getstatement(contlabel, breaklabel,
919 nextcaselabel, defaultlabel);
920 return;
921
922 case T_DEFAULT:
923 if (gettoken() != T_COLON) {
924 scanerror(T_SEMICOLON,
925 "Colon expected after DEFAULT keyword");
926 return;
927 }
928 if (defaultlabel == NULL_LABEL) {
929 scanerror(T_SEMICOLON,
930 "DEFAULT not within SWITCH statement");
931 return;
932 }
933 if (defaultlabel->l_offset > 0) {
934 scanerror(T_SEMICOLON,
935 "Multiple DEFAULT clauses in SWITCH");
936 return;
937 }
938 clearlabel(&label1);
939 addoplabel(OP_JUMP, &label1);
940 setlabel(defaultlabel);
941 addop(OP_POP);
942 setlabel(&label1);
943 getstatement(contlabel, breaklabel,
944 nextcaselabel, defaultlabel);
945 return;
946
947 case T_ELSE:
948 scanerror(T_SEMICOLON, "ELSE without preceding IF");
949 return;
950
951 case T_SHOW:
952 getshowstatement();
953 break;
954
955 case T_PRINT:
956 printeol = TRUE;
957 for (;;) {
958 switch (gettoken()) {
959 case T_RIGHTPAREN:
960 case T_RIGHTBRACKET:
961 case T_RIGHTBRACE:
962 case T_NEWLINE:
963 case T_ELSE:
964 case T_EOF:
965 rescantoken();
966 /*FALLTHRU*/
967 case T_SEMICOLON:
968 if (printeol)
969 addop(OP_PRINTEOL);
970 return;
971 case T_COMMA:
972 addop(OP_PRINTSPACE);
973 /*FALLTHRU*/
974 case T_COLON:
975 printeol = FALSE;
976 break;
977 case T_STRING:
978 printeol = TRUE;
979 addopone(OP_PRINTSTRING, tokenstring());
980 break;
981 default:
982 printeol = TRUE;
983 rescantoken();
984 (void) getopassignment();
985 addopone(OP_PRINT, (long) PRINT_NORMAL);
986 }
987 }
988
989 case T_QUIT:
990 switch (gettoken()) {
991 case T_STRING:
992 addopone(OP_QUIT, tokenstring());
993 break;
994 default:
995 addopone(OP_QUIT, -1);
996 rescantoken();
997 }
998 break;
999
1000 case T_ABORT:
1001 switch (gettoken()) {
1002 case T_STRING:
1003 addopone(OP_ABORT, tokenstring());
1004 break;
1005 default:
1006 addopone(OP_ABORT, -1);
1007 rescantoken();
1008 }
1009 break;
1010
1011 case T_SYMBOL:
1012 if (nextchar() == ':') { /****HACK HACK****/
1013 definelabel(tokensymbol());
1014 if (gettoken() == T_RIGHTBRACE) {
1015 rescantoken();
1016 return;
1017 }
1018 rescantoken();
1019 getstatement(contlabel, breaklabel,
1020 NULL_LABEL, NULL_LABEL);
1021 return;
1022 }
1023 reread();
1024 /* fall into default case */
1025
1026 default:
1027 rescantoken();
1028 type = getexprlist();
1029 if (contlabel || breaklabel || (curfunc->f_name[0] != '*')) {
1030 addop(OP_POP);
1031 break;
1032 }
1033 addop(OP_SAVE);
1034 if (isassign(type) || (curfunc->f_name[1] != '\0')) {
1035 addop(OP_POP);
1036 break;
1037 }
1038 addop(OP_PRINTRESULT);
1039 break;
1040 }
1041 for (;;) {
1042 switch (gettoken()) {
1043 case T_RIGHTBRACE:
1044 case T_NEWLINE:
1045 case T_EOF:
1046 case T_ELSE:
1047 rescantoken();
1048 return;
1049 case T_SEMICOLON:
1050 return;
1051 case T_NUMBER:
1052 case T_IMAGINARY:
1053 addopone(OP_NUMBER, tokennumber());
1054 scanerror(T_NULL, "Unexpected number");
1055 continue;
1056 default:
1057 scanerror(T_NULL, "Semicolon expected");
1058 return;
1059 }
1060 }
1061 }
1062
1063
1064 /*
1065 * Read in an object declaration.
1066 * This is of the following form:
1067 * OBJ type [ '{' id [ ',' id ] ... '}' ] [ objlist ].
1068 * The OBJ keyword has already been read. Symtype is SYM_UNDEFINED if this
1069 * is an OBJ statement, otherwise this is part of a declaration which will
1070 * define new symbols with the specified type.
1071 */
1072 S_FUNC void
1073 getobjdeclaration(int symtype)
1074 {
1075 char *name; /* name of object type */
1076 int count; /* number of elements */
1077 int index; /* current index */
1078 int i; /* loop counter */
1079 int oldmode;
1080
1081 if (gettoken() != T_SYMBOL) {
1082 scanerror(T_SEMICOLON, "Object type name missing");
1083 return;
1084 }
1085 name = addliteral(tokensymbol());
1086 if (gettoken() != T_LEFTBRACE) {
1087 rescantoken();
1088 getobjvars(name, symtype);
1089 return;
1090 }
1091 /*
1092 * Read in the definition of the elements of the object.
1093 */
1094 count = 0;
1095 indices = quickindices;
1096 maxindices = INDICALLOC;
1097
1098 oldmode = tokenmode(TM_DEFAULT);
1099
1100 for (;;) {
1101 switch (gettoken()) {
1102 case T_SYMBOL:
1103 if (count == maxindices) {
1104 if (maxindices == INDICALLOC) {
1105 maxindices += INDICALLOC;
1106 newindices = (int *) malloc(maxindices *
1107 sizeof(int));
1108 if (newindices == NULL) {
1109 scanerror(T_SEMICOLON,
1110 "Out of memory for indices malloc");
1111 (void) tokenmode(oldmode);
1112 return;
1113 }
1114 memcpy(newindices, quickindices,
1115 INDICALLOC * sizeof(int));
1116 indices = newindices;
1117 } else {
1118 maxindices += INDICALLOC;
1119 newindices = (int *) realloc(indices,
1120 maxindices * sizeof(int));
1121 if (newindices == NULL) {
1122 free(indices);
1123 scanerror(T_SEMICOLON,
1124 "Out of memory for indices realloc");
1125 (void) tokenmode(oldmode);
1126 return;
1127 }
1128 indices = newindices;
1129 }
1130 }
1131 index = addelement(tokensymbol());
1132 for (i = 0; i < count; i++) {
1133 if (indices[i] == index) {
1134 if (indices != quickindices)
1135 free(indices);
1136 scanerror(T_SEMICOLON,
1137 "Duplicate element name \"%s\"",
1138 tokensymbol());
1139 (void) tokenmode(oldmode);
1140 return;
1141 }
1142 }
1143 indices[count++] = index;
1144 if (gettoken() == T_COMMA)
1145 continue;
1146 rescantoken();
1147 if (gettoken() != T_RIGHTBRACE) {
1148 if (indices != quickindices)
1149 free(indices);
1150 scanerror(T_SEMICOLON,
1151 "Bad object type definition");
1152 (void) tokenmode(oldmode);
1153 return;
1154 }
1155 /*FALLTHRU*/
1156 case T_RIGHTBRACE:
1157 (void) tokenmode(oldmode);
1158 if (defineobject(name, indices, count)) {
1159 if (indices != quickindices)
1160 free(indices);
1161 scanerror(T_NULL,
1162 "Object type \"%s\" is already defined", name);
1163 return;
1164 }
1165 if (indices != quickindices)
1166 free(indices);
1167 getobjvars(name, symtype);
1168 return;
1169 case T_NEWLINE:
1170 continue;
1171 default:
1172 if (indices != quickindices)
1173 free(indices);
1174 scanerror(T_SEMICOLON, "Bad object type definition");
1175 (void) tokenmode(oldmode);
1176 return;
1177
1178 }
1179 }
1180 }
1181
1182
1183 S_FUNC void
1184 getoneobj(long index, int symtype)
1185 {
1186 char *symname;
1187
1188 if (gettoken() == T_SYMBOL) {
1189 if (symtype == SYM_UNDEFINED) {
1190 rescantoken();
1191 (void) getidexpr(TRUE, 1);
1192 } else {
1193 symname = tokensymbol();
1194 definesymbol(symname, symtype);
1195 usesymbol(symname, 0);
1196 }
1197 getoneobj(index, symtype);
1198 addop(OP_ASSIGN);
1199 return;
1200 }
1201 rescantoken();
1202 addopone(OP_OBJCREATE, index);
1203 while (gettoken() == T_ASSIGN)
1204 (void) getinitlist();
1205 rescantoken();
1206 }
1207
1208 /*
1209 * Routine to assign a specified object-type value to each of a set of
1210 * variables in a "global", "local" or "S_FUNC" declaration, or, if
1211 * symtype is SYM_UNDEFINED, to create one object value of the specified
1212 * type.
1213 *
1214 * given:
1215 * name object name
1216 * symtype declaration type
1217 */
1218 S_FUNC void
1219 getobjvars(char *name, int symtype)
1220 {
1221 long index; /* index for object */
1222
1223 index = checkobject(name);
1224 if (index < 0) {
1225 scanerror(T_SEMICOLON,
1226 "Object %s has not been defined yet", name);
1227 return;
1228 }
1229 for (;;) {
1230 getoneobj(index, symtype);
1231 if (symtype == SYM_UNDEFINED)
1232 return;
1233 if (gettoken() != T_COMMA) {
1234 rescantoken();
1235 return;
1236 }
1237 addop(OP_POP);
1238 }
1239 }
1240
1241
1242 S_FUNC void
1243 getmatdeclaration(int symtype)
1244 {
1245 for (;;) {
1246 switch (gettoken()) {
1247 case T_SYMBOL:
1248 rescantoken();
1249 getonematrix(symtype);
1250 addop(OP_POP);
1251 continue;
1252 case T_COMMA:
1253 continue;
1254 default:
1255 rescantoken();
1256 return;
1257 }
1258 }
1259 }
1260
1261
1262 S_FUNC void
1263 getonematrix(int symtype)
1264 {
1265 long dim;
1266 long index;
1267 long count;
1268 unsigned long patchpc;
1269 char *name;
1270
1271 if (gettoken() == T_SYMBOL) {
1272 if (symtype == SYM_UNDEFINED) {
1273 rescantoken();
1274 (void) getidexpr(FALSE, 1);
1275 } else {
1276 name = tokensymbol();
1277 definesymbol(name, symtype);
1278 usesymbol(name, 0);
1279 }
1280 while (gettoken() == T_COMMA);
1281 rescantoken();
1282 getonematrix(symtype);
1283 addop(OP_ASSIGN);
1284 return;
1285 }
1286 rescantoken();
1287
1288 if (gettoken() == T_LEFTPAREN) {
1289 if (isrvalue(getexprlist())) {
1290 scanerror(T_SEMICOLON, "Lvalue expected");
1291 return;
1292 }
1293 if (gettoken() != T_RIGHTPAREN) {
1294 scanerror(T_SEMICOLON, "Missing right parenthesis");
1295 return;
1296 }
1297 getonematrix(symtype);
1298 addop(OP_ASSIGN);
1299 return;
1300 }
1301 rescantoken();
1302
1303 if (gettoken() != T_LEFTBRACKET) {
1304 rescantoken();
1305 scanerror(T_SEMICOLON, "Left-bracket expected");
1306 return;
1307 }
1308 dim = 1;
1309
1310 /*
1311 * If there are no bounds given for the matrix, then they must be
1312 * implicitly defined by a list of initialization values. Put in
1313 * a dummy number in the opcode stream for the bounds and remember
1314 * its location. After we know how many values are in the list, we
1315 * will patch the correct value back into the opcode.
1316 */
1317 if (gettoken() == T_RIGHTBRACKET) {
1318 if (gettoken() == T_ASSIGN) {
1319 clearopt();
1320 patchpc = curfunc->f_opcodecount + 1;
1321 addopone(OP_NUMBER, (long) -1);
1322 clearopt();
1323 addop(OP_ZERO);
1324 addopone(OP_MATCREATE, dim);
1325 addop(OP_ZERO);
1326 addop(OP_INITFILL);
1327 count = 0;
1328 count = getinitlist();
1329 index = addqconstant(itoq(count));
1330 if (index < 0)
1331 math_error("Cannot allocate constant");
1332 curfunc->f_opcodes[patchpc] = index;
1333 return;
1334 }
1335 rescantoken();
1336 addopone(OP_MATCREATE, 0);
1337 if (gettoken() == T_LEFTBRACKET) {
1338 creatematrix();
1339 } else {
1340 rescantoken();
1341 addop(OP_ZERO);
1342 }
1343 addop(OP_INITFILL);
1344 return;
1345 }
1346
1347 /*
1348 * This isn't implicit, so we expect expressions for the bounds.
1349 */
1350 rescantoken();
1351 creatematrix();
1352 while (gettoken() == T_ASSIGN)
1353 (void) getinitlist();
1354 rescantoken();
1355 }
1356
1357
1358 S_FUNC void
1359 creatematrix(void)
1360 {
1361 long dim;
1362
1363 dim = 0;
1364
1365 for (;;) {
1366 if (gettoken() == T_RIGHTBRACKET) {
1367 addopone(OP_MATCREATE, dim);
1368 if (gettoken() == T_LEFTBRACKET) {
1369 creatematrix();
1370 } else {
1371 rescantoken();
1372 addop(OP_ZERO);
1373 }
1374 addop(OP_INITFILL);
1375 return;
1376 }
1377 rescantoken();
1378 if (++dim > MAXDIM) {
1379 scanerror(T_SEMICOLON,
1380 "Only %d dimensions allowed", MAXDIM);
1381 return;
1382 }
1383 (void) getopassignment();
1384 switch (gettoken()) {
1385 case T_RIGHTBRACKET:
1386 rescantoken();
1387 case T_COMMA:
1388 addop(OP_ONE);
1389 addop(OP_SUB);
1390 addop(OP_ZERO);
1391 break;
1392 case T_COLON:
1393 (void) getopassignment();
1394 switch(gettoken()) {
1395 case T_RIGHTBRACKET:
1396 rescantoken();
1397 case T_COMMA:
1398 continue;
1399 }
1400 /*FALLTHRU*/
1401 default:
1402 rescantoken();
1403 scanerror(T_SEMICOLON,
1404 "Illegal matrix definition");
1405 return;
1406 }
1407 }
1408 }
1409
1410
1411 /*
1412 * Get an optional initialization list for a matrix or object definition.
1413 * Returns the number of elements that are in the list, or -1 on parse error.
1414 * initlist = { assignment [ , assignment ] ... }.
1415 */
1416 S_FUNC long
1417 getinitlist(void)
1418 {
1419 long index;
1420 int oldmode;
1421
1422 oldmode = tokenmode(TM_DEFAULT);
1423
1424 if (gettoken() != T_LEFTBRACE) {
1425 scanerror(T_SEMICOLON,
1426 "Missing left brace for initialization list");
1427 (void) tokenmode(oldmode);
1428 return -1;
1429 }
1430
1431 for (index = 0; ; index++) {
1432 switch(gettoken()) {
1433 case T_COMMA:
1434 case T_NEWLINE:
1435 continue;
1436 case T_RIGHTBRACE:
1437 (void) tokenmode(oldmode);
1438 return index;
1439 case T_LEFTBRACE:
1440 rescantoken();
1441 addop(OP_DUPLICATE);
1442 addopone(OP_ELEMADDR, index);
1443 (void) getinitlist();
1444 break;
1445 default:
1446 rescantoken();
1447 getopassignment();
1448 }
1449 addopone(OP_ELEMINIT, index);
1450 switch (gettoken()) {
1451 case T_COMMA:
1452 case T_NEWLINE:
1453 continue;
1454
1455 case T_RIGHTBRACE:
1456 (void) tokenmode(oldmode);
1457 return index;
1458
1459 default:
1460 scanerror(T_SEMICOLON,
1461 "Missing right brace for initialization list");
1462 (void) tokenmode(oldmode);
1463 return -1;
1464 }
1465 }
1466 }
1467
1468
1469 /*
1470 * Get a condition.
1471 * condition = '(' assignment ')'.
1472 */
1473 S_FUNC void
1474 getcondition(void)
1475 {
1476 if (gettoken() != T_LEFTPAREN) {
1477 scanerror(T_SEMICOLON,
1478 "Missing left parenthesis for condition");
1479 return;
1480 }
1481 (void) getexprlist();
1482 if (gettoken() != T_RIGHTPAREN) {
1483 scanerror(T_SEMICOLON,
1484 "Missing right parenthesis for condition");
1485 return;
1486 }
1487 }
1488
1489
1490 /*
1491 * Get an expression list consisting of one or more expressions,
1492 * separated by commas. The value of the list is that of the final expression.
1493 * This is the top level routine for parsing expressions.
1494 * Returns flags describing the type of the last assignment or expression found.
1495 * exprlist = assignment [ ',' assignment ] ...
1496 */
1497 S_FUNC int
1498 getexprlist(void)
1499 {
1500 int type;
1501
1502 type = getopassignment();
1503 while (gettoken() == T_COMMA) {
1504 addop(OP_POP);
1505 type = getopassignment();
1506 }
1507 rescantoken();
1508 return type;
1509 }
1510
1511
1512 /*
1513 * Get an opassignment or possibly just an assignment or expression.
1514 * Returns flags describing the type of assignment or expression found.
1515 * assignment = lvalue '=' assignment
1516 * | lvalue '+=' assignment
1517 * | lvalue '-=' assignment
1518 * | lvalue '*=' assignment
1519 * | lvalue '/=' assignment
1520 * | lvalue '%=' assignment
1521 * | lvalue '//=' assignment
1522 * | lvalue '&=' assignment
1523 * | lvalue '|=' assignment
1524 * | lvalue '<<=' assignment
1525 * | lvalue '>>=' assignment
1526 * | lvalue '^=' assignment
1527 * | lvalue '**=' assignment
1528 * | orcond.
1529 */
1530 S_FUNC int
1531 getopassignment(void)
1532 {
1533 int type; /* type of expression */
1534 long op; /* opcode to generate */
1535
1536 type = getassignment();
1537 switch (gettoken()) {
1538 case T_PLUSEQUALS: op = OP_ADD; break;
1539 case T_MINUSEQUALS: op = OP_SUB; break;
1540 case T_MULTEQUALS: op = OP_MUL; break;
1541 case T_DIVEQUALS: op = OP_DIV; break;
1542 case T_SLASHSLASHEQUALS: op = OP_QUO; break;
1543 case T_MODEQUALS: op = OP_MOD; break;
1544 case T_ANDEQUALS: op = OP_AND; break;
1545 case T_OREQUALS: op = OP_OR; break;
1546 case T_LSHIFTEQUALS: op = OP_LEFTSHIFT; break;
1547 case T_RSHIFTEQUALS: op = OP_RIGHTSHIFT; break;
1548 case T_POWEREQUALS: op = OP_POWER; break;
1549 case T_HASHEQUALS: op = OP_HASHOP; break;
1550 case T_TILDEEQUALS: op = OP_XOR; break;
1551 case T_BACKSLASHEQUALS: op = OP_SETMINUS; break;
1552
1553 default:
1554 rescantoken();
1555 return type;
1556 }
1557 if (isrvalue(type)) {
1558 scanerror(T_NULL, "Illegal assignment");
1559 (void) getopassignment();
1560 return (EXPR_RVALUE | EXPR_ASSIGN);
1561 }
1562 writeindexop();
1563 for(;;) {
1564 addop(OP_DUPLICATE);
1565 if (gettoken() == T_LEFTBRACE) {
1566 rescantoken();
1567 addop(OP_DUPVALUE);
1568 getinitlist();
1569 while (gettoken() == T_ASSIGN)
1570 getinitlist();
1571 rescantoken();
1572 } else {
1573 rescantoken();
1574 (void) getassignment();
1575 }
1576 addop(op);
1577 addop(OP_ASSIGN);
1578 switch (gettoken()) {
1579 case T_PLUSEQUALS: op = OP_ADD; break;
1580 case T_MINUSEQUALS: op = OP_SUB; break;
1581 case T_MULTEQUALS: op = OP_MUL; break;
1582 case T_DIVEQUALS: op = OP_DIV; break;
1583 case T_SLASHSLASHEQUALS: op = OP_QUO; break;
1584 case T_MODEQUALS: op = OP_MOD; break;
1585 case T_ANDEQUALS: op = OP_AND; break;
1586 case T_OREQUALS: op = OP_OR; break;
1587 case T_LSHIFTEQUALS: op = OP_LEFTSHIFT; break;
1588 case T_RSHIFTEQUALS: op = OP_RIGHTSHIFT; break;
1589 case T_POWEREQUALS: op = OP_POWER; break;
1590 case T_HASHEQUALS: op = OP_HASHOP; break;
1591 case T_TILDEEQUALS: op = OP_XOR; break;
1592 case T_BACKSLASHEQUALS: op = OP_SETMINUS; break;
1593
1594 default:
1595 rescantoken();
1596 return EXPR_ASSIGN;
1597 }
1598 }
1599 }
1600
1601
1602 /*
1603 * Get an assignment (lvalue = ...) or possibly just an expression
1604 */
1605
1606 S_FUNC int
1607 getassignment (void)
1608 {
1609 int type; /* type of expression */
1610
1611 switch(gettoken()) {
1612 case T_COMMA:
1613 case T_SEMICOLON:
1614 case T_NEWLINE:
1615 case T_RIGHTPAREN:
1616 case T_RIGHTBRACKET:
1617 case T_RIGHTBRACE:
1618 case T_EOF:
1619 addop(OP_UNDEF);
1620 rescantoken();
1621 return EXPR_RVALUE;
1622 }
1623
1624 rescantoken();
1625
1626 type = getaltcond();
1627
1628 switch (gettoken()) {
1629 case T_NUMBER:
1630 case T_IMAGINARY:
1631 addopone(OP_NUMBER, tokennumber());
1632 type = (EXPR_RVALUE | EXPR_CONST);
1633 /*FALLTHRU*/
1634 case T_STRING:
1635 case T_SYMBOL:
1636 case T_OLDVALUE:
1637 case T_LEFTPAREN:
1638 case T_PLUSPLUS:
1639 case T_MINUSMINUS:
1640 case T_NOT:
1641 scanerror(T_NULL, "Missing operator");
1642 return type;
1643 case T_ASSIGN:
1644 break;
1645
1646 default:
1647 rescantoken();
1648 return type;
1649 }
1650 if (isrvalue(type)) {
1651 scanerror(T_SEMICOLON, "Illegal assignment");
1652 (void) getassignment();
1653 return (EXPR_RVALUE | EXPR_ASSIGN);
1654 }
1655 writeindexop();
1656 if (gettoken() == T_LEFTBRACE) {
1657 rescantoken();
1658 getinitlist();
1659 while (gettoken() == T_ASSIGN)
1660 getinitlist();
1661 rescantoken();
1662 return EXPR_ASSIGN;
1663 }
1664 rescantoken();
1665 (void) getassignment();
1666 addop(OP_ASSIGN);
1667 return EXPR_ASSIGN;
1668 }
1669
1670
1671 /*
1672 * Get a possible conditional result expression (question mark).
1673 * Flags are returned indicating the type of expression found.
1674 * altcond = orcond [ '?' orcond ':' altcond ].
1675 */
1676 S_FUNC int
1677 getaltcond(void)
1678 {
1679 int type; /* type of expression */
1680 LABEL donelab; /* label for done */
1681 LABEL altlab; /* label for alternate expression */
1682
1683 type = getorcond();
1684 if (gettoken() != T_QUESTIONMARK) {
1685 rescantoken();
1686 return type;
1687 }
1688 clearlabel(&donelab);
1689 clearlabel(&altlab);
1690 addoplabel(OP_JUMPZ, &altlab);
1691 type = getaltcond();
1692 if (gettoken() != T_COLON) {
1693 scanerror(T_SEMICOLON,
1694 "Missing colon for conditional expression");
1695 return EXPR_RVALUE;
1696 }
1697 addoplabel(OP_JUMP, &donelab);
1698 setlabel(&altlab);
1699 type |= getaltcond();
1700 setlabel(&donelab);
1701 return type;
1702 }
1703
1704
1705 /*
1706 * Get a possible conditional or expression.
1707 * Flags are returned indicating the type of expression found.
1708 * orcond = andcond [ '||' andcond ] ...
1709 */
1710 S_FUNC int
1711 getorcond(void)
1712 {
1713 int type; /* type of expression */
1714 LABEL donelab; /* label for done */
1715
1716 clearlabel(&donelab);
1717 type = getandcond();
1718 while (gettoken() == T_OROR) {
1719 addoplabel(OP_CONDORJUMP, &donelab);
1720 type |= getandcond();
1721 }
1722 rescantoken();
1723 if (donelab.l_chain >= 0)
1724 setlabel(&donelab);
1725 return type;
1726 }
1727
1728
1729 /*
1730 * Get a possible conditional and expression.
1731 * Flags are returned indicating the type of expression found.
1732 * andcond = relation [ '&&' relation ] ...
1733 */
1734 S_FUNC int
1735 getandcond(void)
1736 {
1737 int type; /* type of expression */
1738 LABEL donelab; /* label for done */
1739
1740 clearlabel(&donelab);
1741 type = getrelation();
1742 while (gettoken() == T_ANDAND) {
1743 addoplabel(OP_CONDANDJUMP, &donelab);
1744 type |= getrelation();
1745 }
1746 rescantoken();
1747 if (donelab.l_chain >= 0)
1748 setlabel(&donelab);
1749 return type;
1750 }
1751
1752
1753 /*
1754 * Get a possible relation (equality or inequality), or just an expression.
1755 * Flags are returned indicating the type of relation found.
1756 * relation = sum '==' sum
1757 * | sum '!=' sum
1758 * | sum '<=' sum
1759 * | sum '>=' sum
1760 * | sum '<' sum
1761 * | sum '>' sum
1762 * | sum.
1763 */
1764 S_FUNC int
1765 getrelation(void)
1766 {
1767 int type; /* type of expression */
1768 long op; /* opcode to generate */
1769
1770 type = getsum();
1771 switch (gettoken()) {
1772 case T_EQ: op = OP_EQ; break;
1773 case T_NE: op = OP_NE; break;
1774 case T_LT: op = OP_LT; break;
1775 case T_GT: op = OP_GT; break;
1776 case T_LE: op = OP_LE; break;
1777 case T_GE: op = OP_GE; break;
1778 default:
1779 rescantoken();
1780 return type;
1781 }
1782 if (islvalue(type))
1783 addop(OP_GETVALUE);
1784 (void) getsum();
1785 addop(op);
1786 return EXPR_RVALUE;
1787 }
1788
1789
1790 /*
1791 * Get an expression made up of sums of products.
1792 * Flags indicating the type of expression found are returned.
1793 * sum = product [ {'+' | '-'} product ] ...
1794 */
1795 S_FUNC int
1796 getsum(void)
1797 {
1798 int type; /* type of expression found */
1799 long op; /* opcode to generate */
1800
1801 type = EXPR_RVALUE;
1802 switch(gettoken()) {
1803 case T_PLUS:
1804 (void) getproduct();
1805 addop(OP_PLUS);
1806 break;
1807 case T_MINUS:
1808 (void) getproduct();
1809 addop(OP_NEGATE);
1810 break;
1811 default:
1812 rescantoken();
1813 type = getproduct();
1814 }
1815 for (;;) {
1816 switch (gettoken()) {
1817 case T_PLUS: op = OP_ADD; break;
1818 case T_MINUS: op = OP_SUB; break;
1819 case T_HASH: op = OP_HASHOP; break;
1820 default:
1821 rescantoken();
1822 return type;
1823 }
1824 if (islvalue(type))
1825 addop(OP_GETVALUE);
1826 (void) getproduct();
1827 addop(op);
1828 type = EXPR_RVALUE;
1829 }
1830 }
1831
1832
1833 /*
1834 * Get the product of arithmetic or expressions.
1835 * Flags indicating the type of expression found are returned.
1836 * product = orexpr [ {'*' | '/' | '//' | '%'} orexpr ] ...
1837 */
1838 S_FUNC int
1839 getproduct(void)
1840 {
1841 int type; /* type of value found */
1842 long op; /* opcode to generate */
1843
1844 type = getorexpr();
1845 for (;;) {
1846 switch (gettoken()) {
1847 case T_MULT: op = OP_MUL; break;
1848 case T_DIV: op = OP_DIV; break;
1849 case T_MOD: op = OP_MOD; break;
1850 case T_SLASHSLASH: op = OP_QUO; break;
1851 default:
1852 rescantoken();
1853 return type;
1854 }
1855 if (islvalue(type))
1856 addop(OP_GETVALUE);
1857 (void) getorexpr();
1858 addop(op);
1859 type = EXPR_RVALUE;
1860 }
1861 }
1862
1863
1864 /*
1865 * Get an expression made up of arithmetic or operators.
1866 * Flags indicating the type of expression found are returned.
1867 * orexpr = andexpr [ '|' andexpr ] ...
1868 */
1869 S_FUNC int
1870 getorexpr(void)
1871 {
1872 int type; /* type of value found */
1873
1874 type = getandexpr();
1875 while (gettoken() == T_OR) {
1876 if (islvalue(type))
1877 addop(OP_GETVALUE);
1878 (void) getandexpr();
1879 addop(OP_OR);
1880 type = EXPR_RVALUE;
1881 }
1882 rescantoken();
1883 return type;
1884 }
1885
1886
1887 /*
1888 * Get an expression made up of arithmetic and operators.
1889 * Flags indicating the type of expression found are returned.
1890 * andexpr = shiftexpr [ '&' shiftexpr ] ...
1891 */
1892 S_FUNC int
1893 getandexpr(void)
1894 {
1895 int type; /* type of value found */
1896 long op;
1897
1898 type = getshiftexpr();
1899 for (;;) {
1900 switch (gettoken()) {
1901 case T_AND: op = OP_AND; break;
1902 case T_TILDE: op = OP_XOR; break;
1903 case T_BACKSLASH: op = OP_SETMINUS; break;
1904 default:
1905 rescantoken();
1906 return type;
1907 }
1908 if (islvalue(type))
1909 addop(OP_GETVALUE);
1910 (void) getshiftexpr();
1911 addop(op);
1912 type = EXPR_RVALUE;
1913 }
1914 }
1915
1916
1917 /*
1918 * Get a shift or power expression.
1919 * Flags indicating the type of expression found are returned.
1920 * shift = '+' shift
1921 * | '-' shift
1922 * | '/' shift
1923 * | '\' shift
1924 * | '~' shift
1925 * | '#' shift
1926 * | reference '^' shiftexpr
1927 * | reference '<<' shiftexpr
1928 * | reference '>>' shiftexpr
1929 * | reference.
1930 */
1931 S_FUNC int
1932 getshiftexpr(void)
1933 {
1934 int type; /* type of value found */
1935 long op; /* opcode to generate */
1936
1937 op = 0;
1938 switch (gettoken()) {
1939 case T_PLUS: op = OP_PLUS; break;
1940 case T_MINUS: op = OP_NEGATE; break;
1941 case T_NOT: op = OP_NOT; break;
1942 case T_DIV: op = OP_INVERT; break;
1943 case T_BACKSLASH: op = OP_BACKSLASH; break;
1944 case T_TILDE: op = OP_COMP; break;
1945 case T_HASH: op = OP_CONTENT; break;
1946 }
1947 if (op) {
1948 (void) getshiftexpr();
1949 addop(op);
1950 return EXPR_RVALUE;
1951 }
1952 rescantoken();
1953 type = getreference();
1954 switch (gettoken()) {
1955 case T_POWER: op = OP_POWER; break;
1956 case T_LEFTSHIFT: op = OP_LEFTSHIFT; break;
1957 case T_RIGHTSHIFT: op = OP_RIGHTSHIFT; break;
1958 default:
1959 rescantoken();
1960 return type;
1961 }
1962 if (islvalue(type))
1963 addop(OP_GETVALUE);
1964 (void) getshiftexpr();
1965 addop(op);
1966 return EXPR_RVALUE;
1967 }
1968
1969
1970 /*
1971 * set an address or dereference indicator
1972 * address = '&' term
1973 * dereference = '*' term
1974 */
1975 S_FUNC int
1976 getreference(void)
1977 {
1978 int type;
1979
1980 switch(gettoken()) {
1981 case T_ANDAND:
1982 scanerror(T_NULL, "&& used as prefix operator");
1983 /*FALLTHRU*/
1984 case T_AND:
1985 type = getreference();
1986 addop(OP_PTR);
1987 type = EXPR_RVALUE;
1988 break;
1989 case T_MULT:
1990 (void) getreference();
1991 addop(OP_DEREF);
1992 type = 0;
1993 break;
1994 case T_POWER: /* '**' or '^' */
1995 (void) getreference();
1996 addop(OP_DEREF);
1997 addop(OP_DEREF);
1998 type = 0;
1999 break;
2000 default:
2001 rescantoken();
2002 type = getincdecexpr();
2003 }
2004 return type;
2005 }
2006
2007
2008 /*
2009 * get an increment or decrement expression
2010 * ++expr, --expr, expr++, expr--
2011 */
2012 S_FUNC int
2013 getincdecexpr(void)
2014 {
2015 int type;
2016 int tok;
2017
2018 type = getterm();
2019 tok = gettoken();
2020 if (tok == T_PLUSPLUS || tok == T_MINUSMINUS) {
2021 if (isrvalue(type))
2022 scanerror(T_NULL, "Bad ++ usage");
2023 writeindexop();
2024 if (tok == T_PLUSPLUS)
2025 addop(OP_POSTINC);
2026 else
2027 addop(OP_POSTDEC);
2028 for (;;) {
2029 tok = gettoken();
2030 switch(tok) {
2031 case T_PLUSPLUS:
2032 addop(OP_PREINC);
2033 continue;
2034 case T_MINUSMINUS:
2035 addop(OP_PREDEC);
2036 continue;
2037 default:
2038 addop(OP_POP);
2039 break;
2040 }
2041 break;
2042 }
2043 type = EXPR_RVALUE | EXPR_ASSIGN;
2044 }
2045 if (tok == T_NOT) {
2046 addopfunction(OP_CALL, getbuiltinfunc("fact"), 1);
2047 tok = gettoken();
2048 type = EXPR_RVALUE;
2049 }
2050 rescantoken();
2051 return type;
2052 }
2053
2054
2055 /*
2056 * Get a single term.
2057 * Flags indicating the type of value found are returned.
2058 * term = lvalue
2059 * | lvalue '[' assignment ']'
2060 * | lvalue '++'
2061 * | lvalue '--'
2062 * | real_number
2063 * | imaginary_number
2064 * | '.'
2065 * | string
2066 * | '(' assignment ')'
2067 * | function [ '(' [assignment [',' assignment] ] ')' ]
2068 * | '!' term
2069 */
2070 S_FUNC int
2071 getterm(void)
2072 {
2073 int type; /* type of term found */
2074 int oldmode;
2075
2076 type = 0;
2077 switch (gettoken()) {
2078 case T_NUMBER:
2079 addopone(OP_NUMBER, tokennumber());
2080 type = (EXPR_RVALUE | EXPR_CONST);
2081 break;
2082
2083 case T_IMAGINARY:
2084 addopone(OP_IMAGINARY, tokennumber());
2085 type = (EXPR_RVALUE | EXPR_CONST);
2086 break;
2087
2088 case T_OLDVALUE:
2089 addop(OP_OLDVALUE);
2090 type = 0;
2091 break;
2092
2093 case T_STRING:
2094 addopone(OP_STRING, tokenstring());
2095 type = EXPR_RVALUE;
2096 break;
2097
2098 case T_PLUSPLUS:
2099 if (isrvalue(getterm()))
2100 scanerror(T_NULL, "Bad ++ usage");
2101 writeindexop();
2102 addop(OP_PREINC);
2103 type = EXPR_ASSIGN;
2104 break;
2105
2106 case T_MINUSMINUS:
2107 if (isrvalue(getterm()))
2108 scanerror(T_NULL, "Bad -- usage");
2109 writeindexop();
2110 addop(OP_PREDEC);
2111 type = EXPR_ASSIGN;
2112 break;
2113
2114 case T_LEFTPAREN:
2115 oldmode = tokenmode(TM_DEFAULT);
2116 type = getexprlist();
2117 if (gettoken() != T_RIGHTPAREN)
2118 scanerror(T_SEMICOLON,
2119 "Missing right parenthesis");
2120 (void) tokenmode(oldmode);
2121 break;
2122
2123 case T_MAT:
2124 getonematrix(SYM_UNDEFINED);
2125 type = EXPR_ASSIGN;
2126 break;
2127
2128 case T_OBJ:
2129 getobjdeclaration(SYM_UNDEFINED);
2130 type = EXPR_ASSIGN;
2131 break;
2132
2133 case T_SYMBOL:
2134 rescantoken();
2135 type = getidexpr(TRUE, 0);
2136 break;
2137
2138 case T_MULT:
2139 (void) getterm();
2140 addop(OP_DEREF);
2141 type = 0;
2142 break;
2143
2144 case T_POWER: /* '**' or '^' */
2145 (void) getterm();
2146 addop(OP_DEREF);
2147 addop(OP_DEREF);
2148 type = 0;
2149 break;
2150
2151 case T_GLOBAL:
2152 if (gettoken() != T_SYMBOL) {
2153 scanerror(T_NULL,
2154 "No identifier after global specifier");
2155 break;
2156 }
2157 rescantoken();
2158 type = getidexpr(TRUE, T_GLOBAL);
2159 break;
2160
2161 case T_LOCAL:
2162 if (gettoken() != T_SYMBOL) {
2163 scanerror(T_NULL,
2164 "No identifier after local specifier");
2165 break;
2166 }
2167 rescantoken();
2168 type = getidexpr(TRUE, T_LOCAL);
2169 break;
2170
2171 case T_STATIC:
2172 if (gettoken() != T_SYMBOL) {
2173 scanerror(T_NULL,
2174 "No identifier after static specifier");
2175 break;
2176 }
2177 rescantoken();
2178 type = getidexpr(TRUE, T_STATIC);
2179 break;
2180
2181 case T_LEFTBRACKET:
2182 scanerror(T_NULL, "Left bracket with no preceding lvalue");
2183 break;
2184
2185 case T_PERIOD:
2186 scanerror(T_NULL, "Period with no preceding lvalue");
2187 break;
2188
2189 default:
2190 if (iskeyword(type)) {
2191 scanerror(T_NULL,
2192 "Expression contains reserved keyword");
2193 break;
2194 }
2195 rescantoken();
2196 scanerror(T_COMMA, "Missing expression");
2197 }
2198 if (type == 0) {
2199 for (;;) {
2200 switch (gettoken()) {
2201 case T_LEFTBRACKET:
2202 rescantoken();
2203 getmatargs();
2204 type = 0;
2205 break;
2206 case T_PERIOD:
2207 getelement();
2208 type = 0;
2209 break;
2210 case T_LEFTPAREN:
2211 scanerror(T_NULL,
2212 "Function calls not allowed "
2213 "as expressions");
2214 default:
2215 rescantoken();
2216 return type;
2217 }
2218 }
2219 }
2220 return type;
2221 }
2222
2223
2224 /*
2225 * Read in an identifier expressions.
2226 * This is a symbol name followed by parenthesis, or by square brackets or
2227 * element references. The symbol can be a global or a local variable name.
2228 * Returns the type of expression found.
2229 */
2230 S_FUNC int
2231 getidexpr(BOOL okmat, int autodef)
2232 {
2233 int type;
2234 char name[SYMBOLSIZE+1]; /* symbol name */
2235 int oldmode;
2236
2237 type = 0;
2238 if (!getid(name))
2239 return type;
2240 switch (gettoken()) {
2241 case T_LEFTPAREN:
2242 oldmode = tokenmode(TM_DEFAULT);
2243 getcallargs(name);
2244 (void) tokenmode(oldmode);
2245 type = 0;
2246 break;
2247 case T_ASSIGN:
2248 if (autodef != T_GLOBAL && autodef != T_LOCAL &&
2249 autodef != T_STATIC)
2250 autodef = 1;
2251 /* fall into default case */
2252 default:
2253 rescantoken();
2254 usesymbol(name, autodef);
2255 }
2256 /*
2257 * Now collect as many element references and matrix index operations
2258 * as there are following the id.
2259 */
2260 for (;;) {
2261 switch (gettoken()) {
2262 case T_LEFTBRACKET:
2263 rescantoken();
2264 if (!okmat)
2265 return type;
2266 getmatargs();
2267 type = 0;
2268 break;
2269 case T_ARROW:
2270 addop(OP_DEREF);
2271 /*FALLTHRU*/
2272 case T_PERIOD:
2273 getelement();
2274 type = 0;
2275 break;
2276 case T_LEFTPAREN:
2277 scanerror(T_NULL,
2278 "Function calls not allowed "
2279 "as expressions");
2280 default:
2281 rescantoken();
2282 return type;
2283 }
2284 }
2285 }
2286
2287
2288 /*
2289 * getsymvalue - return the VALUE of a symbol
2290 *
2291 * given:
2292 * name symbol name
2293 * v_p pointer to value return
2294 *
2295 * returns:
2296 * symbol type found:
2297 *
2298 * SYM_UNDEFINED no such symbol
2299 * SYM_GLOBAL global symbol found
2300 *
2301 * NOTE: This is a special hack to allow some special code in getfilename()
2302 * to get the value of a symbol. It should NOT be used in the
2303 * general op code generation / calc code parsing case.
2304 */
2305 S_FUNC int
2306 getsymvalue(char *name, VALUE *v_p)
2307 {
2308 GLOBAL *g_ret; /* global return from findglobal() */
2309
2310 /* firewall */
2311 if (name == NULL || v_p == NULL) {
2312 return SYM_UNDEFINED;
2313 }
2314
2315 /* look for a global */
2316 g_ret = findglobal(name);
2317 if (g_ret != NULL) {
2318 *v_p = g_ret->g_value;
2319 return SYM_GLOBAL;
2320 }
2321
2322 /* no such symbol */
2323 return SYM_UNDEFINED;
2324 }
2325
2326
2327 /*
2328 * Read in a filename for a read or write command.
2329 * Both quoted and unquoted filenames are handled here.
2330 * The name must be terminated by an end of line or semicolon.
2331 * Returns TRUE if the filename was successfully parsed.
2332 *
2333 * given:
2334 * name filename to read
2335 * namelen length of filename buffer including NUL byte
2336 * once non-NULL => set to TRUE of -once read
2337 */
2338 S_FUNC int
2339 getfilename(char *name, size_t namelen, BOOL *once)
2340 {
2341 STRING *s;
2342 char *symstr; /* symbol string */
2343 VALUE val; /* value of the symbol */
2344 int i;
2345
2346 (void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
2347 for (i = 2; i > 0; i--) {
2348 switch (gettoken()) {
2349 case T_STRING:
2350
2351 /* use the value of the literal string */
2352 s = findstring(tokenstring());
2353 strncpy(name, s->s_str, namelen-1);
2354 name[namelen-1] = '\0';
2355 sfree(s);
2356 break;
2357
2358 case T_SYMBOL:
2359
2360 /* get the symbol name */
2361 symstr = tokensymbol();
2362
2363 /*
2364 * special hack - symbols starting with $ are
2365 * treated as a global variable
2366 * instead of a literal string.
2367 */
2368 if (symstr[0] == '$') {
2369 ++symstr;
2370 if (getsymvalue(symstr, &val)) {
2371 if (val.v_type == V_STR) {
2372 /* use symbol VALUE string */
2373 symstr = val.v_str->s_str;
2374 if (symstr == NULL) {
2375 math_error(
2376 "string value pointer is NULL!!");
2377 /*NOTREACHED*/
2378 }
2379 } else {
2380 math_error(
2381 "a filename variable must be a string");
2382 /*NOTREACHED*/
2383 }
2384 } else {
2385 math_error("no such global variable");
2386 /*NOTREACHED*/
2387 }
2388 }
2389
2390 /* return symbol name or value of global var string */
2391 strncpy(name, symstr, namelen-1);
2392 name[namelen-1] = '\0';
2393 break;
2394
2395 case T_NEWLINE:
2396
2397 /* found newline */
2398 rescantoken();
2399 return 1;
2400
2401 default:
2402
2403 /* found something unexpected */
2404 rescantoken();
2405 return -1;
2406 }
2407
2408 /* deal with -once */
2409 if (i == 2 && once != NULL) {
2410 if ((*once = !strcmp(name, "-once")))
2411 continue;
2412 }
2413 break;
2414 }
2415 return 0;
2416 }
2417
2418
2419 /*
2420 * Read the show command to display useful information
2421 */
2422 S_FUNC void
2423 getshowstatement(void)
2424 {
2425 char name[5];
2426 long arg, index;
2427
2428 switch (gettoken()) {
2429 case T_SYMBOL:
2430 strncpy(name, tokensymbol(), 4);
2431 name[4] = '\0';
2432 /* Yuck! */
2433 arg = stringindex("buil\000"
2434 "real\000"
2435 "func\000"
2436 "objf\000"
2437 "conf\000"
2438 "objt\000"
2439 "file\000"
2440 "size\000"
2441 "erro\000"
2442 "cust\000"
2443 "bloc\000"
2444 "cons\000"
2445 "glob\000"
2446 "stat\000"
2447 "numb\000"
2448 "redc\000"
2449 "stri\000"
2450 "lite\000"
2451 "opco\000", name);
2452 break;
2453 case T_GLOBAL:
2454 arg = 13; break;
2455 case T_STATIC:
2456 arg = 14; break;
2457 default:
2458 printf("SHOW command to be followed by at least ");
2459 printf("four letters of one of:\n");
2460 printf("\tblocks, builtin, config, constants, ");
2461 printf("custom, errors, files, functions,\n");
2462 printf("\tglobaltypes, objfunctions, objtypes, "
2463 "opcodes, sizes, ");
2464 printf("realglobals,\n");
2465 printf("\tstatics, numbers, redcdata, "
2466 "strings, literals\n");
2467 rescantoken();
2468 return;
2469
2470 }
2471 if (arg == 19) {
2472 if (gettoken() != T_SYMBOL) {
2473 rescantoken();
2474 scanerror(T_SEMICOLON,
2475 "Function name expected for show statement");
2476 return;
2477 }
2478 index = adduserfunc(tokensymbol());
2479 addopone(OP_SHOW, index + 19);
2480 return;
2481 }
2482 if (arg > 0)
2483 addopone(OP_SHOW, arg);
2484 else
2485 warning("Unknown parameter for show statement");
2486 }
2487
2488
2489 /*
2490 * Read in a set of matrix index arguments, surrounded with square brackets.
2491 * This also handles double square brackets for 'fast indexing'.
2492 */
2493 S_FUNC void
2494 getmatargs(void)
2495 {
2496 int dim;
2497
2498 if (gettoken() != T_LEFTBRACKET) {
2499 scanerror(T_NULL, "Matrix indexing expected");
2500 return;
2501 }
2502 /*
2503 * Parse all levels of the array reference
2504 * Look for the 'fast index' first.
2505 */
2506 if (gettoken() == T_LEFTBRACKET) {
2507 (void) getopassignment();
2508 if ((gettoken() != T_RIGHTBRACKET) ||
2509 (gettoken() != T_RIGHTBRACKET)) {
2510 scanerror(T_NULL, "Bad fast index usage");
2511 return;
2512 }
2513 addop(OP_FIADDR);
2514 return;
2515 }
2516 rescantoken();
2517 /*
2518 * Normal indexing with the indexes separated by commas.
2519 * Initialize the flag in the opcode to assume that the array
2520 * element will only be referenced for reading. If the parser
2521 * finds that the element will be referenced for writing, then
2522 * it will call writeindexop to change the flag in the opcode.
2523 */
2524 dim = 0;
2525 if (gettoken() == T_RIGHTBRACKET) {
2526 addoptwo(OP_INDEXADDR, (long) dim, (long) FALSE);
2527 return;
2528 }
2529 rescantoken();
2530 for (;;) {
2531 ++dim;
2532 (void) getopassignment();
2533 switch (gettoken()) {
2534 case T_RIGHTBRACKET:
2535 addoptwo(OP_INDEXADDR, (long) dim,
2536 (long) FALSE);
2537 return;
2538 case T_COMMA:
2539 break;
2540 default:
2541 rescantoken();
2542 scanerror(T_NULL,
2543 "Missing right bracket in "
2544 "array reference");
2545 return;
2546 }
2547 }
2548 }
2549
2550
2551 /*
2552 * Get an element of an object reference.
2553 * The leading period which introduces the element has already been read.
2554 */
2555 S_FUNC void
2556 getelement(void)
2557 {
2558 long index;
2559 char name[SYMBOLSIZE+1];
2560
2561 if (!getid(name))
2562 return;
2563 index = findelement(name);
2564 if (index < 0) {
2565 scanerror(T_NULL, "Element \"%s\" is undefined", name);
2566 return;
2567 }
2568 addopone(OP_ELEMADDR, index);
2569 }
2570
2571
2572 /*
2573 * Read in a single symbol name and copy its value into the given buffer.
2574 * Returns TRUE if a valid symbol id was found.
2575 */
2576 S_FUNC BOOL
2577 getid(char *buf)
2578 {
2579 int type;
2580
2581 type = gettoken();
2582 if (iskeyword(type)) {
2583 scanerror(T_NULL, "Reserved keyword used as symbol name");
2584 type = T_SYMBOL;
2585 *buf = '\0';
2586 return FALSE;
2587 }
2588 if (type != T_SYMBOL) {
2589 rescantoken();
2590 scanerror(T_NULL, "Symbol name expected");
2591 *buf = '\0';
2592 return FALSE;
2593 }
2594 strncpy(buf, tokensymbol(), SYMBOLSIZE);
2595 buf[SYMBOLSIZE] = '\0';
2596 return TRUE;
2597 }
2598
2599
2600 /*
2601 * Define a symbol name to be of the specified symbol type. The scope
2602 * of a static variable with the same name is terminated if symtype is
2603 * global or if symtype is static and the old variable is at the same
2604 * level. Warnings are issued when a global or local variable is
2605 * redeclared and when in the same body the variable will be accessible only
2606 ^ with the appropriate specfier.
2607 */
2608 S_FUNC void
2609 definesymbol(char *name, int symtype)
2610 {
2611 switch (symboltype(name)) {
2612 case SYM_STATIC:
2613 if (symtype == SYM_GLOBAL || symtype == SYM_STATIC)
2614 endscope(name, symtype == SYM_GLOBAL);
2615 break;
2616 case SYM_GLOBAL:
2617 if (symtype == SYM_GLOBAL && conf->redecl_warn) {
2618 warning("redeclaration of global \"%s\"",
2619 name);
2620 return;
2621 }
2622 break;
2623
2624 case SYM_LOCAL:
2625 if (symtype == SYM_LOCAL && conf->redecl_warn) {
2626 warning("redeclaration of local \"%s\"",
2627 name);
2628 return;
2629 }
2630 if (symtype == SYM_GLOBAL && conf->dupvar_warn) {
2631 warning("both local and global \"%s\" defined", name);
2632 break;
2633 }
2634 if (conf->dupvar_warn) {
2635 warning("both local and static \"%s\" defined", name);
2636 }
2637 break;
2638 case SYM_PARAM:
2639 if (symtype == SYM_LOCAL && conf->dupvar_warn) {
2640 warning("both local and parameter \"%s\" defined",
2641 name);
2642 break;
2643 }
2644 if (symtype == SYM_GLOBAL && conf->dupvar_warn) {
2645 warning("both global and parameter \"%s\" defined",
2646 name);
2647 break;
2648 }
2649 if (conf->dupvar_warn) {
2650 warning("both static and parameter \"%s\" defined",
2651 name);
2652 }
2653 }
2654 if (symtype == SYM_LOCAL)
2655 (void) addlocal(name);
2656 else
2657 (void) addglobal(name, (symtype == SYM_STATIC));
2658 }
2659
2660
2661 /*
2662 * Check a symbol name to see if it is known and generate code to reference it.
2663 * The symbol can be either a parameter name, a local name, or a global name.
2664 * If autodef is true, we automatically define the name as a global symbol
2665 * if it is not yet known.
2666 *
2667 * given:
2668 * name symbol name to be checked
2669 * autodef 1 => define if symbol is not known
2670 * T_GLOBAL => get global, define if necessary
2671 */
2672 S_FUNC void
2673 usesymbol(char *name, int autodef)
2674 {
2675 int type;
2676
2677 type = symboltype(name);
2678 if (autodef == T_GLOBAL) {
2679 if (type == SYM_GLOBAL) {
2680 warning("Unnecessary global specifier");
2681 }
2682 addopptr(OP_GLOBALADDR, (char *) addglobal(name, FALSE));
2683 return;
2684 }
2685 if (autodef == T_STATIC) {
2686 addopptr(OP_GLOBALADDR, (char *) addglobal(name, TRUE));
2687 return;
2688 }
2689 if (autodef == T_LOCAL) {
2690 if (type == SYM_LOCAL) {
2691 warning("Unnecessary local specifier");
2692 }
2693 addopone(OP_LOCALADDR, addlocal(name));
2694 return;
2695 }
2696 switch (type) {
2697 case SYM_LOCAL:
2698 addopone(OP_LOCALADDR, (long) findlocal(name));
2699 return;
2700 case SYM_PARAM:
2701 addopone(OP_PARAMADDR, (long) findparam(name));
2702 return;
2703 case SYM_GLOBAL:
2704 case SYM_STATIC:
2705 addopptr(OP_GLOBALADDR, (char *) findglobal(name));
2706 return;
2707 }
2708 /*
2709 * The symbol is not yet defined.
2710 * If we are at the top level and we are allowed to, then define it.
2711 */
2712 if ((curfunc->f_name[0] != '*') || !autodef) {
2713 scanerror(T_NULL, "\"%s\" is undefined", name);
2714 return;
2715 }
2716 (void) addglobal(name, FALSE);
2717 addopptr(OP_GLOBALADDR, (char *) findglobal(name));
2718 }
2719
2720
2721 /*
2722 * Get arguments for a function call.
2723 * The name and beginning parenthesis has already been seen.
2724 * callargs = [ [ '&' ] assignment [',' [ '&' ] assignment] ] ')'.
2725 *
2726 * given:
2727 * name name of function
2728 */
2729 S_FUNC void
2730 getcallargs(char *name)
2731 {
2732 long index; /* function index */
2733 long op; /* opcode to add */
2734 int argcount; /* number of arguments */
2735 BOOL addrflag;
2736
2737 op = OP_CALL;
2738 index = getbuiltinfunc(name);
2739 if (index < 0) {
2740 op = OP_USERCALL;
2741 index = adduserfunc(name);
2742 }
2743 if (gettoken() == T_RIGHTPAREN) {
2744 if (op == OP_CALL)
2745 builtincheck(index, 0);
2746 addopfunction(op, index, 0);
2747 return;
2748 }
2749 rescantoken();
2750 argcount = 0;
2751 for (;;) {
2752 argcount++;
2753 if (gettoken() == T_RIGHTPAREN) {
2754 addop(OP_UNDEF);
2755 if (op == OP_CALL)
2756 builtincheck(index, argcount);
2757 addopfunction(op, index, argcount);
2758 return;
2759 }
2760 rescantoken();
2761 if (gettoken() == T_COMMA) {
2762 addop(OP_UNDEF);
2763 continue;
2764 }
2765 rescantoken();
2766 addrflag = (gettoken() == T_BACKQUOTE);
2767 if (!addrflag)
2768 rescantoken();
2769 (void) getopassignment();
2770 if (addrflag) {
2771 writeindexop();
2772 }
2773 if (!addrflag && (op != OP_CALL))
2774 addop(OP_GETVALUE);
2775 if (!strcmp(name, "quomod") && argcount > 2)
2776 writeindexop();
2777 switch (gettoken()) {
2778 case T_RIGHTPAREN:
2779 if (op == OP_CALL)
2780 builtincheck(index, argcount);
2781 addopfunction(op, index, argcount);
2782 return;
2783 case T_COMMA:
2784 break;
2785 default:
2786 scanerror(T_SEMICOLON,
2787 "Missing right parenthesis "
2788 "in function call");
2789 return;
2790 }
2791 }
2792 }
2793
2794
2795 /*
2796 * Change the current directory. If no directory is given, assume home.
2797 */
2798 S_FUNC void
2799 do_changedir(void)
2800 {
2801 char *p;
2802 STRING *s;
2803
2804 /* look at the next token */
2805 (void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
2806
2807 /* determine the new directory */
2808 s = NULL;
2809 switch (gettoken()) {
2810 case T_STRING:
2811 s = findstring(tokenstring());
2812 p = s->s_str;
2813 break;
2814 case T_SYMBOL:
2815 p = tokensymbol();
2816 break;
2817 default:
2818 p = home;
2819 }
2820
2821 if (p == NULL) {
2822 fprintf(stderr, "Cannot determine HOME directory\n");
2823 }
2824
2825 /* change to that directory */
2826 if (chdir(p)) {
2827 perror(p);
2828 }
2829 if (s != NULL)
2830 sfree(s);
2831 }
2832
2833
A place to share codes with mates