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

new meta-call scheme.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@751 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-01-29 14:47:17 +00:00
parent 0b17ff4174
commit 1369dfa410
24 changed files with 588 additions and 683 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

629
C/absmi.c
View File

@ -113,28 +113,6 @@ push_live_regs(yamop *pco)
} }
#endif #endif
static Term
PushModule(Term t,SMALLUNSGN mod) {
Functor f = FunctorOfTerm(t);
Term tmod = ModuleName[mod];
if (ArityOfFunctor(f) == 2) {
Term ti[2], tf[2];
ti[0] = tmod;
ti[1] = ArgOfTerm(1,t);
tf[0] = Yap_MkApplTerm(FunctorModule,2,ti);
ti[0] = tmod;
ti[1] = ArgOfTerm(2,t);
tf[1] = Yap_MkApplTerm(FunctorModule,2,ti);
return(Yap_MkApplTerm(f,2,tf));
} else {
Term ti[2], tf[1];
ti[0] = tmod;
ti[1] = ArgOfTerm(1,t);
tf[0] = Yap_MkApplTerm(FunctorModule,2,ti);
return(Yap_MkApplTerm(f,1,tf));
}
}
Int Int
Yap_absmi(int inp) Yap_absmi(int inp)
{ {
@ -469,21 +447,33 @@ Yap_absmi(int inp)
* Profiled try - retry - trust instructions * * Profiled try - retry - trust instructions *
*****************************************************************/ *****************************************************************/
/* profiled_enter_me Label,NArgs */ /* profiled_enter_me Pred */
Op(enter_profiling, l); Op(enter_profiling, p);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); LOCK(PREG->u.p.p->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfEntries++; PREG->u.p.p->StatisticsForPred.NOfEntries++;
UNLOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
PREG = NEXTOP(PREG, l); PREG = NEXTOP(PREG, p);
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(); GONext();
ENDOp(); ENDOp();
/* profiled_retry Label,NArgs */ /* profiled_retry Label,NArgs */
Op(retry_profiled, l); Op(retry_profiled, l);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); LOCK(PREG->u.p.p->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfRetries++; PREG->u.p.p->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
PREG = NEXTOP(PREG, l); PREG = NEXTOP(PREG, p);
GONext(); GONext();
ENDOp(); ENDOp();
@ -492,9 +482,9 @@ Yap_absmi(int inp)
CACHE_Y(B); CACHE_Y(B);
/* After retry, cut should be pointing at the parent /* After retry, cut should be pointing at the parent
* choicepoint for the current B */ * choicepoint for the current B */
LOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock); LOCK(PREG->u.ld.p->StatisticsForPred.lock);
((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.NOfRetries++; PREG->u.ld.p->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock); UNLOCK(PREG->u.ld.p->StatisticsForPred.lock);
restore_yaam_regs(PREG->u.ld.d); restore_yaam_regs(PREG->u.ld.d);
restore_args(PREG->u.ld.s); restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
@ -535,9 +525,9 @@ Yap_absmi(int inp)
} }
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
LOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock); LOCK(PREG->u.ld.p->StatisticsForPred.lock);
((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.NOfRetries++; PREG->u.ld.p->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock); UNLOCK(PREG->u.ld.p->StatisticsForPred.lock);
PREG = NEXTOP(PREG, ld); PREG = NEXTOP(PREG, ld);
GONext(); GONext();
ENDOp(); ENDOp();
@ -547,10 +537,10 @@ Yap_absmi(int inp)
*****************************************************************/ *****************************************************************/
/* count_enter_me Label,NArgs */ /* count_enter_me Label,NArgs */
Op(count_call, l); Op(count_call, p);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); LOCK(PREG->u.p.p->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfEntries++; PREG->u.p.p->StatisticsForPred.NOfEntries++;
UNLOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
ReductionsCounter--; ReductionsCounter--;
if (ReductionsCounter == 0 && ReductionsCounterOn) { if (ReductionsCounter == 0 && ReductionsCounterOn) {
saveregs(); saveregs();
@ -565,15 +555,41 @@ Yap_absmi(int inp)
setregs(); setregs();
JMPNext(); JMPNext();
} }
PREG = NEXTOP(PREG, l); PREG = NEXTOP(PREG, p);
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(); GONext();
ENDOp(); ENDOp();
/* count_retry Label,NArgs */ /* count_retry Label,NArgs */
Op(count_retry, l); Op(count_retry, p);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); LOCK(PREG->u.p.p->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfRetries++; PREG->u.p.p->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock); UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
RetriesCounter--; RetriesCounter--;
if (RetriesCounter == 0 && RetriesCounterOn) { if (RetriesCounter == 0 && RetriesCounterOn) {
saveregs(); saveregs();
@ -588,7 +604,7 @@ Yap_absmi(int inp)
setregs(); setregs();
JMPNext(); JMPNext();
} }
PREG = NEXTOP(PREG, l); PREG = NEXTOP(PREG, p);
GONext(); GONext();
ENDOp(); ENDOp();
@ -11706,42 +11722,93 @@ Yap_absmi(int inp)
BOp(p_execute, sla); BOp(p_execute, sla);
{ {
PredEntry *pen; PredEntry *pen;
SMALLUNSGN mod = IntOfTerm(Deref(ARG2)); SMALLUNSGN mod = PREG->u.sla.sla_u.m_num;
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
/* Try to preserve the environment */
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
#ifndef NO_CHECKING #ifndef NO_CHECKING
check_stack(NoStackCall, H); check_stack(NoStackCall, H);
#endif #endif
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
#else
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
#endif
}
#else
if (E_YREG > (CELL *) B) {
E_YREG = (CELL *) B;
}
#endif /* FROZEN_STACKS */
BEGD(d0); BEGD(d0);
d0 = ARG1; d0 = ARG1;
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) { restart_execute:
d0 = Yap_ExecuteCallMetaCall(mod);
}
deref_head(d0, execute_unk); deref_head(d0, execute_unk);
execute_nvar: execute_nvar:
if (IsApplTerm(d0)) { if (IsApplTerm(d0)) {
Functor f = FunctorOfTerm(d0); Functor f = FunctorOfTerm(d0);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
d0 = Yap_ExecuteCallMetaCall(mod); goto execute_metacall;
goto execute_nvar;
} }
pen = RepPredProp(PredPropByFunc(f, mod)); pen = RepPredProp(PredPropByFunc(f, mod));
if (pen->PredFlags & MetaPredFlag) { if (pen->PredFlags & MetaPredFlag) {
if (f == FunctorModule) { if (f == FunctorModule) {
Term tmod = Yap_LookupModule(ArgOfTerm(1,d0)); Term tmod = ArgOfTerm(1,d0);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod) && if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
Yap_LookupModule(tmod) == mod) {
d0 = ArgOfTerm(2,d0); d0 = ArgOfTerm(2,d0);
mod = Yap_LookupModule(tmod);
goto execute_nvar; goto execute_nvar;
} }
} } else if (f == FunctorComma) {
if (pen->PredFlags & PushModPredFlag) { SREG = RepAppl(d0);
d0 = PushModule(d0,mod); BEGD(d1);
d1 = SREG[2];
/* create an to execute the call */
deref_head(d1, execute_comma_unk);
execute_comma_nvar:
if (IsAtomTerm(d1)) {
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
} else if (IsApplTerm(d1)) {
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f)) {
goto execute_metacall;
} else { } else {
d0 = Yap_ExecuteCallMetaCall(mod); E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
goto execute_nvar; }
} else {
goto execute_metacall;
}
E_YREG[E_CP] = (CELL)NEXTOP(PREG,sla);
E_YREG[E_CB] = (CELL)B;
E_YREG[E_E] = (CELL)ENV;
#ifdef DEPTH_LIMIT
E_YREG[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */
E_YREG[-EnvSizeInCells-1] = d1;
E_YREG[-EnvSizeInCells-3] = MkIntTerm(mod);
ENV = E_YREG;
E_YREG -= EnvSizeInCells+3;
PREG = COMMA_CODE;
d0 = SREG[1];
goto restart_execute;
BEGP(pt1);
deref_body(d1, pt1, execute_comma_unk, execute_comma_nvar);
goto execute_metacall;
ENDP(pt1);
ENDD(d1);
} else {
goto execute_metacall;
} }
} }
if (PRED_GOAL_EXPANSION_ON) {
goto execute_metacall;
}
BEGP(pt1); BEGP(pt1);
pt1 = RepAppl(d0); pt1 = RepAppl(d0);
BEGD(d2); BEGD(d2);
@ -11749,10 +11816,11 @@ Yap_absmi(int inp)
#if SBA #if SBA
BEGD(d1); BEGD(d1);
d1 = pt1[d2]; d1 = pt1[d2];
if (d1 == 0) if (d1 == 0) {
XREGS[d2] = (CELL)(pt1+d2); XREGS[d2] = (CELL)(pt1+d2);
else } else {
XREGS[d2] = d1; XREGS[d2] = d1;
}
#else #else
XREGS[d2] = pt1[d2]; XREGS[d2] = pt1[d2];
#endif #endif
@ -11761,16 +11829,17 @@ Yap_absmi(int inp)
ENDP(pt1); ENDP(pt1);
CACHE_A1(); CACHE_A1();
} else if (IsAtomTerm(d0)) { } else if (IsAtomTerm(d0)) {
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod)); if (PRED_GOAL_EXPANSION_ON) {
goto execute_metacall;
} else { } else {
d0 = Yap_ExecuteCallMetaCall(mod); pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
goto execute_nvar; }
} else {
goto execute_metacall;
} }
execute_end:
/* code copied from call */ /* code copied from call */
ENV = E_YREG;
/* Try to preserve the environment */
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
CPREG = CPREG =
(yamop *) NEXTOP(PREG, sla); (yamop *) NEXTOP(PREG, sla);
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred); ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
@ -11789,20 +11858,6 @@ Yap_absmi(int inp)
if (Yap_do_low_level_trace) if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1); low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACER */ #endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
#else
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
#endif
}
#else
if (E_YREG > (CELL *) B) {
E_YREG = (CELL *) B;
}
#endif /* FROZEN_STACKS */
WRITEBACK_Y_AS_ENV(); WRITEBACK_Y_AS_ENV();
/* setup GB */ /* setup GB */
E_YREG[E_CB] = (CELL) B; E_YREG[E_CB] = (CELL) B;
@ -11814,259 +11869,35 @@ Yap_absmi(int inp)
BEGP(pt1); BEGP(pt1);
deref_body(d0, pt1, execute_unk, execute_nvar); deref_body(d0, pt1, execute_unk, execute_nvar);
d0 = Yap_ExecuteCallMetaCall(mod); execute_metacall:
goto execute_nvar; ARG1 = ARG3 = d0;
pen = PredMetaCall;
ARG2 = Yap_cp_as_integer(B);
ARG4 = ModuleName[mod];
goto execute_end;
ENDP(pt1); ENDP(pt1);
ENDD(d0);
ENDCACHE_Y_AS_ENV();
}
ENDBOp();
BOp(p_execute_within, sla);
{
PredEntry *pen;
SMALLUNSGN mod = CurrentModule;
CACHE_Y_AS_ENV(YREG);
#ifndef NO_CHECKING
check_stack(NoStackCall, H);
#endif
BEGD(d0);
d0 = ARG1;
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
d0 = Yap_ExecuteCallMetaCall(mod);
}
deref_head(d0, execute_within_unk);
execute_within_nvar:
if (IsApplTerm(d0)) {
Functor f = FunctorOfTerm(d0);
if (IsExtensionFunctor(f)) {
d0 = Yap_ExecuteCallMetaCall(mod);
goto execute_within_nvar;
}
pen = RepPredProp(PredPropByFunc(f, mod));
if (pen->PredFlags & MetaPredFlag) {
if (f == FunctorModule) {
Term tmod;
tmod = ArgOfTerm(1,d0);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod) &&
mod == Yap_LookupModule(tmod)) {
d0 = ArgOfTerm(2,d0);
goto execute_within_nvar;
}
}
if (pen->PredFlags & PushModPredFlag) {
d0 = PushModule(d0,mod);
} else {
d0 = Yap_ExecuteCallMetaCall(mod);
goto execute_within_nvar;
}
}
BEGP(pt1);
pt1 = RepAppl(d0);
BEGD(d2);
for (d2 = ArityOfFunctor(f); d2; d2--) {
#if SBA
BEGD(d1);
d1 = pt1[d2];
if (d1 == 0)
XREGS[d2] = (CELL)(pt1+d2);
else
XREGS[d2] = d1;
#else
XREGS[d2] = pt1[d2];
#endif
}
ENDD(d2);
ENDP(pt1);
CACHE_A1();
} else if (IsAtomTerm(d0)) {
if (AtomOfTerm(d0) == AtomCut) {
choiceptr pt0;
pt0 = (choiceptr)(ENV[E_CB]);
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,pt0)) {
#ifdef YAPOR
/* Wow, we're gonna cut!!! */
CUT_prune_to(pt0);
#else
/* Wow, we're gonna cut!!! */
B = pt0;
#endif /* YAPOR */
HB = PROTECT_FROZEN_H(B);
}
PREG = NEXTOP(PREG, sla);
JMPNext();
}else
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
} else {
d0 = Yap_ExecuteCallMetaCall(mod);
goto execute_within_nvar;
}
/* code copied from call */
ENV = E_YREG;
/* Try to preserve the environment */
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
CPREG =
(yamop *) NEXTOP(PREG, sla);
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
PREG = pen->CodeOfPred;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pen->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef SBA
if (E_YREG > (CELL *) top_b || E_YREG < H) E_YREG = (CELL *) top_b;
#else
if (E_YREG > (CELL *) top_b) E_YREG = (CELL *) top_b;
#endif
}
#else
if (E_YREG > (CELL *) B) {
E_YREG = (CELL *) B;
}
#endif /* FROZEN_STACKS */
WRITEBACK_Y_AS_ENV();
/* setup GB */
if (pen->PredFlags & CutTransparentPredFlag)
E_YREG[E_CB] = ENV[E_CB];
else
E_YREG[E_CB] = (CELL)B;
#ifdef YAPOR
SCH_check_requests();
#endif /* YAPOR */
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
BEGP(pt1);
deref_body(d0, pt1, execute_within_unk, execute_within_nvar);
d0 = Yap_ExecuteCallMetaCall(mod);
goto execute_within_nvar;
ENDP(pt1);
ENDD(d0); ENDD(d0);
ENDCACHE_Y_AS_ENV(); ENDCACHE_Y_AS_ENV();
} }
ENDBOp(); ENDBOp();
BOp(p_last_execute_within, sla); BOp(p_execute_tail, e);
{ {
PredEntry *pen; PredEntry *pen;
SMALLUNSGN mod = CurrentModule; SMALLUNSGN mod;
UInt arity;
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
#ifndef NO_CHECKING #ifndef NO_CHECKING
check_stack(NoStackCall, H); check_stack(NoStackCall, H);
#endif #endif
BEGP(pt0);
BEGD(d0); BEGD(d0);
d0 = ARG1; d0 = E_YREG[-EnvSizeInCells-1];
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) { pen = RepPredProp((Prop)IntegerOfTerm(E_YREG[-EnvSizeInCells-2]));
d0 = Yap_ExecuteCallMetaCall(mod);
}
deref_head(d0, last_execute_within_unk);
last_execute_within_nvar:
if (IsApplTerm(d0)) {
Functor f = FunctorOfTerm(d0);
if (IsExtensionFunctor(f)) {
d0 = Yap_ExecuteCallMetaCall(mod);
goto last_execute_within_nvar;
}
pen = RepPredProp(PredPropByFunc(f, mod));
if (pen->PredFlags & MetaPredFlag) {
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,d0);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod) &&
mod == Yap_LookupModule(tmod)) {
d0 = ArgOfTerm(2,d0);
goto last_execute_within_nvar;
}
}
if (pen->PredFlags & PushModPredFlag) {
d0 = PushModule(d0,mod);
} else {
d0 = Yap_ExecuteCallMetaCall(mod);
goto last_execute_within_nvar;
}
}
BEGP(pt1);
pt1 = RepAppl(d0);
BEGD(d2);
for (d2 = ArityOfFunctor(f); d2; d2--) {
#if SBA
BEGD(d1);
d1 = pt1[d2];
if (d1 == 0)
XREGS[d2] = (CELL)(pt1+d2);
else
XREGS[d2] = d1;
#else
XREGS[d2] = pt1[d2];
#endif
}
ENDD(d2);
ENDP(pt1);
CACHE_A1();
} else if (IsAtomTerm(d0)) {
if (AtomOfTerm(d0) == AtomCut) {
choiceptr pt0;
pt0 = (choiceptr)(ENV[E_CB]);
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,pt0)) {
#ifdef YAPOR
/* Wow, we're gonna cut!!! */
CUT_prune_to(pt0);
#else
/* Wow, we're gonna cut!!! */
B = pt0;
#endif /* YAPOR */
HB = PROTECT_FROZEN_H(B);
}
PREG = NEXTOP(PREG, sla);
JMPNext();
}else
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
} else {
d0 = Yap_ExecuteCallMetaCall(mod);
goto last_execute_within_nvar;
}
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
BEGD(d0);
if (pen->PredFlags & CutTransparentPredFlag)
d0 = ENV[E_CB];
else
d0 = (CELL)B;
PREG = pen->CodeOfPred;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pen->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
/* do deallocate */
CPREG = (yamop *) E_YREG[E_CP]; CPREG = (yamop *) E_YREG[E_CP];
pt0 = E_YREG;
E_YREG = ENV = (CELL *) E_YREG[E_E]; E_YREG = ENV = (CELL *) E_YREG[E_E];
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
@ -12087,19 +11918,159 @@ Yap_absmi(int inp)
E_YREG = (CELL *) ((CELL) E_YREG+ ENV_Size(CPREG)); E_YREG = (CELL *) ((CELL) E_YREG+ ENV_Size(CPREG));
} }
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
arity = pen->ArityOfPE;
if (pen->PredFlags & MetaPredFlag) {
mod = IntOfTerm(pt0[-EnvSizeInCells-3]);
if (pen->FunctorOfPred == FunctorComma) {
SREG = RepAppl(d0);
BEGD(d1);
d1 = SREG[2];
/* create an to execute the call */
deref_head(d1, execute_comma_comma_unk);
execute_comma_comma_nvar:
E_YREG[E_CB] = (CELL)pt0[E_CB];
if (IsAtomTerm(d1)) {
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
} else if (IsApplTerm(d1)) {
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f)) {
goto execute_metacall_after_comma;
} else {
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
}
} else {
goto execute_metacall_after_comma;
}
E_YREG[E_CP] = (CELL)CPREG;
E_YREG[E_E] = (CELL)ENV;
#ifdef DEPTH_LIMIT
E_YREG[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */
E_YREG[-EnvSizeInCells-1] = d1;
E_YREG[-EnvSizeInCells-3] = MkIntTerm(mod);
ENV = E_YREG;
E_YREG -= EnvSizeInCells+3;
d0 = SREG[1];
CPREG = NEXTOP(COMMA_CODE,sla);
/* create an to execute the call */
deref_head(d0, execute_comma_comma2_unk);
execute_comma_comma2_nvar:
if (IsAtomTerm(d0)) {
Atom at = AtomOfTerm(d0);
arity = 0;
if (at == AtomCut) {
choiceptr cut_pt = (choiceptr)ENV[E_CB];
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,cut_pt)) {
#ifdef YAPOR
/* Wow, we're gonna cut!!! */
CUT_prune_to(cut_pt);
#else
/* Wow, we're gonna cut!!! */
B = cut_pt;
#endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
HB = PROTECT_FROZEN_H(B);
}
}
pen = RepPredProp(PredPropByAtom(at, mod));
goto execute_comma;
} else if (IsApplTerm(d0)) {
Functor f = FunctorOfTerm(d0);
if (IsExtensionFunctor(f)) {
goto execute_metacall_after_comma;
} else {
pen = RepPredProp(PredPropByFunc(f,mod));
if (pen->PredFlags & MetaPredFlag) {
goto execute_metacall_after_comma;
}
arity = pen->ArityOfPE;
goto execute_comma;
}
} else {
goto execute_metacall_after_comma;
}
BEGP(pt1);
deref_body(d0, pt1, execute_comma_comma2_unk, execute_comma_comma2_nvar);
goto execute_metacall_after_comma;
ENDP(pt1);
BEGP(pt1);
deref_body(d1, pt1, execute_comma_comma_unk, execute_comma_comma_nvar);
goto execute_metacall_after_comma;
ENDP(pt1);
ENDD(d1);
} else {
execute_metacall_after_comma:
ARG1 = ARG3 = d0;
pen = PredMetaCall;
ARG2 = Yap_cp_as_integer((choiceptr)ENV[E_CB]);
ARG4 = ModuleName[mod];
goto execute_after_comma;
}
}
execute_comma:
if (arity) {
BEGP(pt1);
pt1 = RepAppl(d0);
BEGD(d2);
for (d2 = arity; d2; d2--) {
#if SBA
BEGD(d1);
d1 = pt1[d2];
if (d1 == 0)
XREGS[d2] = (CELL)(pt1+d2);
else
XREGS[d2] = d1;
#else
XREGS[d2] = pt1[d2];
#endif
}
ENDD(d2);
ENDP(pt1);
CACHE_A1();
} else if ((Atom)(pen->FunctorOfPred) == AtomCut) {
choiceptr cut_pt = (choiceptr)ENV[E_CB];
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,cut_pt)) {
#ifdef YAPOR
/* Wow, we're gonna cut!!! */
CUT_prune_to(cut_pt);
#else
/* Wow, we're gonna cut!!! */
B = cut_pt;
#endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
HB = PROTECT_FROZEN_H(B);
}
}
execute_after_comma:
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
PREG = pen->CodeOfPred;
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pen->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pen->ModuleOfPred) {
DEPTH -= MkIntConstant(2);
}
#endif /* DEPTH_LIMIT */
/* do deallocate */
WRITEBACK_Y_AS_ENV(); WRITEBACK_Y_AS_ENV();
/* setup GB */
E_YREG[E_CB] = d0;
ENDD(d0);
ALWAYS_GONext(); ALWAYS_GONext();
ALWAYS_END_PREFETCH(); ALWAYS_END_PREFETCH();
BEGP(pt1);
deref_body(d0, pt1, last_execute_within_unk, last_execute_within_nvar);
d0 = Yap_ExecuteCallMetaCall(mod);
goto last_execute_within_nvar;
ENDP(pt1);
ENDD(d0); ENDD(d0);
ENDP(pt0);
ENDCACHE_Y_AS_ENV(); ENDCACHE_Y_AS_ENV();
} }

4
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * comments: allocating space *
* version:$Id: alloc.c,v 1.30 2002-12-03 06:06:43 vsc Exp $ * * version:$Id: alloc.c,v 1.31 2003-01-29 14:47:07 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -143,8 +143,6 @@ AddToFreeList(BlockHeader *b)
*q = b; *q = b;
} }
long int call_counter;
static void static void
FreeBlock(BlockHeader *b) FreeBlock(BlockHeader *b)
{ {

62
C/amasm.c
View File

@ -776,25 +776,27 @@ a_p(op_numbers opcode)
if (Flags & UserCPredFlag) { if (Flags & UserCPredFlag) {
code_p->opc = emit_op(_call_usercpred); code_p->opc = emit_op(_call_usercpred);
} else { } else {
if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod) if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod) {
code_p->opc = emit_op(_p_execute); code_p->opc = emit_op(_p_execute);
else if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteWithin) } else {
code_p->opc = emit_op(_p_execute_within);
else if (RepPredProp(fe)->FunctorOfPred == FunctorLastExecuteWithin)
code_p->opc = emit_op(_p_last_execute_within);
else
code_p->opc = emit_op(_call_cpred); code_p->opc = emit_op(_call_cpred);
} }
}
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE
* (cpc->rnd2)); * (cpc->rnd2));
if (RepPredProp(fe)->FunctorOfPred != FunctorExecuteInMod) {
code_p->u.sla.sla_u.p = RepPredProp(fe); code_p->u.sla.sla_u.p = RepPredProp(fe);
} else {
code_p->u.sla.sla_u.m_num = IntegerOfTerm(cpc->rnd4);
}
code_p->u.sla.p0 = CurrentPred; code_p->u.sla.p0 = CurrentPred;
if (cpc->rnd2) if (cpc->rnd2) {
code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]); code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
else } else {
/* there is no bitmap as there are no variables in the environment */ /* there is no bitmap as there are no variables in the environment */
code_p->u.sla.bmap = NULL; code_p->u.sla.bmap = NULL;
} }
}
GONEXT(sla); GONEXT(sla);
} }
if (!comit_ok) { if (!comit_ok) {
@ -891,9 +893,9 @@ a_pl(op_numbers opcode, PredEntry *pred)
{ {
if (pass_no) { if (pass_no) {
code_p->opc = emit_op(opcode); code_p->opc = emit_op(opcode);
code_p->u.l.l = emit_a((CELL)pred); code_p->u.p.p = (PredEntry *)emit_a((CELL)pred);
} }
GONEXT(l); GONEXT(p);
} }
static wamreg static wamreg
@ -2616,3 +2618,43 @@ Yap_assemble(int mode)
} }
} }
void
Yap_InitComma(void)
{
yamop *code_p = COMMA_CODE;
code_p->opc = opcode(_call);
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - sizeof(CELL) * 3);
code_p->u.sla.sla_u.p =
code_p->u.sla.p0 =
RepPredProp(PredPropByFunc(FunctorComma,2));
code_p->u.sla.bmap = NULL;
GONEXT(sla);
if (PRED_GOAL_EXPANSION_ON) {
Functor fp = Yap_MkFunctor(Yap_FullLookupAtom("$generate_pred_info"),4);
code_p->opc = emit_op(_call_cpred);
code_p->u.sla.s = emit_count(-Signed(RealEnvSize));
code_p->u.sla.sla_u.p = RepPredProp(Yap_GetPredPropByFunc(fp,0));
code_p->u.sla.bmap = NULL;
GONEXT(sla);
code_p->opc = emit_op(_call);
code_p->u.sla.s = emit_count(-Signed(RealEnvSize));
code_p->u.sla.sla_u.p = PredMetaCall;
code_p->u.sla.bmap = NULL;
GONEXT(sla);
code_p->opc = emit_op(_deallocate);
GONEXT(e);
code_p->opc = emit_op(_procceed);
GONEXT(e);
} 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);
GONEXT(e);
}
}

90
C/cdmgr.c
View File

@ -435,6 +435,10 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
pt->u.ld.d = cp; pt->u.ld.d = cp;
pt->u.ld.p = p; pt->u.ld.p = p;
if (p == PredGoalExpansion) {
PRED_GOAL_EXPANSION_ON = TRUE;
Yap_InitComma();
}
#ifdef YAPOR #ifdef YAPOR
if (SEQUENTIAL_IS_DEFAULT) { if (SEQUENTIAL_IS_DEFAULT) {
p->PredFlags |= SequentialPredFlag; p->PredFlags |= SequentialPredFlag;
@ -489,6 +493,10 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
{ {
yamop *ncp = ((Clause *)NIL)->ClCode; yamop *ncp = ((Clause *)NIL)->ClCode;
Clause *cl; Clause *cl;
if (p == PredGoalExpansion) {
PRED_GOAL_EXPANSION_ON = TRUE;
Yap_InitComma();
}
p->StatisticsForPred.NOfEntries = 0; p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0; p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0; p->StatisticsForPred.NOfRetries = 0;
@ -2206,9 +2214,11 @@ p_is_profiled(void)
s = RepAtom(AtomOfTerm(t))->StrOfAE; s = RepAtom(AtomOfTerm(t))->StrOfAE;
if (strcmp(s,"on") == 0) { if (strcmp(s,"on") == 0) {
PROFILING = TRUE; PROFILING = TRUE;
Yap_InitComma();
return(TRUE); return(TRUE);
} else if (strcmp(s,"off") == 0) { } else if (strcmp(s,"off") == 0) {
PROFILING = FALSE; PROFILING = FALSE;
Yap_InitComma();
return(TRUE); return(TRUE);
} }
return(FALSE); return(FALSE);
@ -2311,9 +2321,11 @@ p_is_call_counted(void)
s = RepAtom(AtomOfTerm(t))->StrOfAE; s = RepAtom(AtomOfTerm(t))->StrOfAE;
if (strcmp(s,"on") == 0) { if (strcmp(s,"on") == 0) {
CALL_COUNTING = TRUE; CALL_COUNTING = TRUE;
Yap_InitComma();
return(TRUE); return(TRUE);
} else if (strcmp(s,"off") == 0) { } else if (strcmp(s,"off") == 0) {
CALL_COUNTING = FALSE; CALL_COUNTING = FALSE;
Yap_InitComma();
return(TRUE); return(TRUE);
} }
return(FALSE); return(FALSE);
@ -2511,82 +2523,6 @@ p_hidden_predicate(void)
return(pe->PredFlags & HiddenPredFlag); return(pe->PredFlags & HiddenPredFlag);
} }
static Int /* $cut_transparent(P) */
p_cut_transparent(void)
{
PredEntry *pe;
Term t1 = Deref(ARG1);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t1), 0));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return(FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"system_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"system_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, 0));
} else
return (FALSE);
if (EndOfPAEntr(pe))
return(FALSE);
pe->PredFlags |= CutTransparentPredFlag;
return(TRUE);
}
static Int /* $is_push_pred_mod(P,M) */
p_is_push_pred_mod(void)
{
PredEntry *pe;
Term t1 = Deref(ARG1);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t1), 0));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return(FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR,ARG1,"system_predicate/1");
return(FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM,ARG1,"system_predicate/1");
return(FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, 0));
} else
return (FALSE);
if (EndOfPAEntr(pe))
return(FALSE);
return(pe->PredFlags & CutTransparentPredFlag);
}
void void
Yap_InitCdMgr(void) Yap_InitCdMgr(void)
{ {
@ -2626,11 +2562,9 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag); Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
Yap_InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag); Yap_InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);
Yap_InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag); Yap_InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag);
Yap_InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag);
Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag); Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag);
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag); Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
Yap_InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag); Yap_InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag);
Yap_InitCPred("$current_stack", 1, p_current_stack, SyncPredFlag); Yap_InitCPred("$current_stack", 1, p_current_stack, SyncPredFlag);
Yap_InitCPred("$is_push_pred_mod", 2, p_is_push_pred_mod, SyncPredFlag);
} }

12
C/compiler.c
View File

@ -1590,15 +1590,19 @@ c_goal(Term Goal, int mod)
#endif #endif
} }
return; return;
} } else {
else {
if (profiling) if (profiling)
Yap_emit(enter_profiling_op, (CELL)p, Zero); Yap_emit(enter_profiling_op, (CELL)p, Zero);
else if (call_counting) else if (call_counting)
Yap_emit(count_call_op, (CELL)p, Zero); Yap_emit(count_call_op, (CELL)p, Zero);
if (f == FunctorExecuteInMod) {
/* compile the first argument only */
c_arg(1, ArgOfTerm(1,Goal), 1, 0);
} else {
c_args(Goal, 0); c_args(Goal, 0);
} }
} }
}
if (p->PredFlags & SafePredFlag if (p->PredFlags & SafePredFlag
#ifdef YAPOR #ifdef YAPOR
@ -1628,7 +1632,11 @@ c_goal(Term Goal, int mod)
if (p->PredFlags & SyncPredFlag) if (p->PredFlags & SyncPredFlag)
Yap_emit(sync_op, (CELL)p, (CELL)(p->ArityOfPE)); Yap_emit(sync_op, (CELL)p, (CELL)(p->ArityOfPE));
#endif /* YAPOR */ #endif /* YAPOR */
if (p->FunctorOfPred == FunctorExecuteInMod) {
Yap_emit_4ops(call_op, (CELL) p0, Zero, Zero, ArgOfTerm(2,Goal));
} else {
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero); Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero);
}
/* functor is allowed to call the garbage collector */ /* functor is allowed to call the garbage collector */
if (onlast) { if (onlast) {
Yap_emit(deallocate_op, Zero, Zero); Yap_emit(deallocate_op, Zero, Zero);

20
C/computils.c
View File

@ -139,6 +139,26 @@ Yap_emit_3ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3)
} }
} }
void
Yap_emit_4ops (compiler_vm_op o, CELL r1, CELL r2, CELL r3, CELL r4)
{
PInstr *p;
p = (PInstr *) AllocCMem (sizeof (*p)+2*sizeof(CELL));
p->op = o;
p->rnd1 = r1;
p->rnd2 = r2;
p->rnd3 = r3;
p->rnd4 = r4;
p->nextInst = NIL;
if (cpc == NIL)
cpc = CodeStart = p;
else
{
cpc->nextInst = p;
cpc = p;
}
}
CELL * CELL *
Yap_emit_extra_size (compiler_vm_op o, CELL r1, int size) Yap_emit_extra_size (compiler_vm_op o, CELL r1, int size)
{ {

245
C/exec.c
View File

@ -29,9 +29,15 @@ STATIC_PROTO(Int p_execute0, (void));
STATIC_PROTO(Int p_at_execute, (void)); STATIC_PROTO(Int p_at_execute, (void));
static Term static Term
current_cp_as_integer(void) cp_as_integer(choiceptr cp)
{ {
return(MkIntTerm(LCL0-(CELL *)B)); return(MkIntTerm(LCL0-(CELL *)cp));
}
Term
Yap_cp_as_integer(choiceptr cp)
{
return cp_as_integer(cp);
} }
static inline Int static inline Int
@ -68,7 +74,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) {
inline static Int inline static Int
CallMetaCall(SMALLUNSGN mod) { CallMetaCall(SMALLUNSGN mod) {
ARG2 = current_cp_as_integer(); /* p_save_cp */ ARG2 = cp_as_integer(B); /* p_save_cp */
ARG3 = ARG1; ARG3 = ARG1;
ARG4 = ModuleName[mod]; ARG4 = ModuleName[mod];
return (CallPredicate(PredMetaCall, B)); return (CallPredicate(PredMetaCall, B));
@ -78,7 +84,7 @@ Term
Yap_ExecuteCallMetaCall(SMALLUNSGN mod) { Yap_ExecuteCallMetaCall(SMALLUNSGN mod) {
Term ts[4]; Term ts[4];
ts[0] = ARG1; ts[0] = ARG1;
ts[1] = current_cp_as_integer(); /* p_save_cp */ ts[1] = cp_as_integer(B); /* p_save_cp */
ts[2] = ARG1; ts[2] = ARG1;
ts[3] = ModuleName[mod]; ts[3] = ModuleName[mod];
return(Yap_MkApplTerm(PredMetaCall->FunctorOfPred,4,ts)); return(Yap_MkApplTerm(PredMetaCall->FunctorOfPred,4,ts));
@ -186,7 +192,7 @@ p_save_cp(void)
register CELL *HBREG = HB; register CELL *HBREG = HB;
#endif #endif
if (!IsVarTerm(t)) return(FALSE); if (!IsVarTerm(t)) return(FALSE);
td = current_cp_as_integer(); td = cp_as_integer(B);
BIND((CELL *)t,td,bind_save_cp); BIND((CELL *)t,td,bind_save_cp);
#ifdef COROUTINING #ifdef COROUTINING
DO_TRAIL(CellPtr(t), td); DO_TRAIL(CellPtr(t), td);
@ -198,7 +204,7 @@ p_save_cp(void)
static Int static Int
EnterCreepMode(SMALLUNSGN mod) { EnterCreepMode(SMALLUNSGN mod) {
PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy,0)); PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy,1));
Term tn = Yap_MkApplTerm(Yap_MkFunctor(AtomMetaCall,1),1,&ARG1); Term tn = Yap_MkApplTerm(Yap_MkFunctor(AtomMetaCall,1),1,&ARG1);
ARG1 = MkPairTerm(ModuleName[mod],tn); ARG1 = MkPairTerm(ModuleName[mod],tn);
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
@ -206,35 +212,12 @@ EnterCreepMode(SMALLUNSGN mod) {
return (CallPredicate(PredSpy, B)); return (CallPredicate(PredSpy, B));
} }
/* push module inside so that it will visible to the next calls */
static Term
PushModule(Term t,SMALLUNSGN mod) {
Functor f = FunctorOfTerm(t);
Term tmod = ModuleName[mod];
if (ArityOfFunctor(f) == 2) {
Term ti[2], tf[2];
ti[0] = tmod;
ti[1] = ArgOfTerm(1,t);
tf[0] = Yap_MkApplTerm(FunctorModule,2,ti);
ti[0] = tmod;
ti[1] = ArgOfTerm(2,t);
tf[1] = Yap_MkApplTerm(FunctorModule,2,ti);
return(Yap_MkApplTerm(f,2,tf));
} else {
Term ti[2], tf[1];
ti[0] = tmod;
ti[1] = ArgOfTerm(1,t);
tf[0] = Yap_MkApplTerm(FunctorModule,2,ti);
return(Yap_MkApplTerm(f,1,tf));
}
}
inline static Int inline static Int
do_execute(Term t, SMALLUNSGN mod) do_execute(Term t, SMALLUNSGN mod)
{ {
if (yap_flags[SPY_CREEP_FLAG]) { if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod)); return(EnterCreepMode(mod));
} else if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) { } else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCall(mod)); return(CallMetaCall(mod));
} }
restart_exec: restart_exec:
@ -263,12 +246,39 @@ do_execute(Term t, SMALLUNSGN mod)
t = ArgOfTerm(2,t); t = ArgOfTerm(2,t);
goto restart_exec; goto restart_exec;
} }
} else if (f == FunctorComma) {
Term d1 = ArgOfTerm(2,t);
YENV = ASP;
if (IsVarTerm(d1)) {
return CallMetaCall(mod);
} }
if (pen->PredFlags & PushModPredFlag) { if (IsAtomTerm(d1)) {
t = PushModule(t,mod); YENV[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
} else if (IsApplTerm(d1)) {
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f)) {
return CallMetaCall(mod);
} else { } else {
return(CallMetaCall(mod)); YENV[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
} }
} else {
return CallMetaCall(mod);
}
YENV[E_CP] = (CELL)P;
YENV[E_CB] = (CELL)B;
YENV[E_E] = (CELL)ENV;
#ifdef DEPTH_LIMIT
YENV[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */
YENV[-EnvSizeInCells-1] = d1;
YENV[-EnvSizeInCells-3] = MkIntTerm(mod);
ENV = YENV;
ASP -= EnvSizeInCells+3;
P = NEXTOP(COMMA_CODE,sla);
t = ArgOfTerm(1,t);
goto restart_exec;
}
return(CallMetaCall(mod));
} }
/* now let us do what we wanted to do from the beginning !! */ /* now let us do what we wanted to do from the beginning !! */
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
@ -279,7 +289,7 @@ do_execute(Term t, SMALLUNSGN mod)
#if SBA #if SBA
Term d0 = *pt++; Term d0 = *pt++;
if (d0 == 0) if (d0 == 0)
XREGS[i] = (CELL)(pt-1); ` XREGS[i] = (CELL)(pt-1);
else else
XREGS[i] = d0; XREGS[i] = d0;
#else #else
@ -320,9 +330,12 @@ p_execute_in_mod(void)
} }
inline static Int inline static Int
CallMetaCallWithin(void) CallMetaCallWithin(SMALLUNSGN mod, choiceptr cpt)
{ {
return (CallPredicate(PredMetaCall, B)); if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod));
}
return (CallPredicate(PredMetaCall, cpt));
} }
/* '$execute_within'(Goal,CutPt,OrigGoal,Mod) */ /* '$execute_within'(Goal,CutPt,OrigGoal,Mod) */
@ -342,12 +355,7 @@ p_execute_within(void)
#endif #endif
restart_exec: restart_exec:
if (yap_flags[SPY_CREEP_FLAG]) { if (IsVarTerm(t)) {
return(EnterCreepMode(mod));
} else if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
return(CallMetaCallWithin());
/* at this point check if we should enter creep mode */
} else if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, mod); return CallError(INSTANTIATION_ERROR, mod);
} else if (IsApplTerm(t)) { } else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t); register Functor f = FunctorOfTerm(t);
@ -376,12 +384,14 @@ p_execute_within(void)
goto restart_exec; goto restart_exec;
} }
} }
if (pen->PredFlags & PushModPredFlag) { return(CallMetaCallWithin(mod, B));
t = PushModule(t,mod); }
/* at this point check if we should enter creep mode */
if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod));
} else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCallWithin(mod, B));
} else { } else {
return(CallMetaCallWithin());
}
}
/* now let us do what we wanted to do from the beginning !! */ /* now let us do what we wanted to do from the beginning !! */
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
otherwise I would dereference the argument and otherwise I would dereference the argument and
@ -400,6 +410,7 @@ p_execute_within(void)
} }
return (CallPredicate(pen, cut_pt)); return (CallPredicate(pen, cut_pt));
} }
}
} else if (IsAtomOrIntTerm(t)) { } else if (IsAtomOrIntTerm(t)) {
if (IsIntTerm(t)) { if (IsIntTerm(t)) {
return CallError(TYPE_ERROR_CALLABLE, mod); return CallError(TYPE_ERROR_CALLABLE, mod);
@ -427,125 +438,20 @@ p_execute_within(void)
return(FALSE); return(FALSE);
} else { } else {
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod));
} else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCallWithin(mod, B));
}
pe = PredPropByAtom(a, mod); pe = PredPropByAtom(a, mod);
return (CallPredicate(RepPredProp(pe), cut_pt)); return (CallPredicate(RepPredProp(pe), cut_pt));
} }
} else { } else {
/* Is Pair Term */ /* Is Pair Term */
return(CallMetaCallWithin()); return(CallMetaCallWithin(mod,B));
} }
} }
/* '$execute_within2'(Goal) */
static Int
p_execute_within2(void)
{
Term t = Deref(ARG1);
Prop pe;
SMALLUNSGN mod = CurrentModule;
restart_exec:
if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(CurrentModule));
} else if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
return(CallMetaCallWithin());
} else if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, CurrentModule);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
if (IsExtensionFunctor(f)) {
return CallError(TYPE_ERROR_CALLABLE, mod);
}
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
mod = Yap_LookupModule(tmod);
t = ArgOfTerm(2,t);
goto restart_exec;
}
}
{
PredEntry *pen;
CELL *dest;
register CELL *pt;
register unsigned int i;
unsigned int arity = ArityOfFunctor(f);
pe = PredPropByFunc(f, mod);
pen = RepPredProp(pe);
/* You thought we would be over by now */
/* but no meta calls require special preprocessing */
if (pen->PredFlags & MetaPredFlag) {
if (pen->PredFlags & PushModPredFlag) {
t = PushModule(t,mod);
} else {
return(CallMetaCallWithin());
}
}
/* at this point check if we should enter creep mode */
/* now let us do what we wanted to do from the beginning !! */
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
might skip a svar */
pt = RepAppl(t)+1;
dest = XREGS+1;
for (i = 0; i < arity; ++i) {
#if SBA
Term d0 = *pt++;
if (d0 == 0)
*dest++ = (CELL)(pt-1);
else
*dest++ = d0;
#else
*dest++ = *pt++;
#endif
}
if (pen->PredFlags & CutTransparentPredFlag)
return (CallPredicate(pen, (choiceptr)(ENV[E_CB])));
else
return (CallPredicate(pen, B));
}
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
if (a == AtomTrue || a == AtomOtherwise)
return(TRUE);
else if (a == AtomCut) {
choiceptr pt0;
pt0 = (choiceptr)(ENV[E_CB]);
/* find where to cut to */
if (SHOULD_CUT_UP_TO(B,pt0)) {
#ifdef YAPOR
/* Wow, we're gonna cut!!! */
CUT_prune_to(pt0);
#else
/* Wow, we're gonna cut!!! */
B = pt0;
#endif /* YAPOR */
#ifdef TABLING
abolish_incomplete_subgoals(B);
#endif /* TABLING */
HB = PROTECT_FROZEN_H(B);
}
return(TRUE);
} else if (a == AtomFail || a == AtomFalse) {
return(FALSE);
}
/* call may not define new system predicates!! */
pe = PredPropByAtom(a, CurrentModule);
return (CallPredicate(RepPredProp(pe), B));
} else if (IsIntTerm(t)) {
return CallError(TYPE_ERROR_CALLABLE, mod);
} else {
/* Is Pair Term */
return(CallMetaCallWithin());
}
}
static Int static Int
p_execute0(void) p_execute0(void)
{ /* '$execute0'(Goal,Mod) */ { /* '$execute0'(Goal,Mod) */
@ -578,9 +484,6 @@ p_execute0(void)
} }
} }
pe = PredPropByFunc(f, mod); pe = PredPropByFunc(f, mod);
if (RepPredProp(pe)->PredFlags & PushModPredFlag) {
t = PushModule(t,mod);
}
arity = ArityOfFunctor(f); arity = ArityOfFunctor(f);
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
otherwise I would dereference the argument and otherwise I would dereference the argument and
@ -1225,7 +1128,7 @@ static Int
p_pred_goal_expansion_on(void) { p_pred_goal_expansion_on(void) {
/* a goal needs expansion if we have goal_expansion defined or /* a goal needs expansion if we have goal_expansion defined or
if the goal is a meta-call */ if the goal is a meta-call */
return (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE); return PRED_GOAL_EXPANSION_ON;
} }
static Int static Int
@ -1262,9 +1165,6 @@ p_at_execute(void)
Yap_Error(TYPE_ERROR_ATOM, ARG1, "calling clause in debugger"); Yap_Error(TYPE_ERROR_ATOM, ARG1, "calling clause in debugger");
} }
pe = PredPropByFunc(f,mod); pe = PredPropByFunc(f,mod);
if (RepPredProp(pe)->PredFlags & PushModPredFlag) {
t = PushModule(t,mod);
}
arity = ArityOfFunctor(f); arity = ArityOfFunctor(f);
a = NameOfFunctor(f); a = NameOfFunctor(f);
/* I cannot use the standard macro here because /* I cannot use the standard macro here because
@ -1681,6 +1581,7 @@ p_clean_ifcp(void) {
return(TRUE); return(TRUE);
} }
static Int static Int
JumpToEnv(Term t) { JumpToEnv(Term t) {
yamop *pos = PredDollarCatch->cs.p_code.LastClause; yamop *pos = PredDollarCatch->cs.p_code.LastClause;
@ -1754,6 +1655,15 @@ p_jump_env(void) {
return(JumpToEnv(Deref(ARG1))); return(JumpToEnv(Deref(ARG1)));
} }
/* set up a meta-call based on . context info */
static Int
p_generate_pred_info(void) {
ARG1 = ARG3 = ENV[-EnvSizeInCells-1];
ARG4 = ModuleName[IntOfTerm(ENV[-EnvSizeInCells-3])];
ARG2 = cp_as_integer((choiceptr)ENV[E_CB]);
return TRUE;
}
void void
Yap_InitYaamRegs(void) Yap_InitYaamRegs(void)
{ {
@ -1802,14 +1712,14 @@ Yap_InitYaamRegs(void)
#endif #endif
} }
void void
Yap_InitExecFs(void) Yap_InitExecFs(void)
{ {
Yap_InitComma();
Yap_InitCPred("$execute", 1, p_execute, 0); Yap_InitCPred("$execute", 1, p_execute, 0);
Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0); Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
Yap_InitCPred("$execute_within", 4, p_execute_within, 0); Yap_InitCPred("$execute_within", 4, p_execute_within, 0);
Yap_InitCPred("$execute_within", 1, p_execute_within2, 0);
Yap_InitCPred("$last_execute_within", 1, p_execute_within2, 0);
Yap_InitCPred("$execute", 3, p_at_execute, 0); Yap_InitCPred("$execute", 3, p_at_execute, 0);
Yap_InitCPred("$call_with_args", 2, p_execute_0, 0); Yap_InitCPred("$call_with_args", 2, p_execute_0, 0);
Yap_InitCPred("$call_with_args", 3, p_execute_1, 0); Yap_InitCPred("$call_with_args", 3, p_execute_1, 0);
@ -1832,5 +1742,6 @@ Yap_InitExecFs(void)
Yap_InitCPred("$restore_regs", 2, p_restore_regs2, SafePredFlag); Yap_InitCPred("$restore_regs", 2, p_restore_regs2, SafePredFlag);
Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag); Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag);
Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0); Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0);
Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, 0);
} }

1
C/init.c
View File

@ -763,6 +763,7 @@ InitCodes(void)
heap_regs->consultcapacity = InitialConsultCapacity; heap_regs->consultcapacity = InitialConsultCapacity;
heap_regs->system_profiling = FALSE; heap_regs->system_profiling = FALSE;
heap_regs->system_call_counting = FALSE; heap_regs->system_call_counting = FALSE;
heap_regs->system_pred_goal_expansion_on = FALSE;
heap_regs->update_mode = 0; heap_regs->update_mode = 0;
heap_regs->consultbase = heap_regs->consultsp = heap_regs->consultbase = heap_regs->consultsp =
heap_regs->consultlow + heap_regs->consultcapacity; heap_regs->consultlow + heap_regs->consultcapacity;

1
C/scanner.c
View File

@ -256,7 +256,6 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
return 127; return 127;
} else if (ch >= 'a' && ch < 'z') {/* octal */ } else if (ch >= 'a' && ch < 'z') {/* octal */
return ch - 'a'; return ch - 'a';
ch = QuotedNxtch(inp_stream);
} else if (ch >= 'A' && ch < 'Z') {/* octal */ } else if (ch >= 'A' && ch < 'Z') {/* octal */
return ch - 'A'; return ch - 'A';
} else { } else {

2
C/tracer.c
View File

@ -119,7 +119,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* if (vsc_count > 500000) exit(0); */ /* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return; */ /* if (gc_calls < 1) return; */
#if defined(__GNUC__) #if defined(__GNUC__)
fprintf(Yap_stderr,"%llu ", vsc_count); fprintf(Yap_stderr,"%llu %p", vsc_count, B);
#endif #endif
/* check_trail_consistency(); */ /* check_trail_consistency(); */
if (pred == NULL) { if (pred == NULL) {

6
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.36 2002-12-27 16:53:08 vsc Exp $ * * version: $Id: Heap.h,v 1.37 2003-01-29 14:47:12 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -57,6 +57,7 @@ typedef struct various_codes {
yamop tablecompletioncode; yamop tablecompletioncode;
yamop tableanswerresolutioncode; yamop tableanswerresolutioncode;
#endif /* TABLING */ #endif /* TABLING */
yamop comma_code[5];
OPCODE failcode; OPCODE failcode;
OPCODE failcode_1; OPCODE failcode_1;
OPCODE failcode_2; OPCODE failcode_2;
@ -121,6 +122,7 @@ typedef struct various_codes {
struct pred_entry *spy_code; struct pred_entry *spy_code;
int system_profiling; int system_profiling;
int system_call_counting; int system_call_counting;
int system_pred_goal_expansion_on;
int compiler_optimizer_on; int compiler_optimizer_on;
int compiler_compile_mode; int compiler_compile_mode;
struct pred_entry *compiler_current_pred; struct pred_entry *compiler_current_pred;
@ -348,6 +350,7 @@ typedef struct various_codes {
#define COMPLETION ((yamop *)&(heap_regs->tablecompletioncode )) #define COMPLETION ((yamop *)&(heap_regs->tablecompletioncode ))
#define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode )) #define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode ))
#endif /* TABLING */ #endif /* TABLING */
#define COMMA_CODE heap_regs->comma_code
#define FAILCODE ((CODEADDR)&(heap_regs->failcode )) #define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
#define FAILCODE ((CODEADDR)&(heap_regs->failcode )) #define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
#define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode )) #define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode ))
@ -366,6 +369,7 @@ typedef struct various_codes {
#endif #endif
#define PROFILING heap_regs->system_profiling #define PROFILING heap_regs->system_profiling
#define CALL_COUNTING heap_regs->system_call_counting #define CALL_COUNTING heap_regs->system_call_counting
#define PRED_GOAL_EXPANSION_ON heap_regs->system_pred_goal_expansion_on
#define UPDATE_MODE heap_regs->update_mode #define UPDATE_MODE heap_regs->update_mode
#define RETRY_C_RECORDED_CODE heap_regs->retry_recorded_code #define RETRY_C_RECORDED_CODE heap_regs->retry_recorded_code
#define RETRY_C_RECORDED_K_CODE heap_regs->retry_recorded_k_code #define RETRY_C_RECORDED_K_CODE heap_regs->retry_recorded_k_code

6
H/YapOpcodes.h
View File

@ -248,11 +248,13 @@
OPCODE(save_appl_x_write ,ox), OPCODE(save_appl_x_write ,ox),
OPCODE(save_appl_y_write ,oy), OPCODE(save_appl_y_write ,oy),
OPCODE(enter_profiling ,l), OPCODE(enter_profiling ,l),
OPCODE(enter_a_profiling ,e),
OPCODE(retry_profiled ,l), OPCODE(retry_profiled ,l),
OPCODE(profiled_retry_me ,ld), OPCODE(profiled_retry_me ,ld),
OPCODE(profiled_trust_me ,ld), OPCODE(profiled_trust_me ,ld),
OPCODE(profiled_retry_and_mark ,ld), OPCODE(profiled_retry_and_mark ,ld),
OPCODE(count_call ,l), OPCODE(count_call ,l),
OPCODE(count_a_call ,e),
OPCODE(count_retry ,l), OPCODE(count_retry ,l),
OPCODE(count_retry_me ,ld), OPCODE(count_retry_me ,ld),
OPCODE(count_trust_me ,ld), OPCODE(count_trust_me ,ld),
@ -359,6 +361,6 @@
OPCODE(p_func2f_yx ,yxx), OPCODE(p_func2f_yx ,yxx),
OPCODE(p_func2f_yy ,yyx), OPCODE(p_func2f_yy ,yyx),
OPCODE(p_execute ,sla), OPCODE(p_execute ,sla),
OPCODE(p_execute_within ,sla), OPCODE(p_execute_tail ,e)
OPCODE(p_last_execute_within ,sla)

2
H/amidefs.h
View File

@ -60,7 +60,7 @@ typedef enum {
} op_numbers; } op_numbers;
#define _std_top _p_last_execute_within #define _std_top _p_execute_tail
typedef enum { typedef enum {
_atom, _atom,

4
H/clause.h
View File

@ -119,6 +119,7 @@ typedef struct clause_struct {
/* amasm.c */ /* amasm.c */
wamreg STD_PROTO(Yap_emit_x,(CELL)); wamreg STD_PROTO(Yap_emit_x,(CELL));
wamreg STD_PROTO(Yap_compile_cmp_flags,(PredEntry *)); wamreg STD_PROTO(Yap_compile_cmp_flags,(PredEntry *));
void STD_PROTO(Yap_InitComma,(void));
/* cdmgr.c */ /* cdmgr.c */
void STD_PROTO(Yap_RemoveLogUpdIndex,(Clause *)); void STD_PROTO(Yap_RemoveLogUpdIndex,(Clause *));
@ -128,6 +129,9 @@ void STD_PROTO(Yap_addclause,(Term,yamop *,int,int));
/* dbase.c */ /* dbase.c */
void STD_PROTO(Yap_ErCl,(Clause *)); void STD_PROTO(Yap_ErCl,(Clause *));
/* exec.c */
Term STD_PROTO(Yap_cp_as_integer,(choiceptr));
/* index.c */ /* index.c */
yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *)); yamop *STD_PROTO(Yap_PredIsIndexable,(PredEntry *));

4
H/compile.h
View File

@ -194,9 +194,10 @@ typedef struct PSEUDO {
} ops; } ops;
} PInstr; } PInstr;
#define rnd2 ops.oprnd2
#define arnds ops.opseqt #define arnds ops.opseqt
#define rnd2 ops.oprnd2
#define rnd3 ops.opseqt[1] #define rnd3 ops.opseqt[1]
#define rnd4 ops.opseqt[2]
typedef struct VENTRY { typedef struct VENTRY {
CELL SelfOfVE; CELL SelfOfVE;
@ -253,6 +254,7 @@ typedef struct CEXPENTRY {
yamop *STD_PROTO(Yap_assemble,(int)); yamop *STD_PROTO(Yap_assemble,(int));
void STD_PROTO(Yap_emit,(compiler_vm_op,Int,CELL)); void STD_PROTO(Yap_emit,(compiler_vm_op,Int,CELL));
void STD_PROTO(Yap_emit_3ops,(compiler_vm_op,CELL,CELL,CELL)); void STD_PROTO(Yap_emit_3ops,(compiler_vm_op,CELL,CELL,CELL));
void STD_PROTO(Yap_emit_4ops,(compiler_vm_op,CELL,CELL,CELL,CELL));
CELL *STD_PROTO(Yap_emit_extra_size,(compiler_vm_op,CELL,int)); CELL *STD_PROTO(Yap_emit_extra_size,(compiler_vm_op,CELL,int));
char *STD_PROTO(Yap_AllocCMem,(int)); char *STD_PROTO(Yap_AllocCMem,(int));
int STD_PROTO(Yap_is_a_test_pred,(Term, SMALLUNSGN)); int STD_PROTO(Yap_is_a_test_pred,(Term, SMALLUNSGN));

11
H/rheap.h
View File

@ -700,6 +700,9 @@ RestoreClause(Clause *Cl, int mode)
case _p_dif: case _p_dif:
case _p_eq: case _p_eq:
case _p_functor: case _p_functor:
case _p_execute_tail:
case _enter_a_profiling:
case _count_a_call:
#ifdef YAPOR #ifdef YAPOR
case _getwork_first_time: case _getwork_first_time:
#endif #endif
@ -770,18 +773,18 @@ RestoreClause(Clause *Cl, int mode)
pc = NEXTOP(pc,y); pc = NEXTOP(pc,y);
break; break;
/* instructions type sla */ /* instructions type sla */
case _p_execute:
goto sla_full;
case _fcall: case _fcall:
case _call: case _call:
case _p_execute:
case _p_execute_within:
case _p_last_execute_within:
#ifdef YAPOR #ifdef YAPOR
case _or_last: case _or_last:
#endif #endif
pc->u.sla.sla_u.p = PtoPredAdjust(pc->u.sla.sla_u.p);
sla_full:
if (pc->u.sla.bmap != NULL) { if (pc->u.sla.bmap != NULL) {
pc->u.sla.bmap = CellPtoHeapAdjust(pc->u.sla.bmap); pc->u.sla.bmap = CellPtoHeapAdjust(pc->u.sla.bmap);
} }
pc->u.sla.sla_u.p = PtoPredAdjust(pc->u.sla.sla_u.p);
pc->u.sla.p0 = PtoPredAdjust(pc->u.sla.p0); pc->u.sla.p0 = PtoPredAdjust(pc->u.sla.p0);
pc = NEXTOP(pc,sla); pc = NEXTOP(pc,sla);
break; break;

2
include/YapInterface.h
View File

@ -7,7 +7,7 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: c_interface.h * * File: YapInterface.h *
* Last rev: 19/2/88 * * Last rev: 19/2/88 *
* mods: * * mods: *
* comments: c_interface header file for YAP * * comments: c_interface header file for YAP *

2
library/random/random.c
View File

@ -8,7 +8,7 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: regexp.c * * File: random.c *
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: regular expression interpreter * * comments: regular expression interpreter *

8
m4/Yatom.h.m4
View File

@ -162,11 +162,9 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
CodeOfPred holds the address of the correspondent C-function. CodeOfPred holds the address of the correspondent C-function.
*/ */
typedef enum { typedef enum {
PushModPredFlag = 0x8000000L, /* may need module to be set */ CountPredFlag = 0x2000000L, /* count calls to pred */
CountPredFlag = 0x4000000L, /* count calls to pred */ HiddenPredFlag = 0x1000000L, /* invisible predicate */
HiddenPredFlag = 0x2000000L, /* invisible predicate */ CArgsPredFlag = 0x800000L, /* SWI-like C-interface pred. */
CArgsPredFlag = 0x1000000L, /* SWI-like C-interface pred. */
CutTransparentPredFlag = 0x800000L, /* ! should ! across */
SourcePredFlag = 0x400000L, /* static predicate with source declaration */ SourcePredFlag = 0x400000L, /* static predicate with source declaration */
MetaPredFlag = 0x200000L, /* predicate subject to a meta declaration */ MetaPredFlag = 0x200000L, /* predicate subject to a meta declaration */
SyncPredFlag = 0x100000L, /* has to synch before it can execute*/ SyncPredFlag = 0x100000L, /* has to synch before it can execute*/

20
pl/arith.yap
View File

@ -45,11 +45,8 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
OUT = (A \= B). OUT = (A \= B).
'$do_c_built_in'(call(G), OUT) :- '$do_c_built_in'(call(G), OUT) :-
nonvar(G), nonvar(G),
G = (Mod:G1), G = (Mod:G1), !,
atom(Mod), '$do_c_built_metacall'(G1, Mod, OUT).
!,
'$module_number'(Mod,MNum),
OUT = '$execute_in_mod'(G1,MNum).
'$do_c_built_in'(recorded(K,T,R), OUT) :- '$do_c_built_in'(recorded(K,T,R), OUT) :-
nonvar(K), nonvar(K),
!, !,
@ -78,6 +75,19 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
'$do_and'(R0, Comp, R). '$do_and'(R0, Comp, R).
'$do_c_built_in'(P, P). '$do_c_built_in'(P, P).
'$do_c_built_metacall'(G1, Mod, call(Mod:G1)) :-
var(G1), var(Mod), !.
'$do_c_built_metacall'(G1, Mod, '$execute_in_mod'(G1,MNum)) :-
var(G1), atom(Mod), !,
'$module_number'(Mod,MNum).
'$do_c_built_metacall'(Mod:G1, _, call(Mod:G1)) :- !,
'$do_c_built_metacall'(G1, Mod, OUT).
'$do_c_built_metacall'(G1, Mod, '$execute_in_mod'(G1,MNum)) :-
atom(Mod), !,
'$module_number'(Mod,MNum).
'$do_c_built_metacall'(G1, Mod, call(Mod:G1)).
'$do_and'(true, P, P) :- !. '$do_and'(true, P, P) :- !.
'$do_and'(P, true, P) :- !. '$do_and'(P, true, P) :- !.
'$do_and'(P, Q, (P,Q)). '$do_and'(P, Q, (P,Q)).

34
pl/boot.yap
View File

@ -680,32 +680,6 @@ incore(G) :- '$execute'(G).
'$call'(G, CP, G0, M). '$call'(G, CP, G0, M).
','(A,B) :-
'$execute_within'(A),
'$last_execute_within'(B).
% Be careful with -> cutting through
(A;B) :- (A = ( T->G) ->
( '$execute_within'(T) -> '$execute_within'(G) ; '$execute_within'(A) ; '$execute_within'(B) )
;
( '$execute_within'(A) ; '$execute_within'(B) ) ).
'|'(A,B) :- (A = ( T->G) ->
( '$execute_within'(T) -> '$execute_within'(G) ; '$execute_within'(A) ; '$execute_within'(B) )
;
( '$execute_within'(A) ; '$execute_within'(B) ) ).
'->'(A,B) :-
( '$execute_within'(A) ->
'$last_execute_within'(B) ).
\+(A) :-
\+ '$execute_within'(A).
not(A) :-
\+ '$execute_within'(A).
'$call'(M:_,_,G0,_) :- var(M), !, '$call'(M:_,_,G0,_) :- var(M), !,
'$do_error'(instantiation_error,call(G0)). '$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_) :- !, '$call'(M:G,CP,G0,_) :- !,
@ -733,6 +707,14 @@ not(A) :-
; ;
'$execute_within'(B,CP,G0,M) '$execute_within'(B,CP,G0,M)
). ).
'$call'((X->Y| Z),CP,G0,M) :- !,
(
'$execute_within'(X,CP,G0,M)
->
'$execute_within'(Y,CP,G0,M)
;
'$execute_within'(Z,CP,G0,M)
).
'$call'((A|B),CP, G0,M) :- !, '$call'((A|B),CP, G0,M) :- !,
( (
'$execute_within'(A,CP,G0,M) '$execute_within'(A,CP,G0,M)

51
pl/debug.yap
View File

@ -269,12 +269,6 @@ debugging :-
/* called from prolog module */ /* called from prolog module */
'$execute0'(G,Module), '$execute0'(G,Module),
'$creep'. '$creep'.
'$spy'([Module|G]) :-
% '$format'(user_error,"$spym(~w,~w)~n",[Module,G]),
'$is_push_pred_mod'(G,Module),
!,
'$creep',
'$execute0'(G,Module).
'$spy'([Mod|G]) :- '$spy'([Mod|G]) :-
'$do_spy'(G,Mod). '$do_spy'(G,Mod).
@ -300,17 +294,44 @@ debugging :-
'$execute0'(G,M), '$execute0'(G,M),
'$creep' '$creep'
). ).
'$direct_spy'([M|G]) :-
'$is_push_pred_mod'(G,M),
!,
'$creep',
'$execute0'(G,M).
'$direct_spy'([Mod|G]) :- '$direct_spy'([Mod|G]) :-
'$do_spy'(G, Mod). '$do_spy'(G, Mod).
'$do_spy'(true, _) :- !, '$creep'. '$do_spy'(true, _) :- !, '$creep'.
'$do_spy'('$cut_by'(M), _) :- !, '$cut_by'(M). '$do_spy'('$cut_by'(M), _) :- !, '$cut_by'(M).
'$do_spy'((A,B),M) :- !,
'$save_current_choice_point'(CP),
'$do_spy'(A,M),
'$call'(B,CP,(A,B),M).
'$do_spy'((T->A;B),M) :- !,
'$save_current_choice_point'(CP),
( '$do_spy'(T,M) -> '$call'(A,CP,(T->A;B),M)
;
'$call'(B,CP,(T->A;B),M)
).
'$do_spy'((A;B),M) :- !,
'$save_current_choice_point'(CP),
( '$do_spy'(A,M)
;
'$call'(B,CP,(A;B),M)
).
'$do_spy'((T->A|B),M) :- !,
'$save_current_choice_point'(CP),
( '$do_spy'(T,M) -> '$call'(A,CP,(T->A|B),M)
;
'$call'(B,CP,(T->A|B),M)
).
'$do_spy'((A|B),M) :- !,
'$save_current_choice_point'(CP),
( '$do_spy'(A,M)
;
'$call'(B,CP,(A|B),M)
).
'$do_spy'((\+G),M) :- !,
\+ '$do_spy'(G,M).
'$do_spy'((not(G)),M) :- !,
\+ '$do_spy'(G,M).
'$do_spy'(G, Module) :- '$do_spy'(G, Module) :-
% write(user_error,$spy(G)), nl, % write(user_error,$spy(G)), nl,
'$get_value'(debug,1), /* ditto if debug off */ '$get_value'(debug,1), /* ditto if debug off */
@ -748,16 +769,12 @@ debugging :-
'$execute'(M:Goal). '$execute'(M:Goal).
'$creep'([M|V]) :- var(V), !, '$creep'([M|V]) :- var(V), !,
'$do_error'(instantiation_error,M:call(M:V)). '$do_error'(instantiation_error,M:call(M:V)).
'$creep'([_|M:V]) :- !,
'$creep'([M|V]).
'$creep'([M|'$execute_in_mod'(G,ModNum)]) :- !, '$creep'([M|'$execute_in_mod'(G,ModNum)]) :- !,
'$module_number'(Mod,ModNum), '$module_number'(Mod,ModNum),
'$clean_module_for_creep'(G,Mod,TrueMod,TrueG), '$clean_module_for_creep'(G,Mod,TrueMod,TrueG),
'$creep'([TrueMod|TrueG]). '$creep'([TrueMod|TrueG]).
'$creep'([M|'$execute_within'(G)]) :- !,
'$clean_module_for_creep'(G,M,TrueMod,TrueG),
'$creep'([TrueMod|TrueG]).
'$creep'([M|'$last_execute_within'(G)]) :- !,
'$clean_module_for_creep'(G,M,TrueMod,TrueG),
'$creep'([TrueMod|TrueG]).
'$creep'(G) :- '$direct_spy'(G). '$creep'(G) :- '$direct_spy'(G).
'$clean_module_for_creep'(M:G,_,TrueMod,TrueG) :- !, '$clean_module_for_creep'(M:G,_,TrueMod,TrueG) :- !,

15
pl/init.yap
View File

@ -27,14 +27,12 @@ false :- fail.
(:- G) :- '$execute'(G), !. (:- G) :- '$execute'(G), !.
'$$!'(CP) :- '$cut_by'(CP). '$$!'(CP) :- '$cut_by'(CP).
[] :- true. [] :- true.
','(A,B) :- '$meta_call'((A,B),prolog).
:- '$cut_transparent'(','(_,_)). ';'(A,B) :- '$meta_call'((A;B),prolog).
:- '$cut_transparent'(';'(_,_)). '|'(A,B) :- '$meta_call'((A;B),prolog).
:- '$cut_transparent'('|'(_,_)). '->'(A,B) :- '$meta_call'((A->B),prolog).
:- '$cut_transparent'('->'(_,_)). \+(G) :- '$meta_call'('\+'(G),prolog).
:- '$cut_transparent'(\+ _). \+(G) :- '$meta_call'(not(G),prolog).
:- '$cut_transparent'(not(_)).
:- '$set_value'('$doindex',true). :- '$set_value'('$doindex',true).
@ -95,6 +93,7 @@ system_mode(verbose,off) :- '$set_value'('$verbose',off).
'$set_pred_module'(bind_attvar(_), attributes), '$set_pred_module'(bind_attvar(_), attributes),
'$set_pred_module'(all_attvars(_), attributes). '$set_pred_module'(all_attvars(_), attributes).
:- '$set_pred_module'(open_mem_read_stream(_,_), charsio), :- '$set_pred_module'(open_mem_read_stream(_,_), charsio),
'$set_pred_module'(open_mem_write_stream(_), charsio), '$set_pred_module'(open_mem_write_stream(_), charsio),
'$set_pred_module'(peek_mem_write_stream(_,_,_), charsio). '$set_pred_module'(peek_mem_write_stream(_,_,_), charsio).