diff --git a/C/agc.c b/C/agc.c index a8fe53696..a52e40b8b 100644 --- a/C/agc.c +++ b/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: diff --git a/C/bignum.c b/C/bignum.c index b369fae40..068682453 100644 --- a/C/bignum.c +++ b/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].write_handler; + return GLOBAL_OpaqueHandlers[blob_info].gc_relocate_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); diff --git a/C/exec.c b/C/exec.c index 8b4d3ddc5..4a3f91cbb 100644 --- a/C/exec.c +++ b/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 { diff --git a/C/grow.c b/C/grow.c index da18c3533..3539a4b50 100644 --- a/C/grow.c +++ b/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: diff --git a/C/heapgc.c b/C/heapgc.c index 0907ca87f..04037d578 100644 --- a/C/heapgc.c +++ b/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; diff --git a/H/TermExt.h b/H/TermExt.h index ba938e832..a30eae80d 100644 --- a/H/TermExt.h +++ b/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)); diff --git a/H/Yap.h b/H/Yap.h index ae0b0c82b..b2dbda484 100644 --- a/H/Yap.h +++ b/H/Yap.h @@ -877,6 +877,7 @@ TailOfTermCell (Term t) return (Term) ((CELL) (RepPair (t) + 1)); } + /************************************************************************************************* slots *************************************************************************************************/ diff --git a/H/YapHeap.h b/H/YapHeap.h index b8a715838..c4b5001f0 100644 --- a/H/YapHeap.h +++ b/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); diff --git a/H/dlocals.h b/H/dlocals.h index 796a5a2df..5726cc920 100644 --- a/H/dlocals.h +++ b/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_ diff --git a/H/hlocals.h b/H/hlocals.h index e16640167..9a664aca3 100644 --- a/H/hlocals.h +++ b/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_; diff --git a/H/ilocals.h b/H/ilocals.h index 8547c4494..d8cf5a6a4 100644 --- a/H/ilocals.h +++ b/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; diff --git a/H/rlocals.h b/H/rlocals.h index 02aa07679..a5de53e3e 100644 --- a/H/rlocals.h +++ b/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)); diff --git a/docs/yap.tex b/docs/yap.tex index dea9938de..f36829186 100644 --- a/docs/yap.tex +++ b/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 diff --git a/include/yap_structs.h b/include/yap_structs.h index 49c9f30db..fd98977f1 100644 --- a/include/yap_structs.h +++ b/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 ***********************/ diff --git a/misc/LOCALS b/misc/LOCALS index b4ccb1e9d..6fd8c2068 100644 --- a/misc/LOCALS +++ b/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