mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-16 08:40:19 +02:00
Replaced SCM_NEWCELL and SCM_NEWCELL2 with scm_alloc_cell and
scm_alloc_double_cell, respectively.
This commit is contained in:
parent
d3c0e81cc8
commit
16d4699b6b
28 changed files with 83 additions and 204 deletions
|
@ -58,18 +58,9 @@ SCM_DEFINE (scm_acons, "acons", 3, 0, 0,
|
||||||
"function is @emph{not} destructive; @var{alist} is not modified.")
|
"function is @emph{not} destructive; @var{alist} is not modified.")
|
||||||
#define FUNC_NAME s_scm_acons
|
#define FUNC_NAME s_scm_acons
|
||||||
{
|
{
|
||||||
SCM pair;
|
return scm_alloc_cell (SCM_UNPACK (scm_alloc_cell (SCM_UNPACK (key),
|
||||||
SCM head;
|
SCM_UNPACK (value))),
|
||||||
|
SCM_UNPACK (alist));
|
||||||
SCM_NEWCELL (pair);
|
|
||||||
SCM_SET_CELL_OBJECT_0 (pair, key);
|
|
||||||
SCM_SET_CELL_OBJECT_1 (pair, value);
|
|
||||||
|
|
||||||
SCM_NEWCELL (head);
|
|
||||||
SCM_SET_CELL_OBJECT_0 (head, pair);
|
|
||||||
SCM_SET_CELL_OBJECT_1 (head, alist);
|
|
||||||
|
|
||||||
return head;
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -257,9 +257,8 @@ scm_call_with_new_thread (SCM argl)
|
||||||
/* Allocate thread locals. */
|
/* Allocate thread locals. */
|
||||||
root = scm_make_root (scm_root->handle);
|
root = scm_make_root (scm_root->handle);
|
||||||
/* Make thread. */
|
/* Make thread. */
|
||||||
SCM_NEWCELL (thread);
|
thread = scm_alloc_cell (scm_tc16_thread, 0);
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
SCM_SETCAR (thread, scm_tc16_thread);
|
|
||||||
argl = scm_cons (thread, argl);
|
argl = scm_cons (thread, argl);
|
||||||
/* Note that we couldn't pass a pointer to argl as data since the
|
/* Note that we couldn't pass a pointer to argl as data since the
|
||||||
argl variable may not exist in memory when the thread starts. */
|
argl variable may not exist in memory when the thread starts. */
|
||||||
|
@ -345,9 +344,8 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data,
|
||||||
/* Allocate thread locals. */
|
/* Allocate thread locals. */
|
||||||
root = scm_make_root (scm_root->handle);
|
root = scm_make_root (scm_root->handle);
|
||||||
/* Make thread. */
|
/* Make thread. */
|
||||||
SCM_NEWCELL (thread);
|
thread = scm_alloc_cell (scm_tc16_thread, 0);
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
SCM_SETCAR (thread, scm_tc16_thread);
|
|
||||||
|
|
||||||
data->u.thread = thread;
|
data->u.thread = thread;
|
||||||
data->body = body;
|
data->body = body;
|
||||||
|
|
|
@ -539,13 +539,7 @@ SCM_DEFINE (scm_debug_object_p, "debug-object?", 1, 0, 0,
|
||||||
SCM
|
SCM
|
||||||
scm_make_debugobj (scm_t_debug_frame *frame)
|
scm_make_debugobj (scm_t_debug_frame *frame)
|
||||||
{
|
{
|
||||||
register SCM z;
|
return scm_alloc_cell (scm_tc16_debugobj, (scm_t_bits) frame);
|
||||||
SCM_NEWCELL (z);
|
|
||||||
SCM_ENTER_A_SECTION;
|
|
||||||
SCM_SET_DEBUGOBJ_FRAME (z, frame);
|
|
||||||
SCM_SET_CELL_TYPE (z, scm_tc16_debugobj);
|
|
||||||
SCM_EXIT_A_SECTION;
|
|
||||||
return z;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -119,13 +119,7 @@ scm_error_environment_immutable_location (const char *func, SCM env, SCM symbol)
|
||||||
SCM
|
SCM
|
||||||
scm_make_environment (void *type)
|
scm_make_environment (void *type)
|
||||||
{
|
{
|
||||||
SCM env;
|
return scm_alloc_cell (scm_tc16_environment, (scm_t_bits) type);
|
||||||
|
|
||||||
SCM_NEWCELL (env);
|
|
||||||
SCM_SET_CELL_WORD_1 (env, type);
|
|
||||||
SCM_SET_CELL_TYPE (env, scm_tc16_environment);
|
|
||||||
|
|
||||||
return env;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -669,11 +663,10 @@ core_environments_observe (SCM env, scm_environment_observer proc, SCM data, int
|
||||||
{
|
{
|
||||||
SCM observer;
|
SCM observer;
|
||||||
|
|
||||||
SCM_NEWCELL2 (observer);
|
observer = scm_alloc_double_cell (scm_tc16_observer,
|
||||||
SCM_SET_CELL_OBJECT_1 (observer, env);
|
SCM_UNPACK (env),
|
||||||
SCM_SET_CELL_OBJECT_2 (observer, data);
|
SCM_UNPACK (data),
|
||||||
SCM_SET_CELL_WORD_3 (observer, proc);
|
(scm_t_bits) proc);
|
||||||
SCM_SET_CELL_TYPE (observer, scm_tc16_observer);
|
|
||||||
|
|
||||||
if (!weak_p)
|
if (!weak_p)
|
||||||
{
|
{
|
||||||
|
|
|
@ -3864,11 +3864,11 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
|
||||||
SCM
|
SCM
|
||||||
scm_closure (SCM code, SCM env)
|
scm_closure (SCM code, SCM env)
|
||||||
{
|
{
|
||||||
register SCM z;
|
SCM z;
|
||||||
|
SCM closcar = scm_cons (code, SCM_EOL);
|
||||||
SCM_NEWCELL (z);
|
z = scm_alloc_cell (SCM_UNPACK (closcar) + scm_tc3_closure,
|
||||||
SCM_SETCODE (z, code);
|
(scm_t_bits) env);
|
||||||
SCM_SETENV (z, env);
|
scm_remember_upto_here (closcar);
|
||||||
return z;
|
return z;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -3939,9 +3939,7 @@ SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0,
|
||||||
#define FUNC_NAME s_scm_cons_source
|
#define FUNC_NAME s_scm_cons_source
|
||||||
{
|
{
|
||||||
SCM p, z;
|
SCM p, z;
|
||||||
SCM_NEWCELL (z);
|
z = scm_cons (x, y);
|
||||||
SCM_SET_CELL_OBJECT_0 (z, x);
|
|
||||||
SCM_SET_CELL_OBJECT_1 (z, y);
|
|
||||||
/* Copy source properties possibly associated with xorig. */
|
/* Copy source properties possibly associated with xorig. */
|
||||||
p = scm_whash_lookup (scm_source_whash, xorig);
|
p = scm_whash_lookup (scm_source_whash, xorig);
|
||||||
if (!SCM_IMP (p))
|
if (!SCM_IMP (p))
|
||||||
|
|
|
@ -428,7 +428,7 @@ scm_fdes_to_port (int fdes, char *mode, SCM name)
|
||||||
SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL);
|
SCM_MISC_ERROR ("requested file mode not available on fdes", SCM_EOL);
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_NEWCELL (port);
|
port = scm_alloc_cell (scm_tc16_fport, 0);
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
pt = scm_add_to_port_table (port);
|
pt = scm_add_to_port_table (port);
|
||||||
SCM_SETPTAB_ENTRY (port, pt);
|
SCM_SETPTAB_ENTRY (port, pt);
|
||||||
|
|
|
@ -149,13 +149,7 @@ gh_doubles2scm (const double *d, long n)
|
||||||
static SCM
|
static SCM
|
||||||
makvect (char *m, size_t len, int type)
|
makvect (char *m, size_t len, int type)
|
||||||
{
|
{
|
||||||
SCM ans;
|
return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (len, type), (scm_t_bits) m);
|
||||||
SCM_NEWCELL (ans);
|
|
||||||
SCM_DEFER_INTS;
|
|
||||||
SCM_SET_UVECTOR_BASE (ans, m);
|
|
||||||
SCM_SET_UVECTOR_LENGTH (ans, len, type);
|
|
||||||
SCM_ALLOW_INTS;
|
|
||||||
return ans;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
|
|
|
@ -1301,20 +1301,15 @@ static void clear_method_cache (SCM);
|
||||||
static SCM
|
static SCM
|
||||||
wrap_init (SCM class, SCM *m, long n)
|
wrap_init (SCM class, SCM *m, long n)
|
||||||
{
|
{
|
||||||
SCM z;
|
|
||||||
long i;
|
long i;
|
||||||
|
|
||||||
/* Set all slots to unbound */
|
/* Set all slots to unbound */
|
||||||
for (i = 0; i < n; i++)
|
for (i = 0; i < n; i++)
|
||||||
m[i] = SCM_GOOPS_UNBOUND;
|
m[i] = SCM_GOOPS_UNBOUND;
|
||||||
|
|
||||||
SCM_NEWCELL2 (z);
|
return scm_alloc_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (class))
|
||||||
SCM_SET_STRUCT_GC_CHAIN (z, 0);
|
| scm_tc3_struct),
|
||||||
SCM_SET_CELL_WORD_1 (z, m);
|
(scm_t_bits) m, 0, 0);
|
||||||
SCM_SET_CELL_WORD_0 (z, (scm_t_bits) SCM_STRUCT_DATA (class)
|
|
||||||
| scm_tc3_struct);
|
|
||||||
|
|
||||||
return z;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
|
SCM_DEFINE (scm_sys_allocate_instance, "%allocate-instance", 2, 0, 0,
|
||||||
|
@ -2589,12 +2584,9 @@ scm_add_slot (SCM class, char *slot_name, SCM slot_class,
|
||||||
SCM
|
SCM
|
||||||
scm_wrap_object (SCM class, void *data)
|
scm_wrap_object (SCM class, void *data)
|
||||||
{
|
{
|
||||||
SCM z;
|
return scm_alloc_double_cell (SCM_UNPACK (SCM_CDR (class)) | scm_tc3_struct,
|
||||||
SCM_NEWCELL2 (z);
|
(scm_t_bits) data,
|
||||||
SCM_SETCDR (z, SCM_PACK ((scm_t_bits) data));
|
0, 0);
|
||||||
SCM_SET_STRUCT_GC_CHAIN (z, 0);
|
|
||||||
SCM_SETCAR (z, SCM_UNPACK (SCM_CDR (class)) | scm_tc3_struct);
|
|
||||||
return z;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM scm_components;
|
SCM scm_components;
|
||||||
|
|
|
@ -248,8 +248,6 @@ scm_guard (SCM guardian, SCM obj, int throw_p)
|
||||||
{
|
{
|
||||||
SCM z;
|
SCM z;
|
||||||
|
|
||||||
SCM_NEWCELL (z);
|
|
||||||
|
|
||||||
/* This critical section barrier will be replaced by a mutex. */
|
/* This critical section barrier will be replaced by a mutex. */
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
|
|
||||||
|
@ -272,6 +270,7 @@ scm_guard (SCM guardian, SCM obj, int throw_p)
|
||||||
obj, guardian);
|
obj, guardian);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
z = scm_cons (SCM_BOOL_F, SCM_BOOL_F);
|
||||||
TCONC_IN (g->live, obj, z);
|
TCONC_IN (g->live, obj, z);
|
||||||
|
|
||||||
SCM_ALLOW_INTS;
|
SCM_ALLOW_INTS;
|
||||||
|
|
|
@ -69,11 +69,7 @@ SCM_DEFINE (scm_nil_cons, "nil-cons", 2, 0, 0,
|
||||||
"a LISP nil.")
|
"a LISP nil.")
|
||||||
#define FUNC_NAME s_scm_nil_cons
|
#define FUNC_NAME s_scm_nil_cons
|
||||||
{
|
{
|
||||||
register SCM z;
|
return scm_cons (x, SCM_NIL2EOL (y, y));
|
||||||
SCM_NEWCELL (z);
|
|
||||||
SCM_SETCAR (z, x);
|
|
||||||
SCM_SETCDR (z, SCM_NIL2EOL (y, y));
|
|
||||||
return z;
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -60,9 +60,7 @@
|
||||||
|
|
||||||
#define SCM_I_CONS(cell,x,y) \
|
#define SCM_I_CONS(cell,x,y) \
|
||||||
do { \
|
do { \
|
||||||
SCM_NEWCELL (cell); \
|
cell = scm_alloc_cell ((scm_t_bits)x, (scm_t_bits)y); \
|
||||||
SCM_SET_CELL_OBJECT_1 (cell, y); \
|
|
||||||
SCM_SET_CELL_OBJECT_0 (cell, x); \
|
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
|
|
|
@ -32,8 +32,7 @@ SCM
|
||||||
FLOAT2NUM (FTYPE n)
|
FLOAT2NUM (FTYPE n)
|
||||||
{
|
{
|
||||||
SCM z;
|
SCM z;
|
||||||
SCM_NEWCELL2 (z);
|
z = scm_alloc_double_cell (scm_tc16_real, 0, 0, 0);
|
||||||
SCM_SET_CELL_TYPE (z, scm_tc16_real);
|
|
||||||
SCM_REAL_VALUE (z) = n;
|
SCM_REAL_VALUE (z) = n;
|
||||||
return z;
|
return z;
|
||||||
}
|
}
|
||||||
|
|
|
@ -1390,9 +1390,7 @@ scm_i_mkbig (size_t nlen, int sign)
|
||||||
|
|
||||||
base = scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum);
|
base = scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum);
|
||||||
|
|
||||||
SCM_NEWCELL (v);
|
v = scm_alloc_cell (SCM_MAKE_BIGNUM_TAG (nlen, sign), (scm_t_bits) base);
|
||||||
SCM_SET_BIGNUM_BASE (v, base);
|
|
||||||
SCM_SETNUMDIGS (v, nlen, sign);
|
|
||||||
return v;
|
return v;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -2829,8 +2827,7 @@ SCM
|
||||||
scm_make_real (double x)
|
scm_make_real (double x)
|
||||||
{
|
{
|
||||||
SCM z;
|
SCM z;
|
||||||
SCM_NEWCELL2 (z);
|
z = scm_alloc_double_cell (scm_tc16_real, 0, 0, 0);
|
||||||
SCM_SET_CELL_TYPE (z, scm_tc16_real);
|
|
||||||
SCM_REAL_VALUE (z) = x;
|
SCM_REAL_VALUE (z) = x;
|
||||||
return z;
|
return z;
|
||||||
}
|
}
|
||||||
|
|
|
@ -80,11 +80,7 @@ SCM_DEFINE (scm_cons, "cons", 2, 0, 0,
|
||||||
"sense of @code{eq?}) from every previously existing object.")
|
"sense of @code{eq?}) from every previously existing object.")
|
||||||
#define FUNC_NAME s_scm_cons
|
#define FUNC_NAME s_scm_cons
|
||||||
{
|
{
|
||||||
SCM z;
|
return scm_alloc_cell (SCM_UNPACK (x), SCM_UNPACK (y));
|
||||||
SCM_NEWCELL (z);
|
|
||||||
SCM_SET_CELL_OBJECT_0 (z, x);
|
|
||||||
SCM_SET_CELL_OBJECT_1 (z, y);
|
|
||||||
return z;
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -92,18 +88,7 @@ SCM_DEFINE (scm_cons, "cons", 2, 0, 0,
|
||||||
SCM
|
SCM
|
||||||
scm_cons2 (SCM w, SCM x, SCM y)
|
scm_cons2 (SCM w, SCM x, SCM y)
|
||||||
{
|
{
|
||||||
SCM z1;
|
return scm_cons (w, scm_cons (x, y));
|
||||||
SCM z2;
|
|
||||||
|
|
||||||
SCM_NEWCELL (z1);
|
|
||||||
SCM_SET_CELL_OBJECT_0 (z1, x);
|
|
||||||
SCM_SET_CELL_OBJECT_1 (z1, y);
|
|
||||||
|
|
||||||
SCM_NEWCELL (z2);
|
|
||||||
SCM_SET_CELL_OBJECT_0 (z2, w);
|
|
||||||
SCM_SET_CELL_OBJECT_1 (z2, z1);
|
|
||||||
|
|
||||||
return z2;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1527,7 +1527,7 @@ scm_void_port (char *mode_str)
|
||||||
SCM answer;
|
SCM answer;
|
||||||
scm_t_port * pt;
|
scm_t_port * pt;
|
||||||
|
|
||||||
SCM_NEWCELL (answer);
|
answer = scm_alloc_cell (scm_tc16_void_port, 0);
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
mode_bits = scm_mode_bits (mode_str);
|
mode_bits = scm_mode_bits (mode_str);
|
||||||
pt = scm_add_to_port_table (answer);
|
pt = scm_add_to_port_table (answer);
|
||||||
|
|
|
@ -249,10 +249,8 @@ scm_free_print_state (SCM print_state)
|
||||||
*/
|
*/
|
||||||
pstate->fancyp = 0;
|
pstate->fancyp = 0;
|
||||||
pstate->revealed = 0;
|
pstate->revealed = 0;
|
||||||
SCM_NEWCELL (handle);
|
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
SCM_SET_CELL_WORD_0 (handle, print_state);
|
handle = scm_cons (print_state, print_state_pool);
|
||||||
SCM_SET_CELL_WORD_1 (handle, print_state_pool);
|
|
||||||
print_state_pool = handle;
|
print_state_pool = handle;
|
||||||
SCM_ALLOW_INTS;
|
SCM_ALLOW_INTS;
|
||||||
}
|
}
|
||||||
|
|
|
@ -86,16 +86,12 @@ scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
|
||||||
scm_subr_table_room = new_size;
|
scm_subr_table_room = new_size;
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_NEWCELL (z);
|
|
||||||
|
|
||||||
entry = scm_subr_table_size;
|
entry = scm_subr_table_size;
|
||||||
|
z = scm_alloc_cell ((entry << 8) + type, (scm_t_bits) fcn);
|
||||||
scm_subr_table[entry].handle = z;
|
scm_subr_table[entry].handle = z;
|
||||||
scm_subr_table[entry].name = scm_str2symbol (name);
|
scm_subr_table[entry].name = scm_str2symbol (name);
|
||||||
scm_subr_table[entry].generic = 0;
|
scm_subr_table[entry].generic = 0;
|
||||||
scm_subr_table[entry].properties = SCM_EOL;
|
scm_subr_table[entry].properties = SCM_EOL;
|
||||||
|
|
||||||
SCM_SET_SUBRF (z, fcn);
|
|
||||||
SCM_SET_CELL_TYPE (z, (entry << 8) + type);
|
|
||||||
scm_subr_table_size++;
|
scm_subr_table_size++;
|
||||||
|
|
||||||
return z;
|
return z;
|
||||||
|
@ -165,12 +161,8 @@ scm_makcclo (SCM proc, size_t len)
|
||||||
for (i = 0; i < len; ++i)
|
for (i = 0; i < len; ++i)
|
||||||
base [i] = SCM_UNPACK (SCM_UNSPECIFIED);
|
base [i] = SCM_UNPACK (SCM_UNSPECIFIED);
|
||||||
|
|
||||||
SCM_NEWCELL (s);
|
s = scm_alloc_cell (SCM_MAKE_CCLO_TAG (len), (scm_t_bits) base);
|
||||||
SCM_DEFER_INTS;
|
|
||||||
SCM_SET_CCLO_BASE (s, base);
|
|
||||||
SCM_SET_CCLO_LENGTH (s, len);
|
|
||||||
SCM_SET_CCLO_SUBR (s, proc);
|
SCM_SET_CCLO_SUBR (s, proc);
|
||||||
SCM_ALLOW_INTS;
|
|
||||||
return s;
|
return s;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -327,16 +319,11 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
|
||||||
"with the associated setter @var{setter}.")
|
"with the associated setter @var{setter}.")
|
||||||
#define FUNC_NAME s_scm_make_procedure_with_setter
|
#define FUNC_NAME s_scm_make_procedure_with_setter
|
||||||
{
|
{
|
||||||
SCM z;
|
|
||||||
SCM_VALIDATE_PROC (1, procedure);
|
SCM_VALIDATE_PROC (1, procedure);
|
||||||
SCM_VALIDATE_PROC (2, setter);
|
SCM_VALIDATE_PROC (2, setter);
|
||||||
SCM_NEWCELL2 (z);
|
return scm_alloc_double_cell (scm_tc7_pws,
|
||||||
SCM_ENTER_A_SECTION;
|
SCM_UNPACK (procedure),
|
||||||
SCM_SET_CELL_OBJECT_1 (z, procedure);
|
SCM_UNPACK (setter), 0);
|
||||||
SCM_SET_CELL_OBJECT_2 (z, setter);
|
|
||||||
SCM_SET_CELL_TYPE (z, scm_tc7_pws);
|
|
||||||
SCM_EXIT_A_SECTION;
|
|
||||||
return z;
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
|
@ -456,23 +456,10 @@ scm_make_smob (scm_t_bits tc)
|
||||||
{
|
{
|
||||||
long n = SCM_TC2SMOBNUM (tc);
|
long n = SCM_TC2SMOBNUM (tc);
|
||||||
size_t size = scm_smobs[n].size;
|
size_t size = scm_smobs[n].size;
|
||||||
SCM z;
|
scm_t_bits data = (size > 0
|
||||||
SCM_NEWCELL (z);
|
? (scm_t_bits) scm_must_malloc (size, SCM_SMOBNAME (n))
|
||||||
if (size != 0)
|
: 0);
|
||||||
{
|
return scm_alloc_cell (tc, data);
|
||||||
#if 0
|
|
||||||
if (scm_smobs[n].mark != 0)
|
|
||||||
{
|
|
||||||
fprintf
|
|
||||||
(stderr,
|
|
||||||
"forbidden operation for smobs with GC data, use SCM_NEWSMOB\n");
|
|
||||||
abort ();
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
SCM_SET_SMOB_DATA (z, scm_must_malloc (size, SCM_SMOBNAME (n)));
|
|
||||||
}
|
|
||||||
SCM_SET_CELL_TYPE (z, tc);
|
|
||||||
return z;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -72,9 +72,7 @@ typedef struct scm_smob_descriptor
|
||||||
|
|
||||||
#define SCM_NEWSMOB(z, tc, data) \
|
#define SCM_NEWSMOB(z, tc, data) \
|
||||||
do { \
|
do { \
|
||||||
SCM_NEWCELL (z); \
|
z = scm_alloc_cell ((tc), (scm_t_bits) (data)); \
|
||||||
SCM_SET_CELL_WORD_1 ((z), (data)); \
|
|
||||||
SCM_SET_CELL_TYPE ((z), (tc)); \
|
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
#define SCM_RETURN_NEWSMOB(tc, data) \
|
#define SCM_RETURN_NEWSMOB(tc, data) \
|
||||||
|
@ -85,10 +83,8 @@ do { \
|
||||||
|
|
||||||
#define SCM_NEWSMOB2(z, tc, data1, data2) \
|
#define SCM_NEWSMOB2(z, tc, data1, data2) \
|
||||||
do { \
|
do { \
|
||||||
SCM_NEWCELL2 (z); \
|
z = scm_alloc_double_cell ((tc), (scm_t_bits)(data1), \
|
||||||
SCM_SET_CELL_WORD_1 ((z), (data1)); \
|
(scm_t_bits)(data2), 0); \
|
||||||
SCM_SET_CELL_WORD_2 ((z), (data2)); \
|
|
||||||
SCM_SET_CELL_TYPE ((z), (tc)); \
|
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
#define SCM_RETURN_NEWSMOB2(tc, data1, data2) \
|
#define SCM_RETURN_NEWSMOB2(tc, data1, data2) \
|
||||||
|
@ -99,11 +95,8 @@ do { \
|
||||||
|
|
||||||
#define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
|
#define SCM_NEWSMOB3(z, tc, data1, data2, data3) \
|
||||||
do { \
|
do { \
|
||||||
SCM_NEWCELL2 (z); \
|
z = scm_alloc_double_cell ((tc), (scm_t_bits)(data1), \
|
||||||
SCM_SET_CELL_WORD_1 ((z), (data1)); \
|
(scm_t_bits)(data2), (scm_t_bits)(data3)); \
|
||||||
SCM_SET_CELL_WORD_2 ((z), (data2)); \
|
|
||||||
SCM_SET_CELL_WORD_3 ((z), (data3)); \
|
|
||||||
SCM_SET_CELL_TYPE ((z), (tc)); \
|
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
#define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \
|
#define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \
|
||||||
|
|
|
@ -132,9 +132,7 @@ scm_take_str (char *s, size_t len)
|
||||||
|
|
||||||
SCM_ASSERT_RANGE (2, scm_ulong2num (len), len <= SCM_STRING_MAX_LENGTH);
|
SCM_ASSERT_RANGE (2, scm_ulong2num (len), len <= SCM_STRING_MAX_LENGTH);
|
||||||
|
|
||||||
SCM_NEWCELL (answer);
|
answer = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) s);
|
||||||
SCM_SET_STRING_CHARS (answer, s);
|
|
||||||
SCM_SET_STRING_LENGTH (answer, len);
|
|
||||||
scm_done_malloc (len + 1);
|
scm_done_malloc (len + 1);
|
||||||
|
|
||||||
return answer;
|
return answer;
|
||||||
|
@ -196,9 +194,7 @@ scm_allocate_string (size_t len)
|
||||||
mem = (char *) scm_must_malloc (len + 1, FUNC_NAME);
|
mem = (char *) scm_must_malloc (len + 1, FUNC_NAME);
|
||||||
mem[len] = 0;
|
mem[len] = 0;
|
||||||
|
|
||||||
SCM_NEWCELL (s);
|
s = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) mem);
|
||||||
SCM_SET_STRING_CHARS (s, mem);
|
|
||||||
SCM_SET_STRING_LENGTH (s, len);
|
|
||||||
|
|
||||||
return s;
|
return s;
|
||||||
}
|
}
|
||||||
|
|
|
@ -279,7 +279,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
|
||||||
scm_out_of_range (caller, pos);
|
scm_out_of_range (caller, pos);
|
||||||
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
|
if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG)))
|
||||||
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
|
scm_misc_error ("scm_mkstrport", "port must read or write", SCM_EOL);
|
||||||
SCM_NEWCELL (z);
|
z = scm_alloc_cell (scm_tc16_strport, 0);
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
pt = scm_add_to_port_table (z);
|
pt = scm_add_to_port_table (z);
|
||||||
SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
|
SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes);
|
||||||
|
|
|
@ -450,7 +450,6 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
|
||||||
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
|
layout = SCM_PACK (SCM_STRUCT_DATA (vtable) [scm_vtable_index_layout]);
|
||||||
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
|
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
|
||||||
tail_elts = SCM_INUM (tail_array_size);
|
tail_elts = SCM_INUM (tail_array_size);
|
||||||
SCM_NEWCELL2 (handle);
|
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
|
if (SCM_STRUCT_DATA (vtable)[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
|
||||||
{
|
{
|
||||||
|
@ -464,11 +463,10 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
|
||||||
data = scm_alloc_struct (basic_size + tail_elts,
|
data = scm_alloc_struct (basic_size + tail_elts,
|
||||||
scm_struct_n_extra_words,
|
scm_struct_n_extra_words,
|
||||||
"make-struct");
|
"make-struct");
|
||||||
SCM_SET_CELL_WORD_1 (handle, data);
|
handle = scm_alloc_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (vtable))
|
||||||
SCM_SET_STRUCT_GC_CHAIN (handle, 0);
|
+ scm_tc3_struct),
|
||||||
|
(scm_t_bits) data, 0, 0);
|
||||||
scm_struct_init (handle, layout, data, tail_elts, init);
|
scm_struct_init (handle, layout, data, tail_elts, init);
|
||||||
SCM_SET_CELL_WORD_0 (handle,
|
|
||||||
(scm_t_bits) SCM_STRUCT_DATA (vtable) + scm_tc3_struct);
|
|
||||||
SCM_ALLOW_INTS;
|
SCM_ALLOW_INTS;
|
||||||
return handle;
|
return handle;
|
||||||
}
|
}
|
||||||
|
@ -540,16 +538,14 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
|
||||||
layout = scm_make_struct_layout (fields);
|
layout = scm_make_struct_layout (fields);
|
||||||
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
|
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
|
||||||
tail_elts = SCM_INUM (tail_array_size);
|
tail_elts = SCM_INUM (tail_array_size);
|
||||||
SCM_NEWCELL2 (handle);
|
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
data = scm_alloc_struct (basic_size + tail_elts,
|
data = scm_alloc_struct (basic_size + tail_elts,
|
||||||
scm_struct_n_extra_words,
|
scm_struct_n_extra_words,
|
||||||
"make-vtable-vtable");
|
"make-vtable-vtable");
|
||||||
SCM_SET_CELL_WORD_1 (handle, data);
|
handle = scm_alloc_double_cell ((scm_t_bits) data + scm_tc3_struct,
|
||||||
SCM_SET_STRUCT_GC_CHAIN (handle, 0);
|
(scm_t_bits) data, 0, 0);
|
||||||
data [scm_vtable_index_layout] = SCM_UNPACK (layout);
|
data [scm_vtable_index_layout] = SCM_UNPACK (layout);
|
||||||
scm_struct_init (handle, layout, data, tail_elts, scm_cons (layout, init));
|
scm_struct_init (handle, layout, data, tail_elts, scm_cons (layout, init));
|
||||||
SCM_SET_CELL_WORD_0 (handle, (scm_t_bits) data + scm_tc3_struct);
|
|
||||||
SCM_ALLOW_INTS;
|
SCM_ALLOW_INTS;
|
||||||
return handle;
|
return handle;
|
||||||
}
|
}
|
||||||
|
|
|
@ -125,11 +125,11 @@ scm_mem2symbol (const char *name, size_t len)
|
||||||
SCM cell;
|
SCM cell;
|
||||||
SCM slot;
|
SCM slot;
|
||||||
|
|
||||||
SCM_NEWCELL2 (symbol);
|
symbol = scm_alloc_double_cell (SCM_MAKE_SYMBOL_TAG (len),
|
||||||
SCM_SET_SYMBOL_CHARS (symbol, scm_must_strndup (name, len));
|
(scm_t_bits) scm_must_strndup (name, len),
|
||||||
SCM_SET_SYMBOL_HASH (symbol, raw_hash);
|
raw_hash,
|
||||||
SCM_SET_PROP_SLOTS (symbol, scm_cons (SCM_BOOL_F, SCM_EOL));
|
SCM_UNPACK (scm_cons (SCM_BOOL_F,
|
||||||
SCM_SET_SYMBOL_LENGTH (symbol, (long) len);
|
SCM_EOL)));
|
||||||
|
|
||||||
slot = SCM_VELTS (symbols) [hash];
|
slot = SCM_VELTS (symbols) [hash];
|
||||||
cell = scm_cons (symbol, SCM_UNDEFINED);
|
cell = scm_cons (symbol, SCM_UNDEFINED);
|
||||||
|
|
|
@ -165,19 +165,16 @@ scm_make_uve (long k, SCM prot)
|
||||||
|
|
||||||
if (SCM_EQ_P (prot, SCM_BOOL_T))
|
if (SCM_EQ_P (prot, SCM_BOOL_T))
|
||||||
{
|
{
|
||||||
SCM_NEWCELL (v);
|
|
||||||
if (k > 0)
|
if (k > 0)
|
||||||
{
|
{
|
||||||
SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH);
|
SCM_ASSERT_RANGE (1,
|
||||||
|
scm_long2num (k), k <= SCM_BITVECTOR_MAX_LENGTH);
|
||||||
i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
|
i = sizeof (long) * ((k + SCM_LONG_BIT - 1) / SCM_LONG_BIT);
|
||||||
SCM_SET_BITVECTOR_BASE (v, (char *) scm_must_malloc (i, "vector"));
|
v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (k),
|
||||||
SCM_SET_BITVECTOR_LENGTH (v, k);
|
(scm_t_bits) scm_must_malloc (i, "vector"));
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (0), 0);
|
||||||
SCM_SET_BITVECTOR_BASE (v, 0);
|
|
||||||
SCM_SET_BITVECTOR_LENGTH (v, 0);
|
|
||||||
}
|
|
||||||
return v;
|
return v;
|
||||||
}
|
}
|
||||||
else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
|
else if (SCM_CHARP (prot) && (SCM_CHAR (prot) == '\0'))
|
||||||
|
@ -242,12 +239,8 @@ scm_make_uve (long k, SCM prot)
|
||||||
|
|
||||||
SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
|
SCM_ASSERT_RANGE (1, scm_long2num (k), k <= SCM_UVECTOR_MAX_LENGTH);
|
||||||
|
|
||||||
SCM_NEWCELL (v);
|
return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (k, type),
|
||||||
SCM_DEFER_INTS;
|
(scm_t_bits) scm_must_malloc (i ? i : 1, "vector"));
|
||||||
SCM_SET_UVECTOR_BASE (v, (char *) scm_must_malloc (i ? i : 1, "vector"));
|
|
||||||
SCM_SET_UVECTOR_LENGTH (v, k, type);
|
|
||||||
SCM_ALLOW_INTS;
|
|
||||||
return v;
|
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -525,7 +518,6 @@ SCM
|
||||||
scm_make_ra (int ndim)
|
scm_make_ra (int ndim)
|
||||||
{
|
{
|
||||||
SCM ra;
|
SCM ra;
|
||||||
SCM_NEWCELL (ra);
|
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_tc16_array,
|
SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_tc16_array,
|
||||||
scm_must_malloc ((sizeof (scm_t_array) +
|
scm_must_malloc ((sizeof (scm_t_array) +
|
||||||
|
|
|
@ -68,12 +68,7 @@ scm_i_variable_print (SCM exp, SCM port, scm_print_state *pstate)
|
||||||
static SCM
|
static SCM
|
||||||
make_variable (SCM init)
|
make_variable (SCM init)
|
||||||
{
|
{
|
||||||
SCM z;
|
return scm_alloc_cell (scm_tc7_variable, SCM_UNPACK (init));
|
||||||
SCM_NEWCELL (z);
|
|
||||||
SCM_SET_CELL_WORD_1 (z, SCM_UNPACK (init));
|
|
||||||
SCM_SET_CELL_TYPE (z, scm_tc7_variable);
|
|
||||||
scm_remember_upto_here_1 (init);
|
|
||||||
return z;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_DEFINE (scm_make_variable, "make-variable", 1, 0, 0,
|
SCM_DEFINE (scm_make_variable, "make-variable", 1, 0, 0,
|
||||||
|
|
|
@ -214,9 +214,8 @@ scm_c_make_vector (unsigned long int k, SCM fill)
|
||||||
else
|
else
|
||||||
base = NULL;
|
base = NULL;
|
||||||
|
|
||||||
SCM_NEWCELL (v);
|
v = scm_alloc_cell (SCM_MAKE_VECTOR_TAG (k, scm_tc7_vector),
|
||||||
SCM_SET_VECTOR_BASE (v, base);
|
(scm_t_bits) base);
|
||||||
SCM_SET_VECTOR_LENGTH (v, k, scm_tc7_vector);
|
|
||||||
scm_remember_upto_here_1 (fill);
|
scm_remember_upto_here_1 (fill);
|
||||||
|
|
||||||
return v;
|
return v;
|
||||||
|
|
|
@ -189,7 +189,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0,
|
||||||
SCM z;
|
SCM z;
|
||||||
SCM_VALIDATE_VECTOR_LEN (1,pv,5);
|
SCM_VALIDATE_VECTOR_LEN (1,pv,5);
|
||||||
SCM_VALIDATE_STRING (2, modes);
|
SCM_VALIDATE_STRING (2, modes);
|
||||||
SCM_NEWCELL (z);
|
z = scm_alloc_cell (scm_tc16_sfport, 0);
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
pt = scm_add_to_port_table (z);
|
pt = scm_add_to_port_table (z);
|
||||||
scm_port_non_buffer (pt);
|
scm_port_non_buffer (pt);
|
||||||
|
|
|
@ -71,10 +71,6 @@ allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller)
|
||||||
SCM_ASSERT_RANGE (1, size, SCM_INUM (size) >= 0);
|
SCM_ASSERT_RANGE (1, size, SCM_INUM (size) >= 0);
|
||||||
c_size = SCM_INUM (size);
|
c_size = SCM_INUM (size);
|
||||||
|
|
||||||
SCM_NEWCELL2 (v);
|
|
||||||
SCM_SET_WVECT_GC_CHAIN (v, SCM_EOL);
|
|
||||||
SCM_SET_WVECT_TYPE (v, type);
|
|
||||||
|
|
||||||
if (c_size > 0)
|
if (c_size > 0)
|
||||||
{
|
{
|
||||||
scm_t_bits *base;
|
scm_t_bits *base;
|
||||||
|
@ -87,14 +83,20 @@ allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller)
|
||||||
base = scm_must_malloc (c_size * sizeof (scm_t_bits), FUNC_NAME);
|
base = scm_must_malloc (c_size * sizeof (scm_t_bits), FUNC_NAME);
|
||||||
for (j = 0; j != c_size; ++j)
|
for (j = 0; j != c_size; ++j)
|
||||||
base[j] = SCM_UNPACK (fill);
|
base[j] = SCM_UNPACK (fill);
|
||||||
SCM_SET_VECTOR_BASE (v, base);
|
v = scm_alloc_double_cell (SCM_MAKE_VECTOR_TAG (c_size,
|
||||||
SCM_SET_VECTOR_LENGTH (v, c_size, scm_tc7_wvect);
|
scm_tc7_wvect),
|
||||||
|
(scm_t_bits) base,
|
||||||
|
type,
|
||||||
|
SCM_UNPACK (SCM_EOL));
|
||||||
scm_remember_upto_here_1 (fill);
|
scm_remember_upto_here_1 (fill);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
SCM_SET_VECTOR_BASE (v, NULL);
|
v = scm_alloc_double_cell (SCM_MAKE_VECTOR_TAG (0,
|
||||||
SCM_SET_VECTOR_LENGTH (v, 0, scm_tc7_wvect);
|
scm_tc7_wvect),
|
||||||
|
(scm_t_bits) NULL,
|
||||||
|
type,
|
||||||
|
SCM_UNPACK (SCM_EOL));
|
||||||
}
|
}
|
||||||
|
|
||||||
return v;
|
return v;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue