[bpt/guile.git] / libguile / gc-card.c

/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 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
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.  */


#include <stdio.h>

#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/stime.h"
#include "libguile/stackchk.h"
#include "libguile/struct.h"
#include "libguile/smob.h"
#include "libguile/unif.h"
#include "libguile/async.h"
#include "libguile/ports.h"
#include "libguile/root.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/weaks.h"
#include "libguile/hashtab.h"
#include "libguile/tags.h"
#include "libguile/private-gc.h"
#include "libguile/validate.h"
#include "libguile/deprecation.h"
#include "libguile/gc.h"


#include "libguile/private-gc.h"

long int scm_i_deprecated_memory_return;


/*
  Init all the free cells in CARD, prepending to *FREE_LIST.

  Return: number of free cells found in this card.

  It would be cleaner to have a separate function sweep_value(), but
  that is too slow (functions with switch statements can't be
  inlined).
  
 */

int
scm_i_sweep_card (scm_t_cell *  p, SCM *free_list, scm_t_heap_segment*seg)
#define FUNC_NAME "sweep_card"
{
  scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p);
  scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
  int span = seg->span;
  int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
  int free_count  = 0;

  ++ scm_gc_running_p;

  /*
    I tried something fancy with shifting by one bit every word from
    the bitvec in turn, but it wasn't any faster, but quite bit
    hairier.
   */
  for (p += offset; p < end; p += span, offset += span)
    {
      SCM scmptr = PTR2SCM(p);
      if (SCM_C_BVEC_GET (bitvec, offset))
        continue;

      switch (SCM_TYP7 (scmptr))
	{
	case scm_tcs_struct:
	  {
	    /* Structs need to be freed in a special order.
	     * This is handled by GC C hooks in struct.c.
	     */
	    SCM_SET_STRUCT_GC_CHAIN (p, scm_structs_to_free);
	    scm_structs_to_free = scmptr;
	  }
	  continue;
      
	case scm_tcs_cons_imcar:
	case scm_tcs_cons_nimcar:
	case scm_tcs_closures:
	case scm_tc7_pws:
	  break;
	case scm_tc7_wvect:
	case scm_tc7_vector:
	  {
	    unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
	    if (length > 0)
	      {
		scm_gc_free (SCM_VECTOR_BASE (scmptr),
			     length * sizeof (scm_t_bits),
			     "vector");
	      }
	    break;
	  }
#ifdef CCLO
	case scm_tc7_cclo:
	  scm_gc_free (SCM_CCLO_BASE (scmptr), 
		       SCM_CCLO_LENGTH (scmptr) * sizeof (SCM),
		       "compiled closure");
	  break;
#endif
#ifdef HAVE_ARRAYS
	case scm_tc7_bvect:
	  {
	    unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
	    if (length > 0)
	      {
		scm_gc_free (SCM_BITVECTOR_BASE (scmptr),
			     (sizeof (long)
			      * ((length+SCM_LONG_BIT-1) / SCM_LONG_BIT)),
			     "vector");
	      }
	  }
	  break;
	case scm_tc7_byvect:
	case scm_tc7_ivect:
	case scm_tc7_uvect:
	case scm_tc7_svect:
#ifdef HAVE_LONG_LONGS
	case scm_tc7_llvect:
#endif
	case scm_tc7_fvect:
	case scm_tc7_dvect:
	case scm_tc7_cvect:
	  scm_gc_free (SCM_UVECTOR_BASE (scmptr), 
		       (SCM_UVECTOR_LENGTH (scmptr)
			* scm_uniform_element_size (scmptr)),
		       "vector");
	  break;
#endif
	case scm_tc7_string:
	  scm_gc_free (SCM_STRING_CHARS (scmptr), 
		       SCM_STRING_LENGTH (scmptr) + 1, "string");
	  break;
	case scm_tc7_symbol:
	  scm_gc_free (SCM_SYMBOL_CHARS (scmptr), 
		       SCM_SYMBOL_LENGTH (scmptr) + 1, "symbol");
	  break;
	case scm_tc7_variable:
	  break;
	case scm_tcs_subrs:
	  /* the various "subrs" (primitives) are never freed */
	  continue;
	case scm_tc7_port:
	  if SCM_OPENP (scmptr)
	    {
	      int k = SCM_PTOBNUM (scmptr);
	      size_t mm;
#if (SCM_DEBUG_CELL_ACCESSES == 1)
	      if (!(k < scm_numptob))
		{
		  fprintf (stderr, "undefined port type");
		  abort();
		}
#endif
	      /* Keep "revealed" ports alive.  */
	      if (scm_revealed_count (scmptr) > 0)
		continue;
	  
	      /* Yes, I really do mean scm_ptobs[k].free */
	      /* rather than ftobs[k].close.  .close */
	      /* is for explicit CLOSE-PORT by user */
	      mm = scm_ptobs[k].free (scmptr);

	      if (mm != 0)
		{
#if SCM_ENABLE_DEPRECATED == 1
		  scm_c_issue_deprecation_warning
		    ("Returning non-0 from a port free function is "
		     "deprecated.  Use scm_gc_free et al instead.");
		  scm_c_issue_deprecation_warning_fmt
		    ("(You just returned non-0 while freeing a %s.)",
		     SCM_PTOBNAME (k));
		  scm_i_deprecated_memory_return += mm;
#else
		  abort ();
#endif
		}

	      SCM_SETSTREAM (scmptr, 0);
	      scm_remove_from_port_table (scmptr);
	      scm_gc_ports_collected++;
	      SCM_CLR_PORT_OPEN_FLAG (scmptr);
	    }
	  break;
	case scm_tc7_smob:
	  switch SCM_TYP16 (scmptr)
	    {
	    case scm_tc_free_cell:
	    case scm_tc16_real:
	      break;
#ifdef SCM_BIGDIG
	    case scm_tc16_big:
	      scm_gc_free (SCM_BDIGITS (scmptr),
			   ((SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG
			     / SCM_CHAR_BIT)), "bignum");
	      break;
#endif /* def SCM_BIGDIG */
	    case scm_tc16_complex:
	      scm_gc_free (SCM_COMPLEX_MEM (scmptr), 2*sizeof (double),
			   "complex");
	      break;
	    default:
	      {
		int k;
		k = SCM_SMOBNUM (scmptr);
#if (SCM_DEBUG_CELL_ACCESSES == 1)
		if (!(k < scm_numsmob))
		  {
		    fprintf (stderr, "undefined smob type");
		    abort();
		  }
#endif
		if (scm_smobs[k].free)
		  {
		    size_t mm;
		    mm = scm_smobs[k].free (scmptr);
		    if (mm != 0)
		      {
#if SCM_ENABLE_DEPRECATED == 1
			scm_c_issue_deprecation_warning
			  ("Returning non-0 from a smob free function is "
			   "deprecated.  Use scm_gc_free et al instead.");
			scm_c_issue_deprecation_warning_fmt
			  ("(You just returned non-0 while freeing a %s.)",
			   SCM_SMOBNAME (k));
			scm_i_deprecated_memory_return += mm;
#else
			abort();
#endif
		      }
		  }
		break;
	      }
	    }
	  break;
	default:
	  fprintf (stderr, "unknown type");
	  abort();
	}

	  
      SCM_SET_CELL_TYPE (p, scm_tc_free_cell);
      SCM_SET_FREE_CELL_CDR (p, PTR2SCM (*free_list));
      *free_list = PTR2SCM (p);
      free_count ++;
    }

  --scm_gc_running_p;
  return free_count;
}
#undef FUNC_NAME


