mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-02 15:40:38 +02:00
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.
This commit is contained in:
Andy Wingo
parent
63317ff480
commit
ccaff3da39
7 changed files with 57 additions and 45 deletions
|
|
@ -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 ();
|
||||
|
|
|
|||
|
|
@ -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 ();
|
||||
|
|
|
|||
|
|
@ -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 ();
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
#define SCM_RSTATEP(obj) SCM_SMOB_PREDICATE (scm_tc16_rstate, obj)
|
||||
#define SCM_RSTATE(obj) ((scm_t_rstate *) SCM_SMOB_DATA (obj))
|
||||
static inline int
|
||||
scm_is_random_state (SCM x)
|
||||
{
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
*/
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
;; corresponding classes, which may be obtained via class-of,
|
||||
;; once you have an instance. Perhaps FIXME to provide a
|
||||
;; smob-type-name->class procedure.
|
||||
<promise>
|
||||
<regexp> <random-state>
|
||||
<directory> <array>
|
||||
<dynamic-object> <macro>
|
||||
;; Particular SMOB or record data types. All SMOB types
|
||||
;; have corresponding classes, which may be obtained via
|
||||
;; class-of, once you have an instance. Perhaps FIXME to
|
||||
;; provide a smob-type-name->class procedure.
|
||||
<regexp>
|
||||
<dynamic-object>
|
||||
|
||||
;; 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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue