Remove stack programs, objcode, and the old VM.
[bpt/guile.git] / libguile / smob.c
index 90849a8..e13591f 100644 (file)
@@ -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;
 }
 
@@ -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;
 }
 
-
-\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 ()
@@ -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;
     }
 }