add OP_PUSHCONST

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

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;

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,

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);

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 <stdio.h>
@@ -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);

src/parse.y

@@ -28,9 +28,10 @@ int yylex(struct parser_control *);
 }
 
 %token tLPAREN tRPAREN tDOT
+%token tQUOTE
 %token <datum> tSYMBOL tNUMBER tBOOLEAN
 
-%type <datum> datum simple_datum symbol compound_datum
+%type <datum> datum simple_datum symbol compound_datum abbrev
 %type <datum> 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

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; }

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");

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 {