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

several debugger and CLP(BN) improvements.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1732 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-12-13 16:10:26 +00:00
parent ce45aab144
commit 90c1641841
37 changed files with 831 additions and 594 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
C/agc.c
View File

@ -173,7 +173,10 @@ mark_hash_entry(AtomHashEntry *HashPtr)
AtomEntry *at = RepAtom(atm); AtomEntry *at = RepAtom(atm);
do { do {
#ifdef DEBUG_RESTORE1 /* useful during debug */ #ifdef DEBUG_RESTORE1 /* useful during debug */
fprintf(errout, "Restoring %s\n", at->StrOfAE); if (IsWideAtom(atm))
fprintf(errout, "Restoring %S\n", at->WStrOfAE);
else
fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif #endif
RestoreEntries(RepProp(at->PropsOfAE)); RestoreEntries(RepProp(at->PropsOfAE));
atm = at->NextOfAE; atm = at->NextOfAE;
@ -211,7 +214,10 @@ mark_atoms(void)
} }
do { do {
#ifdef DEBUG_RESTORE1 /* useful during debug */ #ifdef DEBUG_RESTORE1 /* useful during debug */
fprintf(errout, "Restoring %s\n", at->StrOfAE); if (IsWideAtom(atm))
fprintf(errout, "Restoring %S\n", at->WStrOfAE);
else
fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif #endif
RestoreEntries(RepProp(at->PropsOfAE)); RestoreEntries(RepProp(at->PropsOfAE));
atm = at->NextOfAE; atm = at->NextOfAE;
@ -330,12 +336,19 @@ clean_atom(AtomHashEntry *HashPtr)
atm = at->NextOfAE; atm = at->NextOfAE;
NOfAtoms--; NOfAtoms--;
} else { } else {
if (IsWideAtom(atm)) {
#ifdef DEBUG_RESTORE3 #ifdef DEBUG_RESTORE3
fprintf(stderr, "Purged %p:%s\n", at, at->StrOfAE); fprintf(errout, "Purged %p:%S\n", at, at->WStrOfAE);
#endif #endif
agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE);
} else {
#ifdef DEBUG_RESTORE3
fprintf(stderr, "Purged %p:%s\n", at, at->StrOfAE);
#endif
agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE);
}
*patm = at->NextOfAE; *patm = at->NextOfAE;
atm = at->NextOfAE; atm = at->NextOfAE;
agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE);
Yap_FreeCodeSpace((char *)at); Yap_FreeCodeSpace((char *)at);
} }
} }
@ -370,12 +383,19 @@ clean_atoms(void)
NOfAtoms--; NOfAtoms--;
atm = at->NextOfAE; atm = at->NextOfAE;
} else { } else {
#ifdef DEBUG_RESTORE1 if (IsWideAtom(atm)) {
fprintf(stderr, "Purged %s\n", at->StrOfAE); #ifdef DEBUG_RESTORE3
fprintf(errout, "Purged %p:%S\n", at, at->WStrOfAE);
#endif #endif
agc_collected += sizeof(AtomEntry)+wcslen(at->WStrOfAE);
} else {
#ifdef DEBUG_RESTORE3
fprintf(stderr, "Purged %p:%s\n", at, at->StrOfAE);
#endif
agc_collected += sizeof(AtomEntry)+strlen(at->StrOfAE);
}
*patm = at->NextOfAE; *patm = at->NextOfAE;
atm = at->NextOfAE; atm = at->NextOfAE;
agc_collected += sizeof(AtomEntry) + strlen(at->StrOfAE);
Yap_FreeCodeSpace((char *)at); Yap_FreeCodeSpace((char *)at);
} }
} }

16
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * comments: abstract machine assembler *
* * * *
* Last rev: $Date: 2006-11-15 00:13:36 $ * * Last rev: $Date: 2006-12-13 16:10:14 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.92 2006/11/15 00:13:36 vsc
* fixes for indexing code.
*
* Revision 1.91 2006/11/06 18:35:03 vsc * Revision 1.91 2006/11/06 18:35:03 vsc
* 1estranha * 1estranha
* *
@ -1310,7 +1313,8 @@ compile_cmp_flags(char *s)
wamreg wamreg
Yap_compile_cmp_flags(PredEntry *pred) Yap_compile_cmp_flags(PredEntry *pred)
{ {
return compile_cmp_flags(RepAtom(NameOfFunctor(pred->FunctorOfPred))->StrOfAE); return
compile_cmp_flags(RepAtom(NameOfFunctor(pred->FunctorOfPred))->StrOfAE);
} }
static yamop * static yamop *
@ -3506,12 +3510,16 @@ Yap_InitComma(void)
Functor fp = Yap_MkFunctor(Yap_FullLookupAtom("$generate_pred_info"),4); Functor fp = Yap_MkFunctor(Yap_FullLookupAtom("$generate_pred_info"),4);
code_p->opc = emit_op(_call_cpred); code_p->opc = emit_op(_call_cpred);
code_p->u.sla.s = emit_count(-Signed(RealEnvSize)); code_p->u.sla.s = emit_count(-Signed(RealEnvSize));
code_p->u.sla.sla_u.p = RepPredProp(Yap_GetPredPropByFunc(fp,0)); code_p->u.sla.sla_u.p =
code_p->u.sla.p0 =
RepPredProp(Yap_GetPredPropByFunc(fp,0));
code_p->u.sla.bmap = NULL; code_p->u.sla.bmap = NULL;
GONEXT(sla); GONEXT(sla);
code_p->opc = emit_op(_call); code_p->opc = emit_op(_call);
code_p->u.sla.s = emit_count(-Signed(RealEnvSize)); code_p->u.sla.s = emit_count(-Signed(RealEnvSize));
code_p->u.sla.sla_u.p = PredMetaCall; code_p->u.sla.sla_u.p =
code_p->u.sla.p0 =
PredMetaCall;
code_p->u.sla.bmap = NULL; code_p->u.sla.bmap = NULL;
GONEXT(sla); GONEXT(sla);
code_p->opc = emit_op(_deallocate); code_p->opc = emit_op(_deallocate);

33
C/analyst.c
View File

@ -87,16 +87,26 @@ static Int
p_show_op_counters() p_show_op_counters()
{ {
int i; int i;
char *program;
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsVarTerm(t1) || !IsAtomTerm(t1)) { if (IsVarTerm(t1) || !IsAtomTerm(t1)) {
return FALSE; return FALSE;
} else { } else {
program = RepAtom(AtomOfTerm(t1))->StrOfAE; Atom at1 = AtomOfTerm(t1);
if (IsWideAtom(at1)) {
wchar_t *program;
program = RepAtom(at1)->WStrOfAE;
fprintf(Yap_stderr, "\n Instructions Executed in %S\n", program);
} else {
char *program;
program = RepAtom(at1)->StrOfAE;
fprintf(Yap_stderr, "\n Instructions Executed in %s\n", program);
}
} }
fprintf(Yap_stderr, "\n Instructions Executed in %s \n", program);
for (i = 0; i <= _std_top; ++i) for (i = 0; i <= _std_top; ++i)
print_instruction(i); print_instruction(i);
fprintf(Yap_stderr, "\n Control Instructions \n"); fprintf(Yap_stderr, "\n Control Instructions \n");
@ -300,14 +310,24 @@ p_show_ops_by_group(void)
ccpcount c_cp; ccpcount c_cp;
int gets, unifies, puts, writes, controls, choice_pts, indexes, misc, int gets, unifies, puts, writes, controls, choice_pts, indexes, misc,
total; total;
char *program;
Term t1; Term t1;
Atom at1;
t1 = Deref(ARG1); t1 = Deref(ARG1);
if (IsVarTerm(t1) || !IsAtomTerm(t1)) if (IsVarTerm(t1) || !IsAtomTerm(t1))
return (FALSE); return (FALSE);
else at1 = AtomOfTerm(t1);
program = RepAtom(AtomOfTerm(t1))->StrOfAE; if (IsWideAtom(at1)) {
wchar_t *program;
program = RepAtom(at1)->WStrOfAE;
fprintf(Yap_stderr, "\n Instructions Executed in %S\n", program);
} else {
char *program;
program = RepAtom(at1)->StrOfAE;
fprintf(Yap_stderr, "\n Instructions Executed in %s\n", program);
}
c_get.nxvar = c_get.nxvar =
Yap_opcount[_get_x_var]; Yap_opcount[_get_x_var];
@ -634,7 +654,6 @@ p_show_ops_by_group(void)
* print_instruction(i); * print_instruction(i);
*/ */
fprintf(Yap_stderr, "\n Instructions Executed in %s\n", program);
fprintf(Yap_stderr, "Groups are\n\n"); fprintf(Yap_stderr, "Groups are\n\n");
fprintf(Yap_stderr, " GET instructions: %8d (%3d%%)\n", gets, fprintf(Yap_stderr, " GET instructions: %8d (%3d%%)\n", gets,
(gets * 100) / total); (gets * 100) / total);

127
C/c_interface.c
View File

@ -10,8 +10,11 @@
* File: c_interface.c * * File: c_interface.c *
* comments: c_interface primitives definition * * comments: c_interface primitives definition *
* * * *
* Last rev: $Date: 2006-11-27 17:42:02 $,$Author: vsc $ * * Last rev: $Date: 2006-12-13 16:10:14 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.86 2006/11/27 17:42:02 vsc
* support for UNICODE, and other bug fixes.
*
* Revision 1.85 2006/05/16 18:37:30 vsc * Revision 1.85 2006/05/16 18:37:30 vsc
* WIN32 fixes * WIN32 fixes
* compiler bug fixes * compiler bug fixes
@ -338,10 +341,9 @@ X_API CELL STD_PROTO(YAP_ThreadCreateEngine,(thread_attr *));
X_API int STD_PROTO(YAP_ThreadAttachEngine,(int)); X_API int STD_PROTO(YAP_ThreadAttachEngine,(int));
X_API int STD_PROTO(YAP_ThreadDetachEngine,(int)); X_API int STD_PROTO(YAP_ThreadDetachEngine,(int));
X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int)); X_API int STD_PROTO(YAP_ThreadDestroyEngine,(int));
X_API int STD_PROTO(YAP_ArgsToIntArray,(Term, UInt, const Int *)); X_API Term STD_PROTO(YAP_MkBlobTerm,(unsigned int));
X_API Term STD_PROTO(YAP_IntArrayToArgs,(UInt, const Int *)); X_API void *STD_PROTO(YAP_BlobOfTerm,(Term));
X_API int STD_PROTO(YAP_ArgsToFloatArray,(Term, UInt, const Float *)); X_API Term STD_PROTO(YAP_TermNil,(void));
X_API Term STD_PROTO(YAP_FloatArrayToArgs,(UInt, const Float *));
static int (*do_getf)(void); static int (*do_getf)(void);
@ -475,6 +477,40 @@ YAP_BigNumOfTerm(Term t, void *b)
#endif /* USE_GMP */ #endif /* USE_GMP */
} }
X_API Term
YAP_MkBlobTerm(unsigned int sz)
{
Term I;
MP_INT *dst;
BACKUP_H();
I = AbsAppl(H);
if (H+(sz+sizeof(MP_INT)/sizeof(CELL)+2) > ASP-1024)
return TermNil;
H[0] = (CELL)FunctorBigInt;
dst = (MP_INT *)(H+1);
dst->_mp_size = 0L;
dst->_mp_alloc = sz;
H += (1+sizeof(MP_INT)/sizeof(CELL));
H[sz] = EndSpecials;
H += sz+1;
RECOVER_H();
return I;
}
X_API void *
YAP_BlobOfTerm(Term t)
{
MP_INT *src;
if (IsVarTerm(t))
return NULL;
if (!IsBigIntTerm(t))
return NULL;
src = (MP_INT *)(RepAppl(t)+1);
return (void *)(src+1);
}
X_API Term X_API Term
YAP_MkFloatTerm(double n) YAP_MkFloatTerm(double n)
{ {
@ -1640,86 +1676,9 @@ YAP_ThreadDestroyEngine(int wid)
#endif #endif
} }
/* Copy a number of terms to an array of integers */
X_API int
YAP_ArgsToIntArray(Term t, UInt size, const Int *ar)
{
Int *dest = (Int *)ar;
CELL *ptr;
if (IsVarTerm(t) ||
!IsApplTerm(t)) return FALSE;
if (ArityOfFunctor(FunctorOfTerm(t)) != size)
return FALSE;
ptr = RepAppl(t)+1;
while (size) {
Term t = *ptr++;
if (IsVarTerm(t) || !IsIntegerTerm(t))
return FALSE;
*dest++ = IntegerOfTerm(t);
}
return TRUE;
}
X_API Term X_API Term
YAP_IntArrayToArgs(UInt size, const Int *ar) YAP_TermNil(void)
{ {
Term t; return TermNil;
BACKUP_H();
CELL *ptr = H+1;
Int *source = (Int *)ar;
if (H+(size+1) >= ASP) {
return TermNil;
}
t = AbsAppl(H);
*H++ = (CELL)Yap_MkFunctor(Yap_LookupAtom("data"),size);
H+=size;
while (size) {
*ptr++ = MkIntegerTerm(*source++);
}
RECOVER_H();
return t;
}
X_API int
YAP_ArgsToFloatArray(Term t, UInt size, const Float *ar)
{
CELL *ptr;
Float *dest = (Float *)ar;
if (IsVarTerm(t) ||
!IsApplTerm(t)) return FALSE;
if (ArityOfFunctor(FunctorOfTerm(t)) != size)
return FALSE;
ptr = RepAppl(t)+1;
while (size) {
Term t = *ptr++;
if (IsVarTerm(t) || !IsFloatTerm(t))
return FALSE;
*dest++ = FloatOfTerm(t);
}
return TRUE;
}
X_API Term
YAP_FloatArrayToArgs(UInt size, const Float *ar)
{
Term t;
BACKUP_H();
CELL *ptr = H+1;
Float *source = (Float *)ar;
if (H+(size+1) >= ASP) {
return TermNil;
}
t = AbsAppl(H);
*H++ = (CELL)Yap_MkFunctor(Yap_LookupAtom("data"),size);
H+=size;
while (size) {
*ptr++ = MkFloatTerm(*source++);
}
RECOVER_H();
return t;
} }

