Allocate a static tc16 for random states

* libguile/random.h (scm_t_rstate): Put a tag word in the beginning.
(scm_is_random_state, scm_to_random_state, scm_from_random_state): New
helpers.
(SCM_RSTATEP, SCM_RSTATE): Use the new helpers.
(scm_masktab): Make private.
* libguile/random.c: Adapt random states to not be a smob.
* libguile/eq.c:
* libguile/print.c:
* libguile/scm.h:
* module/oop/goops.scm: Add new random-state cases.  Fix a number of
classes for other types that were recently changed to not be smobs.

libguile/eq.c

@@ -393,6 +393,7 @@ scm_equal_p (SCM x, SCM y)
         case scm_tc16_continuation:
         case scm_tc16_directory:
         case scm_tc16_syntax_transformer:
+        case scm_tc16_random_state:
           return SCM_BOOL_F;
         default:
           abort ();

libguile/goops.c

@@ -142,6 +142,8 @@ static SCM class_condition_variable;
 static SCM class_mutex;
 static SCM class_continuation;
 static SCM class_directory;
+static SCM class_macro;
+static SCM class_random_state;
 
 static struct scm_ephemeron_table *vtable_class_map;
 static SCM pre_goops_vtables = SCM_EOL;
@@ -352,7 +354,9 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
               case scm_tc16_directory:
                 return class_directory;
               case scm_tc16_syntax_transformer:
-                return class_unknown;
+                return class_macro;
+              case scm_tc16_random_state:
+                return class_random_state;
               default:
                 abort ();
               }
@@ -992,6 +996,8 @@ SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
   class_mutex = scm_variable_ref (scm_c_lookup ("<mutex>"));
   class_continuation = scm_variable_ref (scm_c_lookup ("<continuation>"));
   class_directory = scm_variable_ref (scm_c_lookup ("<directory>"));
+  class_macro = scm_variable_ref (scm_c_lookup ("<macro>"));
+  class_random_state = scm_variable_ref (scm_c_lookup ("<random-state>"));
 
   create_smob_classes ();
   create_struct_classes ();

libguile/print.c

@@ -755,6 +755,11 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
               case scm_tc16_syntax_transformer:
                 scm_i_print_syntax_transformer (exp, port, pstate);
                 break;
+              case scm_tc16_random_state:
+                scm_puts ("#<random-state ", port);
+                scm_uintprint (SCM_UNPACK (exp), 16, port);
+                scm_putc ('>', port);
+                break;
               default:
                 abort ();
             }

libguile/random.c

@@ -46,7 +46,6 @@
 #include "numbers.h"
 #include "numbers.h"
 #include "pairs.h"
-#include "smob.h"
 #include "srfi-4.h"
 #include "stime.h"
 #include "strings.h"
@@ -185,6 +184,7 @@ scm_c_make_rstate (const char *seed, int n)
 
   state = scm_gc_malloc_pointerless (scm_the_rng.rstate_size,
 				     "random-state");
+  state->tag = scm_tc16_random_state;
   state->rng = &scm_the_rng;
   state->normal_next = 0.0;
   state->rng->init_rstate (state, seed, n);
@@ -198,6 +198,7 @@ scm_c_rstate_from_datum (SCM datum)
 
   state = scm_gc_malloc_pointerless (scm_the_rng.rstate_size,
 				     "random-state");
+  state->tag = scm_tc16_random_state;
   state->rng = &scm_the_rng;
   state->normal_next = 0.0;
   state->rng->from_datum (state, datum);
@@ -255,7 +256,7 @@ scm_c_exp1 (scm_t_rstate *state)
   return - log (scm_c_uniform01 (state));
 }
 
-unsigned char scm_masktab[256];
+static unsigned char scm_masktab[256];
 
 static inline uint32_t
 scm_i_mask32 (uint32_t m)
@@ -371,19 +372,6 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
   return ret;
 }
 
