Re: global variables & data tags (a la X-Windows callbacks)

[Greg Harvey <Greg.Harvey@thezone.net>]

robertb@continuumsi.com (Robert Brown) writes:

> Sorry to do this to everybody, but I cannot get this tag stuff to work and
> was hoping someone could help me debug it.  For some reason, every time I
> call gh_get_tag_data() (see below), I receive a different (and seemingly
> random) value.  And I assume that that's because gh_eval_str() is
> returning a different SCM object each time I call it, even if I call it
> with the same string.
> 
> I tried stepping through the code, but what the SCM/Guile interpreter is doing
> is mystifying.  So, I don't understand its return values.
> 
> Does anybody see what's wrong with the code below for accomplishing my
> goals and how it might be changed to do what I want?
> 
> -------------------------------------------------------------------------------
> 
> struct genericptr {
>   void* ptr;
>   SCM name;
> };
> 
> static SCM
> mark_genericptr (SCM genericptr_smob)
> {
>   struct genericptr *genericptr = (struct genericptr *) SCM_CDR (genericptr_smob);
> 
>   scm_gc_mark (genericptr->name);
>   return SCM_UNSPECIFIED;
> }
> 
> static scm_sizet
> free_genericptr (SCM genericptr_smob)
> {
>   struct genericptr *genericptr = (struct genericptr *) SCM_CDR (genericptr_smob);
>   scm_sizet size = sizeof (struct genericptr);
> 
>   free (genericptr);
> 
>   return size;
> }
> 
> SCM gh_ptr2scm(void* ptr)
> {
>   struct genericptr* newlib;
>   SCM genericptr_smob;
>   static scm_smobfuns genericptr_funs = {
>     mark_genericptr, free_genericptr, 0, 0
>   };
> 
>   newlib=(struct genericptr *)scm_must_malloc(sizeof(struct genericptr), "genericptr");
>   newlib->ptr=ptr;
>   newlib->name=gh_str02scm("genericptr");
>   SCM_NEWCELL (genericptr_smob);
>   SCM_SETCDR (genericptr_smob, newlib);
>   SCM_SETCAR (genericptr_smob, scm_newsmob(&genericptr_funs));

Eww. You really want to only register these once as an smob, then use
that number (or you'll run out of smobs). Something like (quickly
slapped together, not tested... a bit ugly, too; Message mode isn't
ideal for writing c code ;):

long scm_tc16_genericptr;
SCM scm_genericptr_name;
SCM scm_genericptr_sym;

static scm_smobfuns genericptr_funs = {
        mark_genericptr,
        free_genericptr,
        0,
        0
};

/*
  This will have to be called before you do anything with this stuff
 */

static void
scm_initgeneric(void)
{
        scm_tc16_genericptr = scm_newsmob(&genericptr_funs);
        scm_genericptr_name = gh_str02scm("genericptr");
        scm_permanent_obj(scm_genericptr_name);
        scm_genericptr_sym = gh_symbol2scm("genericptr");
        scm_permanent_obj(scm_genericptr_sym);
}

SCM gh_ptr2scm(void* ptr)
{
   struct genericptr* newlib;
   SCM genericptr_smob;
 
   newlib=(struct genericptr *)scm_must_malloc(sizeof(struct genericptr), "genericptr");
   newlib->ptr=ptr;
   newlib->name=scm_genericptr_name;
   SCM_NEWCELL (genericptr_smob);
   SCM_DEFER_INTS;
   SCM_SETCDR (genericptr_smob, newlib);
   SCM_SETCAR (genericptr_smob, scm_tc16_genericptr);
   SCM_ALLOW_INTS;
   return genericptr_smob;
}

 
void* gh_scm2ptr(SCM ptr)
{
   return (void*)SCM_CDR(ptr);
}
 
void gh_set_ext_data(SCM scm, void* ptr)
{
  scm_set_object_property_x(scm, scm_genericptr_sym, gh_ptr2scm(ptr));
}
 
void* gh_get_ext_data(SCM scm)
{
  return gh_scm2ptr(scm_object_property(scm, scm_genericptr_sym));
}
 
void* gh_get_tag_data(const char* procname)
{
  return gh_scm2ptr(scm_object_property(gh_eval_str((char*)procname), scm_genericptr_sym));
}



-- 
Greg