107
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * comments: Code manager *
* * * *
* Last rev: $Date: 2006-11-27 17:42:02 $,$Author: vsc $ * * Last rev: $Date: 2006-12-13 16:10:14 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.200 2006/11/27 17:42:02 vsc
* support for UNICODE, and other bug fixes.
*
* Revision 1.199 2006/11/15 00:13:36 vsc * Revision 1.199 2006/11/15 00:13:36 vsc
* fixes for indexing code. * fixes for indexing code.
* *
@ -3375,6 +3378,12 @@ p_all_choicepoints(void)
return Yap_unify(ARG1,all_cps(B)); return Yap_unify(ARG1,all_cps(B));
} }
static Int
p_all_envs(void)
{
return Yap_unify(ARG1,all_envs(ENV));
}
static Int static Int
p_current_stack(void) p_current_stack(void)
{ {
@ -5680,12 +5689,69 @@ p_program_continuation(void)
static Term static Term
BuildActivePred(PredEntry *ap, CELL *vect) BuildActivePred(PredEntry *ap, CELL *vect)
{ {
UInt i;
if (!ap->ArityOfPE) { if (!ap->ArityOfPE) {
return MkVarTerm(); return MkVarTerm();
} }
for (i = 0; i < ap->ArityOfPE; i++) {
Term t = Deref(vect[i]);
if (IsVarTerm(t)) {
CELL *pt = VarOfTerm(t);
/* one stack */
if (pt > H) {
Term nt = MkVarTerm();
Yap_unify(t, nt);
}
}
}
return Yap_MkApplTerm(ap->FunctorOfPred, ap->ArityOfPE, vect); return Yap_MkApplTerm(ap->FunctorOfPred, ap->ArityOfPE, vect);
} }
static int
UnifyPredInfo(PredEntry *pe, int start_arg) {
UInt arity = pe->ArityOfPE;
Term tmod, tname;
if (pe->ModuleOfPred != IDB_MODULE) {
if (pe->ModuleOfPred == PROLOG_MODULE) {
tmod = TermProlog;
} else {
tmod = pe->ModuleOfPred;
}
if (pe->ArityOfPE == 0) {
tname = MkAtomTerm((Atom)pe->FunctorOfPred);
} else {
Functor f = pe->FunctorOfPred;
tname = MkAtomTerm(NameOfFunctor(f));
}
} else {
tmod = pe->ModuleOfPred;
if (pe->PredFlags & NumberDBPredFlag) {
tname = MkIntegerTerm(pe->src.IndxId);
} else if (pe->PredFlags & AtomDBPredFlag) {
tname = MkAtomTerm((Atom)pe->FunctorOfPred);
} else {
Functor f = pe->FunctorOfPred;
tname = MkAtomTerm(NameOfFunctor(f));
}
}
return Yap_unify(XREGS[start_arg], tmod) &&
Yap_unify(XREGS[start_arg+1],tname) &&
Yap_unify(XREGS[start_arg+2],MkIntegerTerm(arity));
}
static Int
p_env_info(void)
{
PredEntry *pe;
yamop *env_cp = (yamop *)IntegerOfTerm(Deref(ARG1));
pe = PREVOP(env_cp,sla)->u.sla.p0;
return UnifyPredInfo(pe, 2);
}
static Int static Int
p_choicepoint_info(void) p_choicepoint_info(void)
{ {
@ -5693,8 +5759,7 @@ p_choicepoint_info(void)
PredEntry *pe; PredEntry *pe;
int go_on = TRUE; int go_on = TRUE;
yamop *ipc = cptr->cp_ap; yamop *ipc = cptr->cp_ap;
Term t, tname, tmod; Term t;
UInt arity;
while (go_on) { while (go_on) {
op_numbers opnum = Yap_op_from_opcode(ipc->opc); op_numbers opnum = Yap_op_from_opcode(ipc->opc);
@ -5812,6 +5877,12 @@ p_choicepoint_info(void)
t = BuildActivePred(pe, cptr->cp_args); t = BuildActivePred(pe, cptr->cp_args);
break; break;
case _Nstop: case _Nstop:
{
Atom at = Yap_FullLookupAtom("$live");
t = MkAtomTerm(at);
pe = RepPredProp(PredPropByAtom(at, CurrentModule));
}
break;
case _Ystop: case _Ystop:
default: default:
pe = NULL; pe = NULL;
@ -5819,33 +5890,7 @@ p_choicepoint_info(void)
return FALSE; return FALSE;
} }
} }
arity = pe->ArityOfPE; return UnifyPredInfo(pe, 2) &&
if (pe->ModuleOfPred != IDB_MODULE) {
if (pe->ModuleOfPred == PROLOG_MODULE) {
tmod = TermProlog;
} else {
tmod = pe->ModuleOfPred;
}
if (pe->ArityOfPE == 0) {
tname = MkAtomTerm((Atom)pe->FunctorOfPred);
} else {
Functor f = pe->FunctorOfPred;
tname = MkAtomTerm(NameOfFunctor(f));
}
} else {
tmod = pe->ModuleOfPred;
if (pe->PredFlags & NumberDBPredFlag) {
tname = MkIntegerTerm(pe->src.IndxId);
} else if (pe->PredFlags & AtomDBPredFlag) {
tname = MkAtomTerm((Atom)pe->FunctorOfPred);
} else {
Functor f = pe->FunctorOfPred;
tname = MkAtomTerm(NameOfFunctor(f));
}
}
return Yap_unify(ARG2, tmod) &&
Yap_unify(ARG3,tname) &&
Yap_unify(ARG4,MkIntegerTerm(arity)) &&
Yap_unify(ARG5,t); Yap_unify(ARG5,t);
} }
@ -5906,7 +5951,9 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$p_nth_clause", 4, p_nth_clause, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$p_nth_clause", 4, p_nth_clause, SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$all_choicepoints", 1, p_all_choicepoints, HiddenPredFlag); Yap_InitCPred("$all_choicepoints", 1, p_all_choicepoints, HiddenPredFlag);
Yap_InitCPred("$all_envs", 1, p_all_envs, HiddenPredFlag);
Yap_InitCPred("$choicepoint_info", 5, p_choicepoint_info, HiddenPredFlag); Yap_InitCPred("$choicepoint_info", 5, p_choicepoint_info, HiddenPredFlag);
Yap_InitCPred("$env_info", 4, p_env_info, HiddenPredFlag);
Yap_InitCPred("$predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag); Yap_InitCPred("$predicate_erased_statistics", 5, p_predicate_erased_statistics, SyncPredFlag);
#ifdef DEBUG #ifdef DEBUG
Yap_InitCPred("$predicate_live_cps", 4, p_predicate_lu_cps, 0L); Yap_InitCPred("$predicate_live_cps", 4, p_predicate_lu_cps, 0L);

16
C/dbase.c
View File

@ -4845,22 +4845,6 @@ cont_current_key(void)
READ_UNLOCK(HashChain[i].AERWLock); READ_UNLOCK(HashChain[i].AERWLock);
i++; i++;
} }
i = 0;
while (i < WideAtomHashTableSize) {
/* protect current hash table line, notice that the current
LOCK/UNLOCK algorithm assumes new entries are added to
the *front* of the list, otherwise I should have locked
earlier.
*/
READ_LOCK(HashChain[i].AERWLock);
a = HashChain[i].Entry;
if (a != NIL) {
break;
}
/* move to next entry */
READ_UNLOCK(HashChain[i].AERWLock);
i++;
}
if (i == AtomHashTableSize) { if (i == AtomHashTableSize) {
/* we have left the atom hash table */ /* we have left the atom hash table */
/* we don't have a lock over the hash table any longer */ /* we don't have a lock over the hash table any longer */

4
C/exec.c
View File

@ -362,7 +362,6 @@ EnterCreepMode(Term t, Term mod) {
LOCK(SignalLock); LOCK(SignalLock);
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
UNLOCK(SignalLock); UNLOCK(SignalLock);
yap_flags[SPY_CREEP_FLAG] = TRUE;
P_before_spy = P; P_before_spy = P;
return (CallPredicate(PredCreep, B, PredCreep->CodeOfPred)); return (CallPredicate(PredCreep, B, PredCreep->CodeOfPred));
} }
@ -601,6 +600,8 @@ p_execute_nonstop(void)
/* call may not define new system predicates!! */ /* call may not define new system predicates!! */
if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { if (RepPredProp(pe)->PredFlags & SpiedPredFlag) {
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred); return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred);
} else if (RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) {
return RepPredProp(pe)->cs.f_code();
} else { } else {
return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred); return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred);
} }
@ -1241,7 +1242,6 @@ exec_absmi(int top)
restore_B(); restore_B();
/* H is not so important, because we're gonna backtrack */ /* H is not so important, because we're gonna backtrack */
restore_H(); restore_H();
yap_flags[SPY_CREEP_FLAG] = 0;
LOCK(SignalLock); LOCK(SignalLock);
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
Yap_PrologMode = UserMode; Yap_PrologMode = UserMode;

19
C/globals.c
View File

@ -145,12 +145,14 @@ NewDelayArena(UInt size)
{ {
attvar_record *max = DelayTop(), *min = max-size; attvar_record *max = DelayTop(), *min = max-size;
Term out; Term out;
UInt howmuch;
while ((ADDR)min < Yap_GlobalBase+1024) { while ((ADDR)min < Yap_GlobalBase+1024) {
if (!Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))) { if ((howmuch = Yap_InsertInGlobal((CELL *)max, size*sizeof(attvar_record))==0)) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
return TermNil; return TermNil;
} }
size = howmuch/sizeof(attvar_record);
max = DelayTop(), min = max-size; max = DelayTop(), min = max-size;
} }
out = CreateDelayArena(max, min); out = CreateDelayArena(max, min);
@ -162,6 +164,8 @@ static Term
GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity) GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity)
{ {
Term arena = *arenap; Term arena = *arenap;
UInt howmuch;
if (size == 0) { if (size == 0) {
if (old_size < 1024) { if (old_size < 1024) {
size = old_size; size = old_size;
@ -173,10 +177,11 @@ GrowDelayArena(Term *arenap, UInt old_size, UInt size, UInt arity)
size = 64; size = 64;
} }
XREGS[arity+1] = (CELL)arenap; XREGS[arity+1] = (CELL)arenap;
if (!Yap_InsertInGlobal((CELL *)arena, (size-old_size)*sizeof(attvar_record))) { if ((howmuch = Yap_InsertInGlobal((CELL *)arena, (size-old_size)*sizeof(attvar_record)))==0) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return TermNil; return TermNil;
} }
size = howmuch/sizeof(attvar_record)+old_size;
arenap = (CELL *)XREGS[arity+1]; arenap = (CELL *)XREGS[arity+1];
arena = *arenap; arena = *arenap;
CreateDelayArena(DelayArenaPt(arena), DelayArenaPt(arena)-size); CreateDelayArena(DelayArenaPt(arena), DelayArenaPt(arena)-size);
@ -189,6 +194,7 @@ static Term
NewArena(UInt size, UInt arity, CELL *where) NewArena(UInt size, UInt arity, CELL *where)
{ {
Term t; Term t;
UInt new_size;
if (where == NULL || where == H) { if (where == NULL || where == H) {
while (H+size > ASP-1024) { while (H+size > ASP-1024) {
@ -200,10 +206,11 @@ NewArena(UInt size, UInt arity, CELL *where)
t = CreateNewArena(H, size); t = CreateNewArena(H, size);
H += size; H += size;
} else { } else {
if (!Yap_InsertInGlobal(where, size*sizeof(CELL))) { if ((new_size=Yap_InsertInGlobal(where, size*sizeof(CELL)))==0) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
return TermNil; return TermNil;
} }
size = new_size/sizeof(CELL);
t = CreateNewArena(where, size); t = CreateNewArena(where, size);
} }
return t; return t;
@ -291,10 +298,11 @@ GrowArena(Term arena, CELL *pt, UInt old_size, UInt size, UInt arity)
H += size; H += size;
} else { } else {
XREGS[arity+1] = arena; XREGS[arity+1] = arena;
if (!Yap_InsertInGlobal(pt, size*sizeof(CELL))) { if ((size=Yap_InsertInGlobal(pt, size*sizeof(CELL)))==0) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE; return FALSE;
} }
size = size/sizeof(CELL);
arena = XREGS[arity+1]; arena = XREGS[arity+1];
} }
CreateNewArena(ArenaPt(arena), size+old_size); CreateNewArena(ArenaPt(arena), size+old_size);
@ -1474,10 +1482,11 @@ p_nb_heap_add_to_heap(void)
} else { } else {
extra_size = hmsize; extra_size = hmsize;
} }
if (!Yap_InsertInGlobal(top, extra_size*2*sizeof(CELL))) { if ((extra_size=Yap_InsertInGlobal(top, extra_size*2*sizeof(CELL)))==0) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms"); Yap_Error(OUT_OF_STACK_ERROR,TermNil,"No Stack Space for Non-Backtrackable terms");
return FALSE; return FALSE;
} }
extra_size = extra_size/(2*sizeof(CELL));
qd = GetHeap(ARG1,"add_to_heap"); qd = GetHeap(ARG1,"add_to_heap");
hmsize += extra_size; hmsize += extra_size;
if (!qd) if (!qd)

36
C/grow.c
View File

