New --free-all option for freeing memory on exit.

Although we are garbage-collected, being able to clean up on
shutdown is nevertheless useful for uncovering leaks. Leaks
can occur, for instance, due to neglect to free out-of-heap
satellite data from objects that are reclaimed by gc.
This feature is long overdue.

* arith.c, arith.h (arith_free_all): New function.

* gc.c, gc.h (gc_free_all): New function.

* lib.c (init): Remove program name parameter and
redundant initialization of progname globl variable.

* lib.h (progname): Superfluous declaration removed.
This is already declared in txr.h.
(init): Declaration updated.

* regex.c (char_set_destroy): Do not check the static
allocation flag here; just destroy the object.
Do check for a null pointer, though.
(char_set_cobj_destroy): This cobj destructor now
checks the static flag of the char set object and
avoids freeing it. Thus our char set singletons are
left alone by gc, but our global freeing function
takes care of them.
(wide_cs): New static variable moved out of
wide_display_char_p to static scope.
(regex_free_all): New function.

* regex.h (regex_free_all): Declared.

* txr.c (progname): const qualifier and initializer removed.
(main): Ensure progname is always dynamically allocated, even
in the argv[0] == 0 case. Do not pass progname to init;
it doesn't take that argument any more.
(free_all): New static function.
(txr_main): Implement --free-all option.

* txr.h (progname): Declaration updated.

10 files changed, 88 insertions, 14 deletions

diff --git a/arith.c b/arith.c
index 69cd2962..33942c35 100644
--- a/arith.c
+++ b/arith.c
@@ -2369,3 +2369,10 @@ void arith_init(void)
   reg_varl(intern(lit("*e*"), user_package), flo(M_E));
   reg_varl(intern(lit("%e%"), user_package), flo(M_E));
 }
+
+void arith_free_all(void)
+{
+  mp_clear(&NUM_MAX_MP);
+  mp_clear(&INT_PTR_MAX_MP);
+  mp_clear(&UINT_PTR_MAX_MP);
+}
diff --git a/arith.h b/arith.h
index bc3a0568..4e1bf5d2 100644
--- a/arith.h
+++ b/arith.h
@@ -41,3 +41,4 @@ val tofloat(val obj);
 val toint(val obj, val base);
 val width(val num);
 void arith_init(void);
+void arith_free_all(void);
diff --git a/gc.c b/gc.c
index b515842d..44ec51a9 100644
--- a/gc.c
+++ b/gc.c
@@ -936,3 +936,43 @@ void gc_report_copies(val *pvar)
              convert(int, pvar - opvar));
   }
 }
+
+void gc_free_all(void)
+{
+  {
+    heap_t *iter = heap_list;
+
+    while (iter) {
+      heap_t *next = iter->next;
+      obj_t *block, *end;
+
+#if HAVE_VALGRIND
+      if (opt_vg_debug)
+        VALGRIND_MAKE_MEM_DEFINED(&next->block, sizeof next->block);
+#endif
+
+      for (block = iter->block, end = iter->block + HEAP_SIZE;
+           block < end;
+           block++)
+      {
+        type_t t = block->t.type;
+        if ((t & FREE) != 0)
+          continue;
+        finalize(block);
+      }
+
+      free(iter);
+      iter = next;
+    }
+  }
+
+  {
+    struct fin_reg *iter = final_list;
+
+    while (iter) {
+      struct fin_reg *next = iter->next;
+      free(iter);
+      iter = next;
+    }
+  }
+}
diff --git a/gc.h b/gc.h
index a879ad6a..27c534f9 100644
--- a/gc.h
+++ b/gc.h
@@ -48,6 +48,7 @@ extern int full_gc;
 void unmark(void);
 void gc_hint_func(val *);
 void gc_report_copies(val *pvar);
+void gc_free_all(void);
 
 extern int gc_enabled;
 extern val **gc_prot_top;
diff --git a/lib.c b/lib.c
index 89782b25..0b51c05f 100644
--- a/lib.c
+++ b/lib.c
@@ -9407,11 +9407,9 @@ static void time_init(void)
   static_slot_set(time_st, time_utc_s, func_f1(t, time_meth));
 }
 
