Merge pull request #245 from picrin-scheme/heap-symbol

Let symbols to be allocated in heap

extlib/benz/debug.c

@@ -50,7 +50,7 @@ pic_print_backtrace(pic_state *pic)
 
     e = pic_error_ptr(pic->err);
     if (e->type != pic_intern_cstr(pic, "")) {
-      trace = pic_format(pic, "~s ", pic_sym_value(e->type));
+      trace = pic_format(pic, "~s ", pic_obj_value(e->type));
     } else {
       trace = pic_make_str(pic, NULL, 0);
     }

extlib/benz/dict.c

@@ -7,36 +7,37 @@
 #include "picrin/cont.h"
 #include "picrin/pair.h"
 #include "picrin/error.h"
+#include "picrin/symbol.h"
 
 struct pic_dict *
 pic_make_dict(pic_state *pic)
 {
   struct pic_dict *dict;
 
   dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
-  xh_init_int(&dict->hash, sizeof(pic_value));
+  xh_init_ptr(&dict->hash, sizeof(pic_value));
 
   return dict;
 }
 
 pic_value
-pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_sym key)
+pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_sym *key)
 {
   xh_entry *e;
 
-  e = xh_get_int(&dict->hash, key);
+  e = xh_get_ptr(&dict->hash, key);
   if (! e) {
-    pic_errorf(pic, "element not found for a key: ~s", pic_sym_value(key));
+    pic_errorf(pic, "element not found for a key: ~s", pic_obj_value(key));
   }
   return xh_val(e, pic_value);
 }
 
 void
-pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_sym key, pic_value val)
+pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_sym *key, pic_value val)
 {
   PIC_UNUSED(pic);
 
-  xh_put_int(&dict->hash, key, &val);
+  xh_put_ptr(&dict->hash, key, &val);
 }
 
 size_t
@@ -48,21 +49,21 @@ pic_dict_size(pic_state *pic, struct pic_dict *dict)
 }
 
 bool
-pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_sym key)
+pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_sym *key)
 {
   PIC_UNUSED(pic);
 
-  return xh_get_int(&dict->hash, key) != NULL;
+  return xh_get_ptr(&dict->hash, key) != NULL;
 }
 
 void
-pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_sym key)
+pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_sym *key)
 {
-  if (xh_get_int(&dict->hash, key) == NULL) {
-    pic_errorf(pic, "no slot named ~s found in dictionary", pic_sym_value(key));
+  if (xh_get_ptr(&dict->hash, key) == NULL) {
+    pic_errorf(pic, "no slot named ~s found in dictionary", pic_obj_value(key));
   }
 
-  xh_del_int(&dict->hash, key);
+  xh_del_ptr(&dict->hash, key);
 }
 
 static pic_value
@@ -90,7 +91,7 @@ pic_dict_dictionary(pic_state *pic)
 
   for (i = 0; i < argc; i += 2) {
     pic_assert_type(pic, argv[i], sym);
-    pic_dict_set(pic, dict, pic_sym(argv[i]), argv[i+1]);
+    pic_dict_set(pic, dict, pic_sym_ptr(argv[i]), argv[i+1]);
   }
 
   return pic_obj_value(dict);
@@ -110,7 +111,7 @@ static pic_value
 pic_dict_dictionary_ref(pic_state *pic)
 {
   struct pic_dict *dict;
-  pic_sym key;
+  pic_sym *key;
 
   pic_get_args(pic, "dm", &dict, &key);
 
@@ -125,7 +126,7 @@ static pic_value
 pic_dict_dictionary_set(pic_state *pic)
 {
   struct pic_dict *dict;
-  pic_sym key;
+  pic_sym *key;
   pic_value val;
 
   pic_get_args(pic, "dmo", &dict, &key, &val);
@@ -139,7 +140,7 @@ static pic_value
 pic_dict_dictionary_del(pic_state *pic)
 {
   struct pic_dict *dict;
-  pic_sym key;
+  pic_sym *key;
 
   pic_get_args(pic, "dm", &dict, &key);
 
@@ -186,7 +187,7 @@ pic_dict_dictionary_map(pic_state *pic)
         if (it[i] == NULL) {
           break;
         }
-        pic_push(pic, pic_sym_value(xh_key(it[i], pic_sym)), arg);
+        pic_push(pic, pic_obj_value(xh_key(it[i], pic_sym *)), arg);
         it[i] = xh_next(it[i]);
       }
       if (i != argc) {
@@ -232,7 +233,7 @@ pic_dict_dictionary_for_each(pic_state *pic)
         if (it[i] == NULL) {
           break;
         }
-        pic_push(pic, pic_sym_value(xh_key(it[i], pic_sym)), arg);
+        pic_push(pic, pic_obj_value(xh_key(it[i], pic_sym *)), arg);
         it[i] = xh_next(it[i]);
       }
       if (i != argc) {
@@ -261,7 +262,7 @@ pic_dict_dictionary_to_alist(pic_state *pic)
   pic_get_args(pic, "d", &dict);
 
   for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
-    item = pic_cons(pic, pic_sym_value(xh_key(it, pic_sym)), xh_val(it, pic_value));
+    item = pic_cons(pic, pic_obj_value(xh_key(it, pic_sym *)), xh_val(it, pic_value));
     pic_push(pic, item, alist);
   }
 
@@ -280,7 +281,7 @@ pic_dict_alist_to_dictionary(pic_state *pic)
 
   pic_for_each (e, pic_reverse(pic, alist)) {
     pic_assert_type(pic, pic_car(pic, e), sym);
-    pic_dict_set(pic, dict, pic_sym(pic_car(pic, e)), pic_cdr(pic, e));
+    pic_dict_set(pic, dict, pic_sym_ptr(pic_car(pic, e)), pic_cdr(pic, e));
   }
 
   return pic_obj_value(dict);
@@ -296,7 +297,7 @@ pic_dict_dictionary_to_plist(pic_state *pic)
   pic_get_args(pic, "d", &dict);
 
   for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
-    pic_push(pic, pic_sym_value(xh_key(it, pic_sym)), plist);
+    pic_push(pic, pic_obj_value(xh_key(it, pic_sym *)), plist);
     pic_push(pic, xh_val(it, pic_value), plist);
   }
 
@@ -315,7 +316,7 @@ pic_dict_plist_to_dictionary(pic_state *pic)
 
   for (e = pic_reverse(pic, plist); ! pic_nil_p(e); e = pic_cddr(pic, e)) {
     pic_assert_type(pic, pic_cadr(pic, e), sym);
-    pic_dict_set(pic, dict, pic_sym(pic_cadr(pic, e)), pic_car(pic, e));
+    pic_dict_set(pic, dict, pic_sym_ptr(pic_cadr(pic, e)), pic_car(pic, e));
   }
 
   return pic_obj_value(dict);

extlib/benz/error.c

@@ -125,7 +125,7 @@ pic_pop_try(pic_state *pic)
 }
 
 struct pic_error *
-pic_make_error(pic_state *pic, pic_sym type, const char *msg, pic_value irrs)
+pic_make_error(pic_state *pic, pic_sym *type, const char *msg, pic_value irrs)
 {
   struct pic_error *e;
   pic_str *stack;
@@ -175,7 +175,7 @@ pic_raise(pic_state *pic, pic_value err)
 }
 
 void
-pic_throw(pic_state *pic, pic_sym type, const char *msg, pic_value irrs)
+pic_throw(pic_state *pic, pic_sym *type, const char *msg, pic_value irrs)
 {
   struct pic_error *e;
 
@@ -253,7 +253,7 @@ static pic_value
 pic_error_make_error_object(pic_state *pic)
 {
   struct pic_error *e;
-  pic_sym type;
+  pic_sym *type;
   pic_str *msg;
   size_t argc;
   pic_value *argv;
@@ -302,7 +302,7 @@ pic_error_error_object_type(pic_state *pic)
 
   pic_get_args(pic, "e", &e);
 
-  return pic_sym_value(e->type);
+  return pic_obj_value(e->type);
 }
 
 void

extlib/benz/gc.c

@@ -19,6 +19,7 @@
 #include "picrin/dict.h"
 #include "picrin/record.h"
 #include "picrin/read.h"
+#include "picrin/symbol.h"
 
 union header {
   struct {
@@ -389,6 +390,8 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     }
     if (pic_proc_irep_p(proc)) {
       gc_mark_object(pic, (struct pic_object *)proc->u.irep);
+    } else {
+      gc_mark_object(pic, (struct pic_object *)proc->u.func.name);
     }
     break;
   }
@@ -397,7 +400,8 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
   }
   case PIC_TT_ERROR: {
     struct pic_error *err = (struct pic_error *)obj;
-    gc_mark_object(pic,(struct pic_object *)err->msg);
+    gc_mark_object(pic, (struct pic_object *)err->type);
+    gc_mark_object(pic, (struct pic_object *)err->msg);
     gc_mark(pic, err->irrs);
     gc_mark_object(pic, (struct pic_object *)err->stack);
     break;
@@ -422,24 +426,31 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
       gc_mark_object(pic, (struct pic_object *)senv->up);
     }
     gc_mark(pic, senv->defer);
+    gc_mark_object(pic, (struct pic_object *)senv->map);
     break;
   }
   case PIC_TT_LIB: {
     struct pic_lib *lib = (struct pic_lib *)obj;
     gc_mark(pic, lib->name);
     gc_mark_object(pic, (struct pic_object *)lib->env);
+    gc_mark_object(pic, (struct pic_object *)lib->exports);
     break;
   }
   case PIC_TT_IREP: {
     struct pic_irep *irep = (struct pic_irep *)obj;
     size_t i;
 
+    gc_mark_object(pic, (struct pic_object *)irep->name);
+
     for (i = 0; i < irep->ilen; ++i) {
       gc_mark_object(pic, (struct pic_object *)irep->irep[i]);
     }
     for (i = 0; i < irep->plen; ++i) {
       gc_mark(pic, irep->pool[i]);
     }
+    for (i = 0; i < irep->slen; ++i) {
+      gc_mark_object(pic, (struct pic_object *)irep->syms[i]);
+    }
     break;
   }
   case PIC_TT_DATA: {
@@ -459,24 +470,27 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
     xh_entry *it;
 
     for (it = xh_begin(&dict->hash); it != NULL; it = xh_next(it)) {
+      gc_mark_object(pic, (struct pic_object *)xh_key(it, pic_sym *));
       gc_mark(pic, xh_val(it, pic_value));
     }
     break;
   }
   case PIC_TT_RECORD: {
     struct pic_record *rec = (struct pic_record *)obj;
-    xh_entry *it;
 
-    for (it = xh_begin(&rec->hash); it != NULL; it = xh_next(it)) {
-      gc_mark(pic, xh_val(it, pic_value));
-    }
+    gc_mark_object(pic, (struct pic_object *)rec->data);
+    break;
+  }
+  case PIC_TT_SYMBOL: {
+    struct pic_symbol *sym = (struct pic_symbol *)obj;
+
+    gc_mark_object(pic, (struct pic_object *)sym->str);
     break;
   }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
   case PIC_TT_INT:
-  case PIC_TT_SYMBOL:
   case PIC_TT_CHAR:
   case PIC_TT_EOF:
   case PIC_TT_UNDEF:
@@ -511,6 +525,17 @@ gc_mark_trie(pic_state *pic, struct pic_trie *trie)
   }
 }
 
+#define M(x) gc_mark_object(pic, (struct pic_object *)pic->x)
+
+static void
+gc_mark_global_symbols(pic_state *pic)
+{
+  M(rDEFINE); M(rLAMBDA); M(rIF); M(rBEGIN); M(rQUOTE); M(rSETBANG);
+  M(rDEFINE_SYNTAX); M(rIMPORT); M(rEXPORT);
+  M(rDEFINE_LIBRARY); M(rIN_LIBRARY);
+  M(rCOND_EXPAND);
+}
+
 static void
 gc_mark_phase(pic_state *pic)
 {
@@ -548,14 +573,22 @@ gc_mark_phase(pic_state *pic)
     gc_mark_object(pic, pic->arena[j]);
   }
 
+  /* mark reserved uninterned symbols */
+  gc_mark_global_symbols(pic);
+
+  /* mark all interned symbols */
+  for (it = xh_begin(&pic->syms); it != NULL; it = xh_next(it)) {
+    gc_mark_object(pic, (struct pic_object *)xh_val(it, pic_sym *));
+  }
+
   /* global variables */
-  for (it = xh_begin(&pic->globals); it != NULL; it = xh_next(it)) {
-    gc_mark(pic, xh_val(it, pic_value));
+  if (pic->globals) {
+    gc_mark_object(pic, (struct pic_object *)pic->globals);
   }
 
   /* macro objects */
-  for (it = xh_begin(&pic->macros); it != NULL; it = xh_next(it)) {
-    gc_mark_object(pic, xh_val(it, struct pic_object *));
+  if (pic->macros) {
+    gc_mark_object(pic, (struct pic_object *)pic->macros);
   }
 
   /* error object */
@@ -635,20 +668,17 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_SENV: {
-    struct pic_senv *senv = (struct pic_senv *)obj;
-    xh_destroy(&senv->map);
     break;
   }
   case PIC_TT_LIB: {
-    struct pic_lib *lib = (struct pic_lib *)obj;
-    xh_destroy(&lib->exports);
     break;
   }
   case PIC_TT_IREP: {
     struct pic_irep *irep = (struct pic_irep *)obj;
     pic_free(pic, irep->code);
     pic_free(pic, irep->irep);
     pic_free(pic, irep->pool);
+    pic_free(pic, irep->syms);
     break;
   }
   case PIC_TT_DATA: {
@@ -663,15 +693,15 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
     break;
   }
   case PIC_TT_RECORD: {
-    struct pic_record *rec = (struct pic_record *)obj;
-    xh_destroy(&rec->hash);
+    break;
+  }
+  case PIC_TT_SYMBOL: {
     break;
   }
   case PIC_TT_NIL:
   case PIC_TT_BOOL:
   case PIC_TT_FLOAT:
   case PIC_TT_INT:
-  case PIC_TT_SYMBOL:
   case PIC_TT_CHAR:
   case PIC_TT_EOF:
   case PIC_TT_UNDEF:
@@ -758,6 +788,10 @@ pic_gc_run(pic_state *pic)
   struct heap_page *page;
 #endif
 
+  if (! pic->gc_enable) {
+    return;
+  }
+
 #if DEBUG
   puts("gc run!");
 #endif