@ -607,7 +607,11 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit)
} }
if (size < ((char *)H0-omax)/8) if (size < ((char *)H0-omax)/8)
size = ((char *)H0-omax)/8; size = ((char *)H0-omax)/8;
size0 = size = AdjustPageSize(size); if (do_grow) {
size0 = size = AdjustPageSize(size);
} else {
size0 = size;
}
/* adjust to a multiple of 256) */ /* adjust to a multiple of 256) */
Yap_ErrorMessage = NULL; Yap_ErrorMessage = NULL;
Yap_PrologMode |= GrowStackMode; Yap_PrologMode |= GrowStackMode;
@ -621,7 +625,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit)
if (size < 0) { if (size < 0) {
Yap_ErrorMessage = "Global Stack crashed against Local Stack"; Yap_ErrorMessage = "Global Stack crashed against Local Stack";
Yap_PrologMode &= ~GrowStackMode; Yap_PrologMode &= ~GrowStackMode;
return FALSE; return 0;
} }
} }
} }
@ -705,7 +709,7 @@ static_growglobal(long size, CELL **ptr, CELL *hsplit)
fprintf(Yap_stderr, "%% %cO Total of %g sec expanding stacks \n", vb_msg1, (double)total_delay_overflow_time/1000); fprintf(Yap_stderr, "%% %cO Total of %g sec expanding stacks \n", vb_msg1, (double)total_delay_overflow_time/1000);
} }
Yap_PrologMode &= ~GrowStackMode; Yap_PrologMode &= ~GrowStackMode;
return(TRUE); return size0;
} }
static void static void
@ -1062,19 +1066,7 @@ Yap_growglobal(CELL **ptr)
return(FALSE); return(FALSE);
} }
#endif #endif
if (!static_growglobal(sz, ptr, NULL)) if ( static_growglobal(sz, ptr, NULL) == 0)
return(FALSE);
#ifdef TABLING
fix_tabling_info();
#endif /* TABLING */
return(TRUE);
}
int
Yap_InsertInGlobal(CELL *where, UInt howmuch)
{
if (!static_growglobal(howmuch, NULL, where))
return FALSE; return FALSE;
#ifdef TABLING #ifdef TABLING
fix_tabling_info(); fix_tabling_info();
@ -1083,6 +1075,18 @@ Yap_InsertInGlobal(CELL *where, UInt howmuch)
} }
UInt
Yap_InsertInGlobal(CELL *where, UInt howmuch)
{
if ((howmuch = static_growglobal(howmuch, NULL, where)) == 0)
return 0;
#ifdef TABLING
fix_tabling_info();
#endif /* TABLING */
return howmuch;
}
int int
Yap_growstack(long size) Yap_growstack(long size)
{ {

7
C/init.c
View File

@ -528,7 +528,9 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags)
p_code->opc = Yap_opcode(_call_cpred); p_code->opc = Yap_opcode(_call_cpred);
p_code->u.sla.bmap = NULL; p_code->u.sla.bmap = NULL;
p_code->u.sla.s = -Signed(RealEnvSize); p_code->u.sla.s = -Signed(RealEnvSize);
p_code->u.sla.sla_u.p = pe; p_code->u.sla.sla_u.p =
p_code->u.sla.p0 =
pe;
p_code = NEXTOP(p_code,sla); p_code = NEXTOP(p_code,sla);
if (!(flags & SafePredFlag)) { if (!(flags & SafePredFlag)) {
p_code->opc = Yap_opcode(_deallocate); p_code->opc = Yap_opcode(_deallocate);
@ -628,7 +630,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred); p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred);
p_code->u.sla.bmap = NULL; p_code->u.sla.bmap = NULL;
p_code->u.sla.s = -Signed(RealEnvSize); p_code->u.sla.s = -Signed(RealEnvSize);
p_code->u.sla.sla_u.p = pe; p_code->u.sla.sla_u.p = p_code->u.sla.p0 = pe;
p_code = NEXTOP(p_code,sla); p_code = NEXTOP(p_code,sla);
p_code->opc = Yap_opcode(_procceed); p_code->opc = Yap_opcode(_procceed);
p_code->u.p.p = pe; p_code->u.p.p = pe;
@ -837,7 +839,6 @@ InitFlags(void)
yap_flags[YAP_TO_CHARS_FLAG] = QUINTUS_TO_CHARS; yap_flags[YAP_TO_CHARS_FLAG] = QUINTUS_TO_CHARS;
yap_flags[LANGUAGE_MODE_FLAG] = 0; yap_flags[LANGUAGE_MODE_FLAG] = 0;
yap_flags[STRICT_ISO_FLAG] = FALSE; yap_flags[STRICT_ISO_FLAG] = FALSE;
yap_flags[SPY_CREEP_FLAG] = 0;
yap_flags[SOURCE_MODE_FLAG] = FALSE; yap_flags[SOURCE_MODE_FLAG] = FALSE;
yap_flags[CHARACTER_ESCAPE_FLAG] = SICSTUS_CHARACTER_ESCAPES; yap_flags[CHARACTER_ESCAPE_FLAG] = SICSTUS_CHARACTER_ESCAPES;
yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE; yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE;

141
C/iopreds.c
View File

@ -83,8 +83,10 @@ static char SccsId[] = "%W% %G%";
STATIC_PROTO (Int PlIOError, (yap_error_number, Term, char *)); STATIC_PROTO (Int PlIOError, (yap_error_number, Term, char *));
STATIC_PROTO (int FilePutc, (int, int)); STATIC_PROTO (int FilePutc, (int, int));
STATIC_PROTO (int MemPutc, (int, int)); STATIC_PROTO (int MemPutc, (int, int));
STATIC_PROTO (int console_post_process_read_char, (int, StreamDesc *)); STATIC_PROTO (int console_post_process_read_char, (wchar_t, StreamDesc *));
STATIC_PROTO (int console_post_process_eof, (StreamDesc *));
STATIC_PROTO (int post_process_read_char, (int, StreamDesc *)); STATIC_PROTO (int post_process_read_char, (int, StreamDesc *));
STATIC_PROTO (int post_process_eof, (StreamDesc *));
#if USE_SOCKET #if USE_SOCKET
STATIC_PROTO (int SocketPutc, (int, int)); STATIC_PROTO (int SocketPutc, (int, int));
STATIC_PROTO (int ConsoleSocketPutc, (int, int)); STATIC_PROTO (int ConsoleSocketPutc, (int, int));
@ -999,7 +1001,7 @@ static int
ReadlineGetc(int sno) ReadlineGetc(int sno)
{ {
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
register int ch; register wchar_t ch;
while (ttyptr == NULL) { while (ttyptr == NULL) {
/* Only sends a newline if we are at the start of a line */ /* Only sends a newline if we are at the start of a line */
@ -1042,7 +1044,7 @@ ReadlineGetc(int sno)
if (Yap_PrologMode & AbortMode) { if (Yap_PrologMode & AbortMode) {
Yap_Error(PURE_ABORT, TermNil, ""); Yap_Error(PURE_ABORT, TermNil, "");
Yap_ErrorMessage = "Abort"; Yap_ErrorMessage = "Abort";
return(console_post_process_read_char(EOF, s)); return console_post_process_eof(s);
} }
continue; continue;
} else { } else {
@ -1052,7 +1054,7 @@ ReadlineGetc(int sno)
strncpy (Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT); strncpy (Prompt, RepAtom (*AtPrompt)->StrOfAE, MAX_PROMPT);
/* window of vulnerability closed */ /* window of vulnerability closed */
if (myrl_line == NULL) if (myrl_line == NULL)
return(console_post_process_read_char(EOF, s)); return console_post_process_eof(s);
if (myrl_line[0] != '\0' && myrl_line[1] != '\0') if (myrl_line[0] != '\0' && myrl_line[1] != '\0')
add_history (myrl_line); add_history (myrl_line);
ttyptr = myrl_line; ttyptr = myrl_line;
@ -1064,7 +1066,7 @@ ReadlineGetc(int sno)
ch = *((unsigned char *)ttyptr); ch = *((unsigned char *)ttyptr);
ttyptr++; ttyptr++;
} }
return(console_post_process_read_char(ch, s)); return console_post_process_read_char(ch, s);
} }
#endif /* HAVE_LIBREADLINE */ #endif /* HAVE_LIBREADLINE */
@ -1073,7 +1075,7 @@ ReadlineGetc(int sno)
int int
Yap_GetCharForSIGINT(void) Yap_GetCharForSIGINT(void)
{ {
int ch; wchar_t ch;
#if HAVE_LIBREADLINE #if HAVE_LIBREADLINE
if ((Yap_PrologMode & ConsoleGetcMode) && myrl_line != (char *) NULL) { if ((Yap_PrologMode & ConsoleGetcMode) && myrl_line != (char *) NULL) {
ch = myrl_line[0]; ch = myrl_line[0];
@ -1175,54 +1177,62 @@ EOFGetc(int sno)
static int static int
post_process_read_char(int ch, StreamDesc *s) post_process_read_char(int ch, StreamDesc *s)
{ {
++s->charcount;
++s->linepos;
if (ch == '\n') { if (ch == '\n') {
++s->linecount; ++s->linecount;
++s->charcount;
s->linepos = 0; s->linepos = 0;
/* don't convert if the stream is binary */ /* don't convert if the stream is binary */
if (!(s->status & Binary_Stream_f)) if (!(s->status & Binary_Stream_f))
ch = 10; ch = 10;
} else if (ch == EOF) {
s->status |= Eof_Stream_f;
s->stream_getc = EOFGetc;
s->stream_wgetc = get_wchar;
if (CharConversionTable != NULL)
s->stream_wgetc_for_read = ISOWGetc;
else
s->stream_wgetc_for_read = s->stream_wgetc;
return EOFCHAR;
} else {
++s->charcount;
++s->linepos;
} }
return ch; return ch;
} }
/* check if we read a newline or an EOF */ /* check if we read a newline or an EOF */
static int static int
console_post_process_read_char(int ch, StreamDesc *s) post_process_eof(StreamDesc *s)
{
s->status |= Eof_Stream_f;
s->stream_getc = EOFGetc;
s->stream_wgetc = get_wchar;
if (CharConversionTable != NULL)
s->stream_wgetc_for_read = ISOWGetc;
else
s->stream_wgetc_for_read = s->stream_wgetc;
return EOFCHAR;
}
/* check if we read a newline or an EOF */
static int
console_post_process_read_char(wchar_t ch, StreamDesc *s)
{ {
if (ch == '\n') { if (ch == '\n') {
++s->linecount; ++s->linecount;
++s->charcount; ++s->charcount;
s->linepos = 0; s->linepos = 0;
newline = TRUE; newline = TRUE;
} else if (ch == EOF) {
s->status |= Eof_Stream_f;
s->stream_getc = EOFGetc;
s->stream_wgetc = get_wchar;
if (CharConversionTable != NULL)
s->stream_wgetc_for_read = ISOWGetc;
else
s->stream_wgetc_for_read = s->stream_wgetc;
newline = FALSE;
return (EOFCHAR);
} else { } else {
++s->charcount; ++s->charcount;
++s->linepos; ++s->linepos;
newline = FALSE; newline = FALSE;
} }
return(ch); return ch;
}
/* check if we read a newline or an EOF */
static int
console_post_process_eof(StreamDesc *s)
{
s->status |= Eof_Stream_f;
s->stream_getc = EOFGetc;
s->stream_wgetc = get_wchar;
if (CharConversionTable != NULL)
s->stream_wgetc_for_read = ISOWGetc;
else
s->stream_wgetc_for_read = s->stream_wgetc;
newline = FALSE;
return EOFCHAR;
} }
#if USE_SOCKET #if USE_SOCKET
@ -1234,7 +1244,7 @@ static int
SocketGetc(int sno) SocketGetc(int sno)
{ {
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
register int ch; register Int ch;
char c; char c;
int count; int count;
/* should be able to use a buffer */ /* should be able to use a buffer */
@ -1245,7 +1255,7 @@ SocketGetc(int sno)
#endif #endif
if (count == 0) { if (count == 0) {
s->u.socket.flags = closed_socket; s->u.socket.flags = closed_socket;
ch = EOF; return post_process_eof(s);
} else if (count > 0) { } else if (count > 0) {
ch = c; ch = c;
} else { } else {
@ -1256,9 +1266,9 @@ SocketGetc(int sno)
Yap_Error(SYSTEM_ERROR, TermNil, Yap_Error(SYSTEM_ERROR, TermNil,
"(socket_getc)"); "(socket_getc)");
#endif #endif
return EOF; return post_process_eof(s);
} }
return(post_process_read_char(ch, s)); return post_process_read_char(ch, s);
} }
/* /*
@ -1269,8 +1279,8 @@ static int
ConsoleSocketGetc(int sno) ConsoleSocketGetc(int sno)
{ {
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
register int ch; register wchar_t ch;
char c; Int c;
int count; int count;
/* send the prompt away */ /* send the prompt away */
@ -1292,14 +1302,14 @@ ConsoleSocketGetc(int sno)
#endif #endif
Yap_PrologMode &= ~ConsoleGetcMode; Yap_PrologMode &= ~ConsoleGetcMode;
if (count == 0) { if (count == 0) {
ch = EOF; return console_post_process_eof(s);
} else if (count > 0) { } else if (count > 0) {
ch = c; ch = c;
} else { } else {
Yap_Error(SYSTEM_ERROR, TermNil, "read"); Yap_Error(SYSTEM_ERROR, TermNil, "read");
return(EOF); return console_post_process_eof(s);
} }
return(console_post_process_read_char(ch, s)); return console_post_process_read_char(ch, s);
} }
#endif #endif
@ -1307,9 +1317,10 @@ static int
PipeGetc(int sno) PipeGetc(int sno)
{ {
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
register int ch; register Int ch;
char c; char c;
/* should be able to use a buffer */
/* should be able to use a buffer */
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
DWORD count; DWORD count;
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) { if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) {
@ -1321,14 +1332,14 @@ PipeGetc(int sno)
count = read(s->u.pipe.fd, &c, sizeof(char)); count = read(s->u.pipe.fd, &c, sizeof(char));
#endif #endif
if (count == 0) { if (count == 0) {
ch = EOF; return post_process_eof(s);
} else if (count > 0) { } else if (count > 0) {
ch = c; ch = c;
} else { } else {
Yap_Error(SYSTEM_ERROR, TermNil, "read"); Yap_Error(SYSTEM_ERROR, TermNil, "read");
return(EOF); return post_process_eof(s);
} }
return(post_process_read_char(ch, s)); return post_process_read_char(ch, s);
} }
/* /*
@ -1339,7 +1350,7 @@ static int
ConsolePipeGetc(int sno) ConsolePipeGetc(int sno)
{ {
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
register int ch; register wchar_t ch;
char c; char c;
#if _MSC_VER || defined(__MINGW32__) #if _MSC_VER || defined(__MINGW32__)
DWORD count; DWORD count;
@ -1362,7 +1373,7 @@ ConsolePipeGetc(int sno)
Yap_PrologMode |= ConsoleGetcMode; Yap_PrologMode |= ConsoleGetcMode;
PlIOError (SYSTEM_ERROR,TermNil, "read from pipe returned error"); PlIOError (SYSTEM_ERROR,TermNil, "read from pipe returned error");
Yap_PrologMode &= ~ConsoleGetcMode; Yap_PrologMode &= ~ConsoleGetcMode;
return(EOF); return console_post_process_eof(s);
} }
#else #else
/* should be able to use a buffer */ /* should be able to use a buffer */
@ -1371,14 +1382,14 @@ ConsolePipeGetc(int sno)
Yap_PrologMode &= ~ConsoleGetcMode; Yap_PrologMode &= ~ConsoleGetcMode;
#endif #endif
if (count == 0) { if (count == 0) {
ch = EOF; return console_post_process_eof(s);
} else if (count > 0) { } else if (count > 0) {
ch = c; ch = c;
} else { } else {
Yap_Error(SYSTEM_ERROR, TermNil, "read"); Yap_Error(SYSTEM_ERROR, TermNil, "read");
return(EOF); return console_post_process_eof(s);
} }
return(console_post_process_read_char(ch, s)); return console_post_process_read_char(ch, s);
} }
/* standard routine, it should read from anything pointed by a FILE *. /* standard routine, it should read from anything pointed by a FILE *.
@ -1388,10 +1399,12 @@ static int
PlGetc (int sno) PlGetc (int sno)
{ {
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
register int ch; register Int ch;
ch = YP_getc (s->u.file.file); ch = YP_getc (s->u.file.file);
return(post_process_read_char(ch, s)); if (ch == EOF)
return post_process_eof(s);
return post_process_read_char(ch, s);
} }
/* standard routine, it should read from anything pointed by a FILE *. /* standard routine, it should read from anything pointed by a FILE *.
@ -1403,8 +1416,9 @@ PlGets (int sno, UInt size, char *buf)
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
UInt len; UInt len;
if (fgets (buf, size, s->u.file.file) == NULL) if (fgets (buf, size, s->u.file.file) == NULL) {
return -1; return post_process_eof(s);
}
len = strlen(buf); len = strlen(buf);
s->charcount += len-1; s->charcount += len-1;
post_process_read_char(buf[len-2], s); post_process_read_char(buf[len-2], s);
@ -1418,7 +1432,7 @@ static int
DefaultGets (int sno, UInt size, char *buf) DefaultGets (int sno, UInt size, char *buf)
{ {
StreamDesc *s = &Stream[sno]; StreamDesc *s = &Stream[sno];
int ch; char ch;
char *pt = buf; char *pt = buf;
@ -1435,23 +1449,24 @@ static int
MemGetc (int sno) MemGetc (int sno)
{ {
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
Int ch, spos; Int ch;
int spos;
spos = s->u.mem_string.pos; spos = s->u.mem_string.pos;
if (spos == s->u.mem_string.max_size) { if (spos == s->u.mem_string.max_size) {
ch = -1; return post_process_eof(s);
} else { } else {
ch = s->u.mem_string.buf[spos]; ch = s->u.mem_string.buf[spos];
s->u.mem_string.pos = ++spos; s->u.mem_string.pos = ++spos;
} }
return(post_process_read_char(ch, s)); return post_process_read_char(ch, s);
} }
/* I dispise this code!!!!! */ /* I dispise this code!!!!! */
static wchar_t static wchar_t
ISOWGetc (int sno) ISOWGetc (int sno)
{ {
wchar_t ch = Stream[sno].stream_wgetc(sno); Int ch = Stream[sno].stream_wgetc(sno);
if (ch != EOF && CharConversionTable != NULL) { if (ch != EOF && CharConversionTable != NULL) {
if (ch < NUMBER_OF_CHARS) { if (ch < NUMBER_OF_CHARS) {
@ -1468,7 +1483,7 @@ static int
ConsoleGetc(int sno) ConsoleGetc(int sno)
{ {
register StreamDesc *s = &Stream[sno]; register StreamDesc *s = &Stream[sno];
char ch; int ch;
restart: restart:
if (newline) { if (newline) {
@ -1497,13 +1512,15 @@ ConsoleGetc(int sno)
if (Yap_PrologMode & AbortMode) { if (Yap_PrologMode & AbortMode) {
Yap_Error(PURE_ABORT, TermNil, ""); Yap_Error(PURE_ABORT, TermNil, "");
Yap_ErrorMessage = "Abort"; Yap_ErrorMessage = "Abort";
return(console_post_process_read_char(EOF, s)); return console_post_process_eof(s);
} }
goto restart; goto restart;
} else { } else {
Yap_PrologMode &= ~ConsoleGetcMode; Yap_PrologMode &= ~ConsoleGetcMode;
} }
return(console_post_process_read_char(ch, s)); if (ch == EOF)
return console_post_process_eof(s);
return console_post_process_read_char(ch, s);
} }
/* reads a character from a buffer and does the rest */ /* reads a character from a buffer and does the rest */

4
C/scanner.c
View File

@ -983,7 +983,7 @@ Yap_tokenizer(int inp_stream)
Yap_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)"; Yap_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)";
break; break;
} }
if (ch >= 0xff){ if (ch > MAX_ISO_LATIN1){
/* does not fit in ISO-LATIN */ /* does not fit in ISO-LATIN */
wcharp = ch_to_wide(TokImage, charp); wcharp = ch_to_wide(TokImage, charp);
} }
@ -1007,7 +1007,7 @@ Yap_tokenizer(int inp_stream)
*wcharp++ = read_quoted_char(&scan_next, inp_stream, QuotedNxtch); *wcharp++ = read_quoted_char(&scan_next, inp_stream, QuotedNxtch);
else { else {
wchar_t next = read_quoted_char(&scan_next, inp_stream, QuotedNxtch); wchar_t next = read_quoted_char(&scan_next, inp_stream, QuotedNxtch);
if (next >= 0xff){ if (next > MAX_ISO_LATIN1){
/* does not fit in ISO-LATIN */ /* does not fit in ISO-LATIN */
wcharp = ch_to_wide(TokImage, charp); wcharp = ch_to_wide(TokImage, charp);
*wcharp++ = next; *wcharp++ = next;

70
C/stdpreds.c
View File

@ -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: 2006-11-28 13:46:41 $,$Author: vsc $ * * Last rev: $Date: 2006-12-13 16:10:23 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.115 2006/11/28 13:46:41 vsc
* fix wide_char support for name/2.
*
* Revision 1.114 2006/11/27 17:42:03 vsc * Revision 1.114 2006/11/27 17:42:03 vsc
* support for UNICODE, and other bug fixes. * support for UNICODE, and other bug fixes.
* *
@ -441,7 +444,6 @@ p_creep(void)
at = Yap_FullLookupAtom("$creep"); at = Yap_FullLookupAtom("$creep");
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred; CreepCode = pred;
yap_flags[SPY_CREEP_FLAG] = TRUE;
do_signal(YAP_CREEP_SIGNAL); do_signal(YAP_CREEP_SIGNAL);
return TRUE; return TRUE;
} }
@ -455,7 +457,6 @@ p_delayed_creep(void)
at = Yap_FullLookupAtom("$creep"); at = Yap_FullLookupAtom("$creep");
pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0)); pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
CreepCode = pred; CreepCode = pred;
yap_flags[SPY_CREEP_FLAG] = FALSE;
do_signal(YAP_CREEP_SIGNAL); do_signal(YAP_CREEP_SIGNAL);
LOCK(SignalLock); LOCK(SignalLock);
CreepFlag = CalculateStackGap(); CreepFlag = CalculateStackGap();
@ -754,28 +755,52 @@ p_char_code(void)
return(FALSE); return(FALSE);
} else { } else {
Int code = IntegerOfTerm(t1); Int code = IntegerOfTerm(t1);
char codes[2];
Term tout; Term tout;
if (code < 0 || code > 256) { if (code < 0) {
Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,t1,"char_code/2"); Yap_Error(REPRESENTATION_ERROR_CHARACTER_CODE,t1,"char_code/2");
return(FALSE); return(FALSE);
} }
codes[0] = code; if (code > MAX_ISO_LATIN1) {
codes[1] = '\0'; wchar_t wcodes[2];
tout = MkAtomTerm(Yap_LookupAtom(codes));
return(Yap_unify(ARG1,tout)); wcodes[0] = code;
wcodes[1] = '\0';
tout = MkAtomTerm(Yap_LookupWideAtom(wcodes));
} else {
char codes[2];
codes[0] = code;
codes[1] = '\0';
tout = MkAtomTerm(Yap_LookupAtom(codes));
}
return Yap_unify(ARG1,tout);
} }
} else if (!IsAtomTerm(t0)) { } else if (!IsAtomTerm(t0)) {
Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2"); Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2");
return(FALSE); return(FALSE);
} else { } else {
char *c = RepAtom(AtomOfTerm(t0))->StrOfAE; Atom at = AtomOfTerm(t0);
if (c[1] != '\0') { Term tf;
Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2");
return(FALSE); if (IsWideAtom(at)) {
wchar_t *c = RepAtom(at)->WStrOfAE;
if (c[1] != '\0') {
Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2");
return FALSE;
}
tf = MkIntegerTerm(c[0]);
} else {
char *c = RepAtom(at)->StrOfAE;
if (c[1] != '\0') {
Yap_Error(TYPE_ERROR_CHARACTER,t0,"char_code/2");
return FALSE;
}
tf = MkIntTerm((unsigned char)(c[0]));
} }
return(Yap_unify(ARG2,MkIntTerm((Int)(c[0])))); return Yap_unify(ARG2,tf);
} }
} }
@ -3309,11 +3334,6 @@ p_set_yap_flags(void)
return(FALSE); return(FALSE);
yap_flags[STRICT_ISO_FLAG] = value; yap_flags[STRICT_ISO_FLAG] = value;
break; break;
case SPY_CREEP_FLAG:
if (value != 0 && value != 1)
return(FALSE);
yap_flags[SPY_CREEP_FLAG] = value;
break;
case SOURCE_MODE_FLAG: case SOURCE_MODE_FLAG:
if (value != 0 && value != 1) if (value != 0 && value != 1)
return(FALSE); return(FALSE);
@ -3403,6 +3423,17 @@ p_set_yap_flags(void)
return(TRUE); return(TRUE);
} }
static Int
p_system_mode(void)
{
Int i = IntegerOfTerm(Deref(ARG1));
if (i == 0)
Yap_PrologMode &= ~SystemMode;
else
Yap_PrologMode |= SystemMode;
return TRUE;
}
static Int static Int
p_lock_system(void) p_lock_system(void)
{ {
@ -3631,6 +3662,7 @@ Yap_InitCPreds(void)
Yap_InitCPred("$walltime", 2, p_walltime, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$walltime", 2, p_walltime, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$p_system_mode", 1, p_system_mode, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("abort", 0, p_abort, SyncPredFlag); Yap_InitCPred("abort", 0, p_abort, SyncPredFlag);
Yap_InitCPred("$max_tagged_integer", 1, p_max_tagged_integer, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$max_tagged_integer", 1, p_max_tagged_integer, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$min_tagged_integer", 1, p_min_tagged_integer, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$min_tagged_integer", 1, p_min_tagged_integer, SafePredFlag|HiddenPredFlag);

2
C/unify.c
View File

@ -309,7 +309,7 @@ OCUnify_complex(register CELL *pt0, register CELL *pt0_end,
} }
} }
/* Do we still have compound terms to visit */ /* Do we still have compound terms to visit */
if (to_visit < to_visit_max) { if (to_visit < to_visit_base) {
pt0 = to_visit[0]; pt0 = to_visit[0];
pt0_end = to_visit[1]; pt0_end = to_visit[1];
pt1 = to_visit[2]; pt1 = to_visit[2];

11
CLPBN/clpbn.yap
View File

@ -3,7 +3,9 @@
:- module(clpbn, [{}/1, :- module(clpbn, [{}/1,
clpbn_flag/2, clpbn_flag/2,
set_clpbn_flag/2, set_clpbn_flag/2,
clpbn_flag/3]). clpbn_flag/3,
clpbn_key/2,
clpbn_marginalise/2]).
:- use_module(library(atts)). :- use_module(library(atts)).
:- use_module(library(lists)). :- use_module(library(lists)).
@ -111,6 +113,11 @@ add_evidence(V,NV) :-
clpbn:put_atts(NV,evidence(V)). clpbn:put_atts(NV,evidence(V)).
add_evidence(V,V). add_evidence(V,V).
clpbn_marginalise(V, Dist) :-
attributes:all_attvars(AVars),
project_attributes([V], AVars),
vel:get_atts(V, posterior(_,_,Dist,_)).
% %
% called by top-level % called by top-level
% or by call_residue/2 % or by call_residue/2
@ -244,3 +251,5 @@ user:term_expansion((A :- {}), ( :- true )) :- !, % evidence
prolog_load_context(module, M), prolog_load_context(module, M),
store_evidence(M:A). store_evidence(M:A).
clpbn_key(Var,Key) :-
get_atts(Var, [key(Key)]).

2
CLPBN/clpbn/evidence.yap
View File

@ -5,7 +5,7 @@
:- module(evidence, [ :- module(clpbn_evidence, [
store_evidence/1, store_evidence/1,
incorporate_evidence/2 incorporate_evidence/2
]). ]).

4
CLPBN/clpbn/examples/School/tables.yap
View File

@ -1,7 +1,9 @@
:- use_module(library('clpbn/aggregates'),[cpt_average/5]). :- use_module(library('clpbn/aggregates'),[cpt_average/5]).
int_table(_, [0.5, 0.4, 0.1],[h, m, l]). int_table(_, [0.5,
0.4,
0.1],[h, m, l]).
grade_table(I, D, grade_table(I, D,
/* h h h m h l m h m m m l l h l m l l */ /* h h h m h l m h m m m l l h l m l l */

11
H/Atoms.h
View File

@ -22,6 +22,8 @@
#define EXTERN #define EXTERN
#endif #endif
#include <wchar.h>
/********* operations for atoms ****************************************/ /********* operations for atoms ****************************************/
/* Atoms are assumed to be uniquely represented by an OFFSET and to have /* Atoms are assumed to be uniquely represented by an OFFSET and to have
@ -47,10 +49,17 @@ typedef struct AtomEntryStruct
rwlock_t ARWLock; rwlock_t ARWLock;
#endif #endif
char StrOfAE[MIN_ARRAY]; /* representation of atom as a string */ union {
char uStrOfAE[MIN_ARRAY]; /* representation of atom as a string */
wchar_t uWStrOfAE[MIN_ARRAY]; /* representation of atom as a string */
} rep;
} }
AtomEntry; AtomEntry;
#define StrOfAE rep.uStrOfAE
#define WStrOfAE rep.uWStrOfAE
/* Props and Atoms are stored in chains, ending with a NIL */ /* Props and Atoms are stored in chains, ending with a NIL */
#if USE_OFFSETS #if USE_OFFSETS
# define EndOfPAEntr(P) ( Addr(P) == AtomBase) # define EndOfPAEntr(P) ( Addr(P) == AtomBase)

6
H/Yap.h
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * comments: main header file for YAP *
* version: $Id: Yap.h,v 1.17 2006-11-27 17:42:03 vsc Exp $ * * version: $Id: Yap.h,v 1.18 2006-12-13 16:10:25 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -513,7 +513,6 @@ typedef enum
YAP_TO_CHARS_FLAG = 7, YAP_TO_CHARS_FLAG = 7,
LANGUAGE_MODE_FLAG = 8, LANGUAGE_MODE_FLAG = 8,
STRICT_ISO_FLAG = 9, STRICT_ISO_FLAG = 9,
SPY_CREEP_FLAG = 10,
SOURCE_MODE_FLAG = 11, SOURCE_MODE_FLAG = 11,
CHARACTER_ESCAPE_FLAG = 12, CHARACTER_ESCAPE_FLAG = 12,
WRITE_QUOTED_STRING_FLAG = 13, WRITE_QUOTED_STRING_FLAG = 13,
@ -1152,7 +1151,8 @@ typedef enum
CCallMode = 0x1000, /* In c Call */ CCallMode = 0x1000, /* In c Call */
UnifyMode = 0x2000, /* In Unify Code */ UnifyMode = 0x2000, /* In Unify Code */
UserCCallMode = 0x4000, /* In User C-call Code */ UserCCallMode = 0x4000, /* In User C-call Code */
MallocMode = 0x8000 /* Doing malloc, realloc, free */ MallocMode = 0x8000, /* Doing malloc, realloc, free */
SystemMode = 0x10000, /* in system mode */
} prolog_exec_mode; } prolog_exec_mode;
extern prolog_exec_mode Yap_PrologMode; extern prolog_exec_mode Yap_PrologMode;

4
H/Yapproto.h
View File

@ -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.76 2006-08-22 16:12:46 vsc Exp $ * * version: $Id: Yapproto.h,v 1.77 2006-12-13 16:10:25 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* prototype file for Yap */ /* prototype file for Yap */
@ -172,7 +172,7 @@ void STD_PROTO(Yap_InitGlobals,(void));
/* grow.c */ /* grow.c */
Int STD_PROTO(Yap_total_stack_shift_time,(void)); Int STD_PROTO(Yap_total_stack_shift_time,(void));
void STD_PROTO(Yap_InitGrowPreds, (void)); void STD_PROTO(Yap_InitGrowPreds, (void));
int STD_PROTO(Yap_InsertInGlobal, (CELL *, UInt)); UInt STD_PROTO(Yap_InsertInGlobal, (CELL *, UInt));
int STD_PROTO(Yap_growheap, (int, UInt, void *)); int STD_PROTO(Yap_growheap, (int, UInt, void *));
int STD_PROTO(Yap_growstack, (long)); int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long, int)); int STD_PROTO(Yap_growtrail, (long, int));

