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

fix debugger to do well nonsource predicates.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1354 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2005-08-02 03:09:52 +00:00
parent dda96dc613
commit b8f1beec74
11 changed files with 326 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
C/absmi.c
View File

@@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-08-01 15:40:36 $,$Author: ricroc $ *
* Last rev: $Date: 2005-08-02 03:09:48 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.171 2005/08/01 15:40:36 ricroc
* TABLING NEW: better support for incomplete tabling
*
* Revision 1.170 2005/07/06 19:33:51 ricroc
* TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure.
*
@@ -12157,6 +12160,7 @@ Yap_absmi(int inp)
#ifdef YAPOR
SCH_check_requests();
#endif /* YAPOR */
CACHE_A1();
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
@@ -12170,7 +12174,6 @@ Yap_absmi(int inp)
ARG4 = mod;
else
ARG4 = TermProlog;
CACHE_A1();
goto execute_end;
ENDP(pt1);

6
C/amasm.c
View File

@@ -11,8 +11,11 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2005-07-06 15:10:02 $ *
* Last rev: $Date: 2005-08-02 03:09:49 $ *
* $Log: not supported by cvs2svn $
* Revision 1.82 2005/07/06 15:10:02 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.81 2005/06/01 21:23:44 vsc
* inline compare
*
@@ -2465,6 +2468,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cl_u->sc.ClFlags = StaticMask;
cl_u->sc.ClNext = NULL;
cl_u->sc.ClSize = size;
cl_u->sc.usc.ClPred = cip->CurrentPred;
if (*clause_has_blobsp) {
cl_u->sc.ClFlags |= HasBlobsMask;
}

9
C/cdmgr.c
View File

@@ -11,8 +11,11 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2005-08-01 15:40:37 $,$Author: ricroc $ *
* Last rev: $Date: 2005-08-02 03:09:49 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.166 2005/08/01 15:40:37 ricroc
* TABLING NEW: better support for incomplete tabling
*
* Revision 1.165 2005/07/06 19:33:52 ricroc
* TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure.
*
@@ -4121,6 +4124,10 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
} else {
Term t;
if (!(pe->PredFlags & SourcePredFlag)) {
rtn = Yap_MkStaticRefTerm(cl);
return Yap_unify(tr, rtn);
}
while ((t = Yap_FetchTermFromDB(cl->usc.ClSource)) == 0L) {
if (first_time) {
if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {

67
C/exec.c
View File

@@ -30,7 +30,13 @@ STATIC_PROTO(Int p_execute0, (void));
static Term
cp_as_integer(choiceptr cp)
{
return(MkIntTerm(LCL0-(CELL *)cp));
return(MkIntegerTerm(LCL0-(CELL *)cp));
}
static choiceptr
cp_from_integer(Term cpt)
{
return (choiceptr)(LCL0-(CELL *)IntegerOfTerm(cpt));
}
Term
@@ -242,6 +248,64 @@ p_execute(void)
return(do_execute(t, CurrentModule));
}
static Int
p_execute_clause(void)
{ /* '$execute_clause'(Goal) */
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
StaticClause *cl = Yap_ClauseFromTerm(Deref(ARG3));
choiceptr cp = cp_from_integer(Deref(ARG4));
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!! */
return CallPredicate(RepPredProp(pe), cp, cl->ClCode);
}
static Int
p_execute_in_mod(void)
{ /* '$execute'(Goal) */
@@ -1580,6 +1644,7 @@ Yap_InitExecFs(void)
#endif
Yap_InitCPred("$execute0", 2, p_execute0, HiddenPredFlag);
Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop, HiddenPredFlag);
Yap_InitCPred("$execute_clause", 4, p_execute_clause, HiddenPredFlag);
Yap_InitCPred("$save_current_choice_point", 1, p_save_cp, HiddenPredFlag);
Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag|HiddenPredFlag);

17
C/index.c
View File

@@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2005-08-01 15:40:37 $,$Author: ricroc $ *
* Last rev: $Date: 2005-08-02 03:09:50 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.142 2005/08/01 15:40:37 ricroc
* TABLING NEW: better support for incomplete tabling
*
* Revision 1.141 2005/07/19 16:54:20 rslopes
* fix for older compilers...
*
@@ -6528,9 +6531,15 @@ static_clause(yamop *ipc, PredEntry *ap)
while ((c = ClauseCodeToStaticClause(p))) {
UInt fls = c->ClFlags & ~HasBlobsMask;
if (fls == StaticMask) {
if ((char *)c->usc.ClSource < (char *)c+c->ClSize &&
valid_instructions(ipc, c->ClCode))
return c;
if (ap->PredFlags & SourcePredFlag) {
if ((char *)c->usc.ClSource < (char *)c+c->ClSize &&
valid_instructions(ipc, c->ClCode))
return c;
} else {
if (c->usc.ClPred == ap &&
valid_instructions(ipc, c->ClCode))
return c;
}
} else if (fls == (StaticMask|FactMask)) {
if (c->usc.ClPred == ap &&
valid_instructions(ipc,c->ClCode))