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

debugger fixes

Browse Source 
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:
vsc 2004-05-13 20:54:58 +00:00
parent 94714907ec
commit 9d12384db1
18 changed files with 177 additions and 274 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* 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 $
* 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
* more fixes for USE_SYSTEM_MEMORY
*
@ -146,7 +149,12 @@ push_live_regs(yamop *pco)
#include <stdio.h>
void prof_alrm(int signo)
{
#ifdef i386
fprintf(FProf,"%p\n", PREG);
#else
/* vsc: not really supported for shadow regs */
fprintf(FProf,"%p\n", P);
#endif
return;
}
@ -1305,6 +1313,7 @@ Yap_absmi(int inp)
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
Term t;
ASP = YREG;
saveregs();
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
if (!Yap_gc(3, ENV, CP)) {
@ -1409,12 +1418,10 @@ Yap_absmi(int inp)
/* spy_or_trymark */
BOp(spy_or_trymark, ld);
if (FlipFlop ^= 1) {
READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
PREG = (yamop *)(&(((PredEntry *)(PREG->u.ld.p))->OpcodeOfPred));
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
goto dospy;
}
READ_LOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
PREG = (yamop *)(&(((PredEntry *)(PREG->u.ld.p))->OpcodeOfPred));
READ_UNLOCK(((PredEntry *)(PREG->u.ld.p))->PRWLock);
goto dospy;
ENDBOp();
/* try_and_mark Label,NArgs */
@ -6609,17 +6616,6 @@ Yap_absmi(int inp)
ENDBOp();
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:
{
PredEntry *pe = PredFromDefCode(PREG);

3
C/attvar.c
View File

@ -644,6 +644,7 @@ p_attvar_bound(void)
void Yap_InitAttVarPreds(void)
{
Term OldCurrentModule = CurrentModule;
attas[attvars_ext].bind_op = WakeAttVar;
attas[attvars_ext].copy_term_op = CopyAttVar;
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("bind_attvar", 1, p_bind_attvar, 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("$att_bound", 1, p_attvar_bound, SafePredFlag|TestPredFlag);
}

2
C/c_interface.c
View File

@ -934,7 +934,7 @@ YAP_Init(YAP_init_args *yap_init)
Yap_InitYaamRegs();
#endif /* SBA */
/* slaves, waiting for work */
CurrentModule = 1;
CurrentModule = USER_MODULE;
P = GETWORK_FIRST_TIME;
Yap_exec_absmi(FALSE);
abort_optyap("abstract machine unexpected exit");

9
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c *
* 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 $
* Revision 1.120 2004/04/27 16:21:16 vsc
* stupid bug
*
* Revision 1.119 2004/04/27 15:03:43 vsc
* more fixes for expand_clauses
*
@ -1095,8 +1098,9 @@ not_was_reconsulted(PredEntry *p, Term t, int mode)
if (fp != ConsultBase)
return (FALSE);
if (mode) {
if (ConsultSp == ConsultLow+1)
if (ConsultSp == ConsultLow+1) {
expand_consult();
}
--ConsultSp;
ConsultSp->p = p0;
if (ConsultBase[1].mode &&
@ -1144,7 +1148,6 @@ addcl_permission_error(AtomEntry *ap, Int Arity, int in_use)
}
}
static Term
addclause(Term t, yamop *cp, int mode, int mod)
/*

2
C/corout.c
View File

@ -388,11 +388,11 @@ TermToSuspendedVar(Term gs, Term var)
vs = (sus_tag *)Yap_ReadTimedVar(DelayedVars);
if (H0 - (CELL *)vs < 1024)
return(FALSE);
Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
RESET_VARIABLE(&(vs->ActiveSus));
vs->sus_id = susp_ext;
vs->SG = terms_to_suspended_goals(gs);
Yap_unify(var,(CELL)&(vs->ActiveSus));
Yap_UpdateTimedVar(DelayedVars, (CELL)(vs+1));
return(TRUE);
}

36
C/dbase.c
View File

@ -652,7 +652,6 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
int vars_found = 0;
#ifdef COROUTINING
Term ConstraintsTerm = TermNil;
CELL *ConstraintsBottom = NULL;
CELL *origH = H;
#endif
CELL *CodeMaxBase = CodeMax;
@ -899,19 +898,14 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
int sz = to_visit-to_visit_base;
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[1] = attas[ExtFromCell(ptd0)].to_term_op(ptd0);
t[2] = MkIntegerTerm(ExtFromCell(ptd0));
t[3] = TermNil;
if (ConstraintsBottom == NULL) {
ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
ConstraintsBottom = RepAppl(ConstraintsTerm)+4;
} else {
Term new = Yap_MkApplTerm(FunctorClist, 4, t);
*ConstraintsBottom = new;
ConstraintsBottom = RepAppl(new)+4;
}
t[3] = ConstraintsTerm;
ConstraintsTerm = Yap_MkApplTerm(FunctorClist, 4, t);
if (H+sz >= ASP) {
goto error2;
}
@ -961,14 +955,18 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#ifdef COROUTINING
/* we still may have constraints to do */
if (ConstraintsTerm != TermNil) {
*attachmentsp = (CELL)CodeMax;
if (ConstraintsTerm != TermNil &&
!(RepAppl(ConstraintsTerm) >= tbase &&
RepAppl(ConstraintsTerm) < StoPoint)
) {
*attachmentsp = (CELL)(CodeMax+1);
pt0 = RepAppl(ConstraintsTerm)+1;
pt0_end = RepAppl(ConstraintsTerm)+4;
ConstraintsTerm = TermNil;
StoPoint = CodeMax;
*StoPoint++ = RepAppl(ConstraintsTerm)[0];
ConstraintsTerm = AbsAppl(CodeMax);
CheckDBOverflow();
CodeMax += 4;
CodeMax += 5;
goto loop;
}
#endif
@ -1431,7 +1429,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size, struc
#ifdef COROUTINING
/* attachment */
if (IsVarTerm(Tm)) {
tt = sizeof(CELL);
tt = (CELL)(ppt0->Contents);
ntp = MkDBTerm(VarOfTerm(Tm), VarOfTerm(Tm), ntp0, ntp0+1, ntp0-1,
&attachments,
&vars_found,
@ -2432,7 +2430,11 @@ GetDBTerm(DBTerm *DBSP)
{
Term t = DBSP->Entry;
if (IsVarTerm(t)) {
if (IsVarTerm(t)
#if COROUTINING
&& !DBSP->attachments
#endif
) {
return MkVarTerm();
} else if (IsAtomOrIntTerm(t)) {
return t;

270
C/exec.c
View File

@ -21,13 +21,11 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#include "absmi.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 CallClause, (PredEntry *, Int));
STATIC_PROTO(Int p_save_cp, (void));
STATIC_PROTO(Int p_execute, (void));
STATIC_PROTO(Int p_execute0, (void));
STATIC_PROTO(Int p_at_execute, (void));
static Term
cp_as_integer(choiceptr cp)
@ -42,7 +40,7 @@ Yap_cp_as_integer(choiceptr cp)
}
static inline Int
CallPredicate(PredEntry *pen, choiceptr cut_pt) {
CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code) {
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,pen,XREGS+1);
@ -61,7 +59,7 @@ CallPredicate(PredEntry *pen, choiceptr cut_pt) {
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
CP = P;
P = pen->CodeOfPred;
P = code;
/* vsc: increment reduction counter at meta-call entry */
READ_UNLOCK(pen->PRWLock);
if (pen->PredFlags & ProfiledPredFlag) {
@ -80,7 +78,7 @@ CallMetaCall(Term mod) {
ARG2 = cp_as_integer(B); /* p_save_cp */
ARG3 = ARG1;
ARG4 = mod;
return (CallPredicate(PredMetaCall, B));
return (CallPredicate(PredMetaCall, B, PredMetaCall->CodeOfPred));
}
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
p_save_cp(void)
{
@ -217,10 +124,12 @@ p_save_cp(void)
inline static Int
do_execute(Term t, Term mod)
{
if (ActiveSignals) {
return(EnterCreepMode(t, mod));
} else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCall(mod));
/* first do predicate expansion, even before you process signals.
This way you don't get to spy goal_expansion(). */
if (PRED_GOAL_EXPANSION_ON) {
return CallMetaCall(mod);
} else if (ActiveSignals) {
return EnterCreepMode(t, mod);
}
restart_exec:
if (IsVarTerm(t)) {
@ -268,7 +177,7 @@ do_execute(Term t, Term mod)
XREGS[i] = *pt++;
#endif
}
return (CallPredicate(pen, B));
return (CallPredicate(pen, B, pen->CodeOfPred));
} else if (IsAtomTerm(t)) {
PredEntry *pe;
Atom a = AtomOfTerm(t);
@ -279,7 +188,7 @@ do_execute(Term t, Term mod)
return(FALSE);
/* call may not define new system predicates!! */
pe = RepPredProp(PredPropByAtom(a, mod));
return (CallPredicate(pe, B));
return (CallPredicate(pe, B, pe->CodeOfPred));
} else if (IsIntTerm(t)) {
return CallError(TYPE_ERROR_CALLABLE, mod);
} else {
@ -311,7 +220,7 @@ EnterCreepMode(Term t, Term mod) {
CreepFlag = CalculateStackGap();
UNLOCK(SignalLock);
P_before_spy = P;
return (CallPredicate(PredCreep, B));
return (CallPredicate(PredCreep, B, PredCreep->CodeOfPred));
}
static Int
@ -335,10 +244,13 @@ p_execute0(void)
unsigned int arity;
Prop pe;
if (ActiveSignals) {
return EnterCreepMode(t, mod);
}
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1");
return(FALSE);
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
@ -376,11 +288,71 @@ p_execute0(void)
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE,ARG3,"call/1");
return(FALSE);
return FALSE;
}
/* N = arity; */
/* 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
@ -417,7 +389,7 @@ p_execute_0(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -463,7 +435,7 @@ p_execute_1(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -508,7 +480,7 @@ p_execute_2(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -560,7 +532,7 @@ p_execute_3(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -611,7 +583,7 @@ p_execute_4(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -665,7 +637,7 @@ p_execute_5(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -722,7 +694,7 @@ p_execute_6(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -782,7 +754,7 @@ p_execute_7(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -845,7 +817,7 @@ p_execute_8(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -911,7 +883,7 @@ p_execute_9(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
static Int
@ -980,7 +952,7 @@ p_execute_10(void)
XREGS[1] = ptr[0];
XREGS[2] = ptr[1];
}
return (CallPredicate(RepPredProp(pe), B));
return (CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred));
}
#ifdef DEPTH_LIMIT
@ -1005,66 +977,6 @@ p_pred_goal_expansion_on(void) {
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
exec_absmi(int top)
{
@ -1607,7 +1519,6 @@ Yap_InitExecFs(void)
Yap_InitComma();
Yap_InitCPred("$execute", 1, p_execute, 0);
Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
Yap_InitCPred("$execute", 3, p_at_execute, 0);
Yap_InitCPred("$call_with_args", 2, p_execute_0, 0);
Yap_InitCPred("$call_with_args", 3, p_execute_1, 0);
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);
#endif
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("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag);
Yap_InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag);

3
C/iopreds.c
View File

@ -4634,6 +4634,7 @@ Yap_InitBackIO (void)
void
Yap_InitIOPreds(void)
{
Term cm = CurrentModule;
Yap_stdin = stdin;
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_write_stream", 1, p_open_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_byte", 2, p_put_byte, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$set_read_error_handler", 1, p_set_read_error_handler, SafePredFlag|SyncPredFlag);

2
C/modules.c
View File

@ -96,7 +96,7 @@ p_current_module(void)
if (IsVarTerm(t) || !IsAtomTerm(t))
return FALSE;
if (t == TermProlog) {
CurrentModule = 0;
CurrentModule = PROLOG_MODULE;
} else {
CurrentModule = t;
LookupModule(CurrentModule);

5
C/save.c
View File

@ -377,7 +377,6 @@ save_regs(int mode)
putcellptr(S);
putcellptr((CELL *)P);
putout(CreepFlag);
putout(FlipFlop);
putout(EX);
#ifdef COROUTINING
putout(DelayedVars);
@ -711,7 +710,6 @@ get_regs(int flag)
S = get_cellptr();
P = (yamop *)get_cellptr();
CreepFlag = get_cell();
FlipFlop = get_cell();
#ifdef COROUTINING
DelayedVars = get_cell();
#endif
@ -1413,7 +1411,9 @@ Restore(char *s, char *lib_dir)
restore_regs(restore_mode);
in_limbo = FALSE;
/*#endif*/
fprintf(stderr,"1 CurrentModule is %p\n", CurrentModule);
RestoreHeap(old_ops);
fprintf(stderr,"1.5 CurrentModule is %p\n", CurrentModule);
switch(restore_mode) {
case DO_EVERYTHING:
if (OldHeapBase != Yap_HeapBase ||
@ -1437,6 +1437,7 @@ Restore(char *s, char *lib_dir)
Yap_InitYaamRegs();
break;
}
Yap_ReOpenLoadForeign();
Yap_InitPlIO();
/* reset time */

34
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2004-04-27 15:14:36 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ *
* Last rev: $Date: 2004-05-13 20:54:58 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.65 2004/04/27 15:14:36 vsc
* fix halt/0 and halt/1
* *
* *
*************************************************************************/
#ifdef SCCS
@ -478,24 +481,6 @@ p_values(void)
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
do_signal(yap_signals sig)
{
@ -516,7 +501,6 @@ p_creep(void)
CreepCode = pred;
yap_flags[SPY_CREEP_FLAG] = TRUE;
do_signal(YAP_CREEP_SIGNAL);
FlipFlop = 0;
return TRUE;
}
@ -524,7 +508,10 @@ static Int
p_stop_creep(void)
{
LOCK(SignalLock);
CreepFlag = CalculateStackGap();
ActiveSignals &= ~YAP_CREEP_SIGNAL;
if (!ActiveSignals) {
CreepFlag = CalculateStackGap();
}
UNLOCK(SignalLock);
return TRUE;
}
@ -2678,9 +2665,6 @@ Yap_InitCPreds(void)
Yap_InitCPred("set_value", 2, p_setval, SafePredFlag|SyncPredFlag);
Yap_InitCPred("get_value", 2, p_value, TestPredFlag|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 */
Yap_InitCPred("$opdec", 3, p_opdec, SafePredFlag|SyncPredFlag);
Yap_InitCPred("name", 2, p_name, SafePredFlag);

3
C/unify.c
View File

@ -618,11 +618,12 @@ InitReverseLookupOpcode(void)
void
Yap_InitUnify(void)
{
Term cm = CurrentModule;
Yap_InitCPred("unify_with_occurs_check", 2, p_ocunify, SafePredFlag);
CurrentModule = TERMS_MODULE;
Yap_InitCPred("cyclic_term", 1, p_cyclic, SafePredFlag|TestPredFlag);
Yap_InitCPred("acyclic_term", 1, p_acyclic, SafePredFlag|TestPredFlag);
CurrentModule = PROLOG_MODULE;
CurrentModule = cm;
}

3
C/utilpreds.c
View File

@ -1745,6 +1745,7 @@ camacho_dum(void)
void Yap_InitUtilCPreds(void)
{
Term cm = CurrentModule;
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("ground", 1, p_ground, SafePredFlag);
@ -1756,7 +1757,7 @@ void Yap_InitUtilCPreds(void)
Yap_InitCPred("term_hash", 4, GvNTermHash, SafePredFlag);
Yap_InitCPred("variant", 2, p_variant, SafePredFlag);
Yap_InitCPred("subsumes", 2, p_subsumes, SafePredFlag);
CurrentModule = PROLOG_MODULE;
CurrentModule = cm;
#ifdef DEBUG
Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag);
Yap_InitCPred("dum", 1, camacho_dum, SafePredFlag);

4
H/Regs.h
View File

@ -10,7 +10,7 @@
* File: Regs.h *
* mods: *
* 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 */
ADDR AuxTop_; /* 10 Auxiliary stack top */
/* visualc*/
CELL FlipFlop_; /* 18 */
CELL EX_; /* 18 */
#ifdef COROUTINING
Term DelayedVars_; /* maximum number of attributed variables */
@ -650,7 +649,6 @@ EXTERN inline void restore_B(void) {
#define AuxTop Yap_REGS.AuxTop_
#define TopB Yap_REGS.TopB_
#define DelayedB Yap_REGS.DelayedB_
#define FlipFlop Yap_REGS.FlipFlop_
#define EX Yap_REGS.EX_
#define DEPTH Yap_REGS.DEPTH_
#if defined(SBA) || defined(TABLING)

4
pl/boot.yap
View File

@ -437,7 +437,7 @@ repeat :- '$repeat'.
( get_value('$trace', 1) ->
'$creep'
;
'$setflop'(1)
true
).
'$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M).
@ -1086,7 +1086,7 @@ catch(G, C, A) :-
'$system_catch'(G, M, C, A) :-
% check current trail
'$catch'(C,A,_),
'$execute0'(G, M).
'$execute_nonstop'(G, M).
%
% throw has to be *exactly* after system catch!

14
pl/debug.yap
View File

@ -382,7 +382,7 @@ debugging :-
%
'$spycall'(G, M, _) :-
'$access_yap_flags'(10,0), !,
'$execute0'(G, M).
'$execute_nonstop'(G, M).
'$spycall'(G, M, InControl) :-
'$flags'(G,M,F,F),
F /\ 0x8402000 =\= 0, !, % dynamic procedure, logical semantics, or source
@ -393,7 +393,7 @@ debugging :-
'$spycall'(G, M, _) :-
% I lost control here.
'$continue_debugging'(no),
'$execute0'(G, M).
'$execute_nonstop'(G, M).
'$trace'(P,G,Module,L) :-
@ -510,10 +510,9 @@ debugging :-
'$skipeol'(0'k),
'$set_yap_flags'(10,0),
set_value(spy_skip,CallNumber),
set_value(spy_stop,on),
set_value(spy_stop,on).
% skip first call (for current goal),
% stop next time.
'$setflop'(0).
'$action'(0'r,P,CallId,_,_) :- !, % r retry
'$scan_number'(0'r,CallId,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?
'$continue_debugging'(yes) :- !.
% I don't need to activate the FlipFlop if I am creeping.
'$continue_debugging'(_) :-
'$access_yap_flags'(10,1), !,
'$creep'.
'$continue_debugging'(_) :-
get_value(spy_stop, On),
(On = on -> '$setflop'(1) ; '$setflop'(0)).
get_value(spy_stop, On).
'$stop_debugging' :-
'$stop_creep',
'$setflop'(0).
'$stop_creep'.
'$action_help' :-
'$format'(user_error,"newline creep a abort~n", []),

21
pl/setof.yap
View File

@ -122,6 +122,7 @@ bagof(Template, Generator, Bag) :-
Key =.. ['$'|LFreeVars],
'$init_db_queue'(Ref),
'$findall_with_common_vars'(Key-Template, Generator, Ref, Bags0),
write(vsc:(Bags0,Bags)),nl,
'$keysort'(Bags0, Bags),
'$pick'(Bags, Key, Bag).
% or we just have a list of answers
@ -212,22 +213,28 @@ all(T,G,S) :-
% $$set does its best to preserve space
'$$set'(S,R) :-
'$$build'(S0,S0,R),
'$$build'(S0,_,R),
S = S0.
'$$build'(Ns,S0,R) :- '$db_dequeue'(R,X), !,
'$$build2'(Ns,S0,R,X).
'$$build'([],_,_).
'$$build2'(Ns,Hash,R,X) :-
'$$in'(Hash,X), !,
'$$build'(Ns,Hash,R).
'$$build2'([X|Ns],Hash,R,X) :-
'$$new'(Hash,X), !,
'$$build'(Ns,Hash,R).
'$$build2'(Ns,Hash,R,X) :-
'$$build'(Ns,Hash,R).
'$$in'(V,_) :- var(V), !, fail.
'$$in'([El|_],El) :- !.
'$$in'([_|S],El) :- '$$in'(S,El).
'$$new'(V,El) :- var(V), !, V = n(_,El,_).
'$$new'(n(R,El0,L),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),
( S=[T1|S1], X=X1;

4
pl/signals.yap
View File

@ -65,7 +65,7 @@
'$start_creep'([Mod|G]) :-
'$hidden_predicate'(G,Mod), !,
'$creep',
'$execute0'(G,Mod).
'$execute_nonstop'(G,Mod).
'$start_creep'([Mod|G]) :-
'$stop_debugging',
CP is '$last_choice_pt',
@ -90,7 +90,7 @@
on_signal(Signal,OldAction,default) :-
'$reset_signal'(Signal, OldAction).
on_signal(Signal,OldAction,Action) :-
var(Action),
var(Action), !,
'$check_signal'(OldAction),
Action = OldAction.
on_signal(Signal,OldAction,Action) :-