/*
  Like sweep, but no complicated logic to do the sweeping.
 */
int
scm_i_init_card_freelist (scm_t_cell *  card, SCM *free_list,
			scm_t_heap_segment*seg)
{
  int span = seg->span;
  scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
  scm_t_cell *p = end - span;

  scm_t_c_bvec_long * bvec_ptr =  (scm_t_c_bvec_long* ) seg->bounds[1];
  int idx = (card  - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; 

  bvec_ptr += idx *SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
  SCM_GC_CELL_BVEC (card) = bvec_ptr;
  
  /*
     ASSUMPTION: n_header_cells <= 2. 
   */
  for (; p > card;  p -= span)
    {
      SCM_SET_CELL_TYPE (p, scm_tc_free_cell);
      SCM_SET_FREE_CELL_CDR (p, PTR2SCM (*free_list));
      *free_list = PTR2SCM (p);
    }

  return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS);
}


#if 0
/*
  These functions are meant to be called from GDB as a debug aid.

  I've left them as a convenience for future generations. --hwn.
 */


int scm_gc_marked_p (SCM obj);
scm_t_cell * scm_gc_get_card (SCM obj);
long * scm_gc_get_bvec (SCM obj);

typedef struct scm_t_list_cell_struct {
  scm_t_bits car;  
  struct scm_t_list_cell_struct * cdr;
} scm_t_list_cell;


