//$.
#include <stdlib.h>
#include <libguile.h>

static scm_t_bits child_tag;

//__________________________________________________________________________________________________
//$. make_child ()
static SCM
make_child ()
{
	SCM smob;
	smob = scm_new_smob (child_tag, SCM_BOOL_F);
	fprintf (stderr, "[make_child] ptr=0x%x (0x%x,0x%x)\n",
			 (int)smob, (int)((void**)smob)[0], (int)((void**)smob)[1]);
	return smob;
}

//__________________________________________________________________________________________________
//$. mark_child ()
/* This function is responsible for marking all SCM objects included
 * in the smob. */
static SCM
mark_child (SCM child_smob)
{
	fprintf (stderr, "[mark_child] ptr=0x%x (0x%x,0x%x)\n",
			 (int)child_smob,
			 (int)((void**)child_smob)[0], (int)((void**)child_smob)[1]);
	/* we simply return child_smob and the caller will mark it. */
	return SCM_CELL_OBJECT_1 (child_smob);
}

//__________________________________________________________________________________________________
//$. free_child ()
static size_t
free_child (SCM child_smob)
{
	fprintf (stderr, "[free_child] ptr=%#x (%#06x,%#x)\n",
			 (int)child_smob,
			 (int)((void**)child_smob)[0], (int)((void**)child_smob)[1]);
	if (SCM_TYP7(child_smob) != (0xff & child_tag)) {
		// bad type, not dbi smob, do not free it
		fprintf (stderr, "[free] error: bad smob 0x%x\n", (int)SCM_TYP16(child_smob));
		return 0;
	}
	return 0;
}

//__________________________________________________________________________________________________
//$. print_child ()
static int
print_child (SCM child_smob, SCM port, scm_print_state* pstate)
{
	scm_puts ("#<child ", port);
	printf ("%#x", (int)child_smob); fflush(stdout);
	scm_puts (">", port);
	/* non-zero means success */
	return 1;
}

//__________________________________________________________________________________________________
//$. init_child_type()
void
init_child_type (void)
{
	child_tag = scm_make_smob_type ("box", 0);
	fprintf (stderr, "[init] child_tag = 0x%x\n", (int)child_tag);
	scm_set_smob_mark (child_tag, mark_child);
	scm_set_smob_free (child_tag, free_child);
	scm_set_smob_print (child_tag, print_child);
	scm_c_define_gsubr ("make-child", 0, 0, 0, make_child);
}