diff --git a/C/cdmgr.c b/C/cdmgr.c index a11be27cb..5a0d141f5 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -906,14 +906,14 @@ addclause(Term t, yamop *cp, int mode, int mod) p->PredFlags |= CompiledPredFlag | FastPredFlag; else p->PredFlags |= CompiledPredFlag; - if ((Yap_GetValue(AtomIndex) != TermNil) && - (p->cs.p_code.FirstClause != NIL) && - (Arity != 0)) { + if (yap_flags[INDEXING_MODE_FLAG] != INDEX_MODE_OFF && + p->cs.p_code.FirstClause != NULL && + Arity != 0) { p->OpcodeOfPred = INDEX_OPCODE; p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } } - if (p->cs.p_code.FirstClause == NIL) { + if (p->cs.p_code.FirstClause == NULL) { if (!(p->PredFlags & DynamicPredFlag)) { add_first_static(p, cp, spy_flag); /* make sure we have a place to jump to */ diff --git a/C/exec.c b/C/exec.c index bec5a1baa..21ebaef95 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1552,7 +1552,6 @@ Yap_InitYaamRegs(void) Yap_regp = &Yap_standard_regs; #endif /* PUSH_REGS */ Yap_PutValue (AtomBreak, MkIntTerm (0)); - Yap_PutValue (AtomIndex, MkAtomTerm (AtomTrue)); AuxSp = (CELL *)AuxTop; TR = (tr_fr_ptr)Yap_TrailBase; #ifdef COROUTINING diff --git a/C/index.c b/C/index.c index 14a078714..c4e25fc82 100644 --- a/C/index.c +++ b/C/index.c @@ -88,102 +88,209 @@ smaller(Term t1, Term t2) } } +static inline int +smaller_or_eq(Term t1, Term t2) +{ + if (IsVarTerm(t1)) { + if (!IsVarTerm(t2)) return TRUE; + return (t1 <= t2); + } else if (IsIntTerm(t1)) { + if (IsVarTerm(t2)) return FALSE; + if (!IsIntTerm(t2)) return TRUE; + return (IntOfTerm(t1) <= IntOfTerm(t2)); + } else if (IsAtomTerm(t1)) { + if (IsVarTerm(t2) || IsIntTerm(t2)) return FALSE; + if (IsApplTerm(t2) || IsPairTerm(t2)) return TRUE; + return (t1 <= t2); + } else if (IsApplTerm(t1)) { + if (IsVarTerm(t2) || IsAtomTerm(t2) || IsIntTerm(t2)) return FALSE; + if (IsPairTerm(t2)) return TRUE; + return (t1 <= t2); + } else /* if (IsPairTerm(t1)) */ { + return FALSE; + } +} + static inline void clcpy(ClauseDef *d, ClauseDef *s) { memcpy((void *)d, (void *)s, sizeof(ClauseDef)); } -/* - original code from In Hyuk Choi, - found at http://userpages.umbc.edu/~ichoi1/project/cs441.htm -*/ - -static inline void -exchange(ClauseDef b[], Int i, Int j) -{ - ClauseDef t; - - clcpy(&t, b+j); - clcpy(b+j, b+i); - clcpy(b+i, &t); -} - -static UInt -partition(ClauseDef a[], Int p, Int r) -{ - Term x; - UInt i, j; - - x = a[p].Tag; - i = p+1; - j = r; - - while (smaller(x,a[j].Tag) && i < j) { - j--; - } - while (smaller(a[i].Tag, x) && i < j) { - i++; - } - while(i < j) { - exchange(a, i, j); - i++; - j--; - while (smaller(x, a[j].Tag) && i < j) { - j--; - } - while (smaller(a[i].Tag, x) && i < j) { - i++; - } - } - if (smaller(x, a[i].Tag)) - i--; - exchange(a, p, i); - return(i); -} - static void -insort(ClauseDef a[], Int p, Int q) +insort(ClauseDef base[], CELL *p, CELL *q, int my_p) { - Int j; + CELL *j; + + if (my_p) { + p[1] = p[0]; + for (j = p+2; j < q; j += 2) { + Term key; + Int off = *j; + CELL *i; + + key = base[off].Tag; + i = j+1; - for (j = p+1; j <= q; j ++) { - ClauseDef key; - Int i; - - clcpy(&key, a+j); - i = j; - - while (i > p && smaller(key.Tag,a[i-1].Tag)) { - clcpy(a+i, a+(i-1)); - i --; + /* we are at offset 1 */ + while (i > p+1 && smaller(key,base[i[-2]].Tag)) { + i[0] = i[-2]; + i -= 2; + } + i[0] = off; + } + } else { + for (j = p+2; j < q; j += 2) { + Term key; + Int off = *j; + CELL *i; + + key = base[off].Tag; + i = j; + + /* we are at offset 1 */ + while (i > p && smaller(key,base[i[-2]].Tag)) { + i[0] = i[-2]; + i -= 2; + } + i[0] = off; } - clcpy(a+i, &key); } } -static void -quicksort(ClauseDef a[], Int p, Int r) -{ - Int q; - if (p < r) { - if (r - p < 100) { - insort(a, p, r); - return; +/* copy to a new list of terms */ +static +void msort(ClauseDef *base, Int *pt, Int size, int my_p) +{ + + if (size > 2) { + Int half_size = size / 2; + Int *pt_left, *pt_right, *end_pt, *end_pt_left; + int left_p, right_p; + + if (size < 50) { + insort(base, pt, pt+2*size, my_p); + return; } - exchange(a, p, (p+r)/2); - q = partition (a, p, r); - quicksort(a, p, q-1); - quicksort(a, q + 1, r); + pt_right = pt + half_size*2; + left_p = my_p^1; + right_p = my_p; + msort(base, pt, half_size, left_p); + msort(base, pt_right, size-half_size, right_p); + /* now implement a simple merge routine */ + + /* pointer to after the end of the list */ + end_pt = pt + 2*size; + /* pointer to the element after the last element to the left */ + end_pt_left = pt+half_size*2; + /* where is left list */ + pt_left = pt+left_p; + /* where is right list */ + pt_right += right_p; + /* where is new list */ + pt += my_p; + /* while there are elements in the left or right vector do compares */ + while (pt_left < end_pt_left && pt_right < end_pt) { + /* if the element to the left is larger than the one to the right */ + if (smaller_or_eq(base[pt_left[0]].Tag, base[pt_right[0]].Tag)) { + /* copy the one to the left */ + pt[0] = pt_left[0]; + /* and avance the two pointers */ + pt += 2; + pt_left += 2; + } else { + /* otherwise, copy the one to the right */ + pt[0] = pt_right[0]; + pt += 2; + pt_right += 2; + } + } + /* if any elements were left in the left vector just copy them */ + while (pt_left < end_pt_left) { + pt[0] = pt_left[0]; + pt += 2; + pt_left += 2; + } + /* if any elements were left in the right vector + and they are in the wrong place, just copy them */ + if (my_p != right_p) { + while(pt_right < end_pt) { + pt[0] = pt_right[0]; + pt += 2; + pt_right += 2; + } + } + } else { + if (size > 1 && smaller(base[pt[2]].Tag,base[pt[0]].Tag)) { + CELL t = pt[2]; + pt[2+my_p] = pt[0]; + pt[my_p] = t; + } else if (my_p) { + pt[1] = pt[0]; + if (size > 1) + pt[3] = pt[2]; + } + } +} + +static void +copy_back(ClauseDef *dest, CELL *pt, int max) { + /* first need to say that we had no need to make a copy */ + int i; + CELL *tmp = pt; + for (i=0; i < max; i++) { + if (*tmp != i) { + ClauseDef cl; + int j = i; + CELL *pnt = tmp; + + /* found a chain */ + /* make a backup copy */ + clcpy(&cl, dest+i); + do { + /* follow the chain */ + int k = *pnt; + + *pnt = j; + // printf("i=%d, k = %d, j = %d\n",i,j,k); + if (k == i) { + clcpy(dest+j, &cl); + break; + } else { + clcpy(dest+j, dest+k); + } + pnt = pt+2*k; + j = k; + } while (TRUE); + } + /* we don't need to do swap */ + tmp += 2; } } /* sort a group of clauses by using their tags */ static void -sort_group(GroupDef *grp) +sort_group(GroupDef *grp, CELL *top) { - quicksort(grp->FirstClause, 0, grp->LastClause-grp->FirstClause); + int max = (grp->LastClause-grp->FirstClause)+1, i; + CELL *pt = top; + + while (top+2*max > (CELL *)Yap_TrailTop) { + if (!Yap_growtrail(2*max*CellSize)) { + Yap_Error(SYSTEM_ERROR,TermNil,"YAP failed to reserve %ld in growtrail", + 2*max*CellSize); + return; + } + } + /* initialise vector */ + for (i=0; i < max; i++) { + *pt = i; + pt += 2; + } +#define M_EVEN 0 + msort(grp->FirstClause, top, max, M_EVEN); + copy_back(grp->FirstClause, top, max); } /* add copy to register stack for original reg */ @@ -197,6 +304,14 @@ add_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count, wamreg copy) return regs_count+1; } +/* add copy to register stack for original reg */ +static int +init_regcopy(wamreg regs[MAX_REG_COPIES], wamreg copy) +{ + regs[0] = copy; + return 1; +} + /* add copy to register stack for original reg */ static int delete_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count, wamreg copy) @@ -219,12 +334,12 @@ inline static int regcopy_in(wamreg regs[MAX_REG_COPIES], int regs_count, wamreg copy) { int i = 0; - while (i < regs_count) { + do { if (regs[i] == copy) { return TRUE; } i++; - } + } while (i < regs_count); /* this copy could not be found */ return FALSE; } @@ -237,6 +352,7 @@ has_cut(yamop *pc) * clause for this predicate or not */ { +#if YAPOR do { op_numbers op = Yap_op_from_opcode(pc->opc); pc->opc = Yap_opcode(op); @@ -715,6 +831,9 @@ has_cut(yamop *pc) break; } } while (TRUE); +#else /* YAPOR */ + return FALSE; +#endif /* YAPOR */ } static void @@ -725,117 +844,14 @@ add_info(ClauseDef *clause, UInt regno) yslot ycopy = 0; yamop *cl; - nofregs = add_regcopy(myregs, 0, Yap_regnotoreg(regno)); + nofregs = init_regcopy(myregs, Yap_regnotoreg(regno)); cl = clause->CurrentCode; while (TRUE) { op_numbers op = Yap_op_from_opcode(cl->opc); switch (op) { - case _Ystop: - case _Nstop: - case _try_me: - case _retry_me: - case _trust_me: - case _profiled_retry_me: - case _profiled_trust_me: - case _count_retry_me: - case _count_trust_me: - case _try_me0: - case _retry_me0: - case _trust_me0: - case _try_me1: - case _retry_me1: - case _trust_me1: - case _try_me2: - case _retry_me2: - case _trust_me2: - case _try_me3: - case _retry_me3: - case _trust_me3: - case _try_me4: - case _retry_me4: - case _trust_me4: - case _spy_or_trymark: - case _try_and_mark: - case _profiled_retry_and_mark: - case _count_retry_and_mark: - case _retry_and_mark: - case _try_clause: - case _retry: - case _trust: -#ifdef YAPOR - case _getwork: - case _getwork_seq: - case _sync: -#endif -#ifdef TABLING - case _table_try_me_single: - case _table_try_me: - case _table_retry_me: - case _table_trust_me: - case _table_answer_resolution: - case _table_completion: -#endif - case _enter_profiling: - case _count_call: - case _retry_profiled: - case _count_retry: - case _try_logical_pred: - case _trust_logical_pred: - case _execute: - case _dexecute: - case _jump: - case _move_back: - case _skip: - case _jump_if_var: - case _try_in: - clause->Tag = (CELL)NULL; - return; case _alloc_for_logical_pred: cl = NEXTOP(cl,EC); break; - /* instructions type e */ - case _trust_fail: - case _op_fail: - case _procceed: -#if !defined(YAPOR) - case _or_last: -#endif - case _pop: - case _index_pred: - case _undef_p: - case _spy_pred: - case _p_equal: - case _p_dif: - case _p_eq: - case _p_functor: - case _p_execute_tail: -#ifdef YAPOR - case _getwork_first_time: -#endif -#ifdef TABLING - case _trie_do_var: - case _trie_trust_var: - case _trie_try_var: - case _trie_retry_var: - case _trie_do_val: - case _trie_trust_val: - case _trie_try_val: - case _trie_retry_val: - case _trie_do_atom: - case _trie_trust_atom: - case _trie_try_atom: - case _trie_retry_atom: - case _trie_do_list: - case _trie_trust_list: - case _trie_try_list: - case _trie_retry_list: - case _trie_do_struct: - case _trie_trust_struct: - case _trie_try_struct: - case _trie_retry_struct: -#endif - clause->Tag = (CELL)NULL; - return; case _cut: case _cut_t: case _cut_e: @@ -1487,6 +1503,109 @@ add_info(ClauseDef *clause, UInt regno) case _call_bfunc_yy: cl = NEXTOP(cl,lyy); break; + case _Ystop: + case _Nstop: + case _try_me: + case _retry_me: + case _trust_me: + case _profiled_retry_me: + case _profiled_trust_me: + case _count_retry_me: + case _count_trust_me: + case _try_me0: + case _retry_me0: + case _trust_me0: + case _try_me1: + case _retry_me1: + case _trust_me1: + case _try_me2: + case _retry_me2: + case _trust_me2: + case _try_me3: + case _retry_me3: + case _trust_me3: + case _try_me4: + case _retry_me4: + case _trust_me4: + case _spy_or_trymark: + case _try_and_mark: + case _profiled_retry_and_mark: + case _count_retry_and_mark: + case _retry_and_mark: + case _try_clause: + case _retry: + case _trust: +#ifdef YAPOR + case _getwork: + case _getwork_seq: + case _sync: +#endif +#ifdef TABLING + case _table_try_me_single: + case _table_try_me: + case _table_retry_me: + case _table_trust_me: + case _table_answer_resolution: + case _table_completion: +#endif + case _enter_profiling: + case _count_call: + case _retry_profiled: + case _count_retry: + case _try_logical_pred: + case _trust_logical_pred: + case _execute: + case _dexecute: + case _jump: + case _move_back: + case _skip: + case _jump_if_var: + case _try_in: + clause->Tag = (CELL)NULL; + return; + /* instructions type e */ + case _trust_fail: + case _op_fail: + case _procceed: +#if !defined(YAPOR) + case _or_last: +#endif + case _pop: + case _index_pred: + case _undef_p: + case _spy_pred: + case _p_equal: + case _p_dif: + case _p_eq: + case _p_functor: + case _p_execute_tail: +#ifdef YAPOR + case _getwork_first_time: +#endif +#ifdef TABLING + case _trie_do_var: + case _trie_trust_var: + case _trie_try_var: + case _trie_retry_var: + case _trie_do_val: + case _trie_trust_val: + case _trie_try_val: + case _trie_retry_val: + case _trie_do_atom: + case _trie_trust_atom: + case _trie_try_atom: + case _trie_retry_atom: + case _trie_do_list: + case _trie_trust_list: + case _trie_try_list: + case _trie_retry_list: + case _trie_do_struct: + case _trie_trust_struct: + case _trie_try_struct: + case _trie_retry_struct: +#endif + clause->Tag = (CELL)NULL; + return; } } } @@ -2484,7 +2603,7 @@ do_nonvar_group(GroupDef *grp, int compound_term, UInt labl, PredEntry *ap, UInt type_sw = emit_type_switch(switch_on_type_op); type_sw->VarEntry = do_var_entries(grp, ap, argno, first, clleft, nxtlbl); grp->LastClause = cls_move(grp->FirstClause, grp->LastClause, compound_term, argno, last_arg); - sort_group(grp); + sort_group(grp,top); type_sw->ConstEntry = do_consts(grp, ap, argno, first, nxtlbl, clleft, top); type_sw->FuncEntry = do_funcs(grp, ap, argno, first, last_arg, nxtlbl, clleft, top); type_sw->PairEntry = do_pair(grp, ap, argno, first, last_arg, nxtlbl, clleft, top); @@ -2540,7 +2659,8 @@ do_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt argno, UInt fail_l, /* base case, just commit to the current code */ return emit_single_switch_case(min, ap, first, clleft, fail_l); } - if (ap->ArityOfPE < argno) { + if ((argno > 1 && yap_flags[INDEXING_MODE_FLAG] == INDEX_MODE_SINGLE) || + ap->ArityOfPE < argno) { UInt labl = new_label(); do_var_clauses(min, max, FALSE, ap, labl, first, clleft, fail_l); return labl; @@ -2643,6 +2763,11 @@ do_compound_index(ClauseDef *min, ClauseDef* max, PredEntry *ap, UInt arity, UIn /* base case, just commit to the current code */ return emit_single_switch_case(cl, ap, first, clleft, fail_l); } + if (yap_flags[INDEXING_MODE_FLAG] == INDEX_MODE_SINGLE) { + UInt labl = new_label(); + do_var_clauses(min, max, FALSE, ap, labl, first, clleft, fail_l); + return labl; + } group = (GroupDef *)top; cl = min; while (i < arity) { diff --git a/C/init.c b/C/init.c index facd950d3..da6ceb7e6 100644 --- a/C/init.c +++ b/C/init.c @@ -667,6 +667,8 @@ InitFlags(void) #else yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = TRUE; #endif + /* current default */ + yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI; } static void @@ -838,7 +840,6 @@ InitCodes(void) AtomGVar = Yap_LookupAtom("var"); heap_regs->atom_global = Yap_LookupAtom("global_sp"); heap_regs->atom_heap_used = Yap_LookupAtom("heapused"); - heap_regs->atom_index = Yap_LookupAtom("$doindex"); heap_regs->atom_inf = Yap_LookupAtom("inf"); heap_regs->atom_l_t = Yap_LookupAtom("<"); heap_regs->atom_local = Yap_LookupAtom("local_sp"); diff --git a/C/stdpreds.c b/C/stdpreds.c index 3e81c4057..527bc6a5c 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -110,7 +110,7 @@ STD_PROTO(static Int profres2, (void)); typedef struct prof_files { FILE *f_prof, *f_preds; -}; +} prof_files_struct; void Yap_inform_profiler_of_clause(yamop *code_start, yamop *code_end, PredEntry *pe) { @@ -2434,6 +2434,11 @@ p_set_yap_flags(void) return(FALSE); yap_flags[STACK_DUMP_ON_ERROR_FLAG] = value; break; + case INDEXING_MODE_FLAG: + if (value < INDEX_MODE_OFF || value > INDEX_MODE_MAX) + return(FALSE); + yap_flags[INDEXING_MODE_FLAG] = value; + break; default: return(FALSE); } diff --git a/C/tracer.c b/C/tracer.c index 972725aef..dbaa40f61 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -111,9 +111,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) /* extern int gc_calls; */ vsc_count++; + if (vsc_count < 130000) return; #ifdef COMMENTED return; - if (vsc_count == 124881LL) { + if (vsc_count == 133000LL) { printf("Here I go\n"); } if (vsc_count > 500000) exit(0); diff --git a/C/unify.c b/C/unify.c index 48d348fea..73350d108 100644 --- a/C/unify.c +++ b/C/unify.c @@ -561,13 +561,6 @@ unify_var_nvar_trail: #if USE_THREADED_CODE -static inline int -rtable_hash_op(OPCODE opc, int hash_mask) { - return((((CELL)opc) >> 3) & hash_mask); -} - -#define OP_HASH_SIZE 2048 - /* mask a hash table that allows for fast reverse translation from instruction address to corresponding opcode */ static void @@ -610,31 +603,8 @@ InitReverseLookupOpcode(void) opeptr[j].opc = opc; } } - -/* given an opcode find the corresponding opnumber. This should make - switches on ops a much easier operation */ -op_numbers -Yap_op_from_opcode(OPCODE opc) -{ - int j = rtable_hash_op(opc,OP_HASH_SIZE-1); - - while (OP_RTABLE[j].opc != opc) { - if (j == OP_HASH_SIZE-1) - j = 0; - else - j++; - } - return(OP_RTABLE[j].opnum); -} -#else -op_numbers -Yap_op_from_opcode(OPCODE opc) -{ - return((op_numbers)opc); -} #endif - void Yap_InitUnify(void) { diff --git a/C/ypsocks.c b/C/ypsocks.c index b3bdadcd7..006c3441e 100644 --- a/C/ypsocks.c +++ b/C/ypsocks.c @@ -191,9 +191,9 @@ Yap_init_socks(char *host, long interface_port) #if USE_SOCKET he = gethostbyname(host); - if (!he) { + if (he == NULL) { #if HAVE_STRERROR - Yap_Error(SYSTEM_ERROR, TermNil, "can not get address for host: %s", strerror(errno)); + Yap_Error(SYSTEM_ERROR, TermNil, "can not get address for host %s: %s", host, strerror(h_errno)); #else Yap_Error(SYSTEM_ERROR, TermNil, "can not get address for host"); #endif diff --git a/H/Heap.h b/H/Heap.h index 11b7c92c8..d5512fb69 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.42 2003-05-21 13:00:23 vsc Exp $ * +* version: $Id: Heap.h,v 1.43 2003-06-06 11:54:01 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -199,7 +199,6 @@ typedef struct various_codes { atom_gc_very_verbose, atom_global, atom_heap_used, - atom_index, atom_inf, atom_l_t, atom_local, @@ -430,7 +429,6 @@ typedef struct various_codes { #define AtomGcVeryVerbose heap_regs->atom_gc_very_verbose #define AtomGlobal heap_regs->atom_global #define AtomHeapUsed heap_regs->atom_heap_used -#define AtomIndex heap_regs->atom_index #define AtomInf heap_regs->atom_inf #define AtomLocal heap_regs->atom_local #define AtomLT heap_regs->atom_l_t diff --git a/H/Yapproto.h b/H/Yapproto.h index 2584a06e0..9de9d224d 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.36 2003-05-21 13:00:23 vsc Exp $ * +* version: $Id: Yapproto.h,v 1.37 2003-06-06 11:54:02 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -275,7 +275,6 @@ void STD_PROTO(Yap_InitLowLevelTrace,(void)); void STD_PROTO(Yap_InitAbsmi,(void)); void STD_PROTO(Yap_InitUnify,(void)); int STD_PROTO(Yap_IUnify,(register CELL d0,register CELL d1)); -op_numbers STD_PROTO(Yap_op_from_opcode,(OPCODE)); /* userpreds.c */ void STD_PROTO(Yap_InitUserCPreds,(void)); diff --git a/H/amidefs.h b/H/amidefs.h index a678943aa..bd91f3d92 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -615,4 +615,3 @@ extern int Yap_opcount[_std_top+1]; #endif - diff --git a/H/clause.h b/H/clause.h index 190d9c658..aa5a8cb7e 100644 --- a/H/clause.h +++ b/H/clause.h @@ -144,8 +144,40 @@ Term STD_PROTO(Yap_cp_as_integer,(choiceptr)); /* index.c */ yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *)); - #if LOW_PROF /* profiling */ yamop *Yap_prof_end; #endif /* LOW_PROF */ + +#if USE_THREADED_CODE + +#define OP_HASH_SIZE 2048 + +static inline int +rtable_hash_op(OPCODE opc, int hash_mask) { + return((((CELL)opc) >> 3) & hash_mask); +} + +/* given an opcode find the corresponding opnumber. This should make + switches on ops a much easier operation */ +static inline op_numbers +Yap_op_from_opcode(OPCODE opc) +{ + int j = rtable_hash_op(opc,OP_HASH_SIZE-1); + + while (OP_RTABLE[j].opc != opc) { + if (j == OP_HASH_SIZE-1) { + j = 0; + } else { + j++; + } + } + return OP_RTABLE[j].opnum; +} +#else +static inline op_numbers +Yap_op_from_opcode(OPCODE opc) +{ + return((op_numbers)opc); +} +#endif /* USE_THREADED_CODE */ diff --git a/H/rheap.h b/H/rheap.h index 1921a7ddc..cf7b8d646 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -210,7 +210,6 @@ restore_codes(void) heap_regs->atom_gc_very_verbose = AtomAdjust(heap_regs->atom_gc_very_verbose); heap_regs->atom_global = AtomAdjust(heap_regs->atom_global); heap_regs->atom_heap_used = AtomAdjust(heap_regs->atom_heap_used); - heap_regs->atom_index = AtomAdjust(heap_regs->atom_index); heap_regs->atom_inf = AtomAdjust(heap_regs->atom_inf); heap_regs->atom_l_t = AtomAdjust(heap_regs->atom_l_t); heap_regs->atom_local = AtomAdjust(heap_regs->atom_local); diff --git a/m4/Yap.h.m4 b/m4/Yap.h.m4 index 4f1f92c81..d1de7943a 100644 --- a/m4/Yap.h.m4 +++ b/m4/Yap.h.m4 @@ -10,7 +10,7 @@ * File: Yap.h.m4 * * mods: * * comments: main header file for YAP * -* version: $Id: Yap.h.m4,v 1.46 2003-05-20 19:11:59 vsc Exp $ * +* version: $Id: Yap.h.m4,v 1.47 2003-06-06 11:54:02 vsc Exp $ * *************************************************************************/ #include "config.h" @@ -509,7 +509,8 @@ typedef enum { ALLOW_ASSERTING_STATIC_FLAG = 14, HALT_AFTER_CONSULT_FLAG = 15, FAST_BOOT_FLAG = 16, - STACK_DUMP_ON_ERROR_FLAG = 17 + STACK_DUMP_ON_ERROR_FLAG = 17, + INDEXING_MODE_FLAG = 18 } yap_flags; #define STRING_AS_CHARS 0 @@ -522,7 +523,15 @@ typedef enum { #define ISO_CHARACTER_ESCAPES 1 #define SICSTUS_CHARACTER_ESCAPES 2 -#define NUMBER_OF_YAP_FLAGS STACK_DUMP_ON_ERROR_FLAG+1 +typedef enum { + INDEX_MODE_OFF = 0, + INDEX_MODE_SINGLE = 1, + INDEX_MODE_COMPACT = 2, + INDEX_MODE_MULTI = 3, + INDEX_MODE_MAX = 4 +} index_mode_options; + +#define NUMBER_OF_YAP_FLAGS INDEXING_MODE_FLAG+1 /************************ prototypes **********************************/ diff --git a/pl/directives.yap b/pl/directives.yap index ef54bd3f7..bbb7057d3 100644 --- a/pl/directives.yap +++ b/pl/directives.yap @@ -205,10 +205,23 @@ yap_flag(bounded,X) :- '$do_error'(domain_error(flag_value,bounded+X),yap_flag(bounded,X)). % do or do not indexation -yap_flag(index,X) :- var(X), !, - ( '$get_value'('$doindex',true) -> X=on ; X=off). -yap_flag(index,on) :- !, '$set_value'('$doindex',true). -yap_flag(index,off) :- '$set_value'('$doindex',[]). +yap_flag(index,X) :- var(X), + '$access_yap_flags'(18, X1), + '$transl_to_index_mode'(X1,X), !. +yap_flag(index,X) :- + '$transl_to_index_mode'(X1,X), !, + '$set_yap_flags'(18,X1). +yap_flag(index,X) :- + '$do_error'(domain_error(flag_value,index+X),yap_flag(index,X)). + +% should match definitions in Yap.h.m4 +'$transl_to_index_mode'(0, off). +'$transl_to_index_mode'(1, single). +'$transl_to_index_mode'(2, compact). +'$transl_to_index_mode'(3, multi). +'$transl_to_index_mode'(3, on). % default is multi argument indexing +'$transl_to_index_mode'(4, max). + yap_flag(informational_messages,X) :- var(X), !, '$get_value'('$verbose',X).