4
Makefile.in
View File

@ -528,6 +528,7 @@ all: startup
@INSTALL_DLLS@ (cd library/yap2swi; make) @INSTALL_DLLS@ (cd library/yap2swi; make)
@INSTALL_DLLS@ (cd library/Tries; make) @INSTALL_DLLS@ (cd library/Tries; make)
@INSTALL_DLLS@ (cd library/lammpi; make) @INSTALL_DLLS@ (cd library/lammpi; make)
@INSTALL_DLLS@ (cd library/matrix; make)
@ENABLE_JPL@ @INSTALL_DLLS@ (cd LGPL/JPL/src; make) @ENABLE_JPL@ @INSTALL_DLLS@ (cd LGPL/JPL/src; make)
startup: yap@EXEC_SUFFIX@ $(PL_SOURCES) startup: yap@EXEC_SUFFIX@ $(PL_SOURCES)
@ -564,6 +565,7 @@ install_unix: startup libYap.a
@INSTALL_DLLS@ (cd library/yap2swi; make install) @INSTALL_DLLS@ (cd library/yap2swi; make install)
@INSTALL_DLLS@ (cd library/Tries; make install) @INSTALL_DLLS@ (cd library/Tries; make install)
@INSTALL_DLLS@ (cd library/lammpi; make install) @INSTALL_DLLS@ (cd library/lammpi; make install)
@INSTALL_DLLS@ (cd library/matrix; make install)
@ENABLE_JPL@ @INSTALL_DLLS@ (cd LGPL/JPL/src; make install) @ENABLE_JPL@ @INSTALL_DLLS@ (cd LGPL/JPL/src; make install)
mkdir -p $(DESTDIR)$(INCLUDEDIR) mkdir -p $(DESTDIR)$(INCLUDEDIR)
for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done
@ -584,6 +586,7 @@ install_win32: startup
for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done for h in $(INTERFACE_HEADERS); do $(INSTALL) $$h $(DESTDIR)$(INCLUDEDIR); done
$(INSTALL) config.h $(INCLUDEDIR)/config.h $(INSTALL) config.h $(INCLUDEDIR)/config.h
(cd library/random; make install) (cd library/random; make install)
(cd library/matrix; make install)
(cd library/regex; make install) (cd library/regex; make install)
(cd library/system; make install) (cd library/system; make install)
(cd library/yap2swi; make install) (cd library/yap2swi; make install)
@ -621,6 +624,7 @@ depend: $(HEADERS) $(C_SOURCES)
clean: clean_docs clean: clean_docs
rm -f *.o *~ *.BAK *.a rm -f *.o *~ *.BAK *.a
@INSTALL_DLLS@ (cd library/matrix; make clean)
@INSTALL_DLLS@ (cd library/random; make clean) @INSTALL_DLLS@ (cd library/random; make clean)
@INSTALL_DLLS@ (cd library/regex; make clean) @INSTALL_DLLS@ (cd library/regex; make clean)
@INSTALL_DLLS@ (cd library/system; make clean) @INSTALL_DLLS@ (cd library/system; make clean)

4
changes-5.1.html
View File

@ -16,6 +16,10 @@
<h2>Yap-5.1.2:</h2> <h2>Yap-5.1.2:</h2>
<ul> <ul>
<li> NEW: keep history around (use nb and friends).</li>
<li> NEW: fix determinsitic debugging.</li>
<li> NEW: make debugger compatible with threads (use nb and friends).</li>
<li> FIXED: debugger was confused when crossing between regions.</li>
<li> NEW: unify_with_occurs_check was very broken (obs from Aline Paes).</li> <li> NEW: unify_with_occurs_check was very broken (obs from Aline Paes).</li>
<li> NEW: partial support for UNICODE.</li> <li> NEW: partial support for UNICODE.</li>
<li> FIXED: &yuml; has ISO-LATIN1 code 255, so it would be confused with EOF <li> FIXED: &yuml; has ISO-LATIN1 code 255, so it would be confused with EOF

6
configure vendored
View File

@ -15428,7 +15428,7 @@ _ACEOF
fi fi
mkdir -p library/matrices mkdir -p library/matrix
mkdir -p library/mpi mkdir -p library/mpi
mkdir -p library/random mkdir -p library/random
mkdir -p library/regex mkdir -p library/regex
@ -15449,7 +15449,7 @@ mkdir -p LGPL/clp
mkdir -p LGPL/clpr mkdir -p LGPL/clpr
mkdir -p LGPL/chr mkdir -p LGPL/chr
ac_config_files="$ac_config_files Makefile library/matrices/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/lammpi/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap" ac_config_files="$ac_config_files Makefile library/matrix/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/lammpi/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap"
cat >confcache <<\_ACEOF cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure # This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure # tests run on this system so they can be shared between configure
@ -15976,7 +15976,7 @@ do
case "$ac_config_target" in case "$ac_config_target" in
# Handling of arguments. # Handling of arguments.
"Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
"library/matrices/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/matrices/Makefile" ;; "library/matrix/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/matrix/Makefile" ;;
"library/regex/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/regex/Makefile" ;; "library/regex/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/regex/Makefile" ;;
"library/system/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/system/Makefile" ;; "library/system/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/system/Makefile" ;;
"library/random/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/random/Makefile" ;; "library/random/Makefile" ) CONFIG_FILES="$CONFIG_FILES library/random/Makefile" ;;

4
configure.in
View File

