* Fixed some signedness issues.
* Added conservative marking for the contents of free or allocated cells. * Changed the representation of weak vectors to use double cells. * Minor stuff.
This commit is contained in:
Dirk Herrmann
parent
5b2a7b5906
commit
592996c9ee
6 changed files with 301 additions and 177 deletions
|
|
@ -1,3 +1,66 @@
|
|||
2001-06-30 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||
|
||||
* list.c (SCM_I_CONS): Make sure the cell type is initialized
|
||||
last.
|
||||
|
||||
* gc.c (s_scm_map_free_list, scm_igc, scm_gc_sweep,
|
||||
init_heap_seg): Fixed signedness.
|
||||
|
||||
(init_heap_seg): Replaced strange for-loop with a while loop.
|
||||
|
||||
* weaks.h (WEAKSH, SCM_WEAKS_H): Rename <foo>H to SCM_<foo>_H.
|
||||
|
||||
(SCM_WVECTP): Prefer !SCM_<pred> over SCM_N<pred>.
|
||||
|
||||
The following patch adds conservative marking for the elements of
|
||||
free or allocated cells.
|
||||
|
||||
* gc.c (allocated_mark, heap_segment): New static functions.
|
||||
|
||||
(which_seg): Deleted, since the functionality is now provided by
|
||||
function heap_segment.
|
||||
|
||||
(map_free_list): Use heap_segment instead of which_seg.
|
||||
|
||||
(MARK): If cell debugging is disabled, mark free cells
|
||||
conservatively.
|
||||
|
||||
(scm_mark_locations, scm_cellp): Extracted the search for the
|
||||
heap segment of a SCM value into function heap_segment.
|
||||
|
||||
(scm_init_storage): Allocated cells must be marked
|
||||
conservatively.
|
||||
|
||||
* gc.[ch] (scm_gc_mark_cell_conservatively): New function.
|
||||
|
||||
The following patch changes the representation of weak vectors to
|
||||
double cells instead of using an extension of the vector's
|
||||
allocated memory.
|
||||
|
||||
* gc.c (MARK): Use SCM_SET_WVECT_GC_CHAIN instead of assigning to
|
||||
the result of SCM_WVECT_GC_CHAIN.
|
||||
|
||||
(scm_gc_sweep): Weak vectors don't have extra fields any more.
|
||||
|
||||
* weaks.c (allocate_weak_vector): New static function. It does
|
||||
not patch any previously created vector object during the
|
||||
construction of a weak vector, and thus doesn't need to switch
|
||||
off interrupts during vector creation.
|
||||
|
||||
(scm_make_weak_vector, scm_make_weak_key_hash_table,
|
||||
scm_make_weak_value_hash_table, scm_make_doubly_weak_hash_table):
|
||||
Use allocate_weak_vector to provide the new weak vector object.
|
||||
|
||||
* weaks.h (SCM_WVECT_TYPE, SCM_SET_WVECT_TYPE,
|
||||
SCM_SET_WVECT_GC_CHAIN): New macros. The weak vector subtype is
|
||||
now stored in the double cell.
|
||||
|
||||
(SCM_IS_WHVEC, SCM_IS_WHVEC_V, SCM_IS_WHVEC_B, SCM_IS_WHVEC_ANY):
|
||||
Use SCM_WVECT_TYPE.
|
||||
|
||||
(SCM_WVECT_GC_CHAIN): The weak objects are now chained together
|
||||
using an entry of the double cell.
|
||||
|
||||
2001-06-30 Thien-Thi Nguyen <ttn@revel.glug.org>
|
||||
|
||||
* stamp-h.in: bye bye
|
||||
|
|
|
|||
275
libguile/gc.c
275
libguile/gc.c
|
|
@ -114,6 +114,19 @@ unsigned int scm_debug_cell_accesses_p = 1;
|
|||
static unsigned int debug_cells_gc_interval = 0;
|
||||
|
||||
|
||||
/* If an allocated cell is detected during garbage collection, this means that
|
||||
* some code has just obtained the object but was preempted before the
|
||||
* initialization of the object was completed. This meanst that some entries
|
||||
* of the allocated cell may already contain SCM objects. Therefore,
|
||||
* allocated cells are scanned conservatively. */
|
||||
static SCM
|
||||
allocated_mark (SCM allocated)
|
||||
{
|
||||
scm_gc_mark_cell_conservatively (allocated);
|
||||
return SCM_BOOL_F;
|
||||
}
|
||||
|
||||
|
||||
/* Assert that the given object is a valid reference to a valid cell. This
|
||||
* test involves to determine whether the object is a cell pointer, whether
|
||||
* this pointer actually points into a heap segment and whether the cell
|
||||
|
|
@ -517,22 +530,6 @@ clear_mark_space ()
|
|||
|
||||
#if defined (GUILE_DEBUG) || defined (GUILE_DEBUG_FREELIST)
|
||||
|
||||
/* Return the number of the heap segment containing CELL. */
|
||||
static long
|
||||
which_seg (SCM cell)
|
||||
{
|
||||
long i;
|
||||
|
||||
for (i = 0; i < scm_n_heap_segs; i++)
|
||||
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], SCM2PTR (cell))
|
||||
&& SCM_PTR_GT (scm_heap_table[i].bounds[1], SCM2PTR (cell)))
|
||||
return i;
|
||||
fprintf (stderr, "which_seg: can't find segment containing cell %lux\n",
|
||||
(unsigned long) SCM_UNPACK (cell));
|
||||
abort ();
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
map_free_list (scm_t_freelist *master, SCM freelist)
|
||||
{
|
||||
|
|
@ -541,9 +538,16 @@ map_free_list (scm_t_freelist *master, SCM freelist)
|
|||
|
||||
for (f = freelist; !SCM_NULLP (f); f = SCM_FREE_CELL_CDR (f))
|
||||
{
|
||||
long this_seg = which_seg (f);
|
||||
long int this_seg = heap_segment (f);
|
||||
|
||||
if (this_seg != last_seg)
|
||||
if (this_seg == -1)
|
||||
{
|
||||
fprintf (stderr,
|
||||
"map_free_list: can't find segment containing cell %lux\n",
|
||||
(unsigned long int) SCM_UNPACK (cell));
|
||||
abort ();
|
||||
}
|
||||
else if (this_seg != last_seg)
|
||||
{
|
||||
if (last_seg != -1)
|
||||
fprintf (stderr, " %5ld %d-cells in segment %ld\n",
|
||||
|
|
@ -565,12 +569,14 @@ SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
|
|||
"@code{--enable-guile-debug} builds of Guile.")
|
||||
#define FUNC_NAME s_scm_map_free_list
|
||||
{
|
||||
long i;
|
||||
size_t i;
|
||||
|
||||
fprintf (stderr, "%ld segments total (%d:%ld",
|
||||
(long) scm_n_heap_segs,
|
||||
scm_heap_table[0].span,
|
||||
(long) (scm_heap_table[0].bounds[1] - scm_heap_table[0].bounds[0]));
|
||||
for (i = 1; i < scm_n_heap_segs; i++)
|
||||
|
||||
for (i = 1; i != scm_n_heap_segs; i++)
|
||||
fprintf (stderr, ", %d:%ld",
|
||||
scm_heap_table[i].span,
|
||||
(long) (scm_heap_table[i].bounds[1] - scm_heap_table[i].bounds[0]));
|
||||
|
|
@ -1120,10 +1126,10 @@ scm_igc (const char *what)
|
|||
|
||||
/* mark the registered roots */
|
||||
{
|
||||
long i;
|
||||
size_t i;
|
||||
for (i = 0; i < SCM_VECTOR_LENGTH (scm_gc_registered_roots); ++i) {
|
||||
SCM l = SCM_VELTS (scm_gc_registered_roots)[i];
|
||||
for (; ! SCM_NULLP (l); l = SCM_CDR (l)) {
|
||||
for (; !SCM_NULLP (l); l = SCM_CDR (l)) {
|
||||
SCM *p = (SCM *) (scm_num2long (SCM_CAAR (l), 0, NULL));
|
||||
scm_gc_mark (*p);
|
||||
}
|
||||
|
|
@ -1366,7 +1372,7 @@ gc_mark_loop_first_time:
|
|||
goto_gc_mark_loop;
|
||||
|
||||
case scm_tc7_wvect:
|
||||
SCM_WVECT_GC_CHAIN (ptr) = scm_weak_vectors;
|
||||
SCM_SET_WVECT_GC_CHAIN (ptr, scm_weak_vectors);
|
||||
scm_weak_vectors = ptr;
|
||||
if (SCM_IS_WHVEC_ANY (ptr))
|
||||
{
|
||||
|
|
@ -1449,7 +1455,27 @@ gc_mark_loop_first_time:
|
|||
switch (SCM_TYP16 (ptr))
|
||||
{ /* should be faster than going through scm_smobs */
|
||||
case scm_tc_free_cell:
|
||||
/* printf("found free_cell %X ", ptr); fflush(stdout); */
|
||||
/* We have detected a free cell. This can happen if non-object data
|
||||
* on the C stack points into guile's heap and is scanned during
|
||||
* conservative marking. */
|
||||
#if (SCM_DEBUG_CELL_ACCESSES == 0)
|
||||
/* If cell debugging is disabled, there is a second situation in
|
||||
* which a free cell can be encountered, namely if with preemptive
|
||||
* threading one thread has just obtained a fresh cell and was
|
||||
* preempted before the cell initialization was completed. In this
|
||||
* case, some entries of the cell may already contain objects.
|
||||
* Thus, if cell debugging is disabled, free cells are scanned
|
||||
* conservatively. */
|
||||
scm_gc_mark_cell_conservatively (ptr);
|
||||
#else /* SCM_DEBUG_CELL_ACCESSES == 1 */
|
||||
/* With cell debugging enabled, a freshly obtained but not fully
|
||||
* initialized cell is guaranteed to be of type scm_tc16_allocated.
|
||||
* Thus, no conservative scanning for free cells is necessary, but
|
||||
* instead cells of type scm_tc16_allocated have to be scanned
|
||||
* conservatively. This is done in the mark function of the
|
||||
* scm_tc16_allocated smob type. */
|
||||
#endif
|
||||
break;
|
||||
case scm_tc16_big:
|
||||
case scm_tc16_real:
|
||||
case scm_tc16_complex:
|
||||
|
|
@ -1493,9 +1519,97 @@ gc_mark_loop_first_time:
|
|||
#undef FNAME
|
||||
|
||||
|
||||
/* Mark a Region Conservatively
|
||||
*/
|
||||
/* Determine whether the given value does actually represent a cell in some
|
||||
* heap segment. If this is the case, the number of the heap segment is
|
||||
* returned. Otherwise, -1 is returned. Binary search is used in order to
|
||||
* determine the heap segment that contains the cell.*/
|
||||
/* FIXME: To be used within scm_gc_mark_cell_conservatively,
|
||||
* scm_mark_locations and scm_cellp this function should be an inline
|
||||
* function. */
|
||||
static long int
|
||||
heap_segment (SCM obj)
|
||||
{
|
||||
if (!SCM_CELLP (obj))
|
||||
return -1;
|
||||
else
|
||||
{
|
||||
SCM_CELLPTR ptr = SCM2PTR (obj);
|
||||
unsigned long int i = 0;
|
||||
unsigned long int j = scm_n_heap_segs - 1;
|
||||
|
||||
if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[0]))
|
||||
return -1;
|
||||
else if (SCM_PTR_LE (scm_heap_table[j].bounds[1], ptr))
|
||||
return -1;
|
||||
else
|
||||
{
|
||||
while (i < j)
|
||||
{
|
||||
if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[1]))
|
||||
{
|
||||
break;
|
||||
}
|
||||
else if (SCM_PTR_LE (scm_heap_table[j].bounds[0], ptr))
|
||||
{
|
||||
i = j;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
unsigned long int k = (i + j) / 2;
|
||||
|
||||
if (k == i)
|
||||
return -1;
|
||||
else if (SCM_PTR_LT (ptr, scm_heap_table[k].bounds[1]))
|
||||
{
|
||||
j = k;
|
||||
++i;
|
||||
if (SCM_PTR_LT (ptr, scm_heap_table[i].bounds[0]))
|
||||
return -1;
|
||||
}
|
||||
else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr))
|
||||
{
|
||||
i = k;
|
||||
--j;
|
||||
if (SCM_PTR_LE (scm_heap_table[j].bounds[1], ptr))
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if (!DOUBLECELL_ALIGNED_P (obj) && scm_heap_table[i].span == 2)
|
||||
return -1;
|
||||
else if (SCM_GC_IN_CARD_HEADERP (ptr))
|
||||
return -1;
|
||||
else
|
||||
return i;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Mark the entries of a cell conservatively. The given cell is known to be
|
||||
* on the heap. Still we have to determine its heap segment in order to
|
||||
* figure out whether it is a single or a double cell. Then, each of the cell
|
||||
* elements itself is checked and potentially marked. */
|
||||
void
|
||||
scm_gc_mark_cell_conservatively (SCM cell)
|
||||
{
|
||||
unsigned long int cell_segment = heap_segment (cell);
|
||||
unsigned int span = scm_heap_table[cell_segment].span;
|
||||
unsigned int i;
|
||||
|
||||
for (i = 1; i != span * 2; ++i)
|
||||
{
|
||||
SCM obj = SCM_CELL_OBJECT (cell, i);
|
||||
long int obj_segment = heap_segment (obj);
|
||||
if (obj_segment >= 0)
|
||||
scm_gc_mark (obj);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Mark a region conservatively */
|
||||
void
|
||||
scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
|
||||
{
|
||||
|
|
@ -1504,98 +1618,21 @@ scm_mark_locations (SCM_STACKITEM x[], unsigned long n)
|
|||
for (m = 0; m < n; ++m)
|
||||
{
|
||||
SCM obj = * (SCM *) &x[m];
|
||||
if (SCM_CELLP (obj))
|
||||
{
|
||||
SCM_CELLPTR ptr = SCM2PTR (obj);
|
||||
long i = 0;
|
||||
long j = scm_n_heap_segs - 1;
|
||||
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
|
||||
&& SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr))
|
||||
{
|
||||
while (i <= j)
|
||||
{
|
||||
long seg_id;
|
||||
seg_id = -1;
|
||||
if ((i == j)
|
||||
|| SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr))
|
||||
seg_id = i;
|
||||
else if (SCM_PTR_LE (scm_heap_table[j].bounds[0], ptr))
|
||||
seg_id = j;
|
||||
else
|
||||
{
|
||||
long k;
|
||||
k = (i + j) / 2;
|
||||
if (k == i)
|
||||
break;
|
||||
if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr))
|
||||
{
|
||||
j = k;
|
||||
++i;
|
||||
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr))
|
||||
continue;
|
||||
else
|
||||
break;
|
||||
}
|
||||
else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr))
|
||||
{
|
||||
i = k;
|
||||
--j;
|
||||
if (SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr))
|
||||
continue;
|
||||
else
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (SCM_GC_IN_CARD_HEADERP (ptr))
|
||||
break;
|
||||
|
||||
if (scm_heap_table[seg_id].span == 1
|
||||
|| DOUBLECELL_ALIGNED_P (obj))
|
||||
scm_gc_mark (obj);
|
||||
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
long int segment = heap_segment (obj);
|
||||
if (segment >= 0)
|
||||
scm_gc_mark (obj);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* The function scm_cellp determines whether an SCM value can be regarded as a
|
||||
* pointer to a cell on the heap. Binary search is used in order to determine
|
||||
* the heap segment that contains the cell.
|
||||
* pointer to a cell on the heap.
|
||||
*/
|
||||
int
|
||||
scm_cellp (SCM value)
|
||||
{
|
||||
if (SCM_CELLP (value)) {
|
||||
scm_cell * ptr = SCM2PTR (value);
|
||||
unsigned long i = 0;
|
||||
unsigned long j = scm_n_heap_segs - 1;
|
||||
|
||||
if (SCM_GC_IN_CARD_HEADERP (ptr))
|
||||
return 0;
|
||||
|
||||
while (i < j) {
|
||||
long k = (i + j) / 2;
|
||||
if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) {
|
||||
j = k;
|
||||
} else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) {
|
||||
i = k + 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
|
||||
&& SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr)
|
||||
&& (scm_heap_table[i].span == 1 || DOUBLECELL_ALIGNED_P (value))
|
||||
&& !SCM_GC_IN_CARD_HEADERP (ptr)
|
||||
)
|
||||
return 1;
|
||||
else
|
||||
return 0;
|
||||
} else
|
||||
return 0;
|
||||
long int segment = heap_segment (value);
|
||||
return (segment >= 0);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1654,7 +1691,7 @@ scm_gc_sweep ()
|
|||
register scm_t_freelist *freelist;
|
||||
register unsigned long m;
|
||||
register int span;
|
||||
long i;
|
||||
size_t i;
|
||||
size_t seg_size;
|
||||
|
||||
m = 0;
|
||||
|
|
@ -1738,9 +1775,6 @@ scm_gc_sweep ()
|
|||
case scm_tc7_pws:
|
||||
break;
|
||||
case scm_tc7_wvect:
|
||||
m += (2 + SCM_VECTOR_LENGTH (scmptr)) * sizeof (SCM);
|
||||
scm_must_free (SCM_VECTOR_BASE (scmptr) - 2);
|
||||
break;
|
||||
case scm_tc7_vector:
|
||||
{
|
||||
unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
|
||||
|
|
@ -2222,7 +2256,7 @@ init_heap_seg (SCM_CELLPTR seg_org, size_t size, scm_t_freelist *freelist)
|
|||
{
|
||||
register SCM_CELLPTR ptr;
|
||||
SCM_CELLPTR seg_end;
|
||||
long new_seg_index;
|
||||
size_t new_seg_index;
|
||||
ptrdiff_t n_new_cells;
|
||||
int span = freelist->span;
|
||||
|
||||
|
|
@ -2238,13 +2272,11 @@ init_heap_seg (SCM_CELLPTR seg_org, size_t size, scm_t_freelist *freelist)
|
|||
seg_end = SCM_GC_CARD_DOWN ((char *)seg_org + size);
|
||||
|
||||
/* Find the right place and insert the segment record.
|
||||
*
|
||||
*/
|
||||
for (new_seg_index = 0;
|
||||
( (new_seg_index < scm_n_heap_segs)
|
||||
&& SCM_PTR_LE (scm_heap_table[new_seg_index].bounds[0], seg_org));
|
||||
new_seg_index++)
|
||||
;
|
||||
new_seg_index = 0;
|
||||
while (new_seg_index < scm_n_heap_segs
|
||||
&& SCM_PTR_LE (scm_heap_table[new_seg_index].bounds[0], seg_org))
|
||||
new_seg_index++;
|
||||
|
||||
{
|
||||
int i;
|
||||
|
|
@ -2468,7 +2500,7 @@ alloc_some_heap (scm_t_freelist *freelist, policy_on_error error_policy)
|
|||
* parameters. Therefore, you can be sure that the compiler will keep those
|
||||
* scheme values alive (on the stack or in a register) up to the point where
|
||||
* scm_remember_upto_here* is called. In other words, place the call to
|
||||
* scm_remember_upt_here* _behind_ the last code in your function, that
|
||||
* scm_remember_upto_here* _behind_ the last code in your function, that
|
||||
* depends on the scheme object to exist.
|
||||
*
|
||||
* Example: We want to make sure, that the string object str does not get
|
||||
|
|
@ -2778,6 +2810,7 @@ scm_init_storage ()
|
|||
|
||||
#if (SCM_DEBUG_CELL_ACCESSES == 1)
|
||||
scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
|
||||
scm_set_smob_mark (scm_tc16_allocated, allocated_mark);
|
||||
#endif /* SCM_DEBUG_CELL_ACCESSES == 1 */
|
||||
|
||||
j = SCM_NUM_PROTECTS;
|
||||
|
|
|
|||
|
|
@ -363,6 +363,7 @@ extern void scm_alloc_cluster (struct scm_t_freelist *master);
|
|||
extern void scm_igc (const char *what);
|
||||
extern void scm_gc_mark (SCM p);
|
||||
extern void scm_gc_mark_dependencies (SCM p);
|
||||
extern void scm_gc_mark_cell_conservatively (SCM cell);
|
||||
extern void scm_mark_locations (SCM_STACKITEM x[], unsigned long n);
|
||||
extern int scm_cellp (SCM value);
|
||||
extern void scm_gc_sweep (void);
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1997, 2000 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -63,8 +63,8 @@
|
|||
#define SCM_I_CONS(cell,x,y) \
|
||||
do { \
|
||||
SCM_NEWCELL (cell); \
|
||||
SCM_SET_CELL_OBJECT_0 (cell, x); \
|
||||
SCM_SET_CELL_OBJECT_1 (cell, y); \
|
||||
SCM_SET_CELL_OBJECT_0 (cell, x); \
|
||||
} while (0)
|
||||
|
||||
SCM
|
||||
|
|
|
|||
111
libguile/weaks.c
111
libguile/weaks.c
|
|
@ -43,18 +43,72 @@
|
|||
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
|
||||
|
||||
|
||||
|
||||
#include "libguile/_scm.h"
|
||||
#include "libguile/vectors.h"
|
||||
|
||||
#include "libguile/validate.h"
|
||||
#include "libguile/weaks.h"
|
||||
|
||||
|
||||
|
||||
|
||||
/* {Weak Vectors}
|
||||
*/
|
||||
|
||||
|
||||
/* Allocate memory for a weak vector on behalf of the caller. The allocated
|
||||
* vector will be of the given weak vector subtype. It will contain size
|
||||
* elements which are initialized with the 'fill' object, or, if 'fill' is
|
||||
* undefined, with an unspecified object.
|
||||
*/
|
||||
static SCM
|
||||
allocate_weak_vector (scm_t_bits type, SCM size, SCM fill, const char* caller)
|
||||
#define FUNC_NAME caller
|
||||
{
|
||||
if (SCM_INUMP (size))
|
||||
{
|
||||
size_t c_size;
|
||||
SCM v;
|
||||
|
||||
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;
|
||||
size_t j;
|
||||
|
||||
if (SCM_UNBNDP (fill))
|
||||
fill = SCM_UNSPECIFIED;
|
||||
|
||||
SCM_ASSERT_RANGE (1, size, c_size <= SCM_VECTOR_MAX_LENGTH);
|
||||
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);
|
||||
scm_remember_upto_here_1 (fill);
|
||||
}
|
||||
else
|
||||
{
|
||||
SCM_SET_VECTOR_BASE (v, NULL);
|
||||
SCM_SET_VECTOR_LENGTH (v, 0, scm_tc7_wvect);
|
||||
}
|
||||
|
||||
return v;
|
||||
}
|
||||
else if (SCM_BIGP (size))
|
||||
SCM_OUT_OF_RANGE (1, size);
|
||||
else
|
||||
SCM_WRONG_TYPE_ARG (1, size);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
|
||||
(SCM size, SCM fill),
|
||||
"Return a weak vector with @var{size} elements. If the optional\n"
|
||||
|
|
@ -63,16 +117,7 @@ SCM_DEFINE (scm_make_weak_vector, "make-weak-vector", 1, 1, 0,
|
|||
"empty list.")
|
||||
#define FUNC_NAME s_scm_make_weak_vector
|
||||
{
|
||||
/* Dirk:FIXME:: We should probably rather use a double cell for weak vectors. */
|
||||
SCM v;
|
||||
v = scm_make_vector (scm_sum (size, SCM_MAKINUM (2)), fill);
|
||||
SCM_DEFER_INTS;
|
||||
SCM_SET_VECTOR_LENGTH (v, SCM_INUM (size), scm_tc7_wvect);
|
||||
SCM_SETVELTS(v, SCM_VELTS(v) + 2);
|
||||
SCM_VELTS(v)[-2] = SCM_EOL;
|
||||
SCM_VECTOR_BASE (v) [-1] = 0;
|
||||
SCM_ALLOW_INTS;
|
||||
return v;
|
||||
return allocate_weak_vector (0, size, fill, FUNC_NAME);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -116,16 +161,12 @@ SCM_DEFINE (scm_weak_vector_p, "weak-vector?", 1, 0, 0,
|
|||
"weak hashes are also weak vectors.")
|
||||
#define FUNC_NAME s_scm_weak_vector_p
|
||||
{
|
||||
return SCM_BOOL(SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj));
|
||||
return SCM_BOOL (SCM_WVECTP (obj) && !SCM_IS_WHVEC (obj));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 1, 0, 0,
|
||||
(SCM size),
|
||||
"@deffnx primitive make-weak-value-hash-table size\n"
|
||||
|
|
@ -138,13 +179,7 @@ SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 1, 0, 0,
|
|||
"would modify regular hash tables. (@pxref{Hash Tables})")
|
||||
#define FUNC_NAME s_scm_make_weak_key_hash_table
|
||||
{
|
||||
SCM v;
|
||||
SCM_VALIDATE_INUM (1, size);
|
||||
v = scm_make_weak_vector (size, SCM_EOL);
|
||||
SCM_DEFER_INTS;
|
||||
SCM_VECTOR_BASE (v) [-1] = 1;
|
||||
SCM_ALLOW_INTS;
|
||||
return v;
|
||||
return allocate_weak_vector (1, size, SCM_EOL, FUNC_NAME);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -155,34 +190,22 @@ SCM_DEFINE (scm_make_weak_value_hash_table, "make-weak-value-hash-table", 1, 0,
|
|||
"(@pxref{Hash Tables})")
|
||||
#define FUNC_NAME s_scm_make_weak_value_hash_table
|
||||
{
|
||||
SCM v;
|
||||
SCM_VALIDATE_INUM (1, size);
|
||||
v = scm_make_weak_vector (size, SCM_EOL);
|
||||
SCM_DEFER_INTS;
|
||||
SCM_VECTOR_BASE (v) [-1] = 2;
|
||||
SCM_ALLOW_INTS;
|
||||
return v;
|
||||
return allocate_weak_vector (2, size, SCM_EOL, FUNC_NAME);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
||||
SCM_DEFINE (scm_make_doubly_weak_hash_table, "make-doubly-weak-hash-table", 1, 0, 0,
|
||||
(SCM size),
|
||||
"Return a hash table with weak keys and values with @var{size}\n"
|
||||
"buckets. (@pxref{Hash Tables})")
|
||||
#define FUNC_NAME s_scm_make_doubly_weak_hash_table
|
||||
{
|
||||
SCM v;
|
||||
SCM_VALIDATE_INUM (1, size);
|
||||
v = scm_make_weak_vector (size, SCM_EOL);
|
||||
SCM_DEFER_INTS;
|
||||
SCM_VECTOR_BASE (v) [-1] = 3;
|
||||
SCM_ALLOW_INTS;
|
||||
return v;
|
||||
return allocate_weak_vector (3, size, SCM_EOL, FUNC_NAME);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0,
|
||||
(SCM obj),
|
||||
"@deffnx primitive weak-value-hash-table? obj\n"
|
||||
|
|
@ -192,7 +215,7 @@ SCM_DEFINE (scm_weak_key_hash_table_p, "weak-key-hash-table?", 1, 0, 0,
|
|||
"nor a weak value hash table.")
|
||||
#define FUNC_NAME s_scm_weak_key_hash_table_p
|
||||
{
|
||||
return SCM_BOOL(SCM_WVECTP (obj) && SCM_IS_WHVEC(obj));
|
||||
return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC (obj));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -202,7 +225,7 @@ SCM_DEFINE (scm_weak_value_hash_table_p, "weak-value-hash-table?", 1, 0, 0,
|
|||
"Return @code{#t} if @var{obj} is a weak value hash table.")
|
||||
#define FUNC_NAME s_scm_weak_value_hash_table_p
|
||||
{
|
||||
return SCM_BOOL(SCM_WVECTP (obj) && SCM_IS_WHVEC_V(obj));
|
||||
return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_V (obj));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -212,10 +235,11 @@ SCM_DEFINE (scm_doubly_weak_hash_table_p, "doubly-weak-hash-table?", 1, 0, 0,
|
|||
"Return @code{#t} if @var{obj} is a doubly weak hash table.")
|
||||
#define FUNC_NAME s_scm_doubly_weak_hash_table_p
|
||||
{
|
||||
return SCM_BOOL(SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj));
|
||||
return SCM_BOOL (SCM_WVECTP (obj) && SCM_IS_WHVEC_B (obj));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
static void *
|
||||
scm_weak_vector_gc_init (void *dummy1 SCM_UNUSED,
|
||||
void *dummy2 SCM_UNUSED,
|
||||
|
|
@ -226,6 +250,7 @@ scm_weak_vector_gc_init (void *dummy1 SCM_UNUSED,
|
|||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static void *
|
||||
scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
|
||||
void *dummy2 SCM_UNUSED,
|
||||
|
|
@ -265,6 +290,7 @@ scm_mark_weak_vector_spines (void *dummy1 SCM_UNUSED,
|
|||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static void *
|
||||
scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
|
||||
void *dummy2 SCM_UNUSED,
|
||||
|
|
@ -325,10 +351,8 @@ scm_scan_weak_vectors (void *dummy1 SCM_UNUSED,
|
|||
return 0;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
void
|
||||
scm_weaks_prehistory ()
|
||||
{
|
||||
|
|
@ -337,6 +361,7 @@ scm_weaks_prehistory ()
|
|||
scm_c_hook_add (&scm_after_sweep_c_hook, scm_scan_weak_vectors, 0, 0);
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
scm_init_weaks ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
/* classes: h_files */
|
||||
|
||||
#ifndef WEAKSH
|
||||
#define WEAKSH
|
||||
/* Copyright (C) 1995,1996, 2000 Free Software Foundation, Inc.
|
||||
#ifndef SCM_WEAKS_H
|
||||
#define SCM_WEAKS_H
|
||||
/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation, Inc.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
|
|
@ -51,13 +51,15 @@
|
|||
|
||||
|
||||
|
||||
|
||||
#define SCM_WVECTP(x) (SCM_NIMP(x) && (SCM_TYP7(x)==scm_tc7_wvect))
|
||||
#define SCM_IS_WHVEC(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 1)
|
||||
#define SCM_IS_WHVEC_V(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 2)
|
||||
#define SCM_IS_WHVEC_B(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) == 3)
|
||||
#define SCM_IS_WHVEC_ANY(X) (SCM_UNPACK (SCM_VELTS(X)[-1]) != 0)
|
||||
#define SCM_WVECT_GC_CHAIN(X) (SCM_VELTS(X)[-2])
|
||||
#define SCM_WVECTP(x) (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_wvect)
|
||||
#define SCM_WVECT_TYPE(x) (SCM_CELL_WORD_2 (x))
|
||||
#define SCM_SET_WVECT_TYPE(x, t) (SCM_SET_CELL_WORD_2 ((x), (t)))
|
||||
#define SCM_IS_WHVEC(X) (SCM_WVECT_TYPE (X) == 1)
|
||||
#define SCM_IS_WHVEC_V(X) (SCM_WVECT_TYPE (X) == 2)
|
||||
#define SCM_IS_WHVEC_B(X) (SCM_WVECT_TYPE (X) == 3)
|
||||
#define SCM_IS_WHVEC_ANY(X) (SCM_WVECT_TYPE (X) != 0)
|
||||
#define SCM_WVECT_GC_CHAIN(X) (SCM_CELL_OBJECT_3 (X))
|
||||
#define SCM_SET_WVECT_GC_CHAIN(X, o) (SCM_SET_CELL_OBJECT_3 ((X), (o)))
|
||||
|
||||
extern SCM scm_weak_vectors;
|
||||
|
||||
|
|
@ -75,7 +77,7 @@ extern SCM scm_doubly_weak_hash_table_p (SCM x);
|
|||
extern void scm_weaks_prehistory (void);
|
||||
extern void scm_init_weaks (void);
|
||||
|
||||
#endif /* WEAKSH */
|
||||
#endif /* SCM_WEAKS_H */
|
||||
|
||||
/*
|
||||
Local Variables:
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue