Hey,
I found somehow confusing functionality of garbage collector,
which I really can't understand.
It seems to me, that gc calls the mark functions for garbage objects
before they are than correctly removed from memory.
Is it the a wanted action or some kind of side effect?
Roman
[init] child_tag = 0x1677
[init] container_tag = 0x1777
version = 2.2.0.18-d7778
(
[let begin] ----------------------------------------
[make_container] ptr=0x9b345fe0 (0x1777,0x9b296480)
[make_container] ptr=0x9b345fc0 (0x1777,0x9b296440)
[make_child] ptr=0x9b345fa0 (0x1677,0x4)
[make_child] ptr=0x9b345f80 (0x1677,0x4)
ch1 = #<child 0x9b345fa0>
ch2 = #<child 0x9b345f80>
c1 = #<container my.container.1 child=0x9b345fa0>
c2 = #<container my.container.2 child=0x9b345f80>
[mark_child] ptr=0x9b345f80 (0x1677,0x4)
[mark_child] ptr=0x9b345fa0 (0x1677,0x4)
[mark_container] ptr=0x9b345fc0 (0x1777,0x9b296440)
[mark_container] ptr=0x9b345fe0 (0x1777,0x9b296480)
[let end] ------------------------------------------
)
+----------------------------------------------------+
| What are the following mark functions called for? |
+----------------------------------------------------+
[mark_child] ptr=0x9b345f80 (0x1677,0x4)
[mark_child] ptr=0x9b345fa0 (0x1677,0x4)
[mark_container] ptr=0x9b345fc0 (0x1777,0x9b296440)
[mark_container] ptr=0x9b345fe0 (0x1777,0x9b296480)
[free_child] ptr=0x9b345f80 (0x0077,0x4)
[free_child] ptr=0x9b345fa0 (0x0077,0x4)
[free_container] ptr=0x9b345fc0 (0x0077,0x9b296440)
[free_container] ptr=0x9b345fe0 (0x0077,0x9b296480)
//$.
#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);
}
#if !defined (_CHILD_H_)
#define _CHILD_H_
void init_child_type (void);
#endif
//$.
#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);
}
#if !defined (_CONTAINER_H_)
#define _CONTAINER_H_
void init_container_type (void);
#endif
#include <stdlib.h>
#include <libguile.h>
#include <child.h>
#include <container.h>
//__________________________________________________________________________________________________
//$. inner_main ()
/* This is the function which gets called by scm_boot_guile after the
* Guile library is completely initialized.*/
static void
inner_main (void *closure, int argc, char **argv)
{
/* First, we create our data type... */
init_child_type ();
init_container_type ();
/* ... then we start a shell, in which the box data type can be
* used. */
scm_shell (argc, argv);
}
//__________________________________________________________________________________________________
//$. main ()
int
main (int argc, char **argv)
{
/* Initialize Guile, then call `inner_main' with the arguments 0,
* argc and argv. */
scm_boot_guile (argc, argv, inner_main, 0);
return 0; /* Never reached. */
}
objects = main.o container.o child.o
guile_config = /usr/bin/guile-config
GUILE_COMP = $(shell $(guile_config) compile)
GUILE_LINK = $(shell $(guile_config) link)
CFLAGS = -I. -ggdb -fpic -Wall $(GUILE_COMP) -Wno-pointer-to-int-cast
-Wno-int-conversion
.PHONY:
all: test
GUILE_WARN_DEPRECATED=detailed ./test.scm
test: $(objects)
gcc $(objects) $(GUILE_LINK) -o $@
%.o: %.c
gcc $(CFLAGS) $(INCLUDE) -c -MD -o $@ $<
%.i: %.c
gcc $(CFLAGS) $(INCLUDE) -E -C -dD -dI $< > $@
.PHONY: dump
dump:
@echo GUILE_COMP=$(GUILE_COMP)
@echo GUILE_LINK=$(GUILE_LINK)
@echo CFLAGS=$(CFLAGS)
.PHONY: clean
clean:
rm -fr test *~ *.o *.la *.lo .libs *.so *.d *.i
-include $(objects:.o=.d)
# Local Variables:
# tab-width: 4
# mode: makefile-gmake
# End:
#!/bin/sh
# -*- scheme -*-
guile_config=/usr/bin/guile-config
LD_LIBRARY_PATH=$(${guile_config} info libdir)
export LD_LIBRARY_PATH
GUILE_AUTO_COMPILE=0
export GUILE_AUTO_COMPILE
exec "./test" -s $0 "$@"
!#
(format #t "version = ~a\n" (version))
(display "(\n[let begin] ----------------------------------------\n")
(let ((c1 (make-container "my.container.1" 2048))
(c2 (make-container "my.container.2" 2048))
(ch1 (make-child))
(ch2 (make-child))
)
(format #t "ch1 = ~s\n" ch1)
(format #t "ch2 = ~s\n" ch2)
(container-set-child c1 ch1)
(container-set-child c2 ch2)
(format #t "c1 = ~s\n" c1)
(format #t "c2 = ~s\n" c2)
(gc)
)
(display "[let end] ------------------------------------------\n)\n")
(display "\n+----------------------------------------------------+\n")
(display "| What are the following mark functions called for? |\n")
(display "+----------------------------------------------------+\n")
(gc)
;; Local Variables:
;; tab-width: 4
;; End:
