implement yy arena gc

src/parse.y

@@ -1,6 +1,7 @@
 %{
 #include <stdlib.h>
 #include <stdio.h>
+#include <string.h>
 
 #include "picrin.h"
 #include "picrin/pair.h"
@@ -8,16 +9,6 @@
 
 #define YYERROR_VERBOSE 1
 
-struct parser_control {
-  pic_state *pic;
-  void *yyscanner;
-  pic_value value;
-  bool incomp;
-  int yynerrs;
-};
-
-void yyerror(struct parser_control *, const char *);
-
 /* just for supressing warnings. a little bit evil */
 int yylex();
 int yylex_();
@@ -25,6 +16,123 @@ void yylex_init();
 void yyset_in();
 void yy_scan_string();
 void yylex_destroy();
+
+struct parser_control {
+  pic_state *pic;
+  void *yyscanner;
+  pic_value value;
+  bool incomp;
+  int yynerrs;
+  struct pic_vector *yy_arena;
+  int yy_arena_idx;
+};
+
+#define YY_ARENA_SIZE 50
+
+struct parser_control *
+parser_control_new(pic_state *pic)
+{
+  struct parser_control *p;
+
+  p = (struct parser_control *)pic_alloc(pic, sizeof(struct parser_control));
+  p->pic = pic;
+  p->incomp = false;
+  p->yynerrs = 0;
+  p->yy_arena = pic_vec_new(pic, YY_ARENA_SIZE);
+  p->yy_arena_idx = 0;
+  yylex_init(&p->yyscanner);
+
+  return p;
+}
+
+void
+parser_control_destroy(struct parser_control *p)
+{
+  pic_state *pic = p->pic;
+
+  yylex_destroy(p->yyscanner);
+  pic_free(pic, p);
+}
+
+void
+yy_obj_protect(struct parser_control *p, struct pic_object *obj)
+{
+  if (p->yy_arena_idx >= p->yy_arena->len) {
+    pic_vec_extend_ip(p->pic, p->yy_arena, p->yy_arena->len * 2);
+  }
+  p->yy_arena->data[p->yy_arena_idx++] = pic_obj_value(obj);
+}
+
+struct pic_object *
+yy_obj_alloc(struct parser_control *p, size_t size, enum pic_tt tt)
+{
+  struct pic_object *obj;
+
+  obj = pic_obj_alloc_unsafe(p->pic, size, tt);
+  yy_obj_protect(p, obj);
+  return obj;
+}
+
+pic_value
+yy_cons(struct parser_control *p, pic_value car, pic_value cdr)
+{
+  struct pic_pair *pair;
+
+  pair = (struct pic_pair *)yy_obj_alloc(p, sizeof(struct pic_pair), PIC_TT_PAIR);
+  pair->car = car;
+  pair->cdr = cdr;
+
+  return pic_obj_value(pair);
+}
+
+pic_value
+yy_abbrev(struct parser_control *p, pic_sym sym, pic_value datum)
+{
+  return yy_cons(p, pic_symbol_value(sym), yy_cons(p, datum, pic_nil_value()));
+}
+
+pic_value
+yy_str_new_cstr(struct parser_control *p, const char *cstr)
+{
+  struct pic_string *str;
+
+  str = (struct pic_string *)yy_obj_alloc(p, sizeof(struct pic_string), PIC_TT_STRING);
+  str->len = strlen(cstr);
+  str->str = strdup(cstr);
+
+  return pic_obj_value(str);
+}
+
+pic_value
+yy_vec_new_from_list(struct parser_control *p, pic_value data)
+{
+  struct pic_vector *vec;
+  int i, len;
+
+  len = pic_length(p->pic, data);
+
+  vec = (struct pic_vector *)yy_obj_alloc(p, sizeof(struct pic_vector), PIC_TT_VECTOR);
+  vec->len = len;
+  vec->data = (pic_value *)pic_alloc(p->pic, sizeof(pic_value) * len);
+  for (i = 0; i < len; ++i) {
+    vec->data[i] = pic_car(p->pic, data);
+    data = pic_cdr(p->pic, data);
+  }
+  return pic_obj_value(vec);
+}
+
+pic_value
+yy_blob_new(struct parser_control *p, char *dat, int len)
+{
+  struct pic_blob *bv;
+
+  bv = (struct pic_blob *)yy_obj_alloc(p, sizeof(struct pic_blob), PIC_TT_BLOB);
+  bv->data = strndup(dat, len);
+  bv->len = len;
+  return pic_obj_value(bv);
+}
+
+void yyerror(struct parser_control *, const char *);
 %}
 
 %pure_parser
@@ -77,11 +185,11 @@ program
 program_data
 	: datum
 	{
-	  $$ = pic_cons(p->pic, $1, pic_nil_value());
+	  $$ = yy_cons(p, $1, pic_nil_value());
 	}
 	| datum program_data
 	{
-	  $$ = pic_cons(p->pic, $1, $2);
+	  $$ = yy_cons(p, $1, $2);
 	}
 	| tDATUM_COMMENT datum
 	{
@@ -111,7 +219,7 @@ simple_datum
 	}
 	| tSTRING
 	{
-	  $$ = pic_str_new_cstr(p->pic, $1);
+	  $$ = yy_str_new_cstr(p, $1);
 	  free($1);
 	}
 	| tINT
