From a49675c322a03ef0f98ddad14427aa40b63aae27 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 21 Oct 2013 09:29:56 +0900 Subject: [PATCH] add OP_PUSHCONST --- include/picconf.h | 1 + include/picrin.h | 2 ++ include/picrin/irep.h | 1 + src/codegen.c | 17 ++++++++++++++++- src/gc.c | 17 +++++++++++++++++ src/parse.y | 13 ++++++++++++- src/scan.l | 1 + src/state.c | 6 ++++++ src/vm.c | 9 +++++++-- 9 files changed, 63 insertions(+), 4 deletions(-) diff --git a/include/picconf.h b/include/picconf.h index 598e8fdc..397b8597 100644 --- a/include/picconf.h +++ b/include/picconf.h @@ -14,6 +14,7 @@ #define PIC_IREP_SIZE 256 #define PIC_GLOBALS_SIZE 1024 #define PIC_SYM_TBL_SIZE 128 +#define PIC_POOL_SIZE 1024 /* enable all debug flags */ #define DEBUG 1 diff --git a/include/picrin.h b/include/picrin.h index ac22bea5..12a01233 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -34,6 +34,8 @@ typedef struct { size_t glen, gcapa; struct pic_irep **irep; size_t ilen, icapa; + pic_value *pool; + size_t plen, pcapa; jmp_buf *jmp; const char *errmsg; diff --git a/include/picrin/irep.h b/include/picrin/irep.h index fb88d8be..d5f1f006 100644 --- a/include/picrin/irep.h +++ b/include/picrin/irep.h @@ -7,6 +7,7 @@ enum pic_opcode { OP_PUSHTRUE, OP_PUSHFALSE, OP_PUSHNUM, + OP_PUSHCONST, OP_GREF, OP_GSET, OP_LREF, diff --git a/src/codegen.c b/src/codegen.c index c0142599..59a341e6 100644 --- a/src/codegen.c +++ b/src/codegen.c @@ -107,6 +107,11 @@ print_irep(pic_state *pic, struct pic_irep *irep) case OP_PUSHNUM: printf("OP_PUSHNUM\t%g\n", irep->code[i].u.f); break; + case OP_PUSHCONST: + printf("OP_PUSHCONST\t"); + pic_debug(pic, pic->pool[irep->code[i].u.i]); + puts(""); + break; case OP_GREF: printf("OP_GREF\t%i\n", irep->code[i].u.i); break; @@ -180,7 +185,7 @@ static struct pic_irep *pic_gen_lambda(pic_state *, pic_value, struct pic_env *) static void pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *env) { - pic_value sDEFINE, sLAMBDA, sIF, sBEGIN; + pic_value sDEFINE, sLAMBDA, sIF, sBEGIN, sQUOTE; pic_value sCONS, sCAR, sCDR, sNILP; pic_value sADD, sSUB, sMUL, sDIV; @@ -188,6 +193,7 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en sLAMBDA = pic->sLAMBDA; sIF = pic->sIF; sBEGIN = pic->sBEGIN; + sQUOTE = pic->sQUOTE; sCONS = pic->sCONS; sCAR = pic->sCAR; sCDR = pic->sCDR; @@ -280,6 +286,15 @@ pic_gen(pic_state *pic, struct pic_irep *irep, pic_value obj, struct pic_env *en irep->clen--; break; } + else if (pic_eq_p(pic, proc, sQUOTE)) { + int pidx; + pidx = pic->plen++; + pic->pool[pidx] = pic_car(pic, pic_cdr(pic, obj)); + irep->code[irep->clen].insn = OP_PUSHCONST; + irep->code[irep->clen].u.i = pidx; + irep->clen++; + break; + } else if (pic_eq_p(pic, proc, sCONS)) { pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, pic_cdr(pic, obj))), env); pic_gen(pic, irep, pic_car(pic, pic_cdr(pic, obj)), env); diff --git a/src/gc.c b/src/gc.c index b1530f62..ada47d86 100644 --- a/src/gc.c +++ b/src/gc.c @@ -5,6 +5,7 @@ #include "picrin/irep.h" #include "picrin/proc.h" #include "picrin/string.h" +#include "picrin/symbol.h" #if GC_DEBUG # include @@ -203,9 +204,25 @@ gc_mark_phase(pic_state *pic) gc_mark(pic, pic->globals[i]); } + /* pool */ + for (i = 0; i < pic->plen; ++i) { + gc_mark(pic, pic->pool[i]); + } + + /* symbol table */ + for (i = 0; i < pic->sym_tbl->size; ++i) { + gc_mark(pic, pic->sym_tbl->tbl[i]); + } + gc_mark(pic, pic->sDEFINE); gc_mark(pic, pic->sLAMBDA); + gc_mark(pic, pic->sIF); + gc_mark(pic, pic->sBEGIN); + gc_mark(pic, pic->sQUOTE); gc_mark(pic, pic->sCONS); + gc_mark(pic, pic->sCAR); + gc_mark(pic, pic->sCDR); + gc_mark(pic, pic->sNILP); gc_mark(pic, pic->sADD); gc_mark(pic, pic->sSUB); gc_mark(pic, pic->sMUL); diff --git a/src/parse.y b/src/parse.y index 8aaf0207..0a76e282 100644 --- a/src/parse.y +++ b/src/parse.y @@ -28,9 +28,10 @@ int yylex(struct parser_control *); } %token tLPAREN tRPAREN tDOT +%token tQUOTE %token tSYMBOL tNUMBER tBOOLEAN -%type datum simple_datum symbol compound_datum +%type datum simple_datum symbol compound_datum abbrev %type number boolean list list_data %% @@ -79,6 +80,7 @@ boolean compound_datum : list + | abbrev ; list @@ -103,8 +105,17 @@ list_data } ; +abbrev + : tQUOTE datum + { + $$ = pic_cons(p->pic, p->pic->sQUOTE, pic_cons(p->pic, $2, pic_nil_value())); + } +; + incomplete_datum : tLPAREN incomplete_data + | tQUOTE + | tQUOTE incomplete_datum ; incomplete_data diff --git a/src/scan.l b/src/scan.l index c6a7615e..62cf0d2a 100644 --- a/src/scan.l +++ b/src/scan.l @@ -35,6 +35,7 @@ infnan "+inf.0"|"-inf.0"|"+nan.0"|"-nan.0" "." return tDOT; "(" return tLPAREN; ")" return tRPAREN; +"'" return tQUOTE; {boolean} { yylval.datum = pic_bool_value(strcmp(yytext, "#t") == 0 || strcmp(yytext, "#true") == 0); return tBOOLEAN; } {real} { yylval.datum = pic_float_value(atof(yytext)); return tNUMBER; } {identifier} { yylval.datum = pic_intern_cstr(p->pic, yytext); return tSYMBOL; } diff --git a/src/state.c b/src/state.c index 3f9fd836..82b0327a 100644 --- a/src/state.c +++ b/src/state.c @@ -51,6 +51,11 @@ pic_open() pic->glen = 0; pic->gcapa = PIC_GLOBALS_SIZE; + /* pool */ + pic->pool = (pic_value *)malloc(sizeof(pic_value) * PIC_POOL_SIZE); + pic->plen = 0; + pic->pcapa = PIC_POOL_SIZE; + /* error handling */ pic->jmp = NULL; pic->errmsg = NULL; @@ -62,6 +67,7 @@ pic_open() pic->sLAMBDA = pic_intern_cstr(pic, "lambda"); pic->sIF = pic_intern_cstr(pic, "if"); pic->sBEGIN = pic_intern_cstr(pic, "begin"); + pic->sQUOTE = pic_intern_cstr(pic, "quote"); pic->sCONS = pic_intern_cstr(pic, "cons"); pic->sCAR = pic_intern_cstr(pic, "car"); pic->sCDR = pic_intern_cstr(pic, "cdr"); diff --git a/src/vm.c b/src/vm.c index 8b2c68e9..55a399f7 100644 --- a/src/vm.c +++ b/src/vm.c @@ -69,7 +69,7 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) #if PIC_DIRECT_THREADED_VM static void *oplabels[] = { &&L_OP_POP, &&L_OP_PUSHNIL, &&L_OP_PUSHTRUE, &&L_OP_PUSHFALSE, &&L_OP_PUSHNUM, - &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_JMP, &&L_OP_JMPIF, + &&L_OP_PUSHCONST, &&L_OP_GREF, &&L_OP_GSET, &&L_OP_LREF, &&L_OP_JMP, &&L_OP_JMPIF, &&L_OP_CALL, &&L_OP_RET, &&L_OP_LAMBDA, &&L_OP_CONS, &&L_OP_CAR, &&L_OP_CDR, &&L_OP_NILP, &&L_OP_ADD, &&L_OP_SUB, &&L_OP_MUL, &&L_OP_DIV, &&L_OP_STOP }; @@ -111,6 +111,10 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) PUSH(pic_float_value(pc->u.f)); NEXT; } + CASE(OP_PUSHCONST) { + PUSH(pic->pool[pc->u.i]); + NEXT; + } CASE(OP_GREF) { PUSH(pic->globals[pc->u.i]); NEXT; @@ -166,8 +170,9 @@ pic_run(pic_state *pic, struct pic_proc *proc, pic_value args) pic_value v; pic_callinfo *ci; - L_RAISE: if (pic->errmsg) { + + L_RAISE: goto L_STOP; } else {