This is the mail archive of the
guile@sourceware.cygnus.com
mailing list for the Guile project.
[patch] multi-cells (was: Re: Proposal for a Guile binary file format)
Mikael Djurfeldt <mdj@mdj.nada.kth.se> writes:
> Besides, I think 4-word cells have been implemented already, both by
> Michael Livshin and Greg Harvey.
here you go. now that I look at it, I probably went slightly
overboard with converting various malloced smobs to multi-cells...
the summary is thus: with this patch, we have double- and triple-
cells. real (double) and complex numbers are now double-cells and
triple-cells, respectively. that should hopefully speed up non-integer
arithmetic (not that I ever measured this, but it should be true ;).
1999-11-21 Michael Livshin <mlivshin@bigfoot.com>
The following changes implement primitive support for double and
triple cells (i.e. four- and six-word cells) and change the
representation of some things to multi-cells instead of
cons+malloc.
* pairs.h (SCM_NEWCELL{2,3}): double- and triple-cell variants of
SCM_NEWCELL.
(SCM_CELL_{WORD,SETWORD,WORDLOC}): primitive multi-cell access
macros (used by the ones below).
(SCM_CELL_WORD[0-5], SCM_CELL_SETWORD[0-5]): multi-cell access
macros.
* gc.c: (scm_freelist{2,3}): multi-cell freelists.
(inner_map_free_list): map_free_list, parameterized on ncells.
"nn cells in segment mm" was misleading for ncells > 1; changed to
"objects". still print cells too, though.
(scm_map_free_list): rewritten using inner_map_free_list.
(scm_check_freelist): get freelist as parameter, since now we have
more than one.
(scm_debug_newcell{2,3}): multi-cell variants of
scm_debug_newcell.
(scm_gc_for_newcell): take ncells and freelist pointer as
parameters.
(scm_gc_mark): add case for tc7_pws (procedures with setters are
now double cells).
(scm_gc_sweep): don't free the float data, since it's not malloced
anymore.
(init_heap_seg): didn't understand what n_new_objects stood for,
so changed to n_new_cells.
(make_initial_segment): new function, makes an initial segment
according to given ncells.
(scm_init_storage): call make_initial_segment, for ncells={1,2,3}.
* numbers.c (scm_makdbl): no malloc'ing needed, so the
{DEFER,ALLOW}_INTS thing removed.
* numbers.h (struct scm_dbl): changed to represent a double cell,
with the number in the second half.
(struct scm_cplx): new, represents a complex number as a triple
cell.
* dynwind.c: changed the wind-guards representation to double
cell.
* procs.[ch]: changed the procedure-with-setter representation
to double cell.
* async.[ch]: made async representation a double cell.
* guardians.c: made guardian representation a triple cell.
* dynl.c: made dynamic_obj representation a double cell.
Index: libguile/async.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/async.c,v
retrieving revision 1.20
diff -u -b -r1.20 async.c
--- async.c 1999/07/07 09:43:36 1.20
+++ async.c 1999/11/21 00:11:44
@@ -282,11 +282,16 @@
scm_async (thunk)
SCM thunk;
{
- struct scm_async * async
- = (struct scm_async *) scm_must_malloc (sizeof (*async), s_async);
+ SCM z;
+ struct scm_async * async;
+
+ SCM_NEWCELL2 (z);
+ async = SCM_ASYNC (z);
async->got_it = 0;
async->thunk = thunk;
- SCM_RETURN_NEWSMOB (scm_tc16_async, async);
+ SCM_CELL_SETWORD0 (z, scm_tc16_async);
+
+ return z;
}
SCM_PROC(s_system_async, "system-async", 1, 0, 0, scm_system_async);
@@ -299,7 +304,9 @@
SCM list;
it = scm_async (thunk);
- SCM_NEWSMOB (list, it, scm_asyncs);
+ SCM_NEWCELL (list);
+ SCM_SETCAR (list, it);
+ SCM_SETCDR (list, scm_asyncs);
scm_asyncs = list;
return it;
}
@@ -467,7 +474,7 @@
scm_init_async ()
{
SCM a_thunk;
- scm_tc16_async = scm_make_smob_type_mfpe ("async", sizeof (struct scm_async),
+ scm_tc16_async = scm_make_smob_type_mfpe ("async", 0,
mark_async, NULL, NULL, NULL);
scm_gc_vcell = scm_sysintern ("gc-thunk", SCM_BOOL_F);
a_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk);
Index: libguile/async.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/async.h,v
retrieving revision 1.10
diff -u -b -r1.10 async.h
--- async.h 1998/10/19 21:35:08 1.10
+++ async.h 1999/11/21 00:11:44
@@ -49,11 +49,11 @@
#define SCM_ASYNCP(X) (scm_tc16_async == SCM_GCTYP16 (X))
-#define SCM_ASYNC(X) ((struct scm_async *)SCM_CDR (X))
+#define SCM_ASYNC(X) ((struct scm_async *)(&SCM_CDR (X)))
struct scm_async
{
- int got_it; /* needs to be delivered? */
+ long got_it; /* needs to be delivered? */
SCM thunk; /* the handler. */
};
Index: libguile/dynl.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/dynl.c,v
retrieving revision 1.19
diff -u -b -r1.19 dynl.c
--- dynl.c 1999/07/07 09:43:40 1.19
+++ dynl.c 1999/11/21 00:11:48
@@ -298,22 +298,17 @@
void *handle;
};
+#define DYNL_OBJ(x) ((struct dynl_obj *)(&SCM_CDR(x)))
+
+#define DYNL_FILENAME(x) (DYNL_OBJ (x)->filename)
+#define DYNL_HANDLE(x) (DYNL_OBJ (x)->handle)
+
static SCM mark_dynl_obj SCM_P ((SCM ptr));
static SCM
mark_dynl_obj (ptr)
SCM ptr;
-{
- struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (ptr);
- return d->filename;
-}
-
-static scm_sizet free_dynl_obj SCM_P ((SCM ptr));
-static scm_sizet
-free_dynl_obj (ptr)
- SCM ptr;
{
- scm_must_free ((char *)SCM_CDR (ptr));
- return sizeof (struct dynl_obj);
+ return DYNL_FILENAME (ptr);
}
static int print_dynl_obj SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
@@ -323,10 +318,9 @@
SCM port;
scm_print_state *pstate;
{
- struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (exp);
scm_puts ("#<dynamic-object ", port);
- scm_iprin1 (d->filename, port, pstate);
- if (d->handle == NULL)
+ scm_iprin1 (DYNL_FILENAME (exp), port, pstate);
+ if (DYNL_HANDLE (exp) == NULL)
scm_puts (" (unlinked)", port);
scm_putc ('>', port);
return 1;
@@ -344,7 +338,6 @@
{
SCM z;
void *handle;
- struct dynl_obj *d;
int flags = DYNL_GLOBAL;
fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
@@ -373,19 +366,19 @@
scm_cons (kw, SCM_EOL));
}
+ SCM_NEWCELL2 (z);
+
SCM_DEFER_INTS;
+
handle = sysdep_dynl_link (SCM_CHARS (fname), flags, s_dynamic_link);
- d = (struct dynl_obj *)scm_must_malloc (sizeof (struct dynl_obj),
- s_dynamic_link);
- d->filename = fname;
- d->handle = handle;
-
- SCM_NEWCELL (z);
- SCM_SETCHARS (z, d);
- SCM_SETCAR (z, scm_tc16_dynamic_obj);
+ DYNL_FILENAME (z) = fname;
+ DYNL_HANDLE (z) = handle;
+
SCM_ALLOW_INTS;
+ SCM_CELL_SETWORD0 (z, scm_tc16_dynamic_obj);
+
return z;
}
@@ -399,7 +392,7 @@
struct dynl_obj *d;
SCM_ASSERT (SCM_NIMP (dobj) && SCM_CAR (dobj) == scm_tc16_dynamic_obj,
dobj, argn, subr);
- d = (struct dynl_obj *)SCM_CDR (dobj);
+ d = DYNL_OBJ (dobj);
SCM_ASSERT (d->handle != NULL, dobj, argn, subr);
return d;
}
@@ -490,8 +483,8 @@
void
scm_init_dynamic_linking ()
{
- scm_tc16_dynamic_obj = scm_make_smob_type_mfpe ("dynamic-object", sizeof (struct dynl_obj),
- mark_dynl_obj, free_dynl_obj,
+ scm_tc16_dynamic_obj = scm_make_smob_type_mfpe ("dynamic-object", NULL,
+ mark_dynl_obj, NULL,
print_dynl_obj, NULL);
sysdep_dynl_init ();
#include "dynl.x"
Index: libguile/dynwind.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/dynwind.c,v
retrieving revision 1.13
diff -u -b -r1.13 dynwind.c
--- dynwind.c 1999/09/12 11:16:13 1.13
+++ dynwind.c 1999/11/21 00:11:49
@@ -91,27 +91,13 @@
* smob. Objects of this type are pushed onto the dynwind chain.
*/
-typedef struct guardsmem {
- scm_guard_t before;
- scm_guard_t after;
- void *data;
-} guardsmem;
-
-#define SCM_GUARDSMEM(obj) ((guardsmem *) SCM_CDR (obj))
-#define SCM_BEFORE_GUARD(obj) (SCM_GUARDSMEM (obj)->before)
-#define SCM_AFTER_GUARD(obj) (SCM_GUARDSMEM (obj)->after)
-#define SCM_GUARD_DATA(obj) (SCM_GUARDSMEM (obj)->data)
-#define SCM_GUARDSP(obj) (SCM_CAR (obj) == tc16_guards)
+#define SCM_GUARDSP(obj) (SCM_CELL_WORD (obj, 0) == tc16_guards)
+#define SCM_BEFORE_GUARD(obj) ((scm_guard_t)SCM_CELL_WORD (obj, 1))
+#define SCM_AFTER_GUARD(obj) ((scm_guard_t)SCM_CELL_WORD (obj, 2))
+#define SCM_GUARD_DATA(obj) ((void *)SCM_CELL_WORD (obj, 3))
static long tc16_guards;
-static scm_sizet
-freeguards (SCM guards)
-{
- scm_must_free ((char *) SCM_CDR (guards));
- return sizeof (guardsmem);
-}
-
static int
printguards (SCM exp, SCM port, scm_print_state *pstate)
{
@@ -129,13 +115,12 @@
void *guard_data)
{
SCM guards, ans;
- guardsmem *g;
before (guard_data);
- g = (guardsmem *) scm_must_malloc (sizeof (*g), "guards");
- g->before = before;
- g->after = after;
- g->data = guard_data;
- SCM_NEWSMOB (guards, tc16_guards, g);
+ SCM_NEWCELL2 (guards);
+ SCM_CELL_SETWORD (guards, 1, (SCM)before);
+ SCM_CELL_SETWORD (guards, 2, (SCM)after);
+ SCM_CELL_SETWORD (guards, 3, (SCM)guard_data);
+ SCM_CELL_SETWORD (guards, 0, tc16_guards);
scm_dynwinds = scm_acons (guards, SCM_BOOL_F, scm_dynwinds);
ans = inner (inner_data);
scm_dynwinds = SCM_CDR (scm_dynwinds);
@@ -245,7 +230,7 @@
void
scm_init_dynwind ()
{
- tc16_guards = scm_make_smob_type_mfpe ("guards", sizeof (struct guardsmem),
- NULL, freeguards, printguards, NULL);
+ tc16_guards = scm_make_smob_type_mfpe ("guards", 0,
+ NULL, scm_free0, printguards, NULL);
#include "dynwind.x"
}
Index: libguile/gc.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/gc.c,v
retrieving revision 1.65
diff -u -b -r1.65 gc.c
--- gc.c 1999/11/19 18:16:19 1.65
+++ gc.c 1999/11/21 00:12:00
@@ -142,6 +142,8 @@
* is the head of freelist of cons pairs.
*/
SCM scm_freelist = SCM_EOL;
+SCM scm_freelist2 = SCM_EOL;
+SCM scm_freelist3 = SCM_EOL;
/* scm_mtrigger
* is the number of bytes of must_malloc allocation needed to trigger gc.
@@ -237,30 +239,41 @@
abort ();
}
-
-SCM_PROC (s_map_free_list, "map-free-list", 0, 0, 0, scm_map_free_list);
-SCM
-scm_map_free_list ()
+static void
+inner_map_free_list (int ncells, SCM freelist)
{
- int last_seg = -1, count = 0;
+ int last_seg = -1, count = 0, i, segs = 0;
SCM f;
- fprintf (stderr, "%d segments total\n", scm_n_heap_segs);
- for (f = scm_freelist; SCM_NIMP (f); f = SCM_CDR (f))
+ for (i = 0; i < scm_n_heap_segs; ++i)
+ if (scm_heap_table[i].ncells == ncells)
+ ++segs;
+
+ fprintf (stderr, "ncells = %d: %d segments total\n", ncells, segs);
+ for (f = freelist; SCM_NIMP (f); f = SCM_CDR (f))
{
int this_seg = which_seg (f);
if (this_seg != last_seg)
{
if (last_seg != -1)
- fprintf (stderr, " %5d cells in segment %d\n", count, last_seg);
+ fprintf (stderr, " %5d objects (%5d cells) in segment %d\n", count, count * ncells, last_seg);
last_seg = this_seg;
count = 0;
}
count++;
}
if (last_seg != -1)
- fprintf (stderr, " %5d cells in segment %d\n", count, last_seg);
+ fprintf (stderr, " %5d objects (%5d cells) in segment %d\n", count, count * ncells, last_seg);
+}
+
+SCM_PROC (s_map_free_list, "map-free-list", 0, 0, 0, scm_map_free_list);
+SCM
+scm_map_free_list ()
+{
+ inner_map_free_list (1, scm_freelist);
+ inner_map_free_list (2, scm_freelist2);
+ inner_map_free_list (3, scm_freelist3);
fflush (stderr);
@@ -270,16 +283,18 @@
/* Number of calls to SCM_NEWCELL since startup. */
static unsigned long scm_newcell_count;
+static unsigned long scm_newcell2_count;
+static unsigned long scm_newcell3_count;
/* Search freelist for anything that isn't marked as a free cell.
Abort if we find something. */
static void
-scm_check_freelist ()
+scm_check_freelist (SCM freelist)
{
SCM f;
int i = 0;
- for (f = scm_freelist; SCM_NIMP (f); f = SCM_CDR (f), i++)
+ for (f = freelist; SCM_NIMP (f); f = SCM_CDR (f), i++)
if (SCM_CAR (f) != (SCM) scm_tc_free_cell)
{
fprintf (stderr, "Bad cell in freelist on newcell %lu: %d'th elt\n",
@@ -309,14 +324,14 @@
scm_newcell_count++;
if (scm_debug_check_freelist) {
- scm_check_freelist ();
+ scm_check_freelist (scm_freelist);
scm_gc();
}
/* The rest of this is supposed to be identical to the SCM_NEWCELL
macro. */
if (SCM_IMP (scm_freelist))
- new = scm_gc_for_newcell ();
+ new = scm_gc_for_newcell (1, &scm_freelist);
else
{
new = scm_freelist;
@@ -327,6 +342,56 @@
return new;
}
+SCM
+scm_debug_newcell2 (void)
+{
+ SCM new;
+
+ scm_newcell2_count++;
+ if (scm_debug_check_freelist) {
+ scm_check_freelist (scm_freelist2);
+ scm_gc();
+ }
+
+ /* The rest of this is supposed to be identical to the SCM_NEWCELL2
+ macro. */
+ if (SCM_IMP (scm_freelist2))
+ new = scm_gc_for_newcell (2, &scm_freelist2);
+ else
+ {
+ new = scm_freelist2;
+ scm_freelist2 = SCM_CDR (scm_freelist2);
+ scm_cells_allocated += 2;
+ }
+
+ return new;
+}
+
+SCM
+scm_debug_newcell3 (void)
+{
+ SCM new;
+
+ scm_newcell3_count++;
+ if (scm_debug_check_freelist) {
+ scm_check_freelist (scm_freelist3);
+ scm_gc();
+ }
+
+ /* The rest of this is supposed to be identical to the SCM_NEWCELL3
+ macro. */
+ if (SCM_IMP (scm_freelist3))
+ new = scm_gc_for_newcell (3, &scm_freelist3);
+ else
+ {
+ new = scm_freelist3;
+ scm_freelist3 = SCM_CDR (scm_freelist3);
+ scm_cells_allocated += 3;
+ }
+
+ return new;
+}
+
#endif /* GUILE_DEBUG_FREELIST */
@@ -438,12 +503,12 @@
SCM
-scm_gc_for_newcell ()
+scm_gc_for_newcell (int ncells, SCM * freelistp)
{
SCM fl;
- scm_gc_for_alloc (1, &scm_freelist);
- fl = scm_freelist;
- scm_freelist = SCM_CDR (fl);
+ scm_gc_for_alloc (ncells, freelistp);
+ fl = *freelistp;
+ *freelistp = SCM_CDR (fl);
return fl;
}
@@ -640,10 +705,16 @@
ptr = SCM_GCCDR (ptr);
goto gc_mark_nimp;
case scm_tcs_cons_imcar:
+ if (SCM_GCMARKP (ptr))
+ break;
+ SCM_SETGCMARK (ptr);
+ ptr = SCM_GCCDR (ptr);
+ goto gc_mark_loop;
case scm_tc7_pws:
if (SCM_GCMARKP (ptr))
break;
SCM_SETGCMARK (ptr);
+ scm_gc_mark (SCM_CELL_WORD (ptr, 2));
ptr = SCM_GCCDR (ptr);
goto gc_mark_loop;
case scm_tcs_cons_gloc:
@@ -1281,19 +1352,6 @@
case scm_tc16_flo:
if SCM_GC8MARKP (scmptr)
goto c8mrkcontinue;
- switch ((int) (SCM_CAR (scmptr) >> 16))
- {
- case (SCM_IMAG_PART | SCM_REAL_PART) >> 16:
- m += sizeof (double);
- case SCM_REAL_PART >> 16:
- case SCM_IMAG_PART >> 16:
- m += sizeof (double);
- goto freechars;
- case 0:
- break;
- default:
- goto sweeperr;
- }
break;
default:
if SCM_GC8MARKP (scmptr)
@@ -1352,7 +1410,7 @@
*hp_freelist = nfreelist;
#ifdef GUILE_DEBUG_FREELIST
- scm_check_freelist ();
+ scm_check_freelist (*hp_freelist);
scm_map_free_list ();
#endif
@@ -1619,13 +1677,15 @@
#endif
SCM_CELLPTR seg_end;
int new_seg_index;
- int n_new_objects;
+ int n_new_cells;
if (seg_org == NULL)
return 0;
ptr = seg_org;
+ size = (size / sizeof(scm_cell) / ncells) * ncells * sizeof(scm_cell);
+
/* Compute the ceiling on valid object pointers w/in this segment.
*/
seg_end = CELL_DN ((char *) ptr + size);
@@ -1659,7 +1719,8 @@
ptr = CELL_UP (ptr);
- n_new_objects = seg_end - ptr;
+ /*n_new_objects*/
+ n_new_cells = seg_end - ptr;
/* Prepend objects in this segment to the freelist.
*/
@@ -1681,7 +1742,7 @@
SCM_SETCDR (PTR2SCM (ptr), *freelistp);
*freelistp = PTR2SCM (CELL_UP (seg_org));
- scm_heap_size += (ncells * n_new_objects);
+ scm_heap_size += n_new_cells;
return size;
#ifdef scmptr
#undef scmptr
@@ -1894,8 +1955,30 @@
}
+static int
+make_initial_segment(scm_sizet init_heap_size,
+ int ncells,
+ SCM *freelistp)
+{
+ if (0L == init_heap_size)
+ init_heap_size = SCM_INIT_HEAP_SIZE;
+ if (!init_heap_seg ((SCM_CELLPTR) malloc (init_heap_size), init_heap_size, ncells, freelistp))
+ {
+ init_heap_size = SCM_HEAP_SEG_SIZE;
+ if (!init_heap_seg ((SCM_CELLPTR) malloc (init_heap_size), init_heap_size, ncells, freelistp))
+ return 1;
+ }
+ else
+ scm_expmem = 1;
+
+ return 0;
+}
+
+
int
-scm_init_storage (scm_sizet init_heap_size)
+scm_init_storage (scm_sizet init_heap_size,
+ scm_sizet init_heap2_size,
+ scm_sizet init_heap3_size)
{
scm_sizet j;
@@ -1904,25 +1987,22 @@
scm_sys_protects[--j] = SCM_BOOL_F;
scm_block_gc = 1;
scm_freelist = SCM_EOL;
+ scm_freelist2 = SCM_EOL;
+ scm_freelist3 = SCM_EOL;
scm_expmem = 0;
j = SCM_HEAP_SEG_SIZE;
scm_mtrigger = SCM_INIT_MALLOC_LIMIT;
scm_heap_table = ((struct scm_heap_seg_data *)
- scm_must_malloc (sizeof (struct scm_heap_seg_data), "hplims"));
- if (0L == init_heap_size)
- init_heap_size = SCM_INIT_HEAP_SIZE;
- j = init_heap_size;
- if ((init_heap_size != j)
- || !init_heap_seg ((SCM_CELLPTR) malloc (j), j, 1, &scm_freelist))
- {
- j = SCM_HEAP_SEG_SIZE;
- if (!init_heap_seg ((SCM_CELLPTR) malloc (j), j, 1, &scm_freelist))
+ scm_must_malloc (sizeof (struct scm_heap_seg_data) * 3, "hplims"));
+
+ if (make_initial_segment(init_heap_size, 1, &scm_freelist) ||
+ make_initial_segment(init_heap2_size, 2, &scm_freelist2) ||
+ make_initial_segment(init_heap3_size, 3, &scm_freelist3))
return 1;
- }
- else
- scm_expmem = 1;
+
scm_heap_org = CELL_UP (scm_heap_table[0].bounds[0]);
+
/* scm_hplims[0] can change. do not remove scm_heap_org */
scm_weak_vectors = SCM_EOL;
Index: libguile/gc.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/gc.h,v
retrieving revision 1.23
diff -u -b -r1.23 gc.h
--- gc.h 1999/09/28 00:54:26 1.23
+++ gc.h 1999/11/21 00:12:01
@@ -68,6 +68,8 @@
extern unsigned long scm_heap_size;
extern SCM_CELLPTR scm_heap_org;
extern SCM scm_freelist;
+extern SCM scm_freelist2;
+extern SCM scm_freelist3;
extern unsigned long scm_gc_cells_collected;
extern unsigned long scm_gc_malloc_collected;
extern unsigned long scm_gc_ports_collected;
@@ -78,6 +80,8 @@
#ifdef GUILE_DEBUG_FREELIST
extern SCM scm_map_free_list (void);
extern SCM scm_debug_newcell (void);
+extern SCM scm_debug_newcell2 (void);
+extern SCM scm_debug_newcell3 (void);
extern SCM scm_gc_set_debug_check_freelist_x (SCM flag);
#endif
@@ -90,7 +94,7 @@
extern void scm_gc_end (void);
extern SCM scm_gc (void);
extern void scm_gc_for_alloc (int ncells, SCM * freelistp);
-extern SCM scm_gc_for_newcell (void);
+extern SCM scm_gc_for_newcell (int ncells, SCM * freelistp);
extern void scm_igc (const char *what);
extern void scm_gc_mark (SCM p);
extern void scm_mark_locations (SCM_STACKITEM x[], scm_sizet n);
@@ -107,6 +111,8 @@
extern SCM scm_permanent_object (SCM obj);
extern SCM scm_protect_object (SCM obj);
extern SCM scm_unprotect_object (SCM obj);
-extern int scm_init_storage (scm_sizet init_heap_size);
+extern int scm_init_storage (scm_sizet init_heap_size,
+ scm_sizet init_heap2_size,
+ scm_sizet init_heap3_size);
extern void scm_init_gc (void);
#endif /* GCH */
Index: libguile/guardians.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/guardians.c,v
retrieving revision 1.6
diff -u -b -r1.6 guardians.c
--- guardians.c 1999/07/19 18:57:02 1.6
+++ guardians.c 1999/11/21 00:12:02
@@ -91,12 +91,12 @@
typedef struct guardian_t
{
+ struct guardian_t *next;
tconc_t live;
tconc_t zombies;
- struct guardian_t *next;
} guardian_t;
-#define GUARDIAN(x) ((guardian_t *) SCM_CDR (x))
+#define GUARDIAN(x) ((guardian_t *)(&SCM_CDR (x)))
#define GUARDIAN_LIVE(x) (GUARDIAN (x)->live)
#define GUARDIAN_ZOMBIES(x) (GUARDIAN (x)->zombies)
#define GUARDIAN_NEXT(x) (GUARDIAN (x)->next)
@@ -149,16 +149,20 @@
scm_make_guardian ()
{
SCM cclo = scm_makcclo (guard1, 2L);
- guardian_t *g = (guardian_t *) scm_must_malloc (sizeof (guardian_t),
- s_make_guardian);
+ guardian_t *g;
+
SCM z1 = scm_cons (SCM_BOOL_F, SCM_BOOL_F);
SCM z2 = scm_cons (SCM_BOOL_F, SCM_BOOL_F);
SCM z;
+
+ SCM_NEWCELL3 (z);
+ g = GUARDIAN (z);
+
/* A tconc starts out with one tail pair. */
g->live.head = g->live.tail = z1;
g->zombies.head = g->zombies.tail = z2;
- SCM_NEWSMOB (z, scm_tc16_guardian, g);
+ SCM_CELL_SETWORD0 (z, scm_tc16_guardian);
CCLO_G (cclo) = z;
@@ -255,7 +259,7 @@
void
scm_init_guardian()
{
- scm_tc16_guardian = scm_make_smob_type_mfpe ("guardian", sizeof (guardian_t),
+ scm_tc16_guardian = scm_make_smob_type_mfpe ("guardian", 0,
g_mark, NULL, g_print, NULL);
guard1 = scm_make_subr_opt ("guardian", scm_tc7_subr_2o, guard, 0);
Index: libguile/init.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/init.c,v
retrieving revision 1.71
diff -u -b -r1.71 init.c
--- init.c 1999/11/19 18:16:19 1.71
+++ init.c 1999/11/21 00:12:06
@@ -440,7 +440,7 @@
scm_ports_prehistory ();
scm_smob_prehistory ();
scm_tables_prehistory ();
- scm_init_storage (0);
+ scm_init_storage (0, 0, 0);
scm_init_subr_table ();
scm_init_root ();
#ifdef USE_THREADS
Index: libguile/numbers.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/numbers.c,v
retrieving revision 1.45
diff -u -b -r1.45 numbers.c
--- numbers.c 1999/11/18 22:36:28 1.45
+++ numbers.c 1999/11/21 00:12:22
@@ -2474,7 +2474,6 @@
SCM z;
if ((y == 0.0) && (x == 0.0))
return scm_flo0;
- SCM_DEFER_INTS;
if (y == 0.0)
{
#ifdef SCM_SINGLES
@@ -2489,15 +2488,16 @@
return z;
}
#endif /* def SCM_SINGLES */
- SCM_NEWSMOB(z,scm_tc_dblr,scm_must_malloc (1L * sizeof (double), "real"));
+ SCM_NEWCELL2 (z);
+ SCM_CELL_SETWORD0 (z, scm_tc_dblr);
}
else
{
- SCM_NEWSMOB(z,scm_tc_dblc,scm_must_malloc (2L * sizeof (double), "comkplex"));
+ SCM_NEWCELL3 (z);
+ SCM_CELL_SETWORD0 (z, scm_tc_dblc);
SCM_IMAG (z) = y;
}
SCM_REAL (z) = x;
- SCM_ALLOW_INTS;
return z;
}
#endif
@@ -4834,7 +4834,8 @@
#ifdef SCM_SINGLES
SCM_NEWSMOB(scm_flo0,scm_tc_flo,NULL);
#else
- SCM_NEWSMOB(scm_flo0,scm_tc_dblr,scm_must_malloc (1L * sizeof (double), "real"));
+ SCM_NEWCELL2 (scm_flo0);
+ SCM_CELL_SETWORD0 (scm_flo0, scm_tc_dblr);
SCM_REAL (scm_flo0) = 0.0;
#endif
#ifdef DBL_DIG
Index: libguile/numbers.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/numbers.h,v
retrieving revision 1.19
diff -u -b -r1.19 numbers.h
--- numbers.h 1999/11/18 22:36:28 1.19
+++ numbers.h 1999/11/21 00:12:26
@@ -130,8 +130,8 @@
#define SCM_INEXP(x) (SCM_TYP16(x)==scm_tc16_flo)
#define SCM_CPLXP(x) (SCM_CAR(x)==scm_tc_dblc)
-#define SCM_REAL(x) (*(((scm_dbl *) (SCM2PTR(x)))->real))
-#define SCM_IMAG(x) (*((double *)(SCM_CHARS(x)+sizeof(double))))
+#define SCM_REAL(x) (((scm_dbl *) (SCM2PTR(x)))->real)
+#define SCM_IMAG(x) (((scm_cplx *) (SCM2PTR(x)))->imag)
/* ((&SCM_REAL(x))[1]) */
@@ -235,8 +235,17 @@
typedef struct scm_dbl
{
SCM type;
- double *real;
+ SCM pad;
+ double real;
} scm_dbl;
+
+typedef struct scm_cplx
+{
+ SCM type;
+ SCM pad;
+ double real;
+ double imag;
+} scm_cplx;
#endif
Index: libguile/pairs.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/pairs.h,v
retrieving revision 1.11
diff -u -b -r1.11 pairs.h
--- pairs.h 1999/09/28 00:54:26 1.11
+++ pairs.h 1999/11/21 00:12:27
@@ -143,14 +143,36 @@
#define SCM_CADDDR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
#define SCM_CDDDDR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
+/* Multi-cells
+ */
+
+#define SCM_CELL_WORD(x, n) (((SCM *)(SCM2PTR (x)))[n])
+#define SCM_CELL_SETWORD(x, n, v) (SCM_CELL_WORD (x, n) = (SCM)(v))
+#define SCM_CELL_WORDLOC(x, n) (&SCM_CELL_WORD (x, n))
+
+#define SCM_CELL_WORD0(x) SCM_CELL_WORD (x, 0);
+#define SCM_CELL_WORD1(x) SCM_CELL_WORD (x, 1);
+#define SCM_CELL_WORD2(x) SCM_CELL_WORD (x, 2);
+#define SCM_CELL_WORD3(x) SCM_CELL_WORD (x, 3);
+#define SCM_CELL_WORD4(x) SCM_CELL_WORD (x, 4);
+#define SCM_CELL_WORD5(x) SCM_CELL_WORD (x, 5);
+
+#define SCM_CELL_SETWORD0(x, v) SCM_CELL_SETWORD(x, 0, v)
+#define SCM_CELL_SETWORD1(x, v) SCM_CELL_SETWORD(x, 1, v)
+#define SCM_CELL_SETWORD2(x, v) SCM_CELL_SETWORD(x, 2, v)
+#define SCM_CELL_SETWORD3(x, v) SCM_CELL_SETWORD(x, 3, v)
+#define SCM_CELL_SETWORD4(x, v) SCM_CELL_SETWORD(x, 4, v)
+#define SCM_CELL_SETWORD5(x, v) SCM_CELL_SETWORD(x, 5, v)
#ifdef GUILE_DEBUG_FREELIST
#define SCM_NEWCELL(_into) do { _into = scm_debug_newcell (); } while (0)
+#define SCM_NEWCELL2(_into) do { _into = scm_debug_newcell2 (); } while (0)
+#define SCM_NEWCELL3(_into) do { _into = scm_debug_newcell3 (); } while (0)
#else
#define SCM_NEWCELL(_into) \
do { \
if (SCM_IMP(scm_freelist)) \
- _into = scm_gc_for_newcell();\
+ _into = scm_gc_for_newcell(1, &scm_freelist);\
else \
{ \
_into = scm_freelist; \
@@ -158,6 +180,28 @@
++scm_cells_allocated; \
} \
} while(0)
+#define SCM_NEWCELL2(_into) \
+ do { \
+ if (SCM_IMP(scm_freelist2)) \
+ _into = scm_gc_for_newcell(2, &scm_freelist2);\
+ else \
+ { \
+ _into = scm_freelist2; \
+ scm_freelist2 = SCM_CDR(scm_freelist2);\
+ scm_cells_allocated += 2; \
+ } \
+ } while(0)
+#define SCM_NEWCELL3(_into) \
+ do { \
+ if (SCM_IMP(scm_freelist3)) \
+ _into = scm_gc_for_newcell(3, &scm_freelist3);\
+ else \
+ { \
+ _into = scm_freelist3; \
+ scm_freelist3 = SCM_CDR(scm_freelist3);\
+ scm_cells_allocated += 3; \
+ } \
+ } while(0)
#endif
Index: libguile/procs.c
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/procs.c,v
retrieving revision 1.20
diff -u -b -r1.20 procs.c
--- procs.c 1999/09/12 11:16:13 1.20
+++ procs.c 1999/11/21 00:12:28
@@ -325,10 +325,11 @@
procedure, SCM_ARG1, s_make_procedure_with_setter);
SCM_ASSERT (SCM_NFALSEP (scm_procedure_p (setter)),
setter, SCM_ARG2, s_make_procedure_with_setter);
- SCM_NEWCELL (z);
+ SCM_NEWCELL2 (z);
SCM_ENTER_A_SECTION;
- SCM_SETCDR (z, scm_cons (procedure, setter));
- SCM_SETCAR (z, scm_tc7_pws);
+ SCM_CELL_SETWORD (z, 1, procedure);
+ SCM_CELL_SETWORD (z, 2, setter);
+ SCM_CELL_SETWORD (z, 0, scm_tc7_pws);
SCM_EXIT_A_SECTION;
return z;
}
Index: libguile/procs.h
===================================================================
RCS file: /cvs/guile/guile/guile-core/libguile/procs.h,v
retrieving revision 1.17
diff -u -b -r1.17 procs.h
--- procs.h 1999/09/12 11:16:13 1.17
+++ procs.h 1999/11/21 00:12:30
@@ -155,8 +155,8 @@
new four-word cells. */
#define SCM_PROCEDURE_WITH_SETTER_P(obj) (SCM_TYP7 (obj) == scm_tc7_pws)
-#define SCM_PROCEDURE(obj) SCM_CADR (obj)
-#define SCM_SETTER(obj) SCM_CDDR (obj)
+#define SCM_PROCEDURE(obj) SCM_CELL_WORD (obj, 1)
+#define SCM_SETTER(obj) SCM_CELL_WORD (obj, 2)
extern scm_subr_entry *scm_subr_table;
extern int scm_subr_table_size;