From 7a6bdc8aad4ac7fc22ffce7d97e30dd0cfefc999 Mon Sep 17 00:00:00 2001
From: Konstantin Nazarov <mail@knazarov.com>
Date: Fri, 26 Jul 2024 19:32:27 +0100
Subject: [PATCH] Use GC roots in primitive types

---
 src/arena.hpp  | 14 ++++++++++
 src/common.cpp | 39 +++++++++++++++++++++------
 src/common.hpp | 72 ++++++++++++++++++++++++++++++++++++++------------
 3 files changed, 100 insertions(+), 25 deletions(-)

diff --git a/src/arena.hpp b/src/arena.hpp
index 6e9f66d..5b94898 100644
--- a/src/arena.hpp
+++ b/src/arena.hpp
@@ -30,8 +30,12 @@ class GcRoot : public GcRootBase {
   GcRoot(GcRoot&& rhs);
 
   static Result<GcRoot<T>> create(T* ptr, Arena& arena);
+  Result<GcRoot<T>> copy(Arena& arena) {
+    return GcRoot<T>::create((T*)_ptr, arena);
+  }
 
   T& operator*() { return *(T*)_ptr; }
+  T* operator->() { return (T*)_ptr; }
 };
 
 template <class T>
@@ -60,6 +64,8 @@ class GcRootList {
     if (_next) _next->_prev = _prev;
   }
 
+  GcRootList* next() { return _next; }
+
   void update(GcRootBase* root) { _root = root; }
 
  private:
@@ -108,6 +114,14 @@ class Arena {
 
   void add_root(GcRootList* node) { _gcroot.insert(node); }
 
+  uint64_t root_count() {
+    uint64_t res = 0;
+    for (GcRootList* cur = &_gcroot; cur->next() != 0; cur = cur->next()) {
+      ++res;
+    }
+    return res;
+  };
+
  private:
   ArenaHeap* _heaps[2];
   GcRootList _gcroot;
diff --git a/src/common.cpp b/src/common.cpp
index 6474d1b..b54eb5f 100644
--- a/src/common.cpp
+++ b/src/common.cpp
@@ -1,12 +1,14 @@
 #include "common.hpp"
 
+#include "arena.hpp"
+
 Syntax::Syntax(String filename, String modulename, Value expression) {}
 
 Value Syntax::get_value() {
-  return pod_to_value(_value->expression.get(_value));
+  return pod_to_value(_value->expression.get(&*_value));
 }
 
-Value pod_to_value(PodObject* obj) {
+Result<Value> pod_to_value(PodObject* obj, Arena& arena) {
   switch (obj->header.tag) {
     case Tag::Nil:
       return Value();
@@ -15,20 +17,41 @@ Value pod_to_value(PodObject* obj) {
     case Tag::Float:
       return Value(Int64(((PodFloat*)obj)->value));
     case Tag::String:
-      return Value(String((PodString*)obj));
+      return Value(TRY(String::create(arena, (PodString*)obj)));
     case Tag::Symbol:
-      return Value(Symbol((PodSymbol*)obj));
+      return Value(TRY(Symbol::create(arena, (PodSymbol*)obj)));
     case Tag::Syntax:
-      return Value(Syntax((PodSyntax*)obj));
+      return Value(TRY(Syntax::create(arena, (PodSyntax*)obj)));
     case Tag::Pair:
-      return Value(Pair((PodPair*)obj));
+      return Value(TRY(Pair::create(arena, (PodPair*)obj)));
   };
   return Value();
 }
 
-Value syntax_unwrap(Value val) {
+Result<Value> syntax_unwrap(Arena& arena, Value& val) {
   Syntax* syntax = val.to<Syntax>();
-  if (syntax == 0) return val;
+  if (syntax == 0) return val.copy(arena);
 
   return syntax->get_value();
 }
+
+Result<Value> Nil::copy(Arena& arena) { return Value(Nil()); }
+
+Result<Value> Int64::copy(Arena& arena) { return Value(Int64(_value)); }
+Result<Value> Float::copy(Arena& arena) { return Value(Float(_value)); }
+
+Result<Value> String::copy(Arena& arena) {
+  return Value(String(TRY(_value.copy(arena))));
+}
+
+Result<Value> Symbol::copy(Arena& arena) {
+  return Value(Symbol(TRY(_value.copy(arena))));
+}
+
+Result<Value> Syntax::copy(Arena& arena) {
+  return Value(Syntax(TRY(_value.copy(arena))));
+}
+
+Result<Value> Pair::copy(Arena& arena) {
+  return Value(Pair(TRY(_value.copy(arena))));
+}
diff --git a/src/common.hpp b/src/common.hpp
index 9520008..72cc908 100644
--- a/src/common.hpp
+++ b/src/common.hpp
@@ -72,6 +72,7 @@ class PodPair : public PodObject {
 class Object {
  public:
   virtual Tag tag() = 0;
+  virtual Result<Value> copy(Arena& arena) = 0;
 };
 
 class Nil : public Object {
@@ -79,63 +80,91 @@ class Nil : public Object {
   Nil() {}
 
   virtual Tag tag() final { return Tag::Nil; }
+  virtual Result<Value> copy(Arena& arena) final;
 };
 
 class String : public Object {
  public:
-  String() : _value(0) {}
-  String(PodString* val) : _value(val) {}
+  String() {}
+  String(GcRoot<PodString>&& val) : _value(std::move(val)) {}
   virtual Tag tag() final { return Tag::String; }
 
+  static Result<String> create(Arena& arena, PodString* obj) {
+    return String(TRY(MkGcRoot(obj, arena)));
+  }
   static Result<String> create(Arena& arena, char32_t* chars, int64_t size) {
     auto pod_string = TRY(arena.alloc<PodString>(size * sizeof(char32_t)));
 
     memcpy(pod_string->data, chars, size * sizeof(char32_t));
 
-    return String(pod_string);
+    return String(TRY(MkGcRoot(pod_string, arena)));
   }
 
+  virtual Result<Value> copy(Arena& arena) final;
+
  private:
-  PodString* _value;
+  GcRoot<PodString> _value;
 };
 
 class Symbol : public Object {
  public:
-  Symbol() : _value(0) {}
-  Symbol(PodSymbol* val) : _value(val) {}
+  Symbol() {}
+  Symbol(GcRoot<PodSymbol>&& val) : _value(std::move(val)) {}
   virtual Tag tag() final { return Tag::Symbol; }
 
+  static Result<Symbol> create(Arena& arena, PodSymbol* obj) {
+    return Symbol(TRY(MkGcRoot(obj, arena)));
+  }
+
   static Result<Symbol> create(Arena& arena, char32_t* chars, int64_t size) {
     auto pod_symbol = TRY(arena.alloc<PodSymbol>(size * sizeof(char32_t)));
 
     memcpy(pod_symbol->data, chars, size * sizeof(char32_t));
 
-    return Symbol(pod_symbol);
+    return Symbol(TRY(MkGcRoot(pod_symbol, arena)));
   }
 
+  virtual Result<Value> copy(Arena& arena) final;
+
  private:
-  PodSymbol* _value;
+  GcRoot<PodSymbol> _value;
 };
 
 class Syntax : public Object {
  public:
-  Syntax(PodSyntax* val) : _value(val) {}
+  Syntax() {}
+  Syntax(GcRoot<PodSyntax>&& val) : _value(std::move(val)) {}
   Syntax(String filename, String modulename, Value expression);
   virtual Tag tag() final { return Tag::Syntax; }
 
+  static Result<Syntax> create(Arena& arena, PodSyntax* obj) {
+    return Syntax(TRY(MkGcRoot(obj, arena)));
+  }
+
   Value get_value();
 
+  virtual Result<Value> copy(Arena& arena) final;
+
  private:
-  PodSyntax* _value;
+  GcRoot<PodSyntax> _value;
 };
 
 class Pair : public Object {
  public:
-  Pair(PodPair* value) : _value(value) {}
+  Pair() {}
+  Pair(GcRoot<PodPair>&& val) : _value(std::move(val)) {}
   virtual Tag tag() final { return Tag::Pair; }
 
+  static Result<Pair> create(Arena& arena, PodPair* obj) {
+    return Pair(TRY(MkGcRoot(obj, arena)));
+  }
+
+  static Result<Value> first(Arena& arena);
+
+  virtual Result<Value> copy(Arena& arena) final;
+
  private:
-  PodPair* _value;
+  GcRoot<PodPair> _value;
 };
 
 class Int64 : public Object {
@@ -148,6 +177,8 @@ class Int64 : public Object {
 
   int64_t value() { return _value; }
 
+  virtual Result<Value> copy(Arena& arena) final;
+
  private:
   int64_t _value;
 };
@@ -155,12 +186,15 @@ class Int64 : public Object {
 class Float : public Object {
  public:
   Float() : _value(0) {}
+  Float(double val) : _value(val) {}
   virtual ~Float() = default;
 
   virtual Tag tag() final { return Tag::Float; }
 
   double value() { return _value; }
 
+  virtual Result<Value> copy(Arena& arena) final;
+
  private:
   double _value;
 };
@@ -170,12 +204,14 @@ class Value {
  public:
   Value() { new (buf) Nil(); }
   ~Value() { ((Object*)buf)->~Object(); }
+  Value(Value&& val) { memcpy(buf, val.buf, 24); }
+  Value(const Value&) = delete;
 
   template <class T>
-  Value(const T& obj)
-    requires std::derived_from<T, Object> && (sizeof(T) <= 16)
+  Value(T&& obj)
+    requires std::derived_from<T, Object>
   {
-    new (buf) T(obj);
+    new (buf) T(std::move(obj));
   }
 
   template <class T>
@@ -191,10 +227,12 @@ class Value {
   Object& operator*() { return *(Object*)(buf); }
   Object* operator->() { return (Object*)(buf); }
 
+  Result<Value> copy(Arena& arena) { return ((Object*)buf)->copy(arena); }
+
  private:
-  uint8_t buf[16];
+  uint8_t buf[24];
 };
 
 Value pod_to_value(PodObject* obj);
 
-Value syntax_unwrap(Value);
+Result<Value> syntax_unwrap(Value& val);