Fix exception handling

compiler/src/codegen/compcore.re

@@ -59,8 +59,6 @@ let runtime_heap_next_ptr_name =
   Ident.unique_name(Ident.create_persistent("runtimeHeapNextPtr"));
 let metadata_ptr_name =
   Ident.unique_name(Ident.create_persistent("metadataPtr"));
-let reloc_base_name =
-  Ident.unique_name(Ident.create_persistent("relocBase"));
 
 /* Memory allocation */
 let malloc_name = Ident.unique_name(Ident.create_persistent("malloc"));
@@ -658,8 +656,9 @@ let heap_allocate = (wasm_mod, env, num_words: int) =>
                   runtime_heap_next_ptr_name,
                   Type.int32,
                 ),
-                // fake GC refcount of 1
-                Expression.Const.make(wasm_mod, const_int32(1)),
+                // fake GC refcount of 2
+                // this means objects (should) never drop to zero refcount
+                Expression.Const.make(wasm_mod, const_int32(2)),
               ),
               Expression.Binary.make(
                 wasm_mod,
@@ -1158,15 +1157,19 @@ let compile_record_op = (wasm_mod, env, rec_imm, op) => {
 let compile_closure_op = (wasm_mod, env, closure_imm, op) => {
   let closure = () => compile_imm(wasm_mod, env, closure_imm);
   switch (op) {
-  | MClosureSetPtr(idx) =>
+  | MClosureSetPtr(global_offset, idx) =>
     store(
       ~offset=8,
       wasm_mod,
       closure(),
       Expression.Binary.make(
         wasm_mod,
         Op.add_int32,
-        Expression.Global_get.make(wasm_mod, reloc_base_name, Type.int32),
+        Expression.Global_get.make(
+          wasm_mod,
+          linked_name(~env, global_offset),
+          Type.int32,
+        ),
         Expression.Const.make(wasm_mod, wrap_int32(idx)),
       ),
     )

compiler/src/codegen/mashtree.re

@@ -424,7 +424,7 @@ type record_op =
 
 [@deriving sexp]
 type closure_op =
-  | MClosureSetPtr(int32);
+  | MClosureSetPtr(string, int32);
 
 [@deriving sexp]
 type instr = {

compiler/src/codegen/transl_anf.re

@@ -765,7 +765,10 @@ let lift_imports = (env, imports) => {
                   {
                     instr_desc:
                       MClosureOp(
-                        MClosureSetPtr(Int32.of_int(idx)),
+                        MClosureSetPtr(
+                          get_function_table_global_name(),
+                          Int32.of_int(idx),
+                        ),
                         imm(
                           MImmBinding(
                             MGlobalBind(

compiler/src/compile.re

@@ -149,6 +149,7 @@ let next_state = (~is_root_file=false, {cstate_desc, cstate_filename} as cs) =>
       Grain_utils.Config.apply_attribute_flags(
         ~no_pervasives=has_attr("noPervasives"),
         ~runtime_mode=has_attr("runtimeMode"),
+        ~no_exception_mod=has_attr("exceptionMod"),
       );
 
       Well_formedness.check_well_formedness(p);

compiler/src/parsing/driver.re

@@ -161,6 +161,7 @@ let read_imports = (program: Parsetree.parsed_program) => {
       Grain_utils.Config.with_attribute_flags(
         ~no_pervasives=module_has_attr("noPervasives"),
         ~runtime_mode=module_has_attr("runtimeMode"),
+        ~no_exception_mod=module_has_attr("exceptionMod"),
         Grain_utils.Config.get_implicit_opens,
       ),
     );

compiler/src/parsing/well_formedness.re

@@ -402,6 +402,7 @@ let disallowed_attributes = (errs, super) => {
     let known_module_attributes = [
       {name: "runtimeMode", arity: 0},
       {name: "noPervasives", arity: 0},
+      {name: "exceptionMod", arity: 0},
     ];
     validate_against_known(attributes, known_module_attributes, "module");
     super.enter_parsed_program(prog);

compiler/src/utils/config.re

@@ -411,6 +411,8 @@ type compilation_mode =
 
 let compilation_mode = internal_opt(Normal, NotDigestible);
 
+let no_exception_mod = internal_opt(false, NotDigestible);
+
 let statically_link =
   toggle_flag(
     ~names=["no-link"],
@@ -566,7 +568,8 @@ let module_search_path = () => {
   };
 };
 
-let apply_attribute_flags = (~no_pervasives as np, ~runtime_mode as rm) => {
+let apply_attribute_flags =
+    (~no_pervasives as np, ~runtime_mode as rm, ~no_exception_mod as ne) => {
   // Only apply options if attributes were explicitly given so as to not
   // unintentionally override options set previously e.g. compiling a
   // wasi-polyfill file in non-runtime-mode if @runtimeMode is not specified
@@ -576,11 +579,15 @@ let apply_attribute_flags = (~no_pervasives as np, ~runtime_mode as rm) => {
   if (rm) {
     compilation_mode := Runtime;
   };
+  if (ne) {
+    no_exception_mod := true;
+  };
 };
 
-let with_attribute_flags = (~no_pervasives, ~runtime_mode, thunk) => {
+let with_attribute_flags =
+    (~no_pervasives, ~runtime_mode, ~no_exception_mod, thunk) => {
   preserve_config(() => {
-    apply_attribute_flags(~no_pervasives, ~runtime_mode);
+    apply_attribute_flags(~no_pervasives, ~runtime_mode, ~no_exception_mod);
     thunk();
   });
 };
@@ -611,11 +618,13 @@ let get_implicit_opens = () => {
   if (compilation_mode^ == Runtime) {
     [];
   } else {
+    let ret =
+      if (no_exception_mod^) {
+        ret;
+      } else {
+        [Exception_mod, ...ret];
+      };
     // Pervasives goes first, just for good measure.
-    List.rev([
-      Gc_mod,
-      Exception_mod,
-      ...ret,
-    ]);
+    List.rev([Gc_mod, ...ret]);
   };
 };

compiler/src/utils/config.rei

@@ -184,10 +184,17 @@ let with_cli_options: 'a => Cmdliner.Term.t('a);
 
 /** Applies compile flags provided as module attributes */
 
-let apply_attribute_flags: (~no_pervasives: bool, ~runtime_mode: bool) => unit;
+let apply_attribute_flags:
+  (~no_pervasives: bool, ~runtime_mode: bool, ~no_exception_mod: bool) => unit;
 
 let with_attribute_flags:
-  (~no_pervasives: bool, ~runtime_mode: bool, unit => 'a) => 'a;
+  (
+    ~no_pervasives: bool,
+    ~runtime_mode: bool,
+    ~no_exception_mod: bool,
+    unit => 'a
+  ) =>
+  'a;
 
 type implicit_opens =
   | Pervasives_mod

compiler/test/suites/basic_functionality.re

@@ -377,6 +377,6 @@ describe("basic functionality", ({test, testSkip}) => {
     ~config_fn=smallestFileConfig,
     "smallest_grain_program",
     "",
-    6829,
+    6417,
   );
 });

stdlib/exception.gr

@@ -12,8 +12,6 @@
  */
 module Exception
 
-from "runtime/unsafe/wasmi32" include WasmI32
-from "runtime/unsafe/memory" include Memory
 from "runtime/exception" include Exception
 
 /**

stdlib/runtime/exception.gr

@@ -1,4 +1,5 @@
 @noPervasives
+@exceptionMod
 module Exception
 
 from "runtime/unsafe/panic" include Panic