guile/guile-tcltk ChangeLog Makefile.am guile-t...

[Mikael Djurfeldt]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Mikael Djurfeldt <address@hidden>       02/12/10 04:51:34

Modified files:
        guile-tcltk    : ChangeLog Makefile.am guile-tcl.c guile-tcl.h 
                         guile-tk.c tclUnixNotfy.c 

Log message:
        * guile-tcl.h (SCM_ENTER_TCL, SCM_LEAVE_TCL): New macros
        (currently they do nothing).
        guile-tcl.c, guile-tk.c, tclUnixNotfy.c: Replaced most
        SCM_DEFER_INTS/SCM_ALLOW_INTS with SCM_ENTER_TCL/SCM_LEAVE_TCL.

CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-tcltk/ChangeLog.diff?cvsroot=OldCVS&tr1=1.70&tr2=1.71&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-tcltk/Makefile.am.diff?cvsroot=OldCVS&tr1=1.28&tr2=1.29&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-tcltk/guile-tcl.c.diff?cvsroot=OldCVS&tr1=1.18&tr2=1.19&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-tcltk/guile-tcl.h.diff?cvsroot=OldCVS&tr1=1.4&tr2=1.5&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-tcltk/guile-tk.c.diff?cvsroot=OldCVS&tr1=1.9&tr2=1.10&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-tcltk/tclUnixNotfy.c.diff?cvsroot=OldCVS&tr1=1.2&tr2=1.3&r1=text&r2=text

Patches:
Index: guile/guile-tcltk/ChangeLog
diff -c guile/guile-tcltk/ChangeLog:1.70 guile/guile-tcltk/ChangeLog:1.71
*** guile/guile-tcltk/ChangeLog:1.70    Sun Nov 17 21:45:06 2002
--- guile/guile-tcltk/ChangeLog Tue Dec 10 04:51:33 2002
***************
*** 1,3 ****
--- 1,10 ----
+ 2002-12-10  Mikael Djurfeldt  <address@hidden>
+ 
+       * guile-tcl.h (SCM_ENTER_TCL, SCM_LEAVE_TCL): New macros
+       (currently they do nothing).
+       guile-tcl.c, guile-tk.c, tclUnixNotfy.c: Replaced most
+       SCM_DEFER_INTS/SCM_ALLOW_INTS with SCM_ENTER_TCL/SCM_LEAVE_TCL.
+ 
  2002-11-17  Mikael Djurfeldt  <address@hidden>
  
        * Makefile.am, guile-tcltk-aclocal.sh: Run aclocal in a sane way.
Index: guile/guile-tcltk/Makefile.am
diff -c guile/guile-tcltk/Makefile.am:1.28 guile/guile-tcltk/Makefile.am:1.29
*** guile/guile-tcltk/Makefile.am:1.28  Sun Nov 17 22:03:24 2002
--- guile/guile-tcltk/Makefile.am       Tue Dec 10 04:51:33 2002
***************
*** 2,8 ****
  
  AUTOMAKE_OPTIONS = foreign
  
! INCLUDES = $(GUILE_CFLAGS)
  
  ACLOCAL = ./guile-tcltk-aclocal.sh
  
--- 2,8 ----
  
  AUTOMAKE_OPTIONS = foreign
  
! INCLUDES = -I . $(GUILE_CFLAGS)
  
  ACLOCAL = ./guile-tcltk-aclocal.sh
  
Index: guile/guile-tcltk/guile-tcl.c
diff -c guile/guile-tcltk/guile-tcl.c:1.18 guile/guile-tcltk/guile-tcl.c:1.19
*** guile/guile-tcltk/guile-tcl.c:1.18  Thu Nov 14 13:19:09 2002
--- guile/guile-tcltk/guile-tcl.c       Tue Dec 10 04:51:33 2002
***************
*** 130,146 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    status = Tcl_GlobalEval (SCM_TERP (tobj), SCM_ROCHARS (script));
!   SCM_ALLOW_INTS;
    
    {
      SCM answer;
      answer = scm_cons (SCM_MAKINUM (status),
                       scm_makfrom0str (SCM_TERP (tobj)->result));
!     SCM_DEFER_INTS;
      Tcl_FreeResult (SCM_TERP (tobj));
!     SCM_ALLOW_INTS;
  #ifdef USE_THREADS
      scm_mutex_unlock (&scm_tcl_mutex);
      if (TclIdlePending ())
--- 130,146 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    status = Tcl_GlobalEval (SCM_TERP (tobj), SCM_ROCHARS (script));
!   SCM_LEAVE_TCL;
    
    {
      SCM answer;
      answer = scm_cons (SCM_MAKINUM (status),
                       scm_makfrom0str (SCM_TERP (tobj)->result));
!     SCM_ENTER_TCL;
      Tcl_FreeResult (SCM_TERP (tobj));
!     SCM_LEAVE_TCL;
  #ifdef USE_THREADS
      scm_mutex_unlock (&scm_tcl_mutex);
      if (TclIdlePending ())
***************
*** 240,246 ****
  
    /* proc had better not longjmp past us -- see:
       with-tcl-error-handling in gtcltk/tcl.SCM */
!   SCM_ALLOW_INTS;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
--- 240,246 ----
  
    /* proc had better not longjmp past us -- see:
       with-tcl-error-handling in gtcltk/tcl.SCM */
!   SCM_LEAVE_TCL;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
***************
*** 248,254 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
  
    if (SCM_NIMP (result) && SCM_ROSTRINGP (result))
      {
--- 248,254 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
  
    if (SCM_NIMP (result) && SCM_ROSTRINGP (result))
      {
***************
*** 316,327 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    Tcl_CreateCommand (SCM_TERP (tobj), SCM_ROCHARS (name),
                     invoke_tcl_command,
                     (ClientData)SCM_CAR (SCM_PROPS (tobj)),
                     delete_tcl_command);
!   SCM_ALLOW_INTS;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
--- 316,327 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    Tcl_CreateCommand (SCM_TERP (tobj), SCM_ROCHARS (name),
                     invoke_tcl_command,
                     (ClientData)SCM_CAR (SCM_PROPS (tobj)),
                     delete_tcl_command);
!   SCM_LEAVE_TCL;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
***************
*** 344,352 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    Tcl_DeleteCommand (SCM_TERP (tobj), SCM_ROCHARS (name));
!   SCM_ALLOW_INTS;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
--- 344,352 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    Tcl_DeleteCommand (SCM_TERP (tobj), SCM_ROCHARS (name));
!   SCM_LEAVE_TCL;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
***************
*** 375,384 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    stat = Tcl_GetInt (SCM_TERP (tobj), SCM_ROCHARS (name), &c_answer);
    Tcl_FreeResult (SCM_TERP (tobj));
!   SCM_ALLOW_INTS;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
--- 375,384 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    stat = Tcl_GetInt (SCM_TERP (tobj), SCM_ROCHARS (name), &c_answer);
    Tcl_FreeResult (SCM_TERP (tobj));
!   SCM_LEAVE_TCL;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
***************
*** 404,413 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    stat = Tcl_GetDouble (SCM_TERP (tobj), SCM_ROCHARS (name), &c_answer);
    Tcl_FreeResult (SCM_TERP (tobj));
!   SCM_ALLOW_INTS;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
--- 404,413 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    stat = Tcl_GetDouble (SCM_TERP (tobj), SCM_ROCHARS (name), &c_answer);
    Tcl_FreeResult (SCM_TERP (tobj));
!   SCM_LEAVE_TCL;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
***************
*** 434,443 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    stat = Tcl_GetBoolean (SCM_TERP (tobj), SCM_ROCHARS (name), &c_answer);
    Tcl_FreeResult (SCM_TERP (tobj));
!   SCM_ALLOW_INTS;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
--- 434,443 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    stat = Tcl_GetBoolean (SCM_TERP (tobj), SCM_ROCHARS (name), &c_answer);
    Tcl_FreeResult (SCM_TERP (tobj));
!   SCM_LEAVE_TCL;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
***************
*** 466,472 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    tcl_result = (TCL_OK == Tcl_SplitList (SCM_TERP (tobj),
                                         SCM_ROCHARS (name), &argc, &argv));
  #ifdef USE_THREADS
--- 466,472 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    tcl_result = (TCL_OK == Tcl_SplitList (SCM_TERP (tobj),
                                         SCM_ROCHARS (name), &argc, &argv));
  #ifdef USE_THREADS
***************
*** 474,487 ****
  #endif
    if (!tcl_result)
      {
!       SCM_ALLOW_INTS;
        SCM_ASSERT (tcl_result, name, SCM_TERP (tobj)->result, 
s_tcl_split_list);
      }
    {
      SCM answer;
      answer = listify_strings (argc, argv);
      free (argv);
!     SCM_ALLOW_INTS;
      return answer;
    }
  }
--- 474,487 ----
  #endif
    if (!tcl_result)
      {
!       SCM_LEAVE_TCL;
        SCM_ASSERT (tcl_result, name, SCM_TERP (tobj)->result, 
s_tcl_split_list);
      }
    {
      SCM answer;
      answer = listify_strings (argc, argv);
      free (argv);
!     SCM_LEAVE_TCL;
      return answer;
    }
  }
***************
*** 507,525 ****
    else
      {
        int i;
!       SCM_DEFER_INTS;
        orig_args = args;
        argv = (char **)malloc (sizeof (char *) * argc);
        if (!argv)
        {
!         SCM_ALLOW_INTS;
          scm_memory_error (s_tcl_merge);
        }
        for (i = 0; i < argc; ++i)
        {
          if (!(SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args))))
            {
!             SCM_ALLOW_INTS;
              SCM_ASSERT (0, SCM_CAR (args), "all arguments must be strings",
                          s_tcl_merge);
            }
--- 507,525 ----
    else
      {
        int i;
!       SCM_ENTER_TCL;
        orig_args = args;
        argv = (char **)malloc (sizeof (char *) * argc);
        if (!argv)
        {
!         SCM_LEAVE_TCL;
          scm_memory_error (s_tcl_merge);
        }
        for (i = 0; i < argc; ++i)
        {
          if (!(SCM_NIMP (SCM_CAR (args)) && SCM_ROSTRINGP (SCM_CAR (args))))
            {
!             SCM_LEAVE_TCL;
              SCM_ASSERT (0, SCM_CAR (args), "all arguments must be strings",
                          s_tcl_merge);
            }
***************
*** 543,549 ****
      answer = scm_makfrom0str (c_answer);
      free (c_answer);
      if (argv) free (argv);
!     SCM_ALLOW_INTS;
      return scm_return_first (answer, orig_args);
    }
  }
--- 543,549 ----
      answer = scm_makfrom0str (c_answer);
      free (c_answer);
      if (argv) free (argv);
!     SCM_LEAVE_TCL;
      return scm_return_first (answer, orig_args);
    }
  }
***************
*** 566,579 ****
    SCM result;
  
    proc = (SCM)SCM_CAR (data);
!   SCM_ALLOW_INTS;
    result = masked_apply (proc,
                         scm_listify (SCM_SELF_INTERP (interp),
                                      scm_makfrom0str (name),
                                      scm_makfrom0str_opt (name2),
                                      SCM_MAKINUM (flags),
                                      SCM_UNDEFINED));
!   SCM_DEFER_INTS;
    return ((result == SCM_BOOL_F)
          ? "Error from Scheme variable trace."
          : 0);
--- 566,579 ----
    SCM result;
  
    proc = (SCM)SCM_CAR (data);
!   SCM_LEAVE_TCL;
    result = masked_apply (proc,
                         scm_listify (SCM_SELF_INTERP (interp),
                                      scm_makfrom0str (name),
                                      scm_makfrom0str_opt (name2),
                                      SCM_MAKINUM (flags),
                                      SCM_UNDEFINED));
!   SCM_ENTER_TCL;
    return ((result == SCM_BOOL_F)
          ? "Error from Scheme variable trace."
          : 0);
***************
*** 607,613 ****
    SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG4, s_tcl_trace_var2);
    SCM_ASSERT (scm_procedure_p (thunk), thunk, SCM_ARG5, s_tcl_trace_var2);
    SCM_PROPS (tobj) = scm_acons (thunk, SCM_EOL, SCM_PROPS (tobj));
