Merge branch 'master' of git.dcc.fc.up.pt:yap-6.3

C/agc.c

@@ -329,6 +329,30 @@ mark_global_cell(CELL *pt)
 	Int sz = 3 +
 	  (sizeof(MP_INT)+
 	   (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/sizeof(CELL);
+	Opaque_CallOnGCMark f;
+	Opaque_CallOnGCRelocate f2;
+	Term t = AbsAppl(pt);
+
+	if ( (f = Yap_blob_gc_mark_handler(t)) ) {
+	  CELL ar[256];
+	  Int i,n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, 256);
+	  if (n < 0) {
+	    Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"not enough space for slot internal variables in agc");
+	      }
+	  for (i = 0; i< n; i++) {
+	    CELL *pt = ar+i;
+	    CELL reg = *pt;
+	    if (!IsVarTerm(reg) && IsAtomTerm(reg)) {
+	      *pt = AtomTermAdjust(reg);
+	    }
+	  }
+	  if ( (f2 = Yap_blob_gc_relocate_handler(t)) < 0 ) {
+	    int out = (f2)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, n);
+	    if (out < 0)
+	      Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"bad restore of slot internal variables in agc");
+	  }
+	}
+
 	return pt + sz;
       }
     case (CELL)FunctorLongInt:

C/bignum.c

@@ -188,10 +188,59 @@ Yap_blob_write_handler_from_slot(Int slot)
 {
   CACHE_REGS
   CELL blob_info, blob_tag;
-  MP_INT *blobp;
   Term t = Yap_GetFromSlot(slot PASS_REGS);
   CELL *pt = RepAppl(t);
 
+#ifdef DEBUG
+  /* sanity checking */
+  if (pt[0] != (CELL)FunctorBigInt) {
+    Yap_Error(SYSTEM_ERROR, TermNil, "CleanOpaqueVariable bad call");
+    return FALSE;
+  }
+#endif
+  blob_tag = pt[1];
+  if (blob_tag < USER_BLOB_START ||
+      blob_tag >= USER_BLOB_END) {
+    Yap_Error(SYSTEM_ERROR, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag);
+    return FALSE;
+  }
+  blob_info = blob_tag - USER_BLOB_START;
+  if (!GLOBAL_OpaqueHandlers) {
+    return NULL;
+  }
+  return GLOBAL_OpaqueHandlers[blob_info].write_handler;
+}
+
+Opaque_CallOnGCMark
+Yap_blob_gc_mark_handler(Term t)
+{
+  CELL blob_info, blob_tag;
+  CELL *pt = RepAppl(t);
+
+#ifdef DEBUG
+  /* sanity checking */
+  if (pt[0] != (CELL)FunctorBigInt) {
+    Yap_Error(SYSTEM_ERROR, TermNil, "CleanOpaqueVariable bad call");
+    return FALSE;
+  }
+#endif
+  blob_tag = pt[1];
+  if (blob_tag < USER_BLOB_START ||
+      blob_tag >= USER_BLOB_END) {
+    return NULL;
+  }
+  blob_info = blob_tag - USER_BLOB_START;
+  if (!GLOBAL_OpaqueHandlers)
+    return NULL;
+  return GLOBAL_OpaqueHandlers[blob_info].gc_mark_handler;
+}
+
+Opaque_CallOnGCRelocate
+Yap_blob_gc_relocate_handler(Term t)
+{
+  CELL blob_info, blob_tag;
+  CELL *pt = RepAppl(t);
+
 #ifdef DEBUG
   /* sanity checking */
   if (pt[0] != (CELL)FunctorBigInt) {
@@ -208,8 +257,7 @@ Yap_blob_write_handler_from_slot(Int slot)
   blob_info = blob_tag - USER_BLOB_START;
   if (!GLOBAL_OpaqueHandlers)
     return NULL;
-  blobp = (MP_INT *)(pt+2);
+  return GLOBAL_OpaqueHandlers[blob_info].gc_relocate_handler;
-  return GLOBAL_OpaqueHandlers[blob_info].write_handler;
 }
 
 extern Int Yap_blob_tag_from_slot(Int slot)
@@ -232,7 +280,6 @@ void *
 Yap_blob_info_from_slot(Int slot)
 {
   CACHE_REGS
-  CELL blob_info, blob_tag;
   MP_INT *blobp;
   Term t = Yap_GetFromSlot(slot PASS_REGS);
   CELL *pt = RepAppl(t);
@@ -244,13 +291,6 @@ Yap_blob_info_from_slot(Int slot)
     return FALSE;
   }
 #endif
-  blob_tag = pt[1];
-  if (blob_tag < USER_BLOB_START ||
-      blob_tag >= USER_BLOB_END) {
-    Yap_Error(SYSTEM_ERROR, AbsAppl(pt), "clean opaque: bad blob with tag " UInt_FORMAT ,blob_tag);
-    return FALSE;
-  }
-  blob_info = blob_tag - USER_BLOB_START;
   if (!GLOBAL_OpaqueHandlers)
     return FALSE;
   blobp = (MP_INT *)(pt+2);

C/exec.c

@@ -1264,7 +1264,7 @@ Yap_RunTopGoal(Term t)
     /* I cannot use the standard macro here because
        otherwise I would dereference the argument and
        might skip a svar */
-    pe = PredPropByFunc(f, CurrentModule);
+    pe = PredPropByFunc(f, mod);
     pt = RepAppl(t)+1;
     arity = ArityOfFunctor(f); 
   } else {

C/grow.c

@@ -572,16 +572,49 @@ AdjustGlobal(long sz, int thread_copying USES_REGS)
 	  pt += 2;
 #endif
 	  break;
-#if USE_GMP
 	case (CELL)FunctorBigInt:
 	  {
 	    Int sz = 2+
 	      (sizeof(MP_INT)+
 	       (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)))/CellSize;
+	    Opaque_CallOnGCMark f;
+	    Opaque_CallOnGCRelocate f2;
+	    Term t = AbsAppl(pt);
+
+	    if ( (f = Yap_blob_gc_mark_handler(t)) ) {
+	      CELL ar[256];
+	      Int i,n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, 256);
+	      if (n < 0) {
+		Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"not enough space for slot internal variables");
+	      }
+	      for (i = 0; i< n; i++) {
+		CELL *pt = ar+i;
+		CELL reg = *pt;
+		if (IsVarTerm(reg)) {
+		  if (IsOldGlobal(reg))
+		    *pt = GlobalAdjust(reg);
+		  else if (IsOldLocal(reg))
+		    *pt = LocalAdjust(reg);
+#ifdef MULTI_ASSIGNMENT_VARIABLES
+		  else if (IsOldTrail(reg))
+		    *pt = TrailAdjust(reg);
+#endif
+		} else if (IsApplTerm(reg))
+		  *pt = AdjustAppl(reg PASS_REGS);
+		else if (IsPairTerm(reg))
+		  *pt = AdjustPair(reg PASS_REGS);
+		else if (IsAtomTerm(reg))
+		  *pt = AtomTermAdjust(reg);
+	      }
+	      if ( (f2 = Yap_blob_gc_relocate_handler(t)) < 0 ) {
+		int out = (f2)(Yap_BlobTag(t), Yap_BlobInfo(t), ar, n);
+		if (out < 0)
+		Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"bad restore of slot internal variables");
+	      }
+	    }
 	    pt += sz;
 	  }
 	  break;