@ -1278,7 +1278,7 @@ AC_DEFINE(GC_NO_TAGS,1)
AC_DEFINE(USE_DL_MALLOC,1) AC_DEFINE(USE_DL_MALLOC,1)
fi fi
mkdir -p library/matrices mkdir -p library/matrix
mkdir -p library/mpi mkdir -p library/mpi
mkdir -p library/random mkdir -p library/random
mkdir -p library/regex mkdir -p library/regex
@ -1299,7 +1299,7 @@ mkdir -p LGPL/clp
mkdir -p LGPL/clpr mkdir -p LGPL/clpr
mkdir -p LGPL/chr mkdir -p LGPL/chr
AC_OUTPUT(Makefile library/matrices/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/lammpi/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap) AC_OUTPUT(Makefile library/matrix/Makefile library/regex/Makefile library/system/Makefile library/random/Makefile library/yap2swi/Makefile library/mpi/Makefile .depend library/Makefile LGPL/chr/Makefile LGPL/chr/chr_swi_bootstrap.yap CLPBN/Makefile LGPL/clp/Makefile LGPL/clpr/Makefile library/lammpi/Makefile library/Tries/Makefile LGPL/JPL/Makefile LGPL/JPL/src/Makefile LGPL/JPL/java/Makefile LGPL/JPL/jpl_paths.yap)
make depend make depend

11
include/YapInterface.h
View File

@ -151,6 +151,9 @@ extern X_API YAP_Term PROTO(YAP_HeadOfTerm,(YAP_Term));
/* Term TailOfTerm(Term) */ /* Term TailOfTerm(Term) */
extern X_API YAP_Term PROTO(YAP_TailOfTerm,(YAP_Term)); extern X_API YAP_Term PROTO(YAP_TailOfTerm,(YAP_Term));
/* Term TailOfTerm(Term) */
extern X_API YAP_Term PROTO(YAP_TermNil,(void));
/* YAP_Term MkApplTerm(YAP_Functor f, unsigned int n, YAP_Term[] args) */ /* YAP_Term MkApplTerm(YAP_Functor f, unsigned int n, YAP_Term[] args) */
extern X_API YAP_Term PROTO(YAP_MkApplTerm,(YAP_Functor,unsigned int,YAP_Term *)); extern X_API YAP_Term PROTO(YAP_MkApplTerm,(YAP_Functor,unsigned int,YAP_Term *));
@ -366,11 +369,9 @@ extern X_API int PROTO(YAP_ThreadAttachEngine,(int));
extern X_API int PROTO(YAP_ThreadDetachEngine,(int)); extern X_API int PROTO(YAP_ThreadDetachEngine,(int));
extern X_API int PROTO(YAP_ThreadDestroyEngine,(int)); extern X_API int PROTO(YAP_ThreadDestroyEngine,(int));
/* matrices stuff */ /* blob stuff */
extern X_API int PROTO(YAP_ArgsToIntArray,(YAP_Term, YAP_UInt, const YAP_Int *)); extern X_API YAP_Term PROTO(YAP_MkBlobTerm,(unsigned int));
extern X_API YAP_Term PROTO(YAP_IntArrayToArgs,(YAP_UInt, const YAP_Int *)); extern X_API void *PROTO(YAP_BlobOfTerm,(YAP_Term));
extern X_API int PROTO(YAP_ArgsToFloatArray,(YAP_Term, YAP_UInt, const YAP_Float *));
extern X_API YAP_Term PROTO(YAP_FloatArrayToArgs,(YAP_UInt, const YAP_Float *));
/* term comparison */ /* term comparison */
extern X_API int PROTO(YAP_CompareTerms,(YAP_Term, YAP_Term)); extern X_API int PROTO(YAP_CompareTerms,(YAP_Term, YAP_Term));

2
library/Makefile.in
View File

@ -37,9 +37,9 @@ PROGRAMS= $(srcdir)/apply_macros.yap \
$(srcdir)/listing.yap \ $(srcdir)/listing.yap \
$(srcdir)/lists.yap \ $(srcdir)/lists.yap \
$(srcdir)/logtalk.yap \ $(srcdir)/logtalk.yap \
$(srcdir)/matrices.yap \
$(srcdir)/nb.yap \ $(srcdir)/nb.yap \
$(srcdir)/ordsets.yap \ $(srcdir)/ordsets.yap \
$(srcdir)/matrix.yap \
$(srcdir)/prandom.yap \ $(srcdir)/prandom.yap \
$(srcdir)/queues.yap \ $(srcdir)/queues.yap \
$(srcdir)/random.yap \ $(srcdir)/random.yap \

2
library/swi.yap
View File

@ -149,7 +149,7 @@ cvt_to_swi_atts(att(Mod,Attribute,Atts), ModAttribute) :-
bindings_message(V) --> bindings_message(V) -->
{ cvt_bindings(V, Bindings) }, { cvt_bindings(V, Bindings) },
prolog:message(query(YesNo,Bindings)), !. prolog:message(query(_YesNo,Bindings)), !.
cvt_bindings([],[]). cvt_bindings([],[]).
cvt_bindings([[Name|Value]|L],[AName=Value|Bindings]) :- cvt_bindings([[Name|Value]|L],[AName=Value|Bindings]) :-

7
misc/yap.def
View File

@ -92,7 +92,6 @@ YAP_ThreadAttachEngine
YAP_ThreadDetachEngine YAP_ThreadDetachEngine
YAP_ThreadDestroyEngine YAP_ThreadDestroyEngine
YAP_CompareTerms YAP_CompareTerms
YAP_ArgsToIntArray YAP_MkBlobTerm
YAP_IntArrayToArgs YAP_BlobOfTerm
YAP_ArgsToFloatArray YAP_TermNil
YAP_FloatArrayToArgs

179
pl/boot.yap
View File

@ -45,43 +45,38 @@ true :- true.
; ;
true true
), ),
'$set_yap_flags'(10,0),
'$allocate_default_arena'(1024, 64), '$allocate_default_arena'(1024, 64),
'$enter_system_mode',
set_value(fileerrors,1), set_value(fileerrors,1),
set_value('$gc',on), set_value('$gc',on),
set_value('$lf_verbose',informational), set_value('$lf_verbose',informational),
('$exit_undefp' -> true ; true), ('$exit_undefp' -> true ; true),
prompt(' ?- '), prompt(' ?- '),
get_value('$break',BreakLevel), nb_setval('$break',0),
% '$set_read_error_handler'(error), let the user do that
nb_setval('$debug',off),
nb_setval('$trace',off),
b_setval('$spy_glist',[]),
% simple trick to find out if this is we are booting from Prolog.
get_value('$user_module',V),
( (
BreakLevel =:= 0 V == []
-> ->
% '$set_read_error_handler'(error), let the user do that '$current_module'(_,prolog)
% after an abort, make sure all spy points are gone. ;
'$clean_debugging_info', '$current_module'(_,V), '$compile_mode'(_,0),
% simple trick to find out if this is we are booting from Prolog. ('$access_yap_flags'(16,0) ->
get_value('$user_module',V), ( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ),
( V = [] -> ( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ),
'$current_module'(_,prolog) ( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true )
; ;
'$current_module'(_,V), '$compile_mode'(_,0), true
('$access_yap_flags'(16,0) -> )
( exists('~/.yaprc') -> load_files('~/.yaprc', []) ; true ), ),
( exists('~/.prologrc') -> load_files('~/.prologrc', []) ; true ), '$db_clean_queues'(0),
( exists('~/prolog.ini') -> load_files('~/prolog.ini', []) ; true ) '$startup_reconsult',
; '$startup_goals'.
true
)
),
'$db_clean_queues'(0),
'$startup_reconsult',
'$startup_goals'
;
'$print_message'(informational,break(BreakLevel))
).
%
% encapsulate $cut_by because of co-routining. % encapsulate $cut_by because of co-routining.
% %
'$cut_by'(X) :- '$$cut_by'(X). '$cut_by'(X) :- '$$cut_by'(X).
@ -120,14 +115,17 @@ true :- true.
'$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)), '$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)),
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
get_value('$break',BreakLevel), nb_getval('$break',BreakLevel),
( recorded('$trace',on,_) -> (
TraceDebug = trace nb_getval('$trace',on)
->
TraceDebug = trace
; ;
recorded('$debug', on, _) -> nb_getval('$debug', on)
TraceDebug = debug ->
TraceDebug = debug
; ;
true true
), ),
'$print_message'(informational,prompt(BreakLevel,TraceDebug)), '$print_message'(informational,prompt(BreakLevel,TraceDebug)),
fail. fail.
@ -141,9 +139,10 @@ true :- true.
prompt(' | '), prompt(' | '),
'$run_toplevel_hooks', '$run_toplevel_hooks',
'$read_vars'(user_input,Command,_,_,Varnames), '$read_vars'(user_input,Command,_,_,Varnames),
set_value(spy_gn,1), nb_setval('$spy_gn',1),
( recorded('$spy_skip',_,R), erase(R), fail ; true), % stop at spy-points if debugging is on.
( recorded('$spy_stop',_,R), erase(R), fail ; true), nb_setval('$debug_run',off),
nb_setval('$debug_zip',off),
prompt(_,' |: '), prompt(_,' |: '),
'$command'((?-Command),Varnames,top), '$command'((?-Command),Varnames,top),
'$sync_mmapped_arrays', '$sync_mmapped_arrays',
@ -209,15 +208,6 @@ true :- true.
%
% remove any debugging info after an abort.
%
'$clean_debugging_info' :-
recorded('$spy',_,R),
erase(R),
fail.
'$clean_debugging_info'.
'$erase_sets' :- '$erase_sets' :-
eraseall('$'), eraseall('$'),
eraseall('$$set'), eraseall('$$set'),
@ -342,8 +332,7 @@ true :- true.
% but YAP and SICStus does. % but YAP and SICStus does.
% %
'$process_directive'(G, _, M) :- '$process_directive'(G, _, M) :-
( '$do_yes_no'(G,M) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ), ( '$do_yes_no'(G,M) -> true ; format(user_error,':- ~w:~w failed.~n',[M,G]) ).
'$do_not_creep'.
'$continue_with_command'(reconsult,V,G,Source) :- '$continue_with_command'(reconsult,V,G,Source) :-
'$go_compile_clause'(G,V,5,Source), '$go_compile_clause'(G,V,5,Source),
@ -352,8 +341,7 @@ true :- true.
'$go_compile_clause'(G,V,13,Source), '$go_compile_clause'(G,V,13,Source),
fail. fail.
'$continue_with_command'(top,V,G,_) :- '$continue_with_command'(top,V,G,_) :-
'$query'(G,V), '$query'(G,V).
'$do_not_creep'.
% %
% not 100% compatible with SICStus Prolog, as SICStus Prolog would put % not 100% compatible with SICStus Prolog, as SICStus Prolog would put
@ -428,27 +416,22 @@ true :- true.
'$yes_no'(G,(?-)). '$yes_no'(G,(?-)).
'$query'(G,V) :- '$query'(G,V) :-
( (
( recorded('$trace',on,_) -> '$creep' ; true), '$exit_system_mode',
'$execute'(G), '$execute'(G),
'$do_not_creep', ( '$enter_system_mode' ; '$exit_system_mode', fail),
'$output_frozen'(G, V, LGs), '$output_frozen'(G, V, LGs),
'$write_answer'(V, LGs, Written), '$write_answer'(V, LGs, Written),
'$write_query_answer_true'(Written), '$write_query_answer_true'(Written),
'$another', '$another',
!, fail ; !, fail
'$do_not_creep', ;
( '$undefined'('$print_message'(_,_),prolog) -> '$enter_system_mode',
'$present_answer'(user_error,"no~n", []) '$out_neg_answer'
;
print_message(help,no)
),
fail
). ).
'$yes_no'(G,C) :- '$yes_no'(G,C) :-
'$current_module'(M), '$current_module'(M),
'$do_yes_no'(G,M), '$do_yes_no'(G,M),
'$do_not_creep',
'$output_frozen'(G, [], LGs), '$output_frozen'(G, [], LGs),
'$write_answer'([], LGs, Written), '$write_answer'([], LGs, Written),
( Written = [] -> ( Written = [] ->
@ -457,7 +440,11 @@ true :- true.
), ),
fail. fail.
'$yes_no'(_,_) :- '$yes_no'(_,_) :-
'$do_not_creep', '$out_neg_answer'.
'$add_env_and_fail' :- fail.
'$out_neg_answer' :-
( '$undefined'('$print_message'(_,_),prolog) -> ( '$undefined'('$print_message'(_,_),prolog) ->
'$present_answer'(user_error,"no~n", []) '$present_answer'(user_error,"no~n", [])
; ;
@ -467,8 +454,9 @@ true :- true.
'$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M). '$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M).
'$do_yes_no'(G, M) :- '$do_yes_no'(G, M) :-
( recorded('$trace',on,_) -> '$creep' ; true), '$exit_system_mode',
'$execute'(M:G). '$execute'(M:G),
( '$enter_system_mode' ; '$exit_system_mode', fail ).
'$write_query_answer_true'([]) :- !, '$write_query_answer_true'([]) :- !,
format(user_error,'~ntrue',[]). format(user_error,'~ntrue',[]).
@ -494,7 +482,7 @@ true :- true.
'$flush_all_streams', '$flush_all_streams',
fail. fail.
'$present_answer'((?-), Answ) :- '$present_answer'((?-), Answ) :-
get_value('$break',BL), nb_getval('$break',BL),
( BL \= 0 -> format(user_error, '[~p] ',[BL]) ; ( BL \= 0 -> format(user_error, '[~p] ',[BL]) ;
true ), true ),
( recorded('$print_options','$toplevel'(Opts),_) -> ( recorded('$print_options','$toplevel'(Opts),_) ->
@ -827,29 +815,26 @@ not(G) :- \+ '$execute'(G).
debugger state */ debugger state */
break :- break :-
( recorded('$trace',Val,R) -> Trace = Val, erase(R); true), nb_getval('$trace',Trace),
( recorded('$debug',Val,R1) -> Debug = Val, erase(R1); true), nb_setval('$trace',off),
get_value('$break',BL), NBL is BL+1, nb_getval('$debug',Debug),
get_value(spy_gn,SPY_GN), nb_setval('$debug',off),
'$access_yap_flags'(10,SPY_CREEP), nb_getval('$break',BL), NBL is BL+1,
get_value(spy_cl,SPY_CL), nb_getval('$spy_gn',SPY_GN),
get_value(spy_leap,Leap), b_getval('$spy_glist',GList),
set_value('$break',NBL), b_setval('$spy_glist',[]),
nb_setval('$break',NBL),
current_output(OutStream), current_input(InpStream), current_output(OutStream), current_input(InpStream),
format(user_error, '% Break (level ~w)~n', [NBL]), format(user_error, '% Break (level ~w)~n', [NBL]),
'$do_live', '$do_live',
!, !,
set_value('$live','$true'), set_value('$live','$true'),
set_value(spy_gn,SPY_GN), b_setval('$spy_glist',GList),
'$set_yap_flags'(10,SPY_CREEP), nb_setval('$spy_gn',SPY_GN),
set_value(spy_cl,SPY_CL),
set_value(spy_leap,Leap),
'$set_input'(InpStream), '$set_output'(OutStream), '$set_input'(InpStream), '$set_output'(OutStream),
( recorded('$trace',_,R2), erase(R2), fail; true), nb_setval('$debug',Debug),
( recorded('$debug',_,R3), erase(R3), fail; true), nb_setval('$trace',Trace),
(nonvar(Trace) -> recorda('$trace',Trace,_); true), nb_setval('$break',BL).
(nonvar(Debug) -> recorda('$debug',Debug,_); true),
set_value('$break',BL).
'$silent_bootstrap'(F) :- '$silent_bootstrap'(F) :-
get_value('$lf_verbose',OldSilent), get_value('$lf_verbose',OldSilent),
@ -944,14 +929,14 @@ bootstrap(F) :-
'$find_in_path'(library(File),NewFile, _) :- '$find_in_path'(library(File),NewFile, _) :-
'$dir_separator'(D), '$dir_separator'(D),
atom_codes(A,[D]), atom_codes(A,[D]),
( user:library_directory(Dir), '$do_not_creep' ; '$do_not_creep', fail), user:library_directory(Dir),
'$extend_path'(Dir, A, File, NFile, Goal), '$extend_path'(Dir, A, File, NFile, Goal),
'$search_in_path'(NFile, NewFile), !. '$search_in_path'(NFile, NewFile), !.
'$find_in_path'(S,NewFile, _) :- '$find_in_path'(S,NewFile, _) :-
S =.. [Name,File], !, S =.. [Name,File], !,
'$dir_separator'(D), '$dir_separator'(D),
atom_codes(A,[D]), atom_codes(A,[D]),
( user:file_search_path(Name, Dir), '$do_not_creep' ; '$do_not_creep', fail), user:file_search_path(Name, Dir),
'$extend_path'(Dir, A, File, NFile, Goal), '$extend_path'(Dir, A, File, NFile, Goal),
'$search_in_path'(NFile, NewFile), !. '$search_in_path'(NFile, NewFile), !.
'$find_in_path'(File,NewFile,_) :- atom(File), !, '$find_in_path'(File,NewFile,_) :- atom(File), !,
@ -993,10 +978,8 @@ bootstrap(F) :-
expand_term(Term,Expanded) :- expand_term(Term,Expanded) :-
( \+ '$undefined'(term_expansion(_,_), user), ( \+ '$undefined'(term_expansion(_,_), user),
user:term_expansion(Term,Expanded), user:term_expansion(Term,Expanded)
'$do_not_creep'
; ;
'$do_not_creep',
'$expand_term_grammar'(Term,Expanded) '$expand_term_grammar'(Term,Expanded)
), ),
!. !.
@ -1079,9 +1062,15 @@ throw(Ball) :-
). ).
'$run_toplevel_hooks' :- '$run_toplevel_hooks' :-
get_value('$break',0), nb_getval('$break',0),
recorded('$toplevel_hooks',H,_), !, recorded('$toplevel_hooks',H,_), !,
( '$execute'(H) -> true ; true), ( '$execute'(H) -> true ; true).
'$do_not_creep'.
'$run_toplevel_hooks'. '$run_toplevel_hooks'.
'$enter_system_mode' :-
nb_setval('$system_mode',on).
'$exit_system_mode' :-
nb_setval('$system_mode',off),
( nb_getval('$trace',on) -> '$creep' ; true).

28
pl/consult.yap
View File

@ -122,7 +122,7 @@ load_files(Files,Opts) :-
'$lf'(user, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,SkipUnixComments,Reconsult,UseModule) :- !, '$lf'(user, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,SkipUnixComments,Reconsult,UseModule) :- !,
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,Reconsult,UseModule). '$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,Reconsult,UseModule).
'$lf'(user_input, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,SkipUnixComments,Reconsult,UseModule) :- !, '$lf'(user_input, Mod, Call,InfLevel,_,Changed,CompilationMode,Imports,_,_,SkipUnixComments,Reconsult,UseModule) :- !,
'$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,Reconsult,UseModule). '$do_lf'(user_input, Mod, user_input, InfLevel, CompilationMode,Imports,SkipUnixComments,Reconsult,UseModule).
'$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,Enc,SkipUnixComments,Reconsult,UseModule) :- '$lf'(X, Mod, Call, InfLevel,_,Changed,CompilationMode,Imports,_,Enc,SkipUnixComments,Reconsult,UseModule) :-
'$find_in_path'(X, Y, Call), '$find_in_path'(X, Y, Call),
'$open'(Y, '$csult', Stream, 0, Enc), !, '$open'(Y, '$csult', Stream, 0, Enc), !,
@ -184,6 +184,8 @@ use_module(F,Is) :-
use_module(M,F,Is) :- use_module(M,F,Is) :-
'$use_module'(M,F,Is). '$use_module'(M,F,Is).
'$use_module'(U,F,Is) :- nonvar(U), U = user, !,
'$import_to_current_module'(user_input, user, Is).
'$use_module'(M,F,Is) :- nonvar(M), !, '$use_module'(M,F,Is) :- nonvar(M), !,
recorded('$module','$module'(F1,M,_),_), recorded('$module','$module'(F1,M,_),_),
'$load_files'(F1, [if(not_loaded),imports(Is)], use_module(M,F,Is)), '$load_files'(F1, [if(not_loaded),imports(Is)], use_module(M,F,Is)),
@ -198,6 +200,8 @@ use_module(M,F,Is) :-
'$csult'([F|L], M) :- '$consult'(F, M), '$csult'(L, M). '$csult'([F|L], M) :- '$consult'(F, M), '$csult'(L, M).
'$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, SkipUnixComments, Reconsult, UseModule) :- '$do_lf'(F, ContextModule, Stream, InfLevel, _, Imports, SkipUnixComments, Reconsult, UseModule) :-
nb_getval('$system_mode', OldMode),
( OldMode == off -> '$enter_system_mode' ; true ),
'$record_loaded'(Stream, M), '$record_loaded'(Stream, M),
'$current_module'(OldModule,ContextModule), '$current_module'(OldModule,ContextModule),
getcwd(OldD), getcwd(OldD),
@ -223,7 +227,6 @@ use_module(M,F,Is) :-
EndMsg = consulted EndMsg = consulted
), ),
'$print_message'(InfLevel, loading(StartMsg, File)), '$print_message'(InfLevel, loading(StartMsg, File)),
( recorded('$trace', on, TraceR) -> erase(TraceR) ; true),
( SkipUnixComments == skip_unix_comments -> ( SkipUnixComments == skip_unix_comments ->
'$skip_unix_comments'(Stream) '$skip_unix_comments'(Stream)
; ;
@ -231,7 +234,6 @@ use_module(M,F,Is) :-
), ),
'$loop'(Stream,Reconsult), '$loop'(Stream,Reconsult),
'$end_consult', '$end_consult',
( nonvar(TraceR) -> recorda('$trace', on, _) ; true),
( (
Reconsult = reconsult -> Reconsult = reconsult ->
'$clear_reconsulting' '$clear_reconsulting'
@ -248,6 +250,7 @@ use_module(M,F,Is) :-
( LC == 0 -> prompt(_,' |: ') ; true), ( LC == 0 -> prompt(_,' |: ') ; true),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$print_message'(InfLevel, loaded(EndMsg, File, Mod, T, H)), '$print_message'(InfLevel, loaded(EndMsg, File, Mod, T, H)),
( OldMode == off -> '$exit_system_mode' ; true ),
'$exec_initialisation_goals', '$exec_initialisation_goals',
!. !.
@ -300,9 +303,17 @@ use_module(M,F,Is) :-
erase(R), erase(R),
G \= '$', G \= '$',
'$current_module'(M), '$current_module'(M),
'$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)), nb_getval('$system_mode', OldMode),
'$do_not_creep', ( OldMode == on -> '$exit_system_mode' ; true ),
fail. % run initialization under user control (so allow debugging this stuff).
(
'$system_catch'(once(M:G), M, Error, user:'$LoopError'(Error, top)),
fail
;
OldMode = on,
'$enter_system_mode',
fail
).
'$exec_initialisation_goals'. '$exec_initialisation_goals'.
'$include'(V, _) :- var(V), !, '$include'(V, _) :- var(V), !,
@ -333,8 +344,11 @@ use_module(M,F,Is) :-
'$system_catch'(load_files(X, []),Module,Error,'$Error'(Error)) '$system_catch'(load_files(X, []),Module,Error,'$Error'(Error))
; ;
set_value('$verbose',off), set_value('$verbose',off),
load_files(X, [silent(true),skip_unix_comments]) '$system_catch'(load_files(X, [silent(true),skip_unix_comments]),Module,_,fail)
;
true
), ),
!,
( '$access_yap_flags'(15, 0) -> true ; halt). ( '$access_yap_flags'(15, 0) -> true ; halt).
'$skip_unix_comments'(Stream) :- '$skip_unix_comments'(Stream) :-

