|
|
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.