Patch for 2.1.3

From: Erick Gallesio <eg_at_kaolin.unice.fr>
Date: Thu, 15 Sep 1994 15:52:21 +0100

Hereafter is enclosed a patch to bring your 2.1.2 version to 2.1.3 level. This
version corrects (all, I hope) GC problems. I've use it rather extensively
since yesterday and it seems to be correct.
To apply the patch, go in the STk2.1.2 directory and type
        $ patch < 2.1.2-to-2.1.3-patches
        $ make
and eventually
        $ make install

If you have problems, you can grab a full copy of 2.1.3 on kaolin.unice.fr.

Sorry for this bad try version.

                -- Erick

PS: Some people have sent me corrections relative to installation problems.
I had not time to integrate them in this quick release. They will be in the
next one (which will be probably 2.2!!)

-----------------file 2.1.2-to-2.1.3-patches--------------------------------
*** Extensions/Ext-2.1.2/stklos.c Thu Sep 15 15:24:31 1994
--- ./Extensions/stklos.c Wed Sep 14 18:44:17 1994
***************
*** 19,25 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 9-Feb-1994 15:56
! * Last file update: 9-Sep-1994 09:00
   */
  
  #include <stk.h>
--- 19,25 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 9-Feb-1994 15:56
! * Last file update: 14-Sep-1994 18:44
   */
  
  #include <stk.h>
***************
*** 50,61 ****
  SCM make_instance(SCM class, long size, int type)
  {
    SCM z;
  
    NEWCELL(z, tc_instance);
    EXTDATA(z) = must_malloc(sizeof(Instance));
  
    CLASS_OF(z) = class;
! SLOTS_OF(z) = makevect(size, UNBOUND);
    INST_TYPE(z) = type;
    ACCESSORS_OF(z) = class? THE_SLOT_OF(class, S_getters_n_setters) : NIL;
    return z;
--- 50,68 ----
  SCM make_instance(SCM class, long size, int type)
  {
    SCM z;
+ SCM slots;
  
+ /* Allocate slots before the instance itself to avoid to have a partially
+ * unfilled instance if a GC occurs during vector creation.
+ * Bug signaled by Rob Deline
+ */
+ slots = makevect(size, UNBOUND);
+
    NEWCELL(z, tc_instance);
    EXTDATA(z) = must_malloc(sizeof(Instance));
  
    CLASS_OF(z) = class;
! SLOTS_OF(z) = slots;
    INST_TYPE(z) = type;
    ACCESSORS_OF(z) = class? THE_SLOT_OF(class, S_getters_n_setters) : NIL;
    return z;
***************
*** 321,329 ****
    THE_SLOT_OF(Class, S_cpl) = LIST3(Class, Object, Top);
  
    /* protect Top, Object and Class against garbage collection */
! gc_special(Top);
! gc_special(Object);
! gc_special(Class);
  }
  
  
--- 328,336 ----
    THE_SLOT_OF(Class, S_cpl) = LIST3(Class, Object, Top);
  
    /* protect Top, Object and Class against garbage collection */
! gc_protect(&Top);
! gc_protect(&Object);
! gc_protect(&Class);
  }
  
  
***************
*** 332,338 ****
     SCM tmp = intern(name);
     
     *var=basic_make_class(meta, tmp, supers, NIL);
! gc_special(*var);
     VCELL(tmp) = *var;
  }
  
--- 339,345 ----
     SCM tmp = intern(name);
     
     *var=basic_make_class(meta, tmp, supers, NIL);
! gc_protect(var);
     VCELL(tmp) = *var;
  }
  
***************
*** 531,558 ****
   ****************************************************************************
