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

Merge branch 'master' of gitosis@yap.dcc.fc.up.pt:yap-6

Browse Source
This commit is contained in:
Ricardo Rocha 2009-06-24 20:06:00 +01:00
commit c47da032a8
16 changed files with 249 additions and 115 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
C/absmi.c
View File

@ -977,18 +977,6 @@ Yap_absmi(int inp)
GONext(); GONext();
ENDOp(); 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); Op(retry_profiled, p);
LOCK(PREG->u.p.p->StatisticsForPred.lock); LOCK(PREG->u.p.p->StatisticsForPred.lock);
@ -1214,32 +1202,6 @@ Yap_absmi(int inp)
GONext(); GONext();
ENDOp(); 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 */ /* count_retry Label,NArgs */
Op(count_retry, p); Op(count_retry, p);
LOCK(PREG->u.p.p->StatisticsForPred.lock); 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 */ /* IPred can generate errors, it thus must get rid of the lock itself */
setregs(); 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) { if (!DebugOn) {
PREG = pe->cs.p_code.TrueCodeOfPred; PREG = pe->cs.p_code.TrueCodeOfPred;
UNLOCK(pe->PELock); UNLOCK(pe->PELock);

22
C/amasm.c
View File

@ -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); code_p = a_f2(TRUE, &cmp_info, code_p, pass_no, cip);
break; break;
case enter_profiling_op: 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; break;
case retry_profiled_op: case retry_profiled_op:
code_p = a_pl(_retry_profiled, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no); code_p = a_pl(_retry_profiled, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
break; break;
case count_call_op: case count_call_op:
{
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); code_p = a_pl(_count_call, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no);
}
}
break; break;
case count_retry_op: case count_retry_op:
code_p = a_pl(_count_retry, (PredEntry *)(cip->cpc->rnd1), code_p, pass_no); 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; code_p->u.p.p = PredMetaCall;
GONEXT(p); GONEXT(p);
} else { } 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->opc = opcode(_p_execute_tail);
code_p->u.Osbpp.s = emit_count(-Signed(RealEnvSize)-3*sizeof(CELL)); code_p->u.Osbpp.s = emit_count(-Signed(RealEnvSize)-3*sizeof(CELL));
code_p->u.Osbpp.bmap = NULL; code_p->u.Osbpp.bmap = NULL;

48
C/cdmgr.c
View File

@ -965,7 +965,7 @@ IPred(PredEntry *ap, UInt NSlots)
ap->cs.p_code.TrueCodeOfPred = BaseAddr; ap->cs.p_code.TrueCodeOfPred = BaseAddr;
ap->PredFlags |= IndexedPredFlag; ap->PredFlags |= IndexedPredFlag;
} }
if (ap->PredFlags & SpiedPredFlag) { if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred); ap->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -996,7 +996,7 @@ static void
RemoveMainIndex(PredEntry *ap) RemoveMainIndex(PredEntry *ap)
{ {
yamop *First = ap->cs.p_code.FirstClause; yamop *First = ap->cs.p_code.FirstClause;
int spied = ap->PredFlags & SpiedPredFlag; int spied = ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag);
ap->PredFlags &= ~IndexedPredFlag; ap->PredFlags &= ~IndexedPredFlag;
if (First == NULL) { if (First == NULL) {
@ -1006,7 +1006,7 @@ RemoveMainIndex(PredEntry *ap)
} }
if (First != NULL && spied) { if (First != NULL && spied) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred); 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 } else if (ap->cs.p_code.NOfClauses > 1
#ifdef TABLING #ifdef TABLING
||ap->PredFlags & TabledPredFlag ||ap->PredFlags & TabledPredFlag
@ -1587,6 +1587,10 @@ retract_all(PredEntry *p, int in_use)
p->PredFlags |= ProfiledPredFlag; p->PredFlags |= ProfiledPredFlag;
} else } else
p->PredFlags &= ~ProfiledPredFlag; p->PredFlags &= ~ProfiledPredFlag;
if (CALL_COUNTING) {
p->PredFlags |= CountPredFlag;
} else
p->PredFlags &= ~CountPredFlag;
#ifdef YAPOR #ifdef YAPOR
if (SEQUENTIAL_IS_DEFAULT) { if (SEQUENTIAL_IS_DEFAULT) {
p->PredFlags |= SequentialPredFlag; p->PredFlags |= SequentialPredFlag;
@ -1636,8 +1640,16 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
p->StatisticsForPred.NOfRetries = 0; p->StatisticsForPred.NOfRetries = 0;
if (PROFILING) { if (PROFILING) {
p->PredFlags |= ProfiledPredFlag; p->PredFlags |= ProfiledPredFlag;
} else spy_flag = TRUE;
} else {
p->PredFlags &= ~ProfiledPredFlag; p->PredFlags &= ~ProfiledPredFlag;
}
if (CALL_COUNTING) {
p->PredFlags |= CountPredFlag;
spy_flag = TRUE;
} else {
p->PredFlags &= ~CountPredFlag;
}
if (spy_flag) { if (spy_flag) {
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
@ -1666,8 +1678,16 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
p->StatisticsForPred.NOfRetries = 0; p->StatisticsForPred.NOfRetries = 0;
if (PROFILING) { if (PROFILING) {
p->PredFlags |= ProfiledPredFlag; p->PredFlags |= ProfiledPredFlag;
} else spy_flag = TRUE;
} else {
p->PredFlags &= ~ProfiledPredFlag; p->PredFlags &= ~ProfiledPredFlag;
}
if (CALL_COUNTING) {
p->PredFlags |= CountPredFlag;
spy_flag = TRUE;
} else {
p->PredFlags &= ~CountPredFlag;
}
#ifdef YAPOR #ifdef YAPOR
p->PredFlags |= SequentialPredFlag; p->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */ #endif /* YAPOR */
@ -1753,12 +1773,12 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag)
clq->ClNext = clp; clq->ClNext = clp;
clp->ClPrev = clq; clp->ClPrev = clq;
p->cs.p_code.FirstClause = q; p->cs.p_code.FirstClause = q;
if (p->PredFlags & SpiedPredFlag) { if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred); 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)) { } else if (!(p->PredFlags & IndexedPredFlag)) {
p->OpcodeOfPred = INDEX_OPCODE; 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 defined(YAPOR) || defined(THREADS)
if (p->ModuleOfPred != IDB_MODULE) { 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); cl->ClNext = ClauseCodeToStaticClause(p->cs.p_code.FirstClause);
p->cs.p_code.FirstClause = q; p->cs.p_code.FirstClause = q;
p->cs.p_code.TrueCodeOfPred = q; p->cs.p_code.TrueCodeOfPred = q;
if (p->PredFlags & SpiedPredFlag) { if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} else if (!(p->PredFlags & IndexedPredFlag)) { } else if (!(p->PredFlags & IndexedPredFlag)) {
@ -1840,7 +1860,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} }
#endif #endif
if (p->PredFlags & SpiedPredFlag) { if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} }
@ -1851,7 +1871,7 @@ assertz_stat_clause(PredEntry *p, yamop *cp, int spy_flag)
cl->ClNext = ClauseCodeToStaticClause(cp); cl->ClNext = ClauseCodeToStaticClause(cp);
} }
if (p->cs.p_code.FirstClause == p->cs.p_code.LastClause) { 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->OpcodeOfPred = INDEX_OPCODE;
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} }
@ -2075,7 +2095,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
if (pflags & IndexedPredFlag) { if (pflags & IndexedPredFlag) {
Yap_AddClauseToIndex(p, cp, mode == asserta); Yap_AddClauseToIndex(p, cp, mode == asserta);
} }
if (pflags & SpiedPredFlag) if (pflags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag))
spy_flag = TRUE; spy_flag = TRUE;
if (p == PredGoalExpansion) { if (p == PredGoalExpansion) {
Term tg = ArgOfTerm(1, tf); Term tg = ArgOfTerm(1, tf);
@ -2315,7 +2335,7 @@ Yap_EraseStaticClause(StaticClause *cl, Term mod) {
} else if (ap->cs.p_code.NOfClauses > 1) { } else if (ap->cs.p_code.NOfClauses > 1) {
ap->OpcodeOfPred = INDEX_OPCODE; ap->OpcodeOfPred = INDEX_OPCODE;
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); 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->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
} else { } else {
@ -2770,6 +2790,7 @@ p_rmspy(void)
return TRUE; return TRUE;
} }
#endif #endif
if (!(pred->PredFlags & (CountPredFlag|ProfiledPredFlag))) {
if (!(pred->PredFlags & DynamicPredFlag)) { if (!(pred->PredFlags & DynamicPredFlag)) {
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (pred->PredFlags & LogUpdatePredFlag && if (pred->PredFlags & LogUpdatePredFlag &&
@ -2789,6 +2810,7 @@ p_rmspy(void)
UNLOCK(pred->PELock); UNLOCK(pred->PELock);
return FALSE; return FALSE;
} }
}
pred->PredFlags ^= SpiedPredFlag; pred->PredFlags ^= SpiedPredFlag;
UNLOCK(pred->PELock); UNLOCK(pred->PELock);
return (TRUE); return (TRUE);

8
C/compiler.c
View File

@ -1090,10 +1090,6 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, Term Goal, Term mod, compiler_struct
save_machine_regs(); save_machine_regs();
longjmp(cglobs->cint.CompilerBotch, OUT_OF_HEAP_BOTCH); 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); c_args(Goal, 0, cglobs);
Yap_emit(safe_call_op, (CELL)p0 , Zero, &cglobs->cint); Yap_emit(safe_call_op, (CELL)p0 , Zero, &cglobs->cint);
Yap_emit(empty_call_op, Zero, 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; return;
} }
else if (op >= _plus && op <= _functor) { 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) { if (op == _functor) {
c_functor(Goal, mod, cglobs); c_functor(Goal, mod, cglobs);
} }

4
C/dbase.c
View File

@ -4253,7 +4253,7 @@ PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr)
code_p = p->cs.p_code.FirstClause; code_p = p->cs.p_code.FirstClause;
code_p->u.Otapl.d = p->cs.p_code.FirstClause; code_p->u.Otapl.d = p->cs.p_code.FirstClause;
p->cs.p_code.TrueCodeOfPred = NEXTOP(code_p, Otapl); 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->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
@ -4275,7 +4275,7 @@ PrepareToEraseLogUpdClause(LogUpdClause *clau, DBRef dbr)
p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->cs.p_code.TrueCodeOfPred = p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
} }
} else { } else {
if (p->PredFlags & SpiedPredFlag) { if (p->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
p->OpcodeOfPred = Yap_opcode(_spy_pred); p->OpcodeOfPred = Yap_opcode(_spy_pred);
p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred)); p->CodeOfPred = (yamop *)(&(p->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)

6
C/exec.c
View File

@ -77,12 +77,6 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
YENV[E_CB] = (CELL) cut_pt; YENV[E_CB] = (CELL) cut_pt;
} }
P = code; 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; return TRUE;
} }

12
C/globals.c
View File

@ -44,7 +44,7 @@ static char SccsId[] = "%W% %G%";
#define HEAP_DELAY_ARENA 3 #define HEAP_DELAY_ARENA 3
#define HEAP_START 4 #define HEAP_START 4
#define MIN_ARENA_SIZE 2048 #define MIN_ARENA_SIZE 1048
#define MAX_ARENA_SIZE (2048*16) #define MAX_ARENA_SIZE (2048*16)
#define Global_MkIntegerTerm(I) MkIntegerTerm(I) #define Global_MkIntegerTerm(I) MkIntegerTerm(I)
@ -1497,7 +1497,7 @@ p_nb_queue(void)
{ {
UInt arena_sz = (ASP-H)/16; UInt arena_sz = (ASP-H)/16;
if (DepthArenas > 1) if (DepthArenas > 1)
arena_sz /= log(MIN_ARENA_SIZE); arena_sz /= DepthArenas;
if (arena_sz < MIN_ARENA_SIZE) if (arena_sz < MIN_ARENA_SIZE)
arena_sz = MIN_ARENA_SIZE; arena_sz = MIN_ARENA_SIZE;
if (arena_sz > MAX_ARENA_SIZE) if (arena_sz > MAX_ARENA_SIZE)
@ -1579,9 +1579,10 @@ RecoverArena(Term arena)
CELL *pt = ArenaPt(arena), CELL *pt = ArenaPt(arena),
*max = ArenaLimit(arena); *max = ArenaLimit(arena);
if (max == H) if (max == H) {
H = pt; H = pt;
} }
}
static Int static Int
p_nb_queue_close(void) p_nb_queue_close(void)
@ -1612,7 +1613,10 @@ p_nb_queue_close(void)
Yap_unify(ARG3, qp[QUEUE_TAIL]) && Yap_unify(ARG3, qp[QUEUE_TAIL]) &&
Yap_unify(ARG2, qp[QUEUE_HEAD]); Yap_unify(ARG2, qp[QUEUE_HEAD]);
qp[-1] = (CELL)Yap_MkFunctor(AtomHeap,1); 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; return out;
} }
Yap_Error(INSTANTIATION_ERROR,t,"queue/3"); Yap_Error(INSTANTIATION_ERROR,t,"queue/3");

2
C/index.c
View File

@ -5997,7 +5997,7 @@ remove_from_index(PredEntry *ap, path_stack_entry *sp, ClauseDef *cls, yamop *bg
return; return;
} }
ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause; 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->OpcodeOfPred = Yap_opcode(_spy_pred);
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred)); ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)

65
C/stdpreds.c
View File

@ -2503,6 +2503,70 @@ p_sub_atom_extract(void)
goto start; 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 static Int
p_abort(void) p_abort(void)
@ -3929,6 +3993,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag); Yap_InitCPred("atom_length", 2, p_atom_length, SafePredFlag);
Yap_InitCPred("$atom_split", 4, p_atom_split, SafePredFlag|HiddenPredFlag); 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_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_chars", 2, p_number_chars, 0);
Yap_InitCPred("number_atom", 2, p_number_atom, 0); Yap_InitCPred("number_atom", 2, p_number_atom, 0);
Yap_InitCPred("number_codes", 2, p_number_codes, 0); Yap_InitCPred("number_codes", 2, p_number_codes, 0);

4
C/utilpreds.c
View File

@ -467,7 +467,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs) {
if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE; return FALSE;
goto restart_list; goto restart_list;
} else if (res && share && FunctorOfTerm(t) != FunctorMutable) { } else if (res && share) {
H = Hi; H = Hi;
return t; 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) if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L)
return FALSE; return FALSE;
goto restart_appl; goto restart_appl;
} else if (res && share) { } else if (res && share && FunctorOfTerm(t) != FunctorMutable) {
H = HB0; H = HB0;
return t; return t;
} }

2
H/YapOpcodes.h
View File

@ -8,14 +8,12 @@
OPCODE(retry_me ,Otapl), OPCODE(retry_me ,Otapl),
OPCODE(trust_me ,Otapl), OPCODE(trust_me ,Otapl),
OPCODE(enter_profiling ,p), OPCODE(enter_profiling ,p),
OPCODE(enter_a_profiling ,e),
OPCODE(retry_profiled ,p), OPCODE(retry_profiled ,p),
OPCODE(profiled_retry_me ,Otapl), OPCODE(profiled_retry_me ,Otapl),
OPCODE(profiled_trust_me ,Otapl), OPCODE(profiled_trust_me ,Otapl),
OPCODE(profiled_retry_logical ,OtaLl), OPCODE(profiled_retry_logical ,OtaLl),
OPCODE(profiled_trust_logical ,OtILl), OPCODE(profiled_trust_logical ,OtILl),
OPCODE(count_call ,p), OPCODE(count_call ,p),
OPCODE(count_a_call ,e),
OPCODE(count_retry ,p), OPCODE(count_retry ,p),
OPCODE(count_retry_me ,Otapl), OPCODE(count_retry_me ,Otapl),
OPCODE(count_trust_me ,Otapl), OPCODE(count_trust_me ,Otapl),

6
H/findclause.h
View File

@ -141,12 +141,6 @@
return; return;
cl = NEXTOP(cl,e); cl = NEXTOP(cl,e);
break; break;
case _count_a_call:
cl = NEXTOP(cl,e);
break;
case _enter_a_profiling:
cl = NEXTOP(cl,e);
break;
case _pop: case _pop:
cl = NEXTOP(cl,e); cl = NEXTOP(cl,e);
break; break;

2
H/rclause.h
View File

@ -194,11 +194,9 @@ restore_opcodes(yamop *pc)
case _Nstop: case _Nstop:
case _allocate: case _allocate:
case _copy_idb_term: case _copy_idb_term:
case _count_a_call:
case _cut: case _cut:
case _cut_e: case _cut_e:
case _cut_t: case _cut_t:
case _enter_a_profiling:
case _expand_index: case _expand_index:
case _index_blob: case _index_blob:
case _index_dbref: case _index_dbref:

2
H/walkclause.h
View File

@ -154,11 +154,9 @@
case _unify_idb_term: case _unify_idb_term:
return found_idb_clause(pc, startp, endp); return found_idb_clause(pc, startp, endp);
case _allocate: case _allocate:
case _count_a_call:
case _cut: case _cut:
case _cut_e: case _cut_e:
case _cut_t: case _cut_t:
case _enter_a_profiling:
case _index_blob: case _index_blob:
case _index_dbref: case _index_dbref:
case _index_long: case _index_long:

57
packages/cplint/lpad.pl
View File

@ -34,7 +34,7 @@
p/1, p/1,
slg/3,setting/2,set/2 slg/3,setting/2,set/2
]). ]).
:-source.
:- dynamic wfs_trace/0. :- dynamic wfs_trace/0.
:-use_module(library(ugraphs)). :-use_module(library(ugraphs)).
:-use_module(library(lists)). :-use_module(library(lists)).
@ -434,7 +434,14 @@ map_oldt([Clause|Frames],Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP,
C0,C,D0,D) :- 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), 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) /* edge_oldt(Clause,Ggoal,Tab0,Tab,S0,S,Dfn0,Dfn,Dep0,Dep,TP0,TP)
Clause may be one of the following forms: 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 or to the D set if it is definite. The rule is added only if it is consistent
with the current C set 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), member(N1,LH),
(N1=N-> (N1=N->
HeadSelected=true 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). 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) :- 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-> (HeadSelected=false->
Tab = Tab0, S = S0, Dfn = Dfn0, Dep = Dep0, TP = TP0, C=C1, D=D1 Tab = Tab0, S = S0, Dfn = Dfn0, Dep = Dep0, TP = TP0, C=C1, D=D1
; ;
@ -1347,6 +1370,14 @@ succeeded(l(_,Lanss)) :-
else else
fail. 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) :- add_ans(Tab0,Ggoal,Ans,Nodes,Mode,Tab) :-
updatevs(Tab0,Ggoal,Ent0,Ent,Tab), updatevs(Tab0,Ggoal,Ent0,Ent,Tab),
Ans = d(H,Ds), 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_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) :- new_ans_ent(Ent0,Ent,Ans,Nodes,Mode) :-
Ent0 = e(Nodes,ANegs,Anss0,Delay0,Comp,Dfn,Slist), Ent0 = e(Nodes,ANegs,Anss0,Delay0,Comp,Dfn,Slist),
Ent = e(Nodes,ANegs,Anss,Delay,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) */ set(Parameter,Value) */
setting(epsilon_parsing,0.00001). setting(epsilon_parsing,0.00001).
setting(save_dot,false). 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 /* 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 returns the index R of a disjunctive rule resolving with G together with

15
pl/utils.yap
View File

@ -520,6 +520,10 @@ sub_atom(At, Bef, Size, After, SubAt) :-
% extract something from an atom % extract something from an atom
atom(At), integer(Bef), integer(Size), !, atom(At), integer(Bef), integer(Size), !,
'$sub_atom_extract'(At, Bef, Size, After, SubAt). '$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) :- sub_atom(At, Bef, Size, After, SubAt) :-
atom(At), !, atom(At), !,
atom_codes(At, Atl), 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_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) :- '$sub_atom2'(Bef, Atl, Size, After, SubAt, ErrorTerm) :-
var(Bef), !, var(Bef), !,
'$sub_atombv'(Bef, Size, After, SubAt, Atl, ErrorTerm). '$sub_atombv'(Bef, Size, After, SubAt, Atl, ErrorTerm).