Add tc7 for finalizer objects

Whippet will need this.

* libguile/scm.h (scm_tc7_finalizer): Reserve.
* libguile/evalext.c (scm_self_evaluating_p): Add finalizer case.
* libguile/print.c (iprin1):
* libguile/finalizers.h:
* libguile/finalizers.c (scm_i_print_finalizer): Arrange to print
finalizers.
* module/oop/goops.scm (<finalizer>):
* libguile/goops.c (class_finalizer, scm_class_of)
(scm_sys_goops_early_init): Wire up support for <finalizer>.
* module/system/base/types/internal.scm (heap-tags): Add finalizers.
* module/system/vm/assembler.scm (system): Add emit-finalizer?.

libguile/evalext.c

@@ -95,6 +95,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 	case scm_tc7_bytevector:
 	case scm_tc7_array:
 	case scm_tc7_bitvector:
+	case scm_tc7_finalizer:
 	case scm_tc7_thread:
 	case scm_tcs_struct:
 	  return SCM_BOOL_T;

libguile/finalizers.c

@@ -40,6 +40,7 @@
 #include "gsubr.h"
 #include "init.h"
 #include "numbers.h"
+#include "ports.h"
 #include "struct.h"
 #include "smob.h"
 #include "threads.h"
@@ -459,6 +460,15 @@ scm_set_automatic_finalization_enabled (int enabled_p)
   return was_enabled_p;
 }
 
+int
+scm_i_print_finalizer (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
+{
+  scm_puts ("#<finalizer ", port);
+  scm_uintprint (SCM_UNPACK (exp), 16, port);
+  scm_puts (")>", port);
+  return 1;
+}
+
 int
 scm_run_finalizers (void)
 {

libguile/finalizers.h

@@ -48,6 +48,8 @@ SCM_INTERNAL int scm_i_is_finalizer_thread (struct scm_thread *thread);
 SCM_API int scm_set_automatic_finalization_enabled (int enabled_p);
 SCM_API int scm_run_finalizers (void);
 
+SCM_INTERNAL int scm_i_print_finalizer (SCM exp, SCM port,
+                                        scm_print_state *pstate SCM_UNUSED);
 SCM_INTERNAL void scm_register_finalizers (void);
 SCM_INTERNAL void scm_init_finalizers (void);
 SCM_INTERNAL void scm_init_finalizer_thread (void);

libguile/goops.c

@@ -134,6 +134,7 @@ static SCM class_uvec;
 static SCM class_array;
 static SCM class_thread;
 static SCM class_bitvector;
+static SCM class_finalizer;
 
 static SCM vtable_class_map = SCM_BOOL_F;
 
@@ -257,6 +258,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
           return class_array;
 	case scm_tc7_bitvector:
           return class_bitvector;
+	case scm_tc7_finalizer:
+          return class_finalizer;
 	case scm_tc7_thread:
           return class_thread;
 	case scm_tc7_string:
@@ -940,6 +943,7 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
   class_array = scm_variable_ref (scm_c_lookup ("<array>"));
   class_thread = scm_variable_ref (scm_c_lookup ("<thread>"));
   class_bitvector = scm_variable_ref (scm_c_lookup ("<bitvector>"));
+  class_finalizer = scm_variable_ref (scm_c_lookup ("<finalizer>"));
   class_number = scm_variable_ref (scm_c_lookup ("<number>"));
   class_complex = scm_variable_ref (scm_c_lookup ("<complex>"));
   class_real = scm_variable_ref (scm_c_lookup ("<real>"));

libguile/print.c

@@ -39,6 +39,7 @@
 #include "continuations.h"
 #include "control.h"
 #include "eval.h"
+#include "finalizers.h"
 #include "fluids.h"
 #include "foreign.h"
 #include "frames.h"
@@ -760,6 +761,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	case scm_tc7_bitvector:
 	  scm_i_print_bitvector (exp, port, pstate);
 	  break;
+	case scm_tc7_finalizer:
+	  scm_i_print_finalizer (exp, port, pstate);
+	  break;
 	case scm_tc7_thread:
 	  scm_i_print_thread (exp, port, pstate);
 	  break;

libguile/scm.h

@@ -498,7 +498,7 @@ typedef uintptr_t scm_t_bits;
 #define scm_tc7_weak_table	0x57
 #define scm_tc7_array		0x5d
 #define scm_tc7_bitvector	0x5f
-#define scm_tc7_unused_65	0x65
+#define scm_tc7_finalizer	0x65
 #define scm_tc7_unused_67	0x67
 #define scm_tc7_unused_6d	0x6d
 #define scm_tc7_unused_6f	0x6f

module/oop/goops.scm

@@ -69,7 +69,8 @@
             <boolean> <char> <list> <pair> <null> <string> <symbol>
             <vector> <bytevector> <uvec> <foreign> <hashtable>
             <fluid> <dynamic-state> <frame> <vm> <vm-continuation>
-            <keyword> <syntax> <atomic-box> <thread>
+            <keyword> <syntax> <atomic-box> <thread> <bitvector>
+            <finalizer>
 
             ;; Numbers.
             <number> <complex> <real> <integer> <fraction>
@@ -82,7 +83,7 @@
             ;; once you have an instance.  Perhaps FIXME to provide a
             ;; smob-type-name->class procedure.
             <promise> <mutex> <condition-variable>
-            <regexp> <hook> <bitvector> <random-state>
+            <regexp> <hook> <random-state>
             <directory> <array> <character-set>
             <dynamic-object> <guardian> <macro>
 
@@ -1078,6 +1079,7 @@ slots as we go."
 (define-standard-class <uvec> (<bytevector>))
 (define-standard-class <array> (<top>))
 (define-standard-class <bitvector> (<top>))
+(define-standard-class <finalizer> (<top>))
 (define-standard-class <thread> (<top>))
 (define-standard-class <number> (<top>))
 (define-standard-class <complex> (<number>))

module/system/base/types/internal.scm

@@ -153,7 +153,7 @@
   (weak-table       weak-table?            #b1111111       #b1010111)
   (array            array?                 #b1111111       #b1011101)
   (bitvector        bitvector?             #b1111111       #b1011111)
-  ;;(unused         unused                 #b1111111       #b1100101)
+  (finalizer        finalizer?             #b1111111       #b1100101)
   ;;(unused         unused                 #b1111111       #b1100111)
   ;;(unused         unused                 #b1111111       #b1101101)
   ;;(unused         unused                 #b1111111       #b1101111)

module/system/vm/assembler.scm

@@ -137,6 +137,7 @@
             emit-weak-table?
             emit-array?
             emit-bitvector?
+            emit-finalizer?
             emit-port?
             emit-smob?
             emit-bignum?