**/
  PRIMITIVE modify_instance(SCM old, SCM new)
  {
! SCM z;
  
    if (NINSTANCEP(old) || NINSTANCEP(new))
! err("%modify-instance: both parameters must be instances", NIL);
!
! /* First make a clone to avoid gc-problems */
! NEWCELL(z, tc_instance);
  
! EXTDATA(z) = EXTDATA(old);
! CLASS_OF(z) = CLASS_OF(old);
! SLOTS_OF(z) = SLOTS_OF(old);
! INST_TYPE(z) = INST_TYPE(old);
! ACCESSORS_OF(z) = ACCESSORS_OF(old);
!
! /* Now copy new content in old */
! EXTDATA(old) = EXTDATA(new);
! CLASS_OF(old) = CLASS_OF(new);
! SLOTS_OF(old) = SLOTS_OF(new);
! INST_TYPE(old) = INST_TYPE(new);
! ACCESSORS_OF(old) = ACCESSORS_OF(new);
!
! /* Now z will probaly be garbaged later since nobody points it */
    return old;
  }
  
--- 538,553 ----
   ****************************************************************************
**/
  PRIMITIVE modify_instance(SCM old, SCM new)
  {
! void *old_data;
  
    if (NINSTANCEP(old) || NINSTANCEP(new))
! err("%modify-instance: both parameters must be instances", NIL);
  
! /* Exchange the data contained in old and new */
! old_data = (void *) EXTDATA(old);
! EXTDATA(old) = EXTDATA(new);
! EXTDATA(new) = old_data;
!
    return old;
  }
  
*** Src/Src-2.1.2/eval.c Thu Sep 15 14:55:20 1994
--- ./Src/eval.c Tue Sep 13 18:35:24 1994
***************
*** 19,25 ****
   *
   * Author: Erick Gallesio [eg_at_kaolin.unice.fr]
   * Creation date: 23-Oct-1993 21:37
! * Last file update: 7-Sep-1994 20:28
   */
  
  #include "stk.h"
--- 19,25 ----
   *
   * Author: Erick Gallesio [eg_at_kaolin.unice.fr]
   * Creation date: 23-Oct-1993 21:37
! * Last file update: 13-Sep-1994 18:35
   */
  
  #include "stk.h"
***************
*** 444,450 ****
           for(code=CDR(fct->storage_as.closure.code); NNULLP(code); code=CDR(code))
             param = EVALCAR(code);
           return param;
- return EVAL(cons(sym_progn, CDR(fct->storage_as.closure.code)));
         }
  #ifdef USE_TK
      case tc_tkcommand:
--- 444,449 ----
*** Src/Src-2.1.2/gc.c Thu Sep 15 14:55:20 1994
--- ./Src/gc.c Tue Sep 13 18:45:50 1994
***************
*** 20,26 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 17-Feb-1993 12:27
! * Last file update: 8-Sep-1994 10:17
   *
   */
  
--- 20,26 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 17-Feb-1993 12:27
! * Last file update: 13-Sep-1994 18:45
   *
   */
  
***************
*** 38,44 ****
  };
  
  
-
  /* exported vars */
  SCM freelist;
  SCM *stack_start_ptr;
--- 38,43 ----
***************
*** 135,143 ****
  {
  Top:
     if (NULLP(ptr) || SMALL_CSTP(ptr)) return;
! if (ptr->gc_mark & GC_MARK) return;
  
! ptr->gc_mark |= GC_MARK;
  
     switch (TYPE(ptr)) {
       case tc_nil: return;
--- 134,142 ----
  {
  Top:
     if (NULLP(ptr) || SMALL_CSTP(ptr)) return;
! if (ptr->gc_mark) return;
  
! ptr->gc_mark = GC_MARK;
  
     switch (TYPE(ptr)) {
       case tc_nil: return;
***************
*** 296,309 ****
          
          /* Declare this cell free and put it in free list */
          ptr->type = tc_free_cell;
- ptr->gc_mark = 0;
          CDR(ptr) = nfreelist;
          nfreelist = ptr;
          n += 1;
        }
        else
! /* This cell was marked; unmark it */
! ptr->gc_mark &= ~GC_MARK;
      }
    }
    gc_cells_collected = n;
--- 295,306 ----
          
          /* Declare this cell free and put it in free list */
          ptr->type = tc_free_cell;
          CDR(ptr) = nfreelist;
          nfreelist = ptr;
          n += 1;
        }
        else
