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

631
C/absmi.c
View File

@ -113,28 +113,6 @@ push_live_regs(yamop *pco)
}
#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
Yap_absmi(int inp)
{
@ -469,21 +447,33 @@ Yap_absmi(int inp)
* Profiled try - retry - trust instructions *
*****************************************************************/
/* profiled_enter_me Label,NArgs */
Op(enter_profiling, l);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfEntries++;
UNLOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
PREG = NEXTOP(PREG, l);
/* profiled_enter_me Pred */
Op(enter_profiling, p);
LOCK(PREG->u.p.p->StatisticsForPred.lock);
PREG->u.p.p->StatisticsForPred.NOfEntries++;
UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
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();
ENDOp();
/* profiled_retry Label,NArgs */
Op(retry_profiled, l);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
PREG = NEXTOP(PREG, l);
LOCK(PREG->u.p.p->StatisticsForPred.lock);
PREG->u.p.p->StatisticsForPred.NOfRetries++;
UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
PREG = NEXTOP(PREG, p);
GONext();
ENDOp();
@ -492,9 +482,9 @@ Yap_absmi(int inp)
CACHE_Y(B);
/* After retry, cut should be pointing at the parent
* choicepoint for the current B */
LOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock);
LOCK(PREG->u.ld.p->StatisticsForPred.lock);
PREG->u.ld.p->StatisticsForPred.NOfRetries++;
UNLOCK(PREG->u.ld.p->StatisticsForPred.lock);
restore_yaam_regs(PREG->u.ld.d);
restore_args(PREG->u.ld.s);
#ifdef FROZEN_STACKS
@ -535,9 +525,9 @@ Yap_absmi(int inp)
}
SET_BB(B_YREG);
ENDCACHE_Y();
LOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.ld.p))->StatisticsForPred.lock);
LOCK(PREG->u.ld.p->StatisticsForPred.lock);
PREG->u.ld.p->StatisticsForPred.NOfRetries++;
UNLOCK(PREG->u.ld.p->StatisticsForPred.lock);
PREG = NEXTOP(PREG, ld);
GONext();
ENDOp();
@ -547,10 +537,10 @@ Yap_absmi(int inp)
*****************************************************************/
/* count_enter_me Label,NArgs */
Op(count_call, l);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfEntries++;
UNLOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
Op(count_call, p);
LOCK(PREG->u.p.p->StatisticsForPred.lock);
PREG->u.p.p->StatisticsForPred.NOfEntries++;
UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
ReductionsCounter--;
if (ReductionsCounter == 0 && ReductionsCounterOn) {
saveregs();
@ -565,15 +555,41 @@ Yap_absmi(int inp)
setregs();
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();
ENDOp();
/* count_retry Label,NArgs */
Op(count_retry, l);
LOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
((PredEntry *)(PREG->u.l.l))->StatisticsForPred.NOfRetries++;
UNLOCK(((PredEntry *)(PREG->u.l.l))->StatisticsForPred.lock);
Op(count_retry, p);
LOCK(PREG->u.p.p->StatisticsForPred.lock);
PREG->u.p.p->StatisticsForPred.NOfRetries++;
UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
RetriesCounter--;
if (RetriesCounter == 0 && RetriesCounterOn) {
saveregs();
@ -588,7 +604,7 @@ Yap_absmi(int inp)
setregs();
JMPNext();
}
PREG = NEXTOP(PREG, l);
PREG = NEXTOP(PREG, p);
GONext();
ENDOp();
@ -11706,42 +11722,93 @@ Yap_absmi(int inp)
BOp(p_execute, sla);
{
PredEntry *pen;
SMALLUNSGN mod = IntOfTerm(Deref(ARG2));
SMALLUNSGN mod = PREG->u.sla.sla_u.m_num;
CACHE_Y_AS_ENV(YREG);
/* Try to preserve the environment */
E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s);
#ifndef NO_CHECKING
check_stack(NoStackCall, H);
#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);
d0 = ARG1;
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
d0 = Yap_ExecuteCallMetaCall(mod);
}
restart_execute:
deref_head(d0, execute_unk);
execute_nvar:
if (IsApplTerm(d0)) {
Functor f = FunctorOfTerm(d0);
if (IsExtensionFunctor(f)) {
d0 = Yap_ExecuteCallMetaCall(mod);
goto execute_nvar;
goto execute_metacall;
}
pen = RepPredProp(PredPropByFunc(f, mod));
if (pen->PredFlags & MetaPredFlag) {
if (f == FunctorModule) {
Term tmod = Yap_LookupModule(ArgOfTerm(1,d0));
if (!IsVarTerm(tmod) && IsAtomTerm(tmod) &&
Yap_LookupModule(tmod) == mod) {
Term tmod = ArgOfTerm(1,d0);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
d0 = ArgOfTerm(2,d0);
mod = Yap_LookupModule(tmod);
goto execute_nvar;
}
}
if (pen->PredFlags & PushModPredFlag) {
d0 = PushModule(d0,mod);
} else if (f == FunctorComma) {
SREG = RepAppl(d0);
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 {
E_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod));
}
} 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 {
d0 = Yap_ExecuteCallMetaCall(mod);
goto execute_nvar;
goto execute_metacall;
}
}
if (PRED_GOAL_EXPANSION_ON) {
goto execute_metacall;
}
BEGP(pt1);
pt1 = RepAppl(d0);
BEGD(d2);
@ -11749,10 +11816,11 @@ Yap_absmi(int inp)
#if SBA
BEGD(d1);
d1 = pt1[d2];
if (d1 == 0)
if (d1 == 0) {
XREGS[d2] = (CELL)(pt1+d2);
else
} else {
XREGS[d2] = d1;
}
#else
XREGS[d2] = pt1[d2];
#endif
@ -11761,16 +11829,17 @@ Yap_absmi(int inp)
ENDP(pt1);
CACHE_A1();
} else if (IsAtomTerm(d0)) {
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
if (PRED_GOAL_EXPANSION_ON) {
goto execute_metacall;
} else {
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
}
} else {
d0 = Yap_ExecuteCallMetaCall(mod);
goto execute_nvar;
goto execute_metacall;
}
execute_end:
/* 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);
@ -11789,20 +11858,6 @@ Yap_absmi(int inp)
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 */
E_YREG[E_CB] = (CELL) B;
@ -11814,259 +11869,35 @@ Yap_absmi(int inp)
BEGP(pt1);
deref_body(d0, pt1, execute_unk, execute_nvar);
d0 = Yap_ExecuteCallMetaCall(mod);
goto execute_nvar;
execute_metacall:
ARG1 = ARG3 = d0;
pen = PredMetaCall;
ARG2 = Yap_cp_as_integer(B);
ARG4 = ModuleName[mod];
goto execute_end;
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);
ENDCACHE_Y_AS_ENV();
}
ENDBOp();
BOp(p_last_execute_within, sla);
{
BOp(p_execute_tail, e);
{
PredEntry *pen;
SMALLUNSGN mod = CurrentModule;
SMALLUNSGN mod;
UInt arity;
CACHE_Y_AS_ENV(YREG);
#ifndef NO_CHECKING
check_stack(NoStackCall, H);
#endif
BEGP(pt0);
BEGD(d0);
d0 = ARG1;
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
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 */
d0 = E_YREG[-EnvSizeInCells-1];
pen = RepPredProp((Prop)IntegerOfTerm(E_YREG[-EnvSizeInCells-2]));
CPREG = (yamop *) E_YREG[E_CP];
pt0 = E_YREG;
E_YREG = ENV = (CELL *) E_YREG[E_E];
#ifdef FROZEN_STACKS
{
@ -12087,19 +11918,159 @@ Yap_absmi(int inp)
E_YREG = (CELL *) ((CELL) E_YREG+ ENV_Size(CPREG));
}
#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();
/* setup GB */
E_YREG[E_CB] = d0;
ENDD(d0);
ALWAYS_GONext();
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);
ENDP(pt0);
ENDCACHE_Y_AS_ENV();
}

4
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* 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
static char SccsId[] = "%W% %G%";
@ -143,8 +143,6 @@ AddToFreeList(BlockHeader *b)
*q = b;
}
long int call_counter;
static void
FreeBlock(BlockHeader *b)
{

64
C/amasm.c
View File

@ -776,24 +776,26 @@ a_p(op_numbers opcode)
if (Flags & UserCPredFlag) {
code_p->opc = emit_op(_call_usercpred);
} else {
if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod)
if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod) {
code_p->opc = emit_op(_p_execute);
else if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteWithin)
code_p->opc = emit_op(_p_execute_within);
else if (RepPredProp(fe)->FunctorOfPred == FunctorLastExecuteWithin)
code_p->opc = emit_op(_p_last_execute_within);
else
} else {
code_p->opc = emit_op(_call_cpred);
}
}
code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE
* (cpc->rnd2));
code_p->u.sla.sla_u.p = RepPredProp(fe);
if (RepPredProp(fe)->FunctorOfPred != FunctorExecuteInMod) {
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;
if (cpc->rnd2)
if (cpc->rnd2) {
code_p->u.sla.bmap = emit_bmlabel(cpc->arnds[1]);
else
} else {
/* there is no bitmap as there are no variables in the environment */
code_p->u.sla.bmap = NULL;
}
}
GONEXT(sla);
}
@ -891,9 +893,9 @@ a_pl(op_numbers opcode, PredEntry *pred)
{
if (pass_no) {
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
@ -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.p = p;
if (p == PredGoalExpansion) {
PRED_GOAL_EXPANSION_ON = TRUE;
Yap_InitComma();
}
#ifdef YAPOR
if (SEQUENTIAL_IS_DEFAULT) {
p->PredFlags |= SequentialPredFlag;
@ -489,6 +493,10 @@ add_first_dynamic(PredEntry *p, yamop *cp, int spy_flag)
{
yamop *ncp = ((Clause *)NIL)->ClCode;
Clause *cl;
if (p == PredGoalExpansion) {
PRED_GOAL_EXPANSION_ON = TRUE;
Yap_InitComma();
}
p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0;
@ -2206,9 +2214,11 @@ p_is_profiled(void)
s = RepAtom(AtomOfTerm(t))->StrOfAE;
if (strcmp(s,"on") == 0) {
PROFILING = TRUE;
Yap_InitComma();
return(TRUE);
} else if (strcmp(s,"off") == 0) {
PROFILING = FALSE;
Yap_InitComma();
return(TRUE);
}
return(FALSE);
@ -2311,9 +2321,11 @@ p_is_call_counted(void)
s = RepAtom(AtomOfTerm(t))->StrOfAE;
if (strcmp(s,"on") == 0) {
CALL_COUNTING = TRUE;
Yap_InitComma();
return(TRUE);
} else if (strcmp(s,"off") == 0) {
CALL_COUNTING = FALSE;
Yap_InitComma();
return(TRUE);
}
return(FALSE);
@ -2511,82 +2523,6 @@ p_hidden_predicate(void)
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
Yap_InitCdMgr(void)
{
@ -2626,11 +2562,9 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
Yap_InitCPred("$parent_pred", 3, p_parent_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("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
Yap_InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag);
Yap_InitCPred("$current_stack", 1, p_current_stack, SyncPredFlag);
Yap_InitCPred("$is_push_pred_mod", 2, p_is_push_pred_mod, SyncPredFlag);
}

16
C/compiler.c
View File

@ -1590,13 +1590,17 @@ c_goal(Term Goal, int mod)
#endif
}
return;
}
else {
} else {
if (profiling)
Yap_emit(enter_profiling_op, (CELL)p, Zero);
else if (call_counting)
Yap_emit(count_call_op, (CELL)p, Zero);
c_args(Goal, 0);
if (f == FunctorExecuteInMod) {
/* compile the first argument only */
c_arg(1, ArgOfTerm(1,Goal), 1, 0);
} else {
c_args(Goal, 0);
}
}
}
@ -1628,7 +1632,11 @@ c_goal(Term Goal, int mod)
if (p->PredFlags & SyncPredFlag)
Yap_emit(sync_op, (CELL)p, (CELL)(p->ArityOfPE));
#endif /* YAPOR */
Yap_emit_3ops(call_op, (CELL) p0, Zero, Zero);
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);
}
/* functor is allowed to call the garbage collector */
if (onlast) {
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 *
Yap_emit_extra_size (compiler_vm_op o, CELL r1, int size)
{

275
C/exec.c
View File

@ -29,9 +29,15 @@ STATIC_PROTO(Int p_execute0, (void));
STATIC_PROTO(Int p_at_execute, (void));
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
@ -68,7 +74,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) {
inline static Int
CallMetaCall(SMALLUNSGN mod) {
ARG2 = current_cp_as_integer(); /* p_save_cp */
ARG2 = cp_as_integer(B); /* p_save_cp */
ARG3 = ARG1;
ARG4 = ModuleName[mod];
return (CallPredicate(PredMetaCall, B));
@ -78,7 +84,7 @@ Term
Yap_ExecuteCallMetaCall(SMALLUNSGN mod) {
Term ts[4];
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[3] = ModuleName[mod];
return(Yap_MkApplTerm(PredMetaCall->FunctorOfPred,4,ts));
@ -186,7 +192,7 @@ p_save_cp(void)
register CELL *HBREG = HB;
#endif
if (!IsVarTerm(t)) return(FALSE);
td = current_cp_as_integer();
td = cp_as_integer(B);
BIND((CELL *)t,td,bind_save_cp);
#ifdef COROUTINING
DO_TRAIL(CellPtr(t), td);
@ -198,7 +204,7 @@ p_save_cp(void)
static Int
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);
ARG1 = MkPairTerm(ModuleName[mod],tn);
CreepFlag = CalculateStackGap();
@ -206,35 +212,12 @@ EnterCreepMode(SMALLUNSGN mod) {
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
do_execute(Term t, SMALLUNSGN mod)
{
if (yap_flags[SPY_CREEP_FLAG]) {
return(EnterCreepMode(mod));
} else if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
} else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCall(mod));
}
restart_exec:
@ -263,12 +246,39 @@ do_execute(Term t, SMALLUNSGN mod)
t = ArgOfTerm(2,t);
goto restart_exec;
}
} else if (f == FunctorComma) {
Term d1 = ArgOfTerm(2,t);
YENV = ASP;
if (IsVarTerm(d1)) {
return CallMetaCall(mod);
}
if (IsAtomTerm(d1)) {
YENV[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod));
} else if (IsApplTerm(d1)) {
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f)) {
return CallMetaCall(mod);
} else {
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;
}
if (pen->PredFlags & PushModPredFlag) {
t = PushModule(t,mod);
} else{
return(CallMetaCall(mod));
}
return(CallMetaCall(mod));
}
/* now let us do what we wanted to do from the beginning !! */
/* I cannot use the standard macro here because
@ -279,7 +289,7 @@ do_execute(Term t, SMALLUNSGN mod)
#if SBA
Term d0 = *pt++;
if (d0 == 0)
XREGS[i] = (CELL)(pt-1);
` XREGS[i] = (CELL)(pt-1);
else
XREGS[i] = d0;
#else
@ -320,9 +330,12 @@ p_execute_in_mod(void)
}
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) */
@ -342,12 +355,7 @@ p_execute_within(void)
#endif
restart_exec:
if (yap_flags[SPY_CREEP_FLAG]) {
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)) {
if (IsVarTerm(t)) {
return CallError(INSTANTIATION_ERROR, mod);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
@ -376,29 +384,32 @@ p_execute_within(void)
goto restart_exec;
}
}
if (pen->PredFlags & PushModPredFlag) {
t = PushModule(t,mod);
} else {
return(CallMetaCallWithin());
}
return(CallMetaCallWithin(mod, B));
}
/* 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;
for (i = 1; i <= arity; ++i) {
/* 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 {
/* 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;
for (i = 1; i <= arity; ++i) {
#if SBA
Term d0 = *pt++;
if (d0 == 0)
XREGS[i] = (CELL)(pt-1);
else
XREGS[i] = d0;
Term d0 = *pt++;
if (d0 == 0)
XREGS[i] = (CELL)(pt-1);
else
XREGS[i] = d0;
#else
XREGS[i] = *pt++;
XREGS[i] = *pt++;
#endif
}
return (CallPredicate(pen, cut_pt));
}
return (CallPredicate(pen, cut_pt));
}
} else if (IsAtomOrIntTerm(t)) {
if (IsIntTerm(t)) {
@ -427,125 +438,20 @@ p_execute_within(void)
return(FALSE);
} else {
/* 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);
return (CallPredicate(RepPredProp(pe), cut_pt));
}
} else {
/* 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
p_execute0(void)
{ /* '$execute0'(Goal,Mod) */
@ -578,9 +484,6 @@ p_execute0(void)
}
}
pe = PredPropByFunc(f, mod);
if (RepPredProp(pe)->PredFlags & PushModPredFlag) {
t = PushModule(t,mod);
}
arity = ArityOfFunctor(f);
/* I cannot use the standard macro here because
otherwise I would dereference the argument and
@ -1225,7 +1128,7 @@ static Int
p_pred_goal_expansion_on(void) {
/* a goal needs expansion if we have goal_expansion defined or
if the goal is a meta-call */
return (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE);
return PRED_GOAL_EXPANSION_ON;
}
static Int
@ -1262,9 +1165,6 @@ p_at_execute(void)
Yap_Error(TYPE_ERROR_ATOM, ARG1, "calling clause in debugger");
}
pe = PredPropByFunc(f,mod);
if (RepPredProp(pe)->PredFlags & PushModPredFlag) {
t = PushModule(t,mod);
}
arity = ArityOfFunctor(f);
a = NameOfFunctor(f);
/* I cannot use the standard macro here because
@ -1681,6 +1581,7 @@ p_clean_ifcp(void) {
return(TRUE);
}
static Int
JumpToEnv(Term t) {
yamop *pos = PredDollarCatch->cs.p_code.LastClause;
@ -1754,6 +1655,15 @@ p_jump_env(void) {
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
Yap_InitYaamRegs(void)
{
@ -1802,14 +1712,14 @@ Yap_InitYaamRegs(void)
#endif
}
void
Yap_InitExecFs(void)
{
Yap_InitComma();
Yap_InitCPred("$execute", 1, p_execute, 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", 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("$call_with_args", 2, p_execute_0, 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("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag);
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->system_profiling = FALSE;
heap_regs->system_call_counting = FALSE;
heap_regs->system_pred_goal_expansion_on = FALSE;
heap_regs->update_mode = 0;
heap_regs->consultbase = heap_regs->consultsp =
heap_regs->consultlow + heap_regs->consultcapacity;

2
C/modules.c
View File

@ -105,7 +105,7 @@ p_module_number(void)
Term t;
if (IsVarTerm(tname)) {
return(Yap_unify(tname, ModuleName[IntOfTerm(Deref(ARG2))]));
}else {
} else {
t = MkIntTerm(LookupModule(Deref(ARG1)));
Yap_unify(t,ARG2);
ARG2 = t;

1
C/scanner.c
View File

@ -256,7 +256,6 @@ read_quoted_char(int *scan_nextp, int inp_stream, int (*QuotedNxtch)(int))
return 127;
} else if (ch >= 'a' && ch < 'z') {/* octal */
return ch - 'a';
ch = QuotedNxtch(inp_stream);
} else if (ch >= 'A' && ch < 'Z') {/* octal */
return ch - 'A';
} 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 (gc_calls < 1) return; */
#if defined(__GNUC__)
fprintf(Yap_stderr,"%llu ", vsc_count);
fprintf(Yap_stderr,"%llu %p", vsc_count, B);
#endif
/* check_trail_consistency(); */
if (pred == NULL) {

6
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* 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 */
@ -57,6 +57,7 @@ typedef struct various_codes {
yamop tablecompletioncode;
yamop tableanswerresolutioncode;
#endif /* TABLING */
yamop comma_code[5];
OPCODE failcode;
OPCODE failcode_1;
OPCODE failcode_2;
@ -121,6 +122,7 @@ typedef struct various_codes {
struct pred_entry *spy_code;
int system_profiling;
int system_call_counting;
int system_pred_goal_expansion_on;
int compiler_optimizer_on;
int compiler_compile_mode;
struct pred_entry *compiler_current_pred;
@ -348,6 +350,7 @@ typedef struct various_codes {
#define COMPLETION ((yamop *)&(heap_regs->tablecompletioncode ))
#define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode ))
#endif /* TABLING */
#define COMMA_CODE heap_regs->comma_code
#define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
#define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
#define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode ))
@ -366,6 +369,7 @@ typedef struct various_codes {
#endif
#define PROFILING heap_regs->system_profiling
#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 RETRY_C_RECORDED_CODE heap_regs->retry_recorded_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_y_write ,oy),
OPCODE(enter_profiling ,l),
OPCODE(enter_a_profiling ,e),
OPCODE(retry_profiled ,l),
OPCODE(profiled_retry_me ,ld),
OPCODE(profiled_trust_me ,ld),
OPCODE(profiled_retry_and_mark ,ld),
OPCODE(count_call ,l),
OPCODE(count_a_call ,e),
OPCODE(count_retry ,l),
OPCODE(count_retry_me ,ld),
OPCODE(count_trust_me ,ld),
@ -359,6 +361,6 @@
OPCODE(p_func2f_yx ,yxx),
OPCODE(p_func2f_yy ,yyx),
OPCODE(p_execute ,sla),
OPCODE(p_execute_within ,sla),
OPCODE(p_last_execute_within ,sla)
OPCODE(p_execute_tail ,e)

2
H/amidefs.h
View File

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

4
H/clause.h
View File

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

4
H/compile.h
View File

@ -194,9 +194,10 @@ typedef struct PSEUDO {
} ops;
} PInstr;
#define rnd2 ops.oprnd2
#define arnds ops.opseqt
#define rnd2 ops.oprnd2
#define rnd3 ops.opseqt[1]
#define rnd4 ops.opseqt[2]
typedef struct VENTRY {
CELL SelfOfVE;
@ -253,6 +254,7 @@ typedef struct CEXPENTRY {
yamop *STD_PROTO(Yap_assemble,(int));
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_4ops,(compiler_vm_op,CELL,CELL,CELL,CELL));
CELL *STD_PROTO(Yap_emit_extra_size,(compiler_vm_op,CELL,int));
char *STD_PROTO(Yap_AllocCMem,(int));
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_eq:
case _p_functor:
case _p_execute_tail:
case _enter_a_profiling:
case _count_a_call:
#ifdef YAPOR
case _getwork_first_time:
#endif
@ -770,18 +773,18 @@ RestoreClause(Clause *Cl, int mode)
pc = NEXTOP(pc,y);
break;
/* instructions type sla */
case _p_execute:
goto sla_full;
case _fcall:
case _call:
case _p_execute:
case _p_execute_within:
case _p_last_execute_within:
#ifdef YAPOR
case _or_last:
#endif
pc->u.sla.sla_u.p = PtoPredAdjust(pc->u.sla.sla_u.p);
sla_full:
if (pc->u.sla.bmap != NULL) {
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 = NEXTOP(pc,sla);
break;

2
include/YapInterface.h
View File

@ -7,7 +7,7 @@
* *
**************************************************************************
* *
* File: c_interface.h *
* File: YapInterface.h *
* Last rev: 19/2/88 *
* mods: *
* 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: *
* mods: *
* 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.
*/
typedef enum {
PushModPredFlag = 0x8000000L, /* may need module to be set */
CountPredFlag = 0x4000000L, /* count calls to pred */
HiddenPredFlag = 0x2000000L, /* invisible predicate */
CArgsPredFlag = 0x1000000L, /* SWI-like C-interface pred. */
CutTransparentPredFlag = 0x800000L, /* ! should ! across */
CountPredFlag = 0x2000000L, /* count calls to pred */
HiddenPredFlag = 0x1000000L, /* invisible predicate */
CArgsPredFlag = 0x800000L, /* SWI-like C-interface pred. */
SourcePredFlag = 0x400000L, /* static predicate with source declaration */
MetaPredFlag = 0x200000L, /* predicate subject to a meta declaration */
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).
'$do_c_built_in'(call(G), OUT) :-
nonvar(G),
G = (Mod:G1),
atom(Mod),
!,
'$module_number'(Mod,MNum),
OUT = '$execute_in_mod'(G1,MNum).
G = (Mod:G1), !,
'$do_c_built_metacall'(G1, Mod, OUT).
'$do_c_built_in'(recorded(K,T,R), OUT) :-
nonvar(K),
!,
@ -78,6 +75,19 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
'$do_and'(R0, Comp, R).
'$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'(P, true, P) :- !.
'$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).
','(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), !,
'$do_error'(instantiation_error,call(G0)).
'$call'(M:G,CP,G0,_) :- !,
@ -733,6 +707,14 @@ not(A) :-
;
'$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) :- !,
(
'$execute_within'(A,CP,G0,M)

51
pl/debug.yap
View File

@ -269,12 +269,6 @@ debugging :-
/* called from prolog module */
'$execute0'(G,Module),
'$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]) :-
'$do_spy'(G,Mod).
@ -300,17 +294,44 @@ debugging :-
'$execute0'(G,M),
'$creep'
).
'$direct_spy'([M|G]) :-
'$is_push_pred_mod'(G,M),
!,
'$creep',
'$execute0'(G,M).
'$direct_spy'([Mod|G]) :-
'$do_spy'(G, Mod).
'$do_spy'(true, _) :- !, '$creep'.
'$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) :-
% write(user_error,$spy(G)), nl,
'$get_value'(debug,1), /* ditto if debug off */
@ -748,16 +769,12 @@ debugging :-
'$execute'(M:Goal).
'$creep'([M|V]) :- var(V), !,
'$do_error'(instantiation_error,M:call(M:V)).
'$creep'([_|M:V]) :- !,
'$creep'([M|V]).
'$creep'([M|'$execute_in_mod'(G,ModNum)]) :- !,
'$module_number'(Mod,ModNum),
'$clean_module_for_creep'(G,Mod,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).
'$clean_module_for_creep'(M:G,_,TrueMod,TrueG) :- !,

15
pl/init.yap
View File

@ -27,14 +27,12 @@ false :- fail.
(:- G) :- '$execute'(G), !.
'$$!'(CP) :- '$cut_by'(CP).
[] :- true.
:- '$cut_transparent'(','(_,_)).
:- '$cut_transparent'(';'(_,_)).
:- '$cut_transparent'('|'(_,_)).
:- '$cut_transparent'('->'(_,_)).
:- '$cut_transparent'(\+ _).
:- '$cut_transparent'(not(_)).
','(A,B) :- '$meta_call'((A,B),prolog).
';'(A,B) :- '$meta_call'((A;B),prolog).
'|'(A,B) :- '$meta_call'((A;B),prolog).
'->'(A,B) :- '$meta_call'((A->B),prolog).
\+(G) :- '$meta_call'('\+'(G),prolog).
\+(G) :- '$meta_call'(not(G),prolog).
:- '$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'(all_attvars(_), attributes).
:- '$set_pred_module'(open_mem_read_stream(_,_), charsio),
'$set_pred_module'(open_mem_write_stream(_), charsio),
'$set_pred_module'(peek_mem_write_stream(_,_,_), charsio).