diogo
/
yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of git://yap.git.sourceforge.net/gitroot/yap/yap-6.3

This commit is contained in:
Denys Duchier 2011-12-13 14:51:48 +01:00
parent 213c0780d3 98c849c087
commit fc1f622e7e
17 changed files with 352 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
C/agc.c
View File

@ -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_CallOnGCRellocate 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_rellocate_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:

62
C/bignum.c
View File

@ -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_CallOnGCRellocate
Yap_blob_gc_rellocate_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_rellocate_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);

37
C/grow.c
View File

@ -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_CallOnGCRellocate 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_rellocate_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:

89
C/heapgc.c
View File

@ -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_CallOnGCRellocate 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_rellocate_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;

21
H/TermExt.h
View File

@ -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));

1
H/Yap.h
View File

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

6
H/YapHeap.h
View File

@ -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_CallOnGCRellocate)(int, void *, Term *, Int);
typedef struct opaque_handler_struct {
Opaque_CallOnFail fail_handler;
Opaque_CallOnWrite write_handler;
Opaque_CallOnGCMark gc_mark_handler;
Opaque_CallOnGCRellocate gc_rellocate_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_CallOnGCRellocate Yap_blob_gc_rellocate_handler(Term t);
extern Int Yap_blob_tag_from_slot(Int slot);
extern void *Yap_blob_info_from_slot(Int slot);

8
H/dlocals.h
View File

@ -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_

4
H/hlocals.h
View File

@ -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_;

4
H/ilocals.h
View File

@ -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;

4
H/rlocals.h
View File

@ -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));

22
OPTYap/tab.macros.h
View File

@ -179,17 +179,17 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
#define IS_INVALID_LEAF_NODE(NODE) ((unsigned long int) TrNode_parent(NODE) & 0x2)
/* trie hashes */
#define MAX_NODES_PER_TRIE_LEVEL 8
#define MAX_NODES_PER_BUCKET (MAX_NODES_PER_TRIE_LEVEL / 2)
#define BASE_HASH_BUCKETS 64
#define HASH_ENTRY(ENTRY, SEED) ((((unsigned long int) ENTRY) >> NumberOfLowTagBits) & (SEED))
#define SUBGOAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS))
#define IS_SUBGOAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == SUBGOAL_TRIE_HASH_MARK)
#define ANSWER_TRIE_HASH_MARK 0
#define IS_ANSWER_TRIE_HASH(NODE) (TrNode_instr(NODE) == ANSWER_TRIE_HASH_MARK)
#define GLOBAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS))
#define IS_GLOBAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == GLOBAL_TRIE_HASH_MARK)
#define HASH_TRIE_LOCK(NODE) GLOBAL_trie_locks((((unsigned long int) (NODE)) >> 5) & (TRIE_LOCK_BUCKETS - 1))
#define MAX_NODES_PER_TRIE_LEVEL 8
#define MAX_NODES_PER_BUCKET (MAX_NODES_PER_TRIE_LEVEL / 2)
#define BASE_HASH_BUCKETS 64
#define HASH_ENTRY(ENTRY, NUM_BUCKETS) ((((unsigned long int) ENTRY) >> NumberOfLowTagBits) & (NUM_BUCKETS - 1))
#define SUBGOAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS))
#define IS_SUBGOAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == SUBGOAL_TRIE_HASH_MARK)
#define ANSWER_TRIE_HASH_MARK 0
#define IS_ANSWER_TRIE_HASH(NODE) (TrNode_instr(NODE) == ANSWER_TRIE_HASH_MARK)
#define GLOBAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS))
#define IS_GLOBAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == GLOBAL_TRIE_HASH_MARK)
#define HASH_TRIE_LOCK(NODE) GLOBAL_trie_locks((((unsigned long int) (NODE)) >> 5) & (TRIE_LOCK_BUCKETS - 1))
/* auxiliary stack */
#define STACK_PUSH_UP(ITEM, STACK) *--(STACK) = (CELL)(ITEM)

2
OPTYap/tab.structs.h
View File

@ -148,9 +148,7 @@ typedef struct global_trie_hash {
#define Hash_mark(X) ((X)->mark)
#define Hash_num_buckets(X) ((X)->number_of_buckets)
#define Hash_seed(X) ((X)->number_of_buckets - 1)
#define Hash_buckets(X) ((X)->buckets)
#define Hash_bucket(X,N) ((X)->buckets + N)
#define Hash_num_nodes(X) ((X)->number_of_nodes)
#define Hash_previous(X) ((X)->previous)
#define Hash_next(X) ((X)->next)

2
OPTYap/tab.tries.c
View File

@ -456,7 +456,7 @@ static void free_global_trie_branch(gt_node_ptr current_node) {
child_node = TrNode_child(parent_node);
if (IS_GLOBAL_TRIE_HASH(child_node)) {
gt_hash_ptr hash = (gt_hash_ptr) child_node;
gt_node_ptr *bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(current_node), Hash_seed(hash)));
gt_node_ptr *bucket = Hash_buckets(hash) + HASH_ENTRY(TrNode_entry(current_node), Hash_num_buckets(hash));
int num_nodes = --Hash_num_nodes(hash);
child_node = *bucket;
if (child_node != current_node) {

167
OPTYap/tab.tries.i
View File

@ -95,7 +95,7 @@ static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, s
new_subgoal_trie_hash(hash, count_nodes, tab_ent);
chain_node = child_node;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1));
bucket = Hash_buckets(hash) + HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
@ -114,7 +114,7 @@ static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, s
sg_node_ptr *bucket;
int count_nodes = 0;
hash = (sg_hash_ptr) child_node;
bucket = Hash_bucket(hash, HASH_ENTRY(t, Hash_seed(hash)));
bucket = Hash_buckets(hash) + HASH_ENTRY(t, Hash_num_buckets(hash));
child_node = *bucket;
while (child_node) {
if (TrNode_entry(child_node) == t) {
@ -130,26 +130,27 @@ static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, s
count_nodes++;
if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */
sg_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
int seed;
first_old_bucket = Hash_buckets(hash);
old_bucket = first_old_bucket + Hash_num_buckets(hash);
Hash_num_buckets(hash) *= 2;
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
seed = Hash_seed(hash);
sg_node_ptr chain_node, next_node, *old_bucket, *hash_old_buckets, *hash_new_buckets;
int num_buckets;
num_buckets = Hash_num_buckets(hash) * 2;
ALLOC_HASH_BUCKETS(hash_new_buckets, num_buckets);
hash_old_buckets = Hash_buckets(hash);
old_bucket = hash_old_buckets + Hash_num_buckets(hash);
do {
if (*--old_bucket) {
chain_node = *old_bucket;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed));
bucket = hash_new_buckets + HASH_ENTRY(TrNode_entry(chain_node), num_buckets);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
chain_node = next_node;
} while (chain_node);
}
} while (old_bucket != first_old_bucket);
FREE_HASH_BUCKETS(first_old_bucket);
} while (old_bucket != hash_old_buckets);
FREE_HASH_BUCKETS(hash_old_buckets);
Hash_buckets(hash) = hash_new_buckets;
Hash_num_buckets(hash) = num_buckets;
}
UNLOCK_SUBGOAL_NODE(parent_node);
return child_node;
@ -252,7 +253,7 @@ static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, s
new_subgoal_trie_hash(hash, count_nodes, tab_ent);
chain_node = child_node;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1));
bucket = Hash_buckets(hash) + HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
@ -270,10 +271,10 @@ static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, s
subgoal_trie_hash:
{ /* trie nodes with hashing */
sg_node_ptr *bucket, first_node;
int seed, count_nodes = 0;
int num_buckets, count_nodes = 0;
seed = Hash_seed(hash);
bucket = Hash_bucket(hash, HASH_ENTRY(t, seed));
num_buckets = Hash_num_buckets(hash);
bucket = Hash_buckets(hash) + HASH_ENTRY(t, num_buckets);
first_node = child_node = *bucket;
while (child_node) {
if (TrNode_entry(child_node) == t)
@ -285,7 +286,7 @@ subgoal_trie_hash:
NEW_SUBGOAL_TRIE_NODE(child_node, t, NULL, parent_node, first_node);
#endif /* SUBGOAL_TRIE_ALLOC_BEFORE_CHECK */
LOCK_SUBGOAL_NODE(parent_node);
if (seed != Hash_seed(hash)) {
if (num_buckets != Hash_num_buckets(hash)) {
/* the hash has been expanded */
#ifdef SUBGOAL_TRIE_ALLOC_BEFORE_CHECK
FREE_SUBGOAL_TRIE_NODE(child_node);
@ -319,25 +320,26 @@ subgoal_trie_hash:
count_nodes++;
if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */
sg_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
first_old_bucket = Hash_buckets(hash);
old_bucket = first_old_bucket + Hash_num_buckets(hash);
Hash_num_buckets(hash) *= 2;
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
seed = Hash_seed(hash);
sg_node_ptr chain_node, next_node, *old_bucket, *hash_old_buckets, *hash_new_buckets;
num_buckets = Hash_num_buckets(hash) * 2;
ALLOC_HASH_BUCKETS(hash_new_buckets, num_buckets);
hash_old_buckets = Hash_buckets(hash);
old_bucket = hash_old_buckets + Hash_num_buckets(hash);
do {
if (*--old_bucket) {
chain_node = *old_bucket;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed));
bucket = hash_new_buckets + HASH_ENTRY(TrNode_entry(chain_node), num_buckets);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
chain_node = next_node;
} while (chain_node);
}
} while (old_bucket != first_old_bucket);
FREE_HASH_BUCKETS(first_old_bucket);
} while (old_bucket != hash_old_buckets);
FREE_HASH_BUCKETS(hash_old_buckets);
Hash_buckets(hash) = hash_new_buckets;
Hash_num_buckets(hash) = num_buckets;
}
UNLOCK_SUBGOAL_NODE(parent_node);
return child_node;
@ -391,7 +393,7 @@ static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_n
new_answer_trie_hash(hash, count_nodes, sg_fr);
chain_node = child_node;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1));
bucket = Hash_buckets(hash) + HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
@ -410,7 +412,7 @@ static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_n
ans_node_ptr *bucket;
int count_nodes = 0;
hash = (ans_hash_ptr) child_node;
bucket = Hash_bucket(hash, HASH_ENTRY(t, Hash_seed(hash)));
bucket = Hash_buckets(hash) + HASH_ENTRY(t, Hash_num_buckets(hash));
child_node = *bucket;
while (child_node) {
if (TrNode_entry(child_node) == t) {
@ -426,26 +428,27 @@ static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_n
count_nodes++;
if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */
ans_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
int seed;
first_old_bucket = Hash_buckets(hash);
old_bucket = first_old_bucket + Hash_num_buckets(hash);
Hash_num_buckets(hash) *= 2;
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
seed = Hash_seed(hash);
ans_node_ptr chain_node, next_node, *old_bucket, *hash_old_buckets, *hash_new_buckets;
int num_buckets;
num_buckets = Hash_num_buckets(hash) * 2;
ALLOC_HASH_BUCKETS(hash_new_buckets, num_buckets);
hash_old_buckets = Hash_buckets(hash);
old_bucket = hash_old_buckets + Hash_num_buckets(hash);
do {
if (*--old_bucket) {
chain_node = *old_bucket;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed));
bucket = hash_new_buckets + HASH_ENTRY(TrNode_entry(chain_node), num_buckets);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
chain_node = next_node;
} while (chain_node);
}
} while (old_bucket != first_old_bucket);
FREE_HASH_BUCKETS(first_old_bucket);
} while (old_bucket != hash_old_buckets);
FREE_HASH_BUCKETS(hash_old_buckets);
Hash_buckets(hash) = hash_new_buckets;
Hash_num_buckets(hash) = num_buckets;
}
UNLOCK_ANSWER_NODE(parent_node);
return child_node;
@ -549,7 +552,7 @@ static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_n
new_answer_trie_hash(hash, count_nodes, sg_fr);
chain_node = child_node;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1));
bucket = Hash_buckets(hash) + HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
@ -567,10 +570,10 @@ static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_n
answer_trie_hash:
{ /* trie nodes with hashing */
ans_node_ptr *bucket, first_node;
int seed, count_nodes = 0;
int num_buckets, count_nodes = 0;
seed = Hash_seed(hash);
bucket = Hash_bucket(hash, HASH_ENTRY(t, seed));
num_buckets = Hash_num_buckets(hash);
bucket = Hash_buckets(hash) + HASH_ENTRY(t, num_buckets);
first_node = child_node = *bucket;
while (child_node) {
if (TrNode_entry(child_node) == t)
@ -582,7 +585,7 @@ answer_trie_hash:
NEW_ANSWER_TRIE_NODE(child_node, instr, t, NULL, parent_node, first_node);
#endif /* ANSWER_TRIE_ALLOC_BEFORE_CHECK */
LOCK_ANSWER_NODE(parent_node);
if (seed != Hash_seed(hash)) {
if (num_buckets != Hash_num_buckets(hash)) {
/* the hash has been expanded */
#ifdef ANSWER_TRIE_ALLOC_BEFORE_CHECK
FREE_ANSWER_TRIE_NODE(child_node);
@ -615,26 +618,27 @@ answer_trie_hash:
Hash_num_nodes(hash)++;
count_nodes++;
if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */
ans_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
first_old_bucket = Hash_buckets(hash);
old_bucket = first_old_bucket + Hash_num_buckets(hash);
Hash_num_buckets(hash) *= 2;
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
seed = Hash_seed(hash);
/* expand current hash */
ans_node_ptr chain_node, next_node, *old_bucket, *hash_old_buckets, *hash_new_buckets;
num_buckets = Hash_num_buckets(hash) * 2;
ALLOC_HASH_BUCKETS(hash_new_buckets, num_buckets);
hash_old_buckets = Hash_buckets(hash);
old_bucket = hash_old_buckets + Hash_num_buckets(hash);
do {
if (*--old_bucket) {
chain_node = *old_bucket;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed));
bucket = hash_new_buckets + HASH_ENTRY(TrNode_entry(chain_node), num_buckets);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
chain_node = next_node;
} while (chain_node);
}
} while (old_bucket != first_old_bucket);
FREE_HASH_BUCKETS(first_old_bucket);
} while (old_bucket != hash_old_buckets);
FREE_HASH_BUCKETS(hash_old_buckets);
Hash_buckets(hash) = hash_new_buckets;
Hash_num_buckets(hash) = num_buckets;
}
UNLOCK_ANSWER_NODE(parent_node);
return child_node;
@ -686,7 +690,7 @@ static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node
new_global_trie_hash(hash, count_nodes);
chain_node = child_node;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1));
bucket = Hash_buckets(hash) + HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
@ -705,7 +709,7 @@ static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node
gt_node_ptr *bucket;
int count_nodes = 0;
hash = (gt_hash_ptr) child_node;
bucket = Hash_bucket(hash, HASH_ENTRY(t, Hash_seed(hash)));
bucket = Hash_buckets(hash) + HASH_ENTRY(t, Hash_num_buckets(hash));
child_node = *bucket;
while (child_node) {
if (TrNode_entry(child_node) == t) {
@ -721,26 +725,27 @@ static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node
count_nodes++;
if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */
gt_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
int seed;
first_old_bucket = Hash_buckets(hash);
old_bucket = first_old_bucket + Hash_num_buckets(hash);
Hash_num_buckets(hash) *= 2;
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
seed = Hash_seed(hash);
gt_node_ptr chain_node, next_node, *old_bucket, *hash_old_buckets, *hash_new_buckets;
int num_buckets;
num_buckets = Hash_num_buckets(hash) * 2;
ALLOC_HASH_BUCKETS(hash_new_buckets, num_buckets);
hash_old_buckets = Hash_buckets(hash);
old_bucket = hash_old_buckets + Hash_num_buckets(hash);
do {
if (*--old_bucket) {
chain_node = *old_bucket;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed));
bucket = hash_new_buckets + HASH_ENTRY(TrNode_entry(chain_node), num_buckets);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
chain_node = next_node;
} while (chain_node);
}
} while (old_bucket != first_old_bucket);
FREE_HASH_BUCKETS(first_old_bucket);
} while (old_bucket != hash_old_buckets);
FREE_HASH_BUCKETS(hash_old_buckets);
Hash_buckets(hash) = hash_new_buckets;
Hash_num_buckets(hash) = num_buckets;
}
UNLOCK_GLOBAL_NODE(parent_node);
return child_node;
@ -752,6 +757,7 @@ static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr parent_n
#else
static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node, Term t) {
#endif /* MODE_GLOBAL_TRIE_ENTRY */
CACHE_REGS
gt_node_ptr child_node;
gt_hash_ptr hash;
@ -840,10 +846,10 @@ static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node
if (count_nodes >= MAX_NODES_PER_TRIE_LEVEL) {
/* alloc a new hash */
gt_node_ptr chain_node, next_node, *bucket;
new_answer_trie_hash(hash, count_nodes, sg_fr);
new_global_trie_hash(hash, count_nodes);
chain_node = child_node;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1));
bucket = Hash_buckets(hash) + HASH_ENTRY(TrNode_entry(chain_node), BASE_HASH_BUCKETS);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
@ -861,10 +867,10 @@ static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node
global_trie_hash:
{ /* trie nodes with hashing */
gt_node_ptr *bucket, first_node;
int seed, count_nodes = 0;
int num_buckets, count_nodes = 0;
seed = Hash_seed(hash);
bucket = Hash_bucket(hash, HASH_ENTRY(t, seed));
num_buckets = Hash_num_buckets(hash);
bucket = Hash_buckets(hash) + HASH_ENTRY(t, num_buckets);
first_node = child_node = *bucket;
while (child_node) {
if (TrNode_entry(child_node) == t)
@ -876,7 +882,7 @@ global_trie_hash:
NEW_GLOBAL_TRIE_NODE(child_node, t, NULL, parent_node, first_node);
#endif /* GLOBAL_TRIE_ALLOC_BEFORE_CHECK */
LOCK_GLOBAL_NODE(parent_node);
if (seed != Hash_seed(hash)) {
if (num_buckets != Hash_num_buckets(hash)) {
/* the hash has been expanded */
#ifdef GLOBAL_TRIE_ALLOC_BEFORE_CHECK
FREE_GLOBAL_TRIE_NODE(child_node);
@ -910,25 +916,26 @@ global_trie_hash:
count_nodes++;
if (count_nodes >= MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) {
/* expand current hash */
gt_node_ptr chain_node, next_node, *first_old_bucket, *old_bucket;
first_old_bucket = Hash_buckets(hash);
old_bucket = first_old_bucket + Hash_num_buckets(hash);
Hash_num_buckets(hash) *= 2;
ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash));
seed = Hash_seed(hash);
gt_node_ptr chain_node, next_node, *old_bucket, *hash_old_buckets, *hash_new_buckets;
num_buckets = Hash_num_buckets(hash) * 2;
ALLOC_HASH_BUCKETS(hash_new_buckets, num_buckets);
hash_old_buckets = Hash_buckets(hash);
old_bucket = hash_old_buckets + Hash_num_buckets(hash);
do {
if (*--old_bucket) {
chain_node = *old_bucket;
do {
bucket = Hash_bucket(hash, HASH_ENTRY(TrNode_entry(chain_node), seed));
bucket = hash_new_buckets + HASH_ENTRY(TrNode_entry(chain_node), num_buckets);
next_node = TrNode_next(chain_node);
TrNode_next(chain_node) = *bucket;
*bucket = chain_node;
chain_node = next_node;
} while (chain_node);
}
} while (old_bucket != first_old_bucket);
FREE_HASH_BUCKETS(first_old_bucket);
} while (old_bucket != hash_old_buckets);
FREE_HASH_BUCKETS(hash_old_buckets);
Hash_buckets(hash) = hash_new_buckets;
Hash_num_buckets(hash) = num_buckets;
}
UNLOCK_GLOBAL_NODE(parent_node);
return child_node;

4
include/yap_structs.h
View File

@ -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_CallOnGCRellocate)(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_CallOnGCRellocate rellocate_handler;
} YAP_opaque_handler_t;
/********* execution mode ***********************/

4
misc/LOCALS
View File

@ -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