diff options
author | Marius Vollmer <mvo@zagadka.de> | 2001-11-25 15:21:07 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2001-11-25 15:21:07 +0000 |
commit | 16d4699b6ba33685f1318636ffe4990c7db4fdc6 (patch) | |
tree | d0ef01a70571d77fb07e062e2f29344e33c29952 /libguile | |
parent | d3c0e81cc847b39537a2b2945d80de18bf8d5e89 (diff) | |
download | guile-16d4699b6ba33685f1318636ffe4990c7db4fdc6.tar.gz |
Replaced SCM_NEWCELL and SCM_NEWCELL2 with scm_alloc_cell and
scm_alloc_double_cell, respectively.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/alist.c | 15 | ||||
-rw-r--r-- | libguile/coop-threads.c | 6 | ||||
-rw-r--r-- | libguile/debug.c | 8 | ||||
-rw-r--r-- | libguile/environments.c | 17 | ||||
-rw-r--r-- | libguile/eval.c | 14 | ||||
-rw-r--r-- | libguile/fports.c | 2 | ||||
-rw-r--r-- | libguile/gh_data.c | 8 | ||||
-rw-r--r-- | libguile/goops.c | 20 | ||||
-rw-r--r-- | libguile/guardians.c | 3 | ||||
-rw-r--r-- | libguile/lang.c | 6 | ||||
-rw-r--r-- | libguile/list.c | 4 | ||||
-rw-r--r-- | libguile/num2float.i.c | 3 | ||||
-rw-r--r-- | libguile/numbers.c | 7 | ||||
-rw-r--r-- | libguile/pairs.c | 19 | ||||
-rw-r--r-- | libguile/ports.c | 2 | ||||
-rw-r--r-- | libguile/print.c | 4 | ||||
-rw-r--r-- | libguile/procs.c | 23 | ||||
-rw-r--r-- | libguile/smob.c | 21 | ||||
-rw-r--r-- | libguile/smob.h | 17 | ||||
-rw-r--r-- | libguile/strings.c | 8 | ||||
-rw-r--r-- | libguile/strports.c | 2 | ||||
-rw-r--r-- | libguile/struct.c | 14 | ||||
-rw-r--r-- | libguile/symbols.c | 10 | ||||
-rw-r--r-- | libguile/unif.c | 22 | ||||
-rw-r--r-- | libguile/variable.c | 7 | ||||
-rw-r--r-- | libguile/vectors.c | 5 | ||||
-rw-r--r-- | libguile/vports.c | 2 | ||||
-rw-r--r-- | libguile/weaks.c | 18 |
28 files changed, 83 insertions, 204 deletions
diff --git a/libguile/alist.c b/libguile/alist.c index 9bb44cca8..2dd6057b4 100644 --- a/libguile/alist.c +++ b/libguile/alist.c @@ -58,18 +58,9 @@ SCM_DEFINE (scm_acons, "acons", 3, 0, 0, "function is @emph{not} destructive; @var{alist} is not modified.") #define FUNC_NAME s_scm_acons { - SCM pair; - SCM head; - - 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; + return scm_alloc_cell (SCM_UNPACK (scm_alloc_cell (SCM_UNPACK (key), + SCM_UNPACK (value))), + SCM_UNPACK (alist)); } #undef FUNC_NAME diff --git a/libguile/coop-threads.c b/libguile/coop-threads.c index d126f67f6..659264fc7 100644 --- a/libguile/coop-threads.c +++ b/libguile/coop-threads.c @@ -257,9 +257,8 @@ scm_call_with_new_thread (SCM argl) /* Allocate thread locals. */ root = scm_make_root (scm_root->handle); /* Make thread. */ - SCM_NEWCELL (thread); + thread = scm_alloc_cell (scm_tc16_thread, 0); SCM_DEFER_INTS; - SCM_SETCAR (thread, scm_tc16_thread); argl = scm_cons (thread, argl); /* 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. */ @@ -345,9 +344,8 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, /* Allocate thread locals. */ root = scm_make_root (scm_root->handle); /* Make thread. */ - SCM_NEWCELL (thread); + thread = scm_alloc_cell (scm_tc16_thread, 0); SCM_DEFER_INTS; - SCM_SETCAR (thread, scm_tc16_thread); data->u.thread = thread; data->body = body; diff --git a/libguile/debug.c b/libguile/debug.c index 0f5373e5c..6b930711c 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -539,13 +539,7 @@ SCM_DEFINE (scm_debug_object_p, "debug-object?", 1, 0, 0, SCM scm_make_debugobj (scm_t_debug_frame *frame) { - register SCM z; - 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; + return scm_alloc_cell (scm_tc16_debugobj, (scm_t_bits) frame); } diff --git a/libguile/environments.c b/libguile/environments.c index 541427641..237c8b28e 100644 --- a/libguile/environments.c +++ b/libguile/environments.c @@ -119,13 +119,7 @@ scm_error_environment_immutable_location (const char *func, SCM env, SCM symbol) SCM scm_make_environment (void *type) { - SCM env; - - SCM_NEWCELL (env); - SCM_SET_CELL_WORD_1 (env, type); - SCM_SET_CELL_TYPE (env, scm_tc16_environment); - - return env; + return scm_alloc_cell (scm_tc16_environment, (scm_t_bits) type); } @@ -669,11 +663,10 @@ core_environments_observe (SCM env, scm_environment_observer proc, SCM data, int { SCM observer; - SCM_NEWCELL2 (observer); - SCM_SET_CELL_OBJECT_1 (observer, env); - SCM_SET_CELL_OBJECT_2 (observer, data); - SCM_SET_CELL_WORD_3 (observer, proc); - SCM_SET_CELL_TYPE (observer, scm_tc16_observer); + observer = scm_alloc_double_cell (scm_tc16_observer, + SCM_UNPACK (env), + SCM_UNPACK (data), + (scm_t_bits) proc); if (!weak_p) { diff --git a/libguile/eval.c b/libguile/eval.c index 73ac4eceb..126015e1c 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -3864,11 +3864,11 @@ scm_for_each (SCM proc, SCM arg1, SCM args) SCM scm_closure (SCM code, SCM env) { - register SCM z; - - SCM_NEWCELL (z); - SCM_SETCODE (z, code); - SCM_SETENV (z, env); + SCM z; + SCM closcar = scm_cons (code, SCM_EOL); + z = scm_alloc_cell (SCM_UNPACK (closcar) + scm_tc3_closure, + (scm_t_bits) env); + scm_remember_upto_here (closcar); return z; } @@ -3939,9 +3939,7 @@ SCM_DEFINE (scm_cons_source, "cons-source", 3, 0, 0, #define FUNC_NAME s_scm_cons_source { SCM p, z; - SCM_NEWCELL (z); - SCM_SET_CELL_OBJECT_0 (z, x); - SCM_SET_CELL_OBJECT_1 (z, y); + z = scm_cons (x, y); /* Copy source properties possibly associated with xorig. */ p = scm_whash_lookup (scm_source_whash, xorig); if (!SCM_IMP (p)) diff --git a/libguile/fports.c b/libguile/fports.c index 426db6f55..2ce9c4a0d 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -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_NEWCELL (port); + port = scm_alloc_cell (scm_tc16_fport, 0); SCM_DEFER_INTS; pt = scm_add_to_port_table (port); SCM_SETPTAB_ENTRY (port, pt); diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 0f503a950..116b523fc 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -149,13 +149,7 @@ gh_doubles2scm (const double *d, long n) static SCM makvect (char *m, size_t len, int type) { - SCM ans; - SCM_NEWCELL (ans); - SCM_DEFER_INTS; - SCM_SET_UVECTOR_BASE (ans, m); - SCM_SET_UVECTOR_LENGTH (ans, len, type); - SCM_ALLOW_INTS; - return ans; + return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (len, type), (scm_t_bits) m); } SCM diff --git a/libguile/goops.c b/libguile/goops.c index b813dad05..305f577b3 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1301,20 +1301,15 @@ static void clear_method_cache (SCM); static SCM wrap_init (SCM class, SCM *m, long n) { - SCM z; long i; /* Set all slots to unbound */ for (i = 0; i < n; i++) m[i] = SCM_GOOPS_UNBOUND; - SCM_NEWCELL2 (z); - SCM_SET_STRUCT_GC_CHAIN (z, 0); - SCM_SET_CELL_WORD_1 (z, m); - SCM_SET_CELL_WORD_0 (z, (scm_t_bits) SCM_STRUCT_DATA (class) - | scm_tc3_struct); - - return z; + return scm_alloc_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (class)) + | scm_tc3_struct), + (scm_t_bits) m, 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_wrap_object (SCM class, void *data) { - SCM z; - SCM_NEWCELL2 (z); - SCM_SETCDR (z, SCM_PACK ((scm_t_bits) data)); - SCM_SET_STRUCT_GC_CHAIN (z, 0); - SCM_SETCAR (z, SCM_UNPACK (SCM_CDR (class)) | scm_tc3_struct); - return z; + return scm_alloc_double_cell (SCM_UNPACK (SCM_CDR (class)) | scm_tc3_struct, + (scm_t_bits) data, + 0, 0); } SCM scm_components; diff --git a/libguile/guardians.c b/libguile/guardians.c index ad9832539..d9eb5f003 100644 --- a/libguile/guardians.c +++ b/libguile/guardians.c @@ -248,8 +248,6 @@ scm_guard (SCM guardian, SCM obj, int throw_p) { SCM z; - SCM_NEWCELL (z); - /* This critical section barrier will be replaced by a mutex. */ SCM_DEFER_INTS; @@ -272,6 +270,7 @@ scm_guard (SCM guardian, SCM obj, int throw_p) obj, guardian); } + z = scm_cons (SCM_BOOL_F, SCM_BOOL_F); TCONC_IN (g->live, obj, z); SCM_ALLOW_INTS; diff --git a/libguile/lang.c b/libguile/lang.c index b5791fbbf..f022bee77 100644 --- a/libguile/lang.c +++ b/libguile/lang.c @@ -69,11 +69,7 @@ SCM_DEFINE (scm_nil_cons, "nil-cons", 2, 0, 0, "a LISP nil.") #define FUNC_NAME s_scm_nil_cons { - register SCM z; - SCM_NEWCELL (z); - SCM_SETCAR (z, x); - SCM_SETCDR (z, SCM_NIL2EOL (y, y)); - return z; + return scm_cons (x, SCM_NIL2EOL (y, y)); } #undef FUNC_NAME diff --git a/libguile/list.c b/libguile/list.c index b709b882d..8d6237d20 100644 --- a/libguile/list.c +++ b/libguile/list.c @@ -60,9 +60,7 @@ #define SCM_I_CONS(cell,x,y) \ do { \ - SCM_NEWCELL (cell); \ - SCM_SET_CELL_OBJECT_1 (cell, y); \ - SCM_SET_CELL_OBJECT_0 (cell, x); \ + cell = scm_alloc_cell ((scm_t_bits)x, (scm_t_bits)y); \ } while (0) SCM diff --git a/libguile/num2float.i.c b/libguile/num2float.i.c index 22efffb1d..a3e669266 100644 --- a/libguile/num2float.i.c +++ b/libguile/num2float.i.c @@ -32,8 +32,7 @@ SCM FLOAT2NUM (FTYPE n) { SCM z; - SCM_NEWCELL2 (z); - SCM_SET_CELL_TYPE (z, scm_tc16_real); + z = scm_alloc_double_cell (scm_tc16_real, 0, 0, 0); SCM_REAL_VALUE (z) = n; return z; } diff --git a/libguile/numbers.c b/libguile/numbers.c index f0d23a138..daf8d5da7 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1390,9 +1390,7 @@ scm_i_mkbig (size_t nlen, int sign) base = scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum); - SCM_NEWCELL (v); - SCM_SET_BIGNUM_BASE (v, base); - SCM_SETNUMDIGS (v, nlen, sign); + v = scm_alloc_cell (SCM_MAKE_BIGNUM_TAG (nlen, sign), (scm_t_bits) base); return v; } @@ -2829,8 +2827,7 @@ SCM scm_make_real (double x) { SCM z; - SCM_NEWCELL2 (z); - SCM_SET_CELL_TYPE (z, scm_tc16_real); + z = scm_alloc_double_cell (scm_tc16_real, 0, 0, 0); SCM_REAL_VALUE (z) = x; return z; } diff --git a/libguile/pairs.c b/libguile/pairs.c index 88ce017c4..5216de8bb 100644 --- a/libguile/pairs.c +++ b/libguile/pairs.c @@ -80,11 +80,7 @@ SCM_DEFINE (scm_cons, "cons", 2, 0, 0, "sense of @code{eq?}) from every previously existing object.") #define FUNC_NAME s_scm_cons { - SCM z; - SCM_NEWCELL (z); - SCM_SET_CELL_OBJECT_0 (z, x); - SCM_SET_CELL_OBJECT_1 (z, y); - return z; + return scm_alloc_cell (SCM_UNPACK (x), SCM_UNPACK (y)); } #undef FUNC_NAME @@ -92,18 +88,7 @@ SCM_DEFINE (scm_cons, "cons", 2, 0, 0, SCM scm_cons2 (SCM w, SCM x, SCM y) { - SCM z1; - 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; + return scm_cons (w, scm_cons (x, y)); } diff --git a/libguile/ports.c b/libguile/ports.c index 6e79e9ab7..efeb4cf46 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1527,7 +1527,7 @@ scm_void_port (char *mode_str) SCM answer; scm_t_port * pt; - SCM_NEWCELL (answer); + answer = scm_alloc_cell (scm_tc16_void_port, 0); SCM_DEFER_INTS; mode_bits = scm_mode_bits (mode_str); pt = scm_add_to_port_table (answer); diff --git a/libguile/print.c b/libguile/print.c index 3e7849314..64bd23e89 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -249,10 +249,8 @@ scm_free_print_state (SCM print_state) */ pstate->fancyp = 0; pstate->revealed = 0; - SCM_NEWCELL (handle); SCM_DEFER_INTS; - SCM_SET_CELL_WORD_0 (handle, print_state); - SCM_SET_CELL_WORD_1 (handle, print_state_pool); + handle = scm_cons (print_state, print_state_pool); print_state_pool = handle; SCM_ALLOW_INTS; } diff --git a/libguile/procs.c b/libguile/procs.c index 6f3dca63a..c53e532e2 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -86,16 +86,12 @@ scm_c_make_subr (const char *name, long type, SCM (*fcn) ()) scm_subr_table_room = new_size; } - SCM_NEWCELL (z); - 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].name = scm_str2symbol (name); scm_subr_table[entry].generic = 0; scm_subr_table[entry].properties = SCM_EOL; - - SCM_SET_SUBRF (z, fcn); - SCM_SET_CELL_TYPE (z, (entry << 8) + type); scm_subr_table_size++; return z; @@ -165,12 +161,8 @@ scm_makcclo (SCM proc, size_t len) for (i = 0; i < len; ++i) base [i] = SCM_UNPACK (SCM_UNSPECIFIED); - SCM_NEWCELL (s); - SCM_DEFER_INTS; - SCM_SET_CCLO_BASE (s, base); - SCM_SET_CCLO_LENGTH (s, len); + s = scm_alloc_cell (SCM_MAKE_CCLO_TAG (len), (scm_t_bits) base); SCM_SET_CCLO_SUBR (s, proc); - SCM_ALLOW_INTS; 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}.") #define FUNC_NAME s_scm_make_procedure_with_setter { - SCM z; SCM_VALIDATE_PROC (1, procedure); SCM_VALIDATE_PROC (2, setter); - SCM_NEWCELL2 (z); - SCM_ENTER_A_SECTION; - SCM_SET_CELL_OBJECT_1 (z, procedure); - SCM_SET_CELL_OBJECT_2 (z, setter); - SCM_SET_CELL_TYPE (z, scm_tc7_pws); - SCM_EXIT_A_SECTION; - return z; + return scm_alloc_double_cell (scm_tc7_pws, + SCM_UNPACK (procedure), + SCM_UNPACK (setter), 0); } #undef FUNC_NAME diff --git a/libguile/smob.c b/libguile/smob.c index b4935ba81..788e6a8fd 100644 --- a/libguile/smob.c +++ b/libguile/smob.c @@ -456,23 +456,10 @@ scm_make_smob (scm_t_bits tc) { long n = SCM_TC2SMOBNUM (tc); size_t size = scm_smobs[n].size; - SCM z; - SCM_NEWCELL (z); - if (size != 0) - { -#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; + scm_t_bits data = (size > 0 + ? (scm_t_bits) scm_must_malloc (size, SCM_SMOBNAME (n)) + : 0); + return scm_alloc_cell (tc, data); } diff --git a/libguile/smob.h b/libguile/smob.h index e804a60dc..be87b255e 100644 --- a/libguile/smob.h +++ b/libguile/smob.h @@ -72,9 +72,7 @@ typedef struct scm_smob_descriptor #define SCM_NEWSMOB(z, tc, data) \ do { \ - SCM_NEWCELL (z); \ - SCM_SET_CELL_WORD_1 ((z), (data)); \ - SCM_SET_CELL_TYPE ((z), (tc)); \ + z = scm_alloc_cell ((tc), (scm_t_bits) (data)); \ } while (0) #define SCM_RETURN_NEWSMOB(tc, data) \ @@ -85,10 +83,8 @@ do { \ #define SCM_NEWSMOB2(z, tc, data1, data2) \ do { \ - SCM_NEWCELL2 (z); \ - SCM_SET_CELL_WORD_1 ((z), (data1)); \ - SCM_SET_CELL_WORD_2 ((z), (data2)); \ - SCM_SET_CELL_TYPE ((z), (tc)); \ + z = scm_alloc_double_cell ((tc), (scm_t_bits)(data1), \ + (scm_t_bits)(data2), 0); \ } while (0) #define SCM_RETURN_NEWSMOB2(tc, data1, data2) \ @@ -99,11 +95,8 @@ do { \ #define SCM_NEWSMOB3(z, tc, data1, data2, data3) \ do { \ - SCM_NEWCELL2 (z); \ - SCM_SET_CELL_WORD_1 ((z), (data1)); \ - SCM_SET_CELL_WORD_2 ((z), (data2)); \ - SCM_SET_CELL_WORD_3 ((z), (data3)); \ - SCM_SET_CELL_TYPE ((z), (tc)); \ + z = scm_alloc_double_cell ((tc), (scm_t_bits)(data1), \ + (scm_t_bits)(data2), (scm_t_bits)(data3)); \ } while (0) #define SCM_RETURN_NEWSMOB3(tc, data1, data2, data3) \ diff --git a/libguile/strings.c b/libguile/strings.c index 8bd7de872..680707261 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -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_NEWCELL (answer); - SCM_SET_STRING_CHARS (answer, s); - SCM_SET_STRING_LENGTH (answer, len); + answer = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) s); scm_done_malloc (len + 1); return answer; @@ -196,9 +194,7 @@ scm_allocate_string (size_t len) mem = (char *) scm_must_malloc (len + 1, FUNC_NAME); mem[len] = 0; - SCM_NEWCELL (s); - SCM_SET_STRING_CHARS (s, mem); - SCM_SET_STRING_LENGTH (s, len); + s = scm_alloc_cell (SCM_MAKE_STRING_TAG (len), (scm_t_bits) mem); return s; } diff --git a/libguile/strports.c b/libguile/strports.c index 612d98b27..daf68b5f3 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -279,7 +279,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller) scm_out_of_range (caller, pos); if (!((modes & SCM_WRTNG) || (modes & SCM_RDNG))) 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; pt = scm_add_to_port_table (z); SCM_SET_CELL_TYPE (z, scm_tc16_strport | modes); diff --git a/libguile/struct.c b/libguile/struct.c index 9a580cb41..9d75e43f0 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -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]); basic_size = SCM_SYMBOL_LENGTH (layout) / 2; tail_elts = SCM_INUM (tail_array_size); - SCM_NEWCELL2 (handle); SCM_DEFER_INTS; 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, scm_struct_n_extra_words, "make-struct"); - SCM_SET_CELL_WORD_1 (handle, data); - SCM_SET_STRUCT_GC_CHAIN (handle, 0); + handle = scm_alloc_double_cell ((((scm_t_bits) SCM_STRUCT_DATA (vtable)) + + scm_tc3_struct), + (scm_t_bits) data, 0, 0); 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; return handle; } @@ -540,16 +538,14 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1, layout = scm_make_struct_layout (fields); basic_size = SCM_SYMBOL_LENGTH (layout) / 2; tail_elts = SCM_INUM (tail_array_size); - SCM_NEWCELL2 (handle); SCM_DEFER_INTS; data = scm_alloc_struct (basic_size + tail_elts, scm_struct_n_extra_words, "make-vtable-vtable"); - SCM_SET_CELL_WORD_1 (handle, data); - SCM_SET_STRUCT_GC_CHAIN (handle, 0); + handle = scm_alloc_double_cell ((scm_t_bits) data + scm_tc3_struct, + (scm_t_bits) data, 0, 0); data [scm_vtable_index_layout] = SCM_UNPACK (layout); 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; return handle; } diff --git a/libguile/symbols.c b/libguile/symbols.c index f833eb2be..0a408234b 100644 --- a/libguile/symbols.c +++ b/libguile/symbols.c @@ -125,11 +125,11 @@ scm_mem2symbol (const char *name, size_t len) SCM cell; SCM slot; - SCM_NEWCELL2 (symbol); - SCM_SET_SYMBOL_CHARS (symbol, scm_must_strndup (name, len)); - SCM_SET_SYMBOL_HASH (symbol, raw_hash); - SCM_SET_PROP_SLOTS (symbol, scm_cons (SCM_BOOL_F, SCM_EOL)); - SCM_SET_SYMBOL_LENGTH (symbol, (long) len); + symbol = scm_alloc_double_cell (SCM_MAKE_SYMBOL_TAG (len), + (scm_t_bits) scm_must_strndup (name, len), + raw_hash, + SCM_UNPACK (scm_cons (SCM_BOOL_F, + SCM_EOL))); slot = SCM_VELTS (symbols) [hash]; cell = scm_cons (symbol, SCM_UNDEFINED); diff --git a/libguile/unif.c b/libguile/unif.c index 17470207e..94107db11 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -165,19 +165,16 @@ scm_make_uve (long k, SCM prot) if (SCM_EQ_P (prot, SCM_BOOL_T)) { - SCM_NEWCELL (v); 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); - SCM_SET_BITVECTOR_BASE (v, (char *) scm_must_malloc (i, "vector")); - SCM_SET_BITVECTOR_LENGTH (v, k); + v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (k), + (scm_t_bits) scm_must_malloc (i, "vector")); } else - { - SCM_SET_BITVECTOR_BASE (v, 0); - SCM_SET_BITVECTOR_LENGTH (v, 0); - } + v = scm_alloc_cell (SCM_MAKE_BITVECTOR_TAG (0), 0); return v; } 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_NEWCELL (v); - SCM_DEFER_INTS; - 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; + return scm_alloc_cell (SCM_MAKE_UVECTOR_TAG (k, type), + (scm_t_bits) scm_must_malloc (i ? i : 1, "vector")); } #undef FUNC_NAME @@ -525,7 +518,6 @@ SCM scm_make_ra (int ndim) { SCM ra; - SCM_NEWCELL (ra); SCM_DEFER_INTS; SCM_NEWSMOB(ra, ((scm_t_bits) ndim << 17) + scm_tc16_array, scm_must_malloc ((sizeof (scm_t_array) + diff --git a/libguile/variable.c b/libguile/variable.c index b0e9b61d9..66f82b9de 100644 --- a/libguile/variable.c +++ b/libguile/variable.c @@ -68,12 +68,7 @@ scm_i_variable_print (SCM exp, SCM port, scm_print_state *pstate) static SCM make_variable (SCM init) { - SCM z; - 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; + return scm_alloc_cell (scm_tc7_variable, SCM_UNPACK (init)); } SCM_DEFINE (scm_make_variable, "make-variable", 1, 0, 0, diff --git a/libguile/vectors.c b/libguile/vectors.c index 425eee58a..db9c18669 100644 --- a/libguile/vectors.c +++ b/libguile/vectors.c @@ -214,9 +214,8 @@ scm_c_make_vector (unsigned long int k, SCM fill) else base = NULL; - SCM_NEWCELL (v); - SCM_SET_VECTOR_BASE (v, base); - SCM_SET_VECTOR_LENGTH (v, k, scm_tc7_vector); + v = scm_alloc_cell (SCM_MAKE_VECTOR_TAG (k, scm_tc7_vector), + (scm_t_bits) base); scm_remember_upto_here_1 (fill); return v; diff --git a/libguile/vports.c b/libguile/vports.c index bce6bb867..c25bc204f 100644 --- a/libguile/vports.c +++ b/libguile/vports.c @@ -189,7 +189,7 @@ SCM_DEFINE (scm_make_soft_port, "make-soft-port", 2, 0, 0, SCM z; SCM_VALIDATE_VECTOR_LEN (1,pv,5); SCM_VALIDATE_STRING (2, modes); - SCM_NEWCELL (z); + z = scm_alloc_cell (scm_tc16_sfport, 0); SCM_DEFER_INTS; pt = scm_add_to_port_table (z); scm_port_non_buffer (pt); diff --git a/libguile/weaks.c b/libguile/weaks.c index 74ce39703..277b102b3 100644 --- a/libguile/weaks.c +++ b/libguile/weaks.c @@ -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); 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) { 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); for (j = 0; j != c_size; ++j) base[j] = SCM_UNPACK (fill); - SCM_SET_VECTOR_BASE (v, base); - SCM_SET_VECTOR_LENGTH (v, c_size, scm_tc7_wvect); + v = scm_alloc_double_cell (SCM_MAKE_VECTOR_TAG (c_size, + scm_tc7_wvect), + (scm_t_bits) base, + type, + SCM_UNPACK (SCM_EOL)); scm_remember_upto_here_1 (fill); } else { - SCM_SET_VECTOR_BASE (v, NULL); - SCM_SET_VECTOR_LENGTH (v, 0, scm_tc7_wvect); + v = scm_alloc_double_cell (SCM_MAKE_VECTOR_TAG (0, + scm_tc7_wvect), + (scm_t_bits) NULL, + type, + SCM_UNPACK (SCM_EOL)); } return v; |