This is the mail archive of the guile@sourceware.cygnus.com mailing list for the Guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

Re: Why does the GC frees my function?


Neil Jerram <neil@ossau.uklinux.net> a écrit :

> Well I looked backed through previous posts under this subject, and I
> couldn't find your (complete) source for this problem.  One of your
> posts includes the line
> 
>       init_hook = scm_make_named_hook ("init", 1);
> 
> but that's not enough (for me at least) to debug this problem.

Here the source is:

/* main.c */

#include <stdio.h>
#include <unistd.h>
#include <ctype.h>

#include <libguile.h>
#include <guile/gh.h>

#define VERSION "kbind v0.0"
#define RC "kbind.scm"
#define ALPHA_NUMBER 26

SCM version; 
SCM *alpha_binding;

SCM init_hook;
SCM quit_hook;

void
init_alpha_binding (void)
{
  SCM v = scm_make_vector (SCM_MAKINUM(ALPHA_NUMBER), SCM_BOOL_F);
  scm_protect_object (v);
  alpha_binding = SCM_VELTS(v);
}


SCM
bind_key (key, function)
     SCM key;
     SCM function;
{
  char c;

  if (!gh_char_p (key)) {
    return SCM_BOOL_F;
  }
  c = gh_scm2char (key);
  if (!isalpha (c)) {
    return SCM_BOOL_F;
  }
  if (isupper (c)) {
    c = tolower (c);
  }
  return alpha_binding[(int) c - (int) 'a'] = function;
}

void
exec_key (i)
     int i;
{
  SCM key_function;

  char c = (char) i;
  if (!isalpha (c)) {
      return;
  }
  if (isupper (c)) {
    c = tolower (c);
  }
  key_function = alpha_binding[(int) c - (int) 'a'];
/* i should test if key_function is a procedure */
  if (scm_null_p (key_function)) {
    return;
  }
  gh_call0 (key_function);
}

SCM
run_hook1(hook, arg1)
     SCM hook;
     SCM arg1;
{
  return scm_run_hook(hook,gh_cons(arg1,SCM_EOL));
}

void
main_prog (argc, argv)
     int argc;
     char ** argv;
{
  int k;
  SCM init_hook;
  SCM quit_hook;

  /* create the hooks and initialize variable */
  init_hook = scm_make_named_hook ("init", 1);
  quit_hook = scm_make_named_hook ("quit", 1);
  gh_new_procedure0_2 ("bind-key", bind_key);
  gh_new_procedure0_1 ("printf", scm_printf);
  version = gh_str02scm (VERSION);
  init_alpha_binding ();	

/*    scm_protect_object (init_hook);*/
/*    scm_protect_object (quit_hook);*/


  /* load the config file and run init_hook*/
  gh_load (RC);
  run_hook1 (init_hook, version); 
  
  /* run quit_hook and quit */	
  run_hook1 (quit_hook, version);
}

int
main (argc, argv)
     int argc;
     char ** argv;
{
  gh_enter (argc, argv, main_prog);
  exit (EXIT_SUCCESS);
}
/* end main.c */

/* kbind.scm */
(add-hook! init
 	   (lambda (str)
	     (display
	      (string-append "Welcome to " str ".\n"))))

(add-hook! quit
	   (lambda (str)
	     (display "Bye bye.\n")))

(bind-key #\a
	  (lambda ()
	    (display "a")))

(bind-key #\b
	  (lambda ()
	    (display "b")))

(bind-key #\c
	  (lambda ()
	    (display "c")))

(bind-key #\d
	(lambda ()
            (display "d")   
/* end kbind.scm */

So?

-- 
  Ici, l'exemple est un peu capillotracté. 
  Si on choisissait plutôt un dilemme entre fr.comp.os.unix et
  fr.rec.arts.os.unix ? 
  -+- APM in: Guide du Cabaliste Usenet - La Cabale est-elle barbue ? -+-

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]