! ptr->gc_mark = 0;
      }
    }
    gc_cells_collected = n;
***************
*** 389,400 ****
    no_interrupt(flag);
    return(UNDEFINED);
  }
-
- void gc_special(SCM location)
- {
- location->gc_mark = GC_SPECIAL;
- }
-
  
  void gc_protect(SCM *location)
  {
--- 386,391 ----
*** Src/Src-2.1.2/gc.h Thu Sep 15 14:55:20 1994
--- ./Src/gc.h Tue Sep 13 18:42:02 1994
***************
*** 20,26 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 17-Feb-1993 12:27
! * Last file update: 8-Sep-1994 10:13
   *
   *
   */
--- 20,26 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 17-Feb-1993 12:27
! * Last file update: 13-Sep-1994 18:42
   *
   *
   */
***************
*** 31,37 ****
  double total_gc_time;
  
  #define GC_MARK 01 /* To mark a cell */
- #define GC_SPECIAL 02 /* special cell (never GC'ed) */
  
  #define NEWCELL(_into,_type) \
  { \
--- 31,36 ----
***************
*** 46,52 ****
  
  void gc_mark_and_sweep(void);
  void gc_for_newcell(void);
- void gc_special(SCM location); /* Never GC this location */
  void gc_protect(SCM *location); /* protect against garbage the cell which is
here */
  void gc_mark(SCM location); /* mark (recursively) this location */
  int valid_address(SCM p); /* true if p is a valid address */
--- 45,50 ----
*** Src/Src-2.1.2/globals.c Thu Sep 15 14:55:20 1994
--- ./Src/globals.c Tue Sep 13 18:38:33 1994
***************
*** 17,23 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 9-Aug-1993 23:44
! * Last file update: 2-Sep-1994 14:14
   *
   */
  
--- 17,23 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 9-Aug-1993 23:44
! * Last file update: 13-Sep-1994 18:38
   *
   */
  
***************
*** 39,47 ****
  char *tkbuffer = NULL;
  
  /* Special symbols */
! SCM sym_progn, sym_lambda, sym_quote,sym_dot, sym_imply, sym_debug,
! sym_else, sym_define, sym_letrec,
! sym_quasiquote, sym_unquote, sym_unquote_splicing;
  
  /* Dynamic-wind */
  SCM wind_stack;
--- 39,46 ----
  char *tkbuffer = NULL;
  
  /* Special symbols */
! SCM sym_lambda, sym_quote,sym_dot, sym_imply, sym_debug,
! sym_else, sym_quasiquote, sym_unquote, sym_unquote_splicing;
  
  /* Dynamic-wind */
  SCM wind_stack;
*** Src/Src-2.1.2/globals.h Thu Sep 15 14:55:20 1994
--- ./Src/globals.h Tue Sep 13 18:38:59 1994
***************
*** 17,23 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 9-Aug-1993 23:44
! * Last file update: 2-Sep-1994 14:14
   *
   */
  
--- 17,23 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 9-Aug-1993 23:44
! * Last file update: 13-Sep-1994 18:38
   *
   */
  
***************
*** 38,46 ****
  extern char *tkbuffer;
  
  /* Special symbols */
! extern SCM sym_progn, sym_lambda, sym_quote,sym_dot, sym_imply, sym_debug,
! sym_else, sym_define, sym_letrec,
! sym_quasiquote, sym_unquote, sym_unquote_splicing;
  
  /* Dynamic-wind */
  extern SCM wind_stack;
--- 38,45 ----
  extern char *tkbuffer;
  
  /* Special symbols */
! extern SCM sym_lambda, sym_quote,sym_dot, sym_imply, sym_debug,
! sym_else, sym_quasiquote, sym_unquote, sym_unquote_splicing;
  
  /* Dynamic-wind */
  extern SCM wind_stack;
*** Src/Src-2.1.2/keyword.c Thu Sep 15 14:55:21 1994
--- ./Src/keyword.c Wed Sep 14 18:48:33 1994
***************
*** 19,25 ****
   *
   * Author: Erick Gallesio [eg_at_kaolin.unice.fr]
   * Creation date: 19-Nov-1993 16:12
! * Last file update: 2-Sep-1994 17:06
   */
  
  #include "stk.h"
--- 19,25 ----
   *
   * Author: Erick Gallesio [eg_at_kaolin.unice.fr]
   * Creation date: 19-Nov-1993 16:12
! * Last file update: 14-Sep-1994 18:48
   */
  
  #include "stk.h"
***************
*** 42,58 ****
    int absent;
  
    *token = '-'; /* because keywords corresponds to Tk options */
! p = Tcl_CreateHashEntry(&k_table, token, &absent);
! if (absent) {
      SCM keyword;
!
      NEWCELL(keyword, tc_keyword);
      KEYVAL(keyword) = Tcl_GetHashKey(&k_table, p);
      Tcl_SetHashValue(p, (ClientData) keyword);
      return keyword;
    }
- else
- return (SCM) Tcl_GetHashValue(p);
  }
  
  PRIMITIVE make_keyword(SCM str)
--- 42,62 ----
    int absent;
  
    *token = '-'; /* because keywords corresponds to Tk options */
! if (p = Tcl_FindHashEntry(&k_table, token))
! return (SCM) Tcl_GetHashValue(p);
! else {
      SCM keyword;
! int absent;
!
! /* Be careful with GC: Create hash entry after the new cell to avoid
! * partially initialized table entry
! */
      NEWCELL(keyword, tc_keyword);
+ p = Tcl_CreateHashEntry(&k_table, token, &absent);
      KEYVAL(keyword) = Tcl_GetHashKey(&k_table, p);
      Tcl_SetHashValue(p, (ClientData) keyword);
      return keyword;
    }
  }
  
  PRIMITIVE make_keyword(SCM str)
