fix several bugs in save/restore.b

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1467 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2005-11-18 18:48:51 $,$Author: tiagosoares $						 *
+* Last rev:     $Date: 2005-11-23 03:01:32 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.185  2005/11/18 18:48:51  tiagosoares
+* support for executing c code when a cut occurs
+*
 * Revision 1.184  2005/11/15 00:50:49  vsc
 * fixes for stack expansion and garbage collection under tabling.
 *
@@ -424,7 +427,6 @@ Int
 Yap_absmi(int inp)
 {
 
-
 #if BP_FREE
   /* some function might be using bp for an internal variable, it is the
      callee's responsability to save it */

C/alloc.c

@@ -12,7 +12,7 @@
 * Last rev:								 *
 * mods:									 *
 * comments:	allocating space					 *
-* version:$Id: alloc.c,v 1.75 2005-11-16 01:55:03 vsc Exp $		 *
+* version:$Id: alloc.c,v 1.76 2005-11-23 03:01:33 vsc Exp $		 *
 *************************************************************************/
 #ifdef SCCS
 static char SccsId[] = "%W% %G%";
@@ -78,19 +78,23 @@ minfo(char mtype)
 }
 #endif
 
-static int vsc_allocs;
+static inline char *
-
+call_malloc(unsigned int size)
-char *
-Yap_AllocCodeSpace(unsigned int size)
 {
+  char *tmp;
 #if INSTRUMENT_MALLOC
   if (mallocs % 1024*4 == 0) 
     minfo('A');
   mallocs++;
   tmalloc += size;
 #endif
-  vsc_allocs++;
+  return (char *) malloc(size);
-  return malloc(size);
+}
+
+char *
+Yap_AllocCodeSpace(unsigned int size)
+{
+  return call_malloc(size);
 }
 
 void
@@ -107,13 +111,7 @@ Yap_FreeCodeSpace(char *p)
 char *
 Yap_AllocAtomSpace(unsigned int size)
 {
-#if INSTRUMENT_MALLOC
+  return call_malloc(size);
-  if (mallocs % 1024*4 == 0) 
-    minfo('A');
-  mallocs++;
-  tmalloc += size;
-#endif
-  return malloc(size);
 }
 
 void

C/cdmgr.c

@@ -11,8 +11,11 @@
 * File:		cdmgr.c							 *
 * comments:	Code manager						 *
 *									 *
-* Last rev:     $Date: 2005-10-29 01:28:37 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-11-23 03:01:33 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.171  2005/10/29 01:28:37  vsc
+* make undefined more ISO compatible.
+*
 * Revision 1.170  2005/10/18 17:04:43  vsc
 * 5.1:
 * - improvements to GC
@@ -4345,7 +4348,7 @@ add_code_in_pred(PredEntry *pp) {
 	char *code_end;
 
 	cl = ClauseCodeToDynamicClause(clcode);
- 	code_end = (CODEADDR)cl + cl->ClSize;
+ 	code_end = (char *)cl + cl->ClSize;
 	Yap_inform_profiler_of_clause(clcode, (yamop *)code_end, pp,0);
 	if (clcode == pp->cs.p_code.LastClause)
 	  break;

C/dlmalloc.c

@@ -9,6 +9,14 @@
 #include "alloc.h"
 #include "dlmalloc.h"
 
+static struct malloc_chunk *
+ChunkPtrAdjust (struct malloc_chunk *ptr)
+{
+  return (struct malloc_chunk *) ((char *) (ptr) + HDiff);
+}
+
+
+
 /*
   This is a version (aka dlmalloc) of malloc/free/realloc written by
   Doug Lea and released to the public domain.  Use, modify, and
@@ -2897,4 +2905,128 @@ Yap_initdlmalloc(void)
   HeapMax = HeapUsed = HeapTop-Yap_HeapBase;
 }
 
+void Yap_RestoreDLMalloc(void)
+{
+  mstate av = Yap_av;
+  int i;
+  mchunkptr p;
+  mchunkptr q;
+  mbinptr b;
+  unsigned int binbit;
+  int empty;
+  unsigned int idx;
+  INTERNAL_SIZE_T size;
+  CHUNK_SIZE_T  total = 0;
+  int max_fast_bin;
+
+  /* internal size_t must be no wider than pointer type */
+  assert(sizeof(INTERNAL_SIZE_T) <= sizeof(char*));
+
+  /* alignment is a power of 2 */
+  assert((MALLOC_ALIGNMENT & (MALLOC_ALIGNMENT-1)) == 0);
+
+  /* cannot run remaining checks until fully initialized */
+  if (av->top == 0 || av->top == initial_top(av))
+    return;
+
+  /* pagesize is a power of 2 */
+  assert((av->pagesize & (av->pagesize-1)) == 0);
+
+  /* properties of fastbins */
+
+  /* max_fast is in allowed range */
+  assert(get_max_fast(av) <= request2size(MAX_FAST_SIZE));
+
+  max_fast_bin = fastbin_index(av->max_fast);
+
+  if (av->top) {
+    av->top = ChunkPtrAdjust(av->top);
+  }
+  if (av->last_remainder) {
+    av->last_remainder = ChunkPtrAdjust(av->last_remainder);
+  }
+  for (i = 0; i < NFASTBINS; ++i) {
+    
+    if (av->fastbins[i]) {
+      av->fastbins[i] = ChunkPtrAdjust(av->fastbins[i]);
+    }
+    p = av->fastbins[i];
+
+    /* all bins past max_fast are empty */
+    if (i > max_fast_bin)
+      assert(p == 0);
+
+    while (p != 0) {
+      /* each chunk claims to be inuse */
+      check_inuse_chunk(p);
+      total += chunksize(p);
+      /* chunk belongs in this bin */
+      assert(fastbin_index(chunksize(p)) == i);
+      if (p->fd)
+	p->fd = ChunkPtrAdjust(p->fd);
+      if (p->bk)
+	p->bk = ChunkPtrAdjust(p->bk);
+      p = p->fd;
+    }
+  }
+
+  if (total != 0)
+    assert(have_fastchunks(av));
+  else if (!have_fastchunks(av))
+    assert(total == 0);
+
+  for (i = 0; i < NBINS*2; i++) {
+    if (av->bins[i]) {
+      av->bins[i] = ChunkPtrAdjust(av->bins[i]);
+    }
+  }
+
+  /* check normal bins */
+  for (i = 1; i < NBINS; ++i) {
+    b = bin_at(av,i);
+
+    /* binmap is accurate (except for bin 1 == unsorted_chunks) */
+    if (i >= 2) {
+      binbit = get_binmap(av,i);
+      empty = last(b) == b;
+      if (!binbit)
+        assert(empty);
+      else if (!empty)
+        assert(binbit);
+    }
+
+    for (p = last(b); p != b; p = p->bk) {
+      /* each chunk claims to be free */
+      check_free_chunk(p);
+      if (p->fd)
+	p->fd = ChunkPtrAdjust(p->fd);
+      if (p->bk)
+	p->bk = ChunkPtrAdjust(p->bk);
+      size = chunksize(p);
+      total += size;
+      if (i >= 2) {
+        /* chunk belongs in bin */
+        idx = bin_index(size);
+        assert(idx == i);
+        /* lists are sorted */
+        if ((CHUNK_SIZE_T) size >= (CHUNK_SIZE_T)(FIRST_SORTED_BIN_SIZE)) {
+          assert(p->bk == b || 
+                 (CHUNK_SIZE_T)chunksize(p->bk) >= 
+                 (CHUNK_SIZE_T)chunksize(p));
+        }
+      }
+      /* chunk is followed by a legal chain of inuse chunks */
+      for (q = next_chunk(p);
+           (q != av->top && inuse(q) && 
+             (CHUNK_SIZE_T)(chunksize(q)) >= MINSIZE);
+           q = next_chunk(q)) {
+	check_inuse_chunk(q);
+      }
+    }
+  }
+
+}
+
+
 #endif /* USE_DL_MALLOC */
+

C/heapgc.c

@@ -101,6 +101,9 @@ static cont *cont_top;
 static void
 gc_growtrail(int committed)
 {
+#if THREADS
+  longjmp(Yap_gc_restore, 2);
+#endif
 #if USE_SYSTEM_MALLOC
   TR = OldTR;
 #endif

C/init.c

@@ -600,6 +600,10 @@ Yap_InitAsmPred(char *Name,  unsigned long int Arity, int code, CPredicate def,
     yamop      *p_code = ((StaticClause *)NULL)->ClCode;
     StaticClause     *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),sla),e),e)); 
 
+    if (!cl) {
+      Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"No Heap Space in InitAsmPred");
+      return;
+    }
     cl->ClFlags = 0;
     p_code = cl->ClCode;
     pe->CodeOfPred = p_code;
@@ -1265,12 +1269,21 @@ Yap_InitWorkspace(int Heap, int Stack, int Trail, int max_table_size,
     HashChain[i].Entry = NIL;
   }
   NOfAtoms = 0;
+#if THREADS
+  SF_STORE->AtFoundVar = Yap_LookupAtom(".");
+  Yap_ReleaseAtom(AtomFoundVar);
+  SF_STORE->AtFreeTerm = Yap_LookupAtom("?");
+  Yap_ReleaseAtom(AtomFreeTerm);
+  SF_STORE->AtNil = Yap_LookupAtom("[]");
+  SF_STORE->AtDot = Yap_LookupAtom(".");
+#else
   Yap_LookupAtomWithAddress(".",&(SF_STORE->AtFoundVar));
   Yap_ReleaseAtom(AtomFoundVar);
   Yap_LookupAtomWithAddress("?",&(SF_STORE->AtFreeTerm));
   Yap_ReleaseAtom(AtomFreeTerm);
   Yap_LookupAtomWithAddress("[]",&(SF_STORE->AtNil));
   Yap_LookupAtomWithAddress(".",&(SF_STORE->AtDot));
+#endif
   /* InitAbsmi must be done before InitCodes */
 #ifdef MPW
   Yap_InitAbsmi(REGS, FunctorList);

C/save.c

@@ -415,6 +415,7 @@ save_regs(int mode)
 #endif /* SBA || TABLING */
   }
   putout(CurrentModule);