4
pl/corout.yap
View File

@ -641,11 +641,9 @@ call_residue(Goal,Residue) :-
'$project_module'([Mod|LMods], LIV, LAV) :- '$project_module'([Mod|LMods], LIV, LAV) :-
\+ '$undefined'(project_attributes(LIV, LAV), Mod), \+ '$undefined'(project_attributes(LIV, LAV), Mod),
'$execute'(Mod:project_attributes(LIV, LAV)), !, '$execute'(Mod:project_attributes(LIV, LAV)), !,
'$do_not_creep',
attributes:all_attvars(NLAV), attributes:all_attvars(NLAV),
'$project_module'(LMods,LIV,NLAV). '$project_module'(LMods,LIV,NLAV).
'$project_module'([_|LMods], LIV, LAV) :- '$project_module'([_|LMods], LIV, LAV) :-
'$do_not_creep',
'$project_module'(LMods,LIV,LAV). '$project_module'(LMods,LIV,LAV).
@ -662,11 +660,9 @@ call_residue(Goal,Residue) :-
attributes:convert_att_var(V,G), attributes:convert_att_var(V,G),
G \= true, G \= true,
!, !,
'$do_not_creep',
'$split_goals_for_catv'(G,V,NGs,IGs), '$split_goals_for_catv'(G,V,NGs,IGs),
'$do_convert_att_vars'(LAV, LIV, IGs). '$do_convert_att_vars'(LAV, LIV, IGs).
'$do_convert_att_vars'([_|LAV], LIV, Gs) :- '$do_convert_att_vars'([_|LAV], LIV, Gs) :-
'$do_not_creep',
'$do_convert_att_vars'(LAV, LIV, Gs). '$do_convert_att_vars'(LAV, LIV, Gs).
'$split_goals_for_catv'((G,NG),V,[V-G|Gs],Gs0) :- !, '$split_goals_for_catv'((G,NG),V,[V-G|Gs],Gs0) :- !,

444
pl/debug.yap
View File

