-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2003, 2004, 2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2003, 2004, 2006,
+ * 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
#include "libguile/async.h"
#include "libguile/goops.h"
#include "libguile/instructions.h"
-#include "libguile/objcodes.h"
#include "libguile/programs.h"
#include "libguile/smob.h"
scm_smob_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
{
long n = SCM_SMOBNUM (exp);
- scm_puts ("#<", port);
- scm_puts (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port);
- scm_putc (' ', port);
+ scm_puts_unlocked ("#<", port);
+ scm_puts_unlocked (SCM_SMOBNAME (n) ? SCM_SMOBNAME (n) : "smob", port);
+ scm_putc_unlocked (' ', port);
if (scm_smobs[n].size)
scm_uintprint (SCM_CELL_WORD_1 (exp), 16, port);
else
scm_uintprint (SCM_UNPACK (exp), 16, port);
- scm_putc ('>', port);
+ scm_putc_unlocked ('>', port);
return 1;
}
{
long new_smob;
- SCM_CRITICAL_SECTION_START;
+ scm_i_pthread_mutex_lock (&scm_i_misc_mutex);
new_smob = scm_numsmob;
if (scm_numsmob != MAX_SMOB_COUNT)
++scm_numsmob;
- SCM_CRITICAL_SECTION_END;
+ scm_i_pthread_mutex_unlock (&scm_i_misc_mutex);
if (new_smob == MAX_SMOB_COUNT)
scm_misc_error (FUNC_NAME, "maximum number of smobs exceeded", SCM_EOL);
SCM trampoline = scm_smob_trampoline (req, opt, rst);
scm_smobs[SCM_TC2SMOBNUM (tc)].apply = apply;
- /* In 2.2 this field is renamed to "apply_trampoline". */
- scm_smobs[SCM_TC2SMOBNUM (tc)].apply_trampoline_objcode = trampoline;
+ scm_smobs[SCM_TC2SMOBNUM (tc)].apply_trampoline = trampoline;
if (SCM_UNPACK (scm_smob_class[0]) != 0)
scm_i_inherit_applicable (scm_smob_class[SCM_TC2SMOBNUM (tc)]);
/* The GC kind used for SMOB types that provide a custom mark procedure. */
static int smob_gc_kind;
+/* Mark stack pointer and limit, used by `scm_gc_mark'. */
+static scm_i_pthread_key_t current_mark_stack_pointer;
+static scm_i_pthread_key_t current_mark_stack_limit;
+
/* The generic SMOB mark procedure that gets called for SMOBs allocated
with smob_gc_kind. */
register SCM cell;
register scm_t_bits tc, smobnum;
- cell = PTR2SCM (addr);
+ cell = SCM_PACK_POINTER (addr);
if (SCM_TYP7 (cell) != scm_tc7_smob)
/* It is likely that the GC passed us a pointer to a free-list element
{
SCM obj;
- SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
- SCM_I_CURRENT_THREAD->current_mark_stack_limit = mark_stack_limit;
+ scm_i_pthread_setspecific (current_mark_stack_pointer, mark_stack_ptr);
+ scm_i_pthread_setspecific (current_mark_stack_limit, mark_stack_limit);
/* Invoke the SMOB's mark procedure, which will in turn invoke
- `scm_gc_mark ()', which may modify `current_mark_stack_ptr'. */
+ `scm_gc_mark', which may modify `current_mark_stack_pointer'. */
obj = scm_smobs[smobnum].mark (cell);
- mark_stack_ptr = SCM_I_CURRENT_THREAD->current_mark_stack_ptr;
+ mark_stack_ptr = scm_i_pthread_getspecific (current_mark_stack_pointer);
- if (SCM_NIMP (obj))
+ if (SCM_HEAP_OBJECT_P (obj))
/* Mark the returned object. */
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (obj),
mark_stack_ptr,
mark_stack_limit, NULL);
- SCM_I_CURRENT_THREAD->current_mark_stack_limit = NULL;
- SCM_I_CURRENT_THREAD->current_mark_stack_ptr = NULL;
+ scm_i_pthread_setspecific (current_mark_stack_pointer, NULL);
+ scm_i_pthread_setspecific (current_mark_stack_limit, NULL);
}
return mark_stack_ptr;
}
-/* Mark object O. We assume that this function is only called during the
- mark phase, i.e., from within `smob_mark ()' or one of its
- descendents. */
+/* Mark object O. We assume that this function is only called during the mark
+ phase, i.e., from within `smob_mark' or one of its descendants. */
void
scm_gc_mark (SCM o)
{
-#define CURRENT_MARK_PTR \
- ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_ptr))
-#define CURRENT_MARK_LIMIT \
- ((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
-
- if (SCM_NIMP (o))
+ if (SCM_HEAP_OBJECT_P (o))
{
- /* At this point, the `current_mark_*' fields of the current thread
- must be defined (they are set in `smob_mark ()'). */
- register struct GC_ms_entry *mark_stack_ptr;
+ void *mark_stack_ptr, *mark_stack_limit;
- if (!CURRENT_MARK_PTR)
+ mark_stack_ptr = scm_i_pthread_getspecific (current_mark_stack_pointer);
+ mark_stack_limit = scm_i_pthread_getspecific (current_mark_stack_limit);
+
+ if (mark_stack_ptr == NULL)
/* The function was not called from a mark procedure. */
abort ();
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (o),
- CURRENT_MARK_PTR, CURRENT_MARK_LIMIT,
+ mark_stack_ptr, mark_stack_limit,
NULL);
- SCM_I_CURRENT_THREAD->current_mark_stack_ptr = mark_stack_ptr;
+ scm_i_pthread_setspecific (current_mark_stack_pointer, mark_stack_ptr);
}
-#undef CURRENT_MARK_PTR
-#undef CURRENT_MARK_LIMIT
}
\f
SCM smob;
size_t (* free_smob) (SCM);
- smob = PTR2SCM (ptr);
+ smob = SCM_PACK_POINTER (ptr);
#if 0
printf ("finalizing SMOB %p (smobnum: %u)\n",
ptr, SCM_SMOBNUM (smob));
allocates a double cell. We leave words 2 and 3 to there initial
values, which is 0. */
if (scm_smobs [smobnum].mark)
- ret = PTR2SCM (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind));
+ ret = SCM_PACK_POINTER (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind));
else
- ret = PTR2SCM (GC_MALLOC (sizeof (scm_t_cell)));
+ ret = SCM_PACK_POINTER (GC_MALLOC (sizeof (scm_t_cell)));
SCM_SET_CELL_WORD_1 (ret, data);
SCM_SET_CELL_WORD_0 (ret, tc);
/* Use the smob_gc_kind if needed to allow the mark procedure to
run. */
if (scm_smobs [smobnum].mark)
- ret = PTR2SCM (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind));
+ ret = SCM_PACK_POINTER (GC_generic_malloc (2 * sizeof (scm_t_cell), smob_gc_kind));
else
- ret = PTR2SCM (GC_MALLOC (2 * sizeof (scm_t_cell)));
+ ret = SCM_PACK_POINTER (GC_MALLOC (2 * sizeof (scm_t_cell)));
SCM_SET_CELL_WORD_3 (ret, data3);
SCM_SET_CELL_WORD_2 (ret, data2);
return ret;
}
-
-\f
-
-/* These two are internal details of the previous implementation of
- SCM_NEWSMOB and are no longer used. They are still here to preserve
- ABI stability in the 2.0 series. */
-void
-scm_i_finalize_smob (void *ptr, void *data)
-{
- finalize_smob (ptr, data);
-}
-
-SCM
-scm_i_new_smob_with_mark_proc (scm_t_bits tc, scm_t_bits word1,
- scm_t_bits word2, scm_t_bits word3)
-{
- return scm_new_double_smob (tc, word1, word2, word3);
-}
-
-
\f
void
scm_smob_prehistory ()
{
long i;
+ scm_i_pthread_key_create (¤t_mark_stack_pointer, NULL);
+ scm_i_pthread_key_create (¤t_mark_stack_limit, NULL);
+
smob_gc_kind = GC_new_kind (GC_new_free_list (),
GC_MAKE_PROC (GC_new_proc (smob_mark), 0),
0,
scm_smobs[i].print = scm_smob_print;
scm_smobs[i].equalp = 0;
scm_smobs[i].apply = 0;
- scm_smobs[i].apply_trampoline_objcode = SCM_BOOL_F;
+ scm_smobs[i].apply_trampoline = SCM_BOOL_F;
}
}
HCoop / bpt / guile.git / blobdiff