!   SCM_DEFER_INTS;
    stat = Tcl_TraceVar2 (SCM_TERP (tobj),
                        SCM_ROCHARS (name),
                        ((index == SCM_BOOL_F)
--- 607,613 ----
    SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG4, s_tcl_trace_var2);
    SCM_ASSERT (scm_procedure_p (thunk), thunk, SCM_ARG5, s_tcl_trace_var2);
    SCM_PROPS (tobj) = scm_acons (thunk, SCM_EOL, SCM_PROPS (tobj));
!   SCM_ENTER_TCL;
    stat = Tcl_TraceVar2 (SCM_TERP (tobj),
                        SCM_ROCHARS (name),
                        ((index == SCM_BOOL_F)
***************
*** 624,630 ****
    else
      result = SCM_BOOL_T;
    Tcl_FreeResult (SCM_TERP (tobj));
!   SCM_ALLOW_INTS;
    return result;
  }
  
--- 624,630 ----
    else
      result = SCM_BOOL_T;
    Tcl_FreeResult (SCM_TERP (tobj));
!   SCM_LEAVE_TCL;
    return result;
  }
  
***************
*** 663,669 ****
        if (SCM_CAR (SCM_CAR (pos)) == thunk)
          {
            int got_it;
!           SCM_DEFER_INTS;
            got_it = Tcl_UntraceVar2 (SCM_TERP (tobj),
                                      SCM_ROCHARS (name),
                                      ((SCM_BOOL_F == index)
--- 663,669 ----
        if (SCM_CAR (SCM_CAR (pos)) == thunk)
          {
            int got_it;
!           SCM_ENTER_TCL;
            got_it = Tcl_UntraceVar2 (SCM_TERP (tobj),
                                      SCM_ROCHARS (name),
                                      ((SCM_BOOL_F == index)
***************
*** 677,686 ****
                SCM_PROPS (tobj) = scm_delq_x (SCM_CAR (pos),
                                               SCM_PROPS (tobj));
                Tcl_FreeResult (SCM_TERP (tobj));
!               SCM_ALLOW_INTS;
                return SCM_BOOL_T;
              }
!           SCM_ALLOW_INTS;
          }
        pos = SCM_CDR (pos);
        }
--- 677,686 ----
                SCM_PROPS (tobj) = scm_delq_x (SCM_CAR (pos),
                                               SCM_PROPS (tobj));
                Tcl_FreeResult (SCM_TERP (tobj));
!               SCM_LEAVE_TCL;
                return SCM_BOOL_T;
              }
!           SCM_LEAVE_TCL;
          }
        pos = SCM_CDR (pos);
        }
***************
*** 718,730 ****
    SCM_STRING_COERCE_0TERMINATION_X (value);
    SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG5, s_tcl_set_var2);
  
!   SCM_DEFER_INTS;
    c_answer = Tcl_SetVar2 (SCM_TERP (tobj),
                          SCM_ROCHARS (name),
                          ((index == SCM_BOOL_F) ? 0 : SCM_ROCHARS (index)),
                          SCM_ROCHARS (value),
                          SCM_INUM (flags));
!   SCM_ALLOW_INTS;
    return scm_makfrom0str_opt (c_answer);
  }
  
--- 718,730 ----
    SCM_STRING_COERCE_0TERMINATION_X (value);
    SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG5, s_tcl_set_var2);
  
!   SCM_ENTER_TCL;
    c_answer = Tcl_SetVar2 (SCM_TERP (tobj),
                          SCM_ROCHARS (name),
                          ((index == SCM_BOOL_F) ? 0 : SCM_ROCHARS (index)),
                          SCM_ROCHARS (value),
                          SCM_INUM (flags));