@@ -132,7 +240,7 @@ simple_datum
 	}
 	| tBYTEVECTOR
 	{
-	  $$ = pic_obj_value(pic_blob_new(p->pic, $1.dat, $1.len));
+	  $$ = yy_blob_new(p, $1.dat, $1.len);
 	  free($1.dat);
 	}
 ;
@@ -165,18 +273,18 @@ list_data
 	}
 	| datum tDOT datum
 	{
-	  $$ = pic_cons(p->pic, $1, $3);
+	  $$ = yy_cons(p, $1, $3);
 	}
 	| datum list_data
 	{
-	  $$ = pic_cons(p->pic, $1, $2);
+	  $$ = yy_cons(p, $1, $2);
 	}
 ;
 
 vector
 	: tVPAREN vector_data tRPAREN
 	{
-	  $$ = pic_obj_value(pic_vec_new_from_list(p->pic, $2));
+	  $$ = yy_vec_new_from_list(p, $2);
 	}
 ;
 
@@ -191,26 +299,26 @@ vector_data
 	}
 	| datum vector_data
 	{
-	  $$ = pic_cons(p->pic, $1, $2);
+	  $$ = yy_cons(p, $1, $2);
 	}
 ;
 
 abbrev
 	: tQUOTE datum
 	{
-	  $$ = pic_list(p->pic, 2, pic_symbol_value(p->pic->sQUOTE), $2);
+	  $$ = yy_abbrev(p, p->pic->sQUOTE, $2);
 	}
 	| tQUASIQUOTE datum
 	{
-	  $$ = pic_list(p->pic, 2, pic_symbol_value(p->pic->sQUASIQUOTE), $2);
+	  $$ = yy_abbrev(p, p->pic->sQUASIQUOTE, $2);
 	}
 	| tUNQUOTE datum
 	{
-	  $$ = pic_list(p->pic, 2, pic_symbol_value(p->pic->sUNQUOTE), $2);
+	  $$ = yy_abbrev(p, p->pic->sUNQUOTE, $2);
 	}
 	| tUNQUOTE_SPLICING datum
 	{
-	  $$ = pic_list(p->pic, 2, pic_symbol_value(p->pic->sUNQUOTE_SPLICING), $2);
+	  $$ = yy_abbrev(p, p->pic->sUNQUOTE_SPLICING, $2);
 	}
 ;
 
@@ -258,50 +366,76 @@ yylex(YYSTYPE *yylvalp, struct parser_control *p)
 int
 pic_parse_file(pic_state *pic, FILE *file, pic_value *v)
 {
-  struct parser_control p;
+  struct parser_control *p;
+  int r, ai = pic_gc_arena_preserve(pic);
 
-  p.pic = pic;
+  p = parser_control_new(pic);
-  p.incomp = false;
-  p.yynerrs = 0;
 
-  yylex_init(&p.yyscanner);
+  yyset_in(file, p->yyscanner);
-  yyset_in(file, p.yyscanner);
+  yyparse(p);
-  yyparse(&p);
-  yylex_destroy(p.yyscanner);
 
-  if (p.yynerrs > 0) {
+  if (p->yynerrs > 0) {
-    p.value = pic_undef_value();
+    p->value = pic_undef_value();
-    return PIC_PARSER_ERROR;
+    r = PIC_PARSER_ERROR;
   }
-  if (p.incomp) {
+  else if (p->incomp) {
-    return PIC_PARSER_INCOMPLETE;
+    r = PIC_PARSER_INCOMPLETE;
+  }
+  else {
+    r = pic_length(pic, p->value);
   }
 
-  *v = p.value;
+  parser_control_destroy(p);
-  return pic_length(pic, p.value);
+
+#if DEBUG
+  if (pic_gc_arena_preserve(pic) != ai + 1) {
+    puts("**logic flaw! yy obj protection failure!**");
+  }
+#endif
+
+  pic_gc_arena_restore(pic, ai);
+
+  *v = p->value;
+  pic_gc_protect(pic, p->value);
+
+  return r;
 }
 
 enum pic_parser_res
 pic_parse_cstr(pic_state *pic, const char *str, pic_value *v)
 {
-  struct parser_control p;
+  struct parser_control *p;
+  int r, ai = pic_gc_arena_preserve(pic);
 
-  p.pic = pic;
+  p = parser_control_new(pic);
-  p.incomp = false;
-  p.yynerrs = 0;
 
-  yylex_init(&p.yyscanner);
+  yy_scan_string(str, p->yyscanner);
-  yy_scan_string(str, p.yyscanner);
+  yyparse(p);
-  yyparse(&p);
-  yylex_destroy(p.yyscanner);
 
-  if (p.yynerrs > 0) {
+  if (p->yynerrs > 0) {
-    return PIC_PARSER_ERROR;
+    p->value = pic_undef_value();
+    r = PIC_PARSER_ERROR;
   }
-  if (p.incomp) {
+  else if (p->incomp) {
-    return PIC_PARSER_INCOMPLETE;
+    r = PIC_PARSER_INCOMPLETE;
+  }
+  else {
+    r = pic_length(pic, p->value);
   }
 
-  *v = p.value;
+  parser_control_destroy(p);
-  return pic_length(pic, p.value);
+
+#if DEBUG
+  if (pic_gc_arena_preserve(pic) != ai + 1) {
+    puts("**logic flaw! yy obj protection failure!**");
+    printf("%d\n", pic_gc_arena_preserve(pic));
+  }
+#endif
+
+  pic_gc_arena_restore(pic, ai);
+
+  *v = p->value;
+  pic_gc_protect(pic, p->value);
+
+  return r;
 }