summaryrefslogtreecommitdiff
path: root/libguile/smob.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/smob.c')
-rw-r--r--libguile/smob.c54
1 files changed, 16 insertions, 38 deletions
diff --git a/libguile/smob.c b/libguile/smob.c
index 90849a89d..768257840 100644
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -32,7 +32,6 @@
#include "libguile/async.h"
#include "libguile/goops.h"
#include "libguile/instructions.h"
-#include "libguile/objcodes.h"
#include "libguile/programs.h"
#include "libguile/smob.h"
@@ -106,14 +105,14 @@ int
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;
}
@@ -206,11 +205,11 @@ scm_make_smob_type (char const *name, size_t size)
{
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);
@@ -258,8 +257,7 @@ scm_set_smob_apply (scm_t_bits tc, SCM (*apply) (),
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)]);
@@ -299,7 +297,7 @@ smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
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
@@ -336,7 +334,7 @@ smob_mark (GC_word *addr, struct GC_ms_entry *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,
@@ -355,7 +353,7 @@ smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
void
scm_gc_mark (SCM o)
{
- if (SCM_NIMP (o))
+ if (SCM_HEAP_OBJECT_P (o))
{
void *mark_stack_ptr, *mark_stack_limit;
@@ -381,7 +379,7 @@ finalize_smob (void *ptr, void *data)
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));
@@ -405,9 +403,9 @@ scm_i_new_smob (scm_t_bits tc, scm_t_bits data)
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);
@@ -430,9 +428,9 @@ scm_i_new_double_smob (scm_t_bits tc, scm_t_bits data1,
/* 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);
@@ -445,26 +443,6 @@ scm_i_new_double_smob (scm_t_bits tc, scm_t_bits data1,
return ret;
}
-
-
-
-/* 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);
-}
-
-
void
scm_smob_prehistory ()
@@ -491,7 +469,7 @@ scm_smob_prehistory ()
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;
}
}