typedef struct scm_t_double_cell
{
  scm_t_bits word_0;
  scm_t_bits word_1;
  scm_t_bits word_2;
  scm_t_bits word_3;
} scm_t_double_cell;


int
scm_gc_marked_p (SCM obj)
{
  return SCM_GC_MARK_P(obj);
}

scm_t_cell *
scm_gc_get_card (SCM obj)
{
  return SCM_GC_CELL_CARD(obj);
}

long *
scm_gc_get_bvec (SCM obj)
{
  return SCM_GC_CARD_BVEC(SCM_GC_CELL_CARD(obj));
}
#endif
Commit	Line	Data
c8a1bdc4 HWN	1	/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc.
	2	*
	3	* This program is free software; you can redistribute it and/or modify
	4	* it under the terms of the GNU General Public License as published by
	5	* the Free Software Foundation; either version 2, or (at your option)
	6	* any later version.
	7	*
	8	* This program is distributed in the hope that it will be useful,
	9	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	* GNU General Public License for more details.
	12	*
	13	* You should have received a copy of the GNU General Public License
	14	* along with this software; see the file COPYING. If not, write to
	15	* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
	16	* Boston, MA 02111-1307 USA
	17	*
	18	* As a special exception, the Free Software Foundation gives permission
	19	* for additional uses of the text contained in its release of GUILE.
	20	*
	21	* The exception is that, if you link the GUILE library with other files
	22	* to produce an executable, this does not by itself cause the
	23	* resulting executable to be covered by the GNU General Public License.
	24	* Your use of that executable is in no way restricted on account of
	25	* linking the GUILE library code into it.
	26	*
	27	* This exception does not however invalidate any other reasons why
	28	* the executable file might be covered by the GNU General Public License.
	29	*
	30	* This exception applies only to the code released by the
	31	* Free Software Foundation under the name GUILE. If you copy
	32	* code from other Free Software Foundation releases into a copy of
	33	* GUILE, as the General Public License permits, the exception does
	34	* not apply to the code that you add in this way. To avoid misleading
	35	* anyone as to the status of such modified files, you must delete
	36	* this exception notice from them.
	37	*
	38	* If you write modifications of your own for GUILE, it is your choice
	39	* whether to permit this exception to apply to your modifications.
	40	* If you do not wish that, delete this exception notice. */
	41
	42