*** Src/Src-2.1.2/macros.c Thu Sep 15 14:55:22 1994
--- ./Src/macros.c Mon Sep 12 18:04:58 1994
***************
*** 17,23 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: ??-Oct-1993 ??:??
! * Last file update: 29-Aug-1994 12:34
   *
   */
  
--- 17,23 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: ??-Oct-1993 ??:??
! * Last file update: 12-Sep-1994 18:04
   *
   */
  
***************
*** 26,37 ****
  
  PRIMITIVE lmacro(SCM args, SCM env)
  {
! SCM z;
    
    if (llength(args) != 2) err("macro: Bad parameter list", args);
  
    NEWCELL(z, tc_macro);
! z->storage_as.macro.code = EVAL(cons(sym_lambda, args));
    return z;
  }
  
--- 26,38 ----
  
  PRIMITIVE lmacro(SCM args, SCM env)
  {
! SCM z, code;
    
    if (llength(args) != 2) err("macro: Bad parameter list", args);
  
+ code = cons(sym_lambda, args); /* Create code before to avoid GC problems
*/
    NEWCELL(z, tc_macro);
! z->storage_as.macro.code = EVAL(code);
    return z;
  }
  
*** Src/Src-2.1.2/port.c Thu Sep 15 14:55:22 1994
--- ./Src/port.c Tue Sep 13 18:22:30 1994
***************
*** 19,25 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 17-Feb-1993 12:27
! * Last file update: 24-Aug-1994 17:21
   *
   */
  
--- 19,25 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 17-Feb-1993 12:27
! * Last file update: 13-Sep-1994 18:22
   *
   */
  
***************
*** 120,139 ****
    NEWCELL(curr_iport, tc_iport);
    curr_iport->storage_as.port.name = "*stdin*";
    curr_iport->storage_as.port.f = stdin;
! gc_special(curr_iport);
  
    NEWCELL(curr_oport, tc_oport);
    curr_oport->storage_as.port.name = "*stdout*";
    curr_oport->storage_as.port.f = stdout;
! gc_special(curr_oport);
   
    NEWCELL(curr_eport, tc_oport);
    curr_eport->storage_as.port.name = "*stderr*";
    curr_eport->storage_as.port.f = stderr;
! gc_special(curr_eport);
    
    NEWCELL(eof_object, tc_eof);
! gc_special(eof_object);
  }
  
  
--- 120,139 ----
    NEWCELL(curr_iport, tc_iport);
    curr_iport->storage_as.port.name = "*stdin*";
    curr_iport->storage_as.port.f = stdin;
! gc_protect(&curr_iport);
  
    NEWCELL(curr_oport, tc_oport);
    curr_oport->storage_as.port.name = "*stdout*";
    curr_oport->storage_as.port.f = stdout;
! gc_protect(&curr_oport);
   
    NEWCELL(curr_eport, tc_oport);
    curr_eport->storage_as.port.name = "*stderr*";
    curr_eport->storage_as.port.f = stderr;
! gc_protect(&curr_eport);
    
    NEWCELL(eof_object, tc_eof);
! gc_protect(&eof_object);
  }
  
  
*** Src/Src-2.1.2/slib.c Thu Sep 15 14:55:23 1994
--- ./Src/slib.c Tue Sep 13 15:21:21 1994
***************
*** 17,23 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: ??-Oct-1993 ??:??
! * Last file update: 7-Sep-1994 13:35
   *
   */
  
--- 17,23 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: ??-Oct-1993 ??:??
! * Last file update: 13-Sep-1994 15:21
   *
   */
  
***************
*** 45,58 ****
    tmp = (void *) malloc(size);
  
    /* Test for size because some libc return NULL when doing malloc(0) */
! if (tmp == NULL && size) {
! /* make a GC and try again to allocate space */
! gc_mark_and_sweep();
! tmp = (void *) malloc(size);
! if (tmp == NULL && size)
! /* This time, we have lost */
! err("failed to allocate storage from system", NIL);
! }
    return(tmp);
  }
  
--- 45,52 ----
    tmp = (void *) malloc(size);
  
    /* Test for size because some libc return NULL when doing malloc(0) */
! if (tmp == NULL && size)
! err("failed to allocate storage from system", NIL);
    return(tmp);
  }
  
***************
*** 61,74 ****
    void *tmp;
  
    tmp = (void *) realloc(ptr, size);
! if (tmp == NULL) {
! /* make a GC and try again to allocate space */
! gc_mark_and_sweep();
! tmp = (void *) realloc(ptr, size);
! if (tmp == NULL && size)
! /* This time, we have lost */
! err("failed to re-allocate storage from system",NIL);
! }
    return(tmp);
  }
  #endif
--- 55,62 ----
    void *tmp;
  
    tmp = (void *) realloc(ptr, size);
! if (tmp == NULL)
! err("failed to re-allocate storage from system",NIL);
    return(tmp);
  }
  #endif
*** Src/Src-2.1.2/stklos.c Thu Sep 15 14:55:25 1994
--- ./Src/stklos.c Wed Sep 14 18:44:17 1994
***************
*** 19,25 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 9-Feb-1994 15:56
! * Last file update: 9-Sep-1994 09:00
   */
  
  #include <stk.h>
--- 19,25 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 9-Feb-1994 15:56
! * Last file update: 14-Sep-1994 18:44
   */
  
  #include <stk.h>