!   SCM_LEAVE_TCL;
    return scm_makfrom0str_opt (c_answer);
  }
  
***************
*** 752,763 ****
      SCM_STRING_COERCE_0TERMINATION_X (index);
    SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG4, s_tcl_get_var2);
  
!   SCM_DEFER_INTS;
    c_answer = Tcl_GetVar2 (SCM_TERP (tobj),
                          SCM_ROCHARS (name),
                          ((index == SCM_BOOL_F) ? 0 : SCM_ROCHARS (index)),
                          SCM_INUM (flags));
!   SCM_ALLOW_INTS;
    return scm_makfrom0str_opt (c_answer);
  }
  
--- 752,763 ----
      SCM_STRING_COERCE_0TERMINATION_X (index);
    SCM_ASSERT (SCM_INUMP (flags), flags, SCM_ARG4, s_tcl_get_var2);
  
!   SCM_ENTER_TCL;
    c_answer = Tcl_GetVar2 (SCM_TERP (tobj),
                          SCM_ROCHARS (name),
                          ((index == SCM_BOOL_F) ? 0 : SCM_ROCHARS (index)),
                          SCM_INUM (flags));
!   SCM_LEAVE_TCL;
    return scm_makfrom0str_opt (c_answer);
  }
  
***************
*** 776,784 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    status = Tcl_GetCommandInfo (SCM_TERP (tobj), SCM_ROCHARS (name), &info);
!   SCM_ALLOW_INTS;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
--- 776,784 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    status = Tcl_GetCommandInfo (SCM_TERP (tobj), SCM_ROCHARS (name), &info);
!   SCM_LEAVE_TCL;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
***************
*** 798,806 ****
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_DEFER_INTS;
    answer = (Tcl_DoOneEvent (SCM_INUM (flags)));
!   SCM_ALLOW_INTS;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
--- 798,806 ----
  #ifdef USE_THREADS
    scm_mutex_lock (&scm_tcl_mutex);
  #endif
!   SCM_ENTER_TCL;
    answer = (Tcl_DoOneEvent (SCM_INUM (flags)));
!   SCM_LEAVE_TCL;
  #ifdef USE_THREADS
    scm_mutex_unlock (&scm_tcl_mutex);
  #endif
Index: guile/guile-tcltk/guile-tcl.h
diff -c guile/guile-tcltk/guile-tcl.h:1.4 guile/guile-tcltk/guile-tcl.h:1.5
*** guile/guile-tcltk/guile-tcl.h:1.4   Thu Nov 14 13:19:09 2002
--- guile/guile-tcltk/guile-tcl.h       Tue Dec 10 04:51:33 2002
***************
*** 2,8 ****
  
  #ifndef GUILE_TCLH
  #define GUILE_TCLH
! /*    Copyright (C) 1998, 2001 Free Software Foundation, Inc.
   * 
   * This program is free software; you can redistribute it and/or modify
   * it under the terms of the GNU General Public License as published by
--- 2,8 ----
  
  #ifndef GUILE_TCLH
  #define GUILE_TCLH
! /*    Copyright (C) 1998, 2001, 2002 Free Software Foundation, Inc.
   * 
   * This program is free software; you can redistribute it and/or modify
   * it under the terms of the GNU General Public License as published by
***************
*** 44,49 ****
--- 44,51 ----
   * If you do not wish that, delete this exception notice.  */
  
  
