diff --git a/C/absmi.c b/C/absmi.c index bcb62b3f6..37998cbdc 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -977,19 +977,7 @@ Yap_absmi(int inp) GONext(); ENDOp(); - /* profiled_enter */ - Op(enter_a_profiling, e); - { - PredEntry *pen = RepPredProp((Prop)IntegerOfTerm(ENV[-EnvSizeInCells-2])); - PREG = NEXTOP(PREG, e); - LOCK(pen->StatisticsForPred.lock); - pen->StatisticsForPred.NOfEntries++; - UNLOCK(pen->StatisticsForPred.lock); - } - GONext(); - ENDOp(); - - /* profiled_retry Label,NArgs */ + /* profiled_retry Label,NArgs */ Op(retry_profiled, p); LOCK(PREG->u.p.p->StatisticsForPred.lock); PREG->u.p.p->StatisticsForPred.NOfRetries++; @@ -1214,32 +1202,6 @@ Yap_absmi(int inp) GONext(); ENDOp(); - /* count_enter_me Label,NArgs */ - Op(count_a_call, e); - { - PredEntry *pen = RepPredProp((Prop)IntegerOfTerm(ENV[-EnvSizeInCells-2])); - PREG = NEXTOP(PREG, e); - LOCK(pen->StatisticsForPred.lock); - pen->StatisticsForPred.NOfEntries++; - UNLOCK(pen->StatisticsForPred.lock); - ReductionsCounter--; - if (ReductionsCounter == 0 && ReductionsCounterOn) { - saveregs(); - Yap_Error(CALL_COUNTER_UNDERFLOW,TermNil,""); - setregs(); - JMPNext(); - } - PredEntriesCounter--; - if (PredEntriesCounter == 0 && PredEntriesCounterOn) { - saveregs(); - Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,""); - setregs(); - JMPNext(); - } - } - GONext(); - ENDOp(); - /* count_retry Label,NArgs */ Op(count_retry, p); LOCK(PREG->u.p.p->StatisticsForPred.lock); @@ -8057,6 +8019,41 @@ Yap_absmi(int inp) /* IPred can generate errors, it thus must get rid of the lock itself */ setregs(); } + /* first check if we need to increase the counter */ + if ((pe->PredFlags & CountPredFlag)) { + LOCK(pe->StatisticsForPred.lock); + pe->StatisticsForPred.NOfEntries++; + UNLOCK(pe->StatisticsForPred.lock); + ReductionsCounter--; + if (ReductionsCounter == 0 && ReductionsCounterOn) { + saveregs(); + Yap_Error(CALL_COUNTER_UNDERFLOW,TermNil,""); + setregs(); + JMPNext(); + } + PredEntriesCounter--; + if (PredEntriesCounter == 0 && PredEntriesCounterOn) { + saveregs(); + Yap_Error(PRED_ENTRY_COUNTER_UNDERFLOW,TermNil,""); + setregs(); + JMPNext(); + } + if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) == + CountPredFlag) { + PREG = pe->cs.p_code.TrueCodeOfPred; + JMPNext(); + } + } + /* standard profiler */ + if ((pe->PredFlags & ProfiledPredFlag)) { + LOCK(pe->StatisticsForPred.lock); + pe->StatisticsForPred.NOfEntries++; + UNLOCK(pe->StatisticsForPred.lock); + if (!(pe->PredFlags & SpiedPredFlag)) { + PREG = pe->cs.p_code.TrueCodeOfPred; + JMPNext(); + } + } if (!DebugOn) { PREG = pe->cs.p_code.TrueCodeOfPred; UNLOCK(pe->PELock); diff --git a/C/amasm.c b/C/amasm.c index 6b1318e9a..76116aeb1 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -3665,13 +3665,25 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp code_p = a_f2(TRUE, &cmp_info, code_p, pass_no, cip); break; case enter_profiling_op: - code_p = a_pl(_enter_profiling, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no); + { + PredEntry *pe = (PredEntry *)(cip->cpc->rnd1); + if ((pe->PredFlags & (CPredFlag|UserCPredFlag|AsmPredFlag)) || + !pe->ModuleOfPred) { + code_p = a_pl(_enter_profiling, pe, code_p, pass_no); + } + } break; case retry_profiled_op: code_p = a_pl(_retry_profiled, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no); break; case count_call_op: - code_p = a_pl(_count_call, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no); + { + PredEntry *pe = (PredEntry *)(cip->cpc->rnd1); + if ((pe->PredFlags & (CPredFlag|UserCPredFlag|AsmPredFlag)) || + !pe->ModuleOfPred) { + code_p = a_pl(_count_call, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no); + } + } break; case count_retry_op: code_p = a_pl(_count_retry, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no); @@ -3925,14 +3937,6 @@ Yap_InitComma(void) code_p->u.p.p = PredMetaCall; GONEXT(p); } else { - if (PROFILING) { - code_p->opc = opcode(_enter_a_profiling); - GONEXT(e); - } - if (CALL_COUNTING) { - code_p->opc = opcode(_count_a_call); - GONEXT(e); - } code_p->opc = opcode(_p_execute_tail); code_p->u.Osbpp.s = emit_count(-Signed(RealEnvSize)-3*sizeof(CELL)); code_p->u.Osbpp.bmap = NULL; diff --git a/C/cdmgr.c b/C/cdmgr.c index 093c437bb..ae15542f4 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -965,7 +965,7 @@ IPred(PredEntry *ap, UInt NSlots) ap->cs.p_code.TrueCodeOfPred = BaseAddr; ap->PredFlags |= IndexedPredFlag; } - if (ap->PredFlags & SpiedPredFlag) { + if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); #if defined(YAPOR) || defined(THREADS) @@ -996,7 +996,7 @@ static void RemoveMainIndex(PredEntry *ap) { yamop *First = ap->cs.p_code.FirstClause; - int spied = ap->PredFlags & SpiedPredFlag; + int spied = ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag); ap->PredFlags &= ~IndexedPredFlag; if (First == NULL) { @@ -1006,7 +1006,7 @@ RemoveMainIndex(PredEntry *ap) } if (First != NULL && spied) { ap->OpcodeOfPred = Yap_opcode(_spy_pred); - ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); + ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); } else if (ap->cs.p_code.NOfClauses > 1 #ifdef TABLING ||ap->PredFlags & TabledPredFlag @@ -1587,6 +1587,10 @@ retract_all(PredEntry *p, int in_use) p->PredFlags |= ProfiledPredFlag; } else p->PredFlags &= ~ProfiledPredFlag; + if (CALL_COUNTING) { + p->PredFlags |= CountPredFlag; + } else + p->PredFlags &= ~CountPredFlag; #ifdef YAPOR if (SEQUENTIAL_IS_DEFAULT) { p->PredFlags |= SequentialPredFlag; @@ -1636,8 +1640,16 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag) p->StatisticsForPred.NOfRetries = 0; if (PROFILING) { p->PredFlags |= ProfiledPredFlag; - } else + spy_flag = TRUE; + } else { p->PredFlags &= ~ProfiledPredFlag; + } + if (CALL_COUNTING) { + p->PredFlags |= CountPredFlag; + spy_flag = TRUE; + } else { + p->PredFlags &= ~CountPredFlag; + } if (spy_flag) { p->OpcodeOfPred = Yap_opcode(_spy_pred); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); @@ -1666,8 +1678,16 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag) p->StatisticsForPred.NOfRetries = 0; if (PROFILING) { p->PredFlags |= ProfiledPredFlag; - } else + spy_flag = TRUE; + } else { p->PredFlags &= ~ProfiledPredFlag; + } + if (CALL_COUNTING) { + p->PredFlags |= CountPredFlag; + spy_flag = TRUE; + } else { + p->PredFlags &= ~CountPredFlag; + } #ifdef YAPOR p->PredFlags |= SequentialPredFlag; #endif /* YAPOR */ @@ -1753,12 +1773,12 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag) clq->ClNext = clp; clp->ClPrev = clq; p->cs.p_code.FirstClause = q; - if (p->PredFlags & SpiedPredFlag) { + if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { p->OpcodeOfPred = Yap_opcode(_spy_pred); - p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); + p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } else if (!(p->PredFlags & IndexedPredFlag)) { p->OpcodeOfPred = INDEX_OPCODE; - p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); + p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } #if defined(YAPOR) || defined(THREADS) if (p->ModuleOfPred != IDB_MODULE) { @@ -1771,7 +1791,7 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag) cl->ClNext = ClauseCodeToStaticClause(p->cs.p_code.FirstClause); p->cs.p_code.FirstClause = q; p->cs.p_code.TrueCodeOfPred = q; - if (p->PredFlags & SpiedPredFlag) { + if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { p->OpcodeOfPred = Yap_opcode(_spy_pred); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } else if (!(p->PredFlags & IndexedPredFlag)) { @@ -1840,7 +1860,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag) p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } #endif - if (p->PredFlags & SpiedPredFlag) { + if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { p->OpcodeOfPred = Yap_opcode(_spy_pred); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } @@ -1851,7 +1871,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag) cl->ClNext = ClauseCodeToStaticClause(cp); } if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) { - if (!(p->PredFlags & SpiedPredFlag)) { + if (!(p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag))) { p->OpcodeOfPred = INDEX_OPCODE; p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } @@ -2075,7 +2095,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref) if (pflags & IndexedPredFlag) { Yap_AddClauseToIndex(p, cp, mode == asserta); } - if (pflags & SpiedPredFlag) + if (pflags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) spy_flag = TRUE; if (p == PredGoalExpansion) { Term tg = ArgOfTerm(1, tf); @@ -2315,7 +2335,7 @@ Yap_EraseStaticClause(StaticClause *cl, Term mod) { } else if (ap->cs.p_code.NOfClauses > 1) { ap->OpcodeOfPred = INDEX_OPCODE; ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); - } else if (ap->PredFlags & SpiedPredFlag) { + } else if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); } else { @@ -2770,24 +2790,26 @@ p_rmspy(void) return TRUE; } #endif - if (!(pred->PredFlags & DynamicPredFlag)) { + if (!(pred->PredFlags & (CountPredFlag|ProfiledPredFlag))) { + if (!(pred->PredFlags & DynamicPredFlag)) { #if defined(YAPOR) || defined(THREADS) - if (pred->PredFlags & LogUpdatePredFlag && - pred->ModuleOfPred != IDB_MODULE) { - pred->OpcodeOfPred = LOCKPRED_OPCODE; - pred->CodeOfPred = (yamop *)(&(pred->OpcodeOfPred)); + if (pred->PredFlags & LogUpdatePredFlag && + pred->ModuleOfPred != IDB_MODULE) { + pred->OpcodeOfPred = LOCKPRED_OPCODE; + pred->CodeOfPred = (yamop *)(&(pred->OpcodeOfPred)); + } else { +#endif + pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred; + pred->OpcodeOfPred = pred->CodeOfPred->opc; +#if defined(YAPOR) || defined(THREADS) + } +#endif + } else if (pred->OpcodeOfPred == Yap_opcode(_spy_or_trymark)) { + pred->OpcodeOfPred = Yap_opcode(_try_and_mark); } else { -#endif - pred->CodeOfPred = pred->cs.p_code.TrueCodeOfPred; - pred->OpcodeOfPred = pred->CodeOfPred->opc; -#if defined(YAPOR) || defined(THREADS) + UNLOCK(pred->PELock); + return FALSE; } -#endif - } else if (pred->OpcodeOfPred == Yap_opcode(_spy_or_trymark)) { - pred->OpcodeOfPred = Yap_opcode(_try_and_mark); - } else { - UNLOCK(pred->PELock); - return FALSE; } pred->PredFlags ^= SpiedPredFlag; UNLOCK(pred->PELock); diff --git a/C/compiler.c b/C/compiler.c index 5671b2a8c..91c05aa88 100644 --- a/C/compiler.c +++ b/C/compiler.c @@ -1090,10 +1090,6 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler_struct save_machine_regs(); longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); } - if (profiling) - Yap_emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint); - else if (call_counting) - Yap_emit(count_call_op, (CELL)RepPredProp(p0), Zero, &cglobs->cint); c_args(Goal, 0, cglobs); Yap_emit(safe_call_op, (CELL)p0 , Zero, &cglobs->cint); Yap_emit(empty_call_op, Zero, Zero, &cglobs->cint); @@ -1814,6 +1810,10 @@ c_goal(Term Goal, Term mod, compiler_struct *cglobs) return; } else if (op >= _plus && op <= _functor) { + if (profiling) + Yap_emit(enter_profiling_op, (CELL)RepPredProp(p), Zero, &cglobs->cint); + else if (call_counting) + Yap_emit(count_call_op, (CELL)RepPredProp(p), Zero, &cglobs->cint); if (op == _functor) { c_functor(Goal, mod, cglobs); } diff --git a/C/dbase.c b/C/dbase.c index 74b910cf8..d13e3611a 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -4253,7 +4253,7 @@ PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr) code_p = p->cs.p_code.FirstClause; code_p->u.Otapl.d = p->cs.p_code.FirstClause; p->cs.p_code.TrueCodeOfPred = NEXTOP(code_p, Otapl); - if (p->PredFlags & SpiedPredFlag) { + if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { p->OpcodeOfPred = Yap_opcode(_spy_pred); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); #if defined(YAPOR) || defined(THREADS) @@ -4275,7 +4275,7 @@ PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr) p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); } } else { - if (p->PredFlags & SpiedPredFlag) { + if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { p->OpcodeOfPred = Yap_opcode(_spy_pred); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); #if defined(YAPOR) || defined(THREADS) diff --git a/C/exec.c b/C/exec.c index d1835c410..b446c6afb 100644 --- a/C/exec.c +++ b/C/exec.c @@ -77,12 +77,6 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) { YENV[E_CB] = (CELL) cut_pt; } P = code; - /* vsc: increment reduction counter at meta-call entry */ - if (pen->PredFlags & ProfiledPredFlag) { - LOCK(pen->StatisticsForPred.lock); - pen->StatisticsForPred.NOfEntries++; - UNLOCK(pen->StatisticsForPred.lock); - } return TRUE; } diff --git a/C/globals.c b/C/globals.c index 84fbc8633..1011113c7 100644 --- a/C/globals.c +++ b/C/globals.c @@ -44,7 +44,7 @@ static char SccsId[] = "%W% %G%"; #define HEAP_DELAY_ARENA 3 #define HEAP_START 4 -#define MIN_ARENA_SIZE 2048 +#define MIN_ARENA_SIZE 1048 #define MAX_ARENA_SIZE (2048*16) #define Global_MkIntegerTerm(I) MkIntegerTerm(I) @@ -1497,7 +1497,7 @@ p_nb_queue(void) { UInt arena_sz = (ASP-H)/16; if (DepthArenas > 1) - arena_sz /= log(MIN_ARENA_SIZE); + arena_sz /= DepthArenas; if (arena_sz < MIN_ARENA_SIZE) arena_sz = MIN_ARENA_SIZE; if (arena_sz > MAX_ARENA_SIZE) @@ -1579,8 +1579,9 @@ RecoverArena(Term arena) CELL *pt = ArenaPt(arena), *max = ArenaLimit(arena); - if (max == H) + if (max == H) { H = pt; + } } static Int @@ -1612,7 +1613,10 @@ p_nb_queue_close(void) Yap_unify(ARG3, qp[QUEUE_TAIL]) && Yap_unify(ARG2, qp[QUEUE_HEAD]); qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1); - qp[0] = MkIntegerTerm(0); + qp[QUEUE_ARENA] = + qp[QUEUE_DELAY_ARENA] = + qp[QUEUE_HEAD] = + qp[QUEUE_TAIL] = MkIntegerTerm(0); return out; } Yap_Error(INSTANTIATION_ERROR,t,"queue/3"); diff --git a/C/index.c b/C/index.c index 7231e46ae..5924dbc97 100644 --- a/C/index.c +++ b/C/index.c @@ -5997,7 +5997,7 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg return; } ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause; - if (ap->PredFlags & SpiedPredFlag) { + if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) { ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); #if defined(YAPOR) || defined(THREADS) diff --git a/C/stdpreds.c b/C/stdpreds.c index ced0083d4..0b7337603 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -2503,6 +2503,70 @@ p_sub_atom_extract(void) goto start; } +/* $sub_atom_extract(A,Bef,Size,After,SubAt).*/ +static Int +p_sub_atom_fetch(void) +{ + Atom at = AtomOfTerm(Deref(ARG1)); + Atom subatom = AtomOfTerm(Deref(ARG5)); + Int offset = IntegerOfTerm(Deref(ARG6)); + + if (IsWideAtom(at)) { + wchar_t *s = RepAtom(at)->WStrOfAE; + wchar_t *ins, *where; + Int start, sz, after; + + + if (!IsWideAtom(subatom)) { + /* first convert to wchar_t */ + char *inschars = RepAtom(subatom)->StrOfAE; + Int i; + + sz = strlen(inschars); + ins = (wchar_t *)Yap_PreAllocCodeSpace(); + while ((ins = (wchar_t *)Yap_PreAllocCodeSpace()) + (sz+1) > (wchar_t *)AuxSp) { + if (!Yap_ExpandPreAllocCodeSpace(sizeof(wchar_t)*(sz+1), NULL, TRUE)) { + Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG5, "allocating temp space in sub_atom/2"); + return FALSE; + } + } + for (i=0;i<=sz;i++) + ins[i] = inschars[i]; + } else { + ins = RepAtom(subatom)->WStrOfAE; + sz = wcslen(ins); + } + if (!Yap_unify(MkIntegerTerm(sz), ARG3)) + return FALSE; + if (!(where = wcsstr(s+offset, ins))) { + return FALSE; + } + if (!Yap_unify(MkIntegerTerm((start = (where-s))), ARG2)) + return FALSE; + after = wcslen(s)-(start+sz); + return Yap_unify(MkIntegerTerm(after), ARG4); + } else { + char *s = RepAtom(at)->StrOfAE; + char *ins, *where; + Int start, sz, after; + + if (IsWideAtom(subatom)) { + return FALSE; + } + ins = subatom->StrOfAE; + sz = strlen(ins); + if (!Yap_unify(MkIntegerTerm(sz), ARG3)) + return FALSE; + if (!(where = strstr(s+offset, ins))) { + return FALSE; + } + if (!Yap_unify(MkIntegerTerm((start = (where-s))), ARG2)) + return FALSE; + after = strlen(s)-(start+sz); + return Yap_unify(MkIntegerTerm(after), ARG4); + } +} + static Int p_abort(void) @@ -3929,6 +3993,7 @@ Yap_InitCPreds(void) Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag); Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$sub_atom_extract", 5, p_sub_atom_extract, HiddenPredFlag); + Yap_InitCPred("$sub_atom_fetch", 6, p_sub_atom_fetch, HiddenPredFlag); Yap_InitCPred("number_chars", 2, p_number_chars, 0); Yap_InitCPred("number_atom", 2, p_number_atom, 0); Yap_InitCPred("number_codes", 2, p_number_codes, 0); diff --git a/C/utilpreds.c b/C/utilpreds.c index 89682234c..674874a0a 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -467,7 +467,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs) { if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; goto restart_list; - } else if (res && share && FunctorOfTerm(t) != FunctorMutable) { + } else if (res && share) { H = Hi; return t; } @@ -499,7 +499,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs) { if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) return FALSE; goto restart_appl; - } else if (res && share) { + } else if (res && share && FunctorOfTerm(t) != FunctorMutable) { H = HB0; return t; } diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 8c0abfd12..faa289890 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -8,14 +8,12 @@ OPCODE(retry_me ,Otapl), OPCODE(trust_me ,Otapl), OPCODE(enter_profiling ,p), - OPCODE(enter_a_profiling ,e), OPCODE(retry_profiled ,p), OPCODE(profiled_retry_me ,Otapl), OPCODE(profiled_trust_me ,Otapl), OPCODE(profiled_retry_logical ,OtaLl), OPCODE(profiled_trust_logical ,OtILl), OPCODE(count_call ,p), - OPCODE(count_a_call ,e), OPCODE(count_retry ,p), OPCODE(count_retry_me ,Otapl), OPCODE(count_trust_me ,Otapl), diff --git a/H/findclause.h b/H/findclause.h index 2b5eefa45..ba7a4265a 100644 --- a/H/findclause.h +++ b/H/findclause.h @@ -141,12 +141,6 @@ return; cl = NEXTOP(cl,e); break; - case _count_a_call: - cl = NEXTOP(cl,e); - break; - case _enter_a_profiling: - cl = NEXTOP(cl,e); - break; case _pop: cl = NEXTOP(cl,e); break; diff --git a/H/rclause.h b/H/rclause.h index 1b627a781..47c49b69c 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -194,11 +194,9 @@ restore_opcodes(yamop *pc) case _Nstop: case _allocate: case _copy_idb_term: - case _count_a_call: case _cut: case _cut_e: case _cut_t: - case _enter_a_profiling: case _expand_index: case _index_blob: case _index_dbref: diff --git a/H/walkclause.h b/H/walkclause.h index b08aaa0cc..d396071c9 100644 --- a/H/walkclause.h +++ b/H/walkclause.h @@ -154,11 +154,9 @@ case _unify_idb_term: return found_idb_clause(pc, startp, endp); case _allocate: - case _count_a_call: case _cut: case _cut_e: case _cut_t: - case _enter_a_profiling: case _index_blob: case _index_dbref: case _index_long: diff --git a/packages/cplint/lpad.pl b/packages/cplint/lpad.pl index 826996405..bcd0fec4e 100644 --- a/packages/cplint/lpad.pl +++ b/packages/cplint/lpad.pl @@ -34,7 +34,7 @@ p/1, slg/3,setting/2,set/2 ]). - +:-source. :- dynamic wfs_trace/0. :-use_module(library(ugraphs)). :-use_module(library(lists)). @@ -432,9 +432,16 @@ consistent(N,R,S,[(N1,R,S1)|T]):- map_oldt([],_Ggoal,Tab,Tab,S,S,Dfn,Dfn,Dep,Dep,TP,TP,C,C,D,D). map_oldt([Clause|Frames],Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP, C0,C,D0,D) :- - edge_oldt(Clause,Ggoal,Tab0,Tab1,S0,S1,Dfn0,Dfn1,Dep0,Dep1,TP0,TP1, + edge_oldt(Clause,Ggoal,Tab0,Tab1,S0,S1,Dfn0,Dfn1,Dep0,Dep1,TP0,TP1, C0,C1,D0,D1), - map_oldt(Frames,Ggoal,Tab1,Tab,S1,S,Dfn1,Dfn,Dep1,Dep,TP1,TP,C1,C,D1,D). + find(Tab0,Ggoal,Ent), + ent_to_comp(Ent,Comp), + (Comp \== true-> + map_oldt(Frames,Ggoal,Tab1,Tab,S1,S,Dfn1,Dfn, + Dep1,Dep,TP1,TP,C1,C,D1,D) + ; + Tab=Tab1,S=S1,Dfn=Dfn1,Dep=Dep1,TP=TP1,C=C1,D=D1 + ). /* edge_oldt(Clause,Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP) Clause may be one of the following forms: @@ -470,9 +477,25 @@ edge_oldt(Clause,Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP,C0,C,D0,D) :- or to the D set if it is definite. The rule is added only if it is consistent with the current C set */ -add_ans_to_C(rule(_,_,def(N),_,S,_),C,C,D,[(N,S)|D],true):-!. +add_ans_to_C(rule(_,_,def(N),_,S,_),Tab,C,C,D,[(N,S)|D],true):-!. -add_ans_to_C(rule(_Ans,_B,R,N,S,LH),C0,C,D,D,HeadSelected):- +add_ans_to_C(rule(Goal,_B,R,N,S,LH),Tab,C0,C,D,D,HeadSelected):- + Goal=d(G,_D), + (find(Tab,G,Ent)-> + ent_to_anss(Ent,Anss), + (member_anss(d(G,[]),Anss)-> + C=C0, + HeadSelected=false + ; + add_to_C(R,N,S,LH,C0,C,HeadSelected) + ) + ; + add_to_C(R,N,S,LH,C0,C,HeadSelected) + ). + + + +add_to_C(R,N,S,LH,C0,C,HeadSelected):- member(N1,LH), (N1=N-> HeadSelected=true @@ -518,7 +541,7 @@ add_PC_to_C([rule(H,B,R,N,S)|T],C0,C):- add_PC_to_C(T,C1,C). ans_edge(rule(Ans,B,Rule,Number,Sub,LH),Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP,C0,C,D0,D) :- - add_ans_to_C(rule(Ans,B,Rule,Number,Sub,LH),C0,C1,D0,D1,HeadSelected), + add_ans_to_C(rule(Ans,B,Rule,Number,Sub,LH),Tab0,C0,C1,D0,D1,HeadSelected), (HeadSelected=false-> Tab = Tab0, S = S0, Dfn = Dfn0, Dep = Dep0, TP = TP0, C=C1, D=D1 ; @@ -1347,6 +1370,14 @@ succeeded(l(_,Lanss)) :- else fail. */ +add_ans(Tab0,Ggoal,Ans,Nodes,Mode,Tab) :- + Ans = d(H,[]), + ground(H), + H=Ggoal,!, + updatevs(Tab0,Ggoal,Ent0,Ent,Tab), + new_ans_ent1(Ent0,Ent,Ans,Nodes,Mode). + + add_ans(Tab0,Ggoal,Ans,Nodes,Mode,Tab) :- updatevs(Tab0,Ggoal,Ent0,Ent,Tab), Ans = d(H,Ds), @@ -1356,6 +1387,20 @@ add_ans(Tab0,Ggoal,Ans,Nodes,Mode,Tab) :- new_ans_ent(Ent0,Ent,d(H,NewDs),Nodes,Mode) ). +new_ans_ent1(Ent0,Ent,Ans,Nodes,Mode) :- + Ent0 = e(Nodes,ANegs,Anss0,Delay0,Comp,Dfn,Slist), + Ent = e(Nodes,ANegs,Anss,Delay,true,Dfn,Slist), + Ans = d(H,[]), + ( updatevs(Anss0,H,Lanss0,Lanss,Anss) -> + Lanss = [Ans], + Mode = no_new_head + ; addkey(Anss0,H,[Ans],Anss), + Mode = new_head + ), + Delay = Delay0 + . + + new_ans_ent(Ent0,Ent,Ans,Nodes,Mode) :- Ent0 = e(Nodes,ANegs,Anss0,Delay0,Comp,Dfn,Slist), Ent = e(Nodes,ANegs,Anss,Delay,Comp,Dfn,Slist), @@ -1763,7 +1808,7 @@ cmb5(t(NT2a,Mb,NT2b),T1,M2,M3,T3,t(n2(T1,M2,NT2a),Mb,n2(NT2b,M3,T3))). set(Parameter,Value) */ setting(epsilon_parsing,0.00001). setting(save_dot,false). -setting(ground_body,false). +setting(ground_body,true). /* find_rule(G,(R,S,N),Body,C) takes a goal G and the current C set and returns the index R of a disjunctive rule resolving with G together with diff --git a/pl/utils.yap b/pl/utils.yap index 219790eec..8a274f2f3 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -520,6 +520,10 @@ sub_atom(At, Bef, Size, After, SubAt) :- % extract something from an atom atom(At), integer(Bef), integer(Size), !, '$sub_atom_extract'(At, Bef, Size, After, SubAt). +sub_atom(At, Bef, Size, After, SubAt) :- + % extract subatom from an atom + atom(At), atom(SubAt), !, + '$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, 0). sub_atom(At, Bef, Size, After, SubAt) :- atom(At), !, atom_codes(At, Atl), @@ -532,6 +536,17 @@ sub_atom(At, Bef, Size, After, SubAt) :- '$do_error'(type_error(atom,At),sub_atom(At, Bef, Size,After, SubAt)). +'$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, I0) :- + '$sub_atom_fetch'(At, Bef1, Size, After1, SubAt, I0), + ( + Bef = Bef1, After = After1 + ; + Next is Bef1+1, + '$do_sub_atom_fetch'(At, Bef, Size, After, SubAt, Next) + ). + + + '$sub_atom2'(Bef, Atl, Size, After, SubAt, ErrorTerm) :- var(Bef), !, '$sub_atombv'(Bef, Size, After, SubAt, Atl, ErrorTerm).