@ -135,36 +135,37 @@ nospyall.
% debug mode -> debug flag = 1 % debug mode -> debug flag = 1
debug :- recordaifnot('$debug',on,_), !, debug :-
'$start_debugging'(on),
'$print_message'(informational,debug(debug)). '$print_message'(informational,debug(debug)).
debug.
'$start_debugging'(Mode) :-
nb_setval('$debug',Mode),
nb_setval('$debug_run',off).
nodebug :- '$start_debugging'(Mode) :-
recorded('$debug',_,R), erase(R), fail. nb_setval('$debug',Mode),
nodebug :- nb_setval('$debug_run',off).
recorded('$trace',_,R), erase(R), fail.
nodebug :- nospyall, nodebug :-
'$set_yap_flags'(10,0), nb_setval('$debug',off),
nb_setval('$trace',off),
'$print_message'(informational,debug(off)). '$print_message'(informational,debug(off)).
%
% remove any debugging info after an abort.
%
trace :- trace :-
recorded('$trace',on,_), !. nb_getval('$trace',on), !.
trace :-
recorded('$spy_skip',_,R), erase(R), fail.
trace :- trace :-
( recordaifnot('$trace',on,_) -> true ; true), nb_setval('$trace',on),
( recordaifnot('$debug',on,_) -> true ; true), '$start_debugging'(on),
( recordaifnot('$spy_stop',on,_) -> true ; true),
'$set_yap_flags'(10,1),
'$print_message'(informational,debug(trace)), '$print_message'(informational,debug(trace)),
'$creep'. '$creep'.
notrace :- notrace :-
recorded('$debug',_,R), erase(R), fail. nodebug.
notrace :-
recorded('$trace',_,R), erase(R), fail.
notrace :-
'$print_message'(informational,debug(off)).
/*----------------------------------------------------------------------------- /*-----------------------------------------------------------------------------
@ -185,35 +186,35 @@ leash(X) :-
'$show_leash'(Msg,0) :- '$show_leash'(Msg,0) :-
'$print_message'(Msg,leash([])). '$print_message'(Msg,leash([])).
'$show_leash'(Msg,Code) :- '$show_leash'(Msg,Code) :-
'$check_leash_bit'(Code,2'1000,L3,call,LF), '$check_leash_bit'(Code,0x8,L3,call,LF),
'$check_leash_bit'(Code,2'0100,L2,exit,L3), '$check_leash_bit'(Code,0x4,L2,exit,L3),
'$check_leash_bit'(Code,2'0010,L1,redo,L2), '$check_leash_bit'(Code,0x2,L1,redo,L2),
'$check_leash_bit'(Code,2'0001,[],fail,L1), '$check_leash_bit'(Code,0x1,[],fail,L1),
'$print_message'(Msg,leash(LF)). '$print_message'(Msg,leash(LF)).
'$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !. '$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !.
'$check_leash_bit'(_,_,L0,Name,[Name|L0]). '$check_leash_bit'(_,_,L0,Name,[Name|L0]).
'$leashcode'(full,2'1111) :- !. '$leashcode'(full,0xf) :- !.
'$leashcode'(on,2'1111) :- !. '$leashcode'(on,0xf) :- !.
'$leashcode'(half,2'1010) :- !. '$leashcode'(half,0xb) :- !.
'$leashcode'(loose,2'1000) :- !. '$leashcode'(loose,0x8) :- !.
'$leashcode'(off,2'0000) :- !. '$leashcode'(off,0x0) :- !.
'$leashcode'(none,2'0000) :- !. '$leashcode'(none,0x0) :- !.
%'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code). %'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code).
'$leashcode'([L|M],Code) :- !, '$leashcode'([L|M],Code) :- !,
'$list2Code'([L|M],Code). '$list2Code'([L|M],Code).
'$leashcode'(N,N) :- integer(N), N >= 0, N =< 2'1111. '$leashcode'(N,N) :- integer(N), N >= 0, N =< 0xf.
'$list2Code'(V,_) :- var(V), !, '$list2Code'(V,_) :- var(V), !,
'$do_error'(instantiation_error,leash(V)). '$do_error'(instantiation_error,leash(V)).
'$list2Code'([],0) :- !. '$list2Code'([],0) :- !.
'$list2Code'([V|L],_) :- var(V), !, '$list2Code'([V|L],_) :- var(V), !,
'$do_error'(instantiation_error,leash([V|L])). '$do_error'(instantiation_error,leash([V|L])).
'$list2Code'([call|L],N) :- '$list2Code'(L,N1), N is 2'1000 + N1. '$list2Code'([call|L],N) :- '$list2Code'(L,N1), N is 0x8 + N1.
'$list2Code'([exit|L],N) :- '$list2Code'(L,N1), N is 2'0100 + N1. '$list2Code'([exit|L],N) :- '$list2Code'(L,N1), N is 0x4 + N1.
'$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 2'0010 + N1. '$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 0x2 + N1.
'$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 2'0001 + N1. '$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 0x1 + N1.
/*----------------------------------------------------------------------------- /*-----------------------------------------------------------------------------
@ -223,7 +224,7 @@ leash(X) :-
debugging :- debugging :-
( recorded('$debug',on,_) -> ( nb_getval('$debug',on) ->
'$print_message'(help,debug(debug)) '$print_message'(help,debug(debug))
; ;
'$print_message'(help,debug(off)) '$print_message'(help,debug(off))
@ -239,7 +240,6 @@ debugging :-
-----------------------------------------------------------------------------*/ -----------------------------------------------------------------------------*/
% ok, I may have a spy point for this goal, or not. % ok, I may have a spy point for this goal, or not.
% if I do, I should check what mode I am in. % if I do, I should check what mode I am in.
% Goal/Mode Have Spy Not Spied % Goal/Mode Have Spy Not Spied
@ -255,7 +255,7 @@ debugging :-
% spy_gn goal number 1 1... % spy_gn goal number 1 1...
% spy_trace trace 0 0, 1 % spy_trace trace 0 0, 1
% spy_skip leap off Num (stop level) % spy_skip leap off Num (stop level)
% spy_stop stop at spy points on on,off % debug_prompt stop at spy points on on,off
% a flip-flop is also used % a flip-flop is also used
% when 1 spying is enabled *(the same as spy stop). % when 1 spying is enabled *(the same as spy stop).
@ -266,14 +266,18 @@ debugging :-
% take care with hidden goals. % take care with hidden goals.
% %
% $spy may be called from user code, so be careful. % $spy may be called from user code, so be careful.
'$spy'([Mod|G]) :-
nb_getval('$debug',off), !,
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :-
nb_getval('$system_mode',on), !,
'$execute_nonstop'(G,Mod).
'$spy'([Mod|G]) :- '$spy'([Mod|G]) :-
CP is '$last_choice_pt', CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, yes). '$do_spy'(G, Mod, CP, yes).
% last argument to do_spy says that we are at the end of a context. It % last argument to do_spy says that we are at the end of a context. It
% is required to know whether we are controlled by the debugger. % is required to know whether we are controlled by the debugger.
'$do_spy'(_, _, _, _) :-
'$do_not_creep', fail.
'$do_spy'(!, _, CP, _) :- !, '$cut_by'(CP). '$do_spy'(!, _, CP, _) :- !, '$cut_by'(CP).
'$do_spy'('$cut_by'(M), _, _, _) :- !, '$cut_by'(M). '$do_spy'('$cut_by'(M), _, _, _) :- !, '$cut_by'(M).
'$do_spy'(true, _, _, _) :- !. '$do_spy'(true, _, _, _) :- !.
@ -312,21 +316,22 @@ debugging :-
'$do_spy'((not(G)), M, CP, InControl) :- !, '$do_spy'((not(G)), M, CP, InControl) :- !,
\+ '$do_spy'(G, M, CP, InControl). \+ '$do_spy'(G, M, CP, InControl).
'$do_spy'(G, Module, _, InControl) :- '$do_spy'(G, Module, _, InControl) :-
get_value(spy_gn,L), /* get goal no. */ nb_getval('$spy_gn',L), /* get goal no. */
L1 is L+1, /* bump it */ L1 is L+1, /* bump it */
set_value(spy_gn,L1), /* and save it globaly */ nb_setval('$spy_gn',L1), /* and save it globaly */
'$loop_spy'(L, G, Module, InControl). /* set creep on */ b_getval('$spy_glist',History), /* get goal list */
b_setval('$spy_glist',[info(L,Module,G,Retry,Det)|History]), /* and update it */
'$loop_spy'(L, G, Module, InControl). /* set creep on */
% we are skipping, so we can just call the goal, % we are skipping, so we can just call the goal,
% while leaving the minimal structure in place. % while leaving the minimal structure in place.
'$loop_spy'(GoalNumber, G, Module, InControl) :- '$loop_spy'(GoalNumber, G, Module, InControl) :-
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, InControl), '$save_current_choice_point'(CP),
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, InControl, CP),
Module, Event, Module, Event,
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl)). '$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
% handle weird things happening in the debugger. % handle weird things happening in the debugger.
'$loop_spy_event'(_, _, _, _, _) :-
'$do_not_creep', fail.
'$loop_spy_event'('$retry_spy'(G0), GoalNumber, G, Module, InControl) :- '$loop_spy_event'('$retry_spy'(G0), GoalNumber, G, Module, InControl) :-
G0 >= GoalNumber, !, G0 >= GoalNumber, !,
'$loop_spy'(GoalNumber, G, Module, InControl). '$loop_spy'(GoalNumber, G, Module, InControl).
@ -337,7 +342,7 @@ debugging :-
'$loop_fail'(GoalNumber, G, Module, InControl). '$loop_fail'(GoalNumber, G, Module, InControl).
'$loop_spy_event'('$fail_spy'(GoalNumber), _, _, _, _) :- !, '$loop_spy_event'('$fail_spy'(GoalNumber), _, _, _, _) :- !,
throw('$fail_spy'(GoalNumber)). throw('$fail_spy'(GoalNumber)).
'$loop_spy_event'('$done_spy'(G0), GoalNumber, _, _, _) :- '$loop_spy_event'('$done_spy'(G0,G), GoalNumber, G, _, _) :-
G0 >= GoalNumber, !, G0 >= GoalNumber, !,
'$continue_debugging'. '$continue_debugging'.
'$loop_spy_event'('$done_spy'(GoalNumber), _, _, _, _) :- !, '$loop_spy_event'('$done_spy'(GoalNumber), _, _, _, _) :- !,
@ -347,7 +352,7 @@ debugging :-
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl) :- '$loop_spy_event'(Event, GoalNumber, G, Module, InControl) :-
'$debug_error'(Event), '$debug_error'(Event),
'$system_catch'( '$system_catch'(
('$trace'(exception,G,Module,GoalNumber),fail), ('$trace'(exception,G,Module,GoalNumber,_),fail),
Module,NewEvent, Module,NewEvent,
'$loop_spy_event'(NewEvent, GoalNumber, G, Module, InControl)). '$loop_spy_event'(NewEvent, GoalNumber, G, Module, InControl)).
@ -358,38 +363,49 @@ debugging :-
'$loop_fail'(GoalNumber, G, Module, InControl) :- '$loop_fail'(GoalNumber, G, Module, InControl) :-
'$system_catch'(('$trace'(fail, G, Module, GoalNumber), '$system_catch'(('$trace'(fail, G, Module, GoalNumber,_),
fail ), fail ),
Module, Event, Module, Event,
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl)). '$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
% if we are in % if we are in
'$loop_spy2'(GoalNumber, G, Module, InControl) :- '$loop_spy2'(GoalNumber, G, Module, InControl, CP) :-
/* the following choice point is where the predicate is called */ /* the following choice point is where the predicate is called */
b_getval('$spy_glist',[info(_,_,_,Retry,Det)|_]), /* get goal list */
( (
/* call port */ /* call port */
'$enter_goal'(GoalNumber, G, Module), '$enter_goal'(GoalNumber, G, Module),
'$spycall'(G, Module, InControl), '$spycall'(G, Module, InControl),
(
'$debugger_deterministic_goal'(G) ->
Det=true
;
Det=false
),
/* go execute the predicate */ /* go execute the predicate */
( (
'$do_not_creep', '$show_trace'(exit,G,Module,GoalNumber,Det), /* output message at exit */
'$show_trace'(exit,G,Module,GoalNumber), /* output message at exit */
/* exit port */ /* exit port */
/* get rid of deterministic computations */ /* get rid of deterministic computations */
('$debugger_deterministic_goal'(G) -> throw('$done_spy'(GoalNumber)) ; true), (
'$continue_debugging' Det == true
; ->
'$cut_by'(CP)
;
true
),
'$continue_debugging'
;
/* backtracking from exit */ /* backtracking from exit */
/* we get here when we want to redo a goal */ /* we get here when we want to redo a goal */
'$do_not_creep',
/* redo port */ /* redo port */
'$show_trace'(redo,G,Module,GoalNumber), /* inform user_error */ '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
Retry = true,
'$continue_debugging'(InControl,G,Module), '$continue_debugging'(InControl,G,Module),
fail /* to backtrack to spycalls */ fail /* to backtrack to spycalls */
) )
; ;
'$do_not_creep', '$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */
'$show_trace'(fail,G,Module,GoalNumber), /* inform at fail port */
'$continue_debugging', '$continue_debugging',
/* fail port */ /* fail port */
fail fail
@ -397,36 +413,45 @@ debugging :-
'$enter_goal'(GoalNumber, G, Module) :- '$enter_goal'(GoalNumber, G, Module) :-
'$avoid_goal'(GoalNumber, G, Module), !. '$zip'(GoalNumber, G, Module), !.
'$enter_goal'(GoalNumber, G, Module) :- '$enter_goal'(GoalNumber, G, Module) :-
'$trace'(call, G, Module, GoalNumber). '$trace'(call, G, Module, GoalNumber, _).
'$show_trace'(_, G, Module, GoalNumber) :- '$show_trace'(_, G, Module, GoalNumber,_) :-
'$avoid_goal'(GoalNumber, G, Module), !. '$zip'(GoalNumber, G, Module), !.
'$show_trace'(P,G,Module,GoalNumber) :- '$show_trace'(P,G,Module,GoalNumber,Deterministic) :-
'$trace'(P,G,Module,GoalNumber). '$trace'(P,G,Module,GoalNumber,Deterministic).
'$avoid_goal'(_, _, _) :- %
\+ recorded('$debug',on,_), !. % skip a goal or a port
'$avoid_goal'(GoalNumber, G, Module) :- %
recorded('$spy_skip', Value, _), '$zip'(GoalNumber, G, Module) :-
'$continue_avoid_goal'(GoalNumber, G, Module, Value). nb_getval('$debug_run',StopPoint),
% zip mode off, we cannot zip
% for leap keep on going until finding something spied. StopPoint \= off,
'$continue_avoid_goal'(_, G, Module, _) :- (
recorded('$spy_stop', on, _), !, % skip spy points (eg, s).
\+ '$pred_being_spied'(G, Module). StopPoint == spy
% for skip keep on going until we get back. ->
'$continue_avoid_goal'(GoalNumber, _, _, Value) :- \+ '$pred_being_spied'(G, Module)
number(Value), ;
Value < GoalNumber. % skip goals (eg, l).
number(StopPoint)
->
StopPoint < GoalNumber
;
% skip goals and ports (eg, l).
StopPoint == spy(StoPoint)
->
\+ '$pred_being_spied'(G, Module), StopPoint < GoalNumber
).
% %
'$spycall'(G, M, _) :- '$spycall'(G, M, _) :-
( '$access_yap_flags'(10,0); '$system_predicate'(G,M),
'$system_predicate'(G,M), \+ '$is_metapredicate'(G,M) \+ '$is_metapredicate'(G,M),
), !, !,
'$execute_nonstop'(G, M). '$execute_nonstop'(G, M).
'$spycall'(G, M, InControl) :- '$spycall'(G, M, InControl) :-
'$flags'(G,M,F,F), '$flags'(G,M,F,F),
@ -434,7 +459,6 @@ debugging :-
% use the interpreter % use the interpreter
CP is '$last_choice_pt', CP is '$last_choice_pt',
'$clause'(G, M, Cl), '$clause'(G, M, Cl),
'$do_not_creep',
'$do_spy'(Cl, M, CP, InControl). '$do_spy'(Cl, M, CP, InControl).
'$spycall'(G, M, InControl) :- '$spycall'(G, M, InControl) :-
'$undefined'(G, M), !, '$undefined'(G, M), !,
@ -451,34 +475,38 @@ debugging :-
'$continue_debugging'(InControl, G, M), '$continue_debugging'(InControl, G, M),
'$execute_clause'(G, M, R, CP). '$execute_clause'(G, M, R, CP).
'$trace'(P,G,Module,L) :- '$trace'(P,G,Module,L,Deterministic) :-
% at this point we are done with leap or skip
nb_setval('$debug_run',off),
% make sure we run this code outside debugging mode.
nb_setval('$debug', off),
repeat,
'$trace_msg'(P,G,Module,L,Deterministic),
(
'$unleashed'(P),
'$action'(10,P,L,G,Module,Debug)
;
write(user_error,' ? '), get0(user_input,C),
'$action'(C,P,L,G,Module,Debug)
),
nb_setval('$debug', Debug),
!.
'$trace_msg'(P,G,Module,L,Deterministic) :-
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
recorded('$debug',on,R0), erase(R0), (P = exit, Deterministic \= true -> Det = '?' ; Det = ' '),
repeat, ('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '),
(P = exit, \+ '$debugger_deterministic_goal'(G) -> Det = '?' ; Det = ''),
('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '),
% vsc: fix this % vsc: fix this
% ( SL = L -> SLL = '>' ; SLL = ' '), % ( SL = L -> SLL = '>' ; SLL = ' '),
SLL = ' ', SLL = ' ',
( recorded('$debug',on, R), erase(R), fail ; true), ( Module\=prolog,
( Module\=prolog, Module\=user ->
Module\=user -> format(user_error,'~a~a~a (~d) ~q: ~a:',[Det,CSPY,SLL,L,P,Module])
format(user_error,"~a~a~a (~d) ~q: ~a:",[Det,CSPY,SLL,L,P,Module]) ;
; format(user_error,'~a~a~a (~d) ~q:',[Det,CSPY,SLL,L,P])
format(user_error,"~a~a~a (~d) ~q:",[Det,CSPY,SLL,L,P]) ),
), '$debugger_write'(user_error,G).
'$debugger_write'(user_error,G),
( nonvar(R0), recordaifnot('$debug',on,_), fail ; true),
(
'$unleashed'(P),
'$action'(10,P,L,G,Module)
;
write(user_error,' ? '), get0(user_input,C),
'$action'(C,P,L,G,Module)
),
!.
'$unleashed'(call) :- get_value('$leash',L), L /\ 2'1000 =:= 0. '$unleashed'(call) :- get_value('$leash',L), L /\ 2'1000 =:= 0.
'$unleashed'(exit) :- get_value('$leash',L), L /\ 2'0100 =:= 0. '$unleashed'(exit) :- get_value('$leash',L), L /\ 2'0100 =:= 0.
@ -493,55 +521,53 @@ debugging :-
'$debugger_write'(Stream, G) :- '$debugger_write'(Stream, G) :-
writeq(Stream, G). writeq(Stream, G).
'$action'(10,_,_,_,_) :- % newline creep '$action'(10,_,_,_,_,on). % newline creep
( recorded('$spy_skip',_,R), erase(R), fail ; true ), '$action'(0'!,_,_,_,_,_) :- !, % ! g execute
'$set_yap_flags'(10,1).
'$action'(0'!,_,_,_,_) :- !, % ! g execute
read(user,G), read(user,G),
% don't allow yourself to be caught by creep. % don't allow yourself to be caught by creep.
'$access_yap_flags'(10, CL), nb_getval('$debug',OldDeb),
'$set_yap_flags'(10, 0), nb_setval('$debug',off),
( '$execute'(G) -> true ; true), ( '$execute'(G) -> true ; true),
'$set_yap_flags'(10, CL), nb_setval('$debug',OldDeb),
% '$skipeol'(0'!), % '$skipeol'(0'!),
fail. fail.
'$action'(0'<,_,_,_,_) :- !, % <Depth '$action'(0'<,_,_,_,_,_) :- !, % <Depth
'$new_deb_depth', '$new_deb_depth',
'$skipeol'(0'<), '$skipeol'(0'<),
fail. fail.
'$action'(0'^,_,_,G,_) :- !, '$action'(0'^,_,_,G,_,_) :- !,
'$print_deb_sterm'(G), '$print_deb_sterm'(G),
'$skipeol'(0'^), '$skipeol'(0'^),
fail. fail.
'$action'(0'a,_,_,_,_) :- !, % a abort '$action'(0'a,_,_,_,_,off) :- !, % a abort
'$skipeol'(0'a), '$skipeol'(0'a),
abort. abort.
'$action'(0'b,_,_,_,_) :- !, % b break '$action'(0'b,_,_,_,_,_) :- !, % b break
'$skipeol'(0'b), '$skipeol'(0'b),
break, break,
fail. fail.
'$action'(0'A,_,_,_,_) :- !, % b break '$action'(0'A,_,_,_,_,_) :- !, % b break
'$skipeol'(0'A), '$skipeol'(0'A),
'$show_choicepoint_stack', '$show_choicepoint_stack',
fail. fail.
'$action'(0'c,_,_,_,_) :- !, % c creep '$action'(0'c,_,_,_,_,on) :- !, % c creep
'$set_yap_flags'(10,1),
'$skipeol'(0'c). '$skipeol'(0'c).
'$action'(0'e,_,_,_,_) :- !, % e exit '$action'(0'e,_,_,_,_,_) :- !, % e exit
'$skipeol'(0'e), '$skipeol'(0'e),
halt. halt.
'$action'(0'f,_,CallId,_,_) :- !, % f fail '$action'(0'f,_,CallId,_,_,_) :- !, % f fail
'$scan_number'(0'f, CallId, GoalId), '$scan_number'(0'f, CallId, GoalId),
nb_setval('$debug,on'),
throw('$fail_spy'(GoalId)). throw('$fail_spy'(GoalId)).
'$action'(0'h,_,_,_,_) :- !, % h help '$action'(0'h,_,_,_,_,_) :- !, % h help
'$action_help', '$action_help',
'$skipeol'(104), '$skipeol'(104),
fail. fail.
'$action'(0'?,_,_,_,_) :- !, % ? help '$action'(0'?,_,_,_,_,_) :- !, % ? help
'$action_help', '$action_help',
'$skipeol'(104), '$skipeol'(104),
fail. fail.
'$action'(0'p,_,_,G,Module) :- !, % p print '$action'(0'p,_,_,G,Module,_) :- !, % p print
((Module = prolog ; Module = user) -> ((Module = prolog ; Module = user) ->
print(user_error,G), nl(user_error) print(user_error,G), nl(user_error)
; ;
@ -549,7 +575,7 @@ debugging :-
), ),
'$skipeol'(0'p), '$skipeol'(0'p),
fail. fail.
'$action'(0'd,_,_,G,Module) :- !, % d display '$action'(0'd,_,_,G,Module,_) :- !, % d display
((Module = prolog ; Module = user) -> ((Module = prolog ; Module = user) ->
display(user_error,G), nl(user_error) display(user_error,G), nl(user_error)
; ;
@ -557,53 +583,55 @@ debugging :-
), ),
'$skipeol'(0'd), '$skipeol'(0'd),
fail. fail.
'$action'(0'l,_,CallNumber,_,_) :- !, % l leap '$action'(0'l,_,CallNumber,_,_,on) :- !, % l leap
'$skipeol'(0'l), '$skipeol'(0'l),
( recorded('$spy_skip',_,R), erase(R), fail ; recorda('$spy_skip',CallNumber,_) ), nb_setval('$debug_run',spy).
( recordaifnot('$spy_stop',on,_) -> true ; true ), '$action'(0'z,_,CallNumber,_,_,zip) :- !, % k zip, fast leap
'$set_yap_flags'(10,1). '$skipeol'(0'z),
'$action'(0'n,_,_,_,_) :- !, % n nodebug nb_setval('$debug_run',spy).
'$skipeol'(0'n),
'$set_yap_flags'(10,0),
( recorded('$spy_stop',_,R), erase(R), fail ; true),
nodebug.
'$action'(0'k,_,CallNumber,_,_) :- !, % k quasi leap
'$skipeol'(0'k),
( recorded('$spy_skip',_,R), erase(R), fail ; recorda('$spy_skip',CallNumber,_) ),
( recordaifnot('$spy_stop',on,_) -> true ; true ),
'$set_yap_flags'(10,0).
% skip first call (for current goal), % skip first call (for current goal),
% stop next time. % stop next time.
'$action'(0'r,_,CallId,_,_) :- !, % r retry '$action'(0'k,_,CallNumber,_,_,zip) :- !, % k zip, fast leap
'$scan_number'(0'r,CallId,ScanNumber), '$skipeol'(0'k),
nb_setval('$debug_run',spy).
% skip first call (for current goal),
% stop next time.
'$action'(0'n,_,_,_,_,off) :- !, % n nodebug
'$skipeol'(0'n),
% tell debugger never to stop.
nb_setval('$debug_run', -1),
nodebug.
'$action'(0'r,_,CallId,_,_,_) :- !, % r retry
'$scan_number'(0'r,CallId,ScanNumber),
nb_setval('$debug',on),
throw('$retry_spy'(ScanNumber)). throw('$retry_spy'(ScanNumber)).
'$action'(0's,P,CallNumber,_,_) :- !, % s skip '$action'(0's,P,CallNumber,_,_,on) :- !, % s skip
'$skipeol'(0's), '$skipeol'(0's),
( (P=call; P=redo) -> ( (P=call; P=redo) ->
'$set_yap_flags'(10,1), nb_setval('$debug_run',CallNumber)
( recorded('$spy_skip',_,R), erase(R), fail ; recorda('$spy_skip',CallNumber,_) ),
( recorded('$spy_stop',_,R), erase(R), fail ; true)
; ;
'$ilgl'(0's) '$ilgl'(0's)
). ).
'$action'(0't,P,CallNumber,_,_) :- !, % t fast skip '$action'(0't,P,CallNumber,_,_,zip) :- !, % t fast skip
'$skipeol'(0't), '$skipeol'(0't),
( (P=call; P=redo) -> ( (P=call; P=redo) ->
( recorded('$spy_skip',_,R), erase(R), fail ; recorda('$spy_skip',CallNumber,_) ), nb_setval('$debug_run',CallNumber)
( recorded('$spy_stop',_,R), erase(R), fail ; true), ;
'$set_yap_flags'(10,0) '$ilgl'(0't)
;
'$ilgl'(0't)
). ).
'$action'(0'+,_,_,G,M) :- !, % + spy this '$action'(0'+,_,_,G,M,_) :- !, % + spy this
functor(G,F,N), spy(M:(F/N)), functor(G,F,N), spy(M:(F/N)),
'$skipeol'(0'+), '$skipeol'(0'+),
fail. fail.
'$action'(0'-,_,_,G,M) :- !, % - nospy this '$action'(0'-,_,_,G,M,_) :- !, % - nospy this
functor(G,F,N), nospy(M:(F/N)), functor(G,F,N), nospy(M:(F/N)),
'$skipeol'(0'-), '$skipeol'(0'-),
fail. fail.
'$action'(C,_,_,_,_) :- '$action'(0'g,_,_,_,_,_) :- !, % g ancestors
'$scan_number'(0'g,-1,HowMany),
'$show_ancestors'(HowMany),
fail.
'$action'(C,_,_,_,_,_) :-
'$skipeol'(C), '$skipeol'(C),
'$ilgl'(C), '$ilgl'(C),
fail. fail.
@ -612,29 +640,60 @@ debugging :-
'$continue_debugging'(no,_,_) :- !. '$continue_debugging'(no,_,_) :- !.
'$continue_debugging'(_,G,M) :- '$continue_debugging'(_,G,M) :-
'$system_predicate'(G,M), !, '$system_predicate'(G,M), !,
( '$access_yap_flags'(10,1) -> '$late_creep' ; true). '$late_creep'.
'$continue_debugging'(_,G,M) :-
'nb_getval'('$debug_run',Zip),
(Zip == nodebug ; number(Zip) ; Zip = spy(_) ), !.
'$continue_debugging'(_,_,_) :- '$continue_debugging'(_,_,_) :-
'$continue_debugging'. '$continue_debugging'.
'$continue_debugging' :- '$continue_debugging' :-
'$access_yap_flags'(10,1), !,
'$creep'. '$creep'.
'$continue_debugging'.
'$show_ancestors'(HowMany) :-
b_getval('$spy_glist',[_|History]),
(
History == []
->
'$print_message'(help, ancestors([]))
;
'$show_ancestors'(History,HowMany),
nl(user_error)
).
'$show_ancestors'([],_).
'$show_ancestors'([_|_],0) :- !.
'$show_ancestors'([info(L,M,G,Retry,Det)|History],HowMany) :-
'$show_ancestor'(L,M,G,Retry,Det,HowMany,HowMany1),
'$show_ancestors'(History,HowMany1).
% skip exit port, we're looking at true ancestors
'$show_ancestor'(_,_,_,_,Det,HowMany,HowMany) :-
nonvar(Det), !.
% look at retry
'$show_ancestor'(GoalNumber, M, G, Retry, Det, HowMany, HowMany1) :-
nonvar(Retry), !,
HowMany1 is HowMany-1,
'$trace_msg'(redo, G, M, GoalNumber, _), nl(user_error).
'$show_ancestor'(GoalNumber, M, G, Retry, Det, HowMany, HowMany1) :-
HowMany1 is HowMany-1,
'$trace_msg'(call, G, M, GoalNumber, _), nl(user_error).
'$action_help' :- '$action_help' :-
format(user_error,"newline creep a abort~n", []), format(user_error,'newline creep a abort~n', []),
format(user_error,"c creep e exit~n", []), format(user_error,'c creep e exit~n', []),
format(user_error,"f Goal fail h help~n", []), format(user_error,'f Goal fail h help~n', []),
format(user_error,"l leap r Goal retry~n", []), format(user_error,'l leap r Goal retry~n', []),
format(user_error,"s skip t fastskip~n", []), format(user_error,'s skip t fastskip~n', []),
format(user_error,"q quasiskip k quasileap~n", []), format(user_error,'q quasiskip k quasileap~n', []),
format(user_error,"b break n no debug~n", []), format(user_error,'b break n no debug~n', []),
format(user_error,"p print d display~n", []), format(user_error,'p print d display~n', []),
format(user_error,"<D depth D < full term~n", []), format(user_error,'<D depth D < full term~n', []),
format(user_error,"+ spy this - nospy this~n", []), format(user_error,'+ spy this - nospy this~n', []),
format(user_error,"^ view subg ^^ view using~n", []), format(user_error,'^ view subg ^^ view using~n', []),
format(user_error,"A alternatives~n", []), format(user_error,'A choices g [N] ancestors~n', []),
format(user_error,"! g execute goal~n", []). format(user_error,'! g execute goal~n', []).
'$ilgl'(C) :- '$ilgl'(C) :-
'$print_message'(warning, trace_command(C)), '$print_message'(warning, trace_command(C)),
@ -661,8 +720,8 @@ debugging :-
'$scan_number3'(10, Nb, Nb) :- !, Nb > 0. '$scan_number3'(10, Nb, Nb) :- !, Nb > 0.
'$scan_number3'( C, Nb0, Nb) :- '$scan_number3'( C, Nb0, Nb) :-
C >= 0'0, C =< 0'9, C >= "0", C =< "9",
NbI is Nb0*10+(C-0'0), NbI is Nb0*10+(C-"0"),
get0(user, NC), get0(user, NC),
'$scan_number3'( NC, NbI, Nb). '$scan_number3'( NC, NbI, Nb).
@ -670,7 +729,7 @@ debugging :-
'$get_sterm_list'(L), !, '$get_sterm_list'(L), !,
'$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,_),
format(user_error,"~n~w~n~n",[A]). format(user_error,'~n~w~n~n',[A]).
'$print_deb_sterm'(_) :- '$skipeol'(94). '$print_deb_sterm'(_) :- '$skipeol'(94).
'$get_sterm_list'(L) :- '$get_sterm_list'(L) :-
@ -768,16 +827,27 @@ debugging :-
'$debugger_deterministic_goal'(G) :- '$debugger_deterministic_goal'(G) :-
'$all_choicepoints'(CPs), '$all_choicepoints'(CPs),
'$debugger_check_traces'(CPs,CPs1), '$debugger_skip_traces'(CPs,CPs1),
'$debugger_check_loop_spy2'(CPs1,[Catch|_]), '$debugger_skip_loop_spy2'(CPs1,[Catch|_]),
'$choicepoint_info'(Catch,prolog,'$catch',3,'$catch'(_,'$loop_spy_event'(_,_,G,_,_),_)). '$choicepoint_info'(Catch,prolog,'$catch',3,'$catch'(_,'$loop_spy_event'(_,_,G,_,_),_)).
'$debugger_check_traces'([CP|CPs],CPs1) :-
'$choicepoint_info'(CP,prolog,'$trace',4,(_;_)), !,
'$debugger_check_traces'(CPs,CPs1).
'$debugger_check_traces'(CPs,CPs).
'$debugger_check_loop_spy2'([CP|CPs],CPs1) :- '$cps'([CP|CPs]) :-
'$choicepoint_info'(CP,A,B,C,D),
write(A:B:C:D:CPs),nl,
'$cps'(CPs).
'$cps'([]).
'$debugger_skip_traces'([CP|CPs],CPs1) :-
'$choicepoint_info'(CP,prolog,'$trace',4,(_;_)), !,
'$debugger_skip_traces'(CPs,CPs1).
'$debugger_skip_traces'(CPs,CPs).
'$debugger_skip_loop_spy2'([CP|CPs],CPs1) :-
'$choicepoint_info'(CP,prolog,'$loop_spy2',5,(_;_)), !, '$choicepoint_info'(CP,prolog,'$loop_spy2',5,(_;_)), !,
'$debugger_check_loop_spy2'(CPs,CPs1). '$debugger_skip_loop_spy2'(CPs,CPs1).
'$debugger_check_loop_spy2'(CPs,CPs). '$debugger_skip_loop_spy2'(CPs,CPs).

6
pl/directives.yap
View File

@ -417,11 +417,7 @@ yap_flag(language,X) :-
yap_flag(debug,X) :- yap_flag(debug,X) :-
var(X), !, var(X), !,
(recorded('$debug',on,_) -> nb_getval('$debug',X).
X = on
;
X = off
).
yap_flag(debug,X) :- yap_flag(debug,X) :-
'$transl_to_on_off'(_,X), !, '$transl_to_on_off'(_,X), !,
(X = on -> debug ; nodebug). (X = on -> debug ; nodebug).

8
pl/errors.yap
View File

@ -11,8 +11,11 @@
* File: errors.yap * * File: errors.yap *
* comments: error messages for YAP * * comments: error messages for YAP *
* * * *
* Last rev: $Date: 2006-05-22 16:12:01 $,$Author: tiagosoares $ * * Last rev: $Date: 2006-12-13 16:10:26 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.78 2006/05/22 16:12:01 tiagosoares
* MYDDAS: MYDDAS version boot message
*
* Revision 1.77 2006/04/10 19:24:52 vsc * Revision 1.77 2006/04/10 19:24:52 vsc
* fix syntax error message handling * fix syntax error message handling
* improve redblack trees and use it to reimplement association lists and * improve redblack trees and use it to reimplement association lists and
@ -276,6 +279,9 @@ print_message(Level, Mss) :-
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
'$do_print_message'(format(Msg, Args)) :- !, '$do_print_message'(format(Msg, Args)) :- !,
format(user_error,Msg,Args). format(user_error,Msg,Args).
'$do_print_message'(ancestors([])) :- !,
format(user_error,'There are no ancestors.',
[]).
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,already)) :- !, '$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,already)) :- !,
format(user_error,'There is already a spy point on ~w:~w/~w.', format(user_error,'There is already a spy point on ~w:~w/~w.',
[M,F,N]). [M,F,N]).

2
pl/init.yap
View File

@ -73,8 +73,6 @@ otherwise.
'eam.yap', 'eam.yap',
'yapor.yap']. 'yapor.yap'].
:- thread_local([idb:'$debug'/0,idb:'$trace'/0,idb:'$spy_skip'/0,idb:'$spy_stop'/0]).
:- ['protect.yap']. :- ['protect.yap'].
version(yap,[4,1]). version(yap,[4,1]).

58
pl/signals.yap
View File

@ -32,14 +32,7 @@
'$continue_signals', '$continue_signals',
'$wake_up_goal'(G, LG). '$wake_up_goal'(G, LG).
'$do_signal'(sig_creep, [M|G]) :- '$do_signal'(sig_creep, [M|G]) :-
( '$access_yap_flags'(10,0) -> '$start_creep'([M|G]).
% we're not allowed to creep for now,
% maybe we're inside builtin.
'$late_creep',
'$execute'(M:G)
;
'$start_creep'([M|G])
).
'$do_signal'(sig_delay_creep, [M|G]) :- '$do_signal'(sig_delay_creep, [M|G]) :-
'$execute'(M:G), '$execute'(M:G),
'$creep'. '$creep'.
@ -87,6 +80,13 @@
'$current_module'(M0), '$current_module'(M0),
'$execute0'((Goal,M:G),M0). '$execute0'((Goal,M:G),M0).
% do not debug if we are not in debug mode.
'$start_creep'([Mod|G]) :-
nb_getval('$debug',off), !,
'$execute_nonstop'(G,Mod).
'$start_creep'([Mod|G]) :-
nb_getval('$system_mode',on), !,
'$execute_nonstop'(G,Mod).
% notice that the last signal to be processed must always be creep % notice that the last signal to be processed must always be creep
'$start_creep'([_|'$cut_by'(CP)]) :- !, '$start_creep'([_|'$cut_by'(CP)]) :- !,
'$cut_by'(CP), '$cut_by'(CP),
@ -98,7 +98,17 @@
'$creep', '$creep',
'$execute_nonstop'(G,Mod). '$execute_nonstop'(G,Mod).
'$start_creep'([Mod|G]) :- '$start_creep'([Mod|G]) :-
'$do_not_creep', '$system_predicate'(G, Mod),
'$protected_env', !,
'$creep',
'$execute_nonstop'(G,Mod).
% do not debug if we are zipping through.
'$start_creep'([Mod|G]) :-
nb_getval('$debug_zip',on),
'$zip'(-1, G, Mod), !,
'$creep',
'$execute_nonstop'(G,Mod).
'$start_creep'([Mod|G]) :-
CP is '$last_choice_pt', CP is '$last_choice_pt',
'$do_spy'(G, Mod, CP, yes). '$do_spy'(G, Mod, CP, yes).
@ -154,3 +164,33 @@ read_sig :-
read_sig. read_sig.
'$protected_env' :-
'$all_envs'(Envs),
%'$envs'(Envs),
'$skim_envs'(Envs,Mod,Name,Arity),
\+ '$external_call_seen'(Mod,Name,Arity).
% '$envs'([Env|Envs]) :-
% '$env_info'(Env,Mod0,Name0,Arity0),
% format(user_error,'~a:~w/~w~n',[Mod0,Name0,Arity0]),
% '$envs'(Envs).
% '$envs'([]).
'$skim_envs'([Env|Envs],Mod,Name,Arity) :-
'$env_info'(Env,Mod0,Name0,Arity0),
'$debugger_env'(Mod0,Name0,Arity0), !,
'$skim_envs'(Envs,Mod,Name,Arity).
'$skim_envs'([Env|Envs],Mod,Name,Arity) :-
'$env_info'(Env,Mod,Name,Arity).
'$debugger_env'(prolog,'$start_creep',1).
'$external_call_seen'(prolog,Name,Arity) :- !,
'$allowed'(Name,Arity).
'$external_call_seen'(_,_,_).
'$allowed'('$spycall',3).
'$allowed'('$query',2).

2
pl/yio.yap
View File

@ -528,7 +528,7 @@ print(_,_).
/* interface to user portray */ /* interface to user portray */
'$portray'(T) :- '$portray'(T) :-
\+ '$undefined'(portray(_),user), \+ '$undefined'(portray(_),user),
user:portray(T), !, '$system_catch'(call(portray(T)),user,Error,user:'$Error'(Error)), !,
set_value('$portray',true), fail. set_value('$portray',true), fail.
'$portray'(_) :- set_value('$portray',false), fail. '$portray'(_) :- set_value('$portray',false), fail.