C backend: workaround bulk freeing of constants

compiler/scalc/from_lcalc.ml

@@ -685,7 +685,8 @@ let translate_program ~(config : translation_config) (p : 'm L.program) :
               in
               let func_id = A.FuncName.fresh (func_name, pos) in
               (* The list is being built in reverse order *)
-              (* FIXME: find a better way than a function with no parameters... *)
+              (* Note: this pattern is matched in the C backend to make
+                 allocations permanent. *)
               ( A.SVar
                   {
                     var = var_id;

compiler/scalc/to_c.ml

@@ -779,8 +779,14 @@ let format_program
                  Format.pp_print_space fmt ();
                  VarName.format fmt var))
             typ;
-          Format.fprintf ppc "@[<hov 2>return (%a ? %a : (%a = %a));@]"
-            VarName.format var VarName.format var VarName.format var
+          Format.fprintf ppc "@[<hov 2>return CATALA_GET_LAZY(%a, %a);@]"
+            (* This does (foo ? foo : foo = foo_init()), but enabling persistent
+               allocation around the init *)
+            (* FIXME: the proper solution would be to do a deep copy of the
+               allocated object from the Catala heap to the persistent heap
+               instead of switching allocation mode (which could persist
+               intermediate values) *)
+            VarName.format var
             (format_expression ctx env)
             expr;
           Format.fprintf ppc "@;<1 -2>}@]@,";

runtimes/c/runtime.c

@@ -26,6 +26,8 @@
 #include <dates_calc.h>
 #include "runtime.h"
 
+int catala_persistent_malloc_mode_on = 0;
+
 /* --- Error handling --- */
 
 const catala_code_position catala_empty_position =
@@ -41,6 +43,7 @@ void catala_error(catala_error_code code,
 {
   catala_error_raised.code = code;
   catala_error_raised.position = *pos;
+  catala_persistent_malloc_mode_on = 0;
   longjmp(catala_error_jump_buffer, 1);
 }
 
@@ -71,7 +74,9 @@ void* catala_malloc (size_t sz)
 {
   void* ptr = catala_heap.curptr;
   void* nextptr = ptr + sz;
-  if (nextptr < catala_heap.end) {
+  if (catala_persistent_malloc_mode_on) {
+    return malloc(sz);
+  } else if (nextptr < catala_heap.end) {
     catala_heap.curptr = nextptr;
     return ptr;
   } else {
@@ -100,7 +105,9 @@ void catala_free_all()
 
 void* catala_realloc(void* oldptr, size_t oldsize, size_t newsize)
 {
-  if (newsize <= oldsize) {
+  if (catala_persistent_malloc_mode_on) {
+    return realloc(oldptr, newsize);
+  } else if (newsize <= oldsize) {
     memset(oldptr + newsize, 0, oldsize - newsize);
     return oldptr;
   } else {
@@ -117,6 +124,14 @@ void catala_free(void* ptr, size_t sz)
 }
 #pragma GCC diagnostic pop
 
+void catala_set_persistent_malloc() {
+  catala_persistent_malloc_mode_on++;
+}
+void catala_unset_persistent_malloc() {
+  assert (catala_persistent_malloc_mode_on > 0);
+  catala_persistent_malloc_mode_on--;
+}
+
 /* --- Base types --- */
 
 const int catala_true_value = 1;

runtimes/c/runtime.h

@@ -60,6 +60,14 @@ void* catala_malloc (size_t sz);
 
 void catala_free_all();
 
+void catala_set_persistent_malloc();
+void catala_unset_persistent_malloc();
+/* These two functions can be used for switching an init section to persistent
+   malloc, then switching back to catala built-in malloc. In other words, any
+   calls to `catala_malloc` done between the two will not be affected by
+   `catala_free_all()`. Calls can be nested, but errors reset the context. */
+#define CATALA_GET_LAZY(X, X_INIT) (X ? X : (catala_set_persistent_malloc(), X = X_INIT, catala_unset_persistent_malloc(), X))
+
 /* --- Base types --- */
 
 #define CATALA_BOOL const int*