***************
*** 50,61 ****
  SCM make_instance(SCM class, long size, int type)
  {
    SCM z;
  
    NEWCELL(z, tc_instance);
    EXTDATA(z) = must_malloc(sizeof(Instance));
  
    CLASS_OF(z) = class;
! SLOTS_OF(z) = makevect(size, UNBOUND);
    INST_TYPE(z) = type;
    ACCESSORS_OF(z) = class? THE_SLOT_OF(class, S_getters_n_setters) : NIL;
    return z;
--- 50,68 ----
  SCM make_instance(SCM class, long size, int type)
  {
    SCM z;
+ SCM slots;
  
+ /* Allocate slots before the instance itself to avoid to have a partially
+ * unfilled instance if a GC occurs during vector creation.
+ * Bug signaled by Rob Deline
+ */
+ slots = makevect(size, UNBOUND);
+
    NEWCELL(z, tc_instance);
    EXTDATA(z) = must_malloc(sizeof(Instance));
  
    CLASS_OF(z) = class;
! SLOTS_OF(z) = slots;
    INST_TYPE(z) = type;
    ACCESSORS_OF(z) = class? THE_SLOT_OF(class, S_getters_n_setters) : NIL;
    return z;
***************
*** 321,329 ****
    THE_SLOT_OF(Class, S_cpl) = LIST3(Class, Object, Top);
  
    /* protect Top, Object and Class against garbage collection */
! gc_special(Top);
! gc_special(Object);
! gc_special(Class);
  }
  
  
--- 328,336 ----
    THE_SLOT_OF(Class, S_cpl) = LIST3(Class, Object, Top);
  
    /* protect Top, Object and Class against garbage collection */
! gc_protect(&Top);
! gc_protect(&Object);
! gc_protect(&Class);
  }
  
  
***************
*** 332,338 ****
     SCM tmp = intern(name);
     
     *var=basic_make_class(meta, tmp, supers, NIL);
! gc_special(*var);
     VCELL(tmp) = *var;
  }
  
--- 339,345 ----
     SCM tmp = intern(name);
     
     *var=basic_make_class(meta, tmp, supers, NIL);
! gc_protect(var);
     VCELL(tmp) = *var;
  }
  
***************
*** 531,558 ****
   ****************************************************************************
**/
  PRIMITIVE modify_instance(SCM old, SCM new)
  {
! SCM z;
  
    if (NINSTANCEP(old) || NINSTANCEP(new))
! err("%modify-instance: both parameters must be instances", NIL);
!
! /* First make a clone to avoid gc-problems */
! NEWCELL(z, tc_instance);
  
! EXTDATA(z) = EXTDATA(old);
! CLASS_OF(z) = CLASS_OF(old);
! SLOTS_OF(z) = SLOTS_OF(old);
! INST_TYPE(z) = INST_TYPE(old);
! ACCESSORS_OF(z) = ACCESSORS_OF(old);
!
! /* Now copy new content in old */
! EXTDATA(old) = EXTDATA(new);
! CLASS_OF(old) = CLASS_OF(new);
! SLOTS_OF(old) = SLOTS_OF(new);
! INST_TYPE(old) = INST_TYPE(new);
! ACCESSORS_OF(old) = ACCESSORS_OF(new);
!
! /* Now z will probaly be garbaged later since nobody points it */
    return old;
  }
  
--- 538,553 ----
   ****************************************************************************
**/
  PRIMITIVE modify_instance(SCM old, SCM new)
  {
! void *old_data;
  
    if (NINSTANCEP(old) || NINSTANCEP(new))
! err("%modify-instance: both parameters must be instances", NIL);
  
! /* Exchange the data contained in old and new */
! old_data = (void *) EXTDATA(old);
! EXTDATA(old) = EXTDATA(new);
! EXTDATA(new) = old_data;
!
    return old;
  }
  
*** Src/Src-2.1.2/symbol.c Thu Sep 15 14:55:25 1994
--- ./Src/symbol.c Wed Sep 14 18:45:01 1994
***************
*** 19,25 ****
   *
   * Author: Erick Gallesio [eg_at_kaolin.unice.fr]
   * Creation date: 20-Nov-1993 12:12
