Problem with smobs

[Joris van der Hoeven]

Hi all,

I noticed a strange problem with the memory allocation of smobs and
I fail to understand whether I am doing something wrong or whether
this is a bug in Guile.

Consider the (C++) smob code attached below to this message.
All memory allocations are done from within C++, so the free_mysmob
function returns 0. Now consider the following session:

Guile> (define x (mysmob 2))
make smob
Guile> (gc)
mark smob
Guile> (set! x #f)
Guile> (gc)
free smob

So far so good. But now

Guile> (define x (mysmob 2))
make smob
Guile> (begin (display x) (display "\n"))
print smob
#<mysmob 2>
Guile> (set! x #f)
Guile> (gc)
mark smob

In other words: printing the smob prevents the memory from being released.
Does "display" admit some hidden (and undocumented) side effects?
Did I do something wrong? Is this a bug in Guile?
Any help would be appreciated.

Best wishes, Joris

-----------------------------------------------------------------------------
static scm_bits_t mysmob_tag;

struct mysmob {
  int val;
  inline mysmob (int val2): val (val2) {}
};

static SCM
make_mysmob (SCM s_val) {
  cout << "make smob\n";
  SCM_ASSERT (SCM_INUMP (s_val), s_val, SCM_ARG1, "make-image");
  int val= SCM_INUM (s_val);
  mysmob *obj= new mysmob (val);
  SCM_RETURN_NEWSMOB (mysmob_tag, obj);
}

static SCM
increment_mysmob (SCM smob) {
  cout << "increment smob\n";
  SCM_ASSERT (SCM_SMOB_PREDICATE (mysmob_tag, smob),
              smob, SCM_ARG1, "increment-mysmob");
  mysmob* obj= (mysmob*) SCM_SMOB_DATA (smob);
  mysmob* ret= new mysmob (obj->val + 1);
  SCM_RETURN_NEWSMOB (mysmob_tag, ret);
}

static SCM
mark_mysmob (SCM smob) {
  cout << "mark smob\n";
  (void) smob;
  return SCM_BOOL_F;
}

static size_t
free_mysmob (SCM smob) {
  cout << "free smob\n";
  mysmob* obj = (mysmob*) SCM_SMOB_DATA (smob);
  delete obj;
  return 0;
}

static int
print_mysmob (SCM smob, SCM port, scm_print_state *pstate) {
  cout << "print smob\n";

  mysmob *obj = (mysmob*) SCM_SMOB_DATA (smob);

  scm_puts ("#<mysmob ", port);
  scm_display (int_to_scm (obj->val), port);
  scm_puts (">", port);

  /* non-zero means success */
  return 1;
}

typedef SCM (*scheme_primitive) ();

void
init_mysmob_type () {
  mysmob_tag = scm_make_smob_type ("mysmob", sizeof (struct mysmob));
  scm_set_smob_mark (mysmob_tag, mark_mysmob);
  scm_set_smob_free (mysmob_tag, free_mysmob);
  scm_set_smob_print (mysmob_tag, print_mysmob);

  scm_c_define_gsubr ("mysmob", 1, 0, 0,
                      (scheme_primitive) (void*) make_mysmob);
  scm_c_define_gsubr ("mysmob-inc", 1, 0, 0,
                      (scheme_primitive) (void*) increment_mysmob);
}