+  putcellptr(AuxSp);
   if (mode == DO_EVERYTHING) {
 #ifdef COROUTINING
     putout(WokenGoals);
@@ -1001,6 +1002,9 @@ static void
 restore_regs(int flag)
 {
   restore_heap_regs();
+  if (CurrentModule) {
+    CurrentModule = AtomTermAdjust(CurrentModule);;
+  }
   if (flag == DO_EVERYTHING) {
     CP = PtoOpAdjust(CP);
     ENV = PtoLocAdjust(ENV);
@@ -1199,62 +1203,20 @@ RestoreIOStructures(void)
   Yap_InitStdStreams();
 }
 
-#if USE_DL_MALLOC
-static struct malloc_chunk *
-RestoreFreeChunk(struct malloc_chunk *ptr)
-{
-  if (ptr->fd) {
-    ptr->fd = ChunkPtrAdjust(ptr->fd);
-  }
-  if (ptr->bk) {
-    ptr->bk = ChunkPtrAdjust(ptr->bk);
-  }
-  return ptr;
-}
-#endif
-
 static void 
 RestoreFreeSpace(void)
 {
 #if USE_DL_MALLOC
-  int i;
-
   Yap_av = (struct malloc_state *)AddrAdjust((ADDR)Yap_av);
-  for (i = 0; i < NFASTBINS; i++) {
+  Yap_RestoreDLMalloc();
-    if (Yap_av->fastbins[i]) {
+  if (AuxSp != NULL)
-      struct malloc_chunk *ptr;
+    AuxSp = PtoHeapCellAdjust(AuxSp);
-
+  if (AuxTop != NULL)
-      Yap_av->fastbins[i] = ptr = ChunkPtrAdjust(Yap_av->fastbins[i]);
+    AuxTop = AddrAdjust(AuxTop);
-      while (ptr) {
-	ptr = RestoreFreeChunk(ptr)->fd;
-      }
-    }
-  }
-  if (Yap_av->top) {
-    Yap_av->top = ChunkPtrAdjust(Yap_av->top);
-  }
-  if (Yap_av->last_remainder) {
-    Yap_av->top = ChunkPtrAdjust(Yap_av->last_remainder);
-  }
-  for (i = 0; i < NBINS; i++) {
-
-    struct malloc_chunk *ptr;
-
-    if (Yap_av->bins[i*2]) {
-      Yap_av->bins[i*2] = ptr = ChunkPtrAdjust(Yap_av->bins[i*2]);
-    } else {
-      ptr = NULL;
-    }
-    if (Yap_av->bins[i*2+1]) {
-      Yap_av->bins[i*2+1] = ChunkPtrAdjust(Yap_av->bins[i*2+1]);
-    }
-    while (ptr && ptr != Yap_av->bins[i*2]) {
-      ptr = RestoreFreeChunk(ptr)->fd;
-    }
-  }
 #else
   /* restores the list of free space, with its curious structure */
-  register BlockHeader *bpt, *bsz;
+  BlockHeader *bpt, *bsz;
+
   if (FreeBlocks != NULL)
     FreeBlocks = BlockAdjust(FreeBlocks);
   bpt = FreeBlocks;
@@ -1525,13 +1487,13 @@ RestoreHeap(OPCODE old_ops[])
   CurrentModule = PROLOG_MODULE;
   opcodes_moved = check_opcodes(old_ops);
   /* opcodes_moved has side-effects and should be tried first */
+  if (heap_moved) {
+    RestoreFreeSpace();
+  }
   if (heap_moved || opcodes_moved) {
     restore_heap();
   }
   /* This must be done after restore_heap */
-  if (heap_moved) {
-    RestoreFreeSpace();
-  }
   Yap_InitAbsmi();
   if (opcodes_moved) {
     Yap_InitCPreds();

H/TermExt.h

@@ -10,7 +10,7 @@
 * File:		TermExt.h						 *
 * mods:									 *
 * comments:	Extensions to standard terms for YAP			 *
-* version:      $Id: TermExt.h,v 1.2 2005-09-09 17:24:39 vsc Exp $	 *
+* version:      $Id: TermExt.h,v 1.3 2005-11-23 03:01:33 vsc Exp $	 *
 *************************************************************************/
 
 #ifdef USE_SYSTEM_MALLOC
@@ -24,6 +24,11 @@
 #define   AtomFreeTerm ((Atom)(&(((special_functors *)(NULL))->AtFreeTerm)))
 #define   AtomNil ((Atom)(&(((special_functors *)(NULL))->AtNil)))
 #define   AtomDot ((Atom)(&(((special_functors *)(NULL))->AtDot)))
+#elif THREADS
+#define   AtomFoundVar AbsAtom(SF_STORE->AtFoundVar)
+#define   AtomFreeTerm AbsAtom(SF_STORE->AtFreeTerm)
+#define   AtomNil AbsAtom(SF_STORE->AtNil)
+#define   AtomDot AbsAtom(SF_STORE->AtDot)
 #else
 #define   AtomFoundVar AbsAtom(&(SF_STORE->AtFoundVar))
 #define   AtomFreeTerm AbsAtom(&(SF_STORE->AtFreeTerm))
@@ -117,6 +122,15 @@ extern ext_op attas[attvars_ext + 1];
 
 /* make sure that these data structures are the first thing to be allocated
    in the heap when we start the system */
+#if THREADS
+typedef struct special_functors_struct
+{
+  AtomEntry *AtFoundVar;
+  AtomEntry *AtFreeTerm;
+  AtomEntry *AtNil;
+  AtomEntry *AtDot;
+} special_functors;
+#else
 typedef struct special_functors_struct
 {
   AtomEntry AtFoundVar;
@@ -129,6 +143,7 @@ typedef struct special_functors_struct
   char AtDotChars[8];
 }
 special_functors;
+#endif
 
 #if USE_SYSTEM_MALLOC
 #define MAX_SPECIALS_TAG (4*4096)

H/dlmalloc.h

@@ -4,6 +4,7 @@
 /* YAP only stuff */
 
 void STD_PROTO(Yap_initdlmalloc,(void));
+void STD_PROTO(Yap_RestoreDLMalloc,(void));
 
 
 /* Synopsis of compile-time options:

H/rheap.h

@@ -11,8 +11,11 @@
 * File:		rheap.h							 *
 * comments:	walk through heap code					 *
 *									 *
-* Last rev:     $Date: 2005-10-28 17:38:50 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-11-23 03:01:33 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.57  2005/10/28 17:38:50  vsc
+* sveral updates
+*
 * Revision 1.56  2005/10/21 16:09:03  vsc
 * SWI compatible module only operators
 *
@@ -121,6 +124,9 @@ static void
 restore_codes(void)
 {
   Yap_heap_regs->heap_top = AddrAdjust(OldHeapTop);
+  if (Yap_heap_regs->heap_lim) {
+    Yap_heap_regs->heap_lim = AddrAdjust(Yap_heap_regs->heap_lim);
+  }
 #ifdef YAPOR
   Yap_heap_regs->seq_def = TRUE;
   Yap_heap_regs->getwork_code.opc = Yap_opcode(_getwork);
@@ -447,12 +453,28 @@ restore_codes(void)
     (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_throw);
   Yap_heap_regs->pred_handle_throw =
     (PredEntry *)AddrAdjust((ADDR)Yap_heap_regs->pred_handle_throw);
+#if DEBUG
+  if (Yap_heap_regs->db_erased_list) {
+    Yap_heap_regs->db_erased_list = 
+      PtoLUCAdjust(Yap_heap_regs->db_erased_list);
+  }
+  if (Yap_heap_regs->db_erased_ilist) {
+    Yap_heap_regs->db_erased_ilist = 
+      LUIndexAdjust(Yap_heap_regs->db_erased_ilist);
+  }
+#endif
   if (Yap_heap_regs->undef_code != NULL)
     Yap_heap_regs->undef_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->undef_code));
   if (Yap_heap_regs->creep_code != NULL)
     Yap_heap_regs->creep_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->creep_code));
   if (Yap_heap_regs->spy_code != NULL)
     Yap_heap_regs->spy_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->spy_code));
+#if !defined(THREADS)
+  if (Yap_heap_regs->wl.scratchpad.ptr) {
+    Yap_heap_regs->wl.scratchpad.ptr =
+      (char *)AddrAdjust((ADDR)Yap_heap_regs->wl.scratchpad.ptr);
+  }
+#endif
 #ifdef COROUTINING
   if (Yap_heap_regs->wake_up_code != NULL)
     Yap_heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->wake_up_code));
@@ -492,7 +514,7 @@ AdjustDBTerm(Term trm, Term *p_base)
     Term           *p;
 
     p = PtoHeapCellAdjust(RepPair(trm));
-    if (p > p_base) {
+    if (p >= p_base) {
       p[0] = AdjustDBTerm(p[0], p);
       p[1] = AdjustDBTerm(p[1], p);
     }
@@ -504,7 +526,7 @@ AdjustDBTerm(Term trm, Term *p_base)
     Term *p0 = p = PtoHeapCellAdjust(RepAppl(trm));
     /* if it is before the current position, then we are looking
        at old code */
-    if (p > p_base) {
+    if (p >= p_base) {
       f = (Functor)p[0];
       if (!IsExtensionFunctor(f)) {
 	UInt             Arity, i;

H/sshift.h

@@ -292,7 +292,7 @@ inline EXTERN Term AtomTermAdjust (Term);
 inline EXTERN Term
 AtomTermAdjust (Term at)
 {
-  return (Term) ((at));
+  return at + HDiff;
 }
 
 
@@ -422,6 +422,15 @@ CodeAddrAdjust (CODEADDR addr)
 }
 
 
+inline EXTERN char * CodeCharPAdjust (char *);
+
+inline EXTERN char *
+CodeCharPAdjust (char * addr)
+{
+  return addr + HDiff;
+}
+
+
 
 inline EXTERN BlockHeader *BlockAdjust (BlockHeader *);
 
@@ -504,19 +513,6 @@ PtoStCAdjust (struct static_clause *ptr)
 }
 
 
-#if USE_DL_MALLOC
-
-inline EXTERN struct malloc_chunk *ChunkPtrAdjust (struct malloc_chunk *);
-
-inline EXTERN struct malloc_chunk *
-ChunkPtrAdjust (struct malloc_chunk *ptr)
-{
-  return (struct malloc_chunk
-	  *) (((struct malloc_chunk *) (CharP (ptr) + HDiff)));
-}
-
-
-#endif
 #if PRECOMPUTE_REGADDRESS
 
 inline EXTERN wamreg XAdjust (wamreg);