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

static scm_t_bits container_tag;

//__________________________________________________________________________________________________
//$. struct container
struct container
{
	/* char array */
	int array_length;
	char* array;
	/* The name of this container */
	SCM name;
	/* The child of this container */
	SCM child;
};

//__________________________________________________________________________________________________
//$. make_container ()
static SCM
make_container (SCM name, SCM s_length)
{
	SCM smob;
	struct container* container;
	int array_length = scm_to_int (s_length);

	/* Step 1: Allocate the memory block.
	 *   Memory blocks that are associated with Scheme objects (for example a
	 * foreign object) should be allocated with ‘scm_gc_malloc’ or
	 * ‘scm_gc_malloc_pointerless’.  These two functions will either return a
	 * valid pointer or signal an error.  Memory blocks allocated this way may
	 * be released explicitly; however, this is not strictly needed, and we
	 * recommend _not_ calling ‘scm_gc_free’.  All memory allocated with
	 * ‘scm_gc_malloc’ or ‘scm_gc_malloc_pointerless’ is automatically
	 * reclaimed when the garbage collector no longer sees any live reference
	 * to it(1).
	 */
	container = (struct container*)
		scm_gc_malloc (sizeof (struct container), "container");

	/* Step 2: Initialize it with straight code.
	 */
	container->array_length= array_length;
	container->array = NULL;
	container->name = SCM_BOOL_F;

	/* Step 3: Create the smob.
	 */
	// SCM_NEWSMOB (smob, container_tag, container);
	smob = scm_new_smob (container_tag, (scm_t_bits)container);

	fprintf (stderr, "[make_container] ptr=0x%x (0x%x,0x%x)\n",
			 (int)smob, (int)((void**)smob)[0], (int)((void**)smob)[1]);

	/* Step 4: Finish the initialization.
	 */
	container->name = name;
	container->array = scm_gc_malloc (array_length, "container array");

	return smob;
}

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

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

//__________________________________________________________________________________________________
//$. print_container ()
static int
print_container (SCM container_smob, SCM port, scm_print_state* pstate)
{
	struct container* container = (struct container*) SCM_SMOB_DATA (container_smob);
	scm_puts ("#<container ", port);
	scm_display (container->name, port);
	printf (" child=%#x", (int)container->child); fflush(stdout);
	scm_puts (">", port);
	/* non-zero means success */
	return 1;
}

//__________________________________________________________________________________________________
//$. container_set_child ()
static SCM
container_set_child (SCM c, SCM value)
#define FUNC_NAME "container-set-child"
{
	//SCM_VALIDATE_SMOB (1, c, container);
	SCM_ASSERT (SCM_SMOB_PREDICATE (container_tag, c), c, 1, FUNC_NAME);

	/* Set the child of the container to the given value.  */
	struct container* container = (struct container*) SCM_SMOB_DATA (c);
	container-> child = value;
	
	return SCM_UNSPECIFIED;
}
#undef FUNC_NAME


//__________________________________________________________________________________________________
//$. init_container_type()
void
init_container_type (void)
{
	container_tag = scm_make_smob_type ("container", sizeof (struct container));
	fprintf (stderr, "[init] container_tag = 0x%x\n", (int)container_tag);
	scm_set_smob_mark (container_tag, mark_container);
	scm_set_smob_free (container_tag, free_container);
	scm_set_smob_print (container_tag, print_container);
	scm_c_define_gsubr ("make-container", 2, 0, 0, make_container);
	scm_c_define_gsubr ("container-set-child", 2, 0, 0, container_set_child);
}