-void init(const wchar_t *pn, mem_t *(*oom)(mem_t *, size_t),
-          val *stack_bottom)
+void init(mem_t *(*oom)(mem_t *, size_t), val *stack_bottom)
 {
   int gc_save;
-  progname = pn;
   gc_save = gc_state(0);
 
   oom_realloc = oom;
diff --git a/lib.h b/lib.h
index 8ead64fb..e8e6d4cd 100644
--- a/lib.h
+++ b/lib.h
@@ -449,7 +449,6 @@ extern val null_list; /* (nil) */
 extern val identity_f, equal_f, eql_f, eq_f, car_f, cdr_f, null_f;
 extern val list_f, less_f, greater_f;
 
-extern const wchar_t *progname;
 extern val prog_string;
 
 extern mem_t *(*oom_realloc)(mem_t *, size_t);
@@ -992,8 +991,7 @@ val make_time_utc(val year, val month, val day,
                   val hour, val minute, val second,
                   val isdst);
 
-void init(const wchar_t *progname, mem_t *(*oom_realloc)(mem_t *, size_t),
-          val *stack_bottom);
+void init(mem_t *(*oom_realloc)(mem_t *, size_t), val *stack_bottom);
 int compat_fixup(int compat_ver);
 void dump(val obj, val stream);
 void d(val obj);
diff --git a/regex.c b/regex.c
index 4ad34dcf..e6bdf7d6 100644
--- a/regex.c
+++ b/regex.c
@@ -544,7 +544,7 @@ static char_set_t *char_set_create(chset_type_t type, wchar_t base, unsigned st)
 
 static void char_set_destroy(char_set_t *set)
 {
-  if (set->any.stat)
+  if (!set)
     return;
 
   switch (set->any.type) {
@@ -794,7 +794,8 @@ static void init_special_char_sets(void)
 static void char_set_cobj_destroy(val chset)
 {
   char_set_t *set = coerce(char_set_t *, chset->co.handle);
-  char_set_destroy(set);
+  if (!set->any.stat)
+    char_set_destroy(set);
   chset->co.handle = 0;
 }
 
@@ -2648,10 +2649,10 @@ static char_set_t *create_wide_cs(void)
   return cs;
 }
 
+static char_set_t *wide_cs;
+
 int wide_display_char_p(wchar_t ch)
 {
-  static char_set_t *wide_cs;
-
   if (ch < 0x1100)
     return 0;
 
@@ -2679,3 +2680,14 @@ void regex_init(void)
   reg_fun(intern(lit("read-until-match"), user_package), func_n3o(read_until_match, 1));
   init_special_char_sets();
 }
+
+void regex_free_all(void)
+{
+  char_set_destroy(space_cs);
+  char_set_destroy(digit_cs);
+  char_set_destroy(word_cs);
+  char_set_destroy(cspace_cs);
+  char_set_destroy(cdigit_cs);
+  char_set_destroy(cword_cs);
+  char_set_destroy(wide_cs);
+}
diff --git a/regex.h b/regex.h
index 75bad120..599e985e 100644
--- a/regex.h
+++ b/regex.h
@@ -42,3 +42,4 @@ val regsub(val regex, val repl, val str);
 val read_until_match(val regex, val stream, val keep_match);
 int wide_display_char_p(wchar_t ch);
 void regex_init(void);
+void regex_free_all(void);
diff --git a/txr.c b/txr.c
index 56d67771..ad6f834d 100644
--- a/txr.c
+++ b/txr.c
@@ -56,7 +56,7 @@
 #include "txr.h"
 
 const wchli_t *version = wli(TXR_VER);
-const wchar_t *progname = L"txr";
+wchar_t *progname;
 static const char *progname_u8;
 static val prog_path = nil, sysroot_path = nil;
 int opt_noninteractive;
@@ -372,9 +372,9 @@ int main(int argc, char **argv)
 {
   val stack_bottom = nil;
   repress_privilege();
-  progname = argv[0] ? utf8_dup_from(argv[0]) : progname;
+  progname = utf8_dup_from(argv[0] ? argv[0]: "txr");
   progname_u8 = argv[0];
-  init(progname, oom_realloc_handler, &stack_bottom);
+  init(oom_realloc_handler, &stack_bottom);
   match_init();
   debug_init();
   sysroot_init();
@@ -436,6 +436,19 @@ static int gc_delta(val optval)
   return 1;
 }
 
+static void free_all(void)
+{
+  static int called;
+
+  if (!called) {
+    called = 1;
+    regex_free_all();
+    gc_free_all();
+    arith_free_all();
+    free(progname);
+  }
+}
+
 #ifndef CONFIG_DEBUG_SUPPORT
 static void no_dbg_support(val arg)
 {
@@ -688,6 +701,9 @@ int txr_main(int argc, char **argv)
         opt_noninteractive = 1;
         stream_set_prop(std_input, real_time_k, nil);
         continue;
+      } else if (equal(opt, lit("free-all"))) {
+        atexit(free_all);
+        continue;
       } else {
         drop_privilege();
         format(std_error, lit("~a: unrecognized long option: --~a\n"),
diff --git a/txr.h b/txr.h
index 42908e23..15cf47cd 100644
--- a/txr.h
+++ b/txr.h
@@ -40,5 +40,5 @@ extern int opt_dbg_autoload;
 extern int opt_dbg_expansion;
 extern alloc_bytes_t opt_gc_delta;
 extern const wchli_t *version;
-extern const wchar_t *progname;
+extern wchar_t *progname;
 extern val stdlib_path;