! * Last file update: 2-Sep-1994 17:56
   */
  
  #include "stk.h"
--- 19,25 ----
   *
   * Author: Erick Gallesio [eg_at_kaolin.unice.fr]
   * Creation date: 20-Nov-1993 12:12
! * Last file update: 14-Sep-1994 18:45
   */
  
  #include "stk.h"
***************
*** 39,45 ****
  
    for (ent=Tcl_FirstHashEntry(&obarray, &tmp); ent;
ent=Tcl_NextHashEntry(&tmp)) {
      x = (SCM) Tcl_GetHashValue(ent);
! if (VCELL(x) != UNBOUND) gc_mark(x);
    }
  }
  
--- 39,45 ----
  
    for (ent=Tcl_FirstHashEntry(&obarray, &tmp); ent;
ent=Tcl_NextHashEntry(&tmp)) {
      x = (SCM) Tcl_GetHashValue(ent);
! if (VCELL(x) != UNBOUND) gc_mark(x);
    }
  }
  
***************
*** 52,72 ****
  SCM intern(char *name)
  {
    Tcl_HashEntry *p;
- int absent;
  
! p = Tcl_CreateHashEntry(&obarray, name, &absent);
! if (absent) {
      SCM sym;
!
      NEWCELL(sym, tc_symbol);
      PNAME(sym) = Tcl_GetHashKey(&obarray, p);
      VCELL(sym) = UNBOUND;
      Tcl_SetHashValue(p, (ClientData) sym);
      return sym;
    }
- else
- return Tcl_GetHashValue(p);
  }
  
  SCM global_env2list(void)
  {
--- 52,76 ----
  SCM intern(char *name)
  {
    Tcl_HashEntry *p;
  
! if (p = Tcl_FindHashEntry(&obarray, name))
! return Tcl_GetHashValue(p);
! else {
      SCM sym;
! int absent;
!
! /* Be careful with GC: Create hash entry after the new cell to avoid
! * partially initialized table entry
! */
      NEWCELL(sym, tc_symbol);
+ p = Tcl_CreateHashEntry(&obarray, name, &absent);
      PNAME(sym) = Tcl_GetHashKey(&obarray, p);
      VCELL(sym) = UNBOUND;
      Tcl_SetHashValue(p, (ClientData) sym);
      return sym;
    }
  }
+
  
  SCM global_env2list(void)
  {
*** Src/Src-2.1.2/tk-glue.c Thu Sep 15 14:55:26 1994
--- ./Src/tk-glue.c Tue Sep 13 18:26:04 1994
***************
*** 19,25 ****
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 19-Feb-1993 22:15
! * Last file update: 29-Aug-1994 17:06
   *
   *
   */
--- 19,25 ----
   *
   * Author: Erick Gallesio [eg_at_unice.fr]
   * Creation date: 19-Feb-1993 22:15
! * Last file update: 13-Sep-1994 18:26
   *
   *
   */
***************
*** 202,209 ****
     * pair).
     *
     */
! gc_special(root_window_name = intern(ROOT_WINDOW));
! gc_special(root_window = leval(sym_dot, NIL));
    VCELL(root_window_name) = root_window;
  
    for (s = keeping; **s; s++)
--- 202,209 ----
     * pair).
     *
     */
! root_window_name = intern(ROOT_WINDOW); gc_protect(&root_window_name);
! root_window = leval(sym_dot, NIL); gc_protect(&root_window);
    VCELL(root_window_name) = root_window;
  
    for (s = keeping; **s; s++)
*** Src/Src-2.1.2/toplevel.c Thu Sep 15 14:55:26 1994
--- ./Src/toplevel.c Wed Sep 14 18:50:11 1994
***************
*** 19,25 ****
   *
   * Author: Erick Gallesio [eg_at_kaolin.unice.fr]
   * Creation date: 6-Apr-1994 14:46
