|
|
1.1 root 1: %{
2: #include "hoc.h"
3: #define code2(c1,c2) code(c1); code(c2)
4: #define code3(c1,c2,c3) code(c1); code(c2); code(c3)
5: %}
6: %union {
7: Symbol *sym; /* symbol table pointer */
8: Inst *inst; /* machine instruction */
9: int narg; /* number of arguments */
10: }
11: %token <sym> NUMBER STRING PRINT VAR BLTIN UNDEF WHILE FOR IF ELSE
12: %token <sym> FUNCTION PROCEDURE RETURN FUNC PROC READ
13: %token <narg> ARG
14: %type <inst> expr stmt asgn prlist stmtlist
15: %type <inst> cond while for if begin end
16: %type <sym> procname
17: %type <narg> arglist
18: %right '=' ADDEQ SUBEQ MULEQ DIVEQ MODEQ
19: %left OR
20: %left AND
21: %left GT GE LT LE EQ NE
22: %left '+' '-'
23: %left '*' '/' '%'
24: %left UNARYMINUS NOT INC DEC
25: %right '^'
26: %%
27: list: /* nothing */
28: | list '\n'
29: | list defn '\n'
30: | list asgn '\n' { code2(xpop, STOP); return 1; }
31: | list stmt '\n' { code(STOP); return 1; }
32: | list expr '\n' { code2(print, STOP); return 1; }
33: | list error '\n' { yyerrok; }
34: ;
35: asgn: VAR '=' expr { code3(varpush,(Inst)$1,assign); $$=$3; }
36: | VAR ADDEQ expr { code3(varpush,(Inst)$1,addeq); $$=$3; }
37: | VAR SUBEQ expr { code3(varpush,(Inst)$1,subeq); $$=$3; }
38: | VAR MULEQ expr { code3(varpush,(Inst)$1,muleq); $$=$3; }
39: | VAR DIVEQ expr { code3(varpush,(Inst)$1,diveq); $$=$3; }
40: | VAR MODEQ expr { code3(varpush,(Inst)$1,modeq); $$=$3; }
41: | ARG '=' expr { defnonly("$"); code2(argassign,(Inst)$1); $$=$3;}
42: | ARG ADDEQ expr { defnonly("$"); code2(argaddeq,(Inst)$1); $$=$3;}
43: | ARG SUBEQ expr { defnonly("$"); code2(argsubeq,(Inst)$1); $$=$3;}
44: | ARG MULEQ expr { defnonly("$"); code2(argmuleq,(Inst)$1); $$=$3;}
45: | ARG DIVEQ expr { defnonly("$"); code2(argdiveq,(Inst)$1); $$=$3;}
46: | ARG MODEQ expr { defnonly("$"); code2(argmodeq,(Inst)$1); $$=$3;}
47: ;
48: stmt: expr { code(xpop); }
49: | RETURN { defnonly("return"); code(procret); }
50: | RETURN expr
51: { defnonly("return"); $$=$2; code(funcret); }
52: | PROCEDURE begin '(' arglist ')'
53: { $$ = $2; code3(call, (Inst)$1, (Inst)$4); }
54: | PRINT prlist { $$ = $2; }
55: | while '(' cond ')' stmt end {
56: ($1)[1] = (Inst)$5; /* body of loop */
57: ($1)[2] = (Inst)$6; } /* end, if cond fails */
58: | for '(' cond ';' cond ';' cond ')' stmt end {
59: ($1)[1] = (Inst)$5; /* condition */
60: ($1)[2] = (Inst)$7; /* post loop */
61: ($1)[3] = (Inst)$9; /* body of loop */
62: ($1)[4] = (Inst)$10; } /* end, if cond fails */
63: | if '(' cond ')' stmt end { /* else-less if */
64: ($1)[1] = (Inst)$5; /* thenpart */
65: ($1)[3] = (Inst)$6; } /* end, if cond fails */
66: | if '(' cond ')' stmt end ELSE stmt end { /* if with else */
67: ($1)[1] = (Inst)$5; /* thenpart */
68: ($1)[2] = (Inst)$8; /* elsepart */
69: ($1)[3] = (Inst)$9; } /* end, if cond fails */
70: | '{' stmtlist '}' { $$ = $2; }
71: ;
72: cond: expr { code(STOP); }
73: ;
74: while: WHILE { $$ = code3(whilecode,STOP,STOP); }
75: ;
76: for: FOR { $$ = code(forcode); code3(STOP,STOP,STOP); code(STOP); }
77: ;
78: if: IF { $$ = code(ifcode); code3(STOP,STOP,STOP); }
79: ;
80: begin: /* nothing */ { $$ = progp; }
81: ;
82: end: /* nothing */ { code(STOP); $$ = progp; }
83: ;
84: stmtlist: /* nothing */ { $$ = progp; }
85: | stmtlist '\n'
86: | stmtlist stmt
87: ;
88: expr: NUMBER { $$ = code2(constpush, (Inst)$1); }
89: | VAR { $$ = code3(varpush, (Inst)$1, eval); }
90: | ARG { defnonly("$"); $$ = code2(arg, (Inst)$1); }
91: | asgn
92: | FUNCTION begin '(' arglist ')'
93: { $$ = $2; code3(call,(Inst)$1,(Inst)$4); }
94: | READ '(' VAR ')' { $$ = code2(varread, (Inst)$3); }
95: | BLTIN '(' expr ')' { $$=$3; code2(bltin, (Inst)$1->u.ptr); }
96: | '(' expr ')' { $$ = $2; }
97: | expr '+' expr { code(add); }
98: | expr '-' expr { code(sub); }
99: | expr '*' expr { code(mul); }
100: | expr '/' expr { code(div); }
101: | expr '%' expr { code(mod); }
102: | expr '^' expr { code (power); }
103: | '-' expr %prec UNARYMINUS { $$=$2; code(negate); }
104: | expr GT expr { code(gt); }
105: | expr GE expr { code(ge); }
106: | expr LT expr { code(lt); }
107: | expr LE expr { code(le); }
108: | expr EQ expr { code(eq); }
109: | expr NE expr { code(ne); }
110: | expr AND expr { code(and); }
111: | expr OR expr { code(or); }
112: | NOT expr { $$ = $2; code(not); }
113: | INC VAR { $$ = code2(preinc,(Inst)$2); }
114: | DEC VAR { $$ = code2(predec,(Inst)$2); }
115: | VAR INC { $$ = code2(postinc,(Inst)$1); }
116: | VAR DEC { $$ = code2(postdec,(Inst)$1); }
117: ;
118: prlist: expr { code(prexpr); }
119: | STRING { $$ = code2(prstr, (Inst)$1); }
120: | prlist ',' expr { code(prexpr); }
121: | prlist ',' STRING { code2(prstr, (Inst)$3); }
122: ;
123: defn: FUNC procname { $2->type=FUNCTION; indef=1; }
124: '(' ')' stmt { code(procret); define($2); indef=0; }
125: | PROC procname { $2->type=PROCEDURE; indef=1; }
126: '(' ')' stmt { code(procret); define($2); indef=0; }
127: ;
128: procname: VAR
129: | FUNCTION
130: | PROCEDURE
131: ;
132: arglist: /* nothing */ { $$ = 0; }
133: | expr { $$ = 1; }
134: | arglist ',' expr { $$ = $1 + 1; }
135: ;
136: %%
137: /* end of grammar */
138: #include <stdio.h>
139: #include <ctype.h>
140: char *progname;
141: int lineno = 1;
142: #include <signal.h>
143: #include <setjmp.h>
144: #include <errno.h>
145: jmp_buf begin;
146: int indef;
147: char *infile; /* input file name */
148: FILE *fin; /* input file pointer */
149: char **gargv; /* global argument list */
150: extern errno;
151: int gargc;
152:
153: int c = '\n'; /* global for use by warning() */
154:
155: yylex() /* hoc6 */
156: {
157: while ((c=getc(fin)) == ' ' || c == '\t')
158: ;
159: if (c == EOF)
160: return 0;
161: if (c == '\\') {
162: c = getc(fin);
163: if (c == '\n') {
164: lineno++;
165: return yylex();
166: }
167: }
168: if (c == '#') { /* comment */
169: while ((c=getc(fin)) != '\n' && c != EOF)
170: ;
171: if (c == '\n')
172: lineno++;
173: return c;
174: }
175: if (c == '.' || isdigit(c)) { /* number */
176: double d;
177: ungetc(c, fin);
178: fscanf(fin, "%lf", &d);
179: yylval.sym = install("", NUMBER, d);
180: return NUMBER;
181: }
182: if (isalpha(c) || c == '_') {
183: Symbol *s;
184: char sbuf[100], *p = sbuf;
185: do {
186: if (p >= sbuf + sizeof(sbuf) - 1) {
187: *p = '\0';
188: execerror("name too long", sbuf);
189: }
190: *p++ = c;
191: } while ((c=getc(fin)) != EOF && (isalnum(c) || c == '_'));
192: ungetc(c, fin);
193: *p = '\0';
194: if ((s=lookup(sbuf)) == 0)
195: s = install(sbuf, UNDEF, 0.0);
196: yylval.sym = s;
197: return s->type == UNDEF ? VAR : s->type;
198: }
199: if (c == '$') { /* argument? */
200: int n = 0;
201: while (isdigit(c=getc(fin)))
202: n = 10 * n + c - '0';
203: ungetc(c, fin);
204: if (n == 0)
205: execerror("strange $...", (char *)0);
206: yylval.narg = n;
207: return ARG;
208: }
209: if (c == '"') { /* quoted string */
210: char sbuf[100], *p, *emalloc();
211: for (p = sbuf; (c=getc(fin)) != '"'; p++) {
212: if (c == '\n' || c == EOF)
213: execerror("missing quote", "");
214: if (p >= sbuf + sizeof(sbuf) - 1) {
215: *p = '\0';
216: execerror("string too long", sbuf);
217: }
218: *p = backslash(c);
219: }
220: *p = 0;
221: yylval.sym = (Symbol *)emalloc(strlen(sbuf)+1);
222: strcpy(yylval.sym, sbuf);
223: return STRING;
224: }
225: switch (c) {
226: case '+': return follow('+', INC, follow('=', ADDEQ, '+'));
227: case '-': return follow('-', DEC, follow('=', SUBEQ, '-'));
228: case '*': return follow('=', MULEQ, '*');
229: case '/': return follow('=', DIVEQ, '/');
230: case '%': return follow('=', MODEQ, '%');
231: case '>': return follow('=', GE, GT);
232: case '<': return follow('=', LE, LT);
233: case '=': return follow('=', EQ, '=');
234: case '!': return follow('=', NE, NOT);
235: case '|': return follow('|', OR, '|');
236: case '&': return follow('&', AND, '&');
237: case '\n': lineno++; return '\n';
238: default: return c;
239: }
240: }
241:
242: backslash(c) /* get next char with \'s interpreted */
243: int c;
244: {
245: char *strchr(); /* `index()' in some systems */
246: static char transtab[] = "b\bf\fn\nr\rt\t";
247: if (c != '\\')
248: return c;
249: c = getc(fin);
250: if (islower(c) && strchr(transtab, c))
251: return strchr(transtab, c)[1];
252: return c;
253: }
254:
255: follow(expect, ifyes, ifno) /* look ahead for >=, etc. */
256: {
257: int c = getc(fin);
258:
259: if (c == expect)
260: return ifyes;
261: ungetc(c, fin);
262: return ifno;
263: }
264:
265: defnonly(s) /* warn if illegal definition */
266: char *s;
267: {
268: if (!indef)
269: execerror(s, "used outside definition");
270: }
271:
272: yyerror(s) /* report compile-time error */
273: char *s;
274: {
275: /*rob
276: warning(s, (char *)0);
277: longjmp(begin, 0);
278: rob*/
279: execerror(s, (char *)0);
280: }
281:
282: execerror(s, t) /* recover from run-time error */
283: char *s, *t;
284: {
285: warning(s, t);
286: fseek(fin, 0L, 2); /* flush rest of file */
287: longjmp(begin, 0);
288: }
289:
290: fpecatch() /* catch floating point exceptions */
291: {
292: execerror("floating point exception", (char *) 0);
293: }
294:
295: intcatch() /* catch interrupts */
296: {
297: execerror("interrupt", (char *) 0);
298: }
299:
300: main(argc, argv) /* hoc6 */
301: char *argv[];
302: {
303: int i, fpecatch();
304: static int first = 1;
305:
306: progname = argv[0];
307: init();
308: if (argc == 1) { /* fake an argument list */
309: static char *stdinonly[] = { "-" };
310:
311: gargv = stdinonly;
312: gargc = 1;
313: } else if (first) { /* for interrupts */
314: first = 0;
315: gargv = argv+1;
316: gargc = argc-1;
317: }
318: while (moreinput())
319: run();
320: signal(SIGINT, SIG_IGN);
321: return 0;
322: }
323:
324: moreinput()
325: {
326: if (gargc-- <= 0)
327: return 0;
328: if (fin && fin != stdin)
329: fclose(fin);
330: infile = *gargv++;
331: lineno = 1;
332: if (strcmp(infile, "-") == 0) {
333: fin = stdin;
334: infile = 0;
335: } else if ((fin=fopen(infile, "r")) == NULL) {
336: fprintf(stderr, "%s: can't open %s\n", progname, infile);
337: return moreinput();
338: }
339: return 1;
340: }
341:
342: run() /* execute until EOF */
343: {
344: setjmp(begin);
345: signal(SIGINT, intcatch);
346: signal(SIGFPE, fpecatch);
347: for (initcode(); yyparse(); initcode())
348: execute(progbase);
349: }
350:
351: warning(s, t) /* print warning message */
352: char *s, *t;
353: {
354: fprintf(stderr, "%s: %s", progname, s);
355: if (t)
356: fprintf(stderr, " %s", t);
357: if (infile)
358: fprintf(stderr, " in %s", infile);
359: fprintf(stderr, " near line %d\n", lineno);
360: while (c != '\n' && c != EOF)
361: if((c = getc(fin)) == '\n') /* flush rest of input line */
362: lineno++;
363: else if (c == EOF && errno == EINTR) {
364: clearerr(stdin); /* ick! */
365: errno = 0;
366: }
367: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.