debugger fixes
make sure we always go back to current module, even during initizlization. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1062 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
94714907ec
commit
9d12384db1
24
C/absmi.c
24
C/absmi.c
@ -10,8 +10,11 @@
|
|||||||
* *
|
* *
|
||||||
* File: absmi.c *
|
* File: absmi.c *
|
||||||
* comments: Portable abstract machine interpreter *
|
* comments: Portable abstract machine interpreter *
|
||||||
* Last rev: $Date: 2004-04-29 03:45:49 $,$Author: vsc $ *
|
* Last rev: $Date: 2004-05-13 20:54:57 $,$Author: vsc $ *
|
||||||
* $Log: not supported by cvs2svn $
|
* $Log: not supported by cvs2svn $
|
||||||
|
* Revision 1.132 2004/04/29 03:45:49 vsc
|
||||||
|
* fix garbage collection in execute_tail
|
||||||
|
*
|
||||||
* Revision 1.131 2004/04/22 20:07:02 vsc
|
* Revision 1.131 2004/04/22 20:07:02 vsc
|
||||||
* more fixes for USE_SYSTEM_MEMORY
|
* more fixes for USE_SYSTEM_MEMORY
|
||||||
*
|
*
|
||||||
@ -146,7 +149,12 @@ push_live_regs(yamop *pco)
|
|||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
void prof_alrm(int signo)
|
void prof_alrm(int signo)
|
||||||
{
|
{
|
||||||
|
#ifdef i386
|
||||||
fprintf(FProf,"%p\n", PREG);
|
fprintf(FProf,"%p\n", PREG);
|
||||||
|
#else
|
||||||
|
/* vsc: not really supported for shadow regs */
|
||||||
|
fprintf(FProf,"%p\n", P);
|
||||||
|
#endif
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1305,6 +1313,7 @@ Yap_absmi(int inp)
|
|||||||
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
|
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
|
||||||
Term t;
|
Term t;
|
||||||
|
|
||||||
|
ASP = YREG;
|
||||||
saveregs();
|
saveregs();
|
||||||
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
|
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
|
||||||
if (!Yap_gc(3, ENV, CP)) {
|
if (!Yap_gc(3, ENV, CP)) {
|
||||||
@ -1409,12 +1418,10 @@ Yap_absmi(int inp)
|
|||||||
|
|
||||||
/* spy_or_trymark */
|
/* spy_or_trymark */
|
||||||
BOp(spy_or_trymark, ld);
|
BOp(spy_or_trymark, ld);
|
||||||
if (FlipFlop ^= 1) {
|
|
||||||
READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
|
READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
|
||||||
PREG = (yamop *)(&(((PredEntry *)(PREG->u.ld.p))->OpcodeOfPred));
|
PREG = (yamop *)(&(((PredEntry *)(PREG->u.ld.p))->OpcodeOfPred));
|
||||||
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
|
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
|
||||||
goto dospy;
|
goto dospy;
|
||||||
}
|
|
||||||
ENDBOp();
|
ENDBOp();
|
||||||
|
|
||||||
/* try_and_mark Label,NArgs */
|
/* try_and_mark Label,NArgs */
|
||||||
@ -6609,17 +6616,6 @@ Yap_absmi(int inp)
|
|||||||
ENDBOp();
|
ENDBOp();
|
||||||
|
|
||||||
BOp(spy_pred, e);
|
BOp(spy_pred, e);
|
||||||
{
|
|
||||||
PredEntry *pe = PredFromDefCode(PREG);
|
|
||||||
if (FlipFlop == 0) {
|
|
||||||
READ_LOCK(pe->PRWLock);
|
|
||||||
PREG = pe->cs.p_code.TrueCodeOfPred;
|
|
||||||
READ_UNLOCK(pe->PRWLock);
|
|
||||||
JMPNext();
|
|
||||||
}
|
|
||||||
ENDBOp();
|
|
||||||
}
|
|
||||||
|
|
||||||
dospy:
|
dospy:
|
||||||
{
|
{
|
||||||
PredEntry *pe = PredFromDefCode(PREG);
|
PredEntry *pe = PredFromDefCode(PREG);
|
||||||
|
@ -644,6 +644,7 @@ p_attvar_bound(void)
|
|||||||
|
|
||||||
void Yap_InitAttVarPreds(void)
|
void Yap_InitAttVarPreds(void)
|
||||||
{
|
{
|
||||||
|
Term OldCurrentModule = CurrentModule;
|
||||||
attas[attvars_ext].bind_op = WakeAttVar;
|
attas[attvars_ext].bind_op = WakeAttVar;
|
||||||
attas[attvars_ext].copy_term_op = CopyAttVar;
|
attas[attvars_ext].copy_term_op = CopyAttVar;
|
||||||
attas[attvars_ext].to_term_op = AttVarToTerm;
|
attas[attvars_ext].to_term_op = AttVarToTerm;
|
||||||
@ -659,7 +660,7 @@ void Yap_InitAttVarPreds(void)
|
|||||||
Yap_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);
|
Yap_InitCPred("n_of_atts", 1, p_n_atts, SafePredFlag);
|
||||||
Yap_InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
|
Yap_InitCPred("bind_attvar", 1, p_bind_attvar, SafePredFlag);
|
||||||
Yap_InitCPred("all_attvars", 1, p_all_attvars, SafePredFlag);
|
Yap_InitCPred("all_attvars", 1, p_all_attvars, SafePredFlag);
|
||||||
CurrentModule = PROLOG_MODULE;
|
CurrentModule = OldCurrentModule;
|
||||||
Yap_InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag|TestPredFlag);
|
Yap_InitCPred("$is_att_variable", 1, p_is_attvar, SafePredFlag|TestPredFlag);
|
||||||
Yap_InitCPred("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag);
|
Yap_InitCPred("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag);
|
||||||
}
|
}
|
||||||
|
@ -934,7 +934,7 @@ YAP_Init(YAP_init_args *yap_init)
|
|||||||
Yap_InitYaamRegs();
|
Yap_InitYaamRegs();
|
||||||
#endif /* SBA */
|
#endif /* SBA */
|
||||||
/* slaves, waiting for work */
|
/* slaves, waiting for work */
|
||||||
CurrentModule = 1;
|
CurrentModule = USER_MODULE;
|
||||||
P = GETWORK_FIRST_TIME;
|
P = GETWORK_FIRST_TIME;
|
||||||
Yap_exec_absmi(FALSE);
|
Yap_exec_absmi(FALSE);
|
||||||
abort_optyap("abstract machine unexpected exit");
|
abort_optyap("abstract machine unexpected exit");
|
||||||
|
@ -11,8 +11,11 @@
|
|||||||
* File: cdmgr.c *
|
* File: cdmgr.c *
|
||||||
* comments: Code manager *
|
* comments: Code manager *
|
||||||
* *
|
* *
|
||||||
* Last rev: $Date: 2004-04-27 16:21:16 $,$Author: vsc $ *
|
* Last rev: $Date: 2004-05-13 20:54:57 $,$Author: vsc $ *
|
||||||
* $Log: not supported by cvs2svn $
|
* $Log: not supported by cvs2svn $
|
||||||
|
* Revision 1.120 2004/04/27 16:21:16 vsc
|
||||||
|
* stupid bug
|
||||||
|
*
|
||||||
* Revision 1.119 2004/04/27 15:03:43 vsc
|
* Revision 1.119 2004/04/27 15:03:43 vsc
|
||||||
* more fixes for expand_clauses
|
* more fixes for expand_clauses
|
||||||
*
|
*
|
||||||
@ -1095,8 +1098,9 @@ not_was_reconsulted(PredEntry *p, Term t, int mode)
|
|||||||
if (fp != ConsultBase)
|
if (fp != ConsultBase)
|
||||||
return (FALSE);
|
return (FALSE);
|
||||||
if (mode) {
|
if (mode) {
|
||||||
if (ConsultSp == ConsultLow+1)
|
if (ConsultSp == ConsultLow+1) {
|
||||||
expand_consult();
|
expand_consult();
|
||||||
|
}
|
||||||
--ConsultSp;
|
--ConsultSp;
|
||||||
ConsultSp->p = p0;
|
ConsultSp->p = p0;
|
||||||
if (ConsultBase[1].mode &&
|
if (ConsultBase[1].mode &&
|
||||||
@ -1144,7 +1148,6 @@ addcl_permission_error(AtomEntry *ap, Int Arity, int in_use)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
static Term
|
static Term
|
||||||
addclause(Term t, yamop *cp, int mode, int mod)
|
addclause(Term t, yamop *cp, int mode, int mod)
|
||||||
/*
|
/*
|
||||||
|
@ -388,11 +388,11 @@ TermToSuspendedVar(Term gs, Term var)
|
|||||||
vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars);
|
vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars);
|
||||||
if (H0 - (CELL *)vs < 1024)
|
if (H0 - (CELL *)vs < 1024)
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
|
Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
|
||||||
RESET_VARIABLE(&(vs->ActiveSus));
|
RESET_VARIABLE(&(vs->ActiveSus));
|
||||||
vs->sus_id = susp_ext;
|
vs->sus_id = susp_ext;
|
||||||
vs->SG = terms_to_suspended_goals(gs);
|
vs->SG = terms_to_suspended_goals(gs);
|
||||||
Yap_unify(var,(CELL)&(vs->ActiveSus));
|
Yap_unify(var,(CELL)&(vs->ActiveSus));
|
||||||
Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
|
|
||||||
return(TRUE);
|
return(TRUE);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
34
C/dbase.c
34
C/dbase.c
@ -652,7 +652,6 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
|||||||
int vars_found = 0;
|
int vars_found = 0;
|
||||||
#ifdef COROUTINING
|
#ifdef COROUTINING
|
||||||
Term ConstraintsTerm = TermNil;
|
Term ConstraintsTerm = TermNil;
|
||||||
CELL *ConstraintsBottom = NULL;
|
|
||||||
CELL *origH = H;
|
CELL *origH = H;
|
||||||
#endif
|
#endif
|
||||||
CELL *CodeMaxBase = CodeMax;
|
CELL *CodeMaxBase = CodeMax;
|
||||||
@ -899,19 +898,14 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
|||||||
int sz = to_visit-to_visit_base;
|
int sz = to_visit-to_visit_base;
|
||||||
|
|
||||||
H = (CELL *)to_visit;
|
H = (CELL *)to_visit;
|
||||||
/* store the constraint away for now */
|
/* store the constraint away for: we need a back pointer to
|
||||||
|
the variable, the constraint in some cannonical form, what type
|
||||||
|
of constraint, and a list pointer */
|
||||||
t[0] = (CELL)ptd0;
|
t[0] = (CELL)ptd0;
|
||||||
t[1] = attas[ExtFromCell(ptd0)].to_term_op(ptd0);
|
t[1] = attas[ExtFromCell(ptd0)].to_term_op(ptd0);
|
||||||
t[2] = MkIntegerTerm(ExtFromCell(ptd0));
|
t[2] = MkIntegerTerm(ExtFromCell(ptd0));
|
||||||
t[3] = TermNil;
|
t[3] = ConstraintsTerm;
|
||||||
if (ConstraintsBottom == NULL) {
|
|
||||||
ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
|
ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
|
||||||
ConstraintsBottom = RepAppl(ConstraintsTerm)+4;
|
|
||||||
} else {
|
|
||||||
Term new = Yap_MkApplTerm(FunctorClist, 4, t);
|
|
||||||
*ConstraintsBottom = new;
|
|
||||||
ConstraintsBottom = RepAppl(new)+4;
|
|
||||||
}
|
|
||||||
if (H+sz >= ASP) {
|
if (H+sz >= ASP) {
|
||||||
goto error2;
|
goto error2;
|
||||||
}
|
}
|
||||||
@ -961,14 +955,18 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
|
|||||||
|
|
||||||
#ifdef COROUTINING
|
#ifdef COROUTINING
|
||||||
/* we still may have constraints to do */
|
/* we still may have constraints to do */
|
||||||
if (ConstraintsTerm != TermNil) {
|
if (ConstraintsTerm != TermNil &&
|
||||||
*attachmentsp = (CELL)CodeMax;
|
!(RepAppl(ConstraintsTerm) >= tbase &&
|
||||||
|
RepAppl(ConstraintsTerm) < StoPoint)
|
||||||
|
) {
|
||||||
|
*attachmentsp = (CELL)(CodeMax+1);
|
||||||
pt0 = RepAppl(ConstraintsTerm)+1;
|
pt0 = RepAppl(ConstraintsTerm)+1;
|
||||||
pt0_end = RepAppl(ConstraintsTerm)+4;
|
pt0_end = RepAppl(ConstraintsTerm)+4;
|
||||||
ConstraintsTerm = TermNil;
|
|
||||||
StoPoint = CodeMax;
|
StoPoint = CodeMax;
|
||||||
|
*StoPoint++ = RepAppl(ConstraintsTerm)[0];
|
||||||
|
ConstraintsTerm = AbsAppl(CodeMax);
|
||||||
CheckDBOverflow();
|
CheckDBOverflow();
|
||||||
CodeMax += 4;
|
CodeMax += 5;
|
||||||
goto loop;
|
goto loop;
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
@ -1431,7 +1429,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
|
|||||||
#ifdef COROUTINING
|
#ifdef COROUTINING
|
||||||
/* attachment */
|
/* attachment */
|
||||||
if (IsVarTerm(Tm)) {
|
if (IsVarTerm(Tm)) {
|
||||||
tt = sizeof(CELL);
|
tt = (CELL)(ppt0->Contents);
|
||||||
ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0+1, ntp0-1,
|
ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0+1, ntp0-1,
|
||||||
&attachments,
|
&attachments,
|
||||||
&vars_found,
|
&vars_found,
|
||||||
@ -2432,7 +2430,11 @@ GetDBTerm(DBTerm *DBSP)
|
|||||||
{
|
{
|
||||||
Term t = DBSP->Entry;
|
Term t = DBSP->Entry;
|
||||||
|
|
||||||
if (IsVarTerm(t)) {
|
if (IsVarTerm(t)
|
||||||
|
#if COROUTINING
|
||||||
|
&& !DBSP->attachments
|
||||||
|
#endif
|
||||||
|
) {
|
||||||
return MkVarTerm();
|
return MkVarTerm();
|
||||||
} else if (IsAtomOrIntTerm(t)) {
|
} else if (IsAtomOrIntTerm(t)) {
|
||||||
return t;
|
return t;
|
||||||
|
270
C/exec.c
270
C/exec.c
@ -21,13 +21,11 @@ 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 CallPredicate, (PredEntry *, choiceptr, yamop *));
|
||||||
STATIC_PROTO(Int EnterCreepMode, (Term, Term));
|
STATIC_PROTO(Int EnterCreepMode, (Term, Term));
|
||||||
STATIC_PROTO(Int CallClause, (PredEntry *, 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 Term
|
static Term
|
||||||
cp_as_integer(choiceptr cp)
|
cp_as_integer(choiceptr cp)
|
||||||
@ -42,7 +40,7 @@ Yap_cp_as_integer(choiceptr cp)
|
|||||||
}
|
}
|
||||||
|
|
||||||
static inline Int
|
static inline Int
|
||||||
CallPredicate(PredEntry *pen, choiceptr cut_pt) {
|
CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
|
||||||
#ifdef LOW_LEVEL_TRACER
|
#ifdef LOW_LEVEL_TRACER
|
||||||
if (Yap_do_low_level_trace)
|
if (Yap_do_low_level_trace)
|
||||||
low_level_trace(enter_pred,pen,XREGS+1);
|
low_level_trace(enter_pred,pen,XREGS+1);
|
||||||
@ -61,7 +59,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) {
|
|||||||
DEPTH -= MkIntConstant(2);
|
DEPTH -= MkIntConstant(2);
|
||||||
#endif /* DEPTH_LIMIT */
|
#endif /* DEPTH_LIMIT */
|
||||||
CP = P;
|
CP = P;
|
||||||
P = pen->CodeOfPred;
|
P = code;
|
||||||
/* vsc: increment reduction counter at meta-call entry */
|
/* vsc: increment reduction counter at meta-call entry */
|
||||||
READ_UNLOCK(pen->PRWLock);
|
READ_UNLOCK(pen->PRWLock);
|
||||||
if (pen->PredFlags & ProfiledPredFlag) {
|
if (pen->PredFlags & ProfiledPredFlag) {
|
||||||
@ -80,7 +78,7 @@ CallMetaCall(Term mod) {
|
|||||||
ARG2 = cp_as_integer(B); /* p_save_cp */
|
ARG2 = cp_as_integer(B); /* p_save_cp */
|
||||||
ARG3 = ARG1;
|
ARG3 = ARG1;
|
||||||
ARG4 = mod;
|
ARG4 = mod;
|
||||||
return (CallPredicate(PredMetaCall, B));
|
return (CallPredicate(PredMetaCall, B, PredMetaCall->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
Term
|
Term
|
||||||
@ -104,97 +102,6 @@ CallError(yap_error_number err, Term mod)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
|
||||||
CallClause(PredEntry *pen, Int position)
|
|
||||||
{
|
|
||||||
CELL flags;
|
|
||||||
|
|
||||||
if (position == -1) return(CallPredicate(pen, B));
|
|
||||||
READ_LOCK(pen->PRWLock);
|
|
||||||
flags = pen->PredFlags;
|
|
||||||
if ((flags & (CompiledPredFlag | DynamicPredFlag)) ||
|
|
||||||
pen->OpcodeOfPred == UNDEF_OPCODE) {
|
|
||||||
yamop *q;
|
|
||||||
#ifdef DEPTH_LIMIT
|
|
||||||
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
|
||||||
if (pen->ModuleOfPred) {
|
|
||||||
if (DEPTH == MkIntTerm(0))
|
|
||||||
return(FALSE);
|
|
||||||
else DEPTH = RESET_DEPTH();
|
|
||||||
}
|
|
||||||
} else if (pen->ModuleOfPred)
|
|
||||||
DEPTH -= MkIntConstant(2);
|
|
||||||
#endif /* DEPTH_LIMIT */
|
|
||||||
#ifdef LOW_LEVEL_TRACER
|
|
||||||
if (Yap_do_low_level_trace)
|
|
||||||
low_level_trace(enter_pred,pen,XREGS+1);
|
|
||||||
#endif /* LOW_LEVEL_TRACE */
|
|
||||||
ENV = YENV;
|
|
||||||
YENV = ASP;
|
|
||||||
YENV[E_CB] = (CELL)(B->cp_b);
|
|
||||||
CP = P;
|
|
||||||
q = pen->cs.p_code.FirstClause;
|
|
||||||
if (pen->PredFlags & ProfiledPredFlag) {
|
|
||||||
LOCK(pen->StatisticsForPred.lock);
|
|
||||||
if (position == 1)
|
|
||||||
pen->StatisticsForPred.NOfEntries++;
|
|
||||||
else
|
|
||||||
pen->StatisticsForPred.NOfRetries++;
|
|
||||||
UNLOCK(pen->StatisticsForPred.lock);
|
|
||||||
}
|
|
||||||
if (flags & DynamicPredFlag) {
|
|
||||||
CLAUSECODE->arity = pen->ArityOfPE;
|
|
||||||
CLAUSECODE->func = pen->FunctorOfPred;
|
|
||||||
while (position > 1) {
|
|
||||||
while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask)
|
|
||||||
q = NextDynamicClause(q);
|
|
||||||
position--;
|
|
||||||
q = NextDynamicClause(q);
|
|
||||||
}
|
|
||||||
while (ClauseCodeToDynamicClause(q)->ClFlags & ErasedMask)
|
|
||||||
q = NextDynamicClause(q);
|
|
||||||
#if defined(YAPOR) || defined(THREADS)
|
|
||||||
{
|
|
||||||
DynamicClause *cl = ClauseCodeToDynamicClause(q);
|
|
||||||
|
|
||||||
LOCK(cl->ClLock);
|
|
||||||
TRAIL_CLREF(cl);
|
|
||||||
INC_CLREF_COUNT(cl);
|
|
||||||
UNLOCK(cl->ClLock);
|
|
||||||
}
|
|
||||||
#else
|
|
||||||
if (!(ClauseCodeToDynamicClause(q)->ClFlags & InUseMask)) {
|
|
||||||
CELL *opp = &(ClauseCodeToDynamicClause(q)->ClFlags);
|
|
||||||
TRAIL_CLREF(ClauseCodeToDynamicClause(q));
|
|
||||||
*opp |= InUseMask;
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
READ_UNLOCK(pen->PRWLock);
|
|
||||||
CLAUSECODE->clause = NEXTOP(q,ld);
|
|
||||||
P = CLAUSECODE->clause;
|
|
||||||
return((CELL)(&(CLAUSECODE->clause)));
|
|
||||||
} else if (flags & LogUpdatePredFlag) {
|
|
||||||
LogUpdClause *cl = ClauseCodeToLogUpdClause(q);
|
|
||||||
for (; position > 1; position--)
|
|
||||||
cl = cl->ClNext;
|
|
||||||
READ_UNLOCK(pen->PRWLock);
|
|
||||||
P = cl->ClCode;
|
|
||||||
return (Unsigned(pen));
|
|
||||||
} else {
|
|
||||||
/* static clause */
|
|
||||||
LogUpdClause *cl = ClauseCodeToLogUpdClause(q);
|
|
||||||
for (; position > 1; position--)
|
|
||||||
cl = cl->ClNext;
|
|
||||||
READ_UNLOCK(pen->PRWLock);
|
|
||||||
P = cl->ClCode;
|
|
||||||
return (Unsigned(pen));
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
Yap_Error(SYSTEM_ERROR,ARG1,"debugger tries to debug clause for builtin");
|
|
||||||
return (FALSE);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
p_save_cp(void)
|
p_save_cp(void)
|
||||||
{
|
{
|
||||||
@ -217,10 +124,12 @@ p_save_cp(void)
|
|||||||
inline static Int
|
inline static Int
|
||||||
do_execute(Term t, Term mod)
|
do_execute(Term t, Term mod)
|
||||||
{
|
{
|
||||||
if (ActiveSignals) {
|
/* first do predicate expansion, even before you process signals.
|
||||||
return(EnterCreepMode(t, mod));
|
This way you don't get to spy goal_expansion(). */
|
||||||
} else if (PRED_GOAL_EXPANSION_ON) {
|
if (PRED_GOAL_EXPANSION_ON) {
|
||||||
return(CallMetaCall(mod));
|
return CallMetaCall(mod);
|
||||||
|
} else if (ActiveSignals) {
|
||||||
|
return EnterCreepMode(t, mod);
|
||||||
}
|
}
|
||||||
restart_exec:
|
restart_exec:
|
||||||
if (IsVarTerm(t)) {
|
if (IsVarTerm(t)) {
|
||||||
@ -268,7 +177,7 @@ do_execute(Term t, Term mod)
|
|||||||
XREGS[i] = *pt++;
|
XREGS[i] = *pt++;
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
return (CallPredicate(pen, B));
|
return (CallPredicate(pen, B, pen->CodeOfPred));
|
||||||
} else if (IsAtomTerm(t)) {
|
} else if (IsAtomTerm(t)) {
|
||||||
PredEntry *pe;
|
PredEntry *pe;
|
||||||
Atom a = AtomOfTerm(t);
|
Atom a = AtomOfTerm(t);
|
||||||
@ -279,7 +188,7 @@ do_execute(Term t, Term mod)
|
|||||||
return(FALSE);
|
return(FALSE);
|
||||||
/* call may not define new system predicates!! */
|
/* call may not define new system predicates!! */
|
||||||
pe = RepPredProp(PredPropByAtom(a, mod));
|
pe = RepPredProp(PredPropByAtom(a, mod));
|
||||||
return (CallPredicate(pe, B));
|
return (CallPredicate(pe, B, pe->CodeOfPred));
|
||||||
} else if (IsIntTerm(t)) {
|
} else if (IsIntTerm(t)) {
|
||||||
return CallError(TYPE_ERROR_CALLABLE, mod);
|
return CallError(TYPE_ERROR_CALLABLE, mod);
|
||||||
} else {
|
} else {
|
||||||
@ -311,7 +220,7 @@ EnterCreepMode(Term t, Term mod) {
|
|||||||
CreepFlag = CalculateStackGap();
|
CreepFlag = CalculateStackGap();
|
||||||
UNLOCK(SignalLock);
|
UNLOCK(SignalLock);
|
||||||
P_before_spy = P;
|
P_before_spy = P;
|
||||||
return (CallPredicate(PredCreep, B));
|
return (CallPredicate(PredCreep, B, PredCreep->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -335,10 +244,13 @@ p_execute0(void)
|
|||||||
unsigned int arity;
|
unsigned int arity;
|
||||||
Prop pe;
|
Prop pe;
|
||||||
|
|
||||||
|
if (ActiveSignals) {
|
||||||
|
return EnterCreepMode(t, mod);
|
||||||
|
}
|
||||||
restart_exec:
|
restart_exec:
|
||||||
if (IsVarTerm(t)) {
|
if (IsVarTerm(t)) {
|
||||||
Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");
|
Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");
|
||||||
return(FALSE);
|
return FALSE;
|
||||||
} else if (IsAtomTerm(t)) {
|
} else if (IsAtomTerm(t)) {
|
||||||
Atom a = AtomOfTerm(t);
|
Atom a = AtomOfTerm(t);
|
||||||
pe = PredPropByAtom(a, mod);
|
pe = PredPropByAtom(a, mod);
|
||||||
@ -376,11 +288,71 @@ p_execute0(void)
|
|||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
Yap_Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");
|
Yap_Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");
|
||||||
return(FALSE);
|
return FALSE;
|
||||||
}
|
}
|
||||||
/* N = arity; */
|
/* N = arity; */
|
||||||
/* call may not define new system predicates!! */
|
/* call may not define new system predicates!! */
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int
|
||||||
|
p_execute_nonstop(void)
|
||||||
|
{ /* '$execute_nonstop'(Goal,Mod) */
|
||||||
|
Term t = Deref(ARG1);
|
||||||
|
Term mod = Deref(ARG2);
|
||||||
|
unsigned int arity;
|
||||||
|
Prop pe;
|
||||||
|
|
||||||
|
restart_exec:
|
||||||
|
if (IsVarTerm(t)) {
|
||||||
|
Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");
|
||||||
|
return FALSE;
|
||||||
|
} else if (IsAtomTerm(t)) {
|
||||||
|
Atom a = AtomOfTerm(t);
|
||||||
|
pe = PredPropByAtom(a, mod);
|
||||||
|
} else if (IsApplTerm(t)) {
|
||||||
|
register Functor f = FunctorOfTerm(t);
|
||||||
|
register unsigned int i;
|
||||||
|
register CELL *pt;
|
||||||
|
|
||||||
|
if (IsExtensionFunctor(f))
|
||||||
|
return(FALSE);
|
||||||
|
if (f == FunctorModule) {
|
||||||
|
Term tmod = ArgOfTerm(1,t);
|
||||||
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
||||||
|
mod = tmod;
|
||||||
|
t = ArgOfTerm(2,t);
|
||||||
|
goto restart_exec;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
pe = PredPropByFunc(f, mod);
|
||||||
|
arity = ArityOfFunctor(f);
|
||||||
|
/* I cannot use the standard macro here because
|
||||||
|
otherwise I would dereference the argument and
|
||||||
|
might skip a svar */
|
||||||
|
pt = RepAppl(t)+1;
|
||||||
|
for (i = 1; i <= arity; ++i) {
|
||||||
|
#if SBA
|
||||||
|
Term d0 = *pt++;
|
||||||
|
if (d0 == 0)
|
||||||
|
XREGS[i] = (CELL)(pt-1);
|
||||||
|
else
|
||||||
|
XREGS[i] = d0;
|
||||||
|
#else
|
||||||
|
XREGS[i] = *pt++;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
Yap_Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");
|
||||||
|
return FALSE;
|
||||||
|
}
|
||||||
|
/* N = arity; */
|
||||||
|
/* call may not define new system predicates!! */
|
||||||
|
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
|
||||||
|
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred);
|
||||||
|
} else {
|
||||||
|
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -417,7 +389,7 @@ p_execute_0(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -463,7 +435,7 @@ p_execute_1(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -508,7 +480,7 @@ p_execute_2(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -560,7 +532,7 @@ p_execute_3(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -611,7 +583,7 @@ p_execute_4(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -665,7 +637,7 @@ p_execute_5(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -722,7 +694,7 @@ p_execute_6(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -782,7 +754,7 @@ p_execute_7(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -845,7 +817,7 @@ p_execute_8(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -911,7 +883,7 @@ p_execute_9(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
@ -980,7 +952,7 @@ p_execute_10(void)
|
|||||||
XREGS[1] = ptr[0];
|
XREGS[1] = ptr[0];
|
||||||
XREGS[2] = ptr[1];
|
XREGS[2] = ptr[1];
|
||||||
}
|
}
|
||||||
return (CallPredicate(RepPredProp(pe), B));
|
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef DEPTH_LIMIT
|
#ifdef DEPTH_LIMIT
|
||||||
@ -1005,66 +977,6 @@ p_pred_goal_expansion_on(void) {
|
|||||||
return PRED_GOAL_EXPANSION_ON;
|
return PRED_GOAL_EXPANSION_ON;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
|
||||||
p_at_execute(void)
|
|
||||||
{ /* '$execute'(Goal,ClauseNumber) */
|
|
||||||
Term t = Deref(ARG1), mod = Deref(ARG2), t2 = Deref(ARG3);
|
|
||||||
unsigned int arity;
|
|
||||||
Prop pe;
|
|
||||||
Atom a;
|
|
||||||
|
|
||||||
restart_exec:
|
|
||||||
if (IsAtomTerm(t)) {
|
|
||||||
a = AtomOfTerm(t);
|
|
||||||
pe = PredPropByAtom(a, mod);
|
|
||||||
arity = 0;
|
|
||||||
} else if (IsApplTerm(t)) {
|
|
||||||
register Functor f = FunctorOfTerm(t);
|
|
||||||
register unsigned int i;
|
|
||||||
register CELL *pt;
|
|
||||||
|
|
||||||
if (IsBlobFunctor(f))
|
|
||||||
return(FALSE);
|
|
||||||
if (f == FunctorModule) {
|
|
||||||
Term tmod = ArgOfTerm(1,t);
|
|
||||||
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
|
||||||
mod = tmod;
|
|
||||||
t = ArgOfTerm(2,t);
|
|
||||||
goto restart_exec;
|
|
||||||
}
|
|
||||||
if (IsVarTerm(tmod)) {
|
|
||||||
Yap_Error(INSTANTIATION_ERROR, ARG1, "calling clause in debugger");
|
|
||||||
}
|
|
||||||
Yap_Error(TYPE_ERROR_ATOM, ARG1, "calling clause in debugger");
|
|
||||||
}
|
|
||||||
pe = PredPropByFunc(f,mod);
|
|
||||||
arity = ArityOfFunctor(f);
|
|
||||||
a = NameOfFunctor(f);
|
|
||||||
/* I cannot use the standard macro here because
|
|
||||||
otherwise I would dereference the argument and
|
|
||||||
might skip a svar */
|
|
||||||
pt = RepAppl(t)+1;
|
|
||||||
for (i = 1; i <= arity; ++i)
|
|
||||||
#if SBA
|
|
||||||
{
|
|
||||||
Term d0 = *pt++;
|
|
||||||
if (d0 == 0)
|
|
||||||
XREGS[i] = (CELL)(pt-1);
|
|
||||||
else
|
|
||||||
XREGS[i] = d0;
|
|
||||||
}
|
|
||||||
#else
|
|
||||||
XREGS[i] = *pt++;
|
|
||||||
#endif
|
|
||||||
} else
|
|
||||||
return (FALSE); /* for the moment */
|
|
||||||
if (IsVarTerm(t2) || !IsIntTerm(t2))
|
|
||||||
return (FALSE);
|
|
||||||
/* N = arity; */
|
|
||||||
/* call may not define new system predicates!! */
|
|
||||||
return (CallClause(RepPredProp(pe), IntOfTerm(t2)));
|
|
||||||
}
|
|
||||||
|
|
||||||
static int
|
static int
|
||||||
exec_absmi(int top)
|
exec_absmi(int top)
|
||||||
{
|
{
|
||||||
@ -1607,7 +1519,6 @@ Yap_InitExecFs(void)
|
|||||||
Yap_InitComma();
|
Yap_InitComma();
|
||||||
Yap_InitCPred("$execute", 1, p_execute, 0);
|
Yap_InitCPred("$execute", 1, p_execute, 0);
|
||||||
Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
|
Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
|
||||||
Yap_InitCPred("$execute", 3, p_at_execute, 0);
|
|
||||||
Yap_InitCPred("$call_with_args", 2, p_execute_0, 0);
|
Yap_InitCPred("$call_with_args", 2, p_execute_0, 0);
|
||||||
Yap_InitCPred("$call_with_args", 3, p_execute_1, 0);
|
Yap_InitCPred("$call_with_args", 3, p_execute_1, 0);
|
||||||
Yap_InitCPred("$call_with_args", 4, p_execute_2, 0);
|
Yap_InitCPred("$call_with_args", 4, p_execute_2, 0);
|
||||||
@ -1623,6 +1534,7 @@ Yap_InitExecFs(void)
|
|||||||
Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
|
Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0);
|
||||||
#endif
|
#endif
|
||||||
Yap_InitCPred("$execute0", 2, p_execute0, 0);
|
Yap_InitCPred("$execute0", 2, p_execute0, 0);
|
||||||
|
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, 0);
|
||||||
Yap_InitCPred("$save_current_choice_point", 1, p_save_cp, 0);
|
Yap_InitCPred("$save_current_choice_point", 1, p_save_cp, 0);
|
||||||
Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag);
|
Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag);
|
||||||
Yap_InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag);
|
Yap_InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag);
|
||||||
|
@ -4634,6 +4634,7 @@ Yap_InitBackIO (void)
|
|||||||
void
|
void
|
||||||
Yap_InitIOPreds(void)
|
Yap_InitIOPreds(void)
|
||||||
{
|
{
|
||||||
|
Term cm = CurrentModule;
|
||||||
|
|
||||||
Yap_stdin = stdin;
|
Yap_stdin = stdin;
|
||||||
Yap_stdout = stdout;
|
Yap_stdout = stdout;
|
||||||
@ -4658,7 +4659,7 @@ Yap_InitIOPreds(void)
|
|||||||
Yap_InitCPred ("open_mem_read_stream", 2, p_open_mem_read_stream, SyncPredFlag);
|
Yap_InitCPred ("open_mem_read_stream", 2, p_open_mem_read_stream, SyncPredFlag);
|
||||||
Yap_InitCPred ("open_mem_write_stream", 1, p_open_mem_write_stream, SyncPredFlag);
|
Yap_InitCPred ("open_mem_write_stream", 1, p_open_mem_write_stream, SyncPredFlag);
|
||||||
Yap_InitCPred ("peek_mem_write_stream", 3, p_peek_mem_write_stream, SyncPredFlag);
|
Yap_InitCPred ("peek_mem_write_stream", 3, p_peek_mem_write_stream, SyncPredFlag);
|
||||||
CurrentModule = PROLOG_MODULE;
|
CurrentModule = cm;
|
||||||
Yap_InitCPred ("$put", 2, p_put, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred ("$put", 2, p_put, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred ("$put_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred ("$put_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag);
|
||||||
|
@ -96,7 +96,7 @@ p_current_module(void)
|
|||||||
if (IsVarTerm(t) || !IsAtomTerm(t))
|
if (IsVarTerm(t) || !IsAtomTerm(t))
|
||||||
return FALSE;
|
return FALSE;
|
||||||
if (t == TermProlog) {
|
if (t == TermProlog) {
|
||||||
CurrentModule = 0;
|
CurrentModule = PROLOG_MODULE;
|
||||||
} else {
|
} else {
|
||||||
CurrentModule = t;
|
CurrentModule = t;
|
||||||
LookupModule(CurrentModule);
|
LookupModule(CurrentModule);
|
||||||
|
5
C/save.c
5
C/save.c
@ -377,7 +377,6 @@ save_regs(int mode)
|
|||||||
putcellptr(S);
|
putcellptr(S);
|
||||||
putcellptr((CELL *)P);
|
putcellptr((CELL *)P);
|
||||||
putout(CreepFlag);
|
putout(CreepFlag);
|
||||||
putout(FlipFlop);
|
|
||||||
putout(EX);
|
putout(EX);
|
||||||
#ifdef COROUTINING
|
#ifdef COROUTINING
|
||||||
putout(DelayedVars);
|
putout(DelayedVars);
|
||||||
@ -711,7 +710,6 @@ get_regs(int flag)
|
|||||||
S = get_cellptr();
|
S = get_cellptr();
|
||||||
P = (yamop *)get_cellptr();
|
P = (yamop *)get_cellptr();
|
||||||
CreepFlag = get_cell();
|
CreepFlag = get_cell();
|
||||||
FlipFlop = get_cell();
|
|
||||||
#ifdef COROUTINING
|
#ifdef COROUTINING
|
||||||
DelayedVars = get_cell();
|
DelayedVars = get_cell();
|
||||||
#endif
|
#endif
|
||||||
@ -1413,7 +1411,9 @@ Restore(char *s, char *lib_dir)
|
|||||||
restore_regs(restore_mode);
|
restore_regs(restore_mode);
|
||||||
in_limbo = FALSE;
|
in_limbo = FALSE;
|
||||||
/*#endif*/
|
/*#endif*/
|
||||||
|
fprintf(stderr,"1 CurrentModule is %p\n", CurrentModule);
|
||||||
RestoreHeap(old_ops);
|
RestoreHeap(old_ops);
|
||||||
|
fprintf(stderr,"1.5 CurrentModule is %p\n", CurrentModule);
|
||||||
switch(restore_mode) {
|
switch(restore_mode) {
|
||||||
case DO_EVERYTHING:
|
case DO_EVERYTHING:
|
||||||
if (OldHeapBase != Yap_HeapBase ||
|
if (OldHeapBase != Yap_HeapBase ||
|
||||||
@ -1437,6 +1437,7 @@ Restore(char *s, char *lib_dir)
|
|||||||
Yap_InitYaamRegs();
|
Yap_InitYaamRegs();
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
Yap_ReOpenLoadForeign();
|
Yap_ReOpenLoadForeign();
|
||||||
Yap_InitPlIO();
|
Yap_InitPlIO();
|
||||||
/* reset time */
|
/* reset time */
|
||||||
|
32
C/stdpreds.c
32
C/stdpreds.c
@ -11,8 +11,11 @@
|
|||||||
* File: stdpreds.c *
|
* File: stdpreds.c *
|
||||||
* comments: General-purpose C implemented system predicates *
|
* comments: General-purpose C implemented system predicates *
|
||||||
* *
|
* *
|
||||||
* Last rev: $Date: 2004-04-27 15:14:36 $,$Author: vsc $ *
|
* Last rev: $Date: 2004-05-13 20:54:58 $,$Author: vsc $ *
|
||||||
* $Log: not supported by cvs2svn $ *
|
* $Log: not supported by cvs2svn $
|
||||||
|
* Revision 1.65 2004/04/27 15:14:36 vsc
|
||||||
|
* fix halt/0 and halt/1
|
||||||
|
* *
|
||||||
* *
|
* *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
#ifdef SCCS
|
#ifdef SCCS
|
||||||
@ -478,24 +481,6 @@ p_values(void)
|
|||||||
return (TRUE);
|
return (TRUE);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
|
||||||
p_flipflop(void)
|
|
||||||
{ /* '$flipflop' */
|
|
||||||
return ((int) (FlipFlop = (1 - FlipFlop)));
|
|
||||||
}
|
|
||||||
|
|
||||||
static Int
|
|
||||||
p_setflop(void)
|
|
||||||
{ /* '$setflop'(N) */
|
|
||||||
Term t = Deref(ARG1);
|
|
||||||
|
|
||||||
if (IsIntTerm(t)) {
|
|
||||||
FlipFlop = IntOfTerm(t) & 1;
|
|
||||||
return (TRUE);
|
|
||||||
}
|
|
||||||
return (FALSE);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline static void
|
inline static void
|
||||||
do_signal(yap_signals sig)
|
do_signal(yap_signals sig)
|
||||||
{
|
{
|
||||||
@ -516,7 +501,6 @@ p_creep(void)
|
|||||||
CreepCode = pred;
|
CreepCode = pred;
|
||||||
yap_flags[SPY_CREEP_FLAG] = TRUE;
|
yap_flags[SPY_CREEP_FLAG] = TRUE;
|
||||||
do_signal(YAP_CREEP_SIGNAL);
|
do_signal(YAP_CREEP_SIGNAL);
|
||||||
FlipFlop = 0;
|
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -524,7 +508,10 @@ static Int
|
|||||||
p_stop_creep(void)
|
p_stop_creep(void)
|
||||||
{
|
{
|
||||||
LOCK(SignalLock);
|
LOCK(SignalLock);
|
||||||
|
ActiveSignals &= ~YAP_CREEP_SIGNAL;
|
||||||
|
if (!ActiveSignals) {
|
||||||
CreepFlag = CalculateStackGap();
|
CreepFlag = CalculateStackGap();
|
||||||
|
}
|
||||||
UNLOCK(SignalLock);
|
UNLOCK(SignalLock);
|
||||||
return TRUE;
|
return TRUE;
|
||||||
}
|
}
|
||||||
@ -2678,9 +2665,6 @@ Yap_InitCPreds(void)
|
|||||||
Yap_InitCPred("set_value", 2, p_setval, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("set_value", 2, p_setval, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("get_value", 2, p_value, TestPredFlag|SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("get_value", 2, p_value, TestPredFlag|SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("$values", 3, p_values, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("$values", 3, p_values, SafePredFlag|SyncPredFlag);
|
||||||
/* The flip-flop */
|
|
||||||
Yap_InitCPred("$flipflop", 0, p_flipflop, SafePredFlag|SyncPredFlag);
|
|
||||||
Yap_InitCPred("$setflop", 1, p_setflop, SafePredFlag|SyncPredFlag);
|
|
||||||
/* general purpose */
|
/* general purpose */
|
||||||
Yap_InitCPred("$opdec", 3, p_opdec, SafePredFlag|SyncPredFlag);
|
Yap_InitCPred("$opdec", 3, p_opdec, SafePredFlag|SyncPredFlag);
|
||||||
Yap_InitCPred("name", 2, p_name, SafePredFlag);
|
Yap_InitCPred("name", 2, p_name, SafePredFlag);
|
||||||
|
@ -618,11 +618,12 @@ InitReverseLookupOpcode(void)
|
|||||||
void
|
void
|
||||||
Yap_InitUnify(void)
|
Yap_InitUnify(void)
|
||||||
{
|
{
|
||||||
|
Term cm = CurrentModule;
|
||||||
Yap_InitCPred("unify_with_occurs_check", 2, p_ocunify, SafePredFlag);
|
Yap_InitCPred("unify_with_occurs_check", 2, p_ocunify, SafePredFlag);
|
||||||
CurrentModule = TERMS_MODULE;
|
CurrentModule = TERMS_MODULE;
|
||||||
Yap_InitCPred("cyclic_term", 1, p_cyclic, SafePredFlag|TestPredFlag);
|
Yap_InitCPred("cyclic_term", 1, p_cyclic, SafePredFlag|TestPredFlag);
|
||||||
Yap_InitCPred("acyclic_term", 1, p_acyclic, SafePredFlag|TestPredFlag);
|
Yap_InitCPred("acyclic_term", 1, p_acyclic, SafePredFlag|TestPredFlag);
|
||||||
CurrentModule = PROLOG_MODULE;
|
CurrentModule = cm;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -1745,6 +1745,7 @@ camacho_dum(void)
|
|||||||
|
|
||||||
void Yap_InitUtilCPreds(void)
|
void Yap_InitUtilCPreds(void)
|
||||||
{
|
{
|
||||||
|
Term cm = CurrentModule;
|
||||||
Yap_InitCPred("copy_term", 2, p_copy_term, 0);
|
Yap_InitCPred("copy_term", 2, p_copy_term, 0);
|
||||||
Yap_InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, 0);
|
Yap_InitCPred("$copy_term_but_not_constraints", 2, p_copy_term_no_delays, 0);
|
||||||
Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
|
Yap_InitCPred("ground", 1, p_ground, SafePredFlag);
|
||||||
@ -1756,7 +1757,7 @@ void Yap_InitUtilCPreds(void)
|
|||||||
Yap_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
|
Yap_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
|
||||||
Yap_InitCPred("variant", 2, p_variant, SafePredFlag);
|
Yap_InitCPred("variant", 2, p_variant, SafePredFlag);
|
||||||
Yap_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
|
Yap_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
|
||||||
CurrentModule = PROLOG_MODULE;
|
CurrentModule = cm;
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
|
Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
|
||||||
Yap_InitCPred("dum", 1, camacho_dum, SafePredFlag);
|
Yap_InitCPred("dum", 1, camacho_dum, SafePredFlag);
|
||||||
|
4
H/Regs.h
4
H/Regs.h
@ -10,7 +10,7 @@
|
|||||||
* File: Regs.h *
|
* File: Regs.h *
|
||||||
* mods: *
|
* mods: *
|
||||||
* comments: YAP abstract machine registers *
|
* comments: YAP abstract machine registers *
|
||||||
* version: $Id: Regs.h,v 1.27 2004-03-05 15:26:33 vsc Exp $ *
|
* version: $Id: Regs.h,v 1.28 2004-05-13 20:54:58 vsc Exp $ *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
|
|
||||||
@ -89,7 +89,6 @@ typedef struct
|
|||||||
CELL *AuxSp_; /* 9 Auxiliary stack pointer */
|
CELL *AuxSp_; /* 9 Auxiliary stack pointer */
|
||||||
ADDR AuxTop_; /* 10 Auxiliary stack top */
|
ADDR AuxTop_; /* 10 Auxiliary stack top */
|
||||||
/* visualc*/
|
/* visualc*/
|
||||||
CELL FlipFlop_; /* 18 */
|
|
||||||
CELL EX_; /* 18 */
|
CELL EX_; /* 18 */
|
||||||
#ifdef COROUTINING
|
#ifdef COROUTINING
|
||||||
Term DelayedVars_; /* maximum number of attributed variables */
|
Term DelayedVars_; /* maximum number of attributed variables */
|
||||||
@ -650,7 +649,6 @@ EXTERN inline void restore_B(void) {
|
|||||||
#define AuxTop Yap_REGS.AuxTop_
|
#define AuxTop Yap_REGS.AuxTop_
|
||||||
#define TopB Yap_REGS.TopB_
|
#define TopB Yap_REGS.TopB_
|
||||||
#define DelayedB Yap_REGS.DelayedB_
|
#define DelayedB Yap_REGS.DelayedB_
|
||||||
#define FlipFlop Yap_REGS.FlipFlop_
|
|
||||||
#define EX Yap_REGS.EX_
|
#define EX Yap_REGS.EX_
|
||||||
#define DEPTH Yap_REGS.DEPTH_
|
#define DEPTH Yap_REGS.DEPTH_
|
||||||
#if defined(SBA) || defined(TABLING)
|
#if defined(SBA) || defined(TABLING)
|
||||||
|
@ -437,7 +437,7 @@ repeat :- '$repeat'.
|
|||||||
( get_value('$trace', 1) ->
|
( get_value('$trace', 1) ->
|
||||||
'$creep'
|
'$creep'
|
||||||
;
|
;
|
||||||
'$setflop'(1)
|
true
|
||||||
).
|
).
|
||||||
|
|
||||||
'$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M).
|
'$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M).
|
||||||
@ -1086,7 +1086,7 @@ catch(G, C, A) :-
|
|||||||
'$system_catch'(G, M, C, A) :-
|
'$system_catch'(G, M, C, A) :-
|
||||||
% check current trail
|
% check current trail
|
||||||
'$catch'(C,A,_),
|
'$catch'(C,A,_),
|
||||||
'$execute0'(G, M).
|
'$execute_nonstop'(G, M).
|
||||||
|
|
||||||
%
|
%
|
||||||
% throw has to be *exactly* after system catch!
|
% throw has to be *exactly* after system catch!
|
||||||
|
14
pl/debug.yap
14
pl/debug.yap
@ -382,7 +382,7 @@ debugging :-
|
|||||||
%
|
%
|
||||||
'$spycall'(G, M, _) :-
|
'$spycall'(G, M, _) :-
|
||||||
'$access_yap_flags'(10,0), !,
|
'$access_yap_flags'(10,0), !,
|
||||||
'$execute0'(G, M).
|
'$execute_nonstop'(G, M).
|
||||||
'$spycall'(G, M, InControl) :-
|
'$spycall'(G, M, InControl) :-
|
||||||
'$flags'(G,M,F,F),
|
'$flags'(G,M,F,F),
|
||||||
F /\ 0x8402000 =\= 0, !, % dynamic procedure, logical semantics, or source
|
F /\ 0x8402000 =\= 0, !, % dynamic procedure, logical semantics, or source
|
||||||
@ -393,7 +393,7 @@ debugging :-
|
|||||||
'$spycall'(G, M, _) :-
|
'$spycall'(G, M, _) :-
|
||||||
% I lost control here.
|
% I lost control here.
|
||||||
'$continue_debugging'(no),
|
'$continue_debugging'(no),
|
||||||
'$execute0'(G, M).
|
'$execute_nonstop'(G, M).
|
||||||
|
|
||||||
|
|
||||||
'$trace'(P,G,Module,L) :-
|
'$trace'(P,G,Module,L) :-
|
||||||
@ -510,10 +510,9 @@ debugging :-
|
|||||||
'$skipeol'(0'k),
|
'$skipeol'(0'k),
|
||||||
'$set_yap_flags'(10,0),
|
'$set_yap_flags'(10,0),
|
||||||
set_value(spy_skip,CallNumber),
|
set_value(spy_skip,CallNumber),
|
||||||
set_value(spy_stop,on),
|
set_value(spy_stop,on).
|
||||||
% skip first call (for current goal),
|
% skip first call (for current goal),
|
||||||
% stop next time.
|
% stop next time.
|
||||||
'$setflop'(0).
|
|
||||||
'$action'(0'r,P,CallId,_,_) :- !, % r retry
|
'$action'(0'r,P,CallId,_,_) :- !, % r retry
|
||||||
'$scan_number'(0'r,CallId,ScanNumber),
|
'$scan_number'(0'r,CallId,ScanNumber),
|
||||||
throw('$retry_spy'(ScanNumber)).
|
throw('$retry_spy'(ScanNumber)).
|
||||||
@ -550,17 +549,14 @@ debugging :-
|
|||||||
|
|
||||||
% if we are in the interpreter, don't need to care about forcing a trace, do we?
|
% if we are in the interpreter, don't need to care about forcing a trace, do we?
|
||||||
'$continue_debugging'(yes) :- !.
|
'$continue_debugging'(yes) :- !.
|
||||||
% I don't need to activate the FlipFlop if I am creeping.
|
|
||||||
'$continue_debugging'(_) :-
|
'$continue_debugging'(_) :-
|
||||||
'$access_yap_flags'(10,1), !,
|
'$access_yap_flags'(10,1), !,
|
||||||
'$creep'.
|
'$creep'.
|
||||||
'$continue_debugging'(_) :-
|
'$continue_debugging'(_) :-
|
||||||
get_value(spy_stop, On),
|
get_value(spy_stop, On).
|
||||||
(On = on -> '$setflop'(1) ; '$setflop'(0)).
|
|
||||||
|
|
||||||
'$stop_debugging' :-
|
'$stop_debugging' :-
|
||||||
'$stop_creep',
|
'$stop_creep'.
|
||||||
'$setflop'(0).
|
|
||||||
|
|
||||||
'$action_help' :-
|
'$action_help' :-
|
||||||
'$format'(user_error,"newline creep a abort~n", []),
|
'$format'(user_error,"newline creep a abort~n", []),
|
||||||
|
21
pl/setof.yap
21
pl/setof.yap
@ -122,6 +122,7 @@ bagof(Template, Generator, Bag) :-
|
|||||||
Key =.. ['$'|LFreeVars],
|
Key =.. ['$'|LFreeVars],
|
||||||
'$init_db_queue'(Ref),
|
'$init_db_queue'(Ref),
|
||||||
'$findall_with_common_vars'(Key-Template, Generator, Ref, Bags0),
|
'$findall_with_common_vars'(Key-Template, Generator, Ref, Bags0),
|
||||||
|
write(vsc:(Bags0,Bags)),nl,
|
||||||
'$keysort'(Bags0, Bags),
|
'$keysort'(Bags0, Bags),
|
||||||
'$pick'(Bags, Key, Bag).
|
'$pick'(Bags, Key, Bag).
|
||||||
% or we just have a list of answers
|
% or we just have a list of answers
|
||||||
@ -212,22 +213,28 @@ all(T,G,S) :-
|
|||||||
|
|
||||||
% $$set does its best to preserve space
|
% $$set does its best to preserve space
|
||||||
'$$set'(S,R) :-
|
'$$set'(S,R) :-
|
||||||
'$$build'(S0,S0,R),
|
'$$build'(S0,_,R),
|
||||||
S = S0.
|
S = S0.
|
||||||
|
|
||||||
'$$build'(Ns,S0,R) :- '$db_dequeue'(R,X), !,
|
'$$build'(Ns,S0,R) :- '$db_dequeue'(R,X), !,
|
||||||
'$$build2'(Ns,S0,R,X).
|
'$$build2'(Ns,S0,R,X).
|
||||||
'$$build'([],_,_).
|
'$$build'([],_,_).
|
||||||
|
|
||||||
'$$build2'(Ns,Hash,R,X) :-
|
|
||||||
'$$in'(Hash,X), !,
|
|
||||||
'$$build'(Ns,Hash,R).
|
|
||||||
'$$build2'([X|Ns],Hash,R,X) :-
|
'$$build2'([X|Ns],Hash,R,X) :-
|
||||||
|
'$$new'(Hash,X), !,
|
||||||
|
'$$build'(Ns,Hash,R).
|
||||||
|
'$$build2'(Ns,Hash,R,X) :-
|
||||||
'$$build'(Ns,Hash,R).
|
'$$build'(Ns,Hash,R).
|
||||||
|
|
||||||
'$$in'(V,_) :- var(V), !, fail.
|
'$$new'(V,El) :- var(V), !, V = n(_,El,_).
|
||||||
'$$in'([El|_],El) :- !.
|
'$$new'(n(R,El0,L),El) :-
|
||||||
'$$in'([_|S],El) :- '$$in'(S,El).
|
compare(C,El0,El),
|
||||||
|
'$$new'(C,R,L,El).
|
||||||
|
|
||||||
|
'$$new'(=,_,_,_) :- !, fail.
|
||||||
|
'$$new'(<,R,_,El) :- '$$new'(R,El).
|
||||||
|
'$$new'(>,_,L,El) :- '$$new'(L,El).
|
||||||
|
|
||||||
|
|
||||||
'$$produce'([T1 same X1|Tn],S,X) :- '$$split'(Tn,T1,X1,S1,S2),
|
'$$produce'([T1 same X1|Tn],S,X) :- '$$split'(Tn,T1,X1,S1,S2),
|
||||||
( S=[T1|S1], X=X1;
|
( S=[T1|S1], X=X1;
|
||||||
|
@ -65,7 +65,7 @@
|
|||||||
'$start_creep'([Mod|G]) :-
|
'$start_creep'([Mod|G]) :-
|
||||||
'$hidden_predicate'(G,Mod), !,
|
'$hidden_predicate'(G,Mod), !,
|
||||||
'$creep',
|
'$creep',
|
||||||
'$execute0'(G,Mod).
|
'$execute_nonstop'(G,Mod).
|
||||||
'$start_creep'([Mod|G]) :-
|
'$start_creep'([Mod|G]) :-
|
||||||
'$stop_debugging',
|
'$stop_debugging',
|
||||||
CP is '$last_choice_pt',
|
CP is '$last_choice_pt',
|
||||||
@ -90,7 +90,7 @@
|
|||||||
on_signal(Signal,OldAction,default) :-
|
on_signal(Signal,OldAction,default) :-
|
||||||
'$reset_signal'(Signal, OldAction).
|
'$reset_signal'(Signal, OldAction).
|
||||||
on_signal(Signal,OldAction,Action) :-
|
on_signal(Signal,OldAction,Action) :-
|
||||||
var(Action),
|
var(Action), !,
|
||||||
'$check_signal'(OldAction),
|
'$check_signal'(OldAction),
|
||||||
Action = OldAction.
|
Action = OldAction.
|
||||||
on_signal(Signal,OldAction,Action) :-
|
on_signal(Signal,OldAction,Action) :-
|
||||||
|
Reference in New Issue
Block a user