be3ff021 HWN	43	#include <stdio.h>
be3ff021 HWN	44
c8a1bdc4 HWN	45	#include "libguile/_scm.h"
	46	#include "libguile/eval.h"
	47	#include "libguile/stime.h"
	48	#include "libguile/stackchk.h"
	49	#include "libguile/struct.h"
	50	#include "libguile/smob.h"
	51	#include "libguile/unif.h"
	52	#include "libguile/async.h"
	53	#include "libguile/ports.h"
	54	#include "libguile/root.h"
	55	#include "libguile/strings.h"
	56	#include "libguile/vectors.h"
	57	#include "libguile/weaks.h"
	58	#include "libguile/hashtab.h"
	59	#include "libguile/tags.h"
	60	#include "libguile/private-gc.h"
	61	#include "libguile/validate.h"
	62	#include "libguile/deprecation.h"
	63	#include "libguile/gc.h"
	64
	65
	66	#include "libguile/private-gc.h"
	67
	68	long int scm_i_deprecated_memory_return;
	69
	70
	71	/*
	72	Init all the free cells in CARD, prepending to *FREE_LIST.
	73
	74	Return: number of free cells found in this card.
	75
	76	It would be cleaner to have a separate function sweep_value(), but
	77	that is too slow (functions with switch statements can't be
	78	inlined).
	79
	80	*/
	81
	82	int
1383773b	83	scm_i_sweep_card (scm_t_cell * p, SCM free_list, scm_t_heap_segmentseg)
c8a1bdc4 HWN	84	#define FUNC_NAME "sweep_card"
	85	{
	86	scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p);
	87	scm_t_cell * end = p + SCM_GC_CARD_N_CELLS;
1383773b	88	int span = seg->span;
c8a1bdc4 HWN	89	int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span);
	90	int free_count = 0;
	91
