[Stratagus-CVS] stratagus/src clone/ccl.c include/siod.h includ...

[ludovic pollet]

CVSROOT:        /cvsroot/stratagus
Module name:    stratagus
Branch:         
Changes by:     ludovic pollet <address@hidden> 03/11/11 07:45:25

Modified files:
        src/clone      : ccl.c 
        src/include    : siod.h siodp.h 
        src/siod       : slib.c sliba.c 

Log message:
        SIOD now uses dynamic heap size

Patches:
Index: stratagus/src/clone/ccl.c
diff -u stratagus/src/clone/ccl.c:1.127 stratagus/src/clone/ccl.c:1.128
--- stratagus/src/clone/ccl.c:1.127     Mon Nov 10 14:25:33 2003
+++ stratagus/src/clone/ccl.c   Tue Nov 11 07:45:24 2003
@@ -26,7 +26,7 @@
 //      Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 //      02111-1307, USA.
 //
-//     $Id: ccl.c,v 1.127 2003/11/10 19:25:33 pludov Exp $
+//     $Id: ccl.c,v 1.128 2003/11/11 12:45:24 pludov Exp $
 
 //@{
 
@@ -271,7 +271,11 @@
 local void CheckProtectedCell(SCM* obj,int id)
 {
 #ifdef CHECK_GC_VALUES
+    int i;
     DebugCheck(ProtectedCellValues[id] != *obj);
+    for (i = 0; i < ProtectedCellCount; i++) {
+       DebugCheck(ProtectedCellValues[i] != (*ProtectedCells[i]));
+    }
 #endif
 }
 
@@ -419,6 +423,7 @@
 */
 global void CclGarbageCollect(int fast)
 {
+    
 #ifdef USE_GUILE
     if (!fast) {
        // GUILE handle gc nicely by itself
@@ -428,13 +433,24 @@
 #ifdef SIOD_HEAP_GC
     static int cpt=0;
     
-    // Very slow, so differ...
+    // Very slow, so differ as much as possible...
     if (!(++cpt & 15)) {
        user_gc(SCM_BOOL_F);
     }
 #else
+    static int default_used_cells=0;
+    int new_used_cells;
+    int cur_used_cells=0;
+
     // stop and copy iterates only the allocated SCM
-    gc_stop_and_copy();
+    if (!fast || (cur_used_cells=siod_used_cells()) > default_used_cells + 
10000) {
+       gc_stop_and_copy();
+       new_used_cells = siod_used_cells();
+       if (fast) {
+           DebugLevel2Fn("GC reduced %d cells to %d\n" _C_ cur_used_cells _C_ 
new_used_cells);
+       }
+       default_used_cells = new_used_cells;
+    }
 #endif
 #endif
 }
@@ -1034,7 +1050,8 @@
 #else
     // Stop & copy GC : scan only allocated cells
     sargv[2] = "-g1";
-    sargv[3] = "-h4000000";
+    // Cells are allocated in chunck of 40000 cells ( => 160Ko ) 
+    sargv[3] = "-h40000";
 #endif
     buf = malloc(strlen(StratagusLibPath) + 4);
     sprintf(buf, "-l%s", StratagusLibPath);
@@ -1245,7 +1262,7 @@
     }
 
     fprintf(fd, ";;; -----------------------------------------\n");
-    fprintf(fd, ";;; $Id: ccl.c,v 1.127 2003/11/10 19:25:33 pludov Exp $\n");
+    fprintf(fd, ";;; $Id: ccl.c,v 1.128 2003/11/11 12:45:24 pludov Exp $\n");
 
     fprintf(fd, "(set-video-resolution! %d %d)\n", VideoWidth, VideoHeight);
     
@@ -1270,7 +1287,7 @@
     }
 
     fprintf(fd, ";;; -----------------------------------------\n");
