From f8fdcb325b9cf0f94c6aaffde18cd80f9976138f Mon Sep 17 00:00:00 2001 From: Jan Wielemaker Date: Wed, 1 Jan 2025 11:43:47 +0100 Subject: [PATCH] CLEANUP: Clause indexing code. Split into smaller functions, use `bool` type, avoid `goto`, add more comments, etc. This is a preparation before improvements. --- src/pl-comp.c | 14 +- src/pl-comp.h | 4 +- src/pl-incl.h | 15 +- src/pl-index.c | 678 ++++++++++++++++++++++++++++---------------- src/pl-inline.h | 13 +- src/pl-supervisor.c | 32 +-- src/pl-supervisor.h | 8 +- 7 files changed, 475 insertions(+), 289 deletions(-) diff --git a/src/pl-comp.c b/src/pl-comp.c index 3f4e7f7d8a..83423d655e 100644 --- a/src/pl-comp.c +++ b/src/pl-comp.c @@ -4812,9 +4812,11 @@ machine code. NOTE: this function must be kept consistent with indexOfWord() in pl-index.c. + +@return `true` when argument can be indexed - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -int +bool argKey(Code PC, int skip, word *key) { if ( skip > 0 ) PC = skipArgs(PC, skip); @@ -4887,7 +4889,7 @@ argKey(Code PC, int skip, word *key) case I_SSU_COMMIT: case I_SSU_CHOICE: *key = 0; - fail; + return false; case I_NOP: case I_CHP: continue; @@ -4900,7 +4902,7 @@ argKey(Code PC, int skip, word *key) Sdprintf("Unexpected VM code %" PRIuPTR " at %p\n", c, PC); Sdprintf("\topcode=%s\n", codeTable[c].name); assert(0); - fail; + return false; } } } @@ -4912,7 +4914,7 @@ first argument. This is used by listSupervisor(). This used to share with argKey(), but argKey() is time critical and merging complicates it. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -int +bool arg1Key(Code PC, word *key) { for(;;) { code c = decode(*PC++); @@ -4964,7 +4966,7 @@ arg1Key(Code PC, word *key) case I_SSU_CHOICE: case I_SSU_COMMIT: *key = 0; - fail; + return false; case I_NOP: case I_CHP: continue; @@ -4975,7 +4977,7 @@ arg1Key(Code PC, word *key) #endif default: assert(0); - fail; + return false; } } diff --git a/src/pl-comp.h b/src/pl-comp.h index 40b1f8cb96..e7954546ea 100644 --- a/src/pl-comp.h +++ b/src/pl-comp.h @@ -70,8 +70,8 @@ bool decompileHead(Clause clause, term_t head); int det_goal_error(LocalFrame fr, Code PC, atom_t found); Code skipArgs(Code PC, int skip); -int argKey(Code PC, int skip, word *key); -int arg1Key(Code PC, word *key); +bool argKey(Code PC, int skip, word *key); +bool arg1Key(Code PC, word *key); bool decompile(Clause clause, term_t term, term_t bindings); word pl_nth_clause(term_t p, term_t n, term_t ref, control_t h); diff --git a/src/pl-incl.h b/src/pl-incl.h index fbb6a133f9..3b251d1d10 100644 --- a/src/pl-incl.h +++ b/src/pl-incl.h @@ -1292,6 +1292,8 @@ We assume the compiler will optimise this properly. } \ } +typedef unsigned char iarg_t; /* index argument */ + /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Structure declarations that must be shared across multiple files. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ @@ -1449,7 +1451,6 @@ typedef struct impl_local LocalDefinitions local; /* P_THREAD_LOCAL predicates */ } impl_local, *ImplLocal; - typedef struct clause_list { arg_info *args; /* Meta and indexing info */ ClauseRef first_clause; /* clause list of procedure */ @@ -1458,7 +1459,8 @@ typedef struct clause_list unsigned int number_of_clauses; /* number of associated clauses */ unsigned int erased_clauses; /* number of erased clauses in set */ unsigned int number_of_rules; /* number of real rules */ - unsigned int jiti_tried; /* number of times we tried to find */ + iarg_t jiti_tried; /* number of times we tried to find */ + iarg_t primary_index; /* Index used to link clauses */ } clause_list, *ClauseList; typedef struct clause_ref @@ -1610,12 +1612,10 @@ struct clause_bucket }; #define MAX_MULTI_INDEX 4 -#define MAXINDEXARG 254 +#define MAXINDEXARG 254 /* must fit iarg_t */ #define MAXINDEXDEPTH 7 #define END_INDEX_POS 255 -typedef unsigned char iarg_t; /* index argument */ - struct clause_index { unsigned int buckets; /* # entries */ unsigned int size; /* # clauses */ @@ -1625,6 +1625,7 @@ struct clause_index unsigned is_list : 1; /* Index with lists */ unsigned incomplete : 1; /* Index is incomplete */ unsigned invalid : 1; /* Index is invalid */ + unsigned good : 1; /* Index is (near) perfect */ iarg_t args[MAX_MULTI_INDEX]; /* Indexed arguments */ iarg_t position[MAXINDEXDEPTH+1]; /* Deep index position */ float speedup; /* Estimated speedup */ @@ -1658,10 +1659,6 @@ struct definition #if defined(__SANITIZE_ADDRESS__) char *name; /* Name for debugging */ #endif -#ifdef O_PROF_PENTIUM - int prof_index; /* index in profiling */ - char *prof_name; /* name in profiling */ -#endif }; struct definition_chain diff --git a/src/pl-index.c b/src/pl-index.c index a102ecc06f..7ad0db88e1 100644 --- a/src/pl-index.c +++ b/src/pl-index.c @@ -97,15 +97,22 @@ typedef struct index_context } index_context, *IndexContext; #if USE_LD_MACROS -#define bestHash(av, ac, clist, min_speedup, hints, ctx) LDFUNC(bestHash, av, ac, clist, min_speedup, hints, ctx) -#define setClauseChoice(chp, cref, generation) LDFUNC(setClauseChoice, chp, cref, generation) -#define first_clause_guarded(argv, argc, clist, ctx) LDFUNC(first_clause_guarded, argv, argc, clist, ctx) +#define bestHash(av, ac, clist, min_speedup, hints, ctx) \ + LDFUNC(bestHash, av, ac, clist, min_speedup, hints, ctx) +#define setClauseChoice(chp, cref, generation) \ + LDFUNC(setClauseChoice, chp, cref, generation) +#define first_clause_guarded(argv, argc, clist, ctx) \ + LDFUNC(first_clause_guarded, argv, argc, clist, ctx) +#define find_multi_argument_hash(ac, clist, inst, ninst, msu, hints, ctx) \ + LDFUNC(find_multi_argument_hash, ac, clist, inst, ninst, \ + msu, hints, ctx) #endif /*USE_LD_MACROS*/ #define LDFUNC_DECLARATIONS -static int bestHash(Word av, size_t ac, ClauseList clist, float min_speedup, - hash_hints *hints, IndexContext ctx); +static bool bestHash(Word av, iarg_t ac, ClauseList clist, + float min_speedup, hash_hints *hints, + IndexContext ctx); static ClauseIndex hashDefinition(ClauseList clist, hash_hints *h, IndexContext ctx); static void replaceIndex(Definition def, ClauseList cl, @@ -127,6 +134,10 @@ static Code skipToTerm(Clause clause, const iarg_t *position); static void unalloc_index_array(void *p); static void wait_for_index(const ClauseIndex ci); static void completed_index(ClauseIndex ci); +static bool find_multi_argument_hash(iarg_t ac, ClauseList clist, + iarg_t *inst, int ninst, + float min_speedup, + hash_hints *hints, IndexContext ctx); #undef LDFUNC_DECLARATIONS @@ -145,8 +156,8 @@ NOTE: Indirects should not collide with functor_t to allow for deep indexing. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -static inline int -hashIndex(word key, int buckets) +static inline unsigned int +hashIndex(word key, unsigned int buckets) { unsigned int k = MurmurHashWord(key, MURMUR_SEED); return k & (buckets-1); @@ -266,69 +277,81 @@ argument we are processing. TBD: Keep a flag telling whether there are non-indexable clauses. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -#define nextClauseFromBucket(ci, argv, ctx) LDFUNC(nextClauseFromBucket, ci, argv, ctx) +#define nextClauseFromList(ci, argv, ctx) \ + LDFUNC(nextClauseFromList, ci, argv, ctx) + static ClauseRef -nextClauseFromBucket(DECL_LD ClauseIndex ci, Word argv, IndexContext ctx) +nextClauseFromList(DECL_LD ClauseIndex ci, Word argv, IndexContext ctx) { ClauseRef cref; word key = ctx->chp->key; - if ( ci->is_list ) - { DEBUG(MSG_INDEX_FIND, Sdprintf("Searching for %s\n", keyName(key))); - - assert(ci->args[1] == 0); + DEBUG(MSG_INDEX_FIND, Sdprintf("Searching for %s\n", keyName(key))); + assert(ci->is_list); + assert(ci->args[1] == 0); - non_indexed: - for(cref = ctx->chp->cref; cref; cref = cref->next) - { if ( cref->d.key == key ) - { ClauseList cl = &cref->value.clauses; - ClauseRef cr; +non_indexed: + for(cref = ctx->chp->cref; cref; cref = cref->next) + { if ( cref->d.key == key ) + { ClauseList cl = &cref->value.clauses; + ClauseRef cr; - DEBUG(MSG_INDEX_DEEP, Sdprintf("Deep index for %s\n", keyName(key))); + DEBUG(MSG_INDEX_DEEP, Sdprintf("Deep index for %s\n", keyName(key))); - if ( isFunctor(cref->d.key) && ctx->depth < MAXINDEXDEPTH ) - { int an = ci->args[0]-1; - Word a = argv+an; - Functor at; - size_t argc; + if ( isFunctor(cref->d.key) && ctx->depth < MAXINDEXDEPTH ) + { int an = ci->args[0]-1; + Word a = argv+an; + Functor at; + size_t argc; - deRef(a); - assert(isTerm(*a)); - at = valueTerm(*a); - argv = at->arguments; - argc = arityFunctor(at->definition); + deRef(a); + assert(isTerm(*a)); + at = valueTerm(*a); + argv = at->arguments; + argc = arityFunctor(at->definition); - ctx->position[ctx->depth++] = (iarg_t)an; - ctx->position[ctx->depth] = END_INDEX_POS; + ctx->position[ctx->depth++] = (iarg_t)an; + ctx->position[ctx->depth] = END_INDEX_POS; - DEBUG(MSG_INDEX_DEEP, - Sdprintf("Recursive index for %s at level %d\n", - keyName(cref->d.key), ctx->depth)); - return first_clause_guarded(argv, argc, cl, ctx); - } + DEBUG(MSG_INDEX_DEEP, + Sdprintf("Recursive index for %s at level %d\n", + keyName(cref->d.key), ctx->depth)); + return first_clause_guarded(argv, argc, cl, ctx); + } - ctx->chp->key = 0; /* See (*) */ - for(cr=cl->first_clause; cr; cr=cr->next) - { if ( visibleClauseCNT(cr->value.clause, ctx->generation) ) - { setClauseChoice(ctx->chp, cr->next, ctx->generation); - return cr; - } + ctx->chp->key = 0; /* See (*) */ + for(cr=cl->first_clause; cr; cr=cr->next) + { if ( visibleClauseCNT(cr->value.clause, ctx->generation) ) + { setClauseChoice(ctx->chp, cr->next, ctx->generation); + return cr; } - - return NULL; } - } - if ( key ) - { key = 0; - DEBUG(MSG_INDEX_FIND, Sdprintf("Not found; trying non-indexed\n")); - goto non_indexed; - } else - { DEBUG(MSG_INDEX_FIND, Sdprintf("Not found\n")); + return NULL; } + } - return NULL; + if ( key ) + { key = 0; + DEBUG(MSG_INDEX_FIND, Sdprintf("Not found; trying non-indexed\n")); + goto non_indexed; + } else + { DEBUG(MSG_INDEX_FIND, Sdprintf("Not found\n")); } + return NULL; +} + +#define nextClauseFromBucket(ci, argv, ctx) \ + LDFUNC(nextClauseFromBucket, ci, argv, ctx) + +static ClauseRef +nextClauseFromBucket(DECL_LD ClauseIndex ci, Word argv, IndexContext ctx) +{ ClauseRef cref; + word key = ctx->chp->key; + + if ( unlikely(ci->is_list) ) + return nextClauseFromList(ci, argv, ctx); + for(cref = ctx->chp->cref; cref; cref = cref->next) { if ( (!cref->d.key || key == cref->d.key) && visibleClauseCNT(cref->value.clause, ctx->generation)) @@ -360,7 +383,7 @@ nextClauseFromBucket(DECL_LD ClauseIndex ci, Word argv, IndexContext ctx) is free for CGC. */ -static void +static inline void setClauseChoice(DECL_LD ClauseChoice chp, ClauseRef cref, gen_t generation) { while ( cref && !visibleClauseCNT(cref->value.clause, generation) ) cref = cref->next; @@ -412,6 +435,97 @@ iargsName(const iarg_t args[MAX_MULTI_INDEX], char *buf) } #endif +// If we got an index use this to see whether we should +// try finding a better one because it is poor +static bool +consider_better_index(ClauseIndex const ci, unsigned int nclauses) +{ return ( nclauses > MIN_CLAUSES_FOR_INDEX && + (float)nclauses/ci->speedup > MIN_SPEEDUP_RATIO ); +} + +static ClauseIndex +existing_hash(ClauseIndex *cip, const Word argv, Word keyp) +{ for(; *cip; cip++) + { ClauseIndex ci = *cip; + word k; + + if ( ISDEADCI(ci) ) + continue; + + if ( (k=indexKeyFromArgv(ci, argv)) ) + { *keyp = k; + return ci; + } + } + + return NULL; +} + +/* Add a new index to the clause list if it provides a speedup of at + * least `min_speedup`. This is called if the best index is "poor" or + * linear primary clause index scanning does not work because there + * are too many clauses or the argument is not instantiated. + * + * We call bestHash() to find the best possible index. Next, + * hashDefinition() first checks whether this index already exists and + * creates it otherwise. + * + * Return: + * - CI_RETRY + * Someone invalidated the index while we were building it or + * waiting for a thread to complete it. + * - NULL + * There is no better index possible + * - A ClauseIndex + * All went fine + */ + +#define CI_RETRY ((ClauseIndex)1) + +#define createIndex(av, ac, clist, min_speedup, ctx) \ + LDFUNC(createIndex, av, ac, clist, min_speedup, ctx) + +static ClauseIndex +createIndex(DECL_LD Word argv, iarg_t argc, const ClauseList clist, + float min_speedup, IndexContext ctx) +{ hash_hints hints; + + if ( bestHash(argv, argc, clist, min_speedup, &hints, ctx) ) + { ClauseIndex ci; + + if ( (ci=hashDefinition(clist, &hints, ctx)) ) + { while ( ci->incomplete ) + wait_for_index(ci); + if ( ci->invalid ) + return CI_RETRY; + + return ci; + } + + return CI_RETRY; + } + + return NULL; +} + +#define first_clause_unindexed(clist, ctx) \ + LDFUNC(first_clause_unindexed, clist, ctx) + +static ClauseRef +first_clause_unindexed(DECL_LD const ClauseList clist, const IndexContext ctx) +{ for(ClauseRef cref = clist->first_clause; cref; cref = cref->next) + { if ( visibleClauseCNT(cref->value.clause, ctx->generation) ) + { ClauseChoice chp = ctx->chp; + + chp->key = 0; + setClauseChoice(chp, cref->next, ctx->generation); + return cref; + } + } + + return NULL; +} + /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - firstClause() finds the first applicable clause and leave information for finding the next clause in chp. @@ -428,72 +542,56 @@ first_clause_guarded(DECL_LD Word argv, size_t argc, ClauseList clist, IndexContext ctx) { ClauseRef cref; ClauseIndex *cip; - hash_hints hints; ClauseChoice chp = ctx->chp; -#define STATIC_RELOADING() (LD->reload.generation && isoff(ctx->predicate, P_DYNAMIC)) +#define STATIC_RELOADING() (LD->reload.generation && \ + isoff(ctx->predicate, P_DYNAMIC)) if ( unlikely(argc == 0) ) - goto simple; /* TBD: alt supervisor */ + return first_clause_unindexed(clist, ctx); + if ( unlikely(argc > MAXINDEXARG) ) argc = MAXINDEXARG; retry: - if ( (cip=clist->clause_indexes) ) - { ClauseIndex best_index = NULL; - - for(; *cip; cip++) - { ClauseIndex ci = *cip; - word k; - - if ( ISDEADCI(ci) ) - continue; + while ( (cip=clist->clause_indexes) ) + { ClauseIndex best_index; - if ( (k=indexKeyFromArgv(ci, argv)) ) - { best_index = ci; - chp->key = k; - break; - } - } + best_index = existing_hash(cip, argv, &chp->key); if ( best_index ) - { int hi; - - if ( clist->number_of_clauses > MIN_CLAUSES_FOR_INDEX && - (float)clist->number_of_clauses/best_index->speedup > MIN_SPEEDUP_RATIO && - !STATIC_RELOADING() ) - { DEBUG(MSG_JIT_POOR, - Sdprintf("Poor index %s of %s (trying to find better)\n", - iargsName(best_index->args, NULL), - predicateName(ctx->predicate))); - - if ( bestHash(argv, argc, clist, best_index->speedup, - &hints, ctx) ) + { if ( unlikely(!best_index->good) ) + { if ( !STATIC_RELOADING() && + consider_better_index(best_index, clist->number_of_clauses) ) { ClauseIndex ci; - DEBUG(MSG_JIT, Sdprintf("[%d] Found better at args %s\n", - PL_thread_self(), - iargsName(hints.args, NULL))); + DEBUG(MSG_JIT_POOR, + Sdprintf("Poor index %s of %s (trying to find better)\n", + iargsName(best_index->args, NULL), + predicateName(ctx->predicate))); - if ( (ci=hashDefinition(clist, &hints, ctx)) ) - { chp->key = indexKeyFromArgv(ci, argv); + if ( (ci=createIndex(argv, argc, clist, best_index->speedup, ctx)) ) + { if ( unlikely(ci == CI_RETRY) ) + continue; + + chp->key = indexKeyFromArgv(ci, argv); assert(chp->key); best_index = ci; - } else - { goto retry; } } - } - if ( best_index->incomplete ) - { wait_for_index(best_index); - goto retry; + if ( best_index->incomplete ) + { wait_for_index(best_index); + continue; + } } - hi = hashIndex(chp->key, best_index->buckets); + unsigned int hi = hashIndex(chp->key, best_index->buckets); chp->cref = best_index->entries[hi].head; return nextClauseFromBucket(best_index, argv, ctx); } + + break; } if ( unlikely(clist->number_of_clauses == 0) ) @@ -506,8 +604,10 @@ first_clause_guarded(DECL_LD Word argv, size_t argc, ClauseList clist, * search for other indexes. */ - if ( (chp->key = indexOfWord(argv[0])) && - (clist->number_of_clauses <= MIN_CLAUSES_FOR_INDEX || STATIC_RELOADING()) ) + iarg_t pindex = clist->primary_index; + if ( (chp->key = indexOfWord(argv[pindex])) && + ( clist->number_of_clauses <= MIN_CLAUSES_FOR_INDEX || + STATIC_RELOADING()) ) { chp->cref = clist->first_clause; cref = nextClauseArg1(chp, ctx->generation); @@ -517,50 +617,39 @@ first_clause_guarded(DECL_LD Word argv, size_t argc, ClauseList clist, return cref; /* else duplicate; see whether we can create a deep index */ /* TBD: Avoid trying this every goal */ - } + } else + cref = NULL; - if ( !STATIC_RELOADING() && - bestHash(argv, argc, clist, 0.0, &hints, ctx) ) + if ( !STATIC_RELOADING() ) { ClauseIndex ci; - if ( (ci=hashDefinition(clist, &hints, ctx)) ) - { int hi; - - while ( ci->incomplete ) - wait_for_index(ci); - if ( ci->invalid ) + if ( (ci=createIndex(argv, argc, clist, 0.0, ctx)) ) + { if ( unlikely(ci == CI_RETRY) ) goto retry; chp->key = indexKeyFromArgv(ci, argv); assert(chp->key); - hi = hashIndex(chp->key, ci->buckets); + unsigned int hi = hashIndex(chp->key, ci->buckets); chp->cref = ci->entries[hi].head; return nextClauseFromBucket(ci, argv, ctx); - } else - { goto retry; } } if ( chp->key ) - { chp->cref = clist->first_clause; - return nextClauseArg1(chp, ctx->generation); - } + { if ( cref ) + return cref; -simple: - for(cref = clist->first_clause; cref; cref = cref->next) - { if ( visibleClauseCNT(cref->value.clause, ctx->generation) ) - { chp->key = 0; - setClauseChoice(chp, cref->next, ctx->generation); - break; - } + chp->cref = clist->first_clause; + return nextClauseArg1(chp, ctx->generation); } - return cref; + return first_clause_unindexed(clist, ctx); } ClauseRef -firstClause(DECL_LD Word argv, LocalFrame fr, Definition def, ClauseChoice chp) +firstClause(DECL_LD Word argv, LocalFrame fr, Definition def, + ClauseChoice chp) { ClauseRef cref; index_context ctx; @@ -1661,7 +1750,7 @@ hashDefinition(ClauseList clist, hash_hints *hints, IndexContext ctx) iargsName(hints->args, NULL), 2<ln_buckets, hints->list ? "lists" : "clauses")); -#if defined(O_PLMT) && !defined(NDEBUG) +#if defined(O_PLMT) && defined(O_DEBUG) { GET_LD assert(LD->thread.info->access.predicate == ctx->predicate); } @@ -1712,6 +1801,8 @@ See the test_cgc_1 test case in src/Tests/GC/test_cgc_1.pl ci->resize_below = ci->size/4; completed_index(ci); + if ( !consider_better_index(ci, clist->number_of_clauses) ) + ci->good = true; /* `good` means complete and sufficient */ return ci; } @@ -2200,11 +2291,15 @@ best_hash_assessment(const void *p1, const void *p2, void *ctx) const arg_info *i1 = &clist->args[*a1]; const arg_info *i2 = &clist->args[*a2]; - return i1->speedup - i2->speedup > 0 ? -1 : - i1->speedup - i2->speedup < 0 ? 1 : 0; + return i1->speedup - i2->speedup > 0.0 ? -1 : + i1->speedup - i2->speedup < 0.0 ? 1 : 0; } +/* Sort assessments, represented by their argument position on + * `clist` by decreasing speedup, i.e., best first. + */ + static void sort_assessments(ClauseList clist, iarg_t *instantiated, int ninstantiated) @@ -2233,9 +2328,12 @@ going into the recursive indexes we loose the context to find the unbound clause. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -static int +static bool assess_remove_duplicates(hash_assessment *a, size_t clause_count) -{ if ( !a->keys ) +{ a->speedup = 0.0; + a->list = false; + + if ( !a->keys ) return false; key_asm *s = a->keys; @@ -2246,8 +2344,6 @@ assess_remove_duplicates(hash_assessment *a, size_t clause_count) size_t i = 0; float A=0.0, Q=0.0; - a->speedup = 0.0; - qsort(a->keys, a->size, sizeof(key_asm), compar_keys); for( ; skey != c ) @@ -2437,21 +2533,31 @@ indexableCompound(Code pc) } +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +Access a number of arguments on their suitability for a set of clauses. + +@param ac is the highest argument considered. This is max(arity,MAXINDEXARG) +@param hash_assessment holds the assessments we want to establish. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + static void -assess_scan_clauses(ClauseList clist, size_t arity, +assess_scan_clauses(ClauseList clist, iarg_t ac, hash_assessment *assessments, int assess_count, IndexContext ctx) { hash_assessment *a; ClauseRef cref; int i; - bit_vector *ai = alloca(sizeof_bitvector(arity)); + bit_vector *ai = alloca(sizeof_bitvector(ac)); int kp[MAXINDEXARG+1]; /* key-arg positions */ int nk = 0; /* number of key args */ int *kpp; word keys[MAXINDEXARG]; char nvcomp[MAXINDEXARG]; - init_bitvector(ai, arity); + /* Find the arguments we must check. Assessments may be for + multiple arguments. + */ + init_bitvector(ai, ac); for(i=0, a=assessments; ifirst_clause; cref; cref=cref->next) { Clause cl = cref->value.clause; Code pc; @@ -2476,8 +2585,9 @@ assess_scan_clauses(ClauseList clist, size_t arity, if ( ison(cl, CL_ERASED) ) continue; - pc = skipToTerm(cref->value.clause, ctx->position); + pc = skipToTerm(cl, ctx->position); + /* fill keys[i] with the value of arg kp[i] */ for(kpp=kp; kpp[0] >= 0; kpp++) { if ( kpp[0] > carg ) pc = skipArgs(pc, kpp[0]-carg); @@ -2497,26 +2607,25 @@ assess_scan_clauses(ClauseList clist, size_t arity, int an = a->args[0]-1; if ( (key=keys[an]) ) - { assessAddKey(a, key, nvcomp[an]); - } else - { a->var_count++; - goto next_assessment; - } + assessAddKey(a, key, nvcomp[an]); + else + a->var_count++; } else /* multi-argument index */ { word key[MAX_MULTI_INDEX]; int harg; + bool isvar = false; for(harg=0; a->args[harg]; harg++) { if ( !(key[harg] = keys[a->args[harg]-1]) ) - { a->var_count++; - goto next_assessment; + { isvar = true; + break; } } - - assessAddKey(a, murmur_key(key, sizeof(word)*harg), false); + if ( isvar ) + a->var_count++; + else + assessAddKey(a, murmur_key(key, sizeof(word)*harg), false); } - next_assessment: - ; } } } @@ -2539,6 +2648,49 @@ best_assessment(hash_assessment *assessments, int count, size_t clause_count) return best; } +/* Update clist->args[i] for each candidate index in `aset`. This fills + * the argument's `ainfo` struct with the speedup, size and whether or not + * a "list" index should be created" + */ + +static void +access_candidate_indexes(iarg_t ac, ClauseList clist, assessment_set *aset, + IndexContext ctx) +{ hash_assessment *a; + int i; + + assess_scan_clauses(clist, ac, aset->assessments, aset->count, ctx); + + for(i=0, a=aset->assessments; icount; i++, a++) + { arg_info *ainfo = &clist->args[a->args[0]-1]; + + if ( assess_remove_duplicates(a, clist->number_of_clauses) ) + { DEBUG(MSG_JIT, + Sdprintf("Assess index %s of %s: speedup %f, stdev=%f\n", + iargsName(a->args, NULL), + predicateName(ctx->predicate), + a->speedup, a->stdev)); + + ainfo->speedup = a->speedup; + ainfo->list = a->list; + ainfo->ln_buckets = MSB(a->size)&0x1f; + } else + { ainfo->speedup = 0.0; + ainfo->list = false; + ainfo->ln_buckets = 0; + + DEBUG(MSG_JIT, Sdprintf("Assess index %s of %s: not indexable\n", + iargsName(a->args, NULL), + predicateName(ctx->predicate))); + } + + ainfo->assessed = true; + + if ( a->keys ) + free(a->keys); + } +} + /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - bestHash() finds the best argument for creating a hash, given a concrete @@ -2562,20 +2714,26 @@ expected speedup is *hints. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -static int -bestHash(DECL_LD Word av, size_t ac, ClauseList clist, float min_speedup, +static bool +bestHash(DECL_LD Word av, iarg_t ac, ClauseList clist, float min_speedup, hash_hints *hints, IndexContext ctx) -{ int i; - assessment_set aset; - hash_assessment *a; +{ assessment_set aset; int best = -1; float best_speedup = 0.0; iarg_t ia[MAX_MULTI_INDEX] = {0}; iarg_t *instantiated; int ninstantiated = 0; + /* Step 1: find instantiated args */ instantiated = alloca(ac*sizeof(*instantiated)); - init_assessment_set(&aset); + for(iarg_t i=0; iargs ) { arg_info *ai = allocHeapOrHalt(ac*sizeof(*ai)); memset(ai, 0, ac*sizeof(*ai)); @@ -2583,60 +2741,24 @@ bestHash(DECL_LD Word av, size_t ac, ClauseList clist, float min_speedup, freeHeap(ai, ac*sizeof(*ai)); } - /* Step 1: find instantiated args */ - for(i=0; iargs[arg].assessed ) - { ia[0] = (iarg_t)(arg+1); + { ia[0] = arg+1; alloc_assessment(&aset, ia); } } if ( aset.count ) /* Step 3: assess them */ - { assess_scan_clauses(clist, ac, aset.assessments, aset.count, ctx); - - for(i=0, a=aset.assessments; iargs[a->args[0]-1]; - - if ( assess_remove_duplicates(a, clist->number_of_clauses) ) - { DEBUG(MSG_JIT, - Sdprintf("Assess index %s of %s: speedup %f, stdev=%f\n", - iargsName(a->args, NULL), - predicateName(ctx->predicate), - a->speedup, a->stdev)); - - ainfo->speedup = a->speedup; - ainfo->list = a->list; - ainfo->ln_buckets = MSB(a->size)&0x1f; - } else - { ainfo->speedup = 0.0; - ainfo->list = false; - ainfo->ln_buckets = 0; - - DEBUG(MSG_JIT, Sdprintf("Assess index %s of %s: not indexable\n", - iargsName(a->args, NULL), - predicateName(ctx->predicate))); - } - - ainfo->assessed = true; - - if ( a->keys ) - free(a->keys); - } - + { access_candidate_indexes(ac, clist, &aset, ctx); free_assessment_set(&aset); } - /* Step 4: find the best (single) arg */ - for(i=0; iargs[arg]; if ( ainfo->speedup > best_speedup ) @@ -2645,73 +2767,140 @@ bestHash(DECL_LD Word av, size_t ac, ClauseList clist, float min_speedup, } } - if ( best >= 0 && - (float)clist->number_of_clauses/best_speedup > 3 ) - { int ok, m, n; - - sort_assessments(clist, instantiated, ninstantiated); - for( ok=0; - okargs[instantiated[ok]].speedup > MIN_SPEEDUP; - ok++ ) - ; - - if ( ok >= 2 && ++clist->jiti_tried <= ac ) - { hash_assessment *nbest; - - DEBUG(MSG_JIT, Sdprintf("%s: %zd clauses, index [%d]: speedup = %f" - "; %d promising arguments\n", + if ( best >= 0 ) /* Found at least one index */ + { if ( (float)clist->number_of_clauses/best_speedup > 3.0f && + ninstantiated > 1 ) /* ... but not a real good one ... */ + { DEBUG(MSG_JIT, Sdprintf("%s: %zd clauses, index [%d]: speedup = %f" + "; trying multi-argument index\n", predicateName(ctx->predicate), clist->number_of_clauses, - best+1, best_speedup, ok)); - - init_assessment_set(&aset); - for(m=1; mnumber_of_clauses); - if ( nbest && nbest->speedup > best_speedup*MIN_SPEEDUP ) - { DEBUG(MSG_JIT, Sdprintf("%s: using index %s, speedup = %f\n", - predicateName(ctx->predicate), - iargsName(nbest->args, NULL), - nbest->speedup)); - memset(hints, 0, sizeof(*hints)); - memcpy(hints->args, nbest->args, sizeof(nbest->args)); - hints->ln_buckets = MSB(nbest->size); - hints->speedup = nbest->speedup; - - free_keys_in_assessment_set(&aset); - free_assessment_set(&aset); + if ( find_multi_argument_hash(ac, clist, instantiated, ninstantiated, + best_speedup*MIN_SPEEDUP, hints, ctx) ) return true; + } + + if ( best_speedup > min_speedup ) + { arg_info *ainfo = &clist->args[best]; + + memset(hints, 0, sizeof(*hints)); + hints->args[0] = (iarg_t)(best+1); + hints->ln_buckets = ainfo->ln_buckets; + hints->speedup = ainfo->speedup; + hints->list = ainfo->list; + + return true; + } + } + + return false; +} + + + +static bool +find_multi_argument_hash(DECL_LD iarg_t ac, ClauseList clist, + iarg_t *instantiated, int ninstantiated, + float min_speedup, + hash_hints *hints, IndexContext ctx) +{ int ok, m, n; + + sort_assessments(clist, instantiated, ninstantiated); + for( ok=0; + okargs[instantiated[ok]].speedup > MIN_SPEEDUP; + ok++ ) + ; + + DEBUG(MSG_JIT, Sdprintf(" found %d candidate arguments\n", ok)); + + if ( ok >= 2 && clist->jiti_tried <= ac ) + { assessment_set aset; + iarg_t ia[MAX_MULTI_INDEX] = {0}; + hash_assessment *nbest; + + clist->jiti_tried++; + init_assessment_set(&aset); + for(m=1; mnumber_of_clauses); + if ( nbest && nbest->speedup > min_speedup ) + { DEBUG(MSG_JIT, Sdprintf("%s: using index %s, speedup = %f\n", + predicateName(ctx->predicate), + iargsName(nbest->args, NULL), + nbest->speedup)); + memset(hints, 0, sizeof(*hints)); + memcpy(hints->args, nbest->args, sizeof(nbest->args)); + hints->ln_buckets = MSB(nbest->size); + hints->speedup = nbest->speedup; + free_keys_in_assessment_set(&aset); free_assessment_set(&aset); + return true; } + free_keys_in_assessment_set(&aset); + free_assessment_set(&aset); } - if ( best >= 0 && best_speedup > min_speedup ) - { arg_info *ainfo = &clist->args[best]; + return false; +} + - memset(hints, 0, sizeof(*hints)); - hints->args[0] = (iarg_t)(best+1); - hints->ln_buckets = ainfo->ln_buckets; - hints->speedup = ainfo->speedup; - hints->list = ainfo->list; + /******************************* + * DEFAULT INDEX ARG * + *******************************/ + +static void +modify_primary_index_arg(Definition def, iarg_t an) +{ ClauseList clist = &def->impl.clauses; + + if ( clist->primary_index != an ) + { for(ClauseRef cref = clist->first_clause; + cref; + cref=cref->next) + { Clause cl = cref->value.clause; - return true; + argKey(cl->codes, an, &cref->d.key); + } + + clist->primary_index = an; } +} - return false; +static +PRED_IMPL("$index", 2, index, PL_FA_TRANSPARENT) +{ Procedure proc; + int an; + + if ( !get_procedure(A1, &proc, 0, GP_DEFINE|GP_NAMEARITY) ) + return false; + Definition def = proc->definition; + ClauseList clist = &def->impl.clauses; + + if ( PL_is_variable(A2) ) + return PL_unify_integer(A2, clist->primary_index); + + if ( !PL_get_integer_ex(A2, &an) ) + return false; + if ( an < 1 || an > def->functor->arity || an > MAXINDEXARG ) + return PL_domain_error("arity", A2); + + modify_primary_index_arg(def, an-1); + + return true; } + /******************************* * PREDICATE PROPERTY SUPPORT * *******************************/ @@ -2925,4 +3114,5 @@ initClauseIndexing(void) *******************************/ BeginPredDefs(index) + PRED_DEF("$index", 2, index, PL_FA_TRANSPARENT) EndPredDefs diff --git a/src/pl-inline.h b/src/pl-inline.h index 70171d1e46..d20868ba2a 100644 --- a/src/pl-inline.h +++ b/src/pl-inline.h @@ -592,7 +592,7 @@ linkValI(Word p) } #define is_signalled(_) LDFUNC(is_signalled, _) -static inline int +static inline bool is_signalled(DECL_LD) { sigmask_t msk = 0; @@ -620,8 +620,15 @@ register_attvar(DECL_LD Word gp) LD->attvar.attvars = gp; } +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +True when clause is visible at generation. This notably needs to be +critically aligned with committing or discarding transactions. These +operations update cl->generation.erased and next +cl->generation.created. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + #define visibleClause(cl, gen) LDFUNC(visibleClause, cl, gen) -static inline int +static inline bool visibleClause(DECL_LD Clause cl, gen_t gen) { gen_t c, e; @@ -645,7 +652,7 @@ visibleClause(DECL_LD Clause cl, gen_t gen) } #define visibleClauseCNT(cl, gen) LDFUNC(visibleClauseCNT, cl, gen) -static inline int +static inline bool visibleClauseCNT(DECL_LD Clause cl, gen_t gen) { if ( likely(visibleClause(cl, gen)) ) return true; diff --git a/src/pl-supervisor.c b/src/pl-supervisor.c index 4195b587cf..68ed9b5c57 100644 --- a/src/pl-supervisor.c +++ b/src/pl-supervisor.c @@ -3,7 +3,7 @@ Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (c) 2008-2022, University of Amsterdam + Copyright (c) 2008-2024, University of Amsterdam VU University Amsterdam SWI-Prolog Solutions b.v. All rights reserved. @@ -125,12 +125,7 @@ DET code: I_FOPEN, I_FCALLDETVA|I_FCALLDET, I_FEXITDET NDET code: I_FOPENNDET, I_FCALLNDETVA|I_FCALLNDET, I_FEXITNDET, I_FREDO - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -#ifdef O_PROF_PENTIUM -#include "pentium.h" -static int prof_foreign_index = (I_HIGHEST+20); -#endif - -int +bool createForeignSupervisor(Definition def, Func f) { assert(ison(def, P_FOREIGN)); @@ -169,13 +164,7 @@ createForeignSupervisor(Definition def, Func f) def->codes = codes; } -#ifdef O_PROF_PENTIUM - assert(prof_foreign_index < MAXPROF); - def->prof_index = prof_foreign_index++; - def->prof_name = strdup(predicateName(def)); -#endif - - succeed; + return true; } @@ -412,7 +401,7 @@ chainPredicateSupervisor(Definition def, Code post) * ENTRIES * *******************************/ -int +bool createUndefSupervisor(Definition def) { Code codes; @@ -464,11 +453,11 @@ setSupervisor(Definition def, Code codes) /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - setDefaultSupervisor() is synchronised with unloadFile() (reconsult/1). -Seems this is not yet enough to stop all racer conditions between this +Seems this is not yet enough to stop all race conditions between this code. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -int +bool setDefaultSupervisor(Definition def) { if ( isoff(def, P_LOCKED_SUPERVISOR) ) { Code codes, old; @@ -535,10 +524,11 @@ ends in I_EXIT, such that generic code walkers will always find the end of the sequence. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -#define MAKE_SV1(name, i) { PL_code_data.supervisors.name[0] = (code)0; \ - PL_code_data.supervisors.name[1] = encode(i); \ - PL_code_data.supervisors.name[2] = encode(I_EXIT); \ - } +#define MAKE_SV1(name, i) \ + { PL_code_data.supervisors.name[0] = (code)0; \ + PL_code_data.supervisors.name[1] = encode(i); \ + PL_code_data.supervisors.name[2] = encode(I_EXIT); \ + } void initSupervisors(void) diff --git a/src/pl-supervisor.h b/src/pl-supervisor.h index 5179784150..59fd24585b 100644 --- a/src/pl-supervisor.h +++ b/src/pl-supervisor.h @@ -3,7 +3,7 @@ Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (c) 2008-2021, University of Amsterdam + Copyright (c) 2008-2024, University of Amsterdam VU University Amsterdam SWI-Prolog Solutions b.v. All rights reserved. @@ -42,10 +42,10 @@ Code allocCodes(size_t len); void freeCodesDefinition(Definition def, int linger); void freeSupervisor(Definition def, Code code, int linger); -int createForeignSupervisor(Definition def, Func f); -int createUndefSupervisor(Definition def); +bool createForeignSupervisor(Definition def, Func f); +bool createUndefSupervisor(Definition def); Code createSupervisor(Definition def); -int setDefaultSupervisor(Definition def); +bool setDefaultSupervisor(Definition def); void setSupervisor(Definition def, Code codes); size_t sizeof_supervisor(Code base); size_t supervisorLength(Code base);