eab1b259 HWN	92	++ scm_gc_running_p;
eab1b259 HWN	93
c8a1bdc4 HWN	94	/*
	95	I tried something fancy with shifting by one bit every word from
	96	the bitvec in turn, but it wasn't any faster, but quite bit
	97	hairier.
	98	*/
	99	for (p += offset; p < end; p += span, offset += span)
	100	{
	101	SCM scmptr = PTR2SCM(p);
	102	if (SCM_C_BVEC_GET (bitvec, offset))
	103	continue;
	104
	105	switch (SCM_TYP7 (scmptr))
	106	{
	107	case scm_tcs_struct:
	108	{
	109	/* Structs need to be freed in a special order.
	110	* This is handled by GC C hooks in struct.c.
	111	*/
	112	SCM_SET_STRUCT_GC_CHAIN (p, scm_structs_to_free);
	113	scm_structs_to_free = scmptr;
	114	}
	115	continue;
	116
	117	case scm_tcs_cons_imcar:
	118	case scm_tcs_cons_nimcar:
	119	case scm_tcs_closures:
	120	case scm_tc7_pws:
	121	break;
	122	case scm_tc7_wvect:
	123	case scm_tc7_vector:
	124	{
	125	unsigned long int length = SCM_VECTOR_LENGTH (scmptr);
	126	if (length > 0)
	127	{
	128	scm_gc_free (SCM_VECTOR_BASE (scmptr),
	129	length * sizeof (scm_t_bits),
	130	"vector");
	131	}
	132	break;
	133	}
	134	#ifdef CCLO
	135	case scm_tc7_cclo:
	136	scm_gc_free (SCM_CCLO_BASE (scmptr),
	137	SCM_CCLO_LENGTH (scmptr) * sizeof (SCM),
	138	"compiled closure");
	139	break;
	140	#endif
	141	#ifdef HAVE_ARRAYS
	142	case scm_tc7_bvect:
	143	{
	144	unsigned long int length = SCM_BITVECTOR_LENGTH (scmptr);
	145	if (length > 0)
	146	{
	147	scm_gc_free (SCM_BITVECTOR_BASE (scmptr),
	148	(sizeof (long)
	149	* ((length+SCM_LONG_BIT-1) / SCM_LONG_BIT)),
	150	"vector");
	151	}
	152	}
	153	break;
	154	case scm_tc7_byvect:
	155	case scm_tc7_ivect:
	156	case scm_tc7_uvect:
	157	case scm_tc7_svect:
158	#ifdef HAVE_LONG_LONGS
159	case scm_tc7_llvect:
160	#endif
161	case scm_tc7_fvect:
162	case scm_tc7_dvect:
163	case scm_tc7_cvect:
164	scm_gc_free (SCM_UVECTOR_BASE (scmptr),
165	(SCM_UVECTOR_LENGTH (scmptr)
166	* scm_uniform_element_size (scmptr)),
167	"vector");
168	break;
169	#endif
170	case scm_tc7_string:
171	scm_gc_free (SCM_STRING_CHARS (scmptr),
172	SCM_STRING_LENGTH (scmptr) + 1, "string");
173	break;
174	case scm_tc7_symbol:
175	scm_gc_free (SCM_SYMBOL_CHARS (scmptr),
176	SCM_SYMBOL_LENGTH (scmptr) + 1, "symbol");
177	break;
178	case scm_tc7_variable:
179	break;
180	case scm_tcs_subrs:
181	/* the various "subrs" (primitives) are never freed */
182	continue;
183	case scm_tc7_port:
184	if SCM_OPENP (scmptr)
185	{
186	int k = SCM_PTOBNUM (scmptr);
187	size_t mm;
188	#if (SCM_DEBUG_CELL_ACCESSES == 1)
189	if (!(k < scm_numptob))
be3ff021 HWN	190	{
	191	fprintf (stderr, "undefined port type");
	192	abort();
	193	}
c8a1bdc4 HWN	194	#endif
	195	/* Keep "revealed" ports alive. */
	196	if (scm_revealed_count (scmptr) > 0)
	197	continue;
	198
	199	/* Yes, I really do mean scm_ptobs[k].free */
	200	/* rather than ftobs[k].close. .close */
	201	/* is for explicit CLOSE-PORT by user */
	202	mm = scm_ptobs[k].free (scmptr);
	203
	204	if (mm != 0)
	205	{
	206	#if SCM_ENABLE_DEPRECATED == 1
	207	scm_c_issue_deprecation_warning
	208	("Returning non-0 from a port free function is "
	209	"deprecated. Use scm_gc_free et al instead.");
	210	scm_c_issue_deprecation_warning_fmt
	211	("(You just returned non-0 while freeing a %s.)",
	212	SCM_PTOBNAME (k));
	213	scm_i_deprecated_memory_return += mm;
	214	#else
	215	abort ();
	216	#endif
	217	}
	218
	219	SCM_SETSTREAM (scmptr, 0);
	220	scm_remove_from_port_table (scmptr);
	221	scm_gc_ports_collected++;
	222	SCM_CLR_PORT_OPEN_FLAG (scmptr);
	223	}
	224	break;
	225	case scm_tc7_smob:
	226	switch SCM_TYP16 (scmptr)
	227	{
	228	case scm_tc_free_cell:
	229	case scm_tc16_real:
	230	break;
	231	#ifdef SCM_BIGDIG
	232	case scm_tc16_big:
	233	scm_gc_free (SCM_BDIGITS (scmptr),
	234	((SCM_NUMDIGS (scmptr) * SCM_BITSPERDIG
	235	/ SCM_CHAR_BIT)), "bignum");
	236	break;
	237	#endif /* def SCM_BIGDIG */
	238	case scm_tc16_complex:
	239	scm_gc_free (SCM_COMPLEX_MEM (scmptr), 2*sizeof (double),
	240	"complex");
	241	break;
	242	default:
	243	{
	244	int k;
	245	k = SCM_SMOBNUM (scmptr);
	246	#if (SCM_DEBUG_CELL_ACCESSES == 1)
	247	if (!(k < scm_numsmob))
be3ff021 HWN	248	{
	249	fprintf (stderr, "undefined smob type");
	250	abort();
	251	}
c8a1bdc4 HWN	252	#endif
	253	if (scm_smobs[k].free)
	254	{
	255	size_t mm;
	256	mm = scm_smobs[k].free (scmptr);
	257	if (mm != 0)
	258	{
	259	#if SCM_ENABLE_DEPRECATED == 1
	260	scm_c_issue_deprecation_warning
	261	("Returning non-0 from a smob free function is "
	262	"deprecated. Use scm_gc_free et al instead.");
	263	scm_c_issue_deprecation_warning_fmt
	264	("(You just returned non-0 while freeing a %s.)",
	265	SCM_SMOBNAME (k));
	266	scm_i_deprecated_memory_return += mm;
	267	#else
	268	abort();
	269	#endif
	270	}
	271	}
	272	break;
	273	}
	274	}
	275	break;
	276	default:
be3ff021 HWN	277	fprintf (stderr, "unknown type");
be3ff021 HWN	278	abort();
c8a1bdc4 HWN	279	}
	280
	281
	282	SCM_SET_CELL_TYPE (p, scm_tc_free_cell);
	283	SCM_SET_FREE_CELL_CDR (p, PTR2SCM (*free_list));
	284	*free_list = PTR2SCM (p);
	285	free_count ++;
	286	}