-#endif
 	case (CELL)0L:
 	  break;
 	case (CELL)FunctorLongInt:

C/heapgc.c

@@ -40,6 +40,7 @@ STATIC_PROTO(Int  p_gc, ( CACHE_TYPE1 ));
 STATIC_PROTO(void marking_phase, (tr_fr_ptr, CELL *, yamop * CACHE_TYPE));
 STATIC_PROTO(void compaction_phase, (tr_fr_ptr, CELL *, yamop * CACHE_TYPE));
 STATIC_PROTO(void init_dbtable, (tr_fr_ptr CACHE_TYPE));
+STATIC_PROTO(void mark_external_reference, (CELL * CACHE_TYPE));
 STATIC_PROTO(void mark_db_fixed, (CELL *  CACHE_TYPE));
 STATIC_PROTO(void mark_regs, (tr_fr_ptr CACHE_TYPE));
 STATIC_PROTO(void mark_trail, (tr_fr_ptr, tr_fr_ptr, CELL *, choiceptr CACHE_TYPE));
@@ -475,6 +476,24 @@ pop_registers(Int num_regs, yamop *nextop USES_REGS)
   tr_fr_ptr ptr = TR;
   StaticArrayEntry *sal = LOCAL_StaticArrays;
 
+  /* pop info on opaque variables */
+  while (LOCAL_extra_gc_cells > LOCAL_extra_gc_cells_base) {
+    Opaque_CallOnGCRelocate f;
+    CELL *ptr = LOCAL_extra_gc_cells-1;
+    size_t n = ptr[0], t = ptr[-1];
+
+    LOCAL_extra_gc_cells -= (n+1);
+    if ( (f = Yap_blob_gc_relocate_handler(t)) ) {
+      int out = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), LOCAL_extra_gc_cells, n);
+      if (out < 0) {
+	/* error: we don't have enough room */
+	/* could not find more trail */
+	save_machine_regs();
+	siglongjmp(LOCAL_gc_restore, 4);
+      }     
+    }
+  }
+
   /* pop array entries first */
   ArrayEntry *al = LOCAL_DynamicArrays;
   GlobalEntry *gl = LOCAL_GlobalVariables;
@@ -875,7 +894,13 @@ init_dbtable(tr_fr_ptr trail_ptr USES_REGS) {
   MegaClause *mc = DeadMegaClauses;
   StaticIndex *si = DeadStaticIndices;
 
-  LOCAL_db_vec0 = LOCAL_db_vec = (ADDR)TR;
+  LOCAL_extra_gc_cells =
+    LOCAL_extra_gc_cells_base = (CELL *)TR;
+  LOCAL_extra_gc_cells_top = LOCAL_extra_gc_cells_base+
+    LOCAL_extra_gc_cells_size;
+  if ((char *)LOCAL_extra_gc_cells_top > LOCAL_TrailTop-1024)
+    gc_growtrail(FALSE, NULL, NULL PASS_REGS);
+  LOCAL_db_vec0 = LOCAL_db_vec = (ADDR)LOCAL_extra_gc_cells_top;
   LOCAL_db_root = RBTreeCreate();
   while (trail_ptr > (tr_fr_ptr)LOCAL_TrailBase) {
     register CELL trail_cell;
@@ -1334,9 +1359,30 @@ mark_variable(CELL_PTR current USES_REGS)
 	POP_CONTINUATION();
       case (CELL)FunctorBigInt:
 	{
+	  Opaque_CallOnGCMark f;
+	  Term t = AbsAppl(next);
 	  UInt sz = (sizeof(MP_INT)+CellSize+
 		     ((MP_INT *)(next+2))->_mp_alloc*sizeof(mp_limb_t))/CellSize;
+
 	  MARK(next);
+	  if ( (f = Yap_blob_gc_mark_handler(t)) ) {
+	    Int n = (f)(Yap_BlobTag(t), Yap_BlobInfo(t), LOCAL_extra_gc_cells, LOCAL_extra_gc_cells_top - (LOCAL_extra_gc_cells+2));
+	    if (n < 0) {
+	      /* error: we don't have enough room */
+	      /* could not find more trail */
+	      save_machine_regs();
+	      siglongjmp(LOCAL_gc_restore, 3);
+	    } else if (n > 0) {
+	      CELL *ptr = LOCAL_extra_gc_cells;
+
+	      LOCAL_extra_gc_cells += n+2;      
+	      PUSH_CONTINUATION(ptr, n+1 PASS_REGS);
+	      ptr += n;
+	      ptr[0] = t;
+	      ptr[1] = n+1;
+	    }
+	  }
+
 	  /* size is given by functor + friends */
 	  if (next < LOCAL_HGEN) {
 	    LOCAL_total_oldies += 2+sz;
@@ -2392,6 +2438,23 @@ sweep_trail(choiceptr gc_B, tr_fr_ptr old_TR USES_REGS)
   Int hp_entrs = 0, hp_erased = 0, hp_not_in_use = 0,
     hp_in_use_erased = 0, code_entries = 0;
 #endif
+  CELL *ptr = LOCAL_extra_gc_cells;
+  
+  while (ptr > LOCAL_extra_gc_cells_base) {
+    Int k = ptr[-1], i;
+    ptr = ptr-1;
+
+    for (i = 0; i < k; i++) {
+      ptr--;
+      if (IN_BETWEEN(LOCAL_GlobalBase,ptr[0],LOCAL_TrailTop) &&
+	  MARKED_PTR(ptr)) {
+	UNMARK(ptr);
+	if (HEAP_PTR(ptr[0])) {
+	  into_relocation_chain(ptr, GET_NEXT(ptr[0]) PASS_REGS);
+	}
+      }
+    }
+  }
 
 #ifndef FROZEN_STACKS
   { 
@@ -3750,6 +3813,8 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
   int           gc_trace;
   UInt		gc_phase;
   UInt		alloc_sz;
+  int jmp_res;
+
   heap_cells = H-H0;
   gc_verbose = is_gc_verbose();
   effectiveness = 0;
@@ -3804,7 +3869,8 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
   }
 #endif
   time_start = Yap_cputime();
-  if (sigsetjmp(LOCAL_gc_restore, 0) == 2) {
+  jmp_res = sigsetjmp(LOCAL_gc_restore, 0);
+  if (jmp_res == 2) {
     UInt sz;
 
     /* we cannot recover, fail system */
@@ -3830,6 +3896,25 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
       current_env = (CELL *)*ASP;
       ASP++;
     }
+  } else if (jmp_res == 3) {
+    /* we cannot recover, fail system */
+    restore_machine_regs();    
+    TR = LOCAL_OldTR;
+  
+    LOCAL_total_marked = 0;
+    LOCAL_total_oldies = 0;
+#ifdef COROUTING
+    LOCAL_total_smarked = 0;
+#endif
+    LOCAL_discard_trail_entries = 0;
+    if (LOCAL_extra_gc_cells_size < 1024 *104) {
+      LOCAL_extra_gc_cells_size <<= 1;
+    } else {
+      LOCAL_extra_gc_cells_size += 1024*1024;
+    }
+  } else if (jmp_res == 4) {
+    /* we cannot recover, fail completely */
+    Yap_exit(1);
   }
 #if EASY_SHUNTING
   LOCAL_sTR0 = LOCAL_sTR = NULL;

H/TermExt.h

@@ -604,6 +604,27 @@ IsAttachedTerm (Term t)
 
 #endif
 
+inline EXTERN Int Yap_BlobTag(Term t);
+
+inline EXTERN Int Yap_BlobTag(Term t)
+{
+  CELL *pt = RepAppl(t);
+
+  return pt[1];
+}
+
+
+inline EXTERN void *Yap_BlobInfo(Term t);
+
+inline EXTERN void *Yap_BlobInfo(Term t)
+{
+  MP_INT *blobp;
+  CELL *pt = RepAppl(t);
+
+  blobp = (MP_INT *)(pt+2);
+  return (void *)(blobp+1);
+}
+
 #ifdef YAP_H
 
 inline EXTERN int STD_PROTO (unify_extension, (Functor, CELL, CELL *, CELL));

H/Yap.h

@@ -877,6 +877,7 @@ TailOfTermCell (Term t)
   return (Term) ((CELL) (RepPair (t) + 1));
 }
 
+
 /*************************************************************************************************
                                            slots
 *************************************************************************************************/

H/YapHeap.h

@@ -35,13 +35,19 @@ typedef int (*SWI_PLGetStreamPositionFunction)(void *);
 
 typedef int (*Opaque_CallOnFail)(void *);
 typedef int (*Opaque_CallOnWrite)(void *, int, void *, int);
+typedef Int (*Opaque_CallOnGCMark)(int, void *, Term *, Int);
+typedef int (*Opaque_CallOnGCRelocate)(int, void *, Term *, Int);
 
 typedef struct opaque_handler_struct {
   Opaque_CallOnFail fail_handler;
   Opaque_CallOnWrite write_handler;
+  Opaque_CallOnGCMark gc_mark_handler;
+  Opaque_CallOnGCRelocate gc_relocate_handler;
 } opaque_handler_t;
 
 extern Opaque_CallOnWrite Yap_blob_write_handler_from_slot(Int slot);
+extern Opaque_CallOnGCMark Yap_blob_gc_mark_handler(Term t);
+extern Opaque_CallOnGCRelocate Yap_blob_gc_relocate_handler(Term t);
 extern Int Yap_blob_tag_from_slot(Int slot);
 extern void *Yap_blob_info_from_slot(Int slot);
 

H/dlocals.h

@@ -183,6 +183,14 @@
 #define REMOTE_db_nil(wid) REMOTE(wid)->db_nil_
 #define LOCAL_gc_restore LOCAL->gc_restore_
 #define REMOTE_gc_restore(wid) REMOTE(wid)->gc_restore_
+#define LOCAL_extra_gc_cells LOCAL->extra_gc_cells_
+#define REMOTE_extra_gc_cells(wid) REMOTE(wid)->extra_gc_cells_
+#define LOCAL_extra_gc_cells_base LOCAL->extra_gc_cells_base_
+#define REMOTE_extra_gc_cells_base(wid) REMOTE(wid)->extra_gc_cells_base_
+#define LOCAL_extra_gc_cells_top LOCAL->extra_gc_cells_top_
+#define REMOTE_extra_gc_cells_top(wid) REMOTE(wid)->extra_gc_cells_top_
+#define LOCAL_extra_gc_cells_size LOCAL->extra_gc_cells_size_
+#define REMOTE_extra_gc_cells_size(wid) REMOTE(wid)->extra_gc_cells_size_
 #define LOCAL_DynamicArrays LOCAL->DynamicArrays_
 #define REMOTE_DynamicArrays(wid) REMOTE(wid)->DynamicArrays_
 #define LOCAL_StaticArrays LOCAL->StaticArrays_

H/hlocals.h

@@ -101,6 +101,10 @@ typedef struct worker_local {
   struct RB_red_blk_node*  db_root_;
   struct RB_red_blk_node*  db_nil_;
   sigjmp_buf  gc_restore_;
+  CELL*  extra_gc_cells_;
+  CELL*  extra_gc_cells_base_;
+  CELL*  extra_gc_cells_top_;
+  UInt  extra_gc_cells_size_;
   struct array_entry*  DynamicArrays_;
   struct static_array_entry*  StaticArrays_;
   struct global_entry*  GlobalVariables_;

H/ilocals.h

@@ -101,6 +101,10 @@ static void InitWorker(int wid) {
   REMOTE_db_root(wid) = NULL;
   REMOTE_db_nil(wid) = NULL;
 
+
+
+
+  REMOTE_extra_gc_cells_size(wid) = 256;
   REMOTE_DynamicArrays(wid) = NULL;
   REMOTE_StaticArrays(wid) = NULL;
   REMOTE_GlobalVariables(wid) = NULL;

H/rlocals.h

@@ -101,6 +101,10 @@ static void RestoreWorker(int wid USES_REGS) {
 
 
 
+
+
+
+
   REMOTE_DynamicArrays(wid) = PtoArrayEAdjust(REMOTE_DynamicArrays(wid));
   REMOTE_StaticArrays(wid) = PtoArraySAdjust(REMOTE_StaticArrays(wid));
   REMOTE_GlobalVariables(wid) = PtoGlobalEAdjust(REMOTE_GlobalVariables(wid));

docs/yap.tex

@@ -16741,6 +16741,7 @@ starting at @var{slot}.
 
 The following functions complement @var{YAP_RunGoal}:
 @table @code
+@item  @code{int} YAP_RestartGoal(@code{void})
 @findex YAP_RestartGoal (C-Interface function)
 Look for the next solution to the current query by forcing YAP to
 backtrack to the latest goal. Notice that slots allocated since the last

include/yap_structs.h

@@ -225,10 +225,14 @@ typedef YAP_Int YAP_opaque_tag_t;
 
 typedef int (*YAP_Opaque_CallOnFail)(void *);
 typedef int (*YAP_Opaque_CallOnWrite)(void *, YAP_opaque_tag_t, void *, int);
+typedef YAP_Int (*YAP_Opaque_CallOnGCMark)(YAP_opaque_tag_t, void *, YAP_Term *, YAP_Int);
+typedef int (*YAP_Opaque_CallOnGCRelocate)(YAP_opaque_tag_t, void *, YAP_Term *, YAP_Int);
 
 typedef struct YAP_opaque_handler_struct {
   YAP_Opaque_CallOnFail  fail_handler;
   YAP_Opaque_CallOnWrite write_handler;
+  YAP_Opaque_CallOnGCMark mark_handler;
+  YAP_Opaque_CallOnGCRelocate relocate_handler;
 } YAP_opaque_handler_t;
 
 /********* execution mode ***********************/

misc/LOCALS

@@ -107,6 +107,10 @@ struct RB_red_blk_node*		db_root					=NULL
 struct RB_red_blk_node*		db_nil					=NULL
 
 sigjmp_buf			gc_restore				void
+CELL*				extra_gc_cells				void
+CELL*				extra_gc_cells_base			void
+CELL*				extra_gc_cells_top			void
+UInt				extra_gc_cells_size			=256
 struct array_entry*		DynamicArrays				=NULL 		PtoArrayEAdjust
 struct static_array_entry*	StaticArrays				=NULL 		PtoArraySAdjust
 struct global_entry*		GlobalVariables				=NULL 		PtoGlobalEAdjust