+ #include <tcl.h>
+ 
  /* We represent an interpreter using SCM's "smob" representation.  The
     interpreter value points to a pair whose car is
     scm_tc16_tcl_interp, and whose cdr is a pointer to a struct
***************
*** 65,70 ****
--- 67,75 ----
  #define SCM_GTCLTK(OBJ) ((struct gtcltk_interp *) SCM_CDR (OBJ))
  #define SCM_TERP(OBJ) (SCM_GTCLTK(OBJ)->interp)
  #define SCM_PROPS(OBJ) (SCM_GTCLTK(OBJ)->props)
+ 
+ #define SCM_ENTER_TCL
+ #define SCM_LEAVE_TCL
  
  extern int scm_tc16_tcl_interp;
  
Index: guile/guile-tcltk/guile-tk.c
diff -c guile/guile-tcltk/guile-tk.c:1.9 guile/guile-tcltk/guile-tk.c:1.10
*** guile/guile-tcltk/guile-tk.c:1.9    Thu Nov 14 13:19:09 2002
--- guile/guile-tcltk/guile-tk.c        Tue Dec 10 04:51:33 2002
***************
*** 70,91 ****
    SCM_ASSERT (SCM_NIMP (class) && SCM_STRINGP (class), class, SCM_ARG4,
              s_tk_init_main_window);
  
!   SCM_DEFER_INTS;
    status = Tcl_Init(SCM_TERP (tobj));
!   SCM_ALLOW_INTS;
  
    if (status == TCL_ERROR)
      return scm_makfrom0str (SCM_TERP (tobj)->result);
  
!   SCM_DEFER_INTS;
    status = Tk_Init(SCM_TERP (tobj));
!   SCM_ALLOW_INTS;
    if (status == TCL_ERROR)
      return scm_makfrom0str (SCM_TERP (tobj)->result);
  
!   SCM_DEFER_INTS;
    Tcl_SetVar (SCM_TERP (tobj), "tcl_interactive", "0", TCL_GLOBAL_ONLY);
!   SCM_ALLOW_INTS;
  
    return SCM_BOOL_T;
  }
--- 70,91 ----
    SCM_ASSERT (SCM_NIMP (class) && SCM_STRINGP (class), class, SCM_ARG4,
              s_tk_init_main_window);
  
!   SCM_ENTER_TCL;
    status = Tcl_Init(SCM_TERP (tobj));
!   SCM_LEAVE_TCL;
  
    if (status == TCL_ERROR)
      return scm_makfrom0str (SCM_TERP (tobj)->result);
  
!   SCM_ENTER_TCL;
    status = Tk_Init(SCM_TERP (tobj));
!   SCM_LEAVE_TCL;
    if (status == TCL_ERROR)
      return scm_makfrom0str (SCM_TERP (tobj)->result);
  
!   SCM_ENTER_TCL;
    Tcl_SetVar (SCM_TERP (tobj), "tcl_interactive", "0", TCL_GLOBAL_ONLY);
!   SCM_LEAVE_TCL;
  
    return SCM_BOOL_T;
  }
***************
*** 114,124 ****
        scm_tcl_handle_event_p = 0;
        do
        {
!         SCM_DEFER_INTS;
          scm_mask_ints = 1;
          events = Tcl_DoOneEvent (TCL_ALL_EVENTS | TCL_DONT_WAIT);
          scm_mask_ints = 0;
!         SCM_ALLOW_INTS;
          SCM_ASYNC_TICK;
        }
        while (events);
--- 114,124 ----
        scm_tcl_handle_event_p = 0;
        do
        {
!         SCM_ENTER_TCL;
          scm_mask_ints = 1;
          events = Tcl_DoOneEvent (TCL_ALL_EVENTS | TCL_DONT_WAIT);
          scm_mask_ints = 0;
!         SCM_LEAVE_TCL;
          SCM_ASYNC_TICK;
        }
        while (events);
***************
*** 151,159 ****
         && Tk_GetNumMainWindows () > 0)
      {
        scm_mutex_lock (&scm_tcl_mutex);
!       SCM_DEFER_INTS;
        Tcl_GetCheckMasks (&nfds, masks);
!       SCM_ALLOW_INTS;
        SCM_ASYNC_TICK;
        scm_mutex_unlock (&scm_tcl_mutex);
        scm_internal_select (nfds, &masks[0], &masks[1], &masks[2], 0);
--- 151,159 ----
         && Tk_GetNumMainWindows () > 0)
      {
        scm_mutex_lock (&scm_tcl_mutex);
!       SCM_ENTER_TCL;
        Tcl_GetCheckMasks (&nfds, masks);
!       SCM_LEAVE_TCL;
        SCM_ASYNC_TICK;
        scm_mutex_unlock (&scm_tcl_mutex);
        scm_internal_select (nfds, &masks[0], &masks[1], &masks[2], 0);
***************
*** 195,205 ****
                      (scm_t_catch_handler) main_loop_handler,
                      (void*) loop_invocation);
  #else
!   SCM_DEFER_INTS;
    in_tk_loop_p = 1;
    Tk_MainLoop ();
    in_tk_loop_p = 0;
!   SCM_ALLOW_INTS;
  #endif
    return SCM_UNSPECIFIED;
  }
--- 195,205 ----
                      (scm_t_catch_handler) main_loop_handler,
                      (void*) loop_invocation);
  #else
!   SCM_ENTER_TCL;
    in_tk_loop_p = 1;
    Tk_MainLoop ();
    in_tk_loop_p = 0;
!   SCM_LEAVE_TCL;
  #endif
    return SCM_UNSPECIFIED;
  }
Index: guile/guile-tcltk/tclUnixNotfy.c
diff -c guile/guile-tcltk/tclUnixNotfy.c:1.2 
guile/guile-tcltk/tclUnixNotfy.c:1.3
*** guile/guile-tcltk/tclUnixNotfy.c:1.2        Thu Nov 14 13:19:09 2002
--- guile/guile-tcltk/tclUnixNotfy.c    Tue Dec 10 04:51:33 2002
***************
*** 57,62 ****
--- 57,63 ----
  
  #if 1 /* GUILE */
  #include <libguile.h>
+ #include "guile-tcl.h"
  #endif
  #include "tclInt.h"
  #if 1 /* GUILE */
***************
*** 288,298 ****
        timeout.tv_usec = timePtr->usec;
      }
  #if 1 /* GUILE */
!     SCM_ALLOW_INTS;
      numFound = scm_internal_select (numFdBits, (SELECT_MASK *) &readyMasks[0],
            (SELECT_MASK *) &readyMasks[MASK_SIZE],
            (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
!     SCM_DEFER_INTS;
  #endif
  
      /*
--- 289,299 ----
        timeout.tv_usec = timePtr->usec;
      }
  #if 1 /* GUILE */
!     SCM_LEAVE_TCL;
      numFound = scm_internal_select (numFdBits, (SELECT_MASK *) &readyMasks[0],
            (SELECT_MASK *) &readyMasks[MASK_SIZE],
            (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
!     SCM_ENTER_TCL;
  #endif
  
      /*
***************
*** 348,358 ****
        timeout.tv_sec = timePtr->sec;
        timeout.tv_usec = timePtr->usec;
      }
!     SCM_ALLOW_INTS;
      numFound = scm_internal_select (numFdBits, (SELECT_MASK *) &readyMasks[0],
            (SELECT_MASK *) &readyMasks[MASK_SIZE],
            (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
!     SCM_DEFER_INTS;
  
      /*
       * Some systems don't clear the masks after an error, so
--- 349,359 ----
        timeout.tv_sec = timePtr->sec;
        timeout.tv_usec = timePtr->usec;
      }
!     SCM_LEAVE_TCL;
      numFound = scm_internal_select (numFdBits, (SELECT_MASK *) &readyMasks[0],
            (SELECT_MASK *) &readyMasks[MASK_SIZE],
            (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
!     SCM_ENTER_TCL;
  
      /*
       * Some systems don't clear the masks after an error, so
***************
*** 451,460 ****
                || ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
            break;
        }
!       SCM_ALLOW_INTS;
        (void) scm_internal_select (0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
                (SELECT_MASK *) 0, &delay);
!       SCM_DEFER_INTS;
        TclpGetTime(&before);
      }
  }
--- 452,461 ----
                || ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
            break;
        }
!       SCM_LEAVE_TCL;
        (void) scm_internal_select (0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
                (SELECT_MASK *) 0, &delay);
!       SCM_ENTER_TCL;
        TclpGetTime(&before);
      }
  }