-/*
- * Scheme level representation of random states.
- */
- 
-scm_t_bits scm_tc16_rstate;
-
-static SCM
-make_rstate (scm_t_rstate *state)
-{
-  SCM_RETURN_NEWSMOB (scm_tc16_rstate, state);
-}
-
-
 /*
  * Scheme level interface.
  */
@@ -444,7 +432,8 @@ SCM_DEFINE (scm_copy_random_state, "copy-random-state", 0, 1, 0,
   if (SCM_UNBNDP (state))
     state = SCM_VARIABLE_REF (scm_var_random_state);
   SCM_VALIDATE_RSTATE (1, state);
-  return make_rstate (SCM_RSTATE (state)->rng->copy_rstate (SCM_RSTATE (state)));
+  return scm_from_random_state
+    (SCM_RSTATE (state)->rng->copy_rstate (SCM_RSTATE (state)));
 }
 #undef FUNC_NAME
 
@@ -478,7 +467,7 @@ SCM_DEFINE (scm_seed_to_random_state, "seed->random-state", 1, 0, 0,
       SCM_OUT_OF_RANGE (1, seed);
     }
 
-  res = make_rstate (scm_c_make_rstate (c_str, len));
+  res = scm_from_random_state (scm_c_make_rstate (c_str, len));
   free (c_str);
 
   scm_remember_upto_here_1 (seed);
@@ -493,7 +482,7 @@ SCM_DEFINE (scm_datum_to_random_state, "datum->random-state", 1, 0, 0,
             "been obtained from @code{random-state->datum}.")
 #define FUNC_NAME s_scm_datum_to_random_state
 {
-  return make_rstate (scm_c_rstate_from_datum (datum));
+  return scm_from_random_state (scm_c_rstate_from_datum (datum));
 }
 #undef FUNC_NAME
 
@@ -759,7 +748,7 @@ random_state_of_last_resort (void)
         buf[i] = scm_to_int (scm_logand (seed, SCM_I_MAKINUM (255)));
         seed = scm_ash (seed, SCM_I_MAKINUM (-8));
       }
-    state = make_rstate (scm_c_make_rstate ((char *) buf, len));
+    state = scm_from_random_state (scm_c_make_rstate ((char *) buf, len));
     free (buf);
   }
   return state;
@@ -807,7 +796,7 @@ source of entropy, appropriate for use in non-security-critical applications.")
 {
   unsigned char buf[32];
   if (read_dev_urandom (buf, sizeof(buf)))
-    return make_rstate (scm_c_make_rstate ((char *) buf, sizeof(buf)));
+    return scm_from_random_state (scm_c_make_rstate ((char *) buf, sizeof(buf)));
   else
     return random_state_of_last_resort ();
 }
@@ -829,8 +818,6 @@ scm_init_random ()
   };
   scm_the_rng = rng;
 
-  scm_tc16_rstate = scm_make_smob_type ("random-state", 0);
-
   for (m = 1; m <= 0x100; m <<= 1)
     for (i = m >> 1; i < m; ++i)
       scm_masktab[i] = m - 1;

libguile/random.h

@@ -1,7 +1,7 @@
 #ifndef SCM_RANDOM_H
 #define SCM_RANDOM_H
 
-/* Copyright 1999-2001,2006,2008,2010,2018
+/* Copyright 1999-2001,2006,2008,2010,2018,2025
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -38,6 +38,7 @@
  */
 
 typedef struct scm_t_rstate {
+  scm_t_bits tag;
   struct scm_t_rng *rng;
   double normal_next; /* For scm_c_normal01 */
   /* Custom fields follow here */
@@ -73,15 +74,32 @@ SCM_API SCM scm_c_random_bignum (scm_t_rstate *, SCM m);
 /*
  * Scheme level interface
  */
-SCM_API scm_t_bits scm_tc16_rstate;
+static inline int
-#define SCM_RSTATEP(obj) SCM_SMOB_PREDICATE (scm_tc16_rstate, obj)
+scm_is_random_state (SCM x)
-#define SCM_RSTATE(obj)  ((scm_t_rstate *) SCM_SMOB_DATA (obj))
+{
+  return SCM_HAS_TYP16 (x, scm_tc16_random_state);
+}
+
+static inline struct scm_t_rstate *
+scm_to_random_state (SCM x)
+{
+  if (!scm_is_random_state (x))
+    abort ();
+  return (struct scm_t_rstate *) SCM_UNPACK_POINTER (x);
+}
+
+static inline SCM
+scm_from_random_state (struct scm_t_rstate *x)
+{
+  return SCM_PACK_POINTER (x);
+}
+
+#define SCM_RSTATEP(obj) scm_is_random_state (obj)
+#define SCM_RSTATE(obj)  scm_to_random_state (obj)
 
 #define SCM_VALIDATE_RSTATE(pos, v) \
   SCM_MAKE_VALIDATE_MSG (pos, v, RSTATEP, "random-generator-state")
 
-SCM_API unsigned char scm_masktab[256];
-
 SCM_API SCM scm_var_random_state;
 SCM_API SCM scm_random (SCM n, SCM state);
 SCM_API SCM scm_copy_random_state (SCM state);

libguile/scm.h

@@ -514,9 +514,8 @@ typedef uintptr_t scm_t_bits;
 #define scm_tc16_continuation		0x037f
 #define scm_tc16_directory		0x047f
 #define scm_tc16_syntax_transformer	0x057f
+#define scm_tc16_random_state		0x067f
 /*
-#define scm_tc16_promise		0x0e7f
-#define scm_tc16_random_state		0x0f7f
 #define scm_tc16_regexp			0x107f
 */
 

module/oop/goops.scm

@@ -71,7 +71,8 @@
             <fluid> <dynamic-state> <frame> <vm> <vm-continuation>
             <keyword> <syntax> <atomic-box> <thread> <bitvector>
             <finalizer> <ephemeron> <ephemeron-table> <character-set>
-            <mutex> <condition-variable> <continuation>
+            <mutex> <condition-variable> <continuation> <directory>
+            <array> <random-state>
 
             ;; Numbers.
             <number> <complex> <real> <integer> <fraction>
@@ -79,14 +80,12 @@
             ;; Unknown.
             <unknown>
 
-            ;; Particular SMOB data types.  All SMOB types have
+            ;; Particular SMOB or record data types.  All SMOB types
-            ;; corresponding classes, which may be obtained via class-of,
+            ;; have corresponding classes, which may be obtained via
-            ;; once you have an instance.  Perhaps FIXME to provide a
+            ;; class-of, once you have an instance.  Perhaps FIXME to
-            ;; smob-type-name->class procedure.
+            ;; provide a smob-type-name->class procedure.
-            <promise>
+            <regexp>
-            <regexp> <random-state>
+            <dynamic-object> 
-            <directory> <array>
-            <dynamic-object> <macro>
 
             ;; Modules.
             <module>
@@ -1088,6 +1087,8 @@ slots as we go."
 (define-standard-class <mutex> (<top>))
 (define-standard-class <continuation> (<top>))
 (define-standard-class <directory> (<top>))
+(define-standard-class <macro> (<top>))
+(define-standard-class <random-state> (<top>))
 (define-standard-class <thread> (<top>))
 (define-standard-class <number> (<top>))
 (define-standard-class <complex> (<number>))
@@ -3535,12 +3536,7 @@ var{initargs}."
 ;;; {SMOB and port classes}
 ;;;
 
-(define <promise> (find-subclass <top> '<promise>))
 (define <regexp> (find-subclass <top> '<regexp>))
-(define <bitvector> (find-subclass <top> '<bitvector>))
-(define <random-state> (find-subclass <top> '<random-state>))
-(define <array> (find-subclass <top> '<array>))
-(define <macro> (find-subclass <top> '<macro>))
 
 ;; <dynamic-object> used to be a SMOB type, albeit not exported even to
 ;; C.  However now it's a record type, though still private.  Cross our