! * Last file update: 8-Sep-1994 10:19
   */
  
  #include "stk.h"
--- 19,25 ----
   *
   * Author: Erick Gallesio [eg_at_kaolin.unice.fr]
   * Creation date: 6-Apr-1994 14:46
! * Last file update: 13-Sep-1994 18:39
   */
  
  #include "stk.h"
***************
*** 108,132 ****
     * Define some scheme objects used by the interpreter
     * and protect them against GC
     */
! NEWCELL(UNDEFINED, tc_undefined); gc_special(UNDEFINED);
! NEWCELL(UNBOUND, tc_unbound); gc_special(UNBOUND);
! NEWCELL(truth, tc_boolean); gc_special(truth);
! NEWCELL(ntruth, tc_boolean); gc_special(ntruth);
!
! gc_special(sym_progn = intern("begin"));
! gc_special(sym_lambda = intern("lambda"));
! gc_special(sym_quote = intern("quote"));
! gc_special(sym_imply = intern("=>"));
! gc_special(sym_dot = intern("."));
! gc_special(sym_debug = intern(DEBUG_MODE));
! gc_special(sym_else = intern("else"));
! gc_special(sym_define = intern("define"));
! gc_special(sym_letrec = intern("letrec"));
! gc_special(sym_quasiquote = intern("quasiquote"));
! gc_special(sym_unquote = intern("unquote"));
! gc_special(sym_unquote_splicing = intern("unquote-splicing"));
  
! gc_special(globenv = makeenv(NIL));
  
    /* Initialize standard ports */
    init_standard_ports();
--- 108,129 ----
     * Define some scheme objects used by the interpreter
     * and protect them against GC
     */
! NEWCELL(UNDEFINED, tc_undefined); gc_protect(&UNDEFINED);
! NEWCELL(UNBOUND, tc_unbound); gc_protect(&UNBOUND);
! NEWCELL(truth, tc_boolean); gc_protect(&truth);
! NEWCELL(ntruth, tc_boolean); gc_protect(&ntruth);
!
! sym_lambda = intern("lambda"); gc_protect(&sym_lambda);
! sym_quote = intern("quote"); gc_protect(&sym_quote);
! sym_imply = intern("=>"); gc_protect(&sym_imply);
! sym_dot = intern("."); gc_protect(&sym_dot);
! sym_debug = intern(DEBUG_MODE); gc_protect(&sym_debug);
! sym_else = intern("else"); gc_protect(&sym_else);
! sym_quasiquote = intern("quasiquote"); gc_protect(&sym_quasiquote);
! sym_unquote = intern("unquote"); gc_protect(&sym_unquote);
! sym_unquote_splicing = intern("unquote-splicing");
gc_protect(&sym_unquote);
  
! globenv = makeenv(NIL); gc_protect(&globenv);
  
    /* Initialize standard ports */
    init_standard_ports();
***************
*** 135,142 ****
    init_primitives();
  
    /* initialize wind_stack and protect it against garbage colection */
! wind_stack = NIL;
! gc_protect(&wind_stack);
  }
  
  static void print_banner(void)
--- 132,138 ----
    init_primitives();
  
    /* initialize wind_stack and protect it against garbage colection */
! wind_stack = NIL; gc_protect(&wind_stack);
  }
  
  static void print_banner(void)
*** Src/Src-2.1.2/version.h Thu Sep 15 14:55:27 1994
--- ./Src/version.h Wed Sep 14 18:49:43 1994
***************
*** 15,18 ****
   *
   */
  
! #define STK_VERSION "2.1.2"
--- 15,18 ----
   *
   */
  
! #define STK_VERSION "2.1.3"
Received on Thu Sep 15 1994 - 15:52:22 CEST

This archive was generated by hypermail 2.3.0 : Mon Jul 21 2014 - 19:38:59 CEST