eab1b259 HWN	287
eab1b259 HWN	288	--scm_gc_running_p;
c8a1bdc4 HWN	289	return free_count;
	290	}
	291	#undef FUNC_NAME
	292
	293
	294	/*
	295	Like sweep, but no complicated logic to do the sweeping.
	296	*/
	297	int
1383773b HWN	298	scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,
1383773b HWN	299	scm_t_heap_segment*seg)
c8a1bdc4	300	{
1383773b	301	int span = seg->span;
c8a1bdc4 HWN	302	scm_t_cell *end = card + SCM_GC_CARD_N_CELLS;
	303	scm_t_cell *p = end - span;
	304
1383773b HWN	305	scm_t_c_bvec_long * bvec_ptr = (scm_t_c_bvec_long* ) seg->bounds[1];
	306	int idx = (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
	307
	308	bvec_ptr += idx *SCM_GC_CARD_BVEC_SIZE_IN_LONGS;
	309	SCM_GC_CELL_BVEC (card) = bvec_ptr;
	310
c8a1bdc4 HWN	311	/*
	312	ASSUMPTION: n_header_cells <= 2.
	313	*/
	314	for (; p > card; p -= span)
	315	{
	316	SCM_SET_CELL_TYPE (p, scm_tc_free_cell);
	317	SCM_SET_FREE_CELL_CDR (p, PTR2SCM (*free_list));
	318	*free_list = PTR2SCM (p);
	319	}
	320
	321	return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS);
	322	}
	323
	324
eab1b259	325
c8a1bdc4 HWN	326	#if 0
	327	/*
	328	These functions are meant to be called from GDB as a debug aid.
	329
1383773b	330	I've left them as a convenience for future generations. --hwn.
c8a1bdc4 HWN	331	*/
	332
	333
	334	int scm_gc_marked_p (SCM obj);
	335	scm_t_cell * scm_gc_get_card (SCM obj);
	336	long * scm_gc_get_bvec (SCM obj);
	337
	338	typedef struct scm_t_list_cell_struct {
	339	scm_t_bits car;
	340	struct scm_t_list_cell_struct * cdr;
	341	} scm_t_list_cell;
	342
eab1b259 HWN	343
	344	typedef struct scm_t_double_cell
	345	{
	346	scm_t_bits word_0;
	347	scm_t_bits word_1;
	348	scm_t_bits word_2;
	349	scm_t_bits word_3;
	350	} scm_t_double_cell;
	351
	352
c8a1bdc4 HWN	353	int
	354	scm_gc_marked_p (SCM obj)
	355	{
	356	return SCM_GC_MARK_P(obj);
	357	}
	358
	359	scm_t_cell *
	360	scm_gc_get_card (SCM obj)
	361	{
	362	return SCM_GC_CELL_CARD(obj);
	363	}
	364
	365	long *
	366	scm_gc_get_bvec (SCM obj)
	367	{
	368	return SCM_GC_CARD_BVEC(SCM_GC_CELL_CARD(obj));
	369	}
	370	#endif