-    fprintf(fd, ";;; $Id: ccl.c,v 1.127 2003/11/10 19:25:33 pludov Exp $\n");
+    fprintf(fd, ";;; $Id: ccl.c,v 1.128 2003/11/11 12:45:24 pludov Exp $\n");
 
     // Global options
     if (OriginalFogOfWar) {
@@ -1381,7 +1398,7 @@
     extern SCM oblistvar;
 
     CLprintf(file, "\n;;; -----------------------------------------\n");
-    CLprintf(file, ";;; MODULE: CCL $Id: ccl.c,v 1.127 2003/11/10 19:25:33 
pludov Exp $\n\n");
+    CLprintf(file, ";;; MODULE: CCL $Id: ccl.c,v 1.128 2003/11/11 12:45:24 
pludov Exp $\n\n");
 
     for (list = oblistvar; gh_list_p(list); list = gh_cdr(list)) {
        SCM sym;
Index: stratagus/src/include/siod.h
diff -u stratagus/src/include/siod.h:1.9 stratagus/src/include/siod.h:1.10
--- stratagus/src/include/siod.h:1.9    Mon Nov  3 06:21:41 2003
+++ stratagus/src/include/siod.h        Tue Nov 11 07:45:24 2003
@@ -4,7 +4,7 @@
  *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
  *        See the source file SLIB.C for more information.                  *
 
- $Id: siod.h,v 1.9 2003/11/03 11:21:41 pludov Exp $
+ $Id: siod.h,v 1.10 2003/11/11 12:45:24 pludov Exp $
 
 */
 
@@ -209,6 +209,7 @@
 void gc_unprotect(LISP *location);
 void gc_protect_n(LISP *location,long n);
 void gc_protect_sym(LISP *location,char *st);
+long siod_used_cells(void);
 
 void __stdcall init_storage(void);
 void __stdcall init_slibu(void);
Index: stratagus/src/include/siodp.h
diff -u stratagus/src/include/siodp.h:1.5 stratagus/src/include/siodp.h:1.6
--- stratagus/src/include/siodp.h:1.5   Sat Aug  2 09:34:25 2003
+++ stratagus/src/include/siodp.h       Tue Nov 11 07:45:24 2003
@@ -7,14 +7,20 @@
 Declarations which are private to SLIB.C internals.
 However, some of these should be moved to siod.h
 
- $Id: siodp.h,v 1.5 2003/08/02 13:34:25 grumbel Exp $
+ $Id: siodp.h,v 1.6 2003/11/11 12:45:24 pludov Exp $
 
 */
 
 #include <setjmp.h>
 
 extern char *tkbuffer;
+#define MAX_HEAPS_CHUNCK 256
+extern LISP dyn_heaps[MAX_HEAPS_CHUNCK];
+extern int dyn_heaps_pos[MAX_HEAPS_CHUNCK];
+extern int cur_dyn_heap; 
+
 extern LISP heap,heap_end,heap_org;
+extern long heap_size;
 extern LISP sym_t;
 
 extern long siod_verbose_level;
@@ -49,11 +55,16 @@
  long length;
  struct gc_protected *next;};
 
+#define ALLOCATED_CELLS (gc_kind_copying?\
+       (cur_dyn_heap*heap_size)+dyn_heaps_pos[cur_dyn_heap]:\
+       heap-heap_org)
+ 
 #define NEWCELL(_into,_type)          \
 {if (gc_kind_copying == 1)            \
-   {if ((_into = heap) >= heap_end)   \
-      gc_fatal_error();               \
-    heap = _into+1;}                  \
+   {if (dyn_heaps_pos[cur_dyn_heap]>=heap_size)   \
+      { new_dyn_heap();}             \
+    _into = dyn_heaps[cur_dyn_heap]+(dyn_heaps_pos[cur_dyn_heap]++); \
+    }                                \
  else                                 \
    {if NULLP(freelist)                \
       gc_for_newcell();               \
@@ -103,8 +114,9 @@
 void init_storage_1(void);
 struct user_type_hooks *get_user_type_hooks(long type);
 LISP get_newspace(void);
-void scan_newspace(LISP newspace);
+void scan_newspace(LISP newspace,int start,int end);
 void free_oldspace(LISP space,LISP end);
+void new_dyn_heap(void);
 void gc_stop_and_copy(void);
 void gc_for_newcell(void);
 void gc_mark_and_sweep(void);
Index: stratagus/src/siod/slib.c
diff -u stratagus/src/siod/slib.c:1.32 stratagus/src/siod/slib.c:1.33
--- stratagus/src/siod/slib.c:1.32      Mon Nov  3 06:21:41 2003
+++ stratagus/src/siod/slib.c   Tue Nov 11 07:45:25 2003
@@ -91,7 +91,7 @@
 
 static void init_slib_version(void)
 {setvar(cintern("*slib-version*"),
-       cintern("$Id: slib.c,v 1.32 2003/11/03 11:21:41 pludov Exp $"),
+       cintern("$Id: slib.c,v 1.33 2003/11/11 12:45:25 pludov Exp $"),
        NIL);}
 
 char * __stdcall siod_version(void)
@@ -99,6 +99,10 @@
 
 char current_filename[256];
 long *current_lineno;
+LISP dyn_heaps[MAX_HEAPS_CHUNCK];
+int dyn_heaps_pos[MAX_HEAPS_CHUNCK];
+int cur_dyn_heap; 
+
 long nheaps = 2;
 LISP *heaps;
 LISP heap,heap_end,heap_org;
@@ -254,6 +258,7 @@
 void __stdcall print_hs_2(void)
 {if (siod_verbose_level >= 2)
    {if (gc_kind_copying == 1)
+       // FIXME : update.
       printf("heaps[0] at %p, heaps[1] at %p\n",heaps[0],heaps[1]);
    else
      printf("heaps[0] at %p\n",heaps[0]);}}
@@ -546,6 +551,11 @@
  return((double) x);}
 #endif
 
+long siod_used_cells(void)
+{
+    return ALLOCATED_CELLS;
+}
+
 void set_repl_hooks(void (*puts_f)(char *),
                    LISP (*read_f)(void),
                    LISP (*eval_f)(LISP),
@@ -584,17 +594,18 @@
      
 long repl(struct repl_hooks *h)
 {
-    LISP x, cw = 0;
+    LISP x;
     double rt,ct;
+    int allocated=0;
     assert(h != NULL);
     while(1) {
        if ((gc_kind_copying == 1) &&
-               ((gc_status_flag) || heap >= heap_end))  {
+               ((gc_status_flag) || (dyn_heaps_pos[cur_dyn_heap] >= 
heap_size)))  {
            rt = myruntime();
            gc_stop_and_copy();
            if (siod_verbose_level >= 2) {
                sprintf(tkbuffer,"GC took %g seconds, %ld compressed to %ld, 
%ld free\n",
-                    
myruntime()-rt,old_heap_used,(long)(heap-heap_org),(long)(heap_end-heap));
+                    
myruntime()-rt,old_heap_used,(long)(ALLOCATED_CELLS),(long)(heap_size-dyn_heaps_pos[cur_dyn_heap]));
                grepl_puts(tkbuffer, h->repl_puts);
            }
        }
@@ -612,7 +623,7 @@
        rt = myruntime();
        ct = myrealtime();
        if (gc_kind_copying == 1) {
-           cw = heap;
+           allocated = ALLOCATED_CELLS;
        } else {
            gc_cells_allocated = 0;
            gc_time_taken = 0.0;
@@ -625,7 +636,7 @@
        if (gc_kind_copying == 1)
        {
            sprintf(tkbuffer,"Evaluation took %g seconds %ld cons work, %g 
real.\n",
-                   myruntime()-rt,(long)(heap-cw),myrealtime()-ct);
+                   
myruntime()-rt,(long)(ALLOCATED_CELLS-allocated),myrealtime()-ct);
        } else {
            sprintf(tkbuffer, "Evaluation took %g seconds (%g in gc) %ld cons 
work, %g real.\n",
                    
myruntime()-rt,gc_time_taken,gc_cells_allocated,myrealtime()-ct);
@@ -1048,55 +1059,69 @@
  set_print_hooks(tc_c_file,file_prin1);}
 
 void init_storage_1(void)
-{LISP ptr;
- long j;
- tkbuffer = (char *) must_malloc(TKBUFFERN+1);
- if (((gc_kind_copying == 1) && (nheaps != 2)) || (nheaps < 1))
-   errl("invalid number of heaps",NIL);
- heaps = (LISP *) must_malloc(sizeof(LISP) * nheaps);
- for(j=0;j<nheaps;++j) heaps[j] = NULL;
- heaps[0] = (LISP) must_malloc(sizeof(struct obj)*heap_size);
- heap = heaps[0];
- heap_org = heap;
- heap_end = heap + heap_size;
- if (gc_kind_copying == 1)
-   heaps[1] = (LISP) must_malloc(sizeof(struct obj)*heap_size);
- else
-   freelist = NIL;
- gc_protect(&oblistvar);
- if (obarray_dim > 1)
-   {obarray = (LISP *) must_malloc(sizeof(LISP) * obarray_dim);
-    for(j=0;j<obarray_dim;++j)
-      obarray[j] = NIL;
-    gc_protect_n(obarray,obarray_dim);}
- unbound_marker = cons(cintern("**unbound-marker**"),NIL);
- gc_protect(&unbound_marker);
- eof_val = cons(cintern("eof"),NIL);
- gc_protect(&eof_val);
- gc_protect_sym(&sym_t,"t");
- setvar(sym_t,sym_t,NIL);
- setvar(cintern("nil"),NIL,NIL);
- setvar(cintern("let"),cintern("let-internal-macro"),NIL);
- setvar(cintern("let*"),cintern("let*-macro"),NIL);
- setvar(cintern("letrec"),cintern("letrec-macro"),NIL);
- gc_protect_sym(&sym_errobj,"errobj");
- setvar(sym_errobj,NIL,NIL);
- gc_protect_sym(&sym_catchall,"all");
- gc_protect_sym(&sym_progn,"begin");
- gc_protect_sym(&sym_lambda,"lambda");
- gc_protect_sym(&sym_quote,"quote");
- gc_protect_sym(&sym_dot,".");
- gc_protect_sym(&sym_after_gc,"*after-gc*");
- setvar(sym_after_gc,NIL,NIL);
- gc_protect_sym(&sym_eval_history_ptr,"*eval-history-ptr*");
- setvar(sym_eval_history_ptr,NIL,NIL);
- if (inums_dim > 0)
-   {inums = (LISP *) must_malloc(sizeof(LISP) * inums_dim);
-    for(j=0;j<inums_dim;++j)
-      {NEWCELL(ptr,tc_flonum);
-       FLONM(ptr) = j;
-       inums[j] = ptr;}
-    gc_protect_n(inums,inums_dim);}}
+{
+    LISP ptr;
+    long j;
+    tkbuffer = (char *) must_malloc(TKBUFFERN+1);
+
+    if (gc_kind_copying == 1) {
+       if ((nheaps != 2) || (nheaps < 1))
+           errl("invalid number of heaps",NIL);
+       cur_dyn_heap=-1;
+       new_dyn_heap();
+       heaps=0;
+       heap=0;
+       heap_org=0;
+       heap_end=0;
+    }else{
+       heaps = (LISP *) must_malloc(sizeof(LISP) * nheaps);
+       for(j=0;j<nheaps;++j) heaps[j] = NULL;
+       heaps[0] = (LISP) must_malloc(sizeof(struct obj)*heap_size);
+       heap = heaps[0];
+       heap_org = heap;
+       heap_end = heap + heap_size;
+       
+       freelist = NIL;
+    }
+    gc_protect(&oblistvar);
+    if (obarray_dim > 1){
+       obarray = (LISP *) must_malloc(sizeof(LISP) * obarray_dim);
+       for(j=0;j<obarray_dim;++j)
+           obarray[j] = NIL;
+       gc_protect_n(obarray,obarray_dim);
+    }
+
+    unbound_marker = cons(cintern("**unbound-marker**"),NIL);
+    gc_protect(&unbound_marker);
+    eof_val = cons(cintern("eof"),NIL);
+    gc_protect(&eof_val);
+    gc_protect_sym(&sym_t,"t");
+    setvar(sym_t,sym_t,NIL);
+    setvar(cintern("nil"),NIL,NIL);
+    setvar(cintern("let"),cintern("let-internal-macro"),NIL);
+    setvar(cintern("let*"),cintern("let*-macro"),NIL);
+    setvar(cintern("letrec"),cintern("letrec-macro"),NIL);
+    gc_protect_sym(&sym_errobj,"errobj");
+    setvar(sym_errobj,NIL,NIL);
+    gc_protect_sym(&sym_catchall,"all");
+    gc_protect_sym(&sym_progn,"begin");
+    gc_protect_sym(&sym_lambda,"lambda");
+    gc_protect_sym(&sym_quote,"quote");
+    gc_protect_sym(&sym_dot,".");
+    gc_protect_sym(&sym_after_gc,"*after-gc*");
+    setvar(sym_after_gc,NIL,NIL);
+    gc_protect_sym(&sym_eval_history_ptr,"*eval-history-ptr*");
+    setvar(sym_eval_history_ptr,NIL,NIL);
+    if (inums_dim > 0){
+       inums = (LISP *) must_malloc(sizeof(LISP) * inums_dim);
+       for(j=0;j<inums_dim;++j){
+           NEWCELL(ptr,tc_flonum);
+           FLONM(ptr) = j;
+           inums[j] = ptr;
+       }
+       gc_protect_n(inums,inums_dim);
+    }
+}
  
 void init_subr(char *name, long type, SUBR_FUNC fcn)
 {setvar(cintern(name),subrcons(type,name,fcn),NIL);}
@@ -1194,8 +1219,9 @@
     case tc_lsubr:
     case tc_fsubr:
     case tc_msubr:
-      if ((nw = heap) >= heap_end) gc_fatal_error();
-      heap = nw+1;
+      NEWCELL(nw,0);
+      /*if ((nw = heap) >= heap_end) gc_fatal_error();
+      heap = nw+1;*/
       memcpy(nw,x,sizeof(struct obj));
       break;
     default:
@@ -1203,8 +1229,7 @@
       if (p->gc_relocate)
        nw = (*p->gc_relocate)(x);
       else
-       {if ((nw = heap) >= heap_end) gc_fatal_error();
-        heap = nw+1;
+       {NEWCELL(nw,0);
         memcpy(nw,x,sizeof(struct obj));}}
  (*x).gc_mark = 1;
  CAR(x) = nw;
@@ -1212,6 +1237,7 @@
 
 LISP get_newspace(void)
 {LISP newspace;
+ gc_kind_check();
  if (heap_org == heaps[0])
    newspace = heaps[1];
  else
@@ -1221,10 +1247,10 @@
  heap_end = heap + heap_size;
  return(newspace);}
 
-void scan_newspace(LISP newspace)
+void scan_newspace(LISP newspace,int start,int end)
 {LISP ptr;
  struct user_type_hooks *p;
- for(ptr=newspace; ptr < heap; ++ptr)
+ for(ptr=newspace + start; ptr < newspace + end; ++ptr)
    {switch TYPE(ptr)
       {case tc_cons:
        case tc_closure:
@@ -1275,22 +1301,61 @@
          p = get_user_type_hooks(TYPE(ptr));
          if (p->gc_free) (*p->gc_free)(ptr);}}
       
+void new_dyn_heap(void)
+{
+    cur_dyn_heap++;
+    
+    dyn_heaps[cur_dyn_heap]=(LISP)must_malloc(sizeof(struct obj)*heap_size);
+    dyn_heaps_pos[cur_dyn_heap]=0;
+}
+
 void gc_stop_and_copy(void)
-{LISP newspace,oldspace,end;
- long flag;
+{
+ int flag,i;
+ int oldspace_count;
+ LISP oldspace[MAX_HEAPS_CHUNCK];
+ int oldspace_size[MAX_HEAPS_CHUNCK];
+ 
+ int scan_heap_id,scan_heap_pos,scan_next_pos;
 
  flag = no_interrupt(1);
  errjmp_ok = 0;
- oldspace = heap_org;
- end = heap;
- old_heap_used = end - oldspace;
- newspace = get_newspace();
+
+ // Copy full_heaps into oldspace
+ for(i=0;i<=cur_dyn_heap;i++){
+     oldspace[i]=dyn_heaps[i];
+     oldspace_size[i]=dyn_heaps_pos[i];
+ }
+ oldspace_count=cur_dyn_heap+1; 
+ 
+ // Allocate new space
+ cur_dyn_heap=-1;
+ new_dyn_heap();
+ 
  scan_registers();
- scan_newspace(newspace);
- free_oldspace(oldspace,end);
+ 
+ scan_heap_id=0;
+ scan_heap_pos=0;
+ 
while((scan_heap_id<cur_dyn_heap)||(scan_heap_id==cur_dyn_heap&&scan_heap_pos<dyn_heaps_pos[cur_dyn_heap])){
+  scan_next_pos=dyn_heaps_pos[scan_heap_id];
+  if(scan_heap_pos>=scan_next_pos){
+     // next heap
+     scan_heap_id++;
+     scan_heap_pos=0;
+     scan_next_pos=dyn_heaps_pos[scan_heap_id];
+  }
+  scan_newspace(dyn_heaps[scan_heap_id],scan_heap_pos,scan_next_pos);
+  scan_heap_pos=scan_next_pos;
+ }
+
+ for(i=0;i<oldspace_count;i++){
+     free_oldspace(oldspace[i],oldspace[i]+oldspace_size[i]);
+     free(oldspace[i]);
+ }
  errjmp_ok = 1;
  no_interrupt(flag);}
 
+/* MARK & SWEEP stuffs */
 LISP allocate_aheap(void)
 {long j,flag;
  LISP ptr,end,next;
@@ -1317,6 +1382,7 @@
       return(sym_t);}
  return(NIL);}
 
+/* MARK & SWEEP stuffs */
 void gc_for_newcell(void)
 {long flag,n;
  LISP l;
@@ -1340,6 +1406,7 @@
  else
    allocate_aheap();}
 
+/* MARK & SWEEP stuffs */
 void gc_mark_and_sweep(void)
 {LISP stack_end;
  gc_ms_stats_start();
@@ -1375,7 +1442,8 @@
    printf("[GC took %g cpu seconds, %ld cells collected]\n",
          gc_rt,
          gc_cells_collected);}
-
+         
+/* MARK & SWEEP stuffs */
 void gc_mark(LISP ptr)
 {struct user_type_hooks *p;
  gc_mark_loop:
@@ -1411,7 +1479,8 @@
       p = get_user_type_hooks(TYPE(ptr));
       if (p->gc_mark)
        ptr = (*p->gc_mark)(ptr);}}
-
+    
+/* MARK & SWEEP stuffs */
 void mark_protected_registers(void)
 {struct gc_protected *reg;
  LISP *location;
@@ -1421,7 +1490,8 @@
     n = (*reg).length;
     for(j=0;j<n;++j)
       gc_mark(location[j]);}}
-
+  
+/* MARK & SWEEP stuffs */
 void mark_locations(LISP *start,LISP *end)
 {LISP *tmp;
  long n;
@@ -1432,6 +1502,7 @@
  n = end - start;
  mark_locations_array(start,n);}
 
+/* MARK & SWEEP stuffs */
 long looks_pointerp(LISP p)
 {long j;
  LISP h;
@@ -1445,6 +1516,7 @@
  }
  return(0);}
 
+/* MARK & SWEEP stuffs */
 void mark_locations_array(LISP *x,long n)
 {int j;
  LISP p;
@@ -1453,6 +1525,7 @@
     if (looks_pointerp(p))
       gc_mark(p);}}
 
+/* MARK & SWEEP stuffs */
 void gc_sweep(void)
 {LISP ptr,end,nfreelist,org;
  long n,k;
@@ -1539,7 +1612,7 @@
    else
      put_st("garbage collection is off\n");
     sprintf(tkbuffer,"%ld allocated %ld free\n",
-           (long)(heap - heap_org), (long)(heap_end - heap));
+           (long)(heap_size*(cur_dyn_heap+1)), 
(long)(heap_size-dyn_heaps_pos[cur_dyn_heap]));
     put_st(tkbuffer);}
  else
    {if (gc_status_flag)
@@ -1565,7 +1638,7 @@
       return(flocons(heap_size));
     case 4:
       return(flocons((gc_kind_copying == 1)
-                    ? (long) (heap_end - heap)
+                    ? (long) (heap_size-dyn_heaps_pos[cur_dyn_heap])
                     : freelist_length()));
     default:
       return(NIL);}}
Index: stratagus/src/siod/sliba.c
diff -u stratagus/src/siod/sliba.c:1.9 stratagus/src/siod/sliba.c:1.10
--- stratagus/src/siod/sliba.c:1.9      Fri Sep  5 14:10:56 2003
+++ stratagus/src/siod/sliba.c  Tue Nov 11 07:45:25 2003
@@ -27,7 +27,7 @@
 
 static void init_sliba_version(void)
 {setvar(cintern("*sliba-version*"),
-       cintern("$Id: sliba.c,v 1.9 2003/09/05 18:10:56 n0body Exp $"),
+       cintern("$Id: sliba.c,v 1.10 2003/11/11 12:45:25 pludov Exp $"),
        NIL);}
 
 static LISP sym_plists = NIL;
@@ -62,8 +62,7 @@
 
 LISP array_gc_relocate(LISP ptr)
 {LISP nw;
- if ((nw = heap) >= heap_end) gc_fatal_error();
- heap = nw+1;
+ nw=newcell(0);
  memcpy(nw,ptr,sizeof(struct obj));
  return(nw);}