New metacall mechanism
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@169 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
8cc0f4e803
commit
458a0a857f
186
C/absmi.c
186
C/absmi.c
@ -1604,7 +1604,7 @@ absmi(int inp)
|
|||||||
ENDBOp();
|
ENDBOp();
|
||||||
|
|
||||||
NoStackExecute:
|
NoStackExecute:
|
||||||
SREG = (CELL *) (PREG->u.l.l);
|
SREG = (CELL *) pred_entry(PREG->u.l.l);
|
||||||
#ifdef YAPOR
|
#ifdef YAPOR
|
||||||
/* abort_optyap("NoStackExecute in function absmi"); */
|
/* abort_optyap("NoStackExecute in function absmi"); */
|
||||||
if (HeapTop > GlobalBase - MinHeapGap)
|
if (HeapTop > GlobalBase - MinHeapGap)
|
||||||
@ -1747,7 +1747,8 @@ absmi(int inp)
|
|||||||
|
|
||||||
NoStackCall:
|
NoStackCall:
|
||||||
/* on X86 machines S will not actually be holding the pointer to pred */
|
/* on X86 machines S will not actually be holding the pointer to pred */
|
||||||
SREG = (CELL *) (PREG->u.sla.l);
|
SREG = (CELL *) PREG->u.sla.p;
|
||||||
|
NoStackCallGotS:
|
||||||
#ifdef YAPOR
|
#ifdef YAPOR
|
||||||
/* abort_optyap("NoStackCall in function absmi"); */
|
/* abort_optyap("NoStackCall in function absmi"); */
|
||||||
if (HeapTop > GlobalBase - MinHeapGap)
|
if (HeapTop > GlobalBase - MinHeapGap)
|
||||||
@ -1776,7 +1777,7 @@ absmi(int inp)
|
|||||||
if (ASP > (CELL *)B)
|
if (ASP > (CELL *)B)
|
||||||
ASP = (CELL *)B;
|
ASP = (CELL *)B;
|
||||||
saveregs();
|
saveregs();
|
||||||
gc(PredArity(SREG), Y, NEXTOP(PREG, sla));
|
gc(((PredEntry *)SREG)->ArityOfPE, Y, NEXTOP(PREG, sla));
|
||||||
setregs();
|
setregs();
|
||||||
|
|
||||||
JMPNext();
|
JMPNext();
|
||||||
@ -1788,7 +1789,7 @@ absmi(int inp)
|
|||||||
NoStackComitY:
|
NoStackComitY:
|
||||||
/* find something to fool S */
|
/* find something to fool S */
|
||||||
if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
|
if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
|
||||||
SREG = (CELL *)&(RepPredProp(GetPredProp(AtomRestoreRegs,2))->StateOfPred);
|
SREG = (CELL *)RepPredProp(GetPredProp(AtomRestoreRegs,2));
|
||||||
PREG = NEXTOP(PREG,x);
|
PREG = NEXTOP(PREG,x);
|
||||||
XREGS[0] = XREG(PREG->u.y.y);
|
XREGS[0] = XREG(PREG->u.y.y);
|
||||||
goto creep_either;
|
goto creep_either;
|
||||||
@ -1800,7 +1801,7 @@ absmi(int inp)
|
|||||||
NoStackComitX:
|
NoStackComitX:
|
||||||
/* find something to fool S */
|
/* find something to fool S */
|
||||||
if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
|
if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
|
||||||
SREG = (CELL *)&(RepPredProp(GetPredProp(AtomRestoreRegs,2))->StateOfPred);
|
SREG = (CELL *)RepPredProp(GetPredProp(AtomRestoreRegs,2));
|
||||||
PREG = NEXTOP(PREG,x);
|
PREG = NEXTOP(PREG,x);
|
||||||
#if USE_THREADED_CODE
|
#if USE_THREADED_CODE
|
||||||
if (PREG->opc == (OPCODE)OpAddress[_fcall])
|
if (PREG->opc == (OPCODE)OpAddress[_fcall])
|
||||||
@ -1826,7 +1827,7 @@ absmi(int inp)
|
|||||||
/* don't forget I cannot creep at ; */
|
/* don't forget I cannot creep at ; */
|
||||||
NoStackEither:
|
NoStackEither:
|
||||||
/* find something to fool S */
|
/* find something to fool S */
|
||||||
SREG = (CELL *)&(RepPredProp(GetPredProp(AtomRestoreRegs,1))->StateOfPred);
|
SREG = (CELL *)RepPredProp(GetPredProp(AtomRestoreRegs,1));
|
||||||
#ifdef YAPOR
|
#ifdef YAPOR
|
||||||
/* abort_optyap("NoStackCall in function absmi"); */
|
/* abort_optyap("NoStackCall in function absmi"); */
|
||||||
if (HeapTop > GlobalBase - MinHeapGap)
|
if (HeapTop > GlobalBase - MinHeapGap)
|
||||||
@ -1911,7 +1912,7 @@ absmi(int inp)
|
|||||||
|
|
||||||
NoStackDExecute:
|
NoStackDExecute:
|
||||||
/* set SREG for next instructions */
|
/* set SREG for next instructions */
|
||||||
SREG = (CELL *) (PREG->u.l.l);
|
SREG = (CELL *) pred_entry(PREG->u.l.l);
|
||||||
#ifdef YAPOR
|
#ifdef YAPOR
|
||||||
/* abort_optyap("noStackDExecute in function absmi"); */
|
/* abort_optyap("noStackDExecute in function absmi"); */
|
||||||
if (HeapTop > GlobalBase - MinHeapGap)
|
if (HeapTop > GlobalBase - MinHeapGap)
|
||||||
@ -1945,7 +1946,7 @@ absmi(int inp)
|
|||||||
if (ASP > (CELL *)B)
|
if (ASP > (CELL *)B)
|
||||||
ASP = (CELL *)B;
|
ASP = (CELL *)B;
|
||||||
saveregs();
|
saveregs();
|
||||||
gc(PredArity(SREG), ENV, CPREG);
|
gc(((PredEntry *)(SREG))->ArityOfPE, ENV, CPREG);
|
||||||
setregs();
|
setregs();
|
||||||
/* hopefully, gc will succeeded, and we will retry
|
/* hopefully, gc will succeeded, and we will retry
|
||||||
* the instruction */
|
* the instruction */
|
||||||
@ -2005,13 +2006,13 @@ absmi(int inp)
|
|||||||
S = SREG;
|
S = SREG;
|
||||||
#endif
|
#endif
|
||||||
BEGD(d0);
|
BEGD(d0);
|
||||||
d0 = PredArity(SREG);
|
d0 = ((PredEntry *)(SREG))->ArityOfPE;
|
||||||
if (d0 == 0) {
|
if (d0 == 0) {
|
||||||
my_goal = MkAtomTerm((Atom) PredFunctor(SREG));
|
my_goal = MkAtomTerm((Atom)((PredEntry *)(SREG))->FunctorOfPred);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
my_goal = AbsAppl(H);
|
my_goal = AbsAppl(H);
|
||||||
*H = (CELL) PredFunctor(SREG);
|
*H = (CELL) ((PredEntry *)(SREG))->FunctorOfPred;
|
||||||
H++;
|
H++;
|
||||||
BEGP(pt1);
|
BEGP(pt1);
|
||||||
pt1 = XREGS + 1;
|
pt1 = XREGS + 1;
|
||||||
@ -2047,12 +2048,12 @@ absmi(int inp)
|
|||||||
ENDP(pt1);
|
ENDP(pt1);
|
||||||
}
|
}
|
||||||
ENDD(d0);
|
ENDD(d0);
|
||||||
H[0] = Module_Name((CODEADDR)pred_entry(SREG));
|
H[0] = Module_Name((CODEADDR)SREG);
|
||||||
H[1] = my_goal;
|
H[1] = my_goal;
|
||||||
ARG1 = AbsPair(H);
|
ARG1 = AbsPair(H);
|
||||||
H += 2;
|
H += 2;
|
||||||
ARG2 = ListOfWokenGoals();
|
ARG2 = ListOfWokenGoals();
|
||||||
SREG = (CELL *) (Unsigned(WakeUpCode) - sizeof(SMALLUNSGN));
|
SREG = (CELL *) (WakeUpCode);
|
||||||
|
|
||||||
/* no more goals to wake up */
|
/* no more goals to wake up */
|
||||||
UpdateTimedVar(WokenGoals, TermNil);
|
UpdateTimedVar(WokenGoals, TermNil);
|
||||||
@ -2084,13 +2085,13 @@ absmi(int inp)
|
|||||||
S = SREG;
|
S = SREG;
|
||||||
#endif
|
#endif
|
||||||
BEGD(d0);
|
BEGD(d0);
|
||||||
d0 = PredArity(SREG);
|
d0 = ((PredEntry *)(SREG))->ArityOfPE;
|
||||||
if (d0 == 0) {
|
if (d0 == 0) {
|
||||||
H[1] = MkAtomTerm((Atom) PredFunctor(SREG));
|
H[1] = MkAtomTerm((Atom) ((PredEntry *)(SREG))->FunctorOfPred);
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
H[d0 + 2] = AbsAppl(H);
|
H[d0 + 2] = AbsAppl(H);
|
||||||
*H = (CELL) PredFunctor(SREG);
|
*H = (CELL) ((PredEntry *)(SREG))->FunctorOfPred;
|
||||||
H++;
|
H++;
|
||||||
BEGP(pt1);
|
BEGP(pt1);
|
||||||
pt1 = XREGS + 1;
|
pt1 = XREGS + 1;
|
||||||
@ -2125,20 +2126,20 @@ absmi(int inp)
|
|||||||
ENDP(pt1);
|
ENDP(pt1);
|
||||||
}
|
}
|
||||||
ENDD(d0);
|
ENDD(d0);
|
||||||
H[0] = Module_Name((CODEADDR)pred_entry(SREG));
|
H[0] = Module_Name(((CODEADDR)(SREG)));
|
||||||
ARG1 = (Term) AbsPair(H);
|
ARG1 = (Term) AbsPair(H);
|
||||||
|
|
||||||
H += 2;
|
H += 2;
|
||||||
CFREG = CalculateStackGap();
|
CFREG = CalculateStackGap();
|
||||||
SREG = (CELL *) (Unsigned(CreepCode) - sizeof(SMALLUNSGN));
|
SREG = (CELL *) CreepCode;
|
||||||
#ifdef COROUTINING
|
#ifdef COROUTINING
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
#ifdef LOW_LEVEL_TRACER
|
#ifdef LOW_LEVEL_TRACER
|
||||||
if (do_low_level_trace)
|
if (do_low_level_trace)
|
||||||
low_level_trace(enter_pred,pred_entry(SREG),XREGS+1);
|
low_level_trace(enter_pred,(PredEntry *)(SREG),XREGS+1);
|
||||||
#endif /* LOW_LEVEL_TRACE */
|
#endif /* LOW_LEVEL_TRACE */
|
||||||
PREG = (yamop *) PredCode(SREG);
|
PREG = (yamop *) ((PredEntry *)(SREG))->CodeOfPred;
|
||||||
CACHE_A1();
|
CACHE_A1();
|
||||||
JMPNext();
|
JMPNext();
|
||||||
|
|
||||||
@ -5643,15 +5644,13 @@ absmi(int inp)
|
|||||||
d0 = (CELL) (PREG->u.sla.l);
|
d0 = (CELL) (PREG->u.sla.l);
|
||||||
PREG = NEXTOP(PREG, sla);
|
PREG = NEXTOP(PREG, sla);
|
||||||
saveregs();
|
saveregs();
|
||||||
SREG = (CELL *) (*((Int (*)(void)) d0)) ();
|
d0 = (*((Int (*)(void)) d0)) ();
|
||||||
ENDD(d0);
|
|
||||||
|
|
||||||
|
|
||||||
setregs();
|
setregs();
|
||||||
if (!SREG) {
|
if (!d0) {
|
||||||
FAIL();
|
FAIL();
|
||||||
}
|
}
|
||||||
CACHE_A1();
|
CACHE_A1();
|
||||||
|
ENDD(d0);
|
||||||
JMPNext();
|
JMPNext();
|
||||||
ENDBOp();
|
ENDBOp();
|
||||||
|
|
||||||
@ -5903,7 +5902,7 @@ absmi(int inp)
|
|||||||
READ_UNLOCK(pe->PRWLock);
|
READ_UNLOCK(pe->PRWLock);
|
||||||
d0 = pe->ArityOfPE;
|
d0 = pe->ArityOfPE;
|
||||||
if (d0 == 0) {
|
if (d0 == 0) {
|
||||||
H[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
|
H[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
H[d0 + 2] = AbsAppl(H);
|
H[d0 + 2] = AbsAppl(H);
|
||||||
@ -5957,12 +5956,12 @@ absmi(int inp)
|
|||||||
PredEntry *undefpe;
|
PredEntry *undefpe;
|
||||||
undefpe = RepPredProp (p);
|
undefpe = RepPredProp (p);
|
||||||
READ_LOCK(undefpe->PRWLock);
|
READ_LOCK(undefpe->PRWLock);
|
||||||
UndefCode = (CELL *) & (undefpe->CodeOfPred);
|
UndefCode = undefpe;
|
||||||
READ_UNLOCK(undefpe->PRWLock);
|
READ_UNLOCK(undefpe->PRWLock);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
PREG = (yamop *)pred_entry_from_code(UndefCode)->CodeOfPred;
|
PREG = (yamop *)(UndefCode->CodeOfPred);
|
||||||
CFREG = CalculateStackGap();
|
CFREG = CalculateStackGap();
|
||||||
CACHE_A1();
|
CACHE_A1();
|
||||||
JMPNext();
|
JMPNext();
|
||||||
@ -5987,7 +5986,7 @@ absmi(int inp)
|
|||||||
d0 = pe->ArityOfPE;
|
d0 = pe->ArityOfPE;
|
||||||
/* save S for ModuleName */
|
/* save S for ModuleName */
|
||||||
if (d0 == 0) {
|
if (d0 == 0) {
|
||||||
H[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
|
H[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
|
||||||
} else {
|
} else {
|
||||||
*H = (CELL) pe->FunctorOfPred;
|
*H = (CELL) pe->FunctorOfPred;
|
||||||
H[d0 + 2] = AbsAppl(H);
|
H[d0 + 2] = AbsAppl(H);
|
||||||
@ -6026,16 +6025,17 @@ absmi(int inp)
|
|||||||
}
|
}
|
||||||
ARG1 = (Term) AbsPair(H);
|
ARG1 = (Term) AbsPair(H);
|
||||||
H += 2;
|
H += 2;
|
||||||
BEGP(pt0);
|
{
|
||||||
pt0 = (CELL *) (Unsigned(SpyCode) - sizeof(SMALLUNSGN));
|
PredEntry *pt0;
|
||||||
P_before_spy = PREG;
|
pt0 = SpyCode;
|
||||||
PREG = (yamop *) PredCode(pt0);
|
P_before_spy = PREG;
|
||||||
CACHE_A1();
|
PREG = (yamop *) (pt0->CodeOfPred);
|
||||||
|
CACHE_A1();
|
||||||
#ifdef LOW_LEVEL_TRACER
|
#ifdef LOW_LEVEL_TRACER
|
||||||
if (do_low_level_trace)
|
if (do_low_level_trace)
|
||||||
low_level_trace(enter_pred,(PredEntry *)(PREG->u.sla.p),XREGS+1);
|
low_level_trace(enter_pred,pt0,XREGS+1);
|
||||||
#endif /* LOW_LEVEL_TRACE */
|
#endif /* LOW_LEVEL_TRACE */
|
||||||
ENDP(pt0);
|
}
|
||||||
JMPNext();
|
JMPNext();
|
||||||
|
|
||||||
/************************************************************************\
|
/************************************************************************\
|
||||||
@ -11132,6 +11132,118 @@ absmi(int inp)
|
|||||||
ENDD(d0);
|
ENDD(d0);
|
||||||
ENDOp();
|
ENDOp();
|
||||||
|
|
||||||
|
BOp(p_execute, sla);
|
||||||
|
{
|
||||||
|
PredEntry *pen;
|
||||||
|
|
||||||
|
CACHE_Y_AS_ENV(Y);
|
||||||
|
CACHE_A1();
|
||||||
|
BEGD(d0);
|
||||||
|
d0 = ARG1;
|
||||||
|
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
|
||||||
|
d0 = ExecuteCallMetaCall();
|
||||||
|
}
|
||||||
|
deref_head(d0, execute_unk);
|
||||||
|
execute_nvar:
|
||||||
|
if (IsApplTerm(d0)) {
|
||||||
|
Functor f = FunctorOfTerm(d0);
|
||||||
|
if (IsExtensionFunctor(f)) {
|
||||||
|
d0 = ExecuteCallMetaCall();
|
||||||
|
goto execute_nvar;
|
||||||
|
}
|
||||||
|
pen = RepPredProp(PredPropByFunc(f, ARG2));
|
||||||
|
if (pen->PredFlags & MetaPredFlag) {
|
||||||
|
d0 = ExecuteCallMetaCall();
|
||||||
|
goto execute_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);
|
||||||
|
} else if (IsAtomTerm(d0)) {
|
||||||
|
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), ARG2));
|
||||||
|
} else {
|
||||||
|
d0 = ExecuteCallMetaCall();
|
||||||
|
goto execute_nvar;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifndef NO_CHECKING
|
||||||
|
check_stack(NoStackPExec, H);
|
||||||
|
#endif
|
||||||
|
/* code copied from call */
|
||||||
|
ENV = E_Y;
|
||||||
|
/* Try to preserve the environment */
|
||||||
|
E_Y = (CELL *) (((char *) Y) + PREG->u.sla.s);
|
||||||
|
CPREG =
|
||||||
|
(yamop *) NEXTOP(PREG, sla);
|
||||||
|
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
|
||||||
|
PREG = (yamop *) pen->CodeOfPred;
|
||||||
|
#ifdef DEPTH_LIMIT
|
||||||
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
|
||||||
|
if (Module(pt0)) {
|
||||||
|
if (DEPTH == MkIntTerm(0))
|
||||||
|
FAIL();
|
||||||
|
else DEPTH = RESET_DEPTH();
|
||||||
|
}
|
||||||
|
} else if (Module(pt0))
|
||||||
|
DEPTH -= MkIntConstant(2);
|
||||||
|
#endif /* DEPTH_LIMIT */
|
||||||
|
#ifdef LOW_LEVEL_TRACER
|
||||||
|
if (do_low_level_trace)
|
||||||
|
low_level_trace(enter_pred,pen,XREGS+1);
|
||||||
|
#endif /* LOW_LEVEL_TRACER */
|
||||||
|
#ifdef FROZEN_REGS
|
||||||
|
{
|
||||||
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||||
|
#ifdef SBA
|
||||||
|
if (E_Y > (CELL *) top_b || E_Y < H) E_Y = (CELL *) top_b;
|
||||||
|
#else
|
||||||
|
if (E_Y > (CELL *) top_b) E_Y = (CELL *) top_b;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
#else
|
||||||
|
if (E_Y > (CELL *) B) {
|
||||||
|
E_Y = (CELL *) B;
|
||||||
|
}
|
||||||
|
#endif /* FROZEN_REGS */
|
||||||
|
WRITEBACK_Y_AS_ENV();
|
||||||
|
/* setup GB */
|
||||||
|
E_Y[E_CB] = (CELL) B;
|
||||||
|
#ifdef YAPOR
|
||||||
|
SCH_check_requests();
|
||||||
|
#endif /* YAPOR */
|
||||||
|
ALWAYS_GONext();
|
||||||
|
ALWAYS_END_PREFETCH();
|
||||||
|
|
||||||
|
BEGP(pt1);
|
||||||
|
deref_body(d0, pt1, execute_unk, execute_nvar);
|
||||||
|
d0 = ExecuteCallMetaCall();
|
||||||
|
goto execute_nvar;
|
||||||
|
ENDP(pt1);
|
||||||
|
ENDD(d0);
|
||||||
|
ENDCACHE_Y_AS_ENV();
|
||||||
|
|
||||||
|
NoStackPExec:
|
||||||
|
/* on X86 machines S will not actually be holding the pointer to pred */
|
||||||
|
SREG = (CELL *) pen;
|
||||||
|
goto NoStackCallGotS;
|
||||||
|
|
||||||
|
}
|
||||||
|
ENDBOp();
|
||||||
|
|
||||||
#if !USE_THREADED_CODE
|
#if !USE_THREADED_CODE
|
||||||
default:
|
default:
|
||||||
PREG = Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode);
|
PREG = Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode);
|
||||||
|
168
C/adtdefs.c
168
C/adtdefs.c
@ -22,6 +22,8 @@ static char SccsId[] = "%W% %G%";
|
|||||||
#define ADTDEFS_C
|
#define ADTDEFS_C
|
||||||
|
|
||||||
#include "Yap.h"
|
#include "Yap.h"
|
||||||
|
Prop STD_PROTO(PredPropByFunc,(Functor, Term));
|
||||||
|
Prop STD_PROTO(PredPropByAtom,(Atom, Term));
|
||||||
#include "Yatom.h"
|
#include "Yatom.h"
|
||||||
#include "Heap.h"
|
#include "Heap.h"
|
||||||
#include "yapio.h"
|
#include "yapio.h"
|
||||||
@ -36,7 +38,7 @@ GetFunctorProp(AtomEntry *ae, unsigned int arity)
|
|||||||
{ /* look property list of atom a for kind */
|
{ /* look property list of atom a for kind */
|
||||||
FunctorEntry *pp;
|
FunctorEntry *pp;
|
||||||
|
|
||||||
pp = RepFunctorProp(ae->PropOfAE);
|
pp = RepFunctorProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) &&
|
while (!EndOfPAEntr(pp) &&
|
||||||
(!IsFunctorProperty(pp->KindOfPE) ||
|
(!IsFunctorProperty(pp->KindOfPE) ||
|
||||||
pp->ArityOfFE != arity))
|
pp->ArityOfFE != arity))
|
||||||
@ -60,9 +62,9 @@ InlinedUnlockedMkFunctor(AtomEntry *ae, unsigned int arity)
|
|||||||
p->NameOfFE = AbsAtom(ae);
|
p->NameOfFE = AbsAtom(ae);
|
||||||
p->ArityOfFE = arity;
|
p->ArityOfFE = arity;
|
||||||
p->PropsOfFE = NIL;
|
p->PropsOfFE = NIL;
|
||||||
p->NextOfPE = ae->PropOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
INIT_RWLOCK(p->FRWLock);
|
INIT_RWLOCK(p->FRWLock);
|
||||||
ae->PropOfAE = AbsProp((PropEntry *) p);
|
ae->PropsOfAE = AbsProp((PropEntry *) p);
|
||||||
return ((Functor) p);
|
return ((Functor) p);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -95,8 +97,8 @@ MkFunctorWithAddress(Atom ap, unsigned int arity, FunctorEntry *p)
|
|||||||
p->KindOfPE = FunctorProperty;
|
p->KindOfPE = FunctorProperty;
|
||||||
p->NameOfFE = ap;
|
p->NameOfFE = ap;
|
||||||
p->ArityOfFE = arity;
|
p->ArityOfFE = arity;
|
||||||
p->NextOfPE = RepAtom(ap)->PropOfAE;
|
p->NextOfPE = RepAtom(ap)->PropsOfAE;
|
||||||
ae->PropOfAE = AbsProp((PropEntry *) p);
|
ae->PropsOfAE = AbsProp((PropEntry *) p);
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -156,7 +158,7 @@ LookupAtom(char *atom)
|
|||||||
a = AbsAtom(ae);
|
a = AbsAtom(ae);
|
||||||
ae->NextOfAE = HashChain[hash].Entry;
|
ae->NextOfAE = HashChain[hash].Entry;
|
||||||
HashChain[hash].Entry = a;
|
HashChain[hash].Entry = a;
|
||||||
ae->PropOfAE = NIL;
|
ae->PropsOfAE = NIL;
|
||||||
if (ae->StrOfAE != atom)
|
if (ae->StrOfAE != atom)
|
||||||
strcpy(ae->StrOfAE, atom);
|
strcpy(ae->StrOfAE, atom);
|
||||||
INIT_RWLOCK(ae->ARWLock);
|
INIT_RWLOCK(ae->ARWLock);
|
||||||
@ -197,7 +199,7 @@ LookupAtomWithAddress(char *atom, AtomEntry *ae)
|
|||||||
/* add new atom to start of chain */
|
/* add new atom to start of chain */
|
||||||
ae->NextOfAE = a;
|
ae->NextOfAE = a;
|
||||||
HashChain[hash].Entry = AbsAtom(ae);
|
HashChain[hash].Entry = AbsAtom(ae);
|
||||||
ae->PropOfAE = NIL;
|
ae->PropsOfAE = NIL;
|
||||||
strcpy(ae->StrOfAE, atom);
|
strcpy(ae->StrOfAE, atom);
|
||||||
INIT_RWLOCK(ae->ARWLock);
|
INIT_RWLOCK(ae->ARWLock);
|
||||||
WRITE_UNLOCK(HashChain[hash].AERWLock);
|
WRITE_UNLOCK(HashChain[hash].AERWLock);
|
||||||
@ -232,20 +234,20 @@ ReleaseAtom(Atom atom)
|
|||||||
}
|
}
|
||||||
|
|
||||||
static Prop
|
static Prop
|
||||||
StaticLockedGetAProp(AtomEntry *ae, PropFlags kind)
|
StaticGetAPropHavingLock(AtomEntry *ae, PropFlags kind)
|
||||||
{ /* look property list of atom a for kind */
|
{ /* look property list of atom a for kind */
|
||||||
PropEntry *pp;
|
PropEntry *pp;
|
||||||
|
|
||||||
pp = RepProp(ae->PropOfAE);
|
pp = RepProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != kind)
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != kind)
|
||||||
pp = RepProp(pp->NextOfPE);
|
pp = RepProp(pp->NextOfPE);
|
||||||
return (AbsProp(pp));
|
return (AbsProp(pp));
|
||||||
}
|
}
|
||||||
|
|
||||||
Prop
|
Prop
|
||||||
LockedGetAProp(AtomEntry *ae, PropFlags kind)
|
GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
|
||||||
{ /* look property list of atom a for kind */
|
{ /* look property list of atom a for kind */
|
||||||
return (StaticLockedGetAProp(ae,kind));
|
return (StaticGetAPropHavingLock(ae,kind));
|
||||||
}
|
}
|
||||||
|
|
||||||
Prop
|
Prop
|
||||||
@ -255,13 +257,13 @@ GetAProp(Atom a, PropFlags kind)
|
|||||||
Prop out;
|
Prop out;
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
out = StaticLockedGetAProp(ae, kind);
|
out = StaticGetAPropHavingLock(ae, kind);
|
||||||
READ_UNLOCK(ae->ARWLock);
|
READ_UNLOCK(ae->ARWLock);
|
||||||
return (out);
|
return (out);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Prop
|
inline static Prop
|
||||||
UnlockedFunctorGetPredProp(Functor f)
|
UnlockedFunctorGetPredProp(Functor f, Term cur_mod)
|
||||||
/* get predicate entry for ap/arity; */
|
/* get predicate entry for ap/arity; */
|
||||||
{
|
{
|
||||||
Prop p0;
|
Prop p0;
|
||||||
@ -269,13 +271,45 @@ UnlockedFunctorGetPredProp(Functor f)
|
|||||||
PredEntry *p;
|
PredEntry *p;
|
||||||
|
|
||||||
p = RepPredProp(p0 = fe->PropsOfFE);
|
p = RepPredProp(p0 = fe->PropsOfFE);
|
||||||
while (p0 && (p->KindOfPE != PEProp ||
|
while (p0 && (/* p->KindOfPE != PEProp || only preds in here */
|
||||||
(p->ModuleOfPred && p->ModuleOfPred != CurrentModule)))
|
(p->ModuleOfPred != cur_mod && p->ModuleOfPred)))
|
||||||
p = RepPredProp(p0 = p->NextOfPE);
|
p = RepPredProp(p0 = p->NextOfPE);
|
||||||
READ_UNLOCK(fe->FRWLock);
|
READ_UNLOCK(fe->FRWLock);
|
||||||
return (p0);
|
return (p0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
inline static Prop
|
||||||
|
GetPredPropByAtomHavingLock(AtomEntry* ae, Term cur_mod)
|
||||||
|
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||||
|
{
|
||||||
|
Prop p0;
|
||||||
|
|
||||||
|
p0 = ae->PropsOfAE;
|
||||||
|
while (p0) {
|
||||||
|
PredEntry *pe = RepPredProp(p0);
|
||||||
|
if ( pe->KindOfPE == PEProp &&
|
||||||
|
(pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) {
|
||||||
|
return(p0);
|
||||||
|
}
|
||||||
|
p0 = pe->NextOfPE;
|
||||||
|
}
|
||||||
|
return(NIL);
|
||||||
|
}
|
||||||
|
|
||||||
|
Prop
|
||||||
|
GetPredPropByAtom(Atom at, Term cur_mod)
|
||||||
|
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||||
|
{
|
||||||
|
Prop p0;
|
||||||
|
AtomEntry *ae = RepAtom(at);
|
||||||
|
|
||||||
|
READ_LOCK(ae->ARWLock);
|
||||||
|
p0 = GetPredPropByAtomHavingLock(ae, cur_mod);
|
||||||
|
READ_UNLOCK(ae->ARWLock);
|
||||||
|
return(p0);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
Prop
|
Prop
|
||||||
GetPredProp(Atom ap, unsigned int arity)
|
GetPredProp(Atom ap, unsigned int arity)
|
||||||
/* get predicate entry for ap/arity; */
|
/* get predicate entry for ap/arity; */
|
||||||
@ -284,38 +318,43 @@ GetPredProp(Atom ap, unsigned int arity)
|
|||||||
AtomEntry *ae = RepAtom(ap);
|
AtomEntry *ae = RepAtom(ap);
|
||||||
Functor f;
|
Functor f;
|
||||||
|
|
||||||
|
if (arity == 0)
|
||||||
|
return(GetPredPropByAtom(ap, *CurrentModulePtr));
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
f = InlinedUnlockedMkFunctor(ae, arity);
|
f = InlinedUnlockedMkFunctor(ae, arity);
|
||||||
WRITE_UNLOCK(ae->FRWLock);
|
WRITE_UNLOCK(ae->FRWLock);
|
||||||
READ_LOCK(f->ARWLock);
|
READ_LOCK(f->ARWLock);
|
||||||
p0 = UnlockedFunctorGetPredProp(f);
|
p0 = UnlockedFunctorGetPredProp(f, *CurrentModulePtr);
|
||||||
READ_UNLOCK(f->FRWLock);
|
READ_UNLOCK(f->FRWLock);
|
||||||
return (p0);
|
return (p0);
|
||||||
}
|
}
|
||||||
|
|
||||||
Prop
|
Prop
|
||||||
GetPredPropByFunc(Functor f)
|
GetPredPropByFunc(Functor f, Term t)
|
||||||
/* get predicate entry for ap/arity; */
|
/* get predicate entry for ap/arity; */
|
||||||
{
|
{
|
||||||
Prop p0;
|
Prop p0;
|
||||||
|
|
||||||
READ_LOCK(f->ARWLock);
|
READ_LOCK(f->ARWLock);
|
||||||
p0 = UnlockedFunctorGetPredProp(f);
|
p0 = UnlockedFunctorGetPredProp(f, t);
|
||||||
READ_UNLOCK(f->FRWLock);
|
READ_UNLOCK(f->FRWLock);
|
||||||
return (p0);
|
return (p0);
|
||||||
}
|
}
|
||||||
|
|
||||||
Prop
|
Prop
|
||||||
LockedGetPredProp(Atom ap, unsigned int arity)
|
GetPredPropHavingLock(Atom ap, unsigned int arity)
|
||||||
/* get predicate entry for ap/arity; */
|
/* get predicate entry for ap/arity; */
|
||||||
{
|
{
|
||||||
Prop p0;
|
Prop p0;
|
||||||
AtomEntry *ae = RepAtom(ap);
|
AtomEntry *ae = RepAtom(ap);
|
||||||
Functor f;
|
Functor f;
|
||||||
|
|
||||||
|
if (arity == 0) {
|
||||||
|
GetPredPropByAtomHavingLock(ae, *CurrentModulePtr);
|
||||||
|
}
|
||||||
f = InlinedUnlockedMkFunctor(ae, arity);
|
f = InlinedUnlockedMkFunctor(ae, arity);
|
||||||
READ_LOCK(f->ARWLock);
|
READ_LOCK(f->ARWLock);
|
||||||
p0 = UnlockedFunctorGetPredProp(f);
|
p0 = UnlockedFunctorGetPredProp(f, *CurrentModulePtr);
|
||||||
READ_UNLOCK(f->FRWLock);
|
READ_UNLOCK(f->FRWLock);
|
||||||
return (p0);
|
return (p0);
|
||||||
}
|
}
|
||||||
@ -329,7 +368,7 @@ GetExpProp(Atom at, unsigned int arity)
|
|||||||
ExpEntry *p;
|
ExpEntry *p;
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
p = RepExpProp(p0 = ae->PropOfAE);
|
p = RepExpProp(p0 = ae->PropsOfAE);
|
||||||
while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity))
|
while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity))
|
||||||
p = RepExpProp(p0 = p->NextOfPE);
|
p = RepExpProp(p0 = p->NextOfPE);
|
||||||
READ_UNLOCK(ae->ARWLock);
|
READ_UNLOCK(ae->ARWLock);
|
||||||
@ -338,37 +377,24 @@ GetExpProp(Atom at, unsigned int arity)
|
|||||||
|
|
||||||
/* get expression entry for at/arity, at is already locked; */
|
/* get expression entry for at/arity, at is already locked; */
|
||||||
Prop
|
Prop
|
||||||
LockedGetExpProp(AtomEntry *ae, unsigned int arity)
|
GetExpPropHavingLock(AtomEntry *ae, unsigned int arity)
|
||||||
{
|
{
|
||||||
Prop p0;
|
Prop p0;
|
||||||
ExpEntry *p;
|
ExpEntry *p;
|
||||||
|
|
||||||
p = RepExpProp(p0 = ae->PropOfAE);
|
p = RepExpProp(p0 = ae->PropsOfAE);
|
||||||
while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity))
|
while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity))
|
||||||
p = RepExpProp(p0 = p->NextOfPE);
|
p = RepExpProp(p0 = p->NextOfPE);
|
||||||
return (p0);
|
return (p0);
|
||||||
}
|
}
|
||||||
|
|
||||||
Prop
|
Prop
|
||||||
PredPropByFunc(Functor f)
|
NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
|
||||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
|
||||||
{
|
{
|
||||||
Prop p0;
|
Prop p0;
|
||||||
FunctorEntry *fe = (FunctorEntry *)f;
|
PredEntry *p = (PredEntry *) AllocAtomSpace(sizeof(*p));
|
||||||
PredEntry *p;
|
Int m = IntOfTerm(cur_mod);
|
||||||
|
|
||||||
WRITE_LOCK(fe->FRWLock);
|
|
||||||
p = RepPredProp(p0 = fe->PropsOfFE);
|
|
||||||
|
|
||||||
while (p0 && (p->KindOfPE != 0 ||
|
|
||||||
(p->ModuleOfPred && p->ModuleOfPred != CurrentModule)))
|
|
||||||
p = RepPredProp(p0 = p->NextOfPE);
|
|
||||||
|
|
||||||
if (p0 != NIL) {
|
|
||||||
WRITE_UNLOCK(f->FRWLock);
|
|
||||||
return (p0);
|
|
||||||
}
|
|
||||||
p = (PredEntry *) AllocAtomSpace(sizeof(*p));
|
|
||||||
INIT_RWLOCK(p->PRWLock);
|
INIT_RWLOCK(p->PRWLock);
|
||||||
p->KindOfPE = PEProp;
|
p->KindOfPE = PEProp;
|
||||||
p->ArityOfPE = fe->ArityOfFE;
|
p->ArityOfPE = fe->ArityOfFE;
|
||||||
@ -378,9 +404,12 @@ PredPropByFunc(Functor f)
|
|||||||
p->OwnerFile = AtomNil;
|
p->OwnerFile = AtomNil;
|
||||||
p->OpcodeOfPred = UNDEF_OPCODE;
|
p->OpcodeOfPred = UNDEF_OPCODE;
|
||||||
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
|
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
|
||||||
p->ModuleOfPred = CurrentModule;
|
if (m == 0)
|
||||||
p->NextPredOfModule = ModulePred[CurrentModule];
|
p->ModuleOfPred = 0;
|
||||||
ModulePred[CurrentModule] = p;
|
else
|
||||||
|
p->ModuleOfPred = cur_mod;
|
||||||
|
p->NextPredOfModule = ModulePred[m];
|
||||||
|
ModulePred[m] = p;
|
||||||
INIT_LOCK(p->StatisticsForPred.lock);
|
INIT_LOCK(p->StatisticsForPred.lock);
|
||||||
p->StatisticsForPred.NOfEntries = 0;
|
p->StatisticsForPred.NOfEntries = 0;
|
||||||
p->StatisticsForPred.NOfHeadSuccesses = 0;
|
p->StatisticsForPred.NOfHeadSuccesses = 0;
|
||||||
@ -391,22 +420,63 @@ PredPropByFunc(Functor f)
|
|||||||
/* careful that they don't cross MkFunctor */
|
/* careful that they don't cross MkFunctor */
|
||||||
p->NextOfPE = fe->PropsOfFE;
|
p->NextOfPE = fe->PropsOfFE;
|
||||||
fe->PropsOfFE = p0 = AbsPredProp(p);
|
fe->PropsOfFE = p0 = AbsPredProp(p);
|
||||||
p->FunctorOfPred = f;
|
p->FunctorOfPred = (Functor)fe;
|
||||||
WRITE_UNLOCK(fe->FRWLock);
|
WRITE_UNLOCK(fe->FRWLock);
|
||||||
return (p0);
|
return (p0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Prop
|
||||||
|
NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
|
||||||
|
{
|
||||||
|
Prop p0;
|
||||||
|
PredEntry *p = (PredEntry *) AllocAtomSpace(sizeof(*p));
|
||||||
|
int m = IntOfTerm(cur_mod);
|
||||||
|
|
||||||
|
INIT_RWLOCK(p->PRWLock);
|
||||||
|
p->KindOfPE = PEProp;
|
||||||
|
p->ArityOfPE = 0;
|
||||||
|
p->FirstClause = p->LastClause = NIL;
|
||||||
|
p->PredFlags = 0L;
|
||||||
|
p->StateOfPred = 0;
|
||||||
|
p->OwnerFile = AtomNil;
|
||||||
|
p->OpcodeOfPred = UNDEF_OPCODE;
|
||||||
|
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
|
||||||
|
if (!m)
|
||||||
|
p->ModuleOfPred = 0;
|
||||||
|
else
|
||||||
|
p->ModuleOfPred = cur_mod;
|
||||||
|
p->NextPredOfModule = ModulePred[m];
|
||||||
|
ModulePred[m] = p;
|
||||||
|
INIT_LOCK(p->StatisticsForPred.lock);
|
||||||
|
p->StatisticsForPred.NOfEntries = 0;
|
||||||
|
p->StatisticsForPred.NOfHeadSuccesses = 0;
|
||||||
|
p->StatisticsForPred.NOfRetries = 0;
|
||||||
|
#ifdef TABLING
|
||||||
|
p->TableOfPred = NULL;
|
||||||
|
#endif /* TABLING */
|
||||||
|
/* careful that they don't cross MkFunctor */
|
||||||
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
|
ae->PropsOfAE = p0 = AbsPredProp(p);
|
||||||
|
p->FunctorOfPred = (Functor)AbsAtom(ae);
|
||||||
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
|
return (p0);
|
||||||
|
}
|
||||||
|
|
||||||
Prop
|
Prop
|
||||||
PredProp(Atom ap, unsigned int arity)
|
PredProp(Atom ap, unsigned int arity)
|
||||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||||
{
|
{
|
||||||
Prop p0;
|
Prop p0;
|
||||||
AtomEntry *ae = RepAtom(ap);
|
AtomEntry *ae;
|
||||||
Functor f;
|
Functor f;
|
||||||
|
|
||||||
|
if (arity == 0) {
|
||||||
|
return(PredPropByAtom(ap, *CurrentModulePtr));
|
||||||
|
}
|
||||||
|
ae = RepAtom(ap);
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
f = InlinedUnlockedMkFunctor(ae, arity);
|
f = InlinedUnlockedMkFunctor(ae, arity);
|
||||||
p0 = PredPropByFunc(f);
|
p0 = PredPropByFunc(f, *CurrentModulePtr);
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
return(p0);
|
return(p0);
|
||||||
}
|
}
|
||||||
@ -433,15 +503,15 @@ PutValue(Atom a, Term v)
|
|||||||
ValEntry *p;
|
ValEntry *p;
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
p0 = LockedGetAProp(ae, ValProperty);
|
p0 = GetAPropHavingLock(ae, ValProperty);
|
||||||
if (p0 != NIL) {
|
if (p0 != NIL) {
|
||||||
p = RepValProp(p0);
|
p = RepValProp(p0);
|
||||||
WRITE_LOCK(p->VRWLock);
|
WRITE_LOCK(p->VRWLock);
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
} else {
|
} else {
|
||||||
p = (ValEntry *) AllocAtomSpace(sizeof(ValEntry));
|
p = (ValEntry *) AllocAtomSpace(sizeof(ValEntry));
|
||||||
p->NextOfPE = RepAtom(a)->PropOfAE;
|
p->NextOfPE = RepAtom(a)->PropsOfAE;
|
||||||
RepAtom(a)->PropOfAE = AbsValProp(p);
|
RepAtom(a)->PropsOfAE = AbsValProp(p);
|
||||||
p->KindOfPE = ValProperty;
|
p->KindOfPE = ValProperty;
|
||||||
/* take care that the lock for the property will be inited even
|
/* take care that the lock for the property will be inited even
|
||||||
if someone else searches for the property */
|
if someone else searches for the property */
|
||||||
|
14
C/amasm.c
14
C/amasm.c
@ -753,7 +753,7 @@ a_p(op_numbers opcode)
|
|||||||
code_p->u.sdl.s =
|
code_p->u.sdl.s =
|
||||||
emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2);
|
emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2);
|
||||||
code_p->u.sdl.d =
|
code_p->u.sdl.d =
|
||||||
emit_a((CELL) RepPredProp(fe)->CodeOfPred);
|
emit_a((CELL) RepPredProp(fe)->TrueCodeOfPred);
|
||||||
code_p->u.sdl.l =
|
code_p->u.sdl.l =
|
||||||
emit_a(Unsigned(code_addr) + label_offset[comit_lab]);
|
emit_a(Unsigned(code_addr) + label_offset[comit_lab]);
|
||||||
code_p->u.sdl.p =
|
code_p->u.sdl.p =
|
||||||
@ -765,14 +765,18 @@ a_p(op_numbers opcode)
|
|||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
if (pass_no) {
|
if (pass_no) {
|
||||||
if (Flags & UserCPredFlag)
|
if (Flags & UserCPredFlag) {
|
||||||
code_p->opc = emit_op(_call_usercpred);
|
code_p->opc = emit_op(_call_usercpred);
|
||||||
else
|
} else {
|
||||||
code_p->opc = emit_op(_call_cpred);
|
if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod)
|
||||||
|
code_p->opc = emit_op(_p_execute);
|
||||||
|
else
|
||||||
|
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));
|
||||||
code_p->u.sla.l = emit_a((CELL)
|
code_p->u.sla.l = emit_a((CELL)
|
||||||
RepPredProp(fe)->CodeOfPred);
|
RepPredProp(fe)->TrueCodeOfPred);
|
||||||
code_p->u.sla.p = emit_a((CELL)
|
code_p->u.sla.p = emit_a((CELL)
|
||||||
RepPredProp(fe));
|
RepPredProp(fe));
|
||||||
if (cpc->rnd2)
|
if (cpc->rnd2)
|
||||||
|
@ -190,7 +190,7 @@ InitConstExps(void)
|
|||||||
for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
|
for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
|
||||||
AtomEntry *ae = RepAtom(LookupAtom(InitConstTab[i].OpName));
|
AtomEntry *ae = RepAtom(LookupAtom(InitConstTab[i].OpName));
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
if (LockedGetExpProp(ae, 0)) {
|
if (GetExpPropHavingLock(ae, 0)) {
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@ -199,8 +199,8 @@ InitConstExps(void)
|
|||||||
p->ArityOfEE = 0;
|
p->ArityOfEE = 0;
|
||||||
p->ENoOfEE = 0;
|
p->ENoOfEE = 0;
|
||||||
p->FOfEE.constant = InitConstTab[i].f;
|
p->FOfEE.constant = InitConstTab[i].f;
|
||||||
p->NextOfPE = ae->PropOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
ae->PropOfAE = AbsExpProp(p);
|
ae->PropsOfAE = AbsExpProp(p);
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -216,7 +216,7 @@ ReInitConstExps(void)
|
|||||||
AtomEntry *ae = RepAtom(FullLookupAtom(InitConstTab[i].OpName));
|
AtomEntry *ae = RepAtom(FullLookupAtom(InitConstTab[i].OpName));
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
if ((p = LockedGetExpProp(ae, 0)) == NULL) {
|
if ((p = GetExpPropHavingLock(ae, 0)) == NULL) {
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
|
@ -2007,7 +2007,7 @@ InitUnaryExps(void)
|
|||||||
for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
|
for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
|
||||||
AtomEntry *ae = RepAtom(LookupAtom(InitUnTab[i].OpName));
|
AtomEntry *ae = RepAtom(LookupAtom(InitUnTab[i].OpName));
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
if (LockedGetExpProp(ae, 1)) {
|
if (GetExpPropHavingLock(ae, 1)) {
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@ -2016,8 +2016,8 @@ InitUnaryExps(void)
|
|||||||
p->ArityOfEE = 1;
|
p->ArityOfEE = 1;
|
||||||
p->ENoOfEE = 1;
|
p->ENoOfEE = 1;
|
||||||
p->FOfEE.unary = InitUnTab[i].f;
|
p->FOfEE.unary = InitUnTab[i].f;
|
||||||
p->NextOfPE = ae->PropOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
ae->PropOfAE = AbsExpProp(p);
|
ae->PropsOfAE = AbsExpProp(p);
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
}
|
}
|
||||||
InitCPred("is", 3, p_unary_is, TestPredFlag | SafePredFlag);
|
InitCPred("is", 3, p_unary_is, TestPredFlag | SafePredFlag);
|
||||||
@ -2034,7 +2034,7 @@ ReInitUnaryExps(void)
|
|||||||
AtomEntry *ae = RepAtom(FullLookupAtom(InitUnTab[i].OpName));
|
AtomEntry *ae = RepAtom(FullLookupAtom(InitUnTab[i].OpName));
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
if ((p = LockedGetExpProp(ae, 1)) == NULL) {
|
if ((p = GetExpPropHavingLock(ae, 1)) == NULL) {
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
|
@ -1720,7 +1720,7 @@ InitBinaryExps(void)
|
|||||||
for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) {
|
for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) {
|
||||||
AtomEntry *ae = RepAtom(LookupAtom(InitBinTab[i].OpName));
|
AtomEntry *ae = RepAtom(LookupAtom(InitBinTab[i].OpName));
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
if (LockedGetExpProp(ae, 2)) {
|
if (GetExpPropHavingLock(ae, 2)) {
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@ -1729,8 +1729,8 @@ InitBinaryExps(void)
|
|||||||
p->ArityOfEE = 2;
|
p->ArityOfEE = 2;
|
||||||
p->ENoOfEE = 2;
|
p->ENoOfEE = 2;
|
||||||
p->FOfEE.binary = InitBinTab[i].f;
|
p->FOfEE.binary = InitBinTab[i].f;
|
||||||
p->NextOfPE = ae->PropOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
ae->PropOfAE = AbsExpProp(p);
|
ae->PropsOfAE = AbsExpProp(p);
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
}
|
}
|
||||||
InitCPred("is", 4, p_binary_is, TestPredFlag | SafePredFlag);
|
InitCPred("is", 4, p_binary_is, TestPredFlag | SafePredFlag);
|
||||||
@ -1747,7 +1747,7 @@ ReInitBinaryExps(void)
|
|||||||
AtomEntry *ae = RepAtom(FullLookupAtom(InitBinTab[i].OpName));
|
AtomEntry *ae = RepAtom(FullLookupAtom(InitBinTab[i].OpName));
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
if ((p = LockedGetExpProp(ae, 2)) == NULL) {
|
if ((p = GetExpPropHavingLock(ae, 2)) == NULL) {
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
|
28
C/arrays.c
28
C/arrays.c
@ -149,7 +149,7 @@ AccessNamedArray(Atom a, Int indx)
|
|||||||
ArrayEntry *pp;
|
ArrayEntry *pp;
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
pp = RepArrayProp(ae->PropOfAE);
|
pp = RepArrayProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
||||||
pp = RepArrayProp(pp->NextOfPE);
|
pp = RepArrayProp(pp->NextOfPE);
|
||||||
READ_UNLOCK(ae->ARWLock);
|
READ_UNLOCK(ae->ARWLock);
|
||||||
@ -393,9 +393,9 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae)
|
|||||||
|
|
||||||
p = (ArrayEntry *) AllocAtomSpace(sizeof(*p));
|
p = (ArrayEntry *) AllocAtomSpace(sizeof(*p));
|
||||||
p->KindOfPE = ArrayProperty;
|
p->KindOfPE = ArrayProperty;
|
||||||
p->NextOfPE = ae->PropOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
INIT_RWLOCK(p->ArRWLock);
|
INIT_RWLOCK(p->ArRWLock);
|
||||||
ae->PropOfAE = AbsArrayProp(p);
|
ae->PropsOfAE = AbsArrayProp(p);
|
||||||
|
|
||||||
InitNamedArray(p, dim);
|
InitNamedArray(p, dim);
|
||||||
|
|
||||||
@ -446,13 +446,13 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
|
|||||||
if (EndOfPAEntr(p)) {
|
if (EndOfPAEntr(p)) {
|
||||||
p = (StaticArrayEntry *) AllocAtomSpace(sizeof(*p));
|
p = (StaticArrayEntry *) AllocAtomSpace(sizeof(*p));
|
||||||
p->KindOfPE = ArrayProperty;
|
p->KindOfPE = ArrayProperty;
|
||||||
p->NextOfPE = ae->PropOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
INIT_RWLOCK(p->ArRWLock);
|
INIT_RWLOCK(p->ArRWLock);
|
||||||
WRITE_LOCK(p->ArRWLock);
|
WRITE_LOCK(p->ArRWLock);
|
||||||
}
|
}
|
||||||
p->ArrayEArity = -dim;
|
p->ArrayEArity = -dim;
|
||||||
p->ArrayType = type;
|
p->ArrayType = type;
|
||||||
ae->PropOfAE = AbsArrayProp((ArrayEntry *)p);
|
ae->PropsOfAE = AbsArrayProp((ArrayEntry *)p);
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
if (start_addr == NULL) {
|
if (start_addr == NULL) {
|
||||||
int i;
|
int i;
|
||||||
@ -578,7 +578,7 @@ ClearNamedArray(CELL *pt0)
|
|||||||
AtomEntry *ae = (AtomEntry *)RepAppl(pt0[-1]);
|
AtomEntry *ae = (AtomEntry *)RepAppl(pt0[-1]);
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
pp = RepProp(ae->PropOfAE);
|
pp = RepProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty) {
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty) {
|
||||||
pp = RepProp(pp->NextOfPE);
|
pp = RepProp(pp->NextOfPE);
|
||||||
}
|
}
|
||||||
@ -649,7 +649,7 @@ p_create_array(void)
|
|||||||
PropEntry *pp;
|
PropEntry *pp;
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
pp = RepProp(ae->PropOfAE);
|
pp = RepProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
||||||
pp = RepProp(pp->NextOfPE);
|
pp = RepProp(pp->NextOfPE);
|
||||||
if (EndOfPAEntr(pp)) {
|
if (EndOfPAEntr(pp)) {
|
||||||
@ -753,7 +753,7 @@ p_create_static_array(void)
|
|||||||
StaticArrayEntry *pp;
|
StaticArrayEntry *pp;
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
pp = RepStaticArrayProp(ae->PropOfAE);
|
pp = RepStaticArrayProp(ae->PropsOfAE);
|
||||||
WRITE_LOCK(pp->ArRWLock);
|
WRITE_LOCK(pp->ArRWLock);
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
||||||
pp = RepStaticArrayProp(pp->NextOfPE);
|
pp = RepStaticArrayProp(pp->NextOfPE);
|
||||||
@ -786,7 +786,7 @@ p_has_static_array(void)
|
|||||||
StaticArrayEntry *pp;
|
StaticArrayEntry *pp;
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
pp = RepStaticArrayProp(ae->PropOfAE);
|
pp = RepStaticArrayProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
||||||
pp = RepStaticArrayProp(pp->NextOfPE);
|
pp = RepStaticArrayProp(pp->NextOfPE);
|
||||||
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
|
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
|
||||||
@ -833,7 +833,7 @@ p_resize_static_array(void)
|
|||||||
else if (IsAtomTerm(t)) {
|
else if (IsAtomTerm(t)) {
|
||||||
/* resize a named array */
|
/* resize a named array */
|
||||||
Atom a = AtomOfTerm(t);
|
Atom a = AtomOfTerm(t);
|
||||||
StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropOfAE);
|
StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropsOfAE);
|
||||||
|
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
||||||
pp = RepStaticArrayProp(pp->NextOfPE);
|
pp = RepStaticArrayProp(pp->NextOfPE);
|
||||||
@ -868,7 +868,7 @@ p_close_static_array(void)
|
|||||||
PropEntry *pp;
|
PropEntry *pp;
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
pp = RepProp(ae->PropOfAE);
|
pp = RepProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
||||||
pp = RepProp(pp->NextOfPE);
|
pp = RepProp(pp->NextOfPE);
|
||||||
READ_UNLOCK(ae->ARWLock);
|
READ_UNLOCK(ae->ARWLock);
|
||||||
@ -1101,7 +1101,7 @@ p_create_mmapped_array(void)
|
|||||||
StaticArrayEntry *pp;
|
StaticArrayEntry *pp;
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
pp = RepStaticArrayProp(ae->PropOfAE);
|
pp = RepStaticArrayProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
|
||||||
pp = RepStaticArrayProp(pp->NextOfPE);
|
pp = RepStaticArrayProp(pp->NextOfPE);
|
||||||
if (!EndOfPAEntr(pp)) {
|
if (!EndOfPAEntr(pp)) {
|
||||||
@ -1361,7 +1361,7 @@ p_assign_static(void)
|
|||||||
AtomEntry *ae = RepAtom(AtomOfTerm(t1));
|
AtomEntry *ae = RepAtom(AtomOfTerm(t1));
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
ptr = RepStaticArrayProp(ae->PropOfAE);
|
ptr = RepStaticArrayProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
|
||||||
ptr = RepStaticArrayProp(ptr->NextOfPE);
|
ptr = RepStaticArrayProp(ptr->NextOfPE);
|
||||||
READ_UNLOCK(ae->ARWLock);
|
READ_UNLOCK(ae->ARWLock);
|
||||||
@ -1611,7 +1611,7 @@ SetDBForThrow(Term Message)
|
|||||||
StaticArrayEntry *ptr;
|
StaticArrayEntry *ptr;
|
||||||
DBRef ref;
|
DBRef ref;
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
ptr = RepStaticArrayProp(ae->PropOfAE);
|
ptr = RepStaticArrayProp(ae->PropsOfAE);
|
||||||
while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
|
while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
|
||||||
ptr = RepStaticArrayProp(ptr->NextOfPE);
|
ptr = RepStaticArrayProp(ptr->NextOfPE);
|
||||||
READ_UNLOCK(ae->ARWLock);
|
READ_UNLOCK(ae->ARWLock);
|
||||||
|
8
C/bb.c
8
C/bb.c
@ -32,7 +32,7 @@ PutBBProp(AtomEntry *ae) /* get BBentry for at; */
|
|||||||
BBProp p;
|
BBProp p;
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
p = RepBBProp(p0 = ae->PropOfAE);
|
p = RepBBProp(p0 = ae->PropsOfAE);
|
||||||
while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
|
while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
|
||||||
(p->ModuleOfBB != CurrentModule))) {
|
(p->ModuleOfBB != CurrentModule))) {
|
||||||
p = RepBBProp(p0 = p->NextOfPE);
|
p = RepBBProp(p0 = p->NextOfPE);
|
||||||
@ -44,8 +44,8 @@ PutBBProp(AtomEntry *ae) /* get BBentry for at; */
|
|||||||
Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2");
|
Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2");
|
||||||
return(NULL);
|
return(NULL);
|
||||||
}
|
}
|
||||||
p->NextOfPE = ae->PropOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
ae->PropOfAE = AbsBBProp(p);
|
ae->PropsOfAE = AbsBBProp(p);
|
||||||
p->ModuleOfBB = CurrentModule;
|
p->ModuleOfBB = CurrentModule;
|
||||||
p->Element = NULL;
|
p->Element = NULL;
|
||||||
p->KeyOfBB = AbsAtom(ae);
|
p->KeyOfBB = AbsAtom(ae);
|
||||||
@ -111,7 +111,7 @@ GetBBProp(AtomEntry *ae) /* get BBentry for at; */
|
|||||||
BBProp p;
|
BBProp p;
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
p = RepBBProp(p0 = ae->PropOfAE);
|
p = RepBBProp(p0 = ae->PropsOfAE);
|
||||||
while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
|
while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
|
||||||
(p->ModuleOfBB != CurrentModule))) {
|
(p->ModuleOfBB != CurrentModule))) {
|
||||||
p = RepBBProp(p0 = p->NextOfPE);
|
p = RepBBProp(p0 = p->NextOfPE);
|
||||||
|
143
C/cdmgr.c
143
C/cdmgr.c
@ -299,7 +299,7 @@ RemoveIndexation(PredEntry *ap)
|
|||||||
Error_Term = TermNil;
|
Error_Term = TermNil;
|
||||||
Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
|
Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
|
||||||
if (Arity == 0)
|
if (Arity == 0)
|
||||||
sprintf(ErrorMessage, "predicate %s is in use", RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE);
|
sprintf(ErrorMessage, "predicate %s is in use", RepAtom((Atom)(ap->FunctorOfPred))->StrOfAE);
|
||||||
else
|
else
|
||||||
sprintf(ErrorMessage,
|
sprintf(ErrorMessage,
|
||||||
#if SHORT_INTS
|
#if SHORT_INTS
|
||||||
@ -796,6 +796,8 @@ addclause(Term t, CODEADDR cp, int mode)
|
|||||||
Int Arity;
|
Int Arity;
|
||||||
PredEntry *p;
|
PredEntry *p;
|
||||||
int spy_flag = FALSE;
|
int spy_flag = FALSE;
|
||||||
|
SMALLUNSGN mod = CurrentModule;
|
||||||
|
|
||||||
|
|
||||||
if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert)
|
if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert)
|
||||||
t = ArgOfTerm(1, t);
|
t = ArgOfTerm(1, t);
|
||||||
@ -810,39 +812,9 @@ addclause(Term t, CODEADDR cp, int mode)
|
|||||||
p = RepPredProp(PredProp(AbsAtom(ap), Arity));
|
p = RepPredProp(PredProp(AbsAtom(ap), Arity));
|
||||||
PutValue(AtomAbol, TermNil);
|
PutValue(AtomAbol, TermNil);
|
||||||
WRITE_LOCK(p->PRWLock);
|
WRITE_LOCK(p->PRWLock);
|
||||||
if (p->PredFlags & StandardPredFlag) {
|
/* we are redefining a prolog module predicate */
|
||||||
Term t, ti[2];
|
if (mod != 0 && p->ModuleOfPred == 0) {
|
||||||
|
addcl_permission_error(ap, Arity);
|
||||||
WRITE_UNLOCK(p->PRWLock);
|
|
||||||
ti[0] = MkAtomTerm(AbsAtom(ap));
|
|
||||||
ti[1] = MkIntegerTerm(Arity);
|
|
||||||
t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
|
|
||||||
ErrorMessage = ErrorSay;
|
|
||||||
Error_Term = t;
|
|
||||||
Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
|
|
||||||
#ifdef HAVE_SNPRINTF
|
|
||||||
if (Arity == 0)
|
|
||||||
snprintf(ErrorMessage, 256, "system predicate %s", ap->StrOfAE);
|
|
||||||
else
|
|
||||||
snprintf(ErrorMessage, 256,
|
|
||||||
#if SHORT_INTS
|
|
||||||
"system predicate %s/%ld",
|
|
||||||
#else
|
|
||||||
"system predicate %s/%d",
|
|
||||||
#endif
|
|
||||||
ap->StrOfAE, Arity);
|
|
||||||
#else
|
|
||||||
if (Arity == 0)
|
|
||||||
sprintf(ErrorMessage, "system predicate %s", ap->StrOfAE);
|
|
||||||
else
|
|
||||||
sprintf(ErrorMessage,
|
|
||||||
#if SHORT_INTS
|
|
||||||
"system predicate %s/%ld",
|
|
||||||
#else
|
|
||||||
"system predicate %s/%d",
|
|
||||||
#endif
|
|
||||||
ap->StrOfAE, Arity);
|
|
||||||
#endif
|
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
/* The only problem we have now is when we need to throw away
|
/* The only problem we have now is when we need to throw away
|
||||||
@ -1183,7 +1155,7 @@ p_purge_clauses(void)
|
|||||||
pred = RepPredProp(PredProp(at, 0));
|
pred = RepPredProp(PredProp(at, 0));
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor fun = FunctorOfTerm(t);
|
Functor fun = FunctorOfTerm(t);
|
||||||
pred = RepPredProp(PredPropByFunc(fun));
|
pred = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
WRITE_LOCK(pred->PRWLock);
|
WRITE_LOCK(pred->PRWLock);
|
||||||
@ -1233,7 +1205,7 @@ p_setspy(void)
|
|||||||
|
|
||||||
at = FullLookupAtom("$spy");
|
at = FullLookupAtom("$spy");
|
||||||
pred = RepPredProp(PredProp(at, 1));
|
pred = RepPredProp(PredProp(at, 1));
|
||||||
SpyCode = CellPtr(&(pred->CodeOfPred));
|
SpyCode = pred;
|
||||||
t = Deref(ARG1);
|
t = Deref(ARG1);
|
||||||
if (IsVarTerm(t))
|
if (IsVarTerm(t))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
@ -1242,7 +1214,7 @@ p_setspy(void)
|
|||||||
pred = RepPredProp(PredProp(at, 0));
|
pred = RepPredProp(PredProp(at, 0));
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor fun = FunctorOfTerm(t);
|
Functor fun = FunctorOfTerm(t);
|
||||||
pred = RepPredProp(PredPropByFunc(fun));
|
pred = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
|
||||||
} else {
|
} else {
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
}
|
}
|
||||||
@ -1290,7 +1262,7 @@ p_rmspy(void)
|
|||||||
pred = RepPredProp(PredProp(at, 0));
|
pred = RepPredProp(PredProp(at, 0));
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor fun = FunctorOfTerm(t);
|
Functor fun = FunctorOfTerm(t);
|
||||||
pred = RepPredProp(PredPropByFunc(fun));
|
pred = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
WRITE_LOCK(pred->PRWLock);
|
WRITE_LOCK(pred->PRWLock);
|
||||||
@ -1334,7 +1306,7 @@ p_number_of_clauses(void)
|
|||||||
pe = PredProp(a, 0);
|
pe = PredProp(a, 0);
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
register Functor f = FunctorOfTerm(t);
|
register Functor f = FunctorOfTerm(t);
|
||||||
pe = PredPropByFunc(f);
|
pe = PredPropByFunc(f, *CurrentModulePtr);
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
q = RepPredProp(pe)->FirstClause;
|
q = RepPredProp(pe)->FirstClause;
|
||||||
@ -1372,7 +1344,7 @@ p_find_dynamic(void)
|
|||||||
pe = PredProp(a, 0);
|
pe = PredProp(a, 0);
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
register Functor f = FunctorOfTerm(t);
|
register Functor f = FunctorOfTerm(t);
|
||||||
pe = PredPropByFunc(f);
|
pe = PredPropByFunc(f, *CurrentModulePtr);
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
q = RepPredProp(pe)->FirstClause;
|
q = RepPredProp(pe)->FirstClause;
|
||||||
@ -1427,7 +1399,7 @@ p_next_dynamic(void)
|
|||||||
pe = PredProp(a, 0);
|
pe = PredProp(a, 0);
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
register Functor f = FunctorOfTerm(t);
|
register Functor f = FunctorOfTerm(t);
|
||||||
pe = PredPropByFunc(f);
|
pe = PredPropByFunc(f, *CurrentModulePtr);
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
q = RepPredProp(pe)->FirstClause;
|
q = RepPredProp(pe)->FirstClause;
|
||||||
@ -1462,7 +1434,7 @@ p_in_use(void)
|
|||||||
pe = RepPredProp(PredProp(at, 0));
|
pe = RepPredProp(PredProp(at, 0));
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor fun = FunctorOfTerm(t);
|
Functor fun = FunctorOfTerm(t);
|
||||||
pe = RepPredProp(PredPropByFunc(fun));
|
pe = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
READ_LOCK(pe->PRWLock);
|
READ_LOCK(pe->PRWLock);
|
||||||
@ -1576,7 +1548,7 @@ p_is_dynamic(void)
|
|||||||
pe = RepPredProp(PredProp(at, 0));
|
pe = RepPredProp(PredProp(at, 0));
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor fun = FunctorOfTerm(t);
|
Functor fun = FunctorOfTerm(t);
|
||||||
pe = RepPredProp(PredPropByFunc(fun));
|
pe = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
@ -1609,7 +1581,13 @@ p_set_pred_module(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
WRITE_LOCK(pe->PRWLock);
|
WRITE_LOCK(pe->PRWLock);
|
||||||
pe->ModuleOfPred = LookupModule(Deref(ARG2));
|
{
|
||||||
|
SMALLUNSGN mod = LookupModule(Deref(ARG2));
|
||||||
|
if (mod)
|
||||||
|
pe->ModuleOfPred = MkIntTerm(mod);
|
||||||
|
else
|
||||||
|
pe->ModuleOfPred = 0;
|
||||||
|
}
|
||||||
WRITE_UNLOCK(pe->PRWLock);
|
WRITE_UNLOCK(pe->PRWLock);
|
||||||
return(TRUE);
|
return(TRUE);
|
||||||
}
|
}
|
||||||
@ -1619,34 +1597,37 @@ p_undefined(void)
|
|||||||
{ /* '$undefined'(P) */
|
{ /* '$undefined'(P) */
|
||||||
PredEntry *pe;
|
PredEntry *pe;
|
||||||
Term t;
|
Term t;
|
||||||
|
Term tmod = *CurrentModulePtr;
|
||||||
|
|
||||||
SMALLUNSGN omod = CurrentModule;
|
|
||||||
t = Deref(ARG1);
|
t = Deref(ARG1);
|
||||||
restart_undefined:
|
restart_undefined:
|
||||||
if (IsVarTerm(t)) {
|
if (IsVarTerm(t)) {
|
||||||
Error(INSTANTIATION_ERROR,ARG1,"undefined/1");
|
Error(INSTANTIATION_ERROR,ARG1,"undefined/1");
|
||||||
*CurrentModulePtr = MkIntTerm(omod);
|
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
if (IsAtomTerm(t)) {
|
if (IsAtomTerm(t)) {
|
||||||
Atom at = AtomOfTerm(t);
|
Atom at = AtomOfTerm(t);
|
||||||
pe = RepPredProp(GetPredProp(at,0));
|
pe = RepPredProp(GetPredPropByAtom(at,tmod));
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor funt = FunctorOfTerm(t);
|
Functor funt = FunctorOfTerm(t);
|
||||||
if (funt == FunctorModule) {
|
if (funt == FunctorModule) {
|
||||||
Term mod = ArgOfTerm(1, t);
|
Term mod = ArgOfTerm(1, t);
|
||||||
if (!IsVarTerm(mod) ) {
|
if (IsVarTerm(mod) ) {
|
||||||
*CurrentModulePtr = MkIntTerm(LookupModule(mod));
|
Error(INSTANTIATION_ERROR,ARG1,"undefined/1");
|
||||||
t = ArgOfTerm(2, t);
|
return(FALSE);
|
||||||
goto restart_undefined;
|
|
||||||
}
|
}
|
||||||
|
if (!IsAtomTerm(mod) ) {
|
||||||
|
Error(TYPE_ERROR_ATOM,ARG1,"undefined/1");
|
||||||
|
return(FALSE);
|
||||||
|
}
|
||||||
|
tmod = MkIntTerm(LookupModule(mod));
|
||||||
|
t = ArgOfTerm(2, t);
|
||||||
|
goto restart_undefined;
|
||||||
}
|
}
|
||||||
pe = RepPredProp(GetPredPropByFunc(funt));
|
pe = RepPredProp(GetPredPropByFunc(funt, tmod));
|
||||||
} else {
|
} else {
|
||||||
*CurrentModulePtr = MkIntTerm(omod);
|
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
}
|
}
|
||||||
*CurrentModulePtr = MkIntTerm(omod);
|
|
||||||
if (pe == RepPredProp(NIL))
|
if (pe == RepPredProp(NIL))
|
||||||
return (TRUE);
|
return (TRUE);
|
||||||
READ_LOCK(pe->PRWLock);
|
READ_LOCK(pe->PRWLock);
|
||||||
@ -1679,7 +1660,7 @@ p_kill_dynamic(void)
|
|||||||
pe = RepPredProp(PredProp(at, 0));
|
pe = RepPredProp(PredProp(at, 0));
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor funt = FunctorOfTerm(t);
|
Functor funt = FunctorOfTerm(t);
|
||||||
pe = RepPredProp(PredPropByFunc(funt));
|
pe = RepPredProp(PredPropByFunc(funt, *CurrentModulePtr));
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
@ -1880,7 +1861,7 @@ p_search_for_static_predicate_in_use(void)
|
|||||||
pe = RepPredProp(PredProp(at, 0));
|
pe = RepPredProp(PredProp(at, 0));
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor funt = FunctorOfTerm(ARG1);
|
Functor funt = FunctorOfTerm(ARG1);
|
||||||
pe = RepPredProp(PredPropByFunc(funt));
|
pe = RepPredProp(PredPropByFunc(funt, *CurrentModulePtr));
|
||||||
} else
|
} else
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
/* do nothing if we are in consult */
|
/* do nothing if we are in consult */
|
||||||
@ -1949,7 +1930,7 @@ NextPred(PredEntry *pp, AtomEntry *ae)
|
|||||||
static Int
|
static Int
|
||||||
check_code_in_atom(AtomEntry *ae, CODEADDR codeptr, Int *parity, SMALLUNSGN *pmodule) {
|
check_code_in_atom(AtomEntry *ae, CODEADDR codeptr, Int *parity, SMALLUNSGN *pmodule) {
|
||||||
PredEntry *pp;
|
PredEntry *pp;
|
||||||
for (pp = NextPred(RepPredProp(ae->PropOfAE),ae);
|
for (pp = NextPred(RepPredProp(ae->PropsOfAE),ae);
|
||||||
!EndOfPAEntr(pp);
|
!EndOfPAEntr(pp);
|
||||||
pp = NextPred(RepPredProp(pp->NextOfPE),ae)) {
|
pp = NextPred(RepPredProp(pp->NextOfPE),ae)) {
|
||||||
CODEADDR clcode, cl;
|
CODEADDR clcode, cl;
|
||||||
@ -1963,7 +1944,10 @@ check_code_in_atom(AtomEntry *ae, CODEADDR codeptr, Int *parity, SMALLUNSGN *pmo
|
|||||||
codeptr > pp->TrueCodeOfPred &&
|
codeptr > pp->TrueCodeOfPred &&
|
||||||
codeptr <= pp->TrueCodeOfPred + SizeOfBlock(pp->TrueCodeOfPred)) {
|
codeptr <= pp->TrueCodeOfPred + SizeOfBlock(pp->TrueCodeOfPred)) {
|
||||||
*parity = pp->ArityOfPE;
|
*parity = pp->ArityOfPE;
|
||||||
*pmodule = pp->ModuleOfPred;
|
if (pp->ModuleOfPred == 0)
|
||||||
|
*pmodule = pp->ModuleOfPred;
|
||||||
|
else
|
||||||
|
*pmodule = IntOfTerm(pp->ModuleOfPred);
|
||||||
READ_UNLOCK(pp->PRWLock);
|
READ_UNLOCK(pp->PRWLock);
|
||||||
return(-1);
|
return(-1);
|
||||||
}
|
}
|
||||||
@ -1972,7 +1956,10 @@ check_code_in_atom(AtomEntry *ae, CODEADDR codeptr, Int *parity, SMALLUNSGN *pmo
|
|||||||
if (codeptr > cl && codeptr <= cl + SizeOfBlock(cl)) {
|
if (codeptr > cl && codeptr <= cl + SizeOfBlock(cl)) {
|
||||||
/* we found it */
|
/* we found it */
|
||||||
*parity = pp->ArityOfPE;
|
*parity = pp->ArityOfPE;
|
||||||
*pmodule = pp->ModuleOfPred;
|
if (pp->ModuleOfPred == 0)
|
||||||
|
*pmodule = pp->ModuleOfPred;
|
||||||
|
else
|
||||||
|
*pmodule = IntOfTerm(pp->ModuleOfPred);
|
||||||
READ_UNLOCK(pp->PRWLock);
|
READ_UNLOCK(pp->PRWLock);
|
||||||
return(i);
|
return(i);
|
||||||
}
|
}
|
||||||
@ -2137,6 +2124,40 @@ p_parent_pred(void)
|
|||||||
unify(ARG3, MkIntTerm(arity)));
|
unify(ARG3, MkIntTerm(arity)));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Int /* $parent_pred(Module, Name, Arity) */
|
||||||
|
p_system_pred(void)
|
||||||
|
{
|
||||||
|
PredEntry *pe;
|
||||||
|
Term mod = *CurrentModulePtr;
|
||||||
|
|
||||||
|
Term t1 = Deref(ARG1);
|
||||||
|
restart:
|
||||||
|
if (IsVarTerm(t1))
|
||||||
|
return (FALSE);
|
||||||
|
if (IsAtomTerm(t1)) {
|
||||||
|
pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), mod));
|
||||||
|
} else if (IsApplTerm(t1)) {
|
||||||
|
Functor funt = FunctorOfTerm(t1);
|
||||||
|
if (funt == FunctorModule) {
|
||||||
|
Term nmod = ArgOfTerm(1, t1);
|
||||||
|
if (IsVarTerm(nmod)) {
|
||||||
|
Error(INSTANTIATION_ERROR,ARG1,"system_predicate/1");
|
||||||
|
return(FALSE);
|
||||||
|
}
|
||||||
|
if (!IsAtomTerm(nmod)) {
|
||||||
|
Error(TYPE_ERROR_ATOM,ARG1,"system_predicate/1");
|
||||||
|
return(FALSE);
|
||||||
|
}
|
||||||
|
mod = MkIntTerm(LookupModule(nmod));
|
||||||
|
t1 = ArgOfTerm(2, t1);
|
||||||
|
goto restart;
|
||||||
|
}
|
||||||
|
pe = RepPredProp(PredPropByFunc(funt, mod));
|
||||||
|
} else
|
||||||
|
return (FALSE);
|
||||||
|
return(pe->ModuleOfPred == 0);
|
||||||
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
InitCdMgr(void)
|
InitCdMgr(void)
|
||||||
{
|
{
|
||||||
@ -2157,7 +2178,7 @@ InitCdMgr(void)
|
|||||||
InitCPred("$number_of_clauses", 2, p_number_of_clauses, SafePredFlag|SyncPredFlag);
|
InitCPred("$number_of_clauses", 2, p_number_of_clauses, SafePredFlag|SyncPredFlag);
|
||||||
InitCPred("$find_dynamic", 3, p_find_dynamic, SafePredFlag|SyncPredFlag);
|
InitCPred("$find_dynamic", 3, p_find_dynamic, SafePredFlag|SyncPredFlag);
|
||||||
InitCPred("$next_dynamic", 3, p_next_dynamic, SafePredFlag|SyncPredFlag);
|
InitCPred("$next_dynamic", 3, p_next_dynamic, SafePredFlag|SyncPredFlag);
|
||||||
InitCPred("$undefined", 1, p_undefined, SafePredFlag);
|
InitCPred("$undefined", 1, p_undefined, SafePredFlag|TestPredFlag);
|
||||||
InitCPred("$optimizer_on", 0, p_optimizer_on, SafePredFlag|SyncPredFlag);
|
InitCPred("$optimizer_on", 0, p_optimizer_on, SafePredFlag|SyncPredFlag);
|
||||||
InitCPred("$clean_up_dead_clauses", 0, p_clean_up_dead_clauses, SyncPredFlag);
|
InitCPred("$clean_up_dead_clauses", 0, p_clean_up_dead_clauses, SyncPredFlag);
|
||||||
InitCPred("$optimizer_off", 0, p_optimizer_off, SafePredFlag|SyncPredFlag);
|
InitCPred("$optimizer_off", 0, p_optimizer_off, SafePredFlag|SyncPredFlag);
|
||||||
@ -2174,4 +2195,6 @@ InitCdMgr(void)
|
|||||||
InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag);
|
InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag);
|
||||||
InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
|
InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
|
||||||
InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);
|
InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);
|
||||||
|
InitCPred("$system_predicate", 1, p_system_pred, SafePredFlag);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1095,7 +1095,7 @@ c_functor(Term Goal)
|
|||||||
c_var(t3,f_flag,(unsigned int)_functor);
|
c_var(t3,f_flag,(unsigned int)_functor);
|
||||||
} else {
|
} else {
|
||||||
Functor f = FunctorOfTerm(Goal);
|
Functor f = FunctorOfTerm(Goal);
|
||||||
Prop p0 = PredPropByFunc(f);
|
Prop p0 = PredPropByFunc(f, *CurrentModulePtr);
|
||||||
if (profiling)
|
if (profiling)
|
||||||
emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero);
|
emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero);
|
||||||
c_args(Goal);
|
c_args(Goal);
|
||||||
@ -1260,7 +1260,7 @@ c_goal(Term Goal)
|
|||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
f = FunctorOfTerm(Goal);
|
f = FunctorOfTerm(Goal);
|
||||||
p = RepPredProp(p0 = PredPropByFunc(f));
|
p = RepPredProp(p0 = PredPropByFunc(f, *CurrentModulePtr));
|
||||||
if (f == FunctorOr) {
|
if (f == FunctorOr) {
|
||||||
CELL l = ++labelno;
|
CELL l = ++labelno;
|
||||||
CELL m = ++labelno;
|
CELL m = ++labelno;
|
||||||
@ -1451,8 +1451,7 @@ c_goal(Term Goal)
|
|||||||
c_goal(ArgOfTerm(2, Goal));
|
c_goal(ArgOfTerm(2, Goal));
|
||||||
*CurrentModulePtr = MkIntTerm(save_CurrentModule);
|
*CurrentModulePtr = MkIntTerm(save_CurrentModule);
|
||||||
return;
|
return;
|
||||||
}
|
} else if (f == FunctorEq) {
|
||||||
else if (f == FunctorEq) {
|
|
||||||
if (profiling)
|
if (profiling)
|
||||||
emit(enter_profiling_op, (CELL)p, Zero);
|
emit(enter_profiling_op, (CELL)p, Zero);
|
||||||
c_eq(ArgOfTerm(1, Goal), ArgOfTerm(2, Goal));
|
c_eq(ArgOfTerm(1, Goal), ArgOfTerm(2, Goal));
|
||||||
@ -2855,7 +2854,7 @@ cclause(Term inp_clause, int NOfArgs)
|
|||||||
Atom ap = AtomOfTerm(head);
|
Atom ap = AtomOfTerm(head);
|
||||||
CurrentPred = RepPredProp(PredProp(ap, 0));
|
CurrentPred = RepPredProp(PredProp(ap, 0));
|
||||||
} else {
|
} else {
|
||||||
CurrentPred = RepPredProp(PredPropByFunc(FunctorOfTerm(head)));
|
CurrentPred = RepPredProp(PredPropByFunc(FunctorOfTerm(head),*CurrentModulePtr));
|
||||||
}
|
}
|
||||||
/* insert extra instructions to count calls */
|
/* insert extra instructions to count calls */
|
||||||
READ_LOCK(CurrentPred->PRWLock);
|
READ_LOCK(CurrentPred->PRWLock);
|
||||||
|
@ -82,9 +82,9 @@ is_a_test_pred (Term arg)
|
|||||||
else if (IsApplTerm (arg))
|
else if (IsApplTerm (arg))
|
||||||
{
|
{
|
||||||
Functor f = FunctorOfTerm (arg);
|
Functor f = FunctorOfTerm (arg);
|
||||||
if (RepPredProp (PredPropByFunc (f)) == NULL)
|
if (RepPredProp (PredPropByFunc (f, *CurrentModulePtr)) == NULL)
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
return (RepPredProp (PredPropByFunc (f))->PredFlags & TestPredFlag);
|
return (RepPredProp (PredPropByFunc (f, *CurrentModulePtr))->PredFlags & TestPredFlag);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
@ -297,22 +297,36 @@ ShowOp (f)
|
|||||||
{
|
{
|
||||||
PredEntry *p = RepPredProp ((Prop) arg);
|
PredEntry *p = RepPredProp ((Prop) arg);
|
||||||
Functor f = p->FunctorOfPred;
|
Functor f = p->FunctorOfPred;
|
||||||
plwrite (ModuleName[p->ModuleOfPred], DebugPutc, 0);
|
UInt arity = p->ArityOfPE;
|
||||||
|
SMALLUNSGN mod = 0;
|
||||||
|
|
||||||
|
if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred);
|
||||||
|
plwrite (ModuleName[mod], DebugPutc, 0);
|
||||||
DebugPutc (c_output_stream,':');
|
DebugPutc (c_output_stream,':');
|
||||||
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
|
if (arity == 0)
|
||||||
|
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
|
||||||
|
else
|
||||||
|
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
|
||||||
DebugPutc (c_output_stream,'/');
|
DebugPutc (c_output_stream,'/');
|
||||||
plwrite (MkIntTerm (ArityOfFunctor (f)), DebugPutc, 0);
|
plwrite (MkIntTerm (arity), DebugPutc, 0);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case 'P':
|
case 'P':
|
||||||
{
|
{
|
||||||
PredEntry *p = RepPredProp((Prop) rn);
|
PredEntry *p = RepPredProp((Prop) rn);
|
||||||
Functor f = p->FunctorOfPred;
|
Functor f = p->FunctorOfPred;
|
||||||
plwrite (ModuleName[p->ModuleOfPred], DebugPutc, 0);
|
UInt arity = p->ArityOfPE;
|
||||||
|
SMALLUNSGN mod = 0;
|
||||||
|
|
||||||
|
if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred);
|
||||||
|
plwrite (ModuleName[mod], DebugPutc, 0);
|
||||||
DebugPutc (c_output_stream,':');
|
DebugPutc (c_output_stream,':');
|
||||||
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
|
if (arity == 0)
|
||||||
|
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
|
||||||
|
else
|
||||||
|
plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
|
||||||
DebugPutc (c_output_stream,'/');
|
DebugPutc (c_output_stream,'/');
|
||||||
plwrite (MkIntTerm (ArityOfFunctor (f)), DebugPutc, 0);
|
plwrite (MkIntTerm (arity), DebugPutc, 0);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case 'f':
|
case 'f':
|
||||||
|
@ -1159,7 +1159,7 @@ void InitCoroutPreds(void)
|
|||||||
#endif /* FIXED_STACKS */
|
#endif /* FIXED_STACKS */
|
||||||
at = LookupAtom("$wake_up_goal");
|
at = LookupAtom("$wake_up_goal");
|
||||||
pred = RepPredProp(PredProp(at, 2));
|
pred = RepPredProp(PredProp(at, 2));
|
||||||
WakeUpCode = (CELL *) & (pred->CodeOfPred);
|
WakeUpCode = (CELL *) pred;
|
||||||
InitAttVarPreds();
|
InitAttVarPreds();
|
||||||
#endif /* COROUTINING */
|
#endif /* COROUTINING */
|
||||||
InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag);
|
InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag);
|
||||||
|
22
C/dbase.c
22
C/dbase.c
@ -392,12 +392,12 @@ int DBTrailOverflow(void)
|
|||||||
|
|
||||||
/* get DB entry for ap/arity; */
|
/* get DB entry for ap/arity; */
|
||||||
static Prop
|
static Prop
|
||||||
LockedFindDBProp(AtomEntry *ae, int CodeDB, unsigned int arity)
|
FindDBPropHavingLock(AtomEntry *ae, int CodeDB, unsigned int arity)
|
||||||
{
|
{
|
||||||
Prop p0;
|
Prop p0;
|
||||||
DBProp p;
|
DBProp p;
|
||||||
|
|
||||||
p = RepDBProp(p0 = ae->PropOfAE);
|
p = RepDBProp(p0 = ae->PropsOfAE);
|
||||||
while (p0 && (((p->KindOfPE & ~0x1) != (CodeDB|DBProperty)) ||
|
while (p0 && (((p->KindOfPE & ~0x1) != (CodeDB|DBProperty)) ||
|
||||||
(p->ArityOfDB != arity) ||
|
(p->ArityOfDB != arity) ||
|
||||||
((CodeDB & MkCode) && p->ModuleOfDB && p->ModuleOfDB != DBModule ))) {
|
((CodeDB & MkCode) && p->ModuleOfDB && p->ModuleOfDB != DBModule ))) {
|
||||||
@ -414,7 +414,7 @@ FindDBProp(AtomEntry *ae, int CodeDB, unsigned int arity)
|
|||||||
Prop out;
|
Prop out;
|
||||||
|
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
out = LockedFindDBProp(ae, CodeDB, arity);
|
out = FindDBPropHavingLock(ae, CodeDB, arity);
|
||||||
READ_UNLOCK(ae->ARWLock);
|
READ_UNLOCK(ae->ARWLock);
|
||||||
return(out);
|
return(out);
|
||||||
}
|
}
|
||||||
@ -2106,11 +2106,11 @@ FetchDBPropFromKey(Term twork, int flag, int new, char *error_mssg)
|
|||||||
AtomEntry *ae = RepAtom(At);
|
AtomEntry *ae = RepAtom(At);
|
||||||
|
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
if (EndOfPAEntr(p = RepDBProp(LockedFindDBProp(ae, flag, arity)))) {
|
if (EndOfPAEntr(p = RepDBProp(FindDBPropHavingLock(ae, flag, arity)))) {
|
||||||
/* create a new DBProp */
|
/* create a new DBProp */
|
||||||
int OLD_UPDATE_MODE = UPDATE_MODE;
|
int OLD_UPDATE_MODE = UPDATE_MODE;
|
||||||
if (flag & MkCode) {
|
if (flag & MkCode) {
|
||||||
PredEntry *pp = RepPredProp(LockedGetPredProp(At, arity));
|
PredEntry *pp = RepPredProp(GetPredPropHavingLock(At, arity));
|
||||||
if (!EndOfPAEntr(pp)) {
|
if (!EndOfPAEntr(pp)) {
|
||||||
READ_LOCK(pp->PRWLock);
|
READ_LOCK(pp->PRWLock);
|
||||||
if(pp->PredFlags & LogUpdatePredFlag)
|
if(pp->PredFlags & LogUpdatePredFlag)
|
||||||
@ -2146,8 +2146,8 @@ FetchDBPropFromKey(Term twork, int flag, int new, char *error_mssg)
|
|||||||
p->FunctorOfDB = (Functor) At;
|
p->FunctorOfDB = (Functor) At;
|
||||||
else
|
else
|
||||||
p->FunctorOfDB = UnlockedMkFunctor(ae,arity);
|
p->FunctorOfDB = UnlockedMkFunctor(ae,arity);
|
||||||
p->NextOfPE = ae->PropOfAE;
|
p->NextOfPE = ae->PropsOfAE;
|
||||||
ae->PropOfAE = AbsDBProp(p);
|
ae->PropsOfAE = AbsDBProp(p);
|
||||||
}
|
}
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
return(p);
|
return(p);
|
||||||
@ -3123,7 +3123,7 @@ MyEraseClause(Clause *clau)
|
|||||||
Atom name = (Atom) father->FunctorOfDB;
|
Atom name = (Atom) father->FunctorOfDB;
|
||||||
pred = RepPredProp(PredProp(name, 0));
|
pred = RepPredProp(PredProp(name, 0));
|
||||||
} else {
|
} else {
|
||||||
pred = RepPredProp(PredPropByFunc(father->FunctorOfDB));
|
pred = RepPredProp(PredPropByFunc(father->FunctorOfDB, *CurrentModulePtr));
|
||||||
}
|
}
|
||||||
DBModule = father->ModuleOfDB;
|
DBModule = father->ModuleOfDB;
|
||||||
WRITE_LOCK(pred->PRWLock);
|
WRITE_LOCK(pred->PRWLock);
|
||||||
@ -3317,7 +3317,7 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
|
|||||||
Atom name = (Atom) father->FunctorOfDB;
|
Atom name = (Atom) father->FunctorOfDB;
|
||||||
pred = RepPredProp(PredProp(name, 0));
|
pred = RepPredProp(PredProp(name, 0));
|
||||||
} else {
|
} else {
|
||||||
pred = RepPredProp(PredPropByFunc(father->FunctorOfDB));
|
pred = RepPredProp(PredPropByFunc(father->FunctorOfDB, *CurrentModulePtr));
|
||||||
}
|
}
|
||||||
DBModule = father->ModuleOfDB;
|
DBModule = father->ModuleOfDB;
|
||||||
WRITE_LOCK(pred->PRWLock);
|
WRITE_LOCK(pred->PRWLock);
|
||||||
@ -3598,7 +3598,7 @@ init_current_key(void)
|
|||||||
READ_UNLOCK(HashChain[i].AERWLock);
|
READ_UNLOCK(HashChain[i].AERWLock);
|
||||||
}
|
}
|
||||||
READ_LOCK(RepAtom(a)->ARWLock);
|
READ_LOCK(RepAtom(a)->ARWLock);
|
||||||
pp = NextDBProp(RepProp(RepAtom(a)->PropOfAE));
|
pp = NextDBProp(RepProp(RepAtom(a)->PropsOfAE));
|
||||||
READ_UNLOCK(RepAtom(a)->ARWLock);
|
READ_UNLOCK(RepAtom(a)->ARWLock);
|
||||||
EXTRA_CBACK_ARG(2,3) = MkAtomTerm(a);
|
EXTRA_CBACK_ARG(2,3) = MkAtomTerm(a);
|
||||||
EXTRA_CBACK_ARG(2,2) = MkIntTerm(i);
|
EXTRA_CBACK_ARG(2,2) = MkIntTerm(i);
|
||||||
@ -3674,7 +3674,7 @@ cont_current_key(void)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
READ_LOCK(RepAtom(a)->ARWLock);
|
READ_LOCK(RepAtom(a)->ARWLock);
|
||||||
if (!EndOfPAEntr(pp = NextDBProp(RepProp(RepAtom(a)->PropOfAE))))
|
if (!EndOfPAEntr(pp = NextDBProp(RepProp(RepAtom(a)->PropsOfAE))))
|
||||||
EXTRA_CBACK_ARG(2,3) = (CELL) MkAtomTerm(a);
|
EXTRA_CBACK_ARG(2,3) = (CELL) MkAtomTerm(a);
|
||||||
READ_UNLOCK(RepAtom(a)->ARWLock);
|
READ_UNLOCK(RepAtom(a)->ARWLock);
|
||||||
}
|
}
|
||||||
|
@ -107,13 +107,15 @@ DumpActiveGoals (void)
|
|||||||
if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag | FastPredFlag))
|
if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag | FastPredFlag))
|
||||||
{
|
{
|
||||||
Functor f;
|
Functor f;
|
||||||
|
SMALLUNSGN mod = 0;
|
||||||
|
|
||||||
f = pe->FunctorOfPred;
|
f = pe->FunctorOfPred;
|
||||||
if (pe->KindOfPE && hidden (NameOfFunctor (f)))
|
if (pe->KindOfPE && hidden (NameOfFunctor (f)))
|
||||||
goto next;
|
goto next;
|
||||||
if (first++ == 1)
|
if (first++ == 1)
|
||||||
YP_fprintf(YP_stderr,"Active ancestors:\n");
|
YP_fprintf(YP_stderr,"Active ancestors:\n");
|
||||||
plwrite (ModuleName[pe->ModuleOfPred], DebugPutc, 0);
|
if (pe->ModuleOfPred) mod = IntOfTerm(pe->ModuleOfPred);
|
||||||
|
plwrite (ModuleName[mod], DebugPutc, 0);
|
||||||
DebugPutc (c_output_stream,':');
|
DebugPutc (c_output_stream,':');
|
||||||
if (pe->ArityOfPE == 0) {
|
if (pe->ArityOfPE == 0) {
|
||||||
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
|
plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
|
||||||
@ -161,9 +163,11 @@ DumpActiveGoals (void)
|
|||||||
READ_LOCK(pe->PRWLock);
|
READ_LOCK(pe->PRWLock);
|
||||||
{
|
{
|
||||||
Functor f;
|
Functor f;
|
||||||
|
SMALLUNSGN mod = 0;
|
||||||
|
|
||||||
f = pe->FunctorOfPred;
|
f = pe->FunctorOfPred;
|
||||||
plwrite (ModuleName[pe->ModuleOfPred], DebugPutc, 0);
|
if (pe->ModuleOfPred) mod = IntOfTerm(pe->ModuleOfPred);
|
||||||
|
plwrite (ModuleName[mod], DebugPutc, 0);
|
||||||
DebugPutc (c_output_stream,':');
|
DebugPutc (c_output_stream,':');
|
||||||
if (pe->ArityOfPE == 0) {
|
if (pe->ArityOfPE == 0) {
|
||||||
plwrite (MkAtomTerm (NameOfFunctor(f)), DebugPutc, 0);
|
plwrite (MkAtomTerm (NameOfFunctor(f)), DebugPutc, 0);
|
||||||
|
588
C/exec.c
588
C/exec.c
@ -21,15 +21,22 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
|
|||||||
#include "absmi.h"
|
#include "absmi.h"
|
||||||
#include "yapio.h"
|
#include "yapio.h"
|
||||||
|
|
||||||
|
STATIC_PROTO(Int CallPredicate, (PredEntry *, choiceptr));
|
||||||
STATIC_PROTO(Int CallProlog, (PredEntry *, unsigned int, Int));
|
STATIC_PROTO(Int CallClause, (PredEntry *, unsigned int, Int));
|
||||||
STATIC_PROTO(Int p_save_cp, (void));
|
STATIC_PROTO(Int p_save_cp, (void));
|
||||||
STATIC_PROTO(Int p_execute, (void));
|
STATIC_PROTO(Int p_execute, (void));
|
||||||
STATIC_PROTO(Int p_execute0, (void));
|
STATIC_PROTO(Int p_execute0, (void));
|
||||||
STATIC_PROTO(Int p_at_execute, (void));
|
STATIC_PROTO(Int p_at_execute, (void));
|
||||||
|
|
||||||
static Int
|
static Term
|
||||||
FastCallProlog(PredEntry *pen) {
|
current_cp_as_integer(void)
|
||||||
|
{
|
||||||
|
return(MkIntTerm(LCL0-(CELL *)B));
|
||||||
|
}
|
||||||
|
|
||||||
|
static inline Int
|
||||||
|
CallPredicate(PredEntry *pen, choiceptr cut_pt) {
|
||||||
|
WRITE_LOCK(pen->PRWLock);
|
||||||
#ifdef DEPTH_LIMIT
|
#ifdef DEPTH_LIMIT
|
||||||
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
||||||
if (pen->ModuleOfPred) {
|
if (pen->ModuleOfPred) {
|
||||||
@ -44,127 +51,123 @@ FastCallProlog(PredEntry *pen) {
|
|||||||
if (do_low_level_trace)
|
if (do_low_level_trace)
|
||||||
low_level_trace(enter_pred,pen,XREGS+1);
|
low_level_trace(enter_pred,pen,XREGS+1);
|
||||||
#endif /* LOW_LEVEL_TRACE */
|
#endif /* LOW_LEVEL_TRACE */
|
||||||
if (pen->PredFlags & ProfiledPredFlag)
|
|
||||||
pen->StatisticsForPred.NOfEntries++;
|
|
||||||
CP = P;
|
CP = P;
|
||||||
P = (yamop *)(pen->CodeOfPred);
|
P = (yamop *)(pen->CodeOfPred);
|
||||||
WRITE_UNLOCK(pen->PRWLock);
|
WRITE_UNLOCK(pen->PRWLock);
|
||||||
ENV = YENV;
|
ENV = YENV;
|
||||||
YENV = ASP;
|
YENV = ASP;
|
||||||
YENV[E_CB] = (CELL) B;
|
YENV[E_CB] = (CELL) cut_pt;
|
||||||
return (Unsigned(&(pen->StateOfPred)));
|
return (TRUE);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline static Int
|
||||||
|
CallMetaCall(void) {
|
||||||
|
ARG2 = current_cp_as_integer(); /* p_save_cp */
|
||||||
|
ARG3 = ARG1;
|
||||||
|
WRITE_LOCK(PredMetaCall->PRWLock);
|
||||||
|
return (CallPredicate(PredMetaCall, B));
|
||||||
|
}
|
||||||
|
|
||||||
|
Term
|
||||||
|
ExecuteCallMetaCall(void) {
|
||||||
|
Term ts[3];
|
||||||
|
ts[0] = ARG1;
|
||||||
|
ts[1] = current_cp_as_integer(); /* p_save_cp */
|
||||||
|
ts[2] = ARG1;
|
||||||
|
return(MkApplTerm(PredMetaCall->FunctorOfPred,3,ts));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
CallProlog(PredEntry *pen, unsigned int arity, Int position)
|
CallError(yap_error_number err)
|
||||||
|
{
|
||||||
|
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
|
||||||
|
return(CallMetaCall());
|
||||||
|
} else {
|
||||||
|
Error(err, ARG1, "call/1");
|
||||||
|
return(FALSE);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int
|
||||||
|
CallClause(PredEntry *pen, unsigned int arity, Int position)
|
||||||
{
|
{
|
||||||
CELL flags;
|
CELL flags;
|
||||||
|
|
||||||
|
if (position == -1) return(CallPredicate(pen, B));
|
||||||
WRITE_LOCK(pen->PRWLock);
|
WRITE_LOCK(pen->PRWLock);
|
||||||
flags = pen->PredFlags;
|
flags = pen->PredFlags;
|
||||||
if ((flags & (CompiledPredFlag | DynamicPredFlag)) ||
|
if ((flags & (CompiledPredFlag | DynamicPredFlag)) ||
|
||||||
pen->OpcodeOfPred == UNDEF_OPCODE) {
|
pen->OpcodeOfPred == UNDEF_OPCODE) {
|
||||||
if (position == -1 ||
|
CODEADDR q;
|
||||||
pen->OpcodeOfPred == UNDEF_OPCODE) {
|
|
||||||
return(FastCallProlog(pen));
|
|
||||||
} else {
|
|
||||||
CODEADDR q;
|
|
||||||
#ifdef DEPTH_LIMIT
|
#ifdef DEPTH_LIMIT
|
||||||
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
||||||
if (pen->ModuleOfPred) {
|
if (pen->ModuleOfPred) {
|
||||||
if (DEPTH == MkIntTerm(0))
|
if (DEPTH == MkIntTerm(0))
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
else DEPTH = RESET_DEPTH();
|
else DEPTH = RESET_DEPTH();
|
||||||
}
|
}
|
||||||
} else if (pen->ModuleOfPred)
|
} else if (pen->ModuleOfPred)
|
||||||
DEPTH -= MkIntConstant(2);
|
DEPTH -= MkIntConstant(2);
|
||||||
#endif /* DEPTH_LIMIT */
|
#endif /* DEPTH_LIMIT */
|
||||||
#ifdef LOW_LEVEL_TRACER
|
#ifdef LOW_LEVEL_TRACER
|
||||||
if (do_low_level_trace)
|
if (do_low_level_trace)
|
||||||
low_level_trace(enter_pred,pen,XREGS+1);
|
low_level_trace(enter_pred,pen,XREGS+1);
|
||||||
#endif /* LOW_LEVEL_TRACE */
|
#endif /* LOW_LEVEL_TRACE */
|
||||||
ENV = YENV;
|
ENV = YENV;
|
||||||
YENV = ASP;
|
YENV = ASP;
|
||||||
YENV[E_CB] = (CELL)(B->cp_b);
|
YENV[E_CB] = (CELL)(B->cp_b);
|
||||||
CP = P;
|
CP = P;
|
||||||
q = pen->FirstClause;
|
q = pen->FirstClause;
|
||||||
if (pen->PredFlags & ProfiledPredFlag) {
|
if (pen->PredFlags & ProfiledPredFlag) {
|
||||||
LOCK(pen->StatisticsForPred.lock);
|
LOCK(pen->StatisticsForPred.lock);
|
||||||
if (position == 1)
|
if (position == 1)
|
||||||
pen->StatisticsForPred.NOfEntries++;
|
pen->StatisticsForPred.NOfEntries++;
|
||||||
else
|
else
|
||||||
pen->StatisticsForPred.NOfRetries++;
|
pen->StatisticsForPred.NOfRetries++;
|
||||||
UNLOCK(pen->StatisticsForPred.lock);
|
UNLOCK(pen->StatisticsForPred.lock);
|
||||||
}
|
}
|
||||||
if (flags & DynamicPredFlag) {
|
if (flags & DynamicPredFlag) {
|
||||||
CLAUSECODE->arity = pen->ArityOfPE;
|
CLAUSECODE->arity = pen->ArityOfPE;
|
||||||
CLAUSECODE->func = pen->FunctorOfPred;
|
CLAUSECODE->func = pen->FunctorOfPred;
|
||||||
while (position > 1) {
|
while (position > 1) {
|
||||||
while (ClauseCodeToClause(q)->ClFlags & ErasedMask)
|
|
||||||
q = NextClause(q);
|
|
||||||
position--;
|
|
||||||
q = NextClause(q);
|
|
||||||
}
|
|
||||||
while (ClauseCodeToClause(q)->ClFlags & ErasedMask)
|
while (ClauseCodeToClause(q)->ClFlags & ErasedMask)
|
||||||
q = NextClause(q);
|
q = NextClause(q);
|
||||||
#if defined(YAPOR) || defined(THREADS)
|
position--;
|
||||||
{
|
q = NextClause(q);
|
||||||
Clause *cl = ClauseCodeToClause(q);
|
|
||||||
|
|
||||||
LOCK(cl->ClLock);
|
|
||||||
TRAIL_CLREF(cl);
|
|
||||||
INC_DBREF_COUNT(cl);
|
|
||||||
UNLOCK(cl->ClLock);
|
|
||||||
}
|
|
||||||
#else
|
|
||||||
if (!(ClauseCodeToClause(q)->ClFlags & InUseMask)) {
|
|
||||||
OPREG *opp = &(ClauseCodeToClause(q)->ClFlags);
|
|
||||||
TRAIL_CLREF(ClauseCodeToClause(q));
|
|
||||||
*opp |= InUseMask;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
CLAUSECODE->clause = (CODEADDR)NEXTOP((yamop *)(q),ld);
|
|
||||||
P = (yamop *)CLAUSECODE->clause;
|
|
||||||
WRITE_UNLOCK(pen->PRWLock);
|
|
||||||
return((CELL)(&(CLAUSECODE->clause)));
|
|
||||||
} else {
|
|
||||||
for (; position > 1; position--)
|
|
||||||
q = NextClause(q);
|
|
||||||
P = NEXTOP((yamop *)(q),ld);
|
|
||||||
WRITE_UNLOCK(pen->PRWLock);
|
|
||||||
return (Unsigned(&(pen->StateOfPred)));
|
|
||||||
}
|
}
|
||||||
}
|
while (ClauseCodeToClause(q)->ClFlags & ErasedMask)
|
||||||
}
|
q = NextClause(q);
|
||||||
if (flags & UserCPredFlag) {
|
#if defined(YAPOR) || defined(THREADS)
|
||||||
Int(*p) (void) = (Int(*) (void)) pen->CodeOfPred;
|
{
|
||||||
Int out;
|
Clause *cl = ClauseCodeToClause(q);
|
||||||
|
|
||||||
WRITE_UNLOCK(pen->PRWLock);
|
LOCK(cl->ClLock);
|
||||||
save_machine_regs();
|
TRAIL_CLREF(cl);
|
||||||
out = YapExecute(p);
|
INC_DBREF_COUNT(cl);
|
||||||
restore_machine_regs();
|
UNLOCK(cl->ClLock);
|
||||||
return(out);
|
}
|
||||||
}
|
#else
|
||||||
if (flags & CPredFlag) {
|
if (!(ClauseCodeToClause(q)->ClFlags & InUseMask)) {
|
||||||
Int(*p) (void) = (Int(*) (void)) pen->CodeOfPred;
|
OPREG *opp = &(ClauseCodeToClause(q)->ClFlags);
|
||||||
WRITE_UNLOCK(pen->PRWLock);
|
TRAIL_CLREF(ClauseCodeToClause(q));
|
||||||
return ((*p) ());
|
*opp |= InUseMask;
|
||||||
} else if (flags & BasicPredFlag) {
|
}
|
||||||
if (pen->OpcodeOfPred != UNDEF_OPCODE) {
|
#endif
|
||||||
Int(*p) (void) = (Int(*) (void)) pen->CodeOfPred;
|
CLAUSECODE->clause = (CODEADDR)NEXTOP((yamop *)(q),ld);
|
||||||
|
P = (yamop *)CLAUSECODE->clause;
|
||||||
WRITE_UNLOCK(pen->PRWLock);
|
WRITE_UNLOCK(pen->PRWLock);
|
||||||
return (((*p) ()) != FALSE);
|
return((CELL)(&(CLAUSECODE->clause)));
|
||||||
|
} else {
|
||||||
|
for (; position > 1; position--)
|
||||||
|
q = NextClause(q);
|
||||||
|
P = NEXTOP((yamop *)(q),ld);
|
||||||
|
WRITE_UNLOCK(pen->PRWLock);
|
||||||
|
return (Unsigned(pen));
|
||||||
}
|
}
|
||||||
|
} else {
|
||||||
|
Error(SYSTEM_ERROR,ARG1,"debugger tries to debug clause for builtin");
|
||||||
|
return (FALSE);
|
||||||
}
|
}
|
||||||
return (FALSE);
|
|
||||||
}
|
|
||||||
|
|
||||||
static Term
|
|
||||||
current_cp_as_integer(void)
|
|
||||||
{
|
|
||||||
return(MkIntTerm(LCL0-(CELL *)B));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -186,154 +189,110 @@ p_save_cp(void)
|
|||||||
return(TRUE);
|
return(TRUE);
|
||||||
}
|
}
|
||||||
|
|
||||||
inline static int
|
|
||||||
SpecialCallFunctor(Functor f) {
|
|
||||||
return(f == FunctorComma || f == FunctorOr || f == FunctorArrow ||
|
|
||||||
f == FunctorVBar || f == FunctorNot || f == FunctorAltNot);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline static Int
|
|
||||||
CallMetaCall(void) {
|
|
||||||
ARG2 = current_cp_as_integer(); /* p_save_cp */
|
|
||||||
ARG3 = ARG1;
|
|
||||||
WRITE_LOCK(PredMetaCall->PRWLock);
|
|
||||||
return (FastCallProlog(PredMetaCall));
|
|
||||||
}
|
|
||||||
|
|
||||||
inline static Int
|
inline static Int
|
||||||
EnterCreepMode(PredEntry *pen) {
|
EnterCreepMode(PredEntry *pen) {
|
||||||
PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy));
|
PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy,*CurrentModulePtr));
|
||||||
ARG1 = MkPairTerm(Module_Name((CODEADDR)(pen)),ARG1);
|
ARG1 = MkPairTerm(Module_Name((CODEADDR)(pen)),ARG1);
|
||||||
CreepFlag = CalculateStackGap();
|
CreepFlag = CalculateStackGap();
|
||||||
P_before_spy = P;
|
P_before_spy = P;
|
||||||
WRITE_LOCK(PredSpy->PRWLock);
|
WRITE_LOCK(PredSpy->PRWLock);
|
||||||
return (FastCallProlog(PredSpy));
|
return (CallPredicate(PredSpy, B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
inline static Int
|
||||||
p_execute(void)
|
do_execute(Term t)
|
||||||
{ /* '$execute'(Goal) */
|
{
|
||||||
Term t = Deref(ARG1);
|
|
||||||
Prop pe;
|
|
||||||
Atom a;
|
|
||||||
|
|
||||||
restart_exec:
|
|
||||||
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
|
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
|
||||||
return(CallMetaCall());
|
return(CallMetaCall());
|
||||||
} else if (IsVarTerm(t)) {
|
}
|
||||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
|
if (IsVarTerm(t)) {
|
||||||
return(CallMetaCall());
|
return CallError(INSTANTIATION_ERROR);
|
||||||
} else {
|
|
||||||
Error(INSTANTIATION_ERROR,t,"call/1");
|
|
||||||
return(FALSE);
|
|
||||||
}
|
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
register Functor f = FunctorOfTerm(t);
|
register Functor f = FunctorOfTerm(t);
|
||||||
register unsigned int i;
|
|
||||||
register CELL *pt;
|
register CELL *pt;
|
||||||
unsigned int arity;
|
PredEntry *pen;
|
||||||
|
unsigned int i, arity;
|
||||||
|
|
||||||
if (IsExtensionFunctor(f)) {
|
if (IsExtensionFunctor(f)) {
|
||||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
|
return CallError(TYPE_ERROR_CALLABLE);
|
||||||
return(CallMetaCall());
|
|
||||||
} else {
|
|
||||||
Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
|
||||||
return(FALSE);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
arity = ArityOfFunctor(f);
|
||||||
|
|
||||||
if (SpecialCallFunctor(f)) {
|
pen = RepPredProp(PredPropByFunc(f, *CurrentModulePtr));
|
||||||
|
/* You thought we would be over by now */
|
||||||
|
/* but no meta calls require special preprocessing */
|
||||||
|
if (pen->PredFlags & MetaPredFlag) {
|
||||||
return(CallMetaCall());
|
return(CallMetaCall());
|
||||||
} else if (f == FunctorModule) {
|
}
|
||||||
Term mod = ArgOfTerm(1, t);
|
if (yap_flags[SPY_CREEP_FLAG]) {
|
||||||
if (mod == ModuleName[CurrentModule]) {
|
return(EnterCreepMode(pen));
|
||||||
/* we can skip this operation */
|
}
|
||||||
/* should catch most cases */
|
/* now let us do what we wanted to do from the beginning !! */
|
||||||
t = ArgOfTerm(2, t);
|
/* I cannot use the standard macro here because
|
||||||
goto restart_exec;
|
otherwise I would dereference the argument and
|
||||||
} else {
|
might skip a svar */
|
||||||
/* I can't do better because I don't have a way of restoring the module */
|
pt = RepAppl(t)+1;
|
||||||
return(CallMetaCall());
|
for (i = 1; i <= arity; i++) {
|
||||||
}
|
|
||||||
} else {
|
|
||||||
PredEntry *pen;
|
|
||||||
arity = ArityOfFunctor(f);
|
|
||||||
a = NameOfFunctor(f);
|
|
||||||
|
|
||||||
if (CurrentModule)
|
|
||||||
pe = PredPropByFunc(f);
|
|
||||||
else {
|
|
||||||
pe = GetPredPropByFunc(f);
|
|
||||||
if (pe == NIL) {
|
|
||||||
return(CallMetaCall());
|
|
||||||
}
|
|
||||||
}
|
|
||||||
pen = RepPredProp(pe);
|
|
||||||
/* You thought we would be over by now */
|
|
||||||
/* but no meta calls require special preprocessing */
|
|
||||||
if (pen->PredFlags & MetaPredFlag) {
|
|
||||||
return(CallMetaCall());
|
|
||||||
}
|
|
||||||
if (yap_flags[SPY_CREEP_FLAG]) {
|
|
||||||
return(EnterCreepMode(pen));
|
|
||||||
}
|
|
||||||
/* 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
|
#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
|
||||||
XREGS[i] = *pt++;
|
XREGS[i] = *pt++;
|
||||||
#endif
|
#endif
|
||||||
}
|
|
||||||
return (CallProlog(pen, arity, (Int) (-1)));
|
|
||||||
}
|
}
|
||||||
} else if (IsAtomOrIntTerm(t)) {
|
return (CallPredicate(pen, B));
|
||||||
if (IsIntTerm(t)) {
|
} else if (IsAtomTerm(t)) {
|
||||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
|
PredEntry *pe;
|
||||||
return (CallMetaCall());
|
Atom a = AtomOfTerm(t);
|
||||||
} else {
|
|
||||||
Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
|
||||||
return(FALSE);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
a = AtomOfTerm(t);
|
|
||||||
if (a == AtomTrue || a == AtomOtherwise || a == AtomCut)
|
if (a == AtomTrue || a == AtomOtherwise || a == AtomCut)
|
||||||
return(TRUE);
|
return(TRUE);
|
||||||
else if (a == AtomFail || a == AtomFalse)
|
else if (a == AtomFail || a == AtomFalse)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
/* call may not define new system predicates!! */
|
/* call may not define new system predicates!! */
|
||||||
if (CurrentModule)
|
pe = RepPredProp(PredPropByAtom(a, *CurrentModulePtr));
|
||||||
pe = PredProp(a, 0);
|
|
||||||
else {
|
|
||||||
pe = GetPredProp(a, 0);
|
|
||||||
if (pe == NIL) {
|
|
||||||
ARG1 = t;
|
|
||||||
return(CallMetaCall());
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (yap_flags[SPY_CREEP_FLAG]) {
|
if (yap_flags[SPY_CREEP_FLAG]) {
|
||||||
return(EnterCreepMode(RepPredProp(pe)));
|
return(EnterCreepMode(pe));
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 0, (Int) (-1)));
|
return (CallPredicate(pe, B));
|
||||||
|
} else if (IsIntTerm(t)) {
|
||||||
|
return CallError(TYPE_ERROR_CALLABLE);
|
||||||
} else {
|
} else {
|
||||||
/* Is Pair Term */
|
/* Is Pair Term */
|
||||||
return(CallMetaCall());
|
return(CallMetaCall());
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_execute(void)
|
||||||
|
{ /* '$execute'(Goal) */
|
||||||
|
Term t = Deref(ARG1);
|
||||||
|
return(do_execute(t));
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_execute_in_mod(void)
|
||||||
|
{ /* '$execute'(Goal) */
|
||||||
|
if (ARG2 != ModuleName[CurrentModule]) {
|
||||||
|
/* switch modules, but do it in Prolog */
|
||||||
|
Term ts[2];
|
||||||
|
|
||||||
|
ts[0] = ARG2;
|
||||||
|
ts[1] = ARG1;
|
||||||
|
ARG1 = MkApplTerm(FunctorModule, 2, ts);
|
||||||
|
}
|
||||||
|
return(do_execute(Deref(ARG1)));
|
||||||
|
}
|
||||||
|
|
||||||
inline static Int
|
inline static Int
|
||||||
CallMetaCallWithin(void)
|
CallMetaCallWithin(void)
|
||||||
{
|
{
|
||||||
WRITE_LOCK(PredMetaCall->PRWLock);
|
WRITE_LOCK(PredMetaCall->PRWLock);
|
||||||
return (FastCallProlog(PredMetaCall));
|
return (CallPredicate(PredMetaCall, B));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* '$execute_within'(Goal,CutPt,OrigGoal) */
|
/* '$execute_within'(Goal,CutPt,OrigGoal) */
|
||||||
@ -349,29 +308,17 @@ p_execute_within(void)
|
|||||||
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
|
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
|
||||||
return(CallMetaCallWithin());
|
return(CallMetaCallWithin());
|
||||||
} else if (IsVarTerm(t)) {
|
} else if (IsVarTerm(t)) {
|
||||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
|
return CallError(INSTANTIATION_ERROR);
|
||||||
return(CallMetaCallWithin());
|
|
||||||
} else {
|
|
||||||
Error(INSTANTIATION_ERROR,t,"call/1");
|
|
||||||
return(FALSE);
|
|
||||||
}
|
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
register Functor f = FunctorOfTerm(t);
|
register Functor f = FunctorOfTerm(t);
|
||||||
register unsigned int i;
|
register unsigned int i;
|
||||||
register CELL *pt;
|
register CELL *pt;
|
||||||
|
|
||||||
if (IsExtensionFunctor(f)) {
|
if (IsExtensionFunctor(f)) {
|
||||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
|
return CallError(TYPE_ERROR_CALLABLE);
|
||||||
return(CallMetaCallWithin());
|
|
||||||
} else {
|
|
||||||
Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
|
||||||
return(FALSE);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if (SpecialCallFunctor(f)) {
|
if (f == FunctorModule) {
|
||||||
return(CallMetaCallWithin());
|
|
||||||
} else if (f == FunctorModule) {
|
|
||||||
Term mod = ArgOfTerm(1, t);
|
Term mod = ArgOfTerm(1, t);
|
||||||
if (mod == ModuleName[CurrentModule]) {
|
if (mod == ModuleName[CurrentModule]) {
|
||||||
/* we can skip this operation */
|
/* we can skip this operation */
|
||||||
@ -388,9 +335,9 @@ p_execute_within(void)
|
|||||||
a = NameOfFunctor(f);
|
a = NameOfFunctor(f);
|
||||||
|
|
||||||
if (CurrentModule)
|
if (CurrentModule)
|
||||||
pe = PredPropByFunc(f);
|
pe = PredPropByFunc(f, *CurrentModulePtr);
|
||||||
else {
|
else {
|
||||||
pe = GetPredPropByFunc(f);
|
pe = GetPredPropByFunc(f, *CurrentModulePtr);
|
||||||
if (pe == NIL) {
|
if (pe == NIL) {
|
||||||
return(CallMetaCallWithin());
|
return(CallMetaCallWithin());
|
||||||
}
|
}
|
||||||
@ -421,16 +368,11 @@ p_execute_within(void)
|
|||||||
XREGS[i] = *pt++;
|
XREGS[i] = *pt++;
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
return (CallProlog(pen, arity, (Int) (-1)));
|
return (CallPredicate(pen, B));
|
||||||
}
|
}
|
||||||
} else if (IsAtomOrIntTerm(t)) {
|
} else if (IsAtomOrIntTerm(t)) {
|
||||||
if (IsIntTerm(t)) {
|
if (IsIntTerm(t)) {
|
||||||
if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
|
return CallError(TYPE_ERROR_CALLABLE);
|
||||||
return (CallMetaCallWithin());
|
|
||||||
} else {
|
|
||||||
Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
|
||||||
return(FALSE);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
a = AtomOfTerm(t);
|
a = AtomOfTerm(t);
|
||||||
if (a == AtomTrue || a == AtomOtherwise)
|
if (a == AtomTrue || a == AtomOtherwise)
|
||||||
@ -447,34 +389,125 @@ p_execute_within(void)
|
|||||||
DelayedB = pt0;
|
DelayedB = pt0;
|
||||||
}
|
}
|
||||||
/* find where to cut to */
|
/* find where to cut to */
|
||||||
#ifdef YAPOR
|
|
||||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||||
|
#ifdef YAPOR
|
||||||
/* Wow, we're gonna cut!!! */
|
/* Wow, we're gonna cut!!! */
|
||||||
CUT_prune_to(pt0);
|
CUT_prune_to(pt0);
|
||||||
#else
|
#else
|
||||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
|
||||||
/* Wow, we're gonna cut!!! */
|
/* Wow, we're gonna cut!!! */
|
||||||
B = pt0;
|
B = pt0;
|
||||||
#endif /* YAPOR */
|
#endif /* YAPOR */
|
||||||
HB = PROTECT_FROZEN_H(B);
|
HB = PROTECT_FROZEN_H(B);
|
||||||
}
|
}
|
||||||
return(TRUE);
|
return(TRUE);
|
||||||
} else if (a == AtomFail || a == AtomFalse)
|
} else if (a == AtomFail || a == AtomFalse) {
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
/* call may not define new system predicates!! */
|
} else {
|
||||||
if (CurrentModule)
|
/* call may not define new system predicates!! */
|
||||||
pe = PredProp(a, 0);
|
pe = PredPropByAtom(a, *CurrentModulePtr);
|
||||||
else {
|
if (yap_flags[SPY_CREEP_FLAG]) {
|
||||||
pe = GetPredProp(a, 0);
|
return(EnterCreepMode(RepPredProp(pe)));
|
||||||
if (pe == NIL) {
|
}
|
||||||
ARG1 = t;
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
/* Is Pair Term */
|
||||||
|
return(CallMetaCallWithin());
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* '$execute_within2'(Goal) */
|
||||||
|
static Int
|
||||||
|
p_execute_within2(void)
|
||||||
|
{
|
||||||
|
Term t = Deref(ARG1);
|
||||||
|
Prop pe;
|
||||||
|
|
||||||
|
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
|
||||||
|
return(CallMetaCallWithin());
|
||||||
|
} else if (IsVarTerm(t)) {
|
||||||
|
return CallError(INSTANTIATION_ERROR);
|
||||||
|
} else if (IsApplTerm(t)) {
|
||||||
|
register Functor f = FunctorOfTerm(t);
|
||||||
|
|
||||||
|
if (IsExtensionFunctor(f)) {
|
||||||
|
return CallError(TYPE_ERROR_CALLABLE);
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
PredEntry *pen;
|
||||||
|
CELL *dest;
|
||||||
|
register CELL *pt;
|
||||||
|
register unsigned int i;
|
||||||
|
unsigned int arity = ArityOfFunctor(f);
|
||||||
|
|
||||||
|
pe = PredPropByFunc(f, *CurrentModulePtr);
|
||||||
|
pen = RepPredProp(pe);
|
||||||
|
/* You thought we would be over by now */
|
||||||
|
/* but no meta calls require special preprocessing */
|
||||||
|
if (pen->PredFlags & MetaPredFlag) {
|
||||||
return(CallMetaCallWithin());
|
return(CallMetaCallWithin());
|
||||||
}
|
}
|
||||||
|
/* at this point check if we should enter creep mode */
|
||||||
|
if (yap_flags[SPY_CREEP_FLAG]) {
|
||||||
|
return(EnterCreepMode(pen));
|
||||||
|
}
|
||||||
|
/* 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
|
||||||
|
}
|
||||||
|
return (CallPredicate(pen, (choiceptr)(ENV[E_CB])));
|
||||||
}
|
}
|
||||||
|
} 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]);
|
||||||
|
if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {
|
||||||
|
pt0 = TopB;
|
||||||
|
if (DelayedB == NULL || YOUNGER_CP(pt0,DelayedB))
|
||||||
|
DelayedB = pt0;
|
||||||
|
}
|
||||||
|
/* 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);
|
||||||
|
}
|
||||||
|
return(TRUE);
|
||||||
|
} else if (a == AtomFail || a == AtomFalse) {
|
||||||
|
return(FALSE);
|
||||||
|
}
|
||||||
|
/* call may not define new system predicates!! */
|
||||||
|
pe = PredPropByAtom(a, *CurrentModulePtr);
|
||||||
if (yap_flags[SPY_CREEP_FLAG]) {
|
if (yap_flags[SPY_CREEP_FLAG]) {
|
||||||
return(EnterCreepMode(RepPredProp(pe)));
|
return(EnterCreepMode(RepPredProp(pe)));
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 0, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
|
} else if (IsIntTerm(t)) {
|
||||||
|
return CallError(TYPE_ERROR_CALLABLE);
|
||||||
} else {
|
} else {
|
||||||
/* Is Pair Term */
|
/* Is Pair Term */
|
||||||
return(CallMetaCallWithin());
|
return(CallMetaCallWithin());
|
||||||
@ -491,14 +524,7 @@ p_execute0(void)
|
|||||||
|
|
||||||
if (IsAtomTerm(t)) {
|
if (IsAtomTerm(t)) {
|
||||||
Atom a = AtomOfTerm(t);
|
Atom a = AtomOfTerm(t);
|
||||||
arity = 0;
|
pe = PredPropByAtom(a, *CurrentModulePtr);
|
||||||
if (CurrentModule)
|
|
||||||
pe = PredProp(a, arity);
|
|
||||||
else {
|
|
||||||
pe = GetPredProp(a, arity);
|
|
||||||
if (pe == NIL)
|
|
||||||
return(FALSE);
|
|
||||||
}
|
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
register Functor f = FunctorOfTerm(t);
|
register Functor f = FunctorOfTerm(t);
|
||||||
register unsigned int i;
|
register unsigned int i;
|
||||||
@ -511,30 +537,23 @@ p_execute0(void)
|
|||||||
otherwise I would dereference the argument and
|
otherwise I would dereference the argument and
|
||||||
might skip a svar */
|
might skip a svar */
|
||||||
pt = RepAppl(t)+1;
|
pt = RepAppl(t)+1;
|
||||||
for (i = 1; i <= arity; ++i)
|
for (i = 1; i <= arity; ++i) {
|
||||||
#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
|
||||||
XREGS[i] = *pt++;
|
XREGS[i] = *pt++;
|
||||||
#endif
|
#endif
|
||||||
if (CurrentModule)
|
|
||||||
pe = PredPropByFunc(f);
|
|
||||||
else {
|
|
||||||
pe = GetPredPropByFunc(f);
|
|
||||||
if (pe == NIL)
|
|
||||||
return(FALSE);
|
|
||||||
}
|
}
|
||||||
|
pe = GetPredPropByFunc(f, *CurrentModulePtr);
|
||||||
} else
|
} else
|
||||||
return (FALSE); /* for the moment */
|
return (FALSE); /* for the moment */
|
||||||
/* N = arity; */
|
/* N = arity; */
|
||||||
/* call may not define new system predicates!! */
|
/* call may not define new system predicates!! */
|
||||||
return (CallProlog(RepPredProp(pe), arity, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -545,15 +564,8 @@ p_execute_0(void)
|
|||||||
Atom a;
|
Atom a;
|
||||||
|
|
||||||
a = AtomOfTerm(t);
|
a = AtomOfTerm(t);
|
||||||
if (CurrentModule)
|
pe = PredPropByAtom(a, *CurrentModulePtr);
|
||||||
pe = PredProp(a, 0);
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
else {
|
|
||||||
pe = GetPredProp(a, 0);
|
|
||||||
if (pe == NIL)
|
|
||||||
return(FALSE);
|
|
||||||
}
|
|
||||||
return (CallProlog(RepPredProp(pe), 0, (Int) (-1)));
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -572,7 +584,7 @@ p_execute_1(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 1, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -592,7 +604,7 @@ p_execute_2(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 2, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -613,7 +625,7 @@ p_execute_3(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 3, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -635,7 +647,7 @@ p_execute_4(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 4, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -658,7 +670,7 @@ p_execute_5(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 5, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -682,7 +694,7 @@ p_execute_6(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 6, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -707,7 +719,7 @@ p_execute_7(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 7, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -733,7 +745,7 @@ p_execute_8(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 8, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -760,7 +772,7 @@ p_execute_9(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 9, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -788,7 +800,7 @@ p_execute_10(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), 10, (Int) (-1)));
|
return (CallPredicate(RepPredProp(pe), B));
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef DEPTH_LIMIT
|
#ifdef DEPTH_LIMIT
|
||||||
@ -861,7 +873,7 @@ p_at_execute(void)
|
|||||||
if (pe == NIL)
|
if (pe == NIL)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
return (CallProlog(RepPredProp(pe), arity, IntOfTerm(t2)));
|
return (CallClause(RepPredProp(pe), arity, IntOfTerm(t2)));
|
||||||
}
|
}
|
||||||
|
|
||||||
int
|
int
|
||||||
@ -979,7 +991,7 @@ do_goal(CODEADDR CodeAdr, int arity, CELL *pt, int args_to_save, int top)
|
|||||||
HB = H;
|
HB = H;
|
||||||
YENV[E_CB] = Unsigned (B);
|
YENV[E_CB] = Unsigned (B);
|
||||||
P = (yamop *) CodeAdr;
|
P = (yamop *) CodeAdr;
|
||||||
S = CellPtr (&(RepPredProp (PredProp (AtomCall, 1))->StateOfPred)); /* A1 mishaps */
|
S = CellPtr (RepPredProp (PredProp (AtomCall, 1))); /* A1 mishaps */
|
||||||
TopB = B;
|
TopB = B;
|
||||||
|
|
||||||
return(exec_absmi(top));
|
return(exec_absmi(top));
|
||||||
@ -1012,7 +1024,7 @@ execute_goal(Term t, int nargs)
|
|||||||
if (IsAtomTerm(t)) {
|
if (IsAtomTerm(t)) {
|
||||||
Atom a = AtomOfTerm(t);
|
Atom a = AtomOfTerm(t);
|
||||||
pt = NULL;
|
pt = NULL;
|
||||||
pe = GetPredProp(a, 0);
|
pe = PredPropByAtom(a, *CurrentModulePtr);
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor f = FunctorOfTerm(t);
|
Functor f = FunctorOfTerm(t);
|
||||||
|
|
||||||
@ -1024,7 +1036,7 @@ execute_goal(Term t, int nargs)
|
|||||||
otherwise I would dereference the argument and
|
otherwise I would dereference the argument and
|
||||||
might skip a svar */
|
might skip a svar */
|
||||||
pt = RepAppl(t)+1;
|
pt = RepAppl(t)+1;
|
||||||
pe = GetPredPropByFunc(f);
|
pe = GetPredPropByFunc(f, *CurrentModulePtr);
|
||||||
} else {
|
} else {
|
||||||
Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
Error(TYPE_ERROR_CALLABLE,t,"call/1");
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
@ -1043,12 +1055,12 @@ execute_goal(Term t, int nargs)
|
|||||||
}
|
}
|
||||||
if (IsAtomTerm(t)) {
|
if (IsAtomTerm(t)) {
|
||||||
Atom at = AtomOfTerm(t);
|
Atom at = AtomOfTerm(t);
|
||||||
CodeAdr = RepPredProp (PredProp (at, 0))->CodeOfPred;
|
CodeAdr = RepPredProp (PredPropByAtom(at, *CurrentModulePtr))->CodeOfPred;
|
||||||
READ_UNLOCK(ppe->PRWLock);
|
READ_UNLOCK(ppe->PRWLock);
|
||||||
out = do_goal(CodeAdr, 0, pt, nargs, FALSE);
|
out = do_goal(CodeAdr, 0, pt, nargs, FALSE);
|
||||||
} else {
|
} else {
|
||||||
Functor f = FunctorOfTerm(t);
|
Functor f = FunctorOfTerm(t);
|
||||||
CodeAdr = RepPredProp (PredPropByFunc (f))->CodeOfPred;
|
CodeAdr = RepPredProp (PredPropByFunc (f, *CurrentModulePtr))->CodeOfPred;
|
||||||
READ_UNLOCK(ppe->PRWLock);
|
READ_UNLOCK(ppe->PRWLock);
|
||||||
out = do_goal(CodeAdr, ArityOfFunctor(f), pt, nargs, FALSE);
|
out = do_goal(CodeAdr, ArityOfFunctor(f), pt, nargs, FALSE);
|
||||||
}
|
}
|
||||||
@ -1172,7 +1184,7 @@ RunTopGoal(Term t)
|
|||||||
if (IsAtomTerm(t)) {
|
if (IsAtomTerm(t)) {
|
||||||
Atom a = AtomOfTerm(t);
|
Atom a = AtomOfTerm(t);
|
||||||
pt = NULL;
|
pt = NULL;
|
||||||
pe = GetPredProp(a, 0);
|
pe = PredPropByAtom(a, *CurrentModulePtr);
|
||||||
arity = 0;
|
arity = 0;
|
||||||
} else if (IsApplTerm(t)) {
|
} else if (IsApplTerm(t)) {
|
||||||
Functor f = FunctorOfTerm(t);
|
Functor f = FunctorOfTerm(t);
|
||||||
@ -1184,7 +1196,7 @@ RunTopGoal(Term t)
|
|||||||
/* 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
|
||||||
might skip a svar */
|
might skip a svar */
|
||||||
pe = GetPredPropByFunc(f);
|
pe = GetPredPropByFunc(f, *CurrentModulePtr);
|
||||||
pt = RepAppl(t)+1;
|
pt = RepAppl(t)+1;
|
||||||
arity = ArityOfFunctor(f);
|
arity = ArityOfFunctor(f);
|
||||||
} else {
|
} else {
|
||||||
@ -1315,7 +1327,9 @@ void
|
|||||||
InitExecFs(void)
|
InitExecFs(void)
|
||||||
{
|
{
|
||||||
InitCPred("$execute", 1, p_execute, 0);
|
InitCPred("$execute", 1, p_execute, 0);
|
||||||
|
InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
|
||||||
InitCPred("$execute_within", 3, p_execute_within, 0);
|
InitCPred("$execute_within", 3, p_execute_within, 0);
|
||||||
|
InitCPred("$execute_within", 1, p_execute_within2, 0);
|
||||||
InitCPred("$execute", 2, p_at_execute, 0);
|
InitCPred("$execute", 2, p_at_execute, 0);
|
||||||
InitCPred("$call_with_args", 1, p_execute_0, 0);
|
InitCPred("$call_with_args", 1, p_execute_0, 0);
|
||||||
InitCPred("$call_with_args", 2, p_execute_1, 0);
|
InitCPred("$call_with_args", 2, p_execute_1, 0);
|
||||||
|
60
C/init.c
60
C/init.c
@ -312,12 +312,12 @@ OpDec(int p, char *type, Atom a)
|
|||||||
p |= DcrrpFlag;
|
p |= DcrrpFlag;
|
||||||
}
|
}
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
info = RepOpProp(LockedGetAProp(ae, OpProperty));
|
info = RepOpProp(GetAPropHavingLock(ae, OpProperty));
|
||||||
if (EndOfPAEntr(info)) {
|
if (EndOfPAEntr(info)) {
|
||||||
info = (OpEntry *) AllocAtomSpace(sizeof(OpEntry));
|
info = (OpEntry *) AllocAtomSpace(sizeof(OpEntry));
|
||||||
info->KindOfPE = Ord(OpProperty);
|
info->KindOfPE = Ord(OpProperty);
|
||||||
info->NextOfPE = RepAtom(a)->PropOfAE;
|
info->NextOfPE = RepAtom(a)->PropsOfAE;
|
||||||
RepAtom(a)->PropOfAE = AbsOpProp(info);
|
RepAtom(a)->PropsOfAE = AbsOpProp(info);
|
||||||
INIT_RWLOCK(info->OpRWLock);
|
INIT_RWLOCK(info->OpRWLock);
|
||||||
WRITE_LOCK(info->OpRWLock);
|
WRITE_LOCK(info->OpRWLock);
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
@ -507,17 +507,30 @@ InitDebug(void)
|
|||||||
PutValue(At, MkIntTerm(10));
|
PutValue(At, MkIntTerm(10));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
void
|
void
|
||||||
InitCPred(char *Name, int Arity, CPredicate code, int flags)
|
InitCPred(char *Name, int Arity, CPredicate code, int flags)
|
||||||
{
|
{
|
||||||
Atom atom = LookupAtom(Name);
|
Atom atom = LookupAtom(Name);
|
||||||
PredEntry *pe = RepPredProp(PredProp(atom, Arity));
|
PredEntry *pe = RepPredProp(PredProp(atom, Arity));
|
||||||
|
yamop *p_code = (yamop *)AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)NULL),sla),e));
|
||||||
|
|
||||||
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
|
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
|
||||||
pe->TrueCodeOfPred = pe->CodeOfPred = (CODEADDR) code;
|
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code;
|
||||||
pe->OpcodeOfPred = opcode(_Ystop);
|
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
|
||||||
pe->ModuleOfPred = CurrentModule;
|
if (flags & UserCPredFlag)
|
||||||
|
p_code->opc = pe->OpcodeOfPred = opcode(_call_usercpred);
|
||||||
|
else
|
||||||
|
p_code->opc = pe->OpcodeOfPred = opcode(_call_cpred);
|
||||||
|
p_code->u.sla.l2 = (CELL)NIL;
|
||||||
|
p_code->u.sla.s = -Signed(RealEnvSize);
|
||||||
|
p_code->u.sla.p = (CODEADDR)pe;
|
||||||
|
p_code = NEXTOP(p_code,sla);
|
||||||
|
p_code->opc = opcode(_procceed);
|
||||||
|
{
|
||||||
|
Term mod = CurrentModule;
|
||||||
|
if (mod) mod = MkIntTerm(mod);
|
||||||
|
pe->ModuleOfPred = mod;
|
||||||
|
}
|
||||||
if (!(flags & UserCPredFlag)) {
|
if (!(flags & UserCPredFlag)) {
|
||||||
c_predicates[NUMBER_OF_CPREDS] = code;
|
c_predicates[NUMBER_OF_CPREDS] = code;
|
||||||
pe->StateOfPred = NUMBER_OF_CPREDS;
|
pe->StateOfPred = NUMBER_OF_CPREDS;
|
||||||
@ -530,9 +543,17 @@ InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int f
|
|||||||
{
|
{
|
||||||
Atom atom = LookupAtom(Name);
|
Atom atom = LookupAtom(Name);
|
||||||
PredEntry *pe = RepPredProp(PredProp(atom, Arity));
|
PredEntry *pe = RepPredProp(PredProp(atom, Arity));
|
||||||
|
yamop *p_code = (yamop *)AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)NULL),sla),e));
|
||||||
|
|
||||||
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
|
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
|
||||||
pe->CodeOfPred = (CODEADDR) code;
|
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code;
|
||||||
|
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
|
||||||
|
p_code->opc = pe->OpcodeOfPred = opcode(_call_cpred);
|
||||||
|
p_code->u.sla.l2 = (CELL)NIL;
|
||||||
|
p_code->u.sla.s = -Signed(RealEnvSize);
|
||||||
|
p_code->u.sla.p = (CODEADDR)pe;
|
||||||
|
p_code = NEXTOP(p_code,sla);
|
||||||
|
p_code->opc = opcode(_procceed);
|
||||||
c_predicates[NUMBER_OF_CPREDS] = code;
|
c_predicates[NUMBER_OF_CPREDS] = code;
|
||||||
pe->StateOfPred = NUMBER_OF_CPREDS;
|
pe->StateOfPred = NUMBER_OF_CPREDS;
|
||||||
NUMBER_OF_CPREDS++;
|
NUMBER_OF_CPREDS++;
|
||||||
@ -550,14 +571,22 @@ InitAsmPred(char *Name, int Arity, int code, CPredicate def, int flags)
|
|||||||
PredEntry *pe = RepPredProp(PredProp(atom, Arity));
|
PredEntry *pe = RepPredProp(PredProp(atom, Arity));
|
||||||
|
|
||||||
pe->PredFlags = flags | StandardPredFlag | (code);
|
pe->PredFlags = flags | StandardPredFlag | (code);
|
||||||
pe->FirstClause = pe->LastClause = NIL;
|
|
||||||
if (def != NULL) {
|
if (def != NULL) {
|
||||||
pe->CodeOfPred = pe->TrueCodeOfPred = (CODEADDR)def;
|
yamop *p_code = (yamop *)AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)NULL),sla),e));
|
||||||
|
|
||||||
|
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) def;
|
||||||
|
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
|
||||||
|
p_code->opc = pe->OpcodeOfPred = opcode(_call_cpred);
|
||||||
|
p_code->u.sla.l2 = (CELL)NIL;
|
||||||
|
p_code->u.sla.s = -Signed(RealEnvSize);
|
||||||
|
p_code->u.sla.p = (CODEADDR)pe;
|
||||||
|
p_code = NEXTOP(p_code,sla);
|
||||||
|
p_code->opc = opcode(_procceed);
|
||||||
c_predicates[NUMBER_OF_CPREDS] = def;
|
c_predicates[NUMBER_OF_CPREDS] = def;
|
||||||
pe->StateOfPred = NUMBER_OF_CPREDS;
|
pe->StateOfPred = NUMBER_OF_CPREDS;
|
||||||
NUMBER_OF_CPREDS++;
|
NUMBER_OF_CPREDS++;
|
||||||
pe->OpcodeOfPred = opcode(_Ystop);
|
|
||||||
} else {
|
} else {
|
||||||
|
pe->FirstClause = pe->LastClause = NIL;
|
||||||
pe->OpcodeOfPred = opcode(_undef_p);
|
pe->OpcodeOfPred = opcode(_undef_p);
|
||||||
pe->TrueCodeOfPred = pe->CodeOfPred =
|
pe->TrueCodeOfPred = pe->CodeOfPred =
|
||||||
(CODEADDR)(&(pe->OpcodeOfPred));
|
(CODEADDR)(&(pe->OpcodeOfPred));
|
||||||
@ -915,6 +944,7 @@ InitCodes(void)
|
|||||||
heap_regs->functor_comma = MkFunctor(AtomComma, 2);
|
heap_regs->functor_comma = MkFunctor(AtomComma, 2);
|
||||||
heap_regs->functor_csult = MkFunctor(AtomCsult, 1);
|
heap_regs->functor_csult = MkFunctor(AtomCsult, 1);
|
||||||
heap_regs->functor_eq = MkFunctor(AtomEq, 2);
|
heap_regs->functor_eq = MkFunctor(AtomEq, 2);
|
||||||
|
heap_regs->functor_execute_in_mod = MkFunctor(LookupAtom("$execute_in_mod"), 2);
|
||||||
heap_regs->functor_g_atom = MkFunctor(LookupAtom("atom"), 1);
|
heap_regs->functor_g_atom = MkFunctor(LookupAtom("atom"), 1);
|
||||||
heap_regs->functor_g_atomic = MkFunctor(LookupAtom("atomic"), 1);
|
heap_regs->functor_g_atomic = MkFunctor(LookupAtom("atomic"), 1);
|
||||||
heap_regs->functor_g_compound = MkFunctor(LookupAtom("compound"), 1);
|
heap_regs->functor_g_compound = MkFunctor(LookupAtom("compound"), 1);
|
||||||
@ -947,6 +977,7 @@ InitCodes(void)
|
|||||||
#ifdef EUROTRA
|
#ifdef EUROTRA
|
||||||
heap_regs->term_dollar_u = MkAtomTerm(LookupAtom("$u"));
|
heap_regs->term_dollar_u = MkAtomTerm(LookupAtom("$u"));
|
||||||
#endif
|
#endif
|
||||||
|
heap_regs->term_prolog = MkAtomTerm(LookupAtom("prolog"));
|
||||||
heap_regs->term_refound_var = MkAtomTerm(LookupAtom("$I_FOUND_THE_VARIABLE_AGAIN"));
|
heap_regs->term_refound_var = MkAtomTerm(LookupAtom("$I_FOUND_THE_VARIABLE_AGAIN"));
|
||||||
heap_regs->n_of_file_aliases = 0;
|
heap_regs->n_of_file_aliases = 0;
|
||||||
heap_regs->file_aliases = NULL;
|
heap_regs->file_aliases = NULL;
|
||||||
@ -955,10 +986,10 @@ InitCodes(void)
|
|||||||
heap_regs->size_of_overflow = 0;
|
heap_regs->size_of_overflow = 0;
|
||||||
/* make sure no one else can use these two atoms */
|
/* make sure no one else can use these two atoms */
|
||||||
*CurrentModulePtr = MkIntTerm(1);
|
*CurrentModulePtr = MkIntTerm(1);
|
||||||
heap_regs->pred_goal_expansion = RepPredProp(PredProp(LookupAtom("goal_expansion"),3));
|
heap_regs->pred_goal_expansion = RepPredProp(PredPropByFunc(MkFunctor(LookupAtom("goal_expansion"),3),MkIntTerm(1)));
|
||||||
*CurrentModulePtr = MkIntTerm(0);
|
*CurrentModulePtr = MkIntTerm(0);
|
||||||
heap_regs->dead_clauses = NULL;
|
heap_regs->dead_clauses = NULL;
|
||||||
heap_regs->pred_meta_call = RepPredProp(PredProp(heap_regs->atom_meta_call,3));
|
heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(MkFunctor(heap_regs->atom_meta_call,3),MkIntTerm(0)));
|
||||||
ReleaseAtom(AtomOfTerm(heap_regs->term_refound_var));
|
ReleaseAtom(AtomOfTerm(heap_regs->term_refound_var));
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1005,7 +1036,7 @@ InitYaamRegs(void)
|
|||||||
UndefCode = NULL;
|
UndefCode = NULL;
|
||||||
} else {
|
} else {
|
||||||
undefpe = RepPredProp (p);
|
undefpe = RepPredProp (p);
|
||||||
UndefCode = (CELL *) & (undefpe->CodeOfPred);
|
UndefCode = undefpe;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
STATIC_PREDICATES_MARKED = FALSE;
|
STATIC_PREDICATES_MARKED = FALSE;
|
||||||
@ -1136,6 +1167,7 @@ InitStacks(int Heap,
|
|||||||
#else
|
#else
|
||||||
InitAbsmi();
|
InitAbsmi();
|
||||||
#endif
|
#endif
|
||||||
|
InitModules();
|
||||||
InitCodes();
|
InitCodes();
|
||||||
InitOps();
|
InitOps();
|
||||||
InitDebug();
|
InitDebug();
|
||||||
|
13
C/modules.c
13
C/modules.c
@ -41,8 +41,11 @@ Module_Name(CODEADDR cap)
|
|||||||
predicate is a meta-call. Otherwise it will still work.
|
predicate is a meta-call. Otherwise it will still work.
|
||||||
*/
|
*/
|
||||||
return(ModuleName[CurrentModule]);
|
return(ModuleName[CurrentModule]);
|
||||||
else
|
else {
|
||||||
|
if (ap->ModuleOfPred)
|
||||||
|
return (ModuleName[IntOfTerm(ap->ModuleOfPred)]);
|
||||||
return (ModuleName[ap->ModuleOfPred]);
|
return (ModuleName[ap->ModuleOfPred]);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int
|
int
|
||||||
@ -94,6 +97,13 @@ p_change_module(void)
|
|||||||
return (TRUE);
|
return (TRUE);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_module_number(void)
|
||||||
|
{ /* $change_module(New) */
|
||||||
|
Term t = MkIntTerm(LookupModule(Deref(ARG1)));
|
||||||
|
return (unify(ARG2,t));
|
||||||
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
InitModules(void)
|
InitModules(void)
|
||||||
{
|
{
|
||||||
@ -104,4 +114,5 @@ InitModules(void)
|
|||||||
InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
|
InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
|
||||||
InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
|
InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
|
||||||
InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
|
InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
|
||||||
|
InitCPred("$module_number", 2, p_module_number, SafePredFlag|SyncPredFlag);
|
||||||
}
|
}
|
||||||
|
22
C/save.c
22
C/save.c
@ -1071,6 +1071,7 @@ restore_codes(void)
|
|||||||
heap_regs->functor_comma = FuncAdjust(heap_regs->functor_comma);
|
heap_regs->functor_comma = FuncAdjust(heap_regs->functor_comma);
|
||||||
heap_regs->functor_csult = FuncAdjust(heap_regs->functor_csult);
|
heap_regs->functor_csult = FuncAdjust(heap_regs->functor_csult);
|
||||||
heap_regs->functor_eq = FuncAdjust(heap_regs->functor_eq);
|
heap_regs->functor_eq = FuncAdjust(heap_regs->functor_eq);
|
||||||
|
heap_regs->functor_execute_in_mod = FuncAdjust(heap_regs->functor_execute_in_mod);
|
||||||
heap_regs->functor_g_atom = FuncAdjust(heap_regs->functor_g_atom);
|
heap_regs->functor_g_atom = FuncAdjust(heap_regs->functor_g_atom);
|
||||||
heap_regs->functor_g_atomic = FuncAdjust(heap_regs->functor_g_atomic);
|
heap_regs->functor_g_atomic = FuncAdjust(heap_regs->functor_g_atomic);
|
||||||
heap_regs->functor_g_compound = FuncAdjust(heap_regs->functor_g_compound);
|
heap_regs->functor_g_compound = FuncAdjust(heap_regs->functor_g_compound);
|
||||||
@ -1102,6 +1103,7 @@ restore_codes(void)
|
|||||||
#ifdef EUROTRA
|
#ifdef EUROTRA
|
||||||
heap_regs->term_dollar_u = AtomTermAdjust(heap_regs->term_dollar_u);
|
heap_regs->term_dollar_u = AtomTermAdjust(heap_regs->term_dollar_u);
|
||||||
#endif
|
#endif
|
||||||
|
heap_regs->term_prolog = AtomTermAdjust(heap_regs->term_prolog);
|
||||||
heap_regs->term_refound_var = AtomTermAdjust(heap_regs->term_refound_var);
|
heap_regs->term_refound_var = AtomTermAdjust(heap_regs->term_refound_var);
|
||||||
heap_regs->file_aliases =
|
heap_regs->file_aliases =
|
||||||
(struct AliasDescS *)AddrAdjust((ADDR)heap_regs->file_aliases);
|
(struct AliasDescS *)AddrAdjust((ADDR)heap_regs->file_aliases);
|
||||||
@ -1112,15 +1114,15 @@ restore_codes(void)
|
|||||||
heap_regs->pred_meta_call =
|
heap_regs->pred_meta_call =
|
||||||
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_meta_call);
|
(PredEntry *)AddrAdjust((ADDR)heap_regs->pred_meta_call);
|
||||||
if (heap_regs->undef_code != NULL)
|
if (heap_regs->undef_code != NULL)
|
||||||
heap_regs->undef_code = PtoHeapCellAdjust(heap_regs->undef_code);
|
heap_regs->undef_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->undef_code));
|
||||||
if (heap_regs->creep_code != NULL)
|
if (heap_regs->creep_code != NULL)
|
||||||
heap_regs->creep_code = PtoHeapCellAdjust(heap_regs->creep_code);
|
heap_regs->creep_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->creep_code));
|
||||||
if (heap_regs->spy_code != NULL)
|
if (heap_regs->spy_code != NULL)
|
||||||
heap_regs->spy_code = PtoHeapCellAdjust(heap_regs->spy_code);
|
heap_regs->spy_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->spy_code));
|
||||||
#ifdef COROUTINING
|
#ifdef COROUTINING
|
||||||
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
||||||
if (heap_regs->wake_up_code != NULL)
|
if (heap_regs->wake_up_code != NULL)
|
||||||
heap_regs->wake_up_code = PtoHeapCellAdjust(heap_regs->wake_up_code);
|
heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->wake_up_code));
|
||||||
heap_regs->mutable_list =
|
heap_regs->mutable_list =
|
||||||
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->mutable_list)));
|
AbsAppl(PtoGloAdjust(RepAppl(heap_regs->mutable_list)));
|
||||||
heap_regs->atts_mutable_list =
|
heap_regs->atts_mutable_list =
|
||||||
@ -1726,6 +1728,7 @@ RestoreClause(Clause *Cl)
|
|||||||
case _call:
|
case _call:
|
||||||
case _either:
|
case _either:
|
||||||
case _or_else:
|
case _or_else:
|
||||||
|
case _p_execute:
|
||||||
#ifdef YAPOR
|
#ifdef YAPOR
|
||||||
case _or_last:
|
case _or_last:
|
||||||
#endif
|
#endif
|
||||||
@ -2408,7 +2411,10 @@ CleanCode(PredEntry *pp)
|
|||||||
CODEADDR FirstC, LastC;
|
CODEADDR FirstC, LastC;
|
||||||
|
|
||||||
/* Init takes care of the first 2 cases */
|
/* Init takes care of the first 2 cases */
|
||||||
pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
|
if (pp->ArityOfPE)
|
||||||
|
pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
|
||||||
|
else
|
||||||
|
pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred));
|
||||||
if (pp->OwnerFile)
|
if (pp->OwnerFile)
|
||||||
pp->OwnerFile = AtomAdjust(pp->OwnerFile);
|
pp->OwnerFile = AtomAdjust(pp->OwnerFile);
|
||||||
pp->OpcodeOfPred = opcode(op_from_opcode(pp->OpcodeOfPred));
|
pp->OpcodeOfPred = opcode(op_from_opcode(pp->OpcodeOfPred));
|
||||||
@ -2555,7 +2561,7 @@ RestoreInvisibleAtoms(void)
|
|||||||
#ifdef DEBUG_RESTORE2 /* useful during debug */
|
#ifdef DEBUG_RESTORE2 /* useful during debug */
|
||||||
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE);
|
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE);
|
||||||
#endif
|
#endif
|
||||||
RestoreEntries(RepProp(at->PropOfAE));
|
RestoreEntries(RepProp(at->PropsOfAE));
|
||||||
atm = at->NextOfAE;
|
atm = at->NextOfAE;
|
||||||
at->NextOfAE = atm = AtomAdjust(atm);
|
at->NextOfAE = atm = AtomAdjust(atm);
|
||||||
at = RepAtom(atm);
|
at = RepAtom(atm);
|
||||||
@ -2646,7 +2652,7 @@ restore_heap(void)
|
|||||||
#ifdef DEBUG_RESTORE2 /* useful during debug */
|
#ifdef DEBUG_RESTORE2 /* useful during debug */
|
||||||
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE);
|
YP_fprintf(errout, "Restoring %s\n", at->StrOfAE);
|
||||||
#endif
|
#endif
|
||||||
RestoreEntries(RepProp(at->PropOfAE));
|
RestoreEntries(RepProp(at->PropsOfAE));
|
||||||
atm = at->NextOfAE = AtomAdjust(at->NextOfAE);
|
atm = at->NextOfAE = AtomAdjust(at->NextOfAE);
|
||||||
at = RepAtom(atm);
|
at = RepAtom(atm);
|
||||||
} while (!EndOfPAEntr(at));
|
} while (!EndOfPAEntr(at));
|
||||||
@ -2680,7 +2686,7 @@ ShowAtoms()
|
|||||||
at = RepAtom(HashPtr->Entry);
|
at = RepAtom(HashPtr->Entry);
|
||||||
do {
|
do {
|
||||||
YP_fprintf(YP_stderr,"Passei ao %s em %x\n", at->StrOfAE, at);
|
YP_fprintf(YP_stderr,"Passei ao %s em %x\n", at->StrOfAE, at);
|
||||||
ShowEntries(RepProp(at->PropOfAE));
|
ShowEntries(RepProp(at->PropsOfAE));
|
||||||
} while (!EndOfPAEntr(at = RepAtom(at->NextOfAE)));
|
} while (!EndOfPAEntr(at = RepAtom(at->NextOfAE)));
|
||||||
}
|
}
|
||||||
HashPtr++;
|
HashPtr++;
|
||||||
|
33
C/stdpreds.c
33
C/stdpreds.c
@ -141,7 +141,7 @@ p_flipflop(void)
|
|||||||
|
|
||||||
at = FullLookupAtom("$spy");
|
at = FullLookupAtom("$spy");
|
||||||
pred = RepPredProp(PredProp(at, 1));
|
pred = RepPredProp(PredProp(at, 1));
|
||||||
SpyCode = CellPtr(&(pred->CodeOfPred));
|
SpyCode = pred;
|
||||||
return ((int) (FlipFlop = (1 - FlipFlop)));
|
return ((int) (FlipFlop = (1 - FlipFlop)));
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -165,7 +165,7 @@ p_creep(void)
|
|||||||
|
|
||||||
at = FullLookupAtom("$creep");
|
at = FullLookupAtom("$creep");
|
||||||
pred = RepPredProp(PredProp(at, 1));
|
pred = RepPredProp(PredProp(at, 1));
|
||||||
CreepCode = (CELL *) & (pred->CodeOfPred);
|
CreepCode = pred;
|
||||||
CreepFlag = Unsigned(LCL0)-Unsigned(H0);
|
CreepFlag = Unsigned(LCL0)-Unsigned(H0);
|
||||||
return (TRUE);
|
return (TRUE);
|
||||||
}
|
}
|
||||||
@ -192,7 +192,7 @@ FindAtom(codeToFind, arity)
|
|||||||
register PredEntry *pp;
|
register PredEntry *pp;
|
||||||
AtomEntry *ae = RepAtom(a);
|
AtomEntry *ae = RepAtom(a);
|
||||||
READ_LOCK(ae->ARWLock);
|
READ_LOCK(ae->ARWLock);
|
||||||
pp = RepPredProp(RepAtom(a)->PropOfAE);
|
pp = RepPredProp(RepAtom(a)->PropsOfAE);
|
||||||
while (!EndOfPAEntr(pp) && ((pp->KindOfPE & 0x8000)
|
while (!EndOfPAEntr(pp) && ((pp->KindOfPE & 0x8000)
|
||||||
|| (pp->CodeOfPred != codeToFind)))
|
|| (pp->CodeOfPred != codeToFind)))
|
||||||
pp = RepPredProp(pp->NextOfPE);
|
pp = RepPredProp(pp->NextOfPE);
|
||||||
@ -1370,7 +1370,10 @@ cont_current_predicate(void)
|
|||||||
cut_fail();
|
cut_fail();
|
||||||
EXTRA_CBACK_ARG(2,1) = (CELL)MkIntegerTerm((Int)(pp->NextPredOfModule));
|
EXTRA_CBACK_ARG(2,1) = (CELL)MkIntegerTerm((Int)(pp->NextPredOfModule));
|
||||||
Arity = pp->ArityOfPE;
|
Arity = pp->ArityOfPE;
|
||||||
name = NameOfFunctor(pp->FunctorOfPred);
|
if (Arity)
|
||||||
|
name = NameOfFunctor(pp->FunctorOfPred);
|
||||||
|
else
|
||||||
|
name = (Atom)pp->FunctorOfPred;
|
||||||
return (unify(ARG1,MkAtomTerm(name)) &&
|
return (unify(ARG1,MkAtomTerm(name)) &&
|
||||||
unify(ARG2, MkIntegerTerm(Arity)));
|
unify(ARG2, MkIntegerTerm(Arity)));
|
||||||
}
|
}
|
||||||
@ -1406,7 +1409,7 @@ cont_current_op(void)
|
|||||||
if (fix > 3) {
|
if (fix > 3) {
|
||||||
a = AtomOfTerm(Deref(ARG3));
|
a = AtomOfTerm(Deref(ARG3));
|
||||||
READ_LOCK(RepAtom(a)->ARWLock);
|
READ_LOCK(RepAtom(a)->ARWLock);
|
||||||
if (EndOfPAEntr(pp = NextOp(RepOpProp(RepAtom(a)->PropOfAE)))) {
|
if (EndOfPAEntr(pp = NextOp(RepOpProp(RepAtom(a)->PropsOfAE)))) {
|
||||||
READ_UNLOCK(RepAtom(a)->ARWLock);
|
READ_UNLOCK(RepAtom(a)->ARWLock);
|
||||||
cut_fail();
|
cut_fail();
|
||||||
}
|
}
|
||||||
@ -1453,13 +1456,13 @@ cont_current_op(void)
|
|||||||
}
|
}
|
||||||
at = RepAtom(a);
|
at = RepAtom(a);
|
||||||
READ_LOCK(at->ARWLock);
|
READ_LOCK(at->ARWLock);
|
||||||
pp = NextOp(RepOpProp(at->PropOfAE));
|
pp = NextOp(RepOpProp(at->PropsOfAE));
|
||||||
READ_UNLOCK(at->ARWLock);
|
READ_UNLOCK(at->ARWLock);
|
||||||
} while (EndOfPAEntr(pp));
|
} while (EndOfPAEntr(pp));
|
||||||
fix = 0;
|
fix = 0;
|
||||||
EXTRA_CBACK_ARG(3,1) = (CELL) MkAtomTerm(a);
|
EXTRA_CBACK_ARG(3,1) = (CELL) MkAtomTerm(a);
|
||||||
} else {
|
} else {
|
||||||
pp = NextOp(RepOpProp(at->PropOfAE));
|
pp = NextOp(RepOpProp(at->PropsOfAE));
|
||||||
}
|
}
|
||||||
READ_LOCK(pp->OpRWLock);
|
READ_LOCK(pp->OpRWLock);
|
||||||
if (fix == 0 && pp->Prefix == 0)
|
if (fix == 0 && pp->Prefix == 0)
|
||||||
@ -1553,23 +1556,19 @@ p_debug()
|
|||||||
static Int
|
static Int
|
||||||
p_flags(void)
|
p_flags(void)
|
||||||
{ /* $flags(+Functor,?OldFlags,?NewFlags) */
|
{ /* $flags(+Functor,?OldFlags,?NewFlags) */
|
||||||
Atom at;
|
|
||||||
int arity;
|
|
||||||
PredEntry *pe;
|
PredEntry *pe;
|
||||||
Int newFl;
|
Int newFl;
|
||||||
|
|
||||||
Term t1 = Deref(ARG1);
|
Term t1 = Deref(ARG1);
|
||||||
if (IsVarTerm(t1))
|
if (IsVarTerm(t1))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
if (IsAtomTerm(t1))
|
if (IsAtomTerm(t1)) {
|
||||||
at = AtomOfTerm(t1), arity = 0;
|
pe = RepPredProp(PredProp(AtomOfTerm(t1), 0));
|
||||||
else if (IsApplTerm(t1)) {
|
} else if (IsApplTerm(t1)) {
|
||||||
Functor funt = FunctorOfTerm(t1);
|
Functor funt = FunctorOfTerm(t1);
|
||||||
at = NameOfFunctor(funt);
|
pe = RepPredProp(PredPropByFunc(funt, *CurrentModulePtr));
|
||||||
arity = ArityOfFunctor(funt);
|
|
||||||
} else
|
} else
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
pe = RepPredProp(PredProp(at, arity));
|
|
||||||
if (EndOfPAEntr(pe))
|
if (EndOfPAEntr(pe))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
WRITE_LOCK(pe->PRWLock);
|
WRITE_LOCK(pe->PRWLock);
|
||||||
@ -1685,7 +1684,7 @@ p_unhide(void)
|
|||||||
}
|
}
|
||||||
atom = RepAtom(AtomOfTerm(t1));
|
atom = RepAtom(AtomOfTerm(t1));
|
||||||
WRITE_LOCK(atom->ARWLock);
|
WRITE_LOCK(atom->ARWLock);
|
||||||
if (atom->PropOfAE != NIL) {
|
if (atom->PropsOfAE != NIL) {
|
||||||
Error(SYSTEM_ERROR,t1,"cannot unhide an atom in use");
|
Error(SYSTEM_ERROR,t1,"cannot unhide an atom in use");
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
}
|
}
|
||||||
@ -1698,7 +1697,7 @@ p_unhide(void)
|
|||||||
}
|
}
|
||||||
if (EndOfPAEntr(chain))
|
if (EndOfPAEntr(chain))
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
atom->PropOfAE = chain->PropOfAE;
|
atom->PropsOfAE = chain->PropsOfAE;
|
||||||
if (old == NIL)
|
if (old == NIL)
|
||||||
INVISIBLECHAIN.Entry = chain->NextOfAE;
|
INVISIBLECHAIN.Entry = chain->NextOfAE;
|
||||||
else
|
else
|
||||||
|
20
C/tracer.c
20
C/tracer.c
@ -133,7 +133,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
|||||||
/* if (vsc_count < 24) return; */
|
/* if (vsc_count < 24) return; */
|
||||||
/* if (vsc_count > 500000) exit(0); */
|
/* if (vsc_count > 500000) exit(0); */
|
||||||
/* if (gc_calls < 1) return;*/
|
/* if (gc_calls < 1) return;*/
|
||||||
YP_fprintf(YP_stderr,"%lu (%d)", vsc_count, CurrentModule);
|
YP_fprintf(YP_stderr,"%lu %p (%d)", vsc_count, B, CurrentModule);
|
||||||
/* check_trail_consistency(); */
|
/* check_trail_consistency(); */
|
||||||
if (pred == NULL) {
|
if (pred == NULL) {
|
||||||
return;
|
return;
|
||||||
@ -145,6 +145,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
|||||||
case enter_pred:
|
case enter_pred:
|
||||||
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
||||||
arity = pred->ArityOfPE;
|
arity = pred->ArityOfPE;
|
||||||
|
if (arity == 0)
|
||||||
|
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
|
||||||
|
else
|
||||||
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
||||||
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
||||||
return; */
|
return; */
|
||||||
@ -165,7 +168,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
|||||||
} else {
|
} else {
|
||||||
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
||||||
arity = pred->ArityOfPE;
|
arity = pred->ArityOfPE;
|
||||||
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
if (arity == 0)
|
||||||
|
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
|
||||||
|
else
|
||||||
|
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
||||||
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
||||||
return; */
|
return; */
|
||||||
send_tracer_message("RETRY PRODUCER: ", s, 0, mname, NULL);
|
send_tracer_message("RETRY PRODUCER: ", s, 0, mname, NULL);
|
||||||
@ -179,7 +185,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
|||||||
} else {
|
} else {
|
||||||
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
||||||
arity = pred->ArityOfPE;
|
arity = pred->ArityOfPE;
|
||||||
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
if (arity == 0)
|
||||||
|
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
|
||||||
|
else
|
||||||
|
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
||||||
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
||||||
return; */
|
return; */
|
||||||
send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL);
|
send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL);
|
||||||
@ -188,7 +197,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
|
|||||||
case retry_pred:
|
case retry_pred:
|
||||||
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
|
||||||
arity = pred->ArityOfPE;
|
arity = pred->ArityOfPE;
|
||||||
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
if (arity == 0)
|
||||||
|
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
|
||||||
|
else
|
||||||
|
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
|
||||||
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
|
||||||
return; */
|
return; */
|
||||||
send_tracer_message("FAIL ", NULL, 0, NULL, args);
|
send_tracer_message("FAIL ", NULL, 0, NULL, args);
|
||||||
|
@ -690,9 +690,9 @@ p_softfunctor()
|
|||||||
WRITE_LOCK(RepAtom(a)->ARWLock);
|
WRITE_LOCK(RepAtom(a)->ARWLock);
|
||||||
if ((p0 = GetAProp(a, SFProperty)) == NIL) {
|
if ((p0 = GetAProp(a, SFProperty)) == NIL) {
|
||||||
pe = (SFEntry *) AllocAtomSpace(sizeof(*pe));
|
pe = (SFEntry *) AllocAtomSpace(sizeof(*pe));
|
||||||
pe->NextOfPE = RepAtom(a)->PropOfAE;
|
pe->NextOfPE = RepAtom(a)->PropsOfAE;
|
||||||
pe->KindOfPE = SFProperty;
|
pe->KindOfPE = SFProperty;
|
||||||
RepAtom(a)->PropOfAE = AbsSFProp(pe);
|
RepAtom(a)->PropsOfAE = AbsSFProp(pe);
|
||||||
} else
|
} else
|
||||||
pe = RepSFProp(p0);
|
pe = RepSFProp(p0);
|
||||||
WRITE_UNLOCK(RepAtom(a)->ARWLock);
|
WRITE_UNLOCK(RepAtom(a)->ARWLock);
|
||||||
|
13
H/Heap.h
13
H/Heap.h
@ -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.9 2001-10-03 13:39:14 vsc Exp $ *
|
* version: $Id: Heap.h,v 1.10 2001-10-30 16:42:05 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
/* information that can be stored in Code Space */
|
/* information that can be stored in Code Space */
|
||||||
@ -99,9 +99,9 @@ typedef struct various_codes {
|
|||||||
#endif
|
#endif
|
||||||
CELL *wake_up_code;
|
CELL *wake_up_code;
|
||||||
#endif
|
#endif
|
||||||
CELL *creep_code;
|
struct pred_entry *creep_code;
|
||||||
CELL *undef_code;
|
struct pred_entry *undef_code;
|
||||||
CELL *spy_code;
|
struct pred_entry *spy_code;
|
||||||
int profiling;
|
int profiling;
|
||||||
AtomHashEntry invisiblechain;
|
AtomHashEntry invisiblechain;
|
||||||
OPCODE dummycode;
|
OPCODE dummycode;
|
||||||
@ -227,6 +227,7 @@ typedef struct various_codes {
|
|||||||
functor_csult,
|
functor_csult,
|
||||||
functor_cut_by,
|
functor_cut_by,
|
||||||
functor_eq,
|
functor_eq,
|
||||||
|
functor_execute_in_mod,
|
||||||
functor_g_atom,
|
functor_g_atom,
|
||||||
functor_g_atomic,
|
functor_g_atomic,
|
||||||
functor_g_compound,
|
functor_g_compound,
|
||||||
@ -259,6 +260,7 @@ typedef struct various_codes {
|
|||||||
#ifdef EUROTRA
|
#ifdef EUROTRA
|
||||||
term_dollar_u,
|
term_dollar_u,
|
||||||
#endif
|
#endif
|
||||||
|
term_prolog,
|
||||||
term_refound_var;
|
term_refound_var;
|
||||||
void *last_wtime;
|
void *last_wtime;
|
||||||
PredEntry *pred_goal_expansion;
|
PredEntry *pred_goal_expansion;
|
||||||
@ -291,6 +293,7 @@ typedef struct various_codes {
|
|||||||
#define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode ))
|
#define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode ))
|
||||||
#endif /* TABLING */
|
#endif /* TABLING */
|
||||||
#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 ))
|
||||||
#define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode ))
|
#define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode ))
|
||||||
#define YESCODE ((CODEADDR)&(heap_regs->yescode ))
|
#define YESCODE ((CODEADDR)&(heap_regs->yescode ))
|
||||||
@ -412,6 +415,7 @@ typedef struct various_codes {
|
|||||||
#define FunctorCsult heap_regs->functor_csult
|
#define FunctorCsult heap_regs->functor_csult
|
||||||
#define FunctorCutBy heap_regs->functor_cut_by
|
#define FunctorCutBy heap_regs->functor_cut_by
|
||||||
#define FunctorEq heap_regs->functor_eq
|
#define FunctorEq heap_regs->functor_eq
|
||||||
|
#define FunctorExecuteInMod heap_regs->functor_execute_in_mod
|
||||||
#define FunctorGAtom heap_regs->functor_g_atom
|
#define FunctorGAtom heap_regs->functor_g_atom
|
||||||
#define FunctorGAtomic heap_regs->functor_g_atomic
|
#define FunctorGAtomic heap_regs->functor_g_atomic
|
||||||
#define FunctorGCompound heap_regs->functor_g_compound
|
#define FunctorGCompound heap_regs->functor_g_compound
|
||||||
@ -441,6 +445,7 @@ typedef struct various_codes {
|
|||||||
#define FunctorVBar heap_regs->functor_v_bar
|
#define FunctorVBar heap_regs->functor_v_bar
|
||||||
#define FunctorVar heap_regs->functor_var
|
#define FunctorVar heap_regs->functor_var
|
||||||
#define TermDollarU heap_regs->term_dollar_u
|
#define TermDollarU heap_regs->term_dollar_u
|
||||||
|
#define TermProlog heap_regs->term_prolog
|
||||||
#define TermReFoundVar heap_regs->term_refound_var
|
#define TermReFoundVar heap_regs->term_refound_var
|
||||||
#define PredGoalExpansion heap_regs->pred_goal_expansion
|
#define PredGoalExpansion heap_regs->pred_goal_expansion
|
||||||
#define PredMetaCall heap_regs->pred_meta_call
|
#define PredMetaCall heap_regs->pred_meta_call
|
||||||
|
@ -353,5 +353,6 @@
|
|||||||
OPCODE(p_func2f_xx ,xxx),
|
OPCODE(p_func2f_xx ,xxx),
|
||||||
OPCODE(p_func2f_xy ,xyx),
|
OPCODE(p_func2f_xy ,xyx),
|
||||||
OPCODE(p_func2f_yx ,yxx),
|
OPCODE(p_func2f_yx ,yxx),
|
||||||
OPCODE(p_func2f_yy ,yyx)
|
OPCODE(p_func2f_yy ,yyx),
|
||||||
|
OPCODE(p_execute ,sla)
|
||||||
|
|
||||||
|
16
H/Yapproto.h
16
H/Yapproto.h
@ -10,7 +10,7 @@
|
|||||||
* File: Yap.proto *
|
* File: Yap.proto *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: Function declarations for YAP *
|
* comments: Function declarations for YAP *
|
||||||
* version: $Id: Yapproto.h,v 1.3 2001-10-03 13:39:14 vsc Exp $ *
|
* version: $Id: Yapproto.h,v 1.4 2001-10-30 16:42:05 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
/* prototype file for Yap */
|
/* prototype file for Yap */
|
||||||
@ -36,6 +36,8 @@ Atom STD_PROTO(LookupAtom,(char *));
|
|||||||
Atom STD_PROTO(FullLookupAtom,(char *));
|
Atom STD_PROTO(FullLookupAtom,(char *));
|
||||||
void STD_PROTO(LookupAtomWithAddress,(char *,AtomEntry *));
|
void STD_PROTO(LookupAtomWithAddress,(char *,AtomEntry *));
|
||||||
Term STD_PROTO(MkApplTerm,(Functor,unsigned int,Term *));
|
Term STD_PROTO(MkApplTerm,(Functor,unsigned int,Term *));
|
||||||
|
Prop STD_PROTO(NewPredPropByFunctor,(struct FunctorEntryStruct *, Term));
|
||||||
|
Prop STD_PROTO(NewPredPropByAtom,(struct AtomEntryStruct *, Term));
|
||||||
Functor STD_PROTO(UnlockedMkFunctor,(AtomEntry *,unsigned int));
|
Functor STD_PROTO(UnlockedMkFunctor,(AtomEntry *,unsigned int));
|
||||||
Functor STD_PROTO(MkFunctor,(Atom,unsigned int));
|
Functor STD_PROTO(MkFunctor,(Atom,unsigned int));
|
||||||
void STD_PROTO(MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
|
void STD_PROTO(MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
|
||||||
@ -52,10 +54,11 @@ CELL STD_PROTO(*ArgsOfSFTerm,(Term));
|
|||||||
|
|
||||||
int STD_PROTO(LookupModule,(Term));
|
int STD_PROTO(LookupModule,(Term));
|
||||||
Prop STD_PROTO(GetPredProp,(Atom,unsigned int));
|
Prop STD_PROTO(GetPredProp,(Atom,unsigned int));
|
||||||
Prop STD_PROTO(GetPredPropByFunc,(Functor));
|
Prop STD_PROTO(GetPredPropByAtom,(Atom, Term));
|
||||||
Prop STD_PROTO(LockedGetPredProp,(Atom,unsigned int));
|
Prop STD_PROTO(GetPredPropByFunc,(Functor, Term));
|
||||||
|
Prop STD_PROTO(GetPredPropHavingLock,(Atom,unsigned int));
|
||||||
Prop STD_PROTO(GetExpProp,(Atom,unsigned int));
|
Prop STD_PROTO(GetExpProp,(Atom,unsigned int));
|
||||||
Prop STD_PROTO(LockedGetExpProp,(AtomEntry *,unsigned int));
|
Prop STD_PROTO(GetExpPropHavingLock,(AtomEntry *,unsigned int));
|
||||||
Term STD_PROTO(Module_Name, (CODEADDR));
|
Term STD_PROTO(Module_Name, (CODEADDR));
|
||||||
|
|
||||||
|
|
||||||
@ -146,10 +149,11 @@ void STD_PROTO(InitEval,(void));
|
|||||||
Int STD_PROTO(EvFArt,(Term));
|
Int STD_PROTO(EvFArt,(Term));
|
||||||
|
|
||||||
/* exec.c */
|
/* exec.c */
|
||||||
|
Term STD_PROTO(ExecuteCallMetaCall,(void));
|
||||||
|
void STD_PROTO(InitExecFs,(void));
|
||||||
|
int STD_PROTO(RunTopGoal,(Term));
|
||||||
Int STD_PROTO(execute_goal,(Term, int));
|
Int STD_PROTO(execute_goal,(Term, int));
|
||||||
int STD_PROTO(exec_absmi,(int));
|
int STD_PROTO(exec_absmi,(int));
|
||||||
int STD_PROTO(RunTopGoal,(Term));
|
|
||||||
void STD_PROTO(InitExecFs,(void));
|
|
||||||
|
|
||||||
|
|
||||||
/* grow.c */
|
/* grow.c */
|
||||||
|
@ -151,7 +151,7 @@ int STD_PROTO(iequ_complex, (CELL *, CELL *,CELL *));
|
|||||||
|
|
||||||
#ifdef ANALYST
|
#ifdef ANALYST
|
||||||
|
|
||||||
static char *op_names[_std_top + 1] =
|
static char *op_names[_p_execute + 1] =
|
||||||
{
|
{
|
||||||
#define OPCODE(OP,TYPE) #OP
|
#define OPCODE(OP,TYPE) #OP
|
||||||
#include "YapOpcodes.h"
|
#include "YapOpcodes.h"
|
||||||
|
2
H/eval.h
2
H/eval.h
@ -34,7 +34,7 @@
|
|||||||
#ifdef LONG_MIN
|
#ifdef LONG_MIN
|
||||||
#define Int_MIN LONG_MIN
|
#define Int_MIN LONG_MIN
|
||||||
#else
|
#else
|
||||||
#define Int_MIN (-CELL_MAX-(CELL)1)
|
#define Int_MIN (-Int_MAX-(CELL)1)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
typedef union arith_ret {
|
typedef union arith_ret {
|
||||||
|
@ -16,6 +16,7 @@
|
|||||||
|
|
||||||
<h2>Yap-4.3.20:</h2>
|
<h2>Yap-4.3.20:</h2>
|
||||||
<ul>
|
<ul>
|
||||||
|
<li>CLEANUP: don't use state of Pred.</li>
|
||||||
<li>SPEEDUP: improve predicate access by linking predicates to
|
<li>SPEEDUP: improve predicate access by linking predicates to
|
||||||
functors.</li>
|
functors.</li>
|
||||||
<li>FIXED: listing broke when current_predicate became meta.</li>
|
<li>FIXED: listing broke when current_predicate became meta.</li>
|
||||||
|
@ -41,7 +41,7 @@ typedef struct PropEntryStruct *Prop;
|
|||||||
/* atom structure */
|
/* atom structure */
|
||||||
typedef struct AtomEntryStruct {
|
typedef struct AtomEntryStruct {
|
||||||
Atom NextOfAE; /* used to build hash chains */
|
Atom NextOfAE; /* used to build hash chains */
|
||||||
Prop PropOfAE; /* property list for this atom */
|
Prop PropsOfAE; /* property list for this atom */
|
||||||
#if defined(YAPOR) || defined(THREADS)
|
#if defined(YAPOR) || defined(THREADS)
|
||||||
rwlock_t ARWLock;
|
rwlock_t ARWLock;
|
||||||
#endif
|
#endif
|
||||||
|
138
m4/Yatom.h.m4
138
m4/Yatom.h.m4
@ -202,24 +202,24 @@ typedef struct {
|
|||||||
typedef struct pred_entry {
|
typedef struct pred_entry {
|
||||||
Prop NextOfPE; /* used to chain properties */
|
Prop NextOfPE; /* used to chain properties */
|
||||||
PropFlags KindOfPE; /* kind of property */
|
PropFlags KindOfPE; /* kind of property */
|
||||||
unsigned int ArityOfPE; /* arity of property */
|
unsigned int ArityOfPE; /* arity of property */
|
||||||
SMALLUNSGN StateOfPred; /* actual state of predicate */
|
Term ModuleOfPred; /* module for this definition */
|
||||||
|
CELL PredFlags;
|
||||||
CODEADDR CodeOfPred; /* code address */
|
CODEADDR CodeOfPred; /* code address */
|
||||||
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */
|
CODEADDR TrueCodeOfPred; /* if needing to spy or to lock */
|
||||||
Functor FunctorOfPred; /* functor for Predicate */
|
Functor FunctorOfPred; /* functor for Predicate */
|
||||||
CODEADDR FirstClause, LastClause;
|
CODEADDR FirstClause, LastClause;
|
||||||
CELL PredFlags;
|
Atom OwnerFile; /* File where the predicate was defined */
|
||||||
Atom OwnerFile; /* File where the predicate was defined */
|
|
||||||
struct pred_entry *NextPredOfModule; /* next pred for same module */
|
struct pred_entry *NextPredOfModule; /* next pred for same module */
|
||||||
#if defined(YAPOR) || defined(THREADS)
|
#if defined(YAPOR) || defined(THREADS)
|
||||||
rwlock_t PRWLock; /* a simple lock to protect this entry */
|
rwlock_t PRWLock; /* a simple lock to protect this entry */
|
||||||
#endif
|
#endif
|
||||||
#ifdef TABLING
|
#ifdef TABLING
|
||||||
tab_ent_ptr TableOfPred;
|
tab_ent_ptr TableOfPred;
|
||||||
#endif /* TABLING */
|
#endif /* TABLING */
|
||||||
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
|
OPCODE OpcodeOfPred; /* undefcode, indexcode, spycode, .... */
|
||||||
profile_data StatisticsForPred; /* enable profiling for predicate */
|
profile_data StatisticsForPred; /* enable profiling for predicate */
|
||||||
SMALLUNSGN ModuleOfPred; /* module for this definition */
|
SMALLUNSGN StateOfPred; /* actual state of predicate */
|
||||||
} PredEntry;
|
} PredEntry;
|
||||||
#define PEProp ((PropFlags)(0x0000))
|
#define PEProp ((PropFlags)(0x0000))
|
||||||
|
|
||||||
@ -493,86 +493,52 @@ CODEADDR STD_PROTO(PredIsIndexable,(PredEntry *));
|
|||||||
/* init.c */
|
/* init.c */
|
||||||
Atom STD_PROTO(GetOp,(OpEntry *,int *,int));
|
Atom STD_PROTO(GetOp,(OpEntry *,int *,int));
|
||||||
|
|
||||||
#ifdef XX_ADTDEFS_C
|
|
||||||
#ifndef inline
|
|
||||||
|
|
||||||
/* look property list of atom a for kind */
|
|
||||||
EXTERN inline Prop GetAProp(a,kind)
|
|
||||||
Atom a;
|
|
||||||
PropFlags kind;
|
|
||||||
{ register PropEntry *pp = RepProp(RepAtom(a)->PropOfAE);
|
|
||||||
while( !EndOfPAEntr(pp) && pp->KindOfPE!=kind) pp=RepProp(pp->NextOfPE);
|
|
||||||
return(AbsProp(pp));
|
|
||||||
}
|
|
||||||
|
|
||||||
/* get predicate entry for ap/arity; create it if neccessary. */
|
|
||||||
EXTERN inline Prop PredProp(ap,arity)
|
|
||||||
Atom ap;
|
|
||||||
unsigned int arity;
|
|
||||||
{
|
|
||||||
Prop p0;
|
|
||||||
PredEntry *p = RepPredProp(p0=RepAtom(ap)->PropOfAE);
|
|
||||||
while(p0 && (p->KindOfPE != 00 || p->ArityOfPE != arity ||
|
|
||||||
(p->ModuleOfPred && p->ModuleOfPred != CurrentModule)))
|
|
||||||
p = RepPredProp(p0=p->NextOfPE);
|
|
||||||
if(p0) return(p0);
|
|
||||||
YAPEnterCriticalSection();
|
|
||||||
p = (PredEntry *) AllocAtomSpace(sizeof(*p));
|
|
||||||
p->KindOfPE = PEProp;
|
|
||||||
p->ArityOfPE = arity;
|
|
||||||
p->FirstClause = p->LastClause = NIL;
|
|
||||||
p->PredFlags = 0L;
|
|
||||||
p->StateOfPred = 0;
|
|
||||||
p->OwnerFile = AtomNil;
|
|
||||||
p->ModuleOfPred = CurrentModule;
|
|
||||||
p->OpcodeOfPred = opcode(_undef_p);
|
|
||||||
p->StatisticsForPred.NOfEntries = 0;
|
|
||||||
p->StatisticsForPred.NOfHeadSuccesses = 0;
|
|
||||||
p->StatisticsForPred.NOfRetries = 0;
|
|
||||||
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->DefaultCodeOfPred));
|
|
||||||
if (arity==0) p->FunctorOfPred = (Functor) ap;
|
|
||||||
else p->FunctorOfPred = MkFunctor(ap,arity);
|
|
||||||
p->NextOfPE = RepAtom(ap)->PropOfAE;
|
|
||||||
RepAtom(ap)->PropOfAE = p0 = AbsPredProp(p);
|
|
||||||
YAPLeaveCriticalSection();
|
|
||||||
return(p0);
|
|
||||||
}
|
|
||||||
|
|
||||||
EXTERN inline Term GetValue(a)
|
|
||||||
Atom a;
|
|
||||||
{
|
|
||||||
Prop p0 = GetAProp(a,ValProperty);
|
|
||||||
if(p0==0) return(MkAtomTerm(AtomNil));
|
|
||||||
return(RepValProp(p0)->ValueOfVE);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
EXTERN inline void PutValue(a,v)
|
|
||||||
Atom a; Term v;
|
|
||||||
{
|
|
||||||
Prop p0 = GetAProp(a,ValProperty);
|
|
||||||
if(p0) RepValProp(p0)->ValueOfVE = v;
|
|
||||||
else {
|
|
||||||
ValEntry *p;
|
|
||||||
YAPEnterCriticalSection();
|
|
||||||
p = (ValEntry *) AllocAtomSpace(sizeof(ValEntry));
|
|
||||||
p->KindOfPE = ValProperty;
|
|
||||||
p->ValueOfVE = v;
|
|
||||||
p->NextOfPE = RepAtom(a)->PropOfAE;
|
|
||||||
RepAtom(a)->PropOfAE = AbsValProp(p);
|
|
||||||
YAPLeaveCriticalSection();
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
#endif /* inline */
|
|
||||||
#else
|
|
||||||
/* vsc: redefined to GetAProp to avoid conflicts with Windows header files */
|
/* vsc: redefined to GetAProp to avoid conflicts with Windows header files */
|
||||||
Prop STD_PROTO(GetAProp,(Atom,PropFlags));
|
Prop STD_PROTO(GetAProp,(Atom,PropFlags));
|
||||||
Prop STD_PROTO(LockedGetAProp,(AtomEntry *,PropFlags));
|
Prop STD_PROTO(GetAPropHavingLock,(AtomEntry *,PropFlags));
|
||||||
Prop STD_PROTO(PredProp,(Atom,unsigned int));
|
Prop STD_PROTO(PredProp,(Atom,unsigned int));
|
||||||
Prop STD_PROTO(PredPropByFunc,(Functor));
|
|
||||||
#endif /* ADTDEFS_C */
|
|
||||||
|
|
||||||
|
EXTERN inline Prop
|
||||||
|
PredPropByFunc(Functor f, Term cur_mod)
|
||||||
|
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||||
|
{
|
||||||
|
Prop p0;
|
||||||
|
FunctorEntry *fe = (FunctorEntry *)f;
|
||||||
|
|
||||||
|
WRITE_LOCK(fe->FRWLock);
|
||||||
|
p0 = fe->PropsOfFE;
|
||||||
|
while (p0) {
|
||||||
|
PredEntry *p = RepPredProp(p0);
|
||||||
|
if (/* p->KindOfPE != 0 || only props */
|
||||||
|
(p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) {
|
||||||
|
WRITE_UNLOCK(f->FRWLock);
|
||||||
|
return (p0);
|
||||||
|
}
|
||||||
|
p0 = p->NextOfPE;
|
||||||
|
}
|
||||||
|
return(NewPredPropByFunctor(fe,cur_mod));
|
||||||
|
}
|
||||||
|
|
||||||
|
EXTERN inline Prop
|
||||||
|
PredPropByAtom(Atom at, Term cur_mod)
|
||||||
|
/* get predicate entry for ap/arity; create it if neccessary. */
|
||||||
|
{
|
||||||
|
Prop p0;
|
||||||
|
AtomEntry *ae = RepAtom(at);
|
||||||
|
|
||||||
|
WRITE_LOCK(ae->ARWLock);
|
||||||
|
p0 = ae->PropsOfAE;
|
||||||
|
while (p0) {
|
||||||
|
PredEntry *pe = RepPredProp(p0);
|
||||||
|
if ( pe->KindOfPE == PEProp &&
|
||||||
|
(pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) {
|
||||||
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
|
return(p0);
|
||||||
|
}
|
||||||
|
p0 = pe->NextOfPE;
|
||||||
|
}
|
||||||
|
return(NewPredPropByAtom(ae,cur_mod));
|
||||||
|
}
|
||||||
|
|
||||||
#if defined(YAPOR) || defined(THREADS)
|
#if defined(YAPOR) || defined(THREADS)
|
||||||
void STD_PROTO(ReleasePreAllocCodeSpace, (ADDR));
|
void STD_PROTO(ReleasePreAllocCodeSpace, (ADDR));
|
||||||
|
12
pl/arith.yap
12
pl/arith.yap
@ -36,11 +36,20 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
|
|||||||
'$c_built_in'(IN, IN).
|
'$c_built_in'(IN, IN).
|
||||||
|
|
||||||
|
|
||||||
|
'$do_c_built_in'(Mod:G, Mod:GN) :- !,
|
||||||
|
'$do_c_built_in'(G, GN).
|
||||||
'$do_c_built_in'(\+ G, OUT) :-
|
'$do_c_built_in'(\+ G, OUT) :-
|
||||||
nonvar(G),
|
nonvar(G),
|
||||||
G = (A = B),
|
G = (A = B),
|
||||||
!,
|
!,
|
||||||
OUT = (A \= B).
|
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).
|
||||||
'$do_c_built_in'(recorded(K,T,R), OUT) :-
|
'$do_c_built_in'(recorded(K,T,R), OUT) :-
|
||||||
nonvar(K),
|
nonvar(K),
|
||||||
!,
|
!,
|
||||||
@ -153,8 +162,7 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
|
|||||||
'$expand_expr'(/\, X, Y, O, Q, P) :- !,
|
'$expand_expr'(/\, X, Y, O, Q, P) :- !,
|
||||||
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
|
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
|
||||||
'$do_and'(E, '$and'(X1,Y1,O), F),
|
'$do_and'(E, '$and'(X1,Y1,O), F),
|
||||||
'$do_and'(Q, F, P),
|
'$do_and'(Q, F, P).
|
||||||
'$do_and'(Q, '$and'(X,Y,O), P).
|
|
||||||
'$expand_expr'(\/, X, Y, O, Q, P) :- !,
|
'$expand_expr'(\/, X, Y, O, Q, P) :- !,
|
||||||
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
|
'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
|
||||||
'$do_and'(E, '$or'(X1,Y1,O), F),
|
'$do_and'(E, '$or'(X1,Y1,O), F),
|
||||||
|
28
pl/boot.yap
28
pl/boot.yap
@ -641,13 +641,35 @@ incore(G) :- '$execute'(G).
|
|||||||
'$iso_check_goal'(G,G0),
|
'$iso_check_goal'(G,G0),
|
||||||
'$call'(G, CP,G0).
|
'$call'(G, CP,G0).
|
||||||
|
|
||||||
|
|
||||||
|
','(A,B) :-
|
||||||
|
'$execute_within'(A),
|
||||||
|
'$execute_within'(B).
|
||||||
|
|
||||||
|
';'(A,B) :-
|
||||||
|
( '$execute_within'(A) ;
|
||||||
|
'$execute_within'(B) ).
|
||||||
|
|
||||||
|
'|'(A,B) :-
|
||||||
|
( '$execute_within'(A) ;
|
||||||
|
'$execute_within'(B) ).
|
||||||
|
|
||||||
|
'->'(A,B) :-
|
||||||
|
( '$execute_within'(A) ->
|
||||||
|
'$execute_within'(B) ).
|
||||||
|
|
||||||
|
\+(A) :-
|
||||||
|
\+ '$execute_within'(A).
|
||||||
|
|
||||||
|
not(A) :-
|
||||||
|
\+ '$execute_within'(A).
|
||||||
|
|
||||||
|
Mod:G :- '$mod_switch'(Mod,'$execute_within'(G)).
|
||||||
|
|
||||||
'$call'(M:_,_,G0) :- var(M), !,
|
'$call'(M:_,_,G0) :- var(M), !,
|
||||||
throw(error(instantiation_error,call(G0))).
|
throw(error(instantiation_error,call(G0))).
|
||||||
'$call'(M:G,CP,G0) :- !,
|
'$call'(M:G,CP,G0) :- !,
|
||||||
'$mod_switch'(M,'$call'(G,CP,G0)).
|
'$mod_switch'(M,'$call'(G,CP,G0)).
|
||||||
'$call'((A,B),CP,G0) :- !,
|
|
||||||
'$execute_within'(A,CP,G0),
|
|
||||||
'$execute_within'(B,CP,G0).
|
|
||||||
'$call'((X->Y),CP,G0) :- !,
|
'$call'((X->Y),CP,G0) :- !,
|
||||||
(
|
(
|
||||||
'$execute_within'(X,CP,G0)
|
'$execute_within'(X,CP,G0)
|
||||||
|
@ -35,7 +35,7 @@ style_check([]).
|
|||||||
style_check([H|T]) :- style_check(H), style_check(T).
|
style_check([H|T]) :- style_check(H), style_check(T).
|
||||||
|
|
||||||
no_style_check(V) :- var(V), !, fail.
|
no_style_check(V) :- var(V), !, fail.
|
||||||
no_style_check(all) :- $syntax_check_mode(_,off),
|
no_style_check(all) :- '$syntax_check_mode'(_,off),
|
||||||
'$syntax_check_single_var'(_,off),
|
'$syntax_check_single_var'(_,off),
|
||||||
'$syntax_check_discontiguous'(_,off),
|
'$syntax_check_discontiguous'(_,off),
|
||||||
'$syntax_check_multiple'(_,off).
|
'$syntax_check_multiple'(_,off).
|
||||||
@ -98,10 +98,10 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
|
|||||||
'$sv_list'(T,L).
|
'$sv_list'(T,L).
|
||||||
|
|
||||||
|
|
||||||
$sv_warning([],_) :- !.
|
'$sv_warning'([],_) :- !.
|
||||||
$sv_warning(SVs,T) :-
|
'$sv_warning'(SVs,T) :-
|
||||||
'$xtract_head'(T,H,Name,Arity),
|
'$xtract_head'(T,H,Name,Arity),
|
||||||
write(user_error,'[ Warning: singleton variable '),
|
write(user_error,'[ Warning: singleton variable'),
|
||||||
'$write_svs'(SVs),
|
'$write_svs'(SVs),
|
||||||
write(user_error,' in '),
|
write(user_error,' in '),
|
||||||
write(user_error,Name/Arity),
|
write(user_error,Name/Arity),
|
||||||
@ -123,7 +123,7 @@ $sv_warning(SVs,T) :-
|
|||||||
'$xtract_head'((H,_),H1,Name,Arity) :- !,
|
'$xtract_head'((H,_),H1,Name,Arity) :- !,
|
||||||
'$xtract_head'(H,H1,Name,Arity).
|
'$xtract_head'(H,H1,Name,Arity).
|
||||||
'$xtract_head'((H-->_),HL,Name,Arity) :- !,
|
'$xtract_head'((H-->_),HL,Name,Arity) :- !,
|
||||||
'$xtract_head'(H,H1,Name,A1),
|
'$xtract_head'(H,_,Name,A1),
|
||||||
Arity is A1+2,
|
Arity is A1+2,
|
||||||
functor(HL,Name,Arity).
|
functor(HL,Name,Arity).
|
||||||
'$xtract_head'(H,H,Name,Arity) :-
|
'$xtract_head'(H,H,Name,Arity) :-
|
||||||
@ -158,7 +158,7 @@ $sv_warning(SVs,T) :-
|
|||||||
|
|
||||||
'$handle_multiple'(F,A) :-
|
'$handle_multiple'(F,A) :-
|
||||||
\+ '$first_clause_in_file'(F,A), !.
|
\+ '$first_clause_in_file'(F,A), !.
|
||||||
'$handle_multiple'(F,A) :-
|
'$handle_multiple'(_,_) :-
|
||||||
'$get_value'('$consulting',true), !.
|
'$get_value'('$consulting',true), !.
|
||||||
'$handle_multiple'(F,A) :-
|
'$handle_multiple'(F,A) :-
|
||||||
'$current_module'(M),
|
'$current_module'(M),
|
||||||
|
@ -28,9 +28,9 @@ ensure_loaded(V) :-
|
|||||||
'$find_in_path'(X,Y),
|
'$find_in_path'(X,Y),
|
||||||
( open(Y,'$csult',Stream), !,
|
( open(Y,'$csult',Stream), !,
|
||||||
( '$loaded'(Stream) ->
|
( '$loaded'(Stream) ->
|
||||||
( $consulting_file_name(Stream,TFN),
|
( '$consulting_file_name'(Stream,TFN),
|
||||||
'$recorded'('$module','$module'(TFN,M,P),_) ->
|
'$recorded'('$module','$module'(TFN,M,P),_) ->
|
||||||
$current_module(T), '$import'(P,M,T)
|
'$current_module'(T), '$import'(P,M,T)
|
||||||
;
|
;
|
||||||
true
|
true
|
||||||
)
|
)
|
||||||
@ -51,7 +51,7 @@ ensure_loaded(V) :-
|
|||||||
( '$loaded'(Stream) ->
|
( '$loaded'(Stream) ->
|
||||||
( '$consulting_file_name'(Stream,TFN),
|
( '$consulting_file_name'(Stream,TFN),
|
||||||
'$recorded'('$module','$module'(TFN,M,P),_) ->
|
'$recorded'('$module','$module'(TFN,M,P),_) ->
|
||||||
'$current_module'(T), $import(P,M,T)
|
'$current_module'(T), '$import'(P,M,T)
|
||||||
;
|
;
|
||||||
true
|
true
|
||||||
)
|
)
|
||||||
@ -158,9 +158,9 @@ reconsult(Fs) :-
|
|||||||
'EMACS_FILE'(F,File0) :-
|
'EMACS_FILE'(F,File0) :-
|
||||||
format('''EMACS_RECONSULT''(~w).~n',[File0]),
|
format('''EMACS_RECONSULT''(~w).~n',[File0]),
|
||||||
'$getcwd'(OldD),
|
'$getcwd'(OldD),
|
||||||
open(F,$csult,Stream),
|
open(F,'$csult',Stream),
|
||||||
'$find_in_path'(File0,File),
|
'$find_in_path'(File0,File),
|
||||||
open(File,$csult,Stream0),
|
open(File,'$csult',Stream0),
|
||||||
'$get_value'('$consulting_file',OldF),
|
'$get_value'('$consulting_file',OldF),
|
||||||
'$set_consulting_file'(Stream0),
|
'$set_consulting_file'(Stream0),
|
||||||
H0 is heapused, T0 is cputime,
|
H0 is heapused, T0 is cputime,
|
||||||
@ -177,7 +177,7 @@ reconsult(Fs) :-
|
|||||||
'$end_consult',
|
'$end_consult',
|
||||||
'$clear_reconsulting',
|
'$clear_reconsulting',
|
||||||
( LC == 0 -> prompt(_,' |: ') ; true),
|
( LC == 0 -> prompt(_,' |: ') ; true),
|
||||||
( '$get_value'($verbose,on) ->
|
( '$get_value'('$verbose',on) ->
|
||||||
tab(user_error,LC) ;
|
tab(user_error,LC) ;
|
||||||
true ),
|
true ),
|
||||||
H is heapused-H0, T is cputime-T0,
|
H is heapused-H0, T is cputime-T0,
|
||||||
@ -243,10 +243,10 @@ reconsult(Fs) :-
|
|||||||
'$peek_byte'(Stream, 0'#), !, % 35 is ASCII for #
|
'$peek_byte'(Stream, 0'#), !, % 35 is ASCII for #
|
||||||
'$get0_line_codes'(Stream, _),
|
'$get0_line_codes'(Stream, _),
|
||||||
'$skip_unix_comments'(Stream).
|
'$skip_unix_comments'(Stream).
|
||||||
'$skip_unix_comments'(Stream).
|
'$skip_unix_comments'(_).
|
||||||
|
|
||||||
|
|
||||||
prolog_load_context(_, X) :-
|
prolog_load_context(_, _) :-
|
||||||
'$get_value'('$consulting_file',[]), !, fail.
|
'$get_value'('$consulting_file',[]), !, fail.
|
||||||
prolog_load_context(directory, DirName) :-
|
prolog_load_context(directory, DirName) :-
|
||||||
'$get_value'('$consulting_file',FileName),
|
'$get_value'('$consulting_file',FileName),
|
||||||
|
@ -116,7 +116,7 @@ freeze(_, G) :-
|
|||||||
'$freeze_goal'(V,VG) :-
|
'$freeze_goal'(V,VG) :-
|
||||||
var(VG), !,
|
var(VG), !,
|
||||||
'$current_module'(M),
|
'$current_module'(M),
|
||||||
'$freeze'(V, '$redo_freeze'(_Done,V,M:G)).
|
'$freeze'(V, '$redo_freeze'(_Done,V,M:VG)).
|
||||||
'$freeze_goal'(V,M:G) :- !,
|
'$freeze_goal'(V,M:G) :- !,
|
||||||
'$freeze'(V, '$redo_freeze'(_Done,V,M:G)).
|
'$freeze'(V, '$redo_freeze'(_Done,V,M:G)).
|
||||||
'$freeze_goal'(V,G) :-
|
'$freeze_goal'(V,G) :-
|
||||||
@ -161,7 +161,7 @@ freeze(_, G) :-
|
|||||||
%
|
%
|
||||||
dif(X, Y) :- '$can_unify'(X, Y, LVars), !,
|
dif(X, Y) :- '$can_unify'(X, Y, LVars), !,
|
||||||
LVars = [_|_],
|
LVars = [_|_],
|
||||||
'$dif_suspend_on_lvars'(LVars, '$redo_dif'(Done, X, Y)).
|
'$dif_suspend_on_lvars'(LVars, '$redo_dif'(_Done, X, Y)).
|
||||||
dif(_, _).
|
dif(_, _).
|
||||||
|
|
||||||
|
|
||||||
@ -179,8 +179,8 @@ dif(_, _).
|
|||||||
% we try to increase the number of suspensions; last, the two terms
|
% we try to increase the number of suspensions; last, the two terms
|
||||||
% did not unify, we are done, so we succeed and bind the Done variable.
|
% did not unify, we are done, so we succeed and bind the Done variable.
|
||||||
%
|
%
|
||||||
'$redo_dif'(Done, X, Y, G) :- nonvar(Done), !.
|
'$redo_dif'(Done, _, _, _) :- nonvar(Done), !.
|
||||||
'$redo_dif'(Done, X, Y, G) :-
|
'$redo_dif'(_, X, Y, G) :-
|
||||||
'$can_unify'(X, Y, LVars), !,
|
'$can_unify'(X, Y, LVars), !,
|
||||||
LVars = [_|_],
|
LVars = [_|_],
|
||||||
'$dif_suspend_on_lvars'(LVars, G).
|
'$dif_suspend_on_lvars'(LVars, G).
|
||||||
@ -191,7 +191,7 @@ dif(_, _).
|
|||||||
%
|
%
|
||||||
% someone else (that is Cond had ;) did the work, do nothing
|
% someone else (that is Cond had ;) did the work, do nothing
|
||||||
%
|
%
|
||||||
'$redo_freeze'(Done, Goal) :- nonvar(Done), !.
|
'$redo_freeze'(Done, _) :- nonvar(Done), !.
|
||||||
%
|
%
|
||||||
% We still have some more conditions: continue the analysis.
|
% We still have some more conditions: continue the analysis.
|
||||||
%
|
%
|
||||||
@ -208,8 +208,8 @@ dif(_, _).
|
|||||||
|
|
||||||
%
|
%
|
||||||
% eq is a combination of dif and freeze
|
% eq is a combination of dif and freeze
|
||||||
'$redo_eq'(Done, X, Y, Goal, G) :- nonvar(Done), !.
|
'$redo_eq'(Done, _, _, _, _) :- nonvar(Done), !.
|
||||||
'$redo_eq'(Done, X, Y, _, G) :-
|
'$redo_eq'(_, X, Y, _, G) :-
|
||||||
'$can_unify'(X, Y, LVars),
|
'$can_unify'(X, Y, LVars),
|
||||||
LVars = [_|_], !,
|
LVars = [_|_], !,
|
||||||
'$dif_suspend_on_lvars'(LVars, G).
|
'$dif_suspend_on_lvars'(LVars, G).
|
||||||
@ -220,7 +220,7 @@ dif(_, _).
|
|||||||
|
|
||||||
%
|
%
|
||||||
% ground is similar to freeze
|
% ground is similar to freeze
|
||||||
'$redo_ground'(Done, X, Goal) :- nonvar(Done), !.
|
'$redo_ground'(Done, _, _) :- nonvar(Done), !.
|
||||||
'$redo_ground'(Done, X, Goal) :-
|
'$redo_ground'(Done, X, Goal) :-
|
||||||
'$non_ground'(X, Var), !,
|
'$non_ground'(X, Var), !,
|
||||||
'$freeze'(Var, '$redo_ground'(Done, X, Goal)).
|
'$freeze'(Var, '$redo_ground'(Done, X, Goal)).
|
||||||
@ -313,7 +313,7 @@ when(_,Goal) :-
|
|||||||
'$when'(Cond, G, Done, [], LG),
|
'$when'(Cond, G, Done, [], LG),
|
||||||
!,
|
!,
|
||||||
'$suspend_when_goals'(LG, Done).
|
'$suspend_when_goals'(LG, Done).
|
||||||
'$when'(Cond, G, '$done') :-
|
'$when'(_, G, '$done') :-
|
||||||
'$execute'(G).
|
'$execute'(G).
|
||||||
|
|
||||||
%
|
%
|
||||||
@ -360,7 +360,7 @@ when(_,Goal) :-
|
|||||||
'$suspend_when_goals'(['$dif_suspend_on_lvars'(LVars, G)|LG], Done) :-
|
'$suspend_when_goals'(['$dif_suspend_on_lvars'(LVars, G)|LG], Done) :-
|
||||||
var(Done), !,
|
var(Done), !,
|
||||||
'$dif_suspend_on_lvars'(LVars, G),
|
'$dif_suspend_on_lvars'(LVars, G),
|
||||||
'$suspend_when_goals'(Ls, Done).
|
'$suspend_when_goals'(LG, Done).
|
||||||
'$suspend_when_goals'([_|_], _).
|
'$suspend_when_goals'([_|_], _).
|
||||||
|
|
||||||
%
|
%
|
||||||
@ -377,7 +377,7 @@ when(_,Goal) :-
|
|||||||
% significant as the remaining overheads.
|
% significant as the remaining overheads.
|
||||||
%
|
%
|
||||||
'$block'(Conds) :-
|
'$block'(Conds) :-
|
||||||
'$generate_blocking_code'(Conds, G, Code),
|
'$generate_blocking_code'(Conds, _, Code),
|
||||||
'$$compile'(Code, Code, 5), fail.
|
'$$compile'(Code, Code, 5), fail.
|
||||||
'$block'(_).
|
'$block'(_).
|
||||||
|
|
||||||
@ -397,7 +397,7 @@ when(_,Goal) :-
|
|||||||
%
|
%
|
||||||
% find out what we are blocking on.
|
% find out what we are blocking on.
|
||||||
%
|
%
|
||||||
'$extract_head_for_block'((C1, C2), G) :- !,
|
'$extract_head_for_block'((C1, _), G) :- !,
|
||||||
'$extract_head_for_block'(C1, G).
|
'$extract_head_for_block'(C1, G).
|
||||||
'$extract_head_for_block'(C, G) :-
|
'$extract_head_for_block'(C, G) :-
|
||||||
functor(C, Na, Ar),
|
functor(C, Na, Ar),
|
||||||
@ -528,7 +528,7 @@ frozen(V, LG) :-
|
|||||||
'$process_when'(G, NG).
|
'$process_when'(G, NG).
|
||||||
'$process_when'(G, G).
|
'$process_when'(G, G).
|
||||||
|
|
||||||
'$convert_frozen_goal'(V, LV, _, V, Gs) :- '$is_att_variable'(V), !.
|
'$convert_frozen_goal'(V, _, _, V, _) :- '$is_att_variable'(V), !.
|
||||||
'$convert_frozen_goal'('$redo_dif'(Done, X, Y), LV, Done, [X,Y|LV], dif(X,Y)).
|
'$convert_frozen_goal'('$redo_dif'(Done, X, Y), LV, Done, [X,Y|LV], dif(X,Y)).
|
||||||
'$convert_frozen_goal'('$redo_freeze'(Done, FV, G), LV, Done, [FV|LV], G).
|
'$convert_frozen_goal'('$redo_freeze'(Done, FV, G), LV, Done, [FV|LV], G).
|
||||||
'$convert_frozen_goal'('$redo_eq'(Done, X, Y, G), LV, Done, [X,Y|LV], G).
|
'$convert_frozen_goal'('$redo_eq'(Done, X, Y, G), LV, Done, [X,Y|LV], G).
|
||||||
@ -578,9 +578,9 @@ call_residue(Goal,Residue) :-
|
|||||||
'$show_frozen'(Goal,LIV,Residue).
|
'$show_frozen'(Goal,LIV,Residue).
|
||||||
|
|
||||||
'$purge_and_set_done_goals'([], L, L).
|
'$purge_and_set_done_goals'([], L, L).
|
||||||
'$purge_and_set_done_goals'([AttV|G0], [LVars-GS|GF], Atts) :-
|
'$purge_and_set_done_goals'([AttV|G0], [_-GS|GF], Atts) :-
|
||||||
'$is_att_variable'(AttV), !,
|
'$is_att_variable'(AttV), !,
|
||||||
attributes:convert_att_var(AttV, Gs),
|
attributes:convert_att_var(AttV, GS),
|
||||||
'$purge_and_set_done_goals'(G0, GF, Atts).
|
'$purge_and_set_done_goals'(G0, GF, Atts).
|
||||||
'$purge_and_set_done_goals'(['$redo_dif'(Done, X , Y)|G0], [LVars-dif(X,Y)|GF], Atts) :-
|
'$purge_and_set_done_goals'(['$redo_dif'(Done, X , Y)|G0], [LVars-dif(X,Y)|GF], Atts) :-
|
||||||
var(Done),
|
var(Done),
|
||||||
@ -600,15 +600,14 @@ call_residue(Goal,Residue) :-
|
|||||||
var(Done), !,
|
var(Done), !,
|
||||||
Done = '$done',
|
Done = '$done',
|
||||||
'$purge_and_set_done_goals'(G0, GF, Atts).
|
'$purge_and_set_done_goals'(G0, GF, Atts).
|
||||||
'$purge_and_set_done_goals'([G|G0], GF, Atts) :-
|
'$purge_and_set_done_goals'([_|G0], GF, Atts) :-
|
||||||
Done = '$done',
|
|
||||||
'$purge_and_set_done_goals'(G0, GF, Atts).
|
'$purge_and_set_done_goals'(G0, GF, Atts).
|
||||||
|
|
||||||
|
|
||||||
'$project'(true,_,_,Gs,Gs) :- !.
|
'$project'(true,_,_,Gs,Gs) :- !.
|
||||||
'$project'(_,_,_,Gs,Gs) :-
|
'$project'(_,_,_,Gs,Gs) :-
|
||||||
'$undefined'(attributes:modules_with_attributes(_)), !.
|
'$undefined'(attributes:modules_with_attributes(_)), !.
|
||||||
'$project'(G,LIV,LAV,Gs,Gs0) :-
|
'$project'(_,LIV,LAV,Gs,Gs0) :-
|
||||||
attributes:modules_with_attributes(LMods),
|
attributes:modules_with_attributes(LMods),
|
||||||
(LAV = [] ->
|
(LAV = [] ->
|
||||||
Gs = Gs0
|
Gs = Gs0
|
||||||
@ -631,24 +630,24 @@ call_residue(Goal,Residue) :-
|
|||||||
'$execute'(Mod:project_attributes(LIV, LAV)), !,
|
'$execute'(Mod:project_attributes(LIV, LAV)), !,
|
||||||
'$all_attvars'(NLAV),
|
'$all_attvars'(NLAV),
|
||||||
'$project_module'(LMods,LIV,NLAV).
|
'$project_module'(LMods,LIV,NLAV).
|
||||||
'$project_module'([Mod|LMods], LIV, LAV) :-
|
'$project_module'([_|LMods], LIV, LAV) :-
|
||||||
'$project_module'(LMods,LIV,LAV).
|
'$project_module'(LMods,LIV,LAV).
|
||||||
|
|
||||||
'$convert_att_vars'([], LIV, L, L).
|
'$convert_att_vars'([], _, L, L).
|
||||||
'$convert_att_vars'([V|LAV], LIV, NGs, NGs0) :-
|
'$convert_att_vars'([V|LAV], LIV, NGs, NGs0) :-
|
||||||
var(V),
|
var(V),
|
||||||
attributes:convert_att_var(V, G),
|
attributes:convert_att_var(V, G),
|
||||||
G \= true,
|
G \= true,
|
||||||
'$variables_in_term'(G,[],GV0),
|
% '$variables_in_term'(G,[],GV0),
|
||||||
% I'm allowing goals without variables to go through
|
% I'm allowing goals without variables to go through
|
||||||
'$sort'(GV0,GV),
|
% '$sort'(GV0,GV),
|
||||||
% ( GV0 = [] -> true ;
|
% ( GV0 = [] -> true ;
|
||||||
% '$sort'(LIV,NLIV), % notice that ordering changes as we introduce constraints
|
% '$sort'(LIV,NLIV), % notice that ordering changes as we introduce constraints
|
||||||
% '$vars_interset_for_constr'(GV,NLIV) ), !,
|
% '$vars_interset_for_constr'(GV,NLIV) ), !,
|
||||||
!,
|
!,
|
||||||
'$split_goals_for_catv'(G,V,NGs,IGs),
|
'$split_goals_for_catv'(G,V,NGs,IGs),
|
||||||
'$convert_att_vars'(LAV, LIV, IGs, NGs0).
|
'$convert_att_vars'(LAV, LIV, IGs, NGs0).
|
||||||
'$convert_att_vars'([V|LAV], LIV, Gs, NGs0) :-
|
'$convert_att_vars'([_|LAV], LIV, Gs, NGs0) :-
|
||||||
'$convert_att_vars'(LAV, LIV, Gs, NGs0).
|
'$convert_att_vars'(LAV, LIV, Gs, NGs0).
|
||||||
|
|
||||||
'$split_goals_for_catv'((G,NG),V,Gs,Gs0) :- !,
|
'$split_goals_for_catv'((G,NG),V,Gs,Gs0) :- !,
|
||||||
@ -660,7 +659,7 @@ call_residue(Goal,Residue) :-
|
|||||||
'$vars_interset_for_constr'([V1|GV],[V2|LIV]) :-
|
'$vars_interset_for_constr'([V1|GV],[V2|LIV]) :-
|
||||||
V1 @< V2, !,
|
V1 @< V2, !,
|
||||||
'$vars_interset_for_constr'(GV,[V2|LIV]).
|
'$vars_interset_for_constr'(GV,[V2|LIV]).
|
||||||
'$vars_interset_for_constr'([V1|GV],[V2|LIV]) :-
|
'$vars_interset_for_constr'([V1|GV],[_|LIV]) :-
|
||||||
'$vars_interset_for_constr'([V1|GV],LIV).
|
'$vars_interset_for_constr'([V1|GV],LIV).
|
||||||
|
|
||||||
|
|
||||||
|
68
pl/debug.yap
68
pl/debug.yap
@ -28,10 +28,8 @@
|
|||||||
% $suspy does most of the work
|
% $suspy does most of the work
|
||||||
'$suspy'(V,S) :- var(V) , !,
|
'$suspy'(V,S) :- var(V) , !,
|
||||||
throw(error(instantiation_error,spy(V,S))).
|
throw(error(instantiation_error,spy(V,S))).
|
||||||
'$suspy'(M:S,P) :- !,
|
'$suspy'((M:S),P) :- !,
|
||||||
'$current_module'(Old,M),
|
'$mod_switch'(M, '$suspy'(S,P)).
|
||||||
('$suspy'(S,P),fail ; true), !,
|
|
||||||
'$change_module'(Old).
|
|
||||||
'$suspy'([],_) :- !.
|
'$suspy'([],_) :- !.
|
||||||
'$suspy'([F|L],M) :- !, ( '$suspy'(F,M) ; '$suspy'(L,M) ).
|
'$suspy'([F|L],M) :- !, ( '$suspy'(F,M) ; '$suspy'(L,M) ).
|
||||||
'$suspy'(F/N,M) :- !, functor(T,F,N),
|
'$suspy'(F/N,M) :- !, functor(T,F,N),
|
||||||
@ -46,8 +44,9 @@
|
|||||||
throw(error(existence_error(procedure,A),spy(A))).
|
throw(error(existence_error(procedure,A),spy(A))).
|
||||||
'$suspy'(A,nospy) :- '$noclausesfor'(A), !,
|
'$suspy'(A,nospy) :- '$noclausesfor'(A), !,
|
||||||
throw(error(existence_error(procedure,A),nospy(A))).
|
throw(error(existence_error(procedure,A),nospy(A))).
|
||||||
'$suspy'(A,M) :- current_predicate(A,T), functor(T,F,N),
|
'$suspy'(A,M) :- current_predicate(A,T),
|
||||||
\+ '$undefined'(T), \+ '$system_predicate'(T),
|
\+ '$undefined'(T), \+ '$system_predicate'(T), !,
|
||||||
|
functor(T,F,N),
|
||||||
'$suspy2'(M,F,N,T).
|
'$suspy2'(M,F,N,T).
|
||||||
|
|
||||||
'$noclausesfor'(A) :- current_predicate(A,T),
|
'$noclausesfor'(A) :- current_predicate(A,T),
|
||||||
@ -56,12 +55,12 @@
|
|||||||
'$noclausesfor'(_).
|
'$noclausesfor'(_).
|
||||||
|
|
||||||
'$suspy2'(spy,F,N,T) :-
|
'$suspy2'(spy,F,N,T) :-
|
||||||
$current_module(M),
|
'$current_module'(M),
|
||||||
'$recorded'('$spy','$spy'(T,M),_), !,
|
'$recorded'('$spy','$spy'(T,M),_), !,
|
||||||
format('[ Warning: there is already a spy point on ~w ]~n',M:F/N).
|
format('[ Warning: there is already a spy point on ~w ]~n',M:F/N).
|
||||||
'$suspy2'(spy,F,N,T) :- !,
|
'$suspy2'(spy,F,N,T) :- !,
|
||||||
'$warn_if_undef'(T,F,N),
|
'$warn_if_undef'(T,F,N),
|
||||||
$current_module(M),
|
'$current_module'(M),
|
||||||
'$recorda'('$spy','$spy'(T,M),_),
|
'$recorda'('$spy','$spy'(T,M),_),
|
||||||
'$set_value'('$spypoint_added', true),
|
'$set_value'('$spypoint_added', true),
|
||||||
'$set_spy'(T),
|
'$set_spy'(T),
|
||||||
@ -74,7 +73,7 @@
|
|||||||
'$rm_spy'(T),
|
'$rm_spy'(T),
|
||||||
write(user_error,'[ Spy point on '), write(user_error,F/N), write(user_error,' removed ]'),
|
write(user_error,'[ Spy point on '), write(user_error,F/N), write(user_error,' removed ]'),
|
||||||
nl(user_error).
|
nl(user_error).
|
||||||
'$suspy2'(nospy,F,N,T) :-
|
'$suspy2'(nospy,F,N,_) :-
|
||||||
write(user_error,'[ Warning: there is no spy-point on '),
|
write(user_error,'[ Warning: there is no spy-point on '),
|
||||||
write(user_error,F/N), write(user_error,' ]'), nl(user_error).
|
write(user_error,F/N), write(user_error,' ]'), nl(user_error).
|
||||||
|
|
||||||
@ -84,15 +83,16 @@
|
|||||||
'$warn_if_undef'(_,_,_).
|
'$warn_if_undef'(_,_,_).
|
||||||
|
|
||||||
'$pred_being_spied'(G) :-
|
'$pred_being_spied'(G) :-
|
||||||
$current_module(M),'$recorded'('$spy','$spy'(G,M),_),!.
|
'$current_module'(M),
|
||||||
|
'$recorded'('$spy','$spy'(G,M),_), !.
|
||||||
|
|
||||||
spy L :- '$set_value'('$spypoint_added', false), fail.
|
spy _ :- '$set_value'('$spypoint_added', false), fail.
|
||||||
spy L :- '$suspy'(L,spy), fail.
|
spy L :- '$suspy'(L,spy), fail.
|
||||||
spy L :- '$get_value'('$spypoint_added', false), !.
|
spy _ :- '$get_value'('$spypoint_added', false), !.
|
||||||
spy L :- debug.
|
spy _ :- debug.
|
||||||
|
|
||||||
nospy L :- '$suspy'(L,nospy), fail.
|
nospy L :- '$suspy'(L,nospy), fail.
|
||||||
nospy L.
|
nospy _.
|
||||||
|
|
||||||
nospyall :- '$recorded'('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(M:F/N,nospy), fail.
|
nospyall :- '$recorded'('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(M:F/N,nospy), fail.
|
||||||
nospyall.
|
nospyall.
|
||||||
@ -148,10 +148,10 @@ leash(X) :-
|
|||||||
'$show_leash_bit'(WasWritten,2'0001,L,fail),
|
'$show_leash_bit'(WasWritten,2'0001,L,fail),
|
||||||
write(user_error,') ]'), nl(user_error).
|
write(user_error,') ]'), nl(user_error).
|
||||||
|
|
||||||
'$show_leash_bit'(Was,Bit,Code,_) :- Bit /\ Code =:= 0, !.
|
'$show_leash_bit'(_,Bit,Code,_) :- Bit /\ Code =:= 0, !.
|
||||||
'$show_leash_bit'(Was,_,_,Name) :- var(Was), !,
|
'$show_leash_bit'(Was,_,_,Name) :- var(Was), !,
|
||||||
Was = yes, write(user_error,Name).
|
Was = yes, write(user_error,Name).
|
||||||
'$show_leash_bit'(Was,_,_,Name) :-
|
'$show_leash_bit'(_,_,_,Name) :-
|
||||||
write(user_error,','), write(user_error,Name).
|
write(user_error,','), write(user_error,Name).
|
||||||
|
|
||||||
'$leashcode'(full,2'1111) :- !.
|
'$leashcode'(full,2'1111) :- !.
|
||||||
@ -249,11 +249,11 @@ debugging :-
|
|||||||
'$awoken_goals'(LG), !,
|
'$awoken_goals'(LG), !,
|
||||||
'$creep',
|
'$creep',
|
||||||
'$wake_up_goal'(G, LG).
|
'$wake_up_goal'(G, LG).
|
||||||
'$spy'([Module|G]) :-
|
'$spy'([_Module|G]) :-
|
||||||
% '$format'(user_error,"$spym(~w,~w)~n",[Module,G]),
|
% '$format'(user_error,"$spym(~w,~w)~n",[Module,G]),
|
||||||
( '$hidden'(G)
|
( '$hidden'(G)
|
||||||
;
|
;
|
||||||
'$parent_pred'(O,A1,A2),
|
'$parent_pred'(0,_,_),
|
||||||
'$system_predicate'(G)
|
'$system_predicate'(G)
|
||||||
),
|
),
|
||||||
!,
|
!,
|
||||||
@ -268,7 +268,7 @@ debugging :-
|
|||||||
'$awoken_goals'(LG), !,
|
'$awoken_goals'(LG), !,
|
||||||
'$creep',
|
'$creep',
|
||||||
'$wake_up_goal'(G, LG).
|
'$wake_up_goal'(G, LG).
|
||||||
'$direct_spy'([Module|G]) :-
|
'$direct_spy'([_|G]) :-
|
||||||
'$hidden'(G),
|
'$hidden'(G),
|
||||||
!,
|
!,
|
||||||
/* called from prolog module */
|
/* called from prolog module */
|
||||||
@ -328,7 +328,7 @@ debugging :-
|
|||||||
'$cont_creep'; /* exit */
|
'$cont_creep'; /* exit */
|
||||||
/* we get here when we want to redo a goal */
|
/* we get here when we want to redo a goal */
|
||||||
'$set_value'(spy_cl,Cla),/* restore clause no. to try */
|
'$set_value'(spy_cl,Cla),/* restore clause no. to try */
|
||||||
$current_module(_,Module),
|
'$current_module'(_,Module),
|
||||||
'$trace'(redo,G,L), /* inform user_error */
|
'$trace'(redo,G,L), /* inform user_error */
|
||||||
fail /* to backtrack to spycalls */
|
fail /* to backtrack to spycalls */
|
||||||
).
|
).
|
||||||
@ -349,18 +349,18 @@ debugging :-
|
|||||||
'$spycalls'(Mod:G,Res) :-
|
'$spycalls'(Mod:G,Res) :-
|
||||||
!,
|
!,
|
||||||
'$mod_switch'(Mod,'$spycalls'(G,Res)).
|
'$mod_switch'(Mod,'$spycalls'(G,Res)).
|
||||||
'$spycalls'(repeat,Res) :-
|
'$spycalls'(repeat,_) :-
|
||||||
!,
|
!,
|
||||||
repeat.
|
repeat.
|
||||||
'$spycalls'(fail,Res) :-
|
'$spycalls'(fail,_) :-
|
||||||
!,
|
!,
|
||||||
fail.
|
fail.
|
||||||
'$spycalls'(false,Res) :-
|
'$spycalls'(false,_) :-
|
||||||
!,
|
!,
|
||||||
false.
|
false.
|
||||||
'$spycalls'(true,Res) :-
|
'$spycalls'(true,_) :-
|
||||||
!.
|
!.
|
||||||
'$spycalls'(otherwise,Res) :-
|
'$spycalls'(otherwise,_) :-
|
||||||
!.
|
!.
|
||||||
'$spycalls'(\+ G,Res) :-
|
'$spycalls'(\+ G,Res) :-
|
||||||
!,
|
!,
|
||||||
@ -476,7 +476,7 @@ debugging :-
|
|||||||
'$spycall_stdpred'(G) :-
|
'$spycall_stdpred'(G) :-
|
||||||
functor(G,F,N),
|
functor(G,F,N),
|
||||||
(
|
(
|
||||||
'$recorded'('$meta_predicate','$meta_predicate'(Mod,F,N,D),_) ->
|
'$recorded'('$meta_predicate','$meta_predicate'(_,F,N,_),_) ->
|
||||||
'$setflop'(1),
|
'$setflop'(1),
|
||||||
'$creep',
|
'$creep',
|
||||||
'$execute0'(G)
|
'$execute0'(G)
|
||||||
@ -752,25 +752,25 @@ debugging :-
|
|||||||
'$direct_spy'([M|'!'(CP)]),
|
'$direct_spy'([M|'!'(CP)]),
|
||||||
% clean up any garbage left here by the debugger.
|
% clean up any garbage left here by the debugger.
|
||||||
'$$cut_by'(CP).
|
'$$cut_by'(CP).
|
||||||
'$creep_call'('$cut_by'(X),CP) :- !,
|
'$creep_call'('$cut_by'(X),_) :- !,
|
||||||
'$$cut_by'(X).
|
'$$cut_by'(X).
|
||||||
'$creep_call'(repeat,_) :- !,
|
'$creep_call'(repeat,_) :- !,
|
||||||
'$current_module'(M),
|
'$current_module'(Module),
|
||||||
'$direct_spy'([Module|repeat]).
|
'$direct_spy'([Module|repeat]).
|
||||||
'$creep_call'([A|B],_) :- !,
|
'$creep_call'([A|B],_) :- !,
|
||||||
'$current_module'(M),
|
'$current_module'(Module),
|
||||||
'$direct_spy'([Module|[A|B]]).
|
'$direct_spy'([Module|[A|B]]).
|
||||||
'$creep_call'(A,CP) :-
|
'$creep_call'(A,CP) :-
|
||||||
'$undefined'(A), !,
|
'$undefined'(A), !,
|
||||||
'$creep_call_undefined'(A,CP).
|
'$creep_call_undefined'(A,CP).
|
||||||
'$creep_call'(A,CP) :-
|
'$creep_call'(A,_) :-
|
||||||
'$current_module'(Module),
|
'$current_module'(Module),
|
||||||
'$direct_spy'([Module|A]).
|
'$direct_spy'([Module|A]).
|
||||||
|
|
||||||
'$creep_call_undefined'(A,CP) :-
|
'$creep_call_undefined'(A,CP) :-
|
||||||
functor(A,F,N),
|
functor(A,F,N),
|
||||||
'$current_module'(M),
|
'$current_module'(M),
|
||||||
'$recorded'($import,$import(S,M,F,N),_), !,
|
'$recorded'('$import','$import'(S,M,F,N),_), !,
|
||||||
'$creep_call'(S:A,CP).
|
'$creep_call'(S:A,CP).
|
||||||
'$creep_call_undefined'(G, _) :-
|
'$creep_call_undefined'(G, _) :-
|
||||||
( \+ '$undefined'(user:unknown_predicate_handler(_,_,_)),
|
( \+ '$undefined'(user:unknown_predicate_handler(_,_,_)),
|
||||||
@ -792,7 +792,7 @@ debugging :-
|
|||||||
true
|
true
|
||||||
),
|
),
|
||||||
'$execute'(M:Goal).
|
'$execute'(M:Goal).
|
||||||
'$creep'(G) :-
|
'$creep'(_) :-
|
||||||
'$get_value'('$throw', true), !,
|
'$get_value'('$throw', true), !,
|
||||||
'$set_value'('$throw', false),
|
'$set_value'('$throw', false),
|
||||||
abort.
|
abort.
|
||||||
@ -823,7 +823,7 @@ debugging :-
|
|||||||
( SL = L -> write(user_error,'>') ; write(user_error,' ')),
|
( SL = L -> write(user_error,'>') ; write(user_error,' ')),
|
||||||
write(user_error,' ('), write(user_error,L), write(user_error,') '),
|
write(user_error,' ('), write(user_error,L), write(user_error,') '),
|
||||||
write(user_error,P), write(user_error,': '),
|
write(user_error,P), write(user_error,': '),
|
||||||
( $current_module(Module), Module\=prolog,
|
( '$current_module'(Module), Module\=prolog,
|
||||||
Module\=user -> write(user_error,Module),write(user_error,':');
|
Module\=user -> write(user_error,Module),write(user_error,':');
|
||||||
true
|
true
|
||||||
),
|
),
|
||||||
@ -979,7 +979,7 @@ debugging :-
|
|||||||
'$deb_get_sterm_in_g'(L,G,A),
|
'$deb_get_sterm_in_g'(L,G,A),
|
||||||
recorda('$debug_sub_skel',L,_),
|
recorda('$debug_sub_skel',L,_),
|
||||||
nl(user_error), write(user_error,A), nl(user_error), nl(user_error).
|
nl(user_error), write(user_error,A), nl(user_error), nl(user_error).
|
||||||
'$print_deb_sterm'(G) :- '$skipeol'(94).
|
'$print_deb_sterm'(_) :- '$skipeol'(94).
|
||||||
|
|
||||||
'$get_sterm_list'(L) :-
|
'$get_sterm_list'(L) :-
|
||||||
get0(user_input,C),
|
get0(user_input,C),
|
||||||
|
@ -20,15 +20,15 @@
|
|||||||
depth_bound_call(A,D) :-
|
depth_bound_call(A,D) :-
|
||||||
'$execute_under_depth_limit'(A,D).
|
'$execute_under_depth_limit'(A,D).
|
||||||
|
|
||||||
$old_depth_bound_call(A,D) :-
|
'$old_depth_bound_call'(A,D) :-
|
||||||
'$check_callable'(A,A),
|
'$check_callable'(A,A),
|
||||||
'$user_call_depth_limited'(A, D).
|
'$user_call_depth_limited'(A, D).
|
||||||
|
|
||||||
'$user_call_depth_limited'(V,D) :- var(V), !,
|
'$user_call_depth_limited'(V,_) :- var(V), !,
|
||||||
throw(error(instantiation_error,V)).
|
throw(error(instantiation_error,V)).
|
||||||
'$user_call_depth_limited'(A,D) :- number(A), !,
|
'$user_call_depth_limited'(A,_) :- number(A), !,
|
||||||
throw(error(type_error(callable,A),A,D)).
|
throw(error(type_error(callable,A),A)).
|
||||||
'$user_call_depth_limited'(R,D) :- db_reference(R), !,
|
'$user_call_depth_limited'(R,_) :- db_reference(R), !,
|
||||||
throw(error(type_error(callable,R),R)).
|
throw(error(type_error(callable,R),R)).
|
||||||
'$user_call_depth_limited'(A,D) :-
|
'$user_call_depth_limited'(A,D) :-
|
||||||
'$access_yap_flags'(10,V),
|
'$access_yap_flags'(10,V),
|
||||||
@ -100,13 +100,13 @@ $old_depth_bound_call(A,D) :-
|
|||||||
'$call_depth_limited'(not X,CP,D) :- !,
|
'$call_depth_limited'(not X,CP,D) :- !,
|
||||||
'$check_callable'(X, not X),
|
'$check_callable'(X, not X),
|
||||||
\+ '$call_depth_limited'(X,CP,D).
|
\+ '$call_depth_limited'(X,CP,D).
|
||||||
'$call_depth_limited'(!,CP,_) :- $$cut_by(CP).
|
'$call_depth_limited'(!,CP,_) :- '$$cut_by'(CP).
|
||||||
'$call_depth_limited'(repeat,_,_) :- !, $repeat.
|
'$call_depth_limited'(repeat,_,_) :- !, '$repeat'.
|
||||||
'$call_depth_limited'([A|B],_,_) :- !, '$csult'([A|B]).
|
'$call_depth_limited'([A|B],_,_) :- !, '$csult'([A|B]).
|
||||||
'$call_depth_limited'(A,CP,D) :-
|
'$call_depth_limited'(A,CP,D) :-
|
||||||
( '$undefined'(A) ->
|
( '$undefined'(A) ->
|
||||||
functor(A,F,N), $current_module(M),
|
functor(A,F,N), '$current_module'(M),
|
||||||
( '$recorded'($import,$import(S,M,F,N),_) ->
|
( '$recorded'('$import','$import'(S,M,F,N),_) ->
|
||||||
'$call_depth_limited'(S:A,CP,D) ;
|
'$call_depth_limited'(S:A,CP,D) ;
|
||||||
get_depth_limit(D0),
|
get_depth_limit(D0),
|
||||||
'$set_depth_limit'(D),
|
'$set_depth_limit'(D),
|
||||||
@ -179,13 +179,13 @@ $old_depth_bound_call(A,D) :-
|
|||||||
'$spied_call_depth_limited'(not X,CP,D) :- !,
|
'$spied_call_depth_limited'(not X,CP,D) :- !,
|
||||||
'$check_callable'(X, not X),
|
'$check_callable'(X, not X),
|
||||||
\+ '$spied_call_depth_limited'(X,CP,D).
|
\+ '$spied_call_depth_limited'(X,CP,D).
|
||||||
'$spied_call_depth_limited'(!,CP,_) :- $$cut_by(CP).
|
'$spied_call_depth_limited'(!,CP,_) :- '$$cut_by'(CP).
|
||||||
'$spied_call_depth_limited'(repeat,_,_) :- !, '$repeat'.
|
'$spied_call_depth_limited'(repeat,_,_) :- !, '$repeat'.
|
||||||
'$spied_call_depth_limited'([A|B],_,_) :- !, '$csult'([A|B]).
|
'$spied_call_depth_limited'([A|B],_,_) :- !, '$csult'([A|B]).
|
||||||
'$spied_call_depth_limited'(A,CP,D) :-
|
'$spied_call_depth_limited'(A,CP,D) :-
|
||||||
( '$undefined'(A) ->
|
( '$undefined'(A) ->
|
||||||
functor(A,F,N), $current_module(M),
|
functor(A,F,N), '$current_module'(M),
|
||||||
( '$recorded'($import,$import(S,M,F,N),_) ->
|
( '$recorded'('$import','$import'(S,M,F,N),_) ->
|
||||||
'$spied_call_depth_limited'(S:A,CP,D) ;
|
'$spied_call_depth_limited'(S:A,CP,D) ;
|
||||||
get_depth_limit(D0),
|
get_depth_limit(D0),
|
||||||
'$set_depth_limit'(D),
|
'$set_depth_limit'(D),
|
||||||
|
@ -287,46 +287,6 @@ yap_flag(language,X) :-
|
|||||||
yap_flag(language,X) :-
|
yap_flag(language,X) :-
|
||||||
throw(error(domain_error(flag_value,language+X),yap_flag(language,X))).
|
throw(error(domain_error(flag_value,language+X),yap_flag(language,X))).
|
||||||
|
|
||||||
'$trans_to_lang_flag'(0,cprolog).
|
|
||||||
'$trans_to_lang_flag'(1,iso).
|
|
||||||
'$trans_to_lang_flag'(2,sicstus).
|
|
||||||
|
|
||||||
'$adjust_language'(cprolog) :-
|
|
||||||
'$switch_log_upd'(0),
|
|
||||||
'$syntax_check_mode'(_,off),
|
|
||||||
'$syntax_check_single_var'(_,off),
|
|
||||||
'$syntax_check_discontiguous'(_,off),
|
|
||||||
'$syntax_check_multiple'(_,off),
|
|
||||||
'$transl_to_on_off'(Y,off), % disable character escapes.
|
|
||||||
'$set_yap_flags'(12,Y),
|
|
||||||
'$set_yap_flags'(14,1),
|
|
||||||
unknown(_,error).
|
|
||||||
'$adjust_language'(sicstus) :-
|
|
||||||
'$switch_log_upd'(1),
|
|
||||||
leash(full),
|
|
||||||
'$syntax_check_mode'(_,on),
|
|
||||||
'$syntax_check_single_var'(_,on),
|
|
||||||
'$syntax_check_discontiguous'(_,on),
|
|
||||||
'$syntax_check_multiple'(_,on),
|
|
||||||
'$transl_to_on_off'(X1,on),
|
|
||||||
'$set_yap_flags'(5,X1),
|
|
||||||
'$force_char_conversion',
|
|
||||||
'$set_yap_flags'(14,0),
|
|
||||||
unknown(_,error).
|
|
||||||
'$adjust_language'(iso) :-
|
|
||||||
'$switch_log_upd'(2),
|
|
||||||
'$syntax_check_mode'(_,on),
|
|
||||||
'$syntax_check_single_var'(_,on),
|
|
||||||
'$syntax_check_discontiguous'(_,on),
|
|
||||||
'$syntax_check_multiple'(_,on),
|
|
||||||
'$set_yap_flags'(7,1),
|
|
||||||
fileerrors,
|
|
||||||
'$transl_to_on_off'(X1,on),
|
|
||||||
'$set_yap_flags'(5,X1),
|
|
||||||
'$force_char_conversion',
|
|
||||||
'$set_yap_flags'(14,0),
|
|
||||||
unknown(_,error).
|
|
||||||
|
|
||||||
yap_flag(debug,X) :-
|
yap_flag(debug,X) :-
|
||||||
var(X), !,
|
var(X), !,
|
||||||
('$get_value'(debug,1) ->
|
('$get_value'(debug,1) ->
|
||||||
@ -417,12 +377,6 @@ yap_flag(character_escapes,X) :- !,
|
|||||||
yap_flag(character_escapes,X) :-
|
yap_flag(character_escapes,X) :-
|
||||||
throw(error(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X))).
|
throw(error(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X))).
|
||||||
|
|
||||||
'$transl_to_character_escape_modes'(0,off) :- !.
|
|
||||||
'$transl_to_character_escape_modes'(0,cprolog).
|
|
||||||
'$transl_to_character_escape_modes'(1,on) :- !.
|
|
||||||
'$transl_to_character_escape_modes'(1,iso).
|
|
||||||
'$transl_to_character_escape_modes'(2,sicstus).
|
|
||||||
|
|
||||||
yap_flag(update_semantics,X) :-
|
yap_flag(update_semantics,X) :-
|
||||||
var(X), !,
|
var(X), !,
|
||||||
( '$log_upd'(I) -> '$convert_upd_sem'(I,X) ).
|
( '$log_upd'(I) -> '$convert_upd_sem'(I,X) ).
|
||||||
@ -480,9 +434,6 @@ yap_flag(user_error,OUT) :-
|
|||||||
yap_flag(user_error,Stream) :-
|
yap_flag(user_error,Stream) :-
|
||||||
'$change_alias_to_stream'(user_error,Stream).
|
'$change_alias_to_stream'(user_error,Stream).
|
||||||
|
|
||||||
'$flag_check_alias'(OUT, Alias) :-
|
|
||||||
stream_property(OUT,[alias(Alias)]), !.
|
|
||||||
|
|
||||||
yap_flag(debugger_print_options,OUT) :-
|
yap_flag(debugger_print_options,OUT) :-
|
||||||
var(OUT),
|
var(OUT),
|
||||||
'$recorded'('$print_options','$debugger'(OUT),_), !.
|
'$recorded'('$print_options','$debugger'(OUT),_), !.
|
||||||
@ -501,30 +452,6 @@ yap_flag(toplevel_print_options,Opts) :- !,
|
|||||||
|
|
||||||
:- '$recorda'('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).
|
:- '$recorda'('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).
|
||||||
|
|
||||||
'$convert_upd_sem'(0,immediate).
|
|
||||||
'$convert_upd_sem'(1,logical).
|
|
||||||
'$convert_upd_sem'(2,logical_assert).
|
|
||||||
|
|
||||||
'$transl_to_true_false'(0,false).
|
|
||||||
'$transl_to_true_false'(1,true).
|
|
||||||
|
|
||||||
'$transl_to_on_off'(0,off).
|
|
||||||
'$transl_to_on_off'(1,on).
|
|
||||||
|
|
||||||
'$transl_to_arity'(X1,X) :- X1 < 0, !, X = unbounded.
|
|
||||||
'$transl_to_arity'(X,X).
|
|
||||||
|
|
||||||
'$transl_to_rounding_function'(0,down).
|
|
||||||
'$transl_to_rounding_function'(1,toward_zero).
|
|
||||||
|
|
||||||
'$transl_to_trl_types'(0,chars).
|
|
||||||
'$transl_to_trl_types'(1,codes).
|
|
||||||
'$transl_to_trl_types'(2,atom).
|
|
||||||
|
|
||||||
'$yap_flag_show_tracing'(true, _, on) :- !.
|
|
||||||
'$yap_flag_show_tracing'(_, true, verbose) :- !.
|
|
||||||
'$yap_flag_show_tracing'(_, _, off).
|
|
||||||
|
|
||||||
yap_flag(host_type,X) :-
|
yap_flag(host_type,X) :-
|
||||||
'$host_type'(X).
|
'$host_type'(X).
|
||||||
|
|
||||||
@ -570,6 +497,79 @@ yap_flag(host_type,X) :-
|
|||||||
),
|
),
|
||||||
yap_flag(V, Out).
|
yap_flag(V, Out).
|
||||||
|
|
||||||
|
'$trans_to_lang_flag'(0,cprolog).
|
||||||
|
'$trans_to_lang_flag'(1,iso).
|
||||||
|
'$trans_to_lang_flag'(2,sicstus).
|
||||||
|
|
||||||
|
'$adjust_language'(cprolog) :-
|
||||||
|
'$switch_log_upd'(0),
|
||||||
|
'$syntax_check_mode'(_,off),
|
||||||
|
'$syntax_check_single_var'(_,off),
|
||||||
|
'$syntax_check_discontiguous'(_,off),
|
||||||
|
'$syntax_check_multiple'(_,off),
|
||||||
|
'$transl_to_on_off'(Y,off), % disable character escapes.
|
||||||
|
'$set_yap_flags'(12,Y),
|
||||||
|
'$set_yap_flags'(14,1),
|
||||||
|
unknown(_,error).
|
||||||
|
'$adjust_language'(sicstus) :-
|
||||||
|
'$switch_log_upd'(1),
|
||||||
|
leash(full),
|
||||||
|
'$syntax_check_mode'(_,on),
|
||||||
|
'$syntax_check_single_var'(_,on),
|
||||||
|
'$syntax_check_discontiguous'(_,on),
|
||||||
|
'$syntax_check_multiple'(_,on),
|
||||||
|
'$transl_to_on_off'(X1,on),
|
||||||
|
'$set_yap_flags'(5,X1),
|
||||||
|
'$force_char_conversion',
|
||||||
|
'$set_yap_flags'(14,0),
|
||||||
|
unknown(_,error).
|
||||||
|
'$adjust_language'(iso) :-
|
||||||
|
'$switch_log_upd'(2),
|
||||||
|
'$syntax_check_mode'(_,on),
|
||||||
|
'$syntax_check_single_var'(_,on),
|
||||||
|
'$syntax_check_discontiguous'(_,on),
|
||||||
|
'$syntax_check_multiple'(_,on),
|
||||||
|
'$set_yap_flags'(7,1),
|
||||||
|
fileerrors,
|
||||||
|
'$transl_to_on_off'(X1,on),
|
||||||
|
'$set_yap_flags'(5,X1),
|
||||||
|
'$force_char_conversion',
|
||||||
|
'$set_yap_flags'(14,0),
|
||||||
|
unknown(_,error).
|
||||||
|
|
||||||
|
'$transl_to_character_escape_modes'(0,off) :- !.
|
||||||
|
'$transl_to_character_escape_modes'(0,cprolog).
|
||||||
|
'$transl_to_character_escape_modes'(1,on) :- !.
|
||||||
|
'$transl_to_character_escape_modes'(1,iso).
|
||||||
|
'$transl_to_character_escape_modes'(2,sicstus).
|
||||||
|
|
||||||
|
'$convert_upd_sem'(0,immediate).
|
||||||
|
'$convert_upd_sem'(1,logical).
|
||||||
|
'$convert_upd_sem'(2,logical_assert).
|
||||||
|
|
||||||
|
'$transl_to_true_false'(0,false).
|
||||||
|
'$transl_to_true_false'(1,true).
|
||||||
|
|
||||||
|
'$transl_to_on_off'(0,off).
|
||||||
|
'$transl_to_on_off'(1,on).
|
||||||
|
|
||||||
|
'$transl_to_arity'(X1,X) :- X1 < 0, !, X = unbounded.
|
||||||
|
'$transl_to_arity'(X,X).
|
||||||
|
|
||||||
|
'$transl_to_rounding_function'(0,down).
|
||||||
|
'$transl_to_rounding_function'(1,toward_zero).
|
||||||
|
|
||||||
|
'$transl_to_trl_types'(0,chars).
|
||||||
|
'$transl_to_trl_types'(1,codes).
|
||||||
|
'$transl_to_trl_types'(2,atom).
|
||||||
|
|
||||||
|
'$yap_flag_show_tracing'(true, _, on) :- !.
|
||||||
|
'$yap_flag_show_tracing'(_, true, verbose) :- !.
|
||||||
|
'$yap_flag_show_tracing'(_, _, off).
|
||||||
|
|
||||||
|
'$flag_check_alias'(OUT, Alias) :-
|
||||||
|
stream_property(OUT,[alias(Alias)]), !.
|
||||||
|
|
||||||
current_prolog_flag(V,Out) :-
|
current_prolog_flag(V,Out) :-
|
||||||
(var(V) ; atom(V) ), !,
|
(var(V) ; atom(V) ), !,
|
||||||
'$show_yap_flag_opts'(V,NOut),
|
'$show_yap_flag_opts'(V,NOut),
|
||||||
@ -594,7 +594,7 @@ prolog_flag(F, Old, New) :-
|
|||||||
throw(error(instantiation_error,prolog_flag(F,Old,New))).
|
throw(error(instantiation_error,prolog_flag(F,Old,New))).
|
||||||
prolog_flag(F, Old, New) :-
|
prolog_flag(F, Old, New) :-
|
||||||
current_prolog_flag(F, Old),
|
current_prolog_flag(F, Old),
|
||||||
set_prolog_flag(F, Old).
|
set_prolog_flag(F, New).
|
||||||
|
|
||||||
prolog_flag(F, Old) :-
|
prolog_flag(F, Old) :-
|
||||||
current_prolog_flag(F, Old).
|
current_prolog_flag(F, Old).
|
||||||
|
@ -56,7 +56,7 @@
|
|||||||
'$process_error'(Throw) :-
|
'$process_error'(Throw) :-
|
||||||
print_message(error,Throw).
|
print_message(error,Throw).
|
||||||
|
|
||||||
print_message(force(Severity), Msg) :- !,
|
print_message(force(_Severity), Msg) :- !,
|
||||||
print(user_error,Msg).
|
print(user_error,Msg).
|
||||||
print_message(Severity, Msg) :-
|
print_message(Severity, Msg) :-
|
||||||
\+ '$undefined'(user: portray_message(Severity, Msg)),
|
\+ '$undefined'(user: portray_message(Severity, Msg)),
|
||||||
@ -290,7 +290,7 @@ print_message(help,M) :-
|
|||||||
'$output_error_message'(system_error(Message), Where) :-
|
'$output_error_message'(system_error(Message), Where) :-
|
||||||
format(user_error,"[ SYSTEM ERROR- ~w at ~w]~n",
|
format(user_error,"[ SYSTEM ERROR- ~w at ~w]~n",
|
||||||
[Message,Where]).
|
[Message,Where]).
|
||||||
'$output_error_message'(type_error(T,_,Err,M), Where) :-
|
'$output_error_message'(type_error(T,_,Err,M), _Where) :-
|
||||||
format(user_error,"[ TYPE ERROR- ~w: expected ~w, got ~w ]~n",
|
format(user_error,"[ TYPE ERROR- ~w: expected ~w, got ~w ]~n",
|
||||||
[T,Err,M]).
|
[T,Err,M]).
|
||||||
'$output_error_message'(type_error(array,W), Where) :-
|
'$output_error_message'(type_error(array,W), Where) :-
|
||||||
|
@ -64,10 +64,10 @@
|
|||||||
'$t_body'((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !,
|
'$t_body'((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !,
|
||||||
'$t_body'(T, ToFill, not_last, S, SR1, Tt),
|
'$t_body'(T, ToFill, not_last, S, SR1, Tt),
|
||||||
'$t_body'(R, ToFill, Last, SR1, SR, Rt).
|
'$t_body'(R, ToFill, Last, SR1, SR, Rt).
|
||||||
'$t_body'((T;R), _ToFill, _Last, S, SR, (Tt;Rt)) :- !,
|
'$t_body'((T;R), ToFill, _Last, S, SR, (Tt;Rt)) :- !,
|
||||||
copy_term(ToFill,OtherToFill),
|
copy_term(ToFill,OtherToFill),
|
||||||
'$t_body'(T, _, last, S, SR, Tt),
|
'$t_body'(T, OtherToFill, last, S, SR, Tt),
|
||||||
'$t_body'(R, _, last, S, SR, Rt).
|
'$t_body'(R, ToFill, last, S, SR, Rt).
|
||||||
'$t_body'(M:G, ToFill, Last, S, SR, M:NG) :- !,
|
'$t_body'(M:G, ToFill, Last, S, SR, M:NG) :- !,
|
||||||
'$t_body'(G, ToFill, Last, S, SR, NG).
|
'$t_body'(G, ToFill, Last, S, SR, NG).
|
||||||
'$t_body'(T, filled_in, _, S, SR, Tt) :-
|
'$t_body'(T, filled_in, _, S, SR, Tt) :-
|
||||||
|
@ -20,16 +20,10 @@
|
|||||||
|
|
||||||
% These are pseudo declarations
|
% These are pseudo declarations
|
||||||
% so that the user will get a redefining system predicate
|
% so that the user will get a redefining system predicate
|
||||||
G1 ; G2 :- '$execute'((G1;G2)).
|
|
||||||
G1 | G2 :- '$execute'((G1;G2)).
|
|
||||||
G1 -> G2 :- '$execute'((G1->G2)).
|
|
||||||
','(G1,G2) :- '$execute'((G1,G2)).
|
|
||||||
otherwise.
|
otherwise.
|
||||||
fail :- fail.
|
fail :- fail.
|
||||||
false :- false.
|
false :- false.
|
||||||
!.
|
!.
|
||||||
\+ G :- \+ G.
|
|
||||||
not(G) :- not(G).
|
|
||||||
(:- G) :- '$execute'(G), !.
|
(:- G) :- '$execute'(G), !.
|
||||||
'$$!'(CP) :- '$cut_by'(CP).
|
'$$!'(CP) :- '$cut_by'(CP).
|
||||||
|
|
||||||
|
@ -86,7 +86,7 @@ portray_clause(Pred) :-
|
|||||||
put(","),
|
put(","),
|
||||||
'$aftercomma'(T,IO,I),
|
'$aftercomma'(T,IO,I),
|
||||||
'$write_body'(Q,I,',').
|
'$write_body'(Q,I,',').
|
||||||
'$write_body'((P->Q;S),I,T) :-
|
'$write_body'((P->Q;S),I,_) :-
|
||||||
!,
|
!,
|
||||||
nl, tab(I-2), put("("),
|
nl, tab(I-2), put("("),
|
||||||
'$write_body'(P,I,'('),
|
'$write_body'(P,I,'('),
|
||||||
@ -95,7 +95,7 @@ portray_clause(Pred) :-
|
|||||||
put(";"),
|
put(";"),
|
||||||
'$write_body'(S,I,';'),
|
'$write_body'(S,I,';'),
|
||||||
tab(1), put(")").
|
tab(1), put(")").
|
||||||
'$write_body'((P->Q|S),I,T) :-
|
'$write_body'((P->Q|S),I,_) :-
|
||||||
!,
|
!,
|
||||||
nl, tab(I-2), put("("),
|
nl, tab(I-2), put("("),
|
||||||
'$write_body'(P,I,'('),
|
'$write_body'(P,I,'('),
|
||||||
@ -104,35 +104,28 @@ portray_clause(Pred) :-
|
|||||||
put("|"),
|
put("|"),
|
||||||
'$write_body'(S,I,'|'),
|
'$write_body'(S,I,'|'),
|
||||||
tab(1), put(")").
|
tab(1), put(")").
|
||||||
'$write_body'((P->Q),I,T) :-
|
'$write_body'((P->Q),I,_) :-
|
||||||
!,
|
!,
|
||||||
nl, tab(I-2), put("("),
|
nl, tab(I-2), put("("),
|
||||||
'$write_body'(P,I,'('),
|
'$write_body'(P,I,'('),
|
||||||
put("-"), put(">"),
|
put("-"), put(">"),
|
||||||
'$write_body'(Q,I,'->'),
|
'$write_body'(Q,I,'->'),
|
||||||
tab(1), put(")").
|
tab(1), put(")").
|
||||||
'$write_body'((P;Q),I,T) :-
|
'$write_body'((P;Q),I,_) :-
|
||||||
!,
|
!,
|
||||||
nl, tab(I-2), put("("),
|
nl, tab(I-2), put("("),
|
||||||
'$write_body'(P,I,'('),
|
'$write_body'(P,I,'('),
|
||||||
put(";"),
|
put(";"),
|
||||||
'$write_body'(Q,I,';'),
|
'$write_body'(Q,I,';'),
|
||||||
tab(1), put(")").
|
tab(1), put(")").
|
||||||
'$write_body'((P;Q),I,T) :-
|
'$write_body'((P|Q),I,_) :-
|
||||||
!,
|
|
||||||
nl, tab(I-2), put("("),
|
|
||||||
'$write_body'(P,I,'('),
|
|
||||||
put(";"),
|
|
||||||
'$write_body'(Q,I,';'),
|
|
||||||
tab(1), put(")").
|
|
||||||
'$write_body'((P|Q),I,T) :-
|
|
||||||
!,
|
!,
|
||||||
nl, tab(I-2), put("("),
|
nl, tab(I-2), put("("),
|
||||||
'$write_body'(P,I,'('),
|
'$write_body'(P,I,'('),
|
||||||
put("|"),
|
put("|"),
|
||||||
'$write_body'(Q,I,'|'),
|
'$write_body'(Q,I,'|'),
|
||||||
tab(1), put(")").
|
tab(1), put(")").
|
||||||
'$write_body'((P|Q),I,T) :-
|
'$write_body'((P|Q),I,_) :-
|
||||||
!,
|
!,
|
||||||
nl, tab(I-2), put("("),
|
nl, tab(I-2), put("("),
|
||||||
'$write_body'(P,I,'('),
|
'$write_body'(P,I,'('),
|
||||||
@ -169,4 +162,4 @@ portray_clause(Pred) :-
|
|||||||
'$list_transform'([X,Y|L],M) :- X == Y, X = '$VAR'(M), !, N is M+1,
|
'$list_transform'([X,Y|L],M) :- X == Y, X = '$VAR'(M), !, N is M+1,
|
||||||
'$list_transform'(L,N).
|
'$list_transform'(L,N).
|
||||||
'$list_transform'('$VAR'(-1).L,M) :- !, '$list_transform'(L,M).
|
'$list_transform'('$VAR'(-1).L,M) :- !, '$list_transform'(L,M).
|
||||||
'$list_transform'(X.L,M) :- '$list_transform'(L,M).
|
'$list_transform'(_.L,M) :- '$list_transform'(L,M).
|
||||||
|
@ -41,7 +41,7 @@ use_module(File,Imports) :-
|
|||||||
atom(File), !,
|
atom(File), !,
|
||||||
'$current_module'(M),
|
'$current_module'(M),
|
||||||
'$find_in_path'(File,X),
|
'$find_in_path'(File,X),
|
||||||
( open(X,$csult,Stream), !,
|
( open(X,'$csult',Stream), !,
|
||||||
'$consulting_file_name'(Stream,TrueFileName),
|
'$consulting_file_name'(Stream,TrueFileName),
|
||||||
( '$loaded'(Stream) -> true
|
( '$loaded'(Stream) -> true
|
||||||
;
|
;
|
||||||
@ -53,7 +53,7 @@ use_module(File,Imports) :-
|
|||||||
close(Stream),
|
close(Stream),
|
||||||
( var(R) -> true; erased(R) -> true; erase(R)),
|
( var(R) -> true; erased(R) -> true; erase(R)),
|
||||||
( '$recorded'('$module','$module'(TrueFileName,Mod,Publics),_) ->
|
( '$recorded'('$module','$module'(TrueFileName,Mod,Publics),_) ->
|
||||||
$use_preds(Imports,Publics,Mod,M)
|
'$use_preds'(Imports,Publics,Mod,M)
|
||||||
;
|
;
|
||||||
format(user_error,'[ use_module/2 can not find a module in file ~w]~n',File),
|
format(user_error,'[ use_module/2 can not find a module in file ~w]~n',File),
|
||||||
fail
|
fail
|
||||||
@ -64,7 +64,7 @@ use_module(File,Imports) :-
|
|||||||
use_module(library(File),Imports) :- !,
|
use_module(library(File),Imports) :- !,
|
||||||
'$current_module'(M),
|
'$current_module'(M),
|
||||||
'$find_in_path'(library(File),X),
|
'$find_in_path'(library(File),X),
|
||||||
( open(X,$csult,Stream), !,
|
( open(X,'$csult',Stream), !,
|
||||||
'$consulting_file_name'(Stream,TrueFileName),
|
'$consulting_file_name'(Stream,TrueFileName),
|
||||||
( '$loaded'(Stream) -> true
|
( '$loaded'(Stream) -> true
|
||||||
;
|
;
|
||||||
@ -76,7 +76,7 @@ use_module(library(File),Imports) :- !,
|
|||||||
close(Stream),
|
close(Stream),
|
||||||
( var(R) -> true; erased(R) -> true; erase(R)),
|
( var(R) -> true; erased(R) -> true; erase(R)),
|
||||||
( '$recorded'('$module','$module'(TrueFileName,Mod,Publics),_) ->
|
( '$recorded'('$module','$module'(TrueFileName,Mod,Publics),_) ->
|
||||||
$use_preds(Imports,Publics,Mod,M)
|
'$use_preds'(Imports,Publics,Mod,M)
|
||||||
;
|
;
|
||||||
format(user_error,'[ use_module/2 can not find a module in file ~w]~n',[File]),
|
format(user_error,'[ use_module/2 can not find a module in file ~w]~n',[File]),
|
||||||
fail
|
fail
|
||||||
@ -177,7 +177,7 @@ module(N) :-
|
|||||||
throw(error(instantiation_error,module(N))).
|
throw(error(instantiation_error,module(N))).
|
||||||
module(N) :-
|
module(N) :-
|
||||||
atom(N), !,
|
atom(N), !,
|
||||||
'$current_module'(Old,N),
|
'$current_module'(_,N),
|
||||||
'$get_value'('$consulting_file',F),
|
'$get_value'('$consulting_file',F),
|
||||||
( recordzifnot('$module','$module'(N),_) -> true; true),
|
( recordzifnot('$module','$module'(N),_) -> true; true),
|
||||||
( recorded('$module','$module'(F,N,[]),_) ->
|
( recorded('$module','$module'(F,N,[]),_) ->
|
||||||
@ -188,8 +188,8 @@ module(N) :-
|
|||||||
throw(error(type_error(atom,N),module(N))).
|
throw(error(type_error(atom,N),module(N))).
|
||||||
|
|
||||||
'$module_dec'(N,P) :-
|
'$module_dec'(N,P) :-
|
||||||
$current_module(Old,N),
|
'$current_module'(Old,N),
|
||||||
$get_value('$consulting_file',F),
|
'$get_value'('$consulting_file',F),
|
||||||
( recordzifnot('$module','$module'(N),_) -> true; true),
|
( recordzifnot('$module','$module'(N),_) -> true; true),
|
||||||
recorda('$module','$module'(F,N,P),_),
|
recorda('$module','$module'(F,N,P),_),
|
||||||
( '$recorded'('$importing','$importing'(F),_) ->
|
( '$recorded'('$importing','$importing'(F),_) ->
|
||||||
@ -201,7 +201,7 @@ module(N) :-
|
|||||||
'$import'([],_,_) :- !.
|
'$import'([],_,_) :- !.
|
||||||
'$import'([N/K|L],M,T) :-
|
'$import'([N/K|L],M,T) :-
|
||||||
integer(K), atom(N), !,
|
integer(K), atom(N), !,
|
||||||
( $check_import(M,T,N,K) ->
|
( '$check_import'(M,T,N,K) ->
|
||||||
% format(user_error,'[Importing ~w to ~w]~n',[M:N/K,T]),
|
% format(user_error,'[Importing ~w to ~w]~n',[M:N/K,T]),
|
||||||
( T = user ->
|
( T = user ->
|
||||||
recordz('$import','$import'(M,_,N,K),_)
|
recordz('$import','$import'(M,_,N,K),_)
|
||||||
@ -216,17 +216,17 @@ module(N) :-
|
|||||||
format(user_error,'[Illegal pred specification(~w) in module declaration for module ~w]~n',[PS,M]),
|
format(user_error,'[Illegal pred specification(~w) in module declaration for module ~w]~n',[PS,M]),
|
||||||
'$import'(L,M,T).
|
'$import'(L,M,T).
|
||||||
|
|
||||||
$check_import(M,T,N,K) :-
|
'$check_import'(M,T,N,K) :-
|
||||||
'$recorded'('$import','$import'(M1,T0,N,K),R), T0 == T, M1 \= M, /* ZP */ !,
|
'$recorded'('$import','$import'(M1,T0,N,K),R), T0 == T, M1 \= M, /* ZP */ !,
|
||||||
format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,T]),
|
format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,T]),
|
||||||
format(user_error,' Do you want to import it from ~w ? [y or n] ',M),
|
format(user_error,' Do you want to import it from ~w ? [y or n] ',M),
|
||||||
repeat,
|
repeat,
|
||||||
get0(C), $skipeol(C),
|
get0(C), '$skipeol'(C),
|
||||||
( C is "y" -> erase(R), !;
|
( C is "y" -> erase(R), !;
|
||||||
C is "n" -> !, fail;
|
C is "n" -> !, fail;
|
||||||
write(user_error, ' Please answer with ''y'' or ''n'' '), fail
|
write(user_error, ' Please answer with ''y'' or ''n'' '), fail
|
||||||
).
|
).
|
||||||
$check_import(_,_,_,_).
|
'$check_import'(_,_,_,_).
|
||||||
|
|
||||||
% $use_preds(Imports,Publics,Mod,M)
|
% $use_preds(Imports,Publics,Mod,M)
|
||||||
'$use_preds'([],_,_,_) :- !.
|
'$use_preds'([],_,_,_) :- !.
|
||||||
@ -299,7 +299,7 @@ $check_import(_,_,_,_).
|
|||||||
tell('P0:debug'),
|
tell('P0:debug'),
|
||||||
write(X),nl,
|
write(X),nl,
|
||||||
tell(F), fail.
|
tell(F), fail.
|
||||||
'$trace_module'(X).
|
'$trace_module'(_).
|
||||||
|
|
||||||
'$trace_module'(X,Y) :- X==Y, !.
|
'$trace_module'(X,Y) :- X==Y, !.
|
||||||
'$trace_module'(X,Y) :-
|
'$trace_module'(X,Y) :-
|
||||||
@ -309,7 +309,7 @@ $check_import(_,_,_,_).
|
|||||||
portray_clause(X),
|
portray_clause(X),
|
||||||
portray_clause(Y),
|
portray_clause(Y),
|
||||||
tell(F),fail.
|
tell(F),fail.
|
||||||
$trace_module(X,Y).
|
'$trace_module'(_,_).
|
||||||
|
|
||||||
%
|
%
|
||||||
% calling the meta-call expansion facility and expand_goal from
|
% calling the meta-call expansion facility and expand_goal from
|
||||||
@ -338,7 +338,7 @@ $trace_module(X,Y).
|
|||||||
% current module for fixing up meta-call arguments
|
% current module for fixing up meta-call arguments
|
||||||
% current module for predicate
|
% current module for predicate
|
||||||
% head variables.
|
% head variables.
|
||||||
'$module_expansion'(V,call(MM:V),call(MM:V),M,MM,TM,HVars) :- var(V), !.
|
'$module_expansion'(V,call(MM:V),call(MM:V),_M,MM,_TM,_) :- var(V), !.
|
||||||
'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars) :- !,
|
'$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars) :- !,
|
||||||
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
|
||||||
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
|
||||||
@ -353,9 +353,9 @@ $trace_module(X,Y).
|
|||||||
'$module_expansion'(false,false,false,_,_,_,_) :- !.
|
'$module_expansion'(false,false,false,_,_,_,_) :- !.
|
||||||
% if I don't know what the module is, I cannot do anything to the goal,
|
% if I don't know what the module is, I cannot do anything to the goal,
|
||||||
% so I just put a call for later on.
|
% so I just put a call for later on.
|
||||||
'$module_expansion'(M:G,call(M:G),call(M:G),_,_,_,HVars) :- var(M), !.
|
'$module_expansion'(M:G,call(M:G),call(M:G),_,_,_,_) :- var(M), !.
|
||||||
% if M1 is given explicitly process G within M1's context.
|
% if M1 is given explicitly process G within M1's context.
|
||||||
'$module_expansion'(M:G,G1,GO,Mod,MM,TM,HVars) :- !,
|
'$module_expansion'(M:G,G1,GO,_Mod,_MM,TM,HVars) :- !,
|
||||||
% is this imported from some other module M1?
|
% is this imported from some other module M1?
|
||||||
( '$imported_pred'(G, M, M1) ->
|
( '$imported_pred'(G, M, M1) ->
|
||||||
% continue recursively...
|
% continue recursively...
|
||||||
@ -435,7 +435,7 @@ $trace_module(X,Y).
|
|||||||
% '$recorded'('$meta_predicate','$meta_predicate'(M,F,N,D),_), !,
|
% '$recorded'('$meta_predicate','$meta_predicate'(M,F,N,D),_), !,
|
||||||
'$meta_predicate'(F,M,N,D), !,
|
'$meta_predicate'(F,M,N,D), !,
|
||||||
'$module_u_vars'(N,D,H,UVars).
|
'$module_u_vars'(N,D,H,UVars).
|
||||||
'$module_u_vars'(H,[]).
|
'$module_u_vars'(_,[]).
|
||||||
|
|
||||||
'$module_u_vars'(0,_,_,[]) :- !.
|
'$module_u_vars'(0,_,_,[]) :- !.
|
||||||
'$module_u_vars'(I,D,H,[Y|L]) :-
|
'$module_u_vars'(I,D,H,[Y|L]) :-
|
||||||
@ -475,14 +475,14 @@ $trace_module(X,Y).
|
|||||||
|
|
||||||
% check if an argument should be expanded
|
% check if an argument should be expanded
|
||||||
'$do_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
|
'$do_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
|
||||||
'$do_expand'(M:F,_) :- !, fail.
|
'$do_expand'(_:_,_) :- !, fail.
|
||||||
'$do_expand'(X,_).
|
'$do_expand'(_,_).
|
||||||
|
|
||||||
$not_in_vars(_,[]).
|
'$not_in_vars'(_,[]).
|
||||||
$not_in_vars(V,[X|L]) :- X\==V, $not_in_vars(V,L).
|
'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
|
||||||
|
|
||||||
current_module(Mod) :-
|
current_module(Mod) :-
|
||||||
'$recorded'($module,'$module'(Mod),_).
|
'$recorded'('$module','$module'(Mod),_).
|
||||||
|
|
||||||
current_module(Mod,TFN) :-
|
current_module(Mod,TFN) :-
|
||||||
'$recorded'('$module','$module'(TFN,Mod,_Publics),_).
|
'$recorded'('$module','$module'(TFN,Mod,_Publics),_).
|
||||||
|
43
pl/preds.yap
43
pl/preds.yap
@ -30,9 +30,8 @@ assert(V) :- var(V), !,
|
|||||||
throw(error(instantiation_error,assert(V))).
|
throw(error(instantiation_error,assert(V))).
|
||||||
assert(C) :- '$assert'(C,last,_,assert(C)).
|
assert(C) :- '$assert'(C,last,_,assert(C)).
|
||||||
|
|
||||||
'$assert'(V,Where,R,P) :- var(V), !,
|
'$assert'(V,_,_,_) :- var(V), !,
|
||||||
'$current_module'(M),
|
throw(error(instantiation_error,assert(V))).
|
||||||
throw(error(instantiation_error,P)).
|
|
||||||
'$assert'(M:C,Where,R,P) :- !,
|
'$assert'(M:C,Where,R,P) :- !,
|
||||||
'$mod_switch'(M,'$assert'(C,Where,R,P)).
|
'$mod_switch'(M,'$assert'(C,Where,R,P)).
|
||||||
'$assert'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
|
'$assert'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
|
||||||
@ -62,9 +61,8 @@ assert(C) :- '$assert'(C,last,_,assert(C)).
|
|||||||
).
|
).
|
||||||
|
|
||||||
|
|
||||||
'$assert_dynamic'(V,Where,R,P) :- var(V), !,
|
'$assert_dynamic'(V,_,_,_) :- var(V), !,
|
||||||
'$current_module'(M),
|
throw(error(instantiation_error,assert(V))).
|
||||||
throw(error(instantiation_error,P)).
|
|
||||||
'$assert_dynamic'(M:C,Where,R,P) :- !,
|
'$assert_dynamic'(M:C,Where,R,P) :- !,
|
||||||
'$mod_switch'(M,'$assert_dynamic'(C,Where,R,P)).
|
'$mod_switch'(M,'$assert_dynamic'(C,Where,R,P)).
|
||||||
'$assert_dynamic'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
|
'$assert_dynamic'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
|
||||||
@ -103,9 +101,8 @@ assertz_static(V) :- var(V), !,
|
|||||||
assertz_static(C) :-
|
assertz_static(C) :-
|
||||||
'$assert_static'(C,last,_,assertz_static(C)).
|
'$assert_static'(C,last,_,assertz_static(C)).
|
||||||
|
|
||||||
'$assert_static'(V,Where,R,P) :- var(V), !,
|
'$assert_static'(V,_,_,_) :- var(V), !,
|
||||||
'$current_module'(M),
|
throw(error(instantiation_error,assert(V))).
|
||||||
throw(error(instantiation_error,P)).
|
|
||||||
'$assert_static'(M:C,Where,R,P) :- !,
|
'$assert_static'(M:C,Where,R,P) :- !,
|
||||||
'$mod_switch'(M,'$assert_static'(C,Where,R,P)).
|
'$mod_switch'(M,'$assert_static'(C,Where,R,P)).
|
||||||
'$assert_static'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
|
'$assert_static'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ; H=M:C), !,
|
||||||
@ -133,7 +130,8 @@ assertz_static(C) :-
|
|||||||
'$compile_dynamic'((Head:-Body),2,CR),
|
'$compile_dynamic'((Head:-Body),2,CR),
|
||||||
( '$get_value'('$abol',true)
|
( '$get_value'('$abol',true)
|
||||||
->
|
->
|
||||||
( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H) ; true ),
|
'$flags'(H,Fl,Fl),
|
||||||
|
( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H) ; true ),
|
||||||
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Fl) ; true )
|
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Fl) ; true )
|
||||||
;
|
;
|
||||||
true
|
true
|
||||||
@ -152,6 +150,7 @@ assertz_static(C) :-
|
|||||||
'$compile_dynamic'((Head:-Body),0,CR),
|
'$compile_dynamic'((Head:-Body),0,CR),
|
||||||
( '$get_value'('$abol',true)
|
( '$get_value'('$abol',true)
|
||||||
->
|
->
|
||||||
|
'$flags'(H,Fl,Fl),
|
||||||
( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H) ; true ),
|
( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H) ; true ),
|
||||||
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Fl) ; true )
|
( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Fl) ; true )
|
||||||
;
|
;
|
||||||
@ -248,6 +247,7 @@ clause(P,Q,R) :-
|
|||||||
( '$is_dynamic'(P) ->
|
( '$is_dynamic'(P) ->
|
||||||
'$recordedp'(P,(P:-Q),R)
|
'$recordedp'(P,(P:-Q),R)
|
||||||
;
|
;
|
||||||
|
functor(P,N,A),
|
||||||
throw(error(permission_error(access,private_procedure,N/A),
|
throw(error(permission_error(access,private_procedure,N/A),
|
||||||
clause(P,Q,R)))
|
clause(P,Q,R)))
|
||||||
).
|
).
|
||||||
@ -278,8 +278,8 @@ retract(C,R) :-
|
|||||||
var(R),
|
var(R),
|
||||||
'$recordedp'(H,(H:-B),R),
|
'$recordedp'(H,(H:-B),R),
|
||||||
erase(R).
|
erase(R).
|
||||||
retract(C,R) :-
|
retract(C,_) :-
|
||||||
'$fetch_predicate_indicator_from_clause'(C, PI).
|
'$fetch_predicate_indicator_from_clause'(C, PI),
|
||||||
throw(error(permission_error(modify,static_procedure,PI),retract(C))).
|
throw(error(permission_error(modify,static_procedure,PI),retract(C))).
|
||||||
|
|
||||||
'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
|
'$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
|
||||||
@ -305,7 +305,7 @@ retractall(T) :-
|
|||||||
'$erase_all_clauses_for_dynamic'(T) :-
|
'$erase_all_clauses_for_dynamic'(T) :-
|
||||||
'$recordedp'(T,(T :- _),R), erase(R), fail.
|
'$recordedp'(T,(T :- _),R), erase(R), fail.
|
||||||
'$erase_all_clauses_for_dynamic'(T) :-
|
'$erase_all_clauses_for_dynamic'(T) :-
|
||||||
'$recordedp'(T,C,R), fail.
|
'$recordedp'(T,_,_), fail.
|
||||||
'$erase_all_clauses_for_dynamic'(_).
|
'$erase_all_clauses_for_dynamic'(_).
|
||||||
|
|
||||||
abolish(N,A) :- var(N), !,
|
abolish(N,A) :- var(N), !,
|
||||||
@ -358,19 +358,19 @@ abolish(X) :-
|
|||||||
'$check_error_in_predicate_indicator'(S, Msg) :-
|
'$check_error_in_predicate_indicator'(S, Msg) :-
|
||||||
S \= _/_, !,
|
S \= _/_, !,
|
||||||
throw(error(type_error(predicate_indicator,S), Msg)).
|
throw(error(type_error(predicate_indicator,S), Msg)).
|
||||||
'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
|
'$check_error_in_predicate_indicator'(Na/_, Msg) :-
|
||||||
var(Na), !,
|
var(Na), !,
|
||||||
throw(error(instantiation_error, Msg)).
|
throw(error(instantiation_error, Msg)).
|
||||||
'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
|
'$check_error_in_predicate_indicator'(Na/_, Msg) :-
|
||||||
\+ atom(Na), !,
|
\+ atom(Na), !,
|
||||||
throw(error(type_error(atom,Na), Msg)).
|
throw(error(type_error(atom,Na), Msg)).
|
||||||
'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
|
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
|
||||||
var(Ar), !,
|
var(Ar), !,
|
||||||
throw(error(instantiation_error, Msg)).
|
throw(error(instantiation_error, Msg)).
|
||||||
'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
|
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
|
||||||
\+ integer(Ar), !,
|
\+ integer(Ar), !,
|
||||||
throw(error(type_error(integer,Ar), Msg)).
|
throw(error(type_error(integer,Ar), Msg)).
|
||||||
'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
|
'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
|
||||||
Ar < 0, !,
|
Ar < 0, !,
|
||||||
throw(error(domain_error(not_less_than_zero,Ar), Msg)).
|
throw(error(domain_error(not_less_than_zero,Ar), Msg)).
|
||||||
% not yet implemented!
|
% not yet implemented!
|
||||||
@ -383,7 +383,7 @@ abolish(X) :-
|
|||||||
throw(error(instantiation_error, Msg)).
|
throw(error(instantiation_error, Msg)).
|
||||||
'$check_error_in_module'(M, Msg) :-
|
'$check_error_in_module'(M, Msg) :-
|
||||||
\+ atom(M), !,
|
\+ atom(M), !,
|
||||||
throw(error(type_error(atom,Na), Msg)).
|
throw(error(type_error(atom,M), Msg)).
|
||||||
|
|
||||||
'$old_abolish'(V) :- var(V), !,
|
'$old_abolish'(V) :- var(V), !,
|
||||||
'$abolish_all_old'.
|
'$abolish_all_old'.
|
||||||
@ -422,6 +422,7 @@ abolish(X) :-
|
|||||||
% this code has to be here because of abolish/2
|
% this code has to be here because of abolish/2
|
||||||
'$abolishs'(G) :-
|
'$abolishs'(G) :-
|
||||||
'$has_yap_or', !,
|
'$has_yap_or', !,
|
||||||
|
functor(G,A,N),
|
||||||
throw(error(permission_error(modify,static_procedure,A/N),abolish(G))).
|
throw(error(permission_error(modify,static_procedure,A/N),abolish(G))).
|
||||||
'$abolishs'(G) :-
|
'$abolishs'(G) :-
|
||||||
'$purge_clauses'(G),
|
'$purge_clauses'(G),
|
||||||
@ -455,13 +456,13 @@ dynamic(X) :-
|
|||||||
F /\ 16'400 =:= 16'400, '$undefined'(T) -> F1 is F /\ \(0x600), NF is F1 \/ 16'2000, '$flags'(T,F,NF);
|
F /\ 16'400 =:= 16'400, '$undefined'(T) -> F1 is F /\ \(0x600), NF is F1 \/ 16'2000, '$flags'(T,F,NF);
|
||||||
F/\16'8 =:= 16'8 -> true ;
|
F/\16'8 =:= 16'8 -> true ;
|
||||||
throw(error(permission_error(modify,static_procedure,A/N),dynamic(A/N)))
|
throw(error(permission_error(modify,static_procedure,A/N),dynamic(A/N)))
|
||||||
), $flags(T,F1,F1).
|
), '$flags'(T,F1,F1).
|
||||||
'$dynamic2'(X) :-
|
'$dynamic2'(X) :-
|
||||||
throw(error(type_error(callable,X),dynamic(X))).
|
throw(error(type_error(callable,X),dynamic(X))).
|
||||||
|
|
||||||
|
|
||||||
'$logical_updatable'(A/N) :- integer(N), atom(A), !,
|
'$logical_updatable'(A/N) :- integer(N), atom(A), !,
|
||||||
functor(T,A,N), $flags(T,F,F),
|
functor(T,A,N), '$flags'(T,F,F),
|
||||||
( F/\16'9bc88 =:= 0 -> NF is F \/ 16'408, '$flags'(T,F,NF);
|
( F/\16'9bc88 =:= 0 -> NF is F \/ 16'408, '$flags'(T,F,NF);
|
||||||
'$is_dynamic'(T) -> true;
|
'$is_dynamic'(T) -> true;
|
||||||
F /\ 16'400 =:= 16'400 , '$undefined'(T) -> NF is F \/ 0x8, '$flags'(T,F,NF);
|
F /\ 16'400 =:= 16'400 , '$undefined'(T) -> NF is F \/ 0x8, '$flags'(T,F,NF);
|
||||||
|
14
pl/setof.yap
14
pl/setof.yap
@ -23,7 +23,7 @@
|
|||||||
|
|
||||||
:- op(50,xfx,same).
|
:- op(50,xfx,same).
|
||||||
|
|
||||||
Variable^Goal :-
|
_^Goal :-
|
||||||
'$execute'(Goal).
|
'$execute'(Goal).
|
||||||
|
|
||||||
|
|
||||||
@ -75,11 +75,11 @@ findall(Template, Generator, Answers, SoFar) :-
|
|||||||
% by getting all answers
|
% by getting all answers
|
||||||
'$collect_with_common_vars'(Ref, VarList, SoFar, Solution) :-
|
'$collect_with_common_vars'(Ref, VarList, SoFar, Solution) :-
|
||||||
'$db_dequeue'(Ref, BDEntry), !,
|
'$db_dequeue'(Ref, BDEntry), !,
|
||||||
BDEntry = Key-Term,
|
BDEntry = Key-_,
|
||||||
Solution = [BDEntry|Answers],
|
Solution = [BDEntry|Answers],
|
||||||
'$variables_in_term'(Key, _, VarList),
|
'$variables_in_term'(Key, _, VarList),
|
||||||
'$collect_with_common_vars'(Ref, VarList, SoFar, Answers).
|
'$collect_with_common_vars'(Ref, VarList, SoFar, Answers).
|
||||||
'$collect_with_common_vars'(Ref, VarList, Solution, Solution).
|
'$collect_with_common_vars'(_, _, Solution, Solution).
|
||||||
|
|
||||||
% This is the setof predicate
|
% This is the setof predicate
|
||||||
|
|
||||||
@ -154,11 +154,11 @@ bagof(Template, Generator, Bag) :-
|
|||||||
'$excess_vars'(bagof(X,P,S), Y, L0, L) :- !,
|
'$excess_vars'(bagof(X,P,S), Y, L0, L) :- !,
|
||||||
'$variables_in_term'(X+Y, [], NY),
|
'$variables_in_term'(X+Y, [], NY),
|
||||||
'$excess_vars'((P,S), NY, L0, L).
|
'$excess_vars'((P,S), NY, L0, L).
|
||||||
'$excess_vars'(findall(X,P,S), Y, L0, L) :- !,
|
'$excess_vars'(findall(_,_,S), Y, L0, L) :- !,
|
||||||
'$excess_vars'(S, Y, L0, L).
|
'$excess_vars'(S, Y, L0, L).
|
||||||
'$excess_vars'(findall(X,P,S0,S), Y, L0, L) :- !,
|
'$excess_vars'(findall(_,_,_,S), Y, L0, L) :- !,
|
||||||
'$excess_vars'(S, Y, L0, L).
|
'$excess_vars'(S, Y, L0, L).
|
||||||
'$excess_vars'(\+G, _, L0, LF) :- !,
|
'$excess_vars'(\+_, _, L0, LF) :- !,
|
||||||
L0 = LF.
|
L0 = LF.
|
||||||
'$excess_vars'(_:G, Y, L0, LF) :- !,
|
'$excess_vars'(_:G, Y, L0, LF) :- !,
|
||||||
'$excess_vars'(G, Y, L0, LF).
|
'$excess_vars'(G, Y, L0, LF).
|
||||||
@ -171,7 +171,7 @@ bagof(Template, Generator, Bag) :-
|
|||||||
'$excess_vars'(T1, X, L0, L1),
|
'$excess_vars'(T1, X, L0, L1),
|
||||||
'$recurse_for_excess_vars'(LArgs, X, L1, L).
|
'$recurse_for_excess_vars'(LArgs, X, L1, L).
|
||||||
|
|
||||||
'$doesnt_include'([], X).
|
'$doesnt_include'([], _).
|
||||||
'$doesnt_include'([Y|L], X) :-
|
'$doesnt_include'([Y|L], X) :-
|
||||||
Y \== X,
|
Y \== X,
|
||||||
'$doesnt_include'(L, X).
|
'$doesnt_include'(L, X).
|
||||||
|
@ -35,7 +35,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
|
|||||||
'$check_list'(V,G) :- var(V), !,
|
'$check_list'(V,G) :- var(V), !,
|
||||||
throw(error(instantiation_error,G)).
|
throw(error(instantiation_error,G)).
|
||||||
'$check_list'([],_) :- !.
|
'$check_list'([],_) :- !.
|
||||||
'$check_list'([Opt|T],G) :- !,
|
'$check_list'([_|T],G) :- !,
|
||||||
'$check_list'(T,G).
|
'$check_list'(T,G).
|
||||||
'$check_io_opts'(T,G) :-
|
'$check_io_opts'(T,G) :-
|
||||||
throw(error(type_error(list,T),G)).
|
throw(error(type_error(list,T),G)).
|
||||||
@ -44,13 +44,13 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
|
|||||||
'$select_cp_fds'([_-Fd|L], Fds0, [Fd|Fds]) :-
|
'$select_cp_fds'([_-Fd|L], Fds0, [Fd|Fds]) :-
|
||||||
'$select_cp_fds'(L, Fds0, Fds).
|
'$select_cp_fds'(L, Fds0, Fds).
|
||||||
|
|
||||||
'$check_select_time'(V, Sec, USec, Goal) :-
|
'$check_select_time'(V, _, _, Goal) :-
|
||||||
var(V), !,
|
var(V), !,
|
||||||
throw(error(instantiation_error,G)).
|
throw(error(instantiation_error,Goal)).
|
||||||
'$check_select_time'(off, -1, -1, _).
|
'$check_select_time'(off, -1, -1, _).
|
||||||
'$check_select_time'(Sec0:Usec0, Sec, USec, _) :-
|
'$check_select_time'(Sec0:USec0, Sec, USec, _) :-
|
||||||
Sec is Sec0,
|
Sec is Sec0,
|
||||||
Usec0 is Usec,
|
USec is USec0,
|
||||||
Sec > 0, USec > 0.
|
Sec > 0, USec > 0.
|
||||||
|
|
||||||
'$cp_socket_fds'([], Fds, [], Fds).
|
'$cp_socket_fds'([], Fds, [], Fds).
|
||||||
@ -60,7 +60,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
|
|||||||
socket_accept(Socket, Client, Stream),
|
socket_accept(Socket, Client, Stream),
|
||||||
'$cp_socket_fds'(Scks, Fds, Out, StrFds).
|
'$cp_socket_fds'(Scks, Fds, Out, StrFds).
|
||||||
|
|
||||||
'$cp_stream_fds'([], Fds, []).
|
'$cp_stream_fds'([], _, []).
|
||||||
'$cp_stream_fds'([_|Strs], [[]|Fds], Out) :- !,
|
'$cp_stream_fds'([_|Strs], [[]|Fds], Out) :- !,
|
||||||
'$cp_stream_fds'(Strs, Fds, Out).
|
'$cp_stream_fds'(Strs, Fds, Out).
|
||||||
'$cp_stream_fds'([Stream|Strs], [Stream|Fds], [Stream|Out]) :-
|
'$cp_stream_fds'([Stream|Strs], [Stream|Fds], [Stream|Out]) :-
|
||||||
@ -75,7 +75,7 @@ socket_buffering(Sock, Flag, InSize, OutSize) :-
|
|||||||
'$convert_sock_buff'(OutSize, OutNumb).
|
'$convert_sock_buff'(OutSize, OutNumb).
|
||||||
|
|
||||||
'$convert_sock_buff'(unbuf, 1) :- !.
|
'$convert_sock_buff'(unbuf, 1) :- !.
|
||||||
'$convert_sock_buff'(fullbuf, InNumb).
|
'$convert_sock_buff'(fullbuf, _).
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -12,10 +12,10 @@
|
|||||||
'$iso_check_goal'((G1;G2),G0) :- !,
|
'$iso_check_goal'((G1;G2),G0) :- !,
|
||||||
'$iso_check_a_goal'(G1,(G1;G2),G0),
|
'$iso_check_a_goal'(G1,(G1;G2),G0),
|
||||||
'$iso_check_a_goal'(G2,(G1;G2),G0).
|
'$iso_check_a_goal'(G2,(G1;G2),G0).
|
||||||
'$iso_check_goal'((G1->G2),(G1->G2),G0) :- !,
|
'$iso_check_goal'((G1->G2),G0) :- !,
|
||||||
'$iso_check_a_goal'(G1,(G1->G2),G0),
|
'$iso_check_a_goal'(G1,(G1->G2),G0),
|
||||||
'$iso_check_a_goal'(G2,(G1->G2),G0).
|
'$iso_check_a_goal'(G2,(G1->G2),G0).
|
||||||
'$iso_check_goal'(!,G0) :- !.
|
'$iso_check_goal'(!,_) :- !.
|
||||||
'$iso_check_goal'((G1|G2),G0) :-
|
'$iso_check_goal'((G1|G2),G0) :-
|
||||||
'$access_yap_flags'(9,1), !,
|
'$access_yap_flags'(9,1), !,
|
||||||
throw(error(domain_error(builtin_procedure,(G1|G2)), call(G0))).
|
throw(error(domain_error(builtin_procedure,(G1|G2)), call(G0))).
|
||||||
@ -30,7 +30,7 @@
|
|||||||
->
|
->
|
||||||
true
|
true
|
||||||
;
|
;
|
||||||
throw(error(domain_error(builtin_procedure,G), G))
|
throw(error(domain_error(builtin_procedure,G), call(G0)))
|
||||||
).
|
).
|
||||||
'$iso_check_goal'(_,_).
|
'$iso_check_goal'(_,_).
|
||||||
|
|
||||||
@ -55,7 +55,7 @@
|
|||||||
'$iso_check_a_goal'((_|_),E,G0) :-
|
'$iso_check_a_goal'((_|_),E,G0) :-
|
||||||
'$access_yap_flags'(9,1), !,
|
'$access_yap_flags'(9,1), !,
|
||||||
throw(error(domain_error(builtin_procedure,E), call(G0))).
|
throw(error(domain_error(builtin_procedure,E), call(G0))).
|
||||||
'$iso_check_a_goal'((G1|G2),_,G0) :- !.
|
'$iso_check_a_goal'((_|_),_,_) :- !.
|
||||||
'$iso_check_a_goal'(G,_,G0) :-
|
'$iso_check_a_goal'(G,_,G0) :-
|
||||||
'$access_yap_flags'(9,1),
|
'$access_yap_flags'(9,1),
|
||||||
'$system_predicate'(G),
|
'$system_predicate'(G),
|
||||||
@ -64,13 +64,13 @@
|
|||||||
->
|
->
|
||||||
true
|
true
|
||||||
;
|
;
|
||||||
throw(error(domain_error(builtin_procedure,G), G))
|
throw(error(domain_error(builtin_procedure,G), call(G0)))
|
||||||
).
|
).
|
||||||
'$iso_check_a_goal'(_,_,_).
|
'$iso_check_a_goal'(_,_,_).
|
||||||
|
|
||||||
'$check_iso_strict_clause'((G:-B)) :- !,
|
'$check_iso_strict_clause'((_:-B)) :- !,
|
||||||
'$check_iso_strict_body'(B).
|
'$check_iso_strict_body'(B).
|
||||||
'$check_iso_strict_clause'(G).
|
'$check_iso_strict_clause'(_).
|
||||||
|
|
||||||
'$check_iso_strict_body'((B1,B2)) :- !,
|
'$check_iso_strict_body'((B1,B2)) :- !,
|
||||||
'$check_iso_strict_body'(B1),
|
'$check_iso_strict_body'(B1),
|
||||||
|
@ -21,7 +21,7 @@ table(X) :- var(X), !,
|
|||||||
fail.
|
fail.
|
||||||
table((A,B)) :- !, table(A), table(B).
|
table((A,B)) :- !, table(A), table(B).
|
||||||
table(A/N) :- integer(N), atom(A), !,
|
table(A/N) :- integer(N), atom(A), !,
|
||||||
functor(T,A,N), $flags(T,F,F),
|
functor(T,A,N), '$flags'(T,F,F),
|
||||||
(
|
(
|
||||||
X is F /\ 8'000100, X =\= 0, !,
|
X is F /\ 8'000100, X =\= 0, !,
|
||||||
write(user_error, '[ Warning: '),
|
write(user_error, '[ Warning: '),
|
||||||
@ -29,7 +29,7 @@ table(A/N) :- integer(N), atom(A), !,
|
|||||||
write(user_error, ' is already declared as table ]'),
|
write(user_error, ' is already declared as table ]'),
|
||||||
nl(user_error)
|
nl(user_error)
|
||||||
;
|
;
|
||||||
X is F /\ 8'170000, X =:= 0, !, $table(T)
|
X is F /\ 8'170000, X =:= 0, !, '$table'(T)
|
||||||
;
|
;
|
||||||
write(user_error, '[ Error: '),
|
write(user_error, '[ Error: '),
|
||||||
write(user_error, A/N),
|
write(user_error, A/N),
|
||||||
@ -49,9 +49,9 @@ show_trie(X) :- var(X), !,
|
|||||||
nl(user_error),
|
nl(user_error),
|
||||||
fail.
|
fail.
|
||||||
show_trie(A/N) :- integer(N), atom(A), !,
|
show_trie(A/N) :- integer(N), atom(A), !,
|
||||||
functor(T,A,N), $flags(T,F,F),
|
functor(T,A,N), '$flags'(T,F,F),
|
||||||
(
|
(
|
||||||
X is F /\ 8'000100, X =\= 0, !, $show_trie(T,_)
|
X is F /\ 8'000100, X =\= 0, !, '$show_trie'(T,_)
|
||||||
;
|
;
|
||||||
write(user_error, '[ Error: '),
|
write(user_error, '[ Error: '),
|
||||||
write(user_error, A/N),
|
write(user_error, A/N),
|
||||||
@ -71,9 +71,9 @@ abolish_trie(X) :- var(X), !,
|
|||||||
nl(user_error),
|
nl(user_error),
|
||||||
fail.
|
fail.
|
||||||
abolish_trie(A/N) :- integer(N), atom(A), !,
|
abolish_trie(A/N) :- integer(N), atom(A), !,
|
||||||
functor(T,A,N), $flags(T,F,F),
|
functor(T,A,N), '$flags'(T,F,F),
|
||||||
(
|
(
|
||||||
X is F /\ 8'000100, X =\= 0, !, $abolish_trie(T)
|
X is F /\ 8'000100, X =\= 0, !, '$abolish_trie'(T)
|
||||||
;
|
;
|
||||||
write(user_error, '[ Error: '),
|
write(user_error, '[ Error: '),
|
||||||
write(user_error, A/N),
|
write(user_error, A/N),
|
||||||
|
47
pl/utils.yap
47
pl/utils.yap
@ -17,12 +17,12 @@
|
|||||||
|
|
||||||
once(G) :- '$execute'(G), !.
|
once(G) :- '$execute'(G), !.
|
||||||
|
|
||||||
if(X,Y,Z) :-
|
if(X,Y,_Z) :-
|
||||||
CP is '$last_choice_pt',
|
CP is '$last_choice_pt',
|
||||||
'$execute'(X),
|
'$execute'(X),
|
||||||
'$clean_ifcp'(CP),
|
'$clean_ifcp'(CP),
|
||||||
'$execute'(Y).
|
'$execute'(Y).
|
||||||
if(X,Y,Z) :-
|
if(_X,_Y,Z) :-
|
||||||
'$execute'(Z).
|
'$execute'(Z).
|
||||||
|
|
||||||
|
|
||||||
@ -341,6 +341,8 @@ current_atom(A) :- % check
|
|||||||
current_atom(A) :- % generate
|
current_atom(A) :- % generate
|
||||||
'$current_atom'(A).
|
'$current_atom'(A).
|
||||||
|
|
||||||
|
current_predicate(A,T) :- var(T), !, % only for the predicate
|
||||||
|
'$current_predicate_no_modules'(A,T).
|
||||||
current_predicate(A,M:T) :- % module specified
|
current_predicate(A,M:T) :- % module specified
|
||||||
var(M), !,
|
var(M), !,
|
||||||
current_module(M),
|
current_module(M),
|
||||||
@ -352,6 +354,8 @@ current_predicate(A,M:T) :- % module specified
|
|||||||
current_predicate(A,T) :- % only for the predicate
|
current_predicate(A,T) :- % only for the predicate
|
||||||
'$current_predicate_no_modules'(A,T).
|
'$current_predicate_no_modules'(A,T).
|
||||||
|
|
||||||
|
current_predicate(F) :- var(F), !, % only for the predicate
|
||||||
|
'$current_predicate3'(F).
|
||||||
current_predicate(M:F) :- % module specified
|
current_predicate(M:F) :- % module specified
|
||||||
var(M), !,
|
var(M), !,
|
||||||
current_module(M),
|
current_module(M),
|
||||||
@ -364,13 +368,9 @@ current_predicate(F) :- % only for the predicate
|
|||||||
'$current_predicate3'(F).
|
'$current_predicate3'(F).
|
||||||
|
|
||||||
system_predicate(A,P) :-
|
system_predicate(A,P) :-
|
||||||
'$mod_switch'(prolog,'$current_predicate_no_modules'(A,T)),
|
'$mod_switch'(prolog,'$current_predicate_no_modules'(A,P)),
|
||||||
\+ '$hidden'(A).
|
\+ '$hidden'(A).
|
||||||
|
|
||||||
'$system_predicate'(Pred) :-
|
|
||||||
'$flags'(Pred,Flags,_),
|
|
||||||
Flags /\ 8'40000 =\= 0.
|
|
||||||
|
|
||||||
system_predicate(P) :- '$system_predicate'(P).
|
system_predicate(P) :- '$system_predicate'(P).
|
||||||
|
|
||||||
'$current_predicate_no_modules'(A,T) :-
|
'$current_predicate_no_modules'(A,T) :-
|
||||||
@ -402,7 +402,7 @@ statistics :-
|
|||||||
'$inform_gc'(NOfGC,TotGCTime,TotGCSize),
|
'$inform_gc'(NOfGC,TotGCTime,TotGCSize),
|
||||||
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize).
|
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize).
|
||||||
|
|
||||||
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize) :-
|
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,_HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize) :-
|
||||||
TotalMemory is HpSpa+StkSpa+TrlSpa,
|
TotalMemory is HpSpa+StkSpa+TrlSpa,
|
||||||
format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
|
format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
|
||||||
format(user_error," program space~t~d bytes~35+", [HpSpa]),
|
format(user_error," program space~t~d bytes~35+", [HpSpa]),
|
||||||
@ -573,15 +573,15 @@ predicate_property(Pred,Prop) :-
|
|||||||
'$is_multifile'(N,A).
|
'$is_multifile'(N,A).
|
||||||
'$predicate_property'(P,imported_from(Mod)) :-
|
'$predicate_property'(P,imported_from(Mod)) :-
|
||||||
functor(P,N,A),
|
functor(P,N,A),
|
||||||
'$recorded'($module,$module(_TFN,Mod,Publics),_),
|
'$recorded'('$module','$module'(_TFN,Mod,Publics),_),
|
||||||
$member(N/A,Publics). /* defined in modules.yap */
|
'$member'(N/A,Publics). /* defined in modules.yap */
|
||||||
'$predicate_property'(P,public) :-
|
'$predicate_property'(P,public) :-
|
||||||
'$is_public'(P).
|
'$is_public'(P).
|
||||||
'$predicate_property'(P,exported) :-
|
'$predicate_property'(P,exported) :-
|
||||||
functor(P,N,A),
|
functor(P,N,A),
|
||||||
$current_module(M),
|
'$current_module'(M),
|
||||||
'$recorded'($module,$module(_TFN,M,Publics),_),
|
'$recorded'('$module','$module'(_TFN,M,Publics),_),
|
||||||
$member(N/A,Publics). /* defined in modules.yap */
|
'$member'(N/A,Publics). /* defined in modules.yap */
|
||||||
|
|
||||||
%%% Some "dirty" predicates
|
%%% Some "dirty" predicates
|
||||||
|
|
||||||
@ -593,8 +593,8 @@ predicate_property(Pred,Prop) :-
|
|||||||
'$pred_exists'(Pred) :- \+ '$undefined'(Pred).
|
'$pred_exists'(Pred) :- \+ '$undefined'(Pred).
|
||||||
|
|
||||||
|
|
||||||
grow_heap(X) :- $grow_heap(X).
|
grow_heap(X) :- '$grow_heap'(X).
|
||||||
grow_stack(X) :- $grow_stack(X).
|
grow_stack(X) :- '$grow_stack'(X).
|
||||||
|
|
||||||
%
|
%
|
||||||
% gc() expects to be called from "call". Make sure it has an
|
% gc() expects to be called from "call". Make sure it has an
|
||||||
@ -615,7 +615,7 @@ profile_data(P, Parm, Data) :- var(P), !,
|
|||||||
profile_data(M:P, Parm, Data) :- var(M), !,
|
profile_data(M:P, Parm, Data) :- var(M), !,
|
||||||
throw(error(instantiation_error,profile_data(M:P, Parm, Data))).
|
throw(error(instantiation_error,profile_data(M:P, Parm, Data))).
|
||||||
profile_data(M:P, Parm, Data) :- var(M), !,
|
profile_data(M:P, Parm, Data) :- var(M), !,
|
||||||
'$mod_switch'(Mod,'$profile_data'(P, Parm, Data)).
|
'$mod_switch'(M,'$profile_data'(P, Parm, Data)).
|
||||||
profile_data(P, Parm, Data) :-
|
profile_data(P, Parm, Data) :-
|
||||||
'$profile_data'(P, Parm, Data).
|
'$profile_data'(P, Parm, Data).
|
||||||
|
|
||||||
@ -735,21 +735,6 @@ sub_atom(At, Bef, Size, After, SubAt) :-
|
|||||||
X11 is X1+1,
|
X11 is X1+1,
|
||||||
'$range_var'(X11,X2,XF).
|
'$range_var'(X11,X2,XF).
|
||||||
|
|
||||||
|
|
||||||
current_predicate(V) :- var(V), !,
|
|
||||||
current_predicate(_,S),
|
|
||||||
functor(S,Na,Ar),
|
|
||||||
V = Na/Ar.
|
|
||||||
current_predicate(Na/Ar) :- !,
|
|
||||||
current_predicate(Na,S),
|
|
||||||
\+ '$system_predicate'(S),
|
|
||||||
functor(S,Na,Ar).
|
|
||||||
current_predicate(M:X) :- !,
|
|
||||||
'$mod_switch'(M,current_predicate(X)).
|
|
||||||
current_predicate(T) :-
|
|
||||||
throw(error(type_error(predicate_indicator,T),current_predicate(T))).
|
|
||||||
|
|
||||||
|
|
||||||
'$singletons_in_term'(T,VL) :-
|
'$singletons_in_term'(T,VL) :-
|
||||||
'$variables_in_term'(T,[],V10),
|
'$variables_in_term'(T,[],V10),
|
||||||
'$sort'(V10, V1),
|
'$sort'(V10, V1),
|
||||||
|
@ -15,8 +15,9 @@
|
|||||||
* *
|
* *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
'$parallel_query'(G,[]) :- !, '$start_yapor', '$execute'(G), !, $parallel_yes_answer.
|
'$parallel_query'(G,[]) :- !, '$start_yapor', '$execute'(G), !,
|
||||||
'$parallel_query'(G,V) :- '$start_yapor', '$execute'(G), $parallel_new_answer(V).
|
'$parallel_yes_answer'.
|
||||||
|
'$parallel_query'(G,V) :- '$start_yapor', '$execute'(G), '$parallel_new_answer'(V).
|
||||||
|
|
||||||
% ***************************
|
% ***************************
|
||||||
% * -------- YAPOR -------- *
|
% * -------- YAPOR -------- *
|
||||||
@ -79,7 +80,7 @@ parallel(A/N) :- integer(N), atom(A), !,
|
|||||||
write(user_error, ' is already declared as sequential ]'),
|
write(user_error, ' is already declared as sequential ]'),
|
||||||
nl(user_error)
|
nl(user_error)
|
||||||
;
|
;
|
||||||
X is F /\ 8'170000, X =:= 0, !, $sequential(T)
|
X is F /\ 8'170000, X =:= 0, !, '$sequential'(T)
|
||||||
;
|
;
|
||||||
write(user_error, '[ Error: '),
|
write(user_error, '[ Error: '),
|
||||||
write(user_error, A/N),
|
write(user_error, A/N),
|
||||||
|
38
pl/yio.yap
38
pl/yio.yap
@ -215,16 +215,10 @@ open(F,T,S,Opts) :-
|
|||||||
throw(error(instantiation_error,G)).
|
throw(error(instantiation_error,G)).
|
||||||
'$check_open_eof_action_arg'(error,_) :- !.
|
'$check_open_eof_action_arg'(error,_) :- !.
|
||||||
'$check_open_eof_action_arg'(eof_code,_) :- !.
|
'$check_open_eof_action_arg'(eof_code,_) :- !.
|
||||||
'$check_open_eof_action_arg'(reset,G) :- !.
|
'$check_open_eof_action_arg'(reset,_) :- !.
|
||||||
'$check_open_eof_action_arg'(X,G) :-
|
'$check_open_eof_action_arg'(X,G) :-
|
||||||
throw(error(domain_error(io_mode,eof_action(X)),G)).
|
throw(error(domain_error(io_mode,eof_action(X)),G)).
|
||||||
|
|
||||||
'$check_open_alias_arg'(T, G) :- var(X), !,
|
|
||||||
throw(error(instantiation_error,G)).
|
|
||||||
'$check_open_eof_action_arg'(T,_) :- atom(T), !.
|
|
||||||
'$check_open_alias_arg'(T, G) :- var(X), !,
|
|
||||||
throw(error(type_error(atom,T),G)).
|
|
||||||
|
|
||||||
'$check_read_syntax_errors_arg'(X, G) :- var(X), !,
|
'$check_read_syntax_errors_arg'(X, G) :- var(X), !,
|
||||||
throw(error(instantiation_error,G)).
|
throw(error(instantiation_error,G)).
|
||||||
'$check_read_syntax_errors_arg'(dec10,_) :- !.
|
'$check_read_syntax_errors_arg'(dec10,_) :- !.
|
||||||
@ -265,7 +259,7 @@ open(F,T,S,Opts) :-
|
|||||||
'$check_write_max_depth'(X, G) :- var(X), !,
|
'$check_write_max_depth'(X, G) :- var(X), !,
|
||||||
throw(error(instantiation_error,G)).
|
throw(error(instantiation_error,G)).
|
||||||
'$check_write_max_depth'(I,_) :- integer(I), I > 0, !.
|
'$check_write_max_depth'(I,_) :- integer(I), I > 0, !.
|
||||||
'$check_write_portrayed'(X,G) :-
|
'$check_write_max_depth'(X,G) :-
|
||||||
throw(error(domain_error(write_option,max_depth(X)),G)).
|
throw(error(domain_error(write_option,max_depth(X)),G)).
|
||||||
|
|
||||||
set_input(Stream) :-
|
set_input(Stream) :-
|
||||||
@ -343,7 +337,7 @@ read_term(Stream, T, Options) :-
|
|||||||
%
|
%
|
||||||
'$preprocess_read_terms_options'([]).
|
'$preprocess_read_terms_options'([]).
|
||||||
'$preprocess_read_terms_options'([syntax_errors(NewVal)|L]) :- !,
|
'$preprocess_read_terms_options'([syntax_errors(NewVal)|L]) :- !,
|
||||||
'$get_read_error_handler'(OldVal).
|
'$get_read_error_handler'(OldVal),
|
||||||
'$set_value'('$read_term_error_handler', OldVal),
|
'$set_value'('$read_term_error_handler', OldVal),
|
||||||
'$set_read_error_handler'(NewVal),
|
'$set_read_error_handler'(NewVal),
|
||||||
'$preprocess_read_terms_options'(L).
|
'$preprocess_read_terms_options'(L).
|
||||||
@ -363,12 +357,12 @@ read_term(Stream, T, Options) :-
|
|||||||
'$postprocess_read_terms_option'(syntax_errors(_), _, _) :-
|
'$postprocess_read_terms_option'(syntax_errors(_), _, _) :-
|
||||||
'$get_value'('$read_term_error_handler', OldVal),
|
'$get_value'('$read_term_error_handler', OldVal),
|
||||||
'$set_read_error_handler'(OldVal).
|
'$set_read_error_handler'(OldVal).
|
||||||
'$postprocess_read_terms_option'(variable_names(Vars), T, VL) :-
|
'$postprocess_read_terms_option'(variable_names(Vars), _, VL) :-
|
||||||
'$read_term_non_anonymous'(VL, Vars).
|
'$read_term_non_anonymous'(VL, Vars).
|
||||||
'$postprocess_read_terms_option'(singletons(Val), T, VL) :-
|
'$postprocess_read_terms_option'(singletons(Val), T, VL) :-
|
||||||
'$singletons_in_term'(T, Val1),
|
'$singletons_in_term'(T, Val1),
|
||||||
'$fetch_singleton_names'(Val1,VL,Val).
|
'$fetch_singleton_names'(Val1,VL,Val).
|
||||||
'$postprocess_read_terms_option'(variables(Val), T, VL) :-
|
'$postprocess_read_terms_option'(variables(Val), T, _) :-
|
||||||
'$variables_in_term'(T, [], Val).
|
'$variables_in_term'(T, [], Val).
|
||||||
%'$postprocess_read_terms_option'(cycles(Val), _, _).
|
%'$postprocess_read_terms_option'(cycles(Val), _, _).
|
||||||
|
|
||||||
@ -393,7 +387,7 @@ read_term(Stream, T, Options) :-
|
|||||||
% V1 @> V2,
|
% V1 @> V2,
|
||||||
'$fetch_singleton_names'(Ss, Ns, NSs).
|
'$fetch_singleton_names'(Ss, Ns, NSs).
|
||||||
|
|
||||||
'$add_singleton_if_no_underscore'([95|_],V2,NSs,NSs) :- !.
|
'$add_singleton_if_no_underscore'([95|_],_,NSs,NSs) :- !.
|
||||||
'$add_singleton_if_no_underscore'(Na,V2,NSs,[(Name=V2)|NSs]) :-
|
'$add_singleton_if_no_underscore'(Na,V2,NSs,[(Name=V2)|NSs]) :-
|
||||||
atom_codes(Name, Na).
|
atom_codes(Name, Na).
|
||||||
|
|
||||||
@ -459,25 +453,25 @@ write_term(_,_,_).
|
|||||||
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
||||||
'$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, CallBacks) :-
|
'$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, CallBacks) :-
|
||||||
FlagI is Flag0 /\ 14,
|
FlagI is Flag0 /\ 14,
|
||||||
'$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
|
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
||||||
'$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, CallBacks) :-
|
'$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, CallBacks) :-
|
||||||
FlagI is Flag0 \/ 2,
|
FlagI is Flag0 \/ 2,
|
||||||
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
||||||
'$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, CallBacks) :-
|
'$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, CallBacks) :-
|
||||||
FlagI is Flag0 /\ 13,
|
FlagI is Flag0 /\ 13,
|
||||||
'$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
|
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
||||||
'$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, CallBacks) :-
|
'$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, CallBacks) :-
|
||||||
FlagI is Flag0 \/ 4,
|
FlagI is Flag0 \/ 4,
|
||||||
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
||||||
'$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, CallBacks) :-
|
'$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, CallBacks) :-
|
||||||
FlagI is Flag0 /\ 11,
|
FlagI is Flag0 /\ 11,
|
||||||
'$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
|
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
||||||
'$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, CallBacks) :-
|
'$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, CallBacks) :-
|
||||||
FlagI is Flag0 \/ 8,
|
FlagI is Flag0 \/ 8,
|
||||||
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
||||||
'$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, CallBacks) :-
|
'$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, CallBacks) :-
|
||||||
FlagI is Flag0 /\ 7,
|
FlagI is Flag0 /\ 7,
|
||||||
'$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
|
'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
|
||||||
'$process_wt_opts'([max_depth(D)|Opts], Flag0, Flag, [max_depth(D1,D0)|CallBacks]) :-
|
'$process_wt_opts'([max_depth(D)|Opts], Flag0, Flag, [max_depth(D1,D0)|CallBacks]) :-
|
||||||
write_depth(D1,D0),
|
write_depth(D1,D0),
|
||||||
write_depth(D,D),
|
write_depth(D,D),
|
||||||
@ -751,7 +745,7 @@ stream_position(A,N,M) :-
|
|||||||
atom(A),
|
atom(A),
|
||||||
current_stream(_,_,S), '$user_file_name'(S,A), !,
|
current_stream(_,_,S), '$user_file_name'(S,A), !,
|
||||||
'$stream_position'(S,N,M).
|
'$stream_position'(S,N,M).
|
||||||
stream_position(S,N) :-
|
stream_position(S,N,M) :-
|
||||||
'$stream_position'(S,N,M).
|
'$stream_position'(S,N,M).
|
||||||
|
|
||||||
'$stream_position'(S,N,M) :-
|
'$stream_position'(S,N,M) :-
|
||||||
@ -812,7 +806,7 @@ stream_property(Stream, Props) :-
|
|||||||
'$check_stream_props'(Prop, [Prop]).
|
'$check_stream_props'(Prop, [Prop]).
|
||||||
|
|
||||||
|
|
||||||
'$process_stream_properties'([], Stream, F, Mode).
|
'$process_stream_properties'([], _, _, _).
|
||||||
'$process_stream_properties'([file_name(F)|Props], Stream, F, Mode) :-
|
'$process_stream_properties'([file_name(F)|Props], Stream, F, Mode) :-
|
||||||
'$process_stream_properties'(Props, Stream, F, Mode).
|
'$process_stream_properties'(Props, Stream, F, Mode).
|
||||||
'$process_stream_properties'([mode(Mode)|Props], Stream, F, Mode) :-
|
'$process_stream_properties'([mode(Mode)|Props], Stream, F, Mode) :-
|
||||||
@ -849,21 +843,21 @@ stream_property(Stream, Props) :-
|
|||||||
'$past_eof'(Stream), !.
|
'$past_eof'(Stream), !.
|
||||||
'$show_stream_eof'(Stream, at) :-
|
'$show_stream_eof'(Stream, at) :-
|
||||||
'$peek'(Stream,N), N = -1, !.
|
'$peek'(Stream,N), N = -1, !.
|
||||||
'$show_stream_eof'(Stream, not).
|
'$show_stream_eof'(_, not).
|
||||||
|
|
||||||
'$show_stream_eof_action'(Fl, error) :-
|
'$show_stream_eof_action'(Fl, error) :-
|
||||||
Fl /\ 16'0200 =:= 16'0200, !.
|
Fl /\ 16'0200 =:= 16'0200, !.
|
||||||
'$show_stream_eof_action'(Fl, reset) :-
|
'$show_stream_eof_action'(Fl, reset) :-
|
||||||
Fl /\ 16'0400 =:= 16'0400, !.
|
Fl /\ 16'0400 =:= 16'0400, !.
|
||||||
'$show_stream_eof_action'(Fl, eof_code).
|
'$show_stream_eof_action'(_, eof_code).
|
||||||
|
|
||||||
'$show_stream_reposition'(Fl, true) :-
|
'$show_stream_reposition'(Fl, true) :-
|
||||||
Fl /\ 16'2000 =:= 16'2000, !.
|
Fl /\ 16'2000 =:= 16'2000, !.
|
||||||
'$show_stream_reposition'(Fl, false).
|
'$show_stream_reposition'(_, false).
|
||||||
|
|
||||||
'$show_stream_type'(Fl, binary) :-
|
'$show_stream_type'(Fl, binary) :-
|
||||||
Fl /\ 16'0100 =:= 16'0100, !.
|
Fl /\ 16'0100 =:= 16'0100, !.
|
||||||
'$show_stream_type'(Fl, text).
|
'$show_stream_type'(_, text).
|
||||||
|
|
||||||
at_end_of_stream :-
|
at_end_of_stream :-
|
||||||
current_input(S),
|
current_input(S),
|
||||||
|
Reference in New Issue
Block a user