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

generic fixes, mostly indentin

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-10-22 00:45:21 +01:00
parent b2369175e5
commit 42e2543ab7
6 changed files with 313 additions and 340 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/save.c
View File

@ -500,7 +500,7 @@ save_code_info(void)
return -1; return -1;
} }
/* and the current character codes */ /* and the current character codes */
if (mywrite(splfild, Yap_chtype, NUMBER_OF_CHARS) < 0) if (mywrite(splfild, (char *)Yap_chtype, NUMBER_OF_CHARS*sizeof(char_kind_t)) < 0)
return -1; return -1;
return 0; return 0;
} }
@ -950,7 +950,7 @@ get_insts(OPCODE old_ops[])
static int static int
get_hash(void) get_hash(void)
{ {
return myread(splfild, Yap_chtype , NUMBER_OF_CHARS); return myread(splfild, (char *)Yap_chtype , NUMBER_OF_CHARS*sizeof(char_kind_t));
} }
/* Copy all of the old code to the new Heap */ /* Copy all of the old code to the new Heap */

262
C/stdpreds.c
View File

@ -182,7 +182,7 @@
* YAP_Error changed. * YAP_Error changed.
* *
* Revision 1.84 2005/03/02 18:35:46 vsc * Revision 1.84 2005/03/02 18:35:46 vsc
* try to make initialisation process more robust * try to make initialization process more robust
* try to make name more robust (in case Lookup new atom fails) * try to make name more robust (in case Lookup new atom fails)
* *
* Revision 1.83 2005/03/01 22:25:09 vsc * Revision 1.83 2005/03/01 22:25:09 vsc
@ -223,13 +223,14 @@
* replace heap_base by Yap_heap_base, according to Yap's convention for globals. * replace heap_base by Yap_heap_base, according to Yap's convention for globals.
* *
* Revision 1.74 2004/11/19 22:08:43 vsc * Revision 1.74 2004/11/19 22:08:43 vsc
* replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever appropriate. * replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever
*appropriate.
* *
* Revision 1.73 2004/11/19 17:14:14 vsc * Revision 1.73 2004/11/19 17:14:14 vsc
* a few fixes for 64 bit compiling. * a few fixes for 64 bit compiling.
* *
* Revision 1.72 2004/11/18 22:32:37 vsc * Revision 1.72 2004/11/18 22:32:37 vsc
* fix situation where we might assume nonextsing double initialisation of C * fix situation where we might assume nonextsing double initialization of C
*predicates (use *predicates (use
* Hidden Pred Flag). * Hidden Pred Flag).
* $host_type was double initialised. * $host_type was double initialised.
@ -342,22 +343,21 @@ static Int p_walltime(USES_REGS1);
static Int p_break(USES_REGS1); static Int p_break(USES_REGS1);
#if YAP_JIT #if YAP_JIT
void* (*Yap_JitCall)(JIT_Compiler* jc, yamop* p); void *(*Yap_JitCall)(JIT_Compiler *jc, yamop *p);
void (* Yap_llvmShutdown)(void ) ; void (*Yap_llvmShutdown)(void);
Int (* Yap_traced_absmi)(void ) ; Int (*Yap_traced_absmi)(void);
static Int p_jit(USES_REGS1) { /* '$set_value'(+Atom,+Atomic) */ static Int p_jit(USES_REGS1) { /* '$set_value'(+Atom,+Atomic) */
void *jit_handle; void *jit_handle;
if ( (jit_handle = Yap_LoadForeignFile( YAP_YAPJITLIB, 0 ) ) ) { if ((jit_handle = Yap_LoadForeignFile(YAP_YAPJITLIB, 0))) {
if (!Yap_CallForeignFile(jit_handle, "init_jit") ) if (!Yap_CallForeignFile(jit_handle, "init_jit"))
fprintf(stderr, "Could not load JIT\n" ); fprintf(stderr, "Could not load JIT\n");
return FALSE; return FALSE;
} }
return TRUE; return TRUE;
} }
#endif /* YAP_JIT */ #endif /* YAP_JIT */
#ifdef BEAM #ifdef BEAM
@ -449,13 +449,14 @@ Int show_time(USES_REGS1) /* MORE PRECISION */
} }
#endif /* BEAM */ #endif /* BEAM */
// @{ // @{
/** /**
@defgroup YAPSetVal @defgroup YAPSetVal
@ingroup Internal_Database @ingroup Internal_Database
Maintain a light-weight map where the key is an atom, and the value can be any constant. Maintain a light-weight map where the key is an atom, and the value can be
any constant.
*/ */
/** @pred set_value(+ _A_,+ _C_) /** @pred set_value(+ _A_,+ _C_)
@ -530,7 +531,6 @@ static Int p_values(USES_REGS1) { /* '$values'(Atom,Old,New) */
//@} //@}
static Int p_opdec(USES_REGS1) { /* '$opdec'(p,type,atom) */ static Int p_opdec(USES_REGS1) { /* '$opdec'(p,type,atom) */
/* we know the arguments are integer, atom, atom */ /* we know the arguments are integer, atom, atom */
Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3); Term p = Deref(ARG1), t = Deref(ARG2), at = Deref(ARG3);
@ -839,21 +839,24 @@ static Int
} }
out = IntegerOfTerm(t); out = IntegerOfTerm(t);
#if YAP_JIT #if YAP_JIT
if (ExpEnv.analysis_struc.stats_enabled || ExpEnv.analysis_struc.time_pass_enabled) { if (ExpEnv.analysis_struc.stats_enabled ||
if (strcmp(((char*)ExpEnv.analysis_struc.outfile), "STDERR")) { ExpEnv.analysis_struc.time_pass_enabled) {
if (strcmp(((char *)ExpEnv.analysis_struc.outfile), "STDERR")) {
int stderrcopy = dup(2); int stderrcopy = dup(2);
if (strcmp(((char*)ExpEnv.analysis_struc.outfile), "STDOUT") == 0) { if (strcmp(((char *)ExpEnv.analysis_struc.outfile), "STDOUT") == 0) {
dup2(1, 2); dup2(1, 2);
#pragma GCC diagnostic push #pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wimplicit-function-declaration" #pragma GCC diagnostic ignored "-Wimplicit-function-declaration"
shutdown_llvm(); shutdown_llvm();
#pragma GCC diagnostic pop #pragma GCC diagnostic pop
dup2(stderrcopy, 2); dup2(stderrcopy, 2);
} } else {
else { int Outputfile = open(((char *)ExpEnv.analysis_struc.outfile),
int Outputfile = open(((char*)ExpEnv.analysis_struc.outfile), O_CREAT | O_APPEND | O_WRONLY, 0777); O_CREAT | O_APPEND | O_WRONLY, 0777);
if (Outputfile < 0) { if (Outputfile < 0) {
fprintf(stderr, "Error:: I can not write analysis passes's output on %s...\n", ((char*)ExpEnv.analysis_struc.outfile)); fprintf(stderr,
"Error:: I can not write analysis passes's output on %s...\n",
((char *)ExpEnv.analysis_struc.outfile));
fprintf(stderr, " %s...\n", strerror(errno)); fprintf(stderr, " %s...\n", strerror(errno));
errno = 0; errno = 0;
exit(1); exit(1);
@ -864,8 +867,7 @@ static Int
dup2(stderrcopy, 2); dup2(stderrcopy, 2);
} }
close(stderrcopy); close(stderrcopy);
} } else
else
shutdown_llvm(); shutdown_llvm();
} }
#endif #endif
@ -874,25 +876,19 @@ static Int
return TRUE; return TRUE;
} }
static bool static bool valid_prop(Prop p, Term task) {
valid_prop(Prop p, Term task) if (RepPredProp(p)->OpcodeOfPred == UNDEF_OPCODE)
{
if (RepPredProp(p)->OpcodeOfPred == UNDEF_OPCODE)
return false; return false;
if ( (RepPredProp(p)->PredFlags & (HiddenPredFlag|StandardPredFlag) ) ) if ((RepPredProp(p)->PredFlags & (HiddenPredFlag | StandardPredFlag))) {
{ return (task == SYSTEM_MODULE || task == TermTrue);
return (task == SYSTEM_MODULE || task == TermTrue ); } else {
} else { return (task == USER_MODULE || task == TermTrue);
return (task == USER_MODULE || task == TermTrue );
} }
} }
static PropEntry * static PropEntry *followLinkedListOfProps(PropEntry *p, Term task) {
followLinkedListOfProps (PropEntry *p, Term task)
{
while (p) { while (p) {
if (p->KindOfPE == PEProp && if (p->KindOfPE == PEProp && valid_prop(p, task)) {
valid_prop(p, task) ) {
// found our baby.. // found our baby..
return p; return p;
} }
@ -901,9 +897,7 @@ followLinkedListOfProps (PropEntry *p, Term task)
return NIL; return NIL;
} }
static PropEntry * static PropEntry *getPredProp(PropEntry *p, Term task) {
getPredProp (PropEntry *p, Term task)
{
PredEntry *pe; PredEntry *pe;
if (p == NIL) if (p == NIL)
return NIL; return NIL;
@ -915,7 +909,7 @@ getPredProp (PropEntry *p, Term task)
// first search remainder of functor list // first search remainder of functor list
Prop pf; Prop pf;
if ((pf = followLinkedListOfProps(RepFunctorProp(p)->PropsOfFE, task))) { if ((pf = followLinkedListOfProps(RepFunctorProp(p)->PropsOfFE, task))) {
return pf; return pf;
} }
} }
p = p->NextOfPE; p = p->NextOfPE;
@ -923,9 +917,7 @@ getPredProp (PropEntry *p, Term task)
return NIL; return NIL;
} }
static PropEntry * static PropEntry *nextPredForAtom(PropEntry *p, Term task) {
nextPredForAtom (PropEntry *p, Term task)
{
PredEntry *pe; PredEntry *pe;
if (p == NIL) if (p == NIL)
return NIL; return NIL;
@ -942,18 +934,15 @@ nextPredForAtom (PropEntry *p, Term task)
} }
// if that fails, follow the functor // if that fails, follow the functor
return getPredProp( f->NextOfPE , task); return getPredProp(f->NextOfPE, task);
} }
} }
static Prop initFunctorSearch(Term t3, Term t2, Term task) {
static Prop
initFunctorSearch(Term t3, Term t2, Term task)
{
if (IsAtomTerm(t3)) { if (IsAtomTerm(t3)) {
Atom at = AtomOfTerm(t3); Atom at = AtomOfTerm(t3);
// access the entry at key address. // access the entry at key address.
return followLinkedListOfProps( RepAtom( at )->PropsOfAE , task ); return followLinkedListOfProps(RepAtom(at)->PropsOfAE, task);
} else if (IsIntTerm(t3)) { } else if (IsIntTerm(t3)) {
if (IsNonVarTerm(t2) && t2 != IDB_MODULE) { if (IsNonVarTerm(t2) && t2 != IDB_MODULE) {
Yap_Error(TYPE_ERROR_CALLABLE, t3, "current_predicate/2"); Yap_Error(TYPE_ERROR_CALLABLE, t3, "current_predicate/2");
@ -962,8 +951,9 @@ initFunctorSearch(Term t3, Term t2, Term task)
Prop p; Prop p;
// access the entry at key address. // access the entry at key address.
// a single property (this will be deterministic // a single property (this will be deterministic
p = AbsPredProp( Yap_FindLUIntKey( IntOfTerm( t3 ) ) ); p = AbsPredProp(Yap_FindLUIntKey(IntOfTerm(t3)));
if (valid_prop(p, task)) return p; if (valid_prop(p, task))
return p;
} }
Yap_Error(TYPE_ERROR_CALLABLE, t3, "current_predicate/2"); Yap_Error(TYPE_ERROR_CALLABLE, t3, "current_predicate/2");
return NULL; return NULL;
@ -974,39 +964,34 @@ initFunctorSearch(Term t3, Term t2, Term task)
} else { } else {
f = FunctorOfTerm(t3); f = FunctorOfTerm(t3);
if (IsExtensionFunctor(f)) { if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t3, "current_predicate/2"); Yap_Error(TYPE_ERROR_CALLABLE, t3, "current_predicate/2");
return NULL; return NULL;
} }
} }
return followLinkedListOfProps( f->PropsOfFE, task ); return followLinkedListOfProps(f->PropsOfFE, task);
} }
} }
static PredEntry * static PredEntry *firstModulePred(PredEntry *npp, Term task) {
firstModulePred( PredEntry * npp, Term task)
{
if (!npp) if (!npp)
return NULL; return NULL;
do { do {
npp = npp->NextPredOfModule; npp = npp->NextPredOfModule;
} while (npp && } while (npp && !valid_prop(AbsPredProp(npp), task));
!valid_prop(AbsPredProp(npp), task));
return npp; return npp;
} }
static PredEntry * static PredEntry *firstModulesPred(PredEntry *npp, Term task) {
firstModulesPred( PredEntry *npp, Term task )
{
ModEntry *m; ModEntry *m;
if (npp) { if (npp) {
m = Yap_GetModuleEntry( npp-> ModuleOfPred ); m = Yap_GetModuleEntry(npp->ModuleOfPred);
npp = npp->NextPredOfModule; npp = npp->NextPredOfModule;
} else { } else {
m = CurrentModules; m = CurrentModules;
npp = m->PredForME; npp = m->PredForME;
} }
do { do {
while (npp && !valid_prop(AbsPredProp(npp), task ) ) while (npp && !valid_prop(AbsPredProp(npp), task))
npp = npp->NextPredOfModule; npp = npp->NextPredOfModule;
if (npp) if (npp)
return npp; return npp;
@ -1018,12 +1003,11 @@ firstModulesPred( PredEntry *npp, Term task )
return npp; return npp;
} }
static Int cont_current_predicate(USES_REGS1) { static Int cont_current_predicate(USES_REGS1) {
UInt Arity; UInt Arity;
Term name, task; Term name, task;
Term t1 = ARG1, t2 = ARG2, t3 = ARG3; Term t1 = ARG1, t2 = ARG2, t3 = ARG3;
bool rc, will_cut = false; bool rc, will_cut = false;
Functor f; Functor f;
PredEntry *pp; PredEntry *pp;
t1 = Yap_YapStripModule(t1, &t2); t1 = Yap_YapStripModule(t1, &t2);
@ -1031,58 +1015,58 @@ static Int cont_current_predicate(USES_REGS1) {
task = Deref(ARG4); task = Deref(ARG4);
pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1)); pp = AddressOfTerm(EXTRA_CBACK_ARG(4, 1));
if (IsNonVarTerm(t3)) { if (IsNonVarTerm(t3)) {
PropEntry *np, *p; PropEntry *np, *p;
// t3 is a functor, or compound term, // t3 is a functor, or compound term,
// just follow the functor chain // just follow the functor chain
p = AbsPredProp( pp ); p = AbsPredProp(pp);
if (!p) { if (!p) {
// initial search, tracks down what is the first call with // initial search, tracks down what is the first call with
// that name, functor.. // that name, functor..
p = initFunctorSearch( t3, t2, task ); p = initFunctorSearch(t3, t2, task);
// now, we can do lookahead. // now, we can do lookahead.
if (p == NIL) if (p == NIL)
cut_fail(); cut_fail();
pp = RepPredProp(p); pp = RepPredProp(p);
if (!IsVarTerm(t2)) { if (!IsVarTerm(t2)) {
do { do {
if (t2 == TermProlog) if (t2 == TermProlog)
t2 = PROLOG_MODULE; t2 = PROLOG_MODULE;
if (pp->ModuleOfPred == t2) { if (pp->ModuleOfPred == t2) {
will_cut = true; will_cut = true;
break; break;
} else { } else {
pp = RepPredProp(p = followLinkedListOfProps( p->NextOfPE, task )); pp = RepPredProp(p = followLinkedListOfProps(p->NextOfPE, task));
} }
} while (!will_cut && p); } while (!will_cut && p);
}
if (!p)
cut_fail();
} }
do { if (!p)
np = followLinkedListOfProps( p->NextOfPE, task ); cut_fail();
if (!np) { }
will_cut = true; do {
} else { np = followLinkedListOfProps(p->NextOfPE, task);
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(RepPredProp(np)); if (!np) {
B->cp_h = HR; will_cut = true;
} } else {
} while (p == NULL); EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(RepPredProp(np));
B->cp_h = HR;
}
} while (p == NULL);
} else if (IsNonVarTerm(t1)) { } else if (IsNonVarTerm(t1)) {
PropEntry *np, *p; PropEntry *np, *p;
// run over the same atomany predicate defined for that atom // run over the same atomany predicate defined for that atom
// may be fair bait, depends on whether we know the module. // may be fair bait, depends on whether we know the module.
p = AbsPredProp( pp ); p = AbsPredProp(pp);
if (!p) { if (!p) {
// initialization time // initialization time
if (IsIntTerm( t1 )) { if (IsIntTerm(t1)) {
// or this or nothing.... // or this or nothing....
p = AbsPredProp( Yap_FindLUIntKey( IntOfTerm( t3 ) ) ); p = AbsPredProp(Yap_FindLUIntKey(IntOfTerm(t3)));
} else if (IsAtomTerm( t1 )) { } else if (IsAtomTerm(t1)) {
// should be the usual situation. // should be the usual situation.
Atom at = AtomOfTerm(t1); Atom at = AtomOfTerm(t1);
p = getPredProp( RepAtom(at)->PropsOfAE , task); p = getPredProp(RepAtom(at)->PropsOfAE, task);
} else { } else {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "current_predicate/2"); Yap_Error(TYPE_ERROR_CALLABLE, t1, "current_predicate/2");
} }
@ -1103,19 +1087,19 @@ static Int cont_current_predicate(USES_REGS1) {
PredEntry *npp; PredEntry *npp;
if (!pp) { if (!pp) {
if (!IsAtomTerm( t2 )) { if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM, t2, "current_predicate/2"); Yap_Error(TYPE_ERROR_ATOM, t2, "current_predicate/2");
} }
ModEntry *m = Yap_GetModuleEntry(t2); ModEntry *m = Yap_GetModuleEntry(t2);
pp = firstModulePred( m->PredForME , task ); pp = firstModulePred(m->PredForME, task);
if (!pp) if (!pp)
cut_fail(); cut_fail();
} }
npp = firstModulePred( pp , task); npp = firstModulePred(pp, task);
if (!npp) if (!npp)
will_cut = true; will_cut = true;
// just try next one // just try next one
else { else {
EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp); EXTRA_CBACK_ARG(4, 1) = MkAddressTerm(npp);
B->cp_h = HR; B->cp_h = HR;
@ -1125,11 +1109,11 @@ static Int cont_current_predicate(USES_REGS1) {
PredEntry *npp; PredEntry *npp;
if (!pp) { if (!pp) {
pp = firstModulesPred( CurrentModules->PredForME, task ); pp = firstModulesPred(CurrentModules->PredForME, task);
if (!pp) if (!pp)
cut_fail(); cut_fail();
} }
npp = firstModulesPred( pp , task); npp = firstModulesPred(pp, task);
if (!npp) if (!npp)
will_cut = true; will_cut = true;
@ -1162,15 +1146,14 @@ static Int cont_current_predicate(USES_REGS1) {
} }
} }
if (Arity) { if (Arity) {
rc = Yap_unify(t3,Yap_MkNewApplTerm(f, Arity)); rc = Yap_unify(t3, Yap_MkNewApplTerm(f, Arity));
} else { } else {
rc = Yap_unify(t3,name); rc = Yap_unify(t3, name);
} }
rc = rc && rc = rc && Yap_unify(t2, ModToTerm(pp->ModuleOfPred)) && Yap_unify(t1, name);
Yap_unify(t2, ModToTerm(pp->ModuleOfPred)) &&
Yap_unify(t1, name);
if (will_cut) { if (will_cut) {
if (rc) cut_succeed(); if (rc)
cut_succeed();
cut_fail(); cut_fail();
} }
return rc; return rc;
@ -1248,7 +1231,8 @@ static Int cont_current_op(USES_REGS1) {
} }
} }
static Int init_current_op(USES_REGS1) { /* current_op(-Precedence,-Type,-Atom) */ static Int init_current_op(
USES_REGS1) { /* current_op(-Precedence,-Type,-Atom) */
EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)OpList); EXTRA_CBACK_ARG(5, 1) = (CELL)MkIntegerTerm((CELL)OpList);
B->cp_h = HR; B->cp_h = HR;
return cont_current_op(PASS_REGS1); return cont_current_op(PASS_REGS1);
@ -1316,25 +1300,22 @@ void Yap_show_statistics(void) {
frag = (100.0 * (heap_space_taken - HeapUsed)) / heap_space_taken; frag = (100.0 * (heap_space_taken - HeapUsed)) / heap_space_taken;
fprintf(stderr, "Code Space: %ld (%ld bytes needed, %ld bytes used, " fprintf(stderr, "Code Space: %ld (%ld bytes needed, %ld bytes used, "
"fragmentation %.3f%%).\n", "fragmentation %.3f%%).\n",
(unsigned long int)(Unsigned(H0) - Unsigned(Yap_HeapBase)), (unsigned long int)(Unsigned(H0) - Unsigned(Yap_HeapBase)),
(unsigned long int)(Unsigned(HeapTop) - Unsigned(Yap_HeapBase)), (unsigned long int)(Unsigned(HeapTop) - Unsigned(Yap_HeapBase)),
(unsigned long int)(HeapUsed), frag); (unsigned long int)(HeapUsed), frag);
fprintf(stderr, "Stack Space: %ld (%ld for Global, %ld for local).\n", fprintf(stderr, "Stack Space: %ld (%ld for Global, %ld for local).\n",
(unsigned long int)(sizeof(CELL) * (LCL0 - H0)), (unsigned long int)(sizeof(CELL) * (LCL0 - H0)),
(unsigned long int)(sizeof(CELL) * (HR - H0)), (unsigned long int)(sizeof(CELL) * (HR - H0)),
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP))); (unsigned long int)(sizeof(CELL) * (LCL0 - ASP)));
fprintf(stderr, "Trail Space: %ld (%ld used).\n", fprintf(stderr, "Trail Space: %ld (%ld used).\n",
(unsigned long int)(sizeof(tr_fr_ptr) * (Unsigned(LOCAL_TrailTop) - (unsigned long int)(sizeof(tr_fr_ptr) * (Unsigned(LOCAL_TrailTop) -
Unsigned(LOCAL_TrailBase))), Unsigned(LOCAL_TrailBase))),
(unsigned long int)(sizeof(tr_fr_ptr) * (unsigned long int)(sizeof(tr_fr_ptr) *
(Unsigned(TR) - Unsigned(LOCAL_TrailBase)))); (Unsigned(TR) - Unsigned(LOCAL_TrailBase))));
fprintf(stderr, "Runtime: %lds.\n", fprintf(stderr, "Runtime: %lds.\n", (unsigned long int)(runtime(PASS_REGS1)));
(unsigned long int)(runtime(PASS_REGS1))); fprintf(stderr, "Cputime: %lds.\n", (unsigned long int)(Yap_cputime()));
fprintf(stderr, "Cputime: %lds.\n", fprintf(stderr, "Walltime: %lds.\n", (unsigned long int)(Yap_walltime()));
(unsigned long int)(Yap_cputime()));
fprintf(stderr, "Walltime: %lds.\n",
(unsigned long int)(Yap_walltime()));
} }
static Int p_statistics_heap_max(USES_REGS1) { static Int p_statistics_heap_max(USES_REGS1) {
@ -1501,7 +1482,8 @@ static Int p_statistics_atom_info(USES_REGS1) {
while (catom != NIL) { while (catom != NIL) {
Atom ncatom; Atom ncatom;
count++; count++;
spaceused += sizeof(AtomEntry) + strlen((char *)RepAtom(catom)->StrOfAE) + 1; spaceused +=
sizeof(AtomEntry) + strlen((char *)RepAtom(catom)->StrOfAE) + 1;
ncatom = RepAtom(catom)->NextOfAE; ncatom = RepAtom(catom)->NextOfAE;
if (ncatom != NIL) { if (ncatom != NIL) {
READ_LOCK(RepAtom(ncatom)->ARWLock); READ_LOCK(RepAtom(ncatom)->ARWLock);
@ -1567,7 +1549,6 @@ static Int p_executable(USES_REGS1) {
return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), ARG1); return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), ARG1);
} }
static Int p_system_mode(USES_REGS1) { static Int p_system_mode(USES_REGS1) {
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
@ -1684,13 +1665,12 @@ static Int p_parallel_mode(USES_REGS1) { return FALSE; }
static Int p_yapor_workers(USES_REGS1) { return FALSE; } static Int p_yapor_workers(USES_REGS1) { return FALSE; }
#endif /* YAPOR */ #endif /* YAPOR */
void Yap_InitCPreds(void) { void Yap_InitCPreds(void) {
/* numerical comparison */ /* numerical comparison */
Yap_InitCPred("set_value", 2, p_setval, SafePredFlag | SyncPredFlag); Yap_InitCPred("set_value", 2, p_setval, SafePredFlag | SyncPredFlag);
Yap_InitCPred("get_value", 2, p_value, Yap_InitCPred("get_value", 2, p_value,
TestPredFlag | SafePredFlag | SyncPredFlag); TestPredFlag | SafePredFlag | SyncPredFlag);
Yap_InitCPred("$values", 3, p_values, SafePredFlag | SyncPredFlag); Yap_InitCPred("$values", 3, p_values, SafePredFlag | SyncPredFlag);
/* general purpose */ /* general purpose */
Yap_InitCPred("$opdec", 4, p_opdec, SafePredFlag | SyncPredFlag); Yap_InitCPred("$opdec", 4, p_opdec, SafePredFlag | SyncPredFlag);
Yap_InitCPred("=..", 2, p_univ, 0); Yap_InitCPred("=..", 2, p_univ, 0);
@ -1758,8 +1738,7 @@ void Yap_InitCPreds(void) {
Yap_InitCPred("$exit_undefp", 0, p_exitundefp, SafePredFlag); Yap_InitCPred("$exit_undefp", 0, p_exitundefp, SafePredFlag);
#ifdef YAP_JIT #ifdef YAP_JIT
Yap_InitCPred("$jit_init", 1, p_jit, Yap_InitCPred("$jit_init", 1, p_jit, SafePredFlag | SyncPredFlag);
SafePredFlag | SyncPredFlag);
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef INES #ifdef INES
Yap_InitCPred("euc_dist", 3, p_euc_dist, SafePredFlag); Yap_InitCPred("euc_dist", 3, p_euc_dist, SafePredFlag);
@ -1819,8 +1798,7 @@ void Yap_InitCPreds(void) {
Yap_init_optyap_preds(); Yap_init_optyap_preds();
#endif /* YAPOR || TABLING */ #endif /* YAPOR || TABLING */
#if YAP_JIT #if YAP_JIT
Yap_InitCPred("jit", 0, p_jit, Yap_InitCPred("jit", 0, p_jit, SafePredFlag | SyncPredFlag);
SafePredFlag | SyncPredFlag);
#endif #endif
Yap_InitThreadPreds(); Yap_InitThreadPreds();
{ {

276
C/tracer.c
View File

@ -26,12 +26,10 @@
#include "clause.h" #include "clause.h"
#include "tracer.h" #include "tracer.h"
static void send_tracer_message(char *start, char *name, Int arity, char *mname,
static void CELL *args) {
send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
{
if (name == NULL) { if (name == NULL) {
#ifdef YAPOR #ifdef YAPOR
fprintf(stderr, "(%d)%s", worker_id, start); fprintf(stderr, "(%d)%s", worker_id, start);
#else #else
fprintf(stderr, "%s", start); fprintf(stderr, "%s", start);
@ -41,19 +39,21 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
if (arity) { if (arity) {
if (args) if (args)
fprintf(stderr, "%s %s:%s(", start, mname, name); fprintf(stderr, "%s %s:%s(", start, mname, name);
else else
fprintf(stderr, "%s %s:%s/%lu", start, mname, name, (unsigned long int)arity); fprintf(stderr, "%s %s:%s/%lu", start, mname, name,
(unsigned long int)arity);
} else { } else {
fprintf(stderr, "%s %s:%s", start, mname, name); fprintf(stderr, "%s %s:%s", start, mname, name);
} }
if (args) { if (args) {
for (i= 0; i < arity; i++) { for (i = 0; i < arity; i++) {
if (i > 0) fprintf(stderr, ","); if (i > 0)
Yap_plwrite(args[i], NULL, 15, Handle_vars_f|AttVar_Portray_f, 1200); fprintf(stderr, ",");
Yap_plwrite(args[i], NULL, 15, Handle_vars_f | AttVar_Portray_f, 1200);
} }
if (arity) { if (arity) {
fprintf(stderr, ")"); fprintf(stderr, ")");
} }
} }
} }
@ -78,15 +78,16 @@ check_trail_consistency(void) {
ptr = --ptr; ptr = --ptr;
if (!IsVarTerm(TrailTerm(ptr))) { if (!IsVarTerm(TrailTerm(ptr))) {
if (IsApplTerm(TrailTerm(ptr))) { if (IsApplTerm(TrailTerm(ptr))) {
CELL *cptr = (CELL *)ptr; CELL *cptr = (CELL *)ptr;
ptr = (tr_fr_ptr)(cptr-1); ptr = (tr_fr_ptr)(cptr-1);
} else { } else {
if (IsPairTerm(TrailTerm(ptr))) { if (IsPairTerm(TrailTerm(ptr))) {
CELL *p = RepPair(TrailTerm(ptr)); CELL *p = RepPair(TrailTerm(ptr));
if IsAttVar(p) continue; if IsAttVar(p) continue;
} }
printf("Oops at call %ld, B->cp(%p) TR(%p) pt(%p)\n", vsc_count,B->cp_tr, TR, ptr); printf("Oops at call %ld, B->cp(%p) TR(%p) pt(%p)\n",
return(FALSE); vsc_count,B->cp_tr, TR, ptr);
return(FALSE);
} }
} }
} }
@ -100,16 +101,13 @@ CELL old_value = 0L, old_value2 = 0L;
void jmp_deb(int), jmp_deb2(void); void jmp_deb(int), jmp_deb2(void);
void void jmp_deb2(void) { fprintf(stderr, "Here\n"); }
jmp_deb2( void )
{
fprintf(stderr,"Here\n");
}
void void jmp_deb(int i) {
jmp_deb(int i) { if (i)
if (i) printf("Here we go %ld\n", old_value++); printf("Here we go %ld\n", old_value++);
if (old_value == 716) jmp_deb2(); if (old_value == 716)
jmp_deb2();
} }
struct various_codes *sc; struct various_codes *sc;
@ -126,8 +124,8 @@ check_area(void)
for (i= 0; i < 332; i++) { for (i= 0; i < 332; i++) {
if (array[i] !=((CELL *)0x187a800)[i]) { if (array[i] !=((CELL *)0x187a800)[i]) {
if (first != -1) { if (first != -1) {
first = i; first = i;
found = TRUE; found = TRUE;
} }
fprintf(stderr,"%lld changed %d\n",vsc_count,i); fprintf(stderr,"%lld changed %d\n",vsc_count,i);
} }
@ -141,89 +139,95 @@ check_area(void)
PredEntry *old_p[10000]; PredEntry *old_p[10000];
Term old_x1[10000], old_x2[10000], old_x3[10000]; Term old_x1[10000], old_x2[10000], old_x3[10000];
//static CELL oldv; // static CELL oldv;
void void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) {
low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
{
CACHE_REGS CACHE_REGS
char *s; char *s;
char *mname; char *mname;
Int arity; Int arity;
/* extern int gc_calls; */ /* extern int gc_calls; */
vsc_count++; vsc_count++;
//if (HR < ASP ) return; // if (HR < ASP ) return;
//fif (vsc_count == 12534) jmp_deb( 2 ); // fif (vsc_count == 12534) jmp_deb( 2 );
#if __ANDROID__ && 0 #if __ANDROID__ && 0
PredEntry *ap = pred; PredEntry *ap = pred;
if (pred && port == enter_pred) { if (pred && port == enter_pred) {
UInt flags = ap->PredFlags; UInt flags = ap->PredFlags;
if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE) if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE)
__android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); __android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %lx\n",
/* printf(" %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, flags); */ NameOfFunctor(ap->FunctorOfPred)->StrOfAE,
else if (ap->ModuleOfPred != IDB_MODULE) ap->ArityOfPE, flags);
__android_log_print(ANDROID_LOG_INFO, "YAP "," %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); /* printf(" %s/%ld %lx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE,
/* printf(" %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); */ * ap->ArityOfPE, flags); */
__android_log_print(ANDROID_LOG_INFO, "YAP "," %x ", ap->src.OwnerFile); else if (ap->ModuleOfPred != IDB_MODULE)
} __android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %lx\n",
((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE,
flags);
/* printf(" %s/%ld %lx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE,
* ap->ArityOfPE, flags); */
__android_log_print(ANDROID_LOG_INFO, "YAP ", " %x ", ap->src.OwnerFile);
}
return; return;
#endif #endif
// if (!worker_id) return; // if (!worker_id) return;
LOCK(Yap_heap_regs->low_level_trace_lock); LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs; sc = Yap_heap_regs;
//if (vsc_count == 161862) jmp_deb(1); // if (vsc_count == 161862) jmp_deb(1);
fprintf(stderr,"B=%ld ", LCL0-(CELL*)B); #ifdef THREADS
#ifdef THREADS
LOCAL_ThreadHandle.thread_inst_count++; LOCAL_ThreadHandle.thread_inst_count++;
#endif #endif
#ifdef COMMENTED #ifdef COMMENTED
fprintf(stderr,"in %p\n"); fprintf(stderr, "in %p\n");
CELL * gc_ENV = ENV; CELL *gc_ENV = ENV;
while (gc_ENV != NULL) { /* no more environments */ while (gc_ENV != NULL) { /* no more environments */
fprintf(stderr,"%ld\n", LCL0-gc_ENV); fprintf(stderr, "%ld\n", LCL0 - gc_ENV);
gc_ENV = (CELL *) gc_ENV[E_E]; /* link to prev gc_ENV = (CELL *)gc_ENV[E_E]; /* link to prev
* environment */ * environment */
} }
return; return;
{ {
choiceptr b_p = B; choiceptr b_p = B;
while (b_p) { while (b_p) {
fprintf(stderr,"%p %ld\n",b_p,Yap_op_from_opcode(b_p->cp_ap->opc)); fprintf(stderr, "%p %ld\n", b_p, Yap_op_from_opcode(b_p->cp_ap->opc));
b_p = b_p->cp_b; b_p = b_p->cp_b;
} }
} }
{ choiceptr myB = B; {
while (myB) myB = myB->cp_b; choiceptr myB = B;
while (myB)
myB = myB->cp_b;
} }
//*(H0+(0xb65f2850-0xb64b2008)/sizeof(CELL))==0xc || //*(H0+(0xb65f2850-0xb64b2008)/sizeof(CELL))==0xc ||
//0x4fd4d // 0x4fd4d
if (vsc_count > 1388060LL && vsc_count < 1388070LL) { if (vsc_count > 1388060LL && vsc_count < 1388070LL) {
if (vsc_count==1388061LL) if (vsc_count == 1388061LL)
jmp_deb(1); jmp_deb(1);
if (vsc_count % 1LL == 0) { if (vsc_count % 1LL == 0) {
UInt sz = Yap_regp->H0_[17]; UInt sz = Yap_regp->H0_[17];
UInt end = sizeof(MP_INT)/sizeof(CELL)+sz+1; UInt end = sizeof(MP_INT) / sizeof(CELL) + sz + 1;
fprintf(stderr,"VAL %lld %d %x/%x\n",vsc_count,sz,H0[16],H0[16+end]); fprintf(stderr, "VAL %lld %d %x/%x\n", vsc_count, sz, H0[16],
H0[16 + end]);
} }
} else } else
return; return;
{ {
tr_fr_ptr pt = (tr_fr_ptr)LOCAL_TrailBase; tr_fr_ptr pt = (tr_fr_ptr)LOCAL_TrailBase;
if (pt[140].term == 0 && pt[140].value != 0) if (pt[140].term == 0 && pt[140].value != 0)
jmp_deb(1); jmp_deb(1);
} }
if (worker_id != 04 || worker_id != 03) return; if (worker_id != 04 || worker_id != 03)
return;
// if (vsc_count == 218280) // if (vsc_count == 218280)
// vsc_xstop = 1; // vsc_xstop = 1;
if (vsc_count < 1468068888) { if (vsc_count < 1468068888) {
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
} }
if (port != enter_pred || if (port != enter_pred || !pred || pred->ArityOfPE != 4 ||
!pred || strcmp(RepAtom(NameOfFunctor(pred->FunctorOfPred))->StrOfAE,
pred->ArityOfPE != 4 || "in_between_target_phrases")) {
strcmp(RepAtom(NameOfFunctor(pred->FunctorOfPred))->StrOfAE,"in_between_target_phrases")) {
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
} }
@ -243,7 +247,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
} }
if (vsc_count == 123536441LL) vsc_xstop = 1; if (vsc_count == 123536441LL)
vsc_xstop = 1;
if (vsc_count < 5530257LL) { if (vsc_count < 5530257LL) {
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
@ -259,17 +264,14 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
jmp_deb(1); jmp_deb(1);
{ {
tr_fr_ptr pt = (tr_fr_ptr)LOCAL_TrailBase; tr_fr_ptr pt = (tr_fr_ptr)LOCAL_TrailBase;
if (pt[153].term == 0 && pt[153].value == 0 && if (pt[153].term == 0 && pt[153].value == 0 && pt[154].term != 0 &&
pt[154].term != 0 && pt[154].value != 0 && ( TR > pt+154 || pt[154].value != 0 && (TR > pt + 154 || TR_FZ > pt + 154))
TR_FZ > pt+154))
jmp_deb(2); jmp_deb(2);
if (pt[635].term == 0 && pt[635].value == 0 && if (pt[635].term == 0 && pt[635].value == 0 && pt[636].term != 0 &&
pt[636].term != 0 && pt[636].value != 0 && ( TR > pt+636 || pt[636].value != 0 && (TR > pt + 636 || TR_FZ > pt + 636))
TR_FZ > pt+636))
jmp_deb(3); jmp_deb(3);
if (pt[138].term == 0 && pt[138].value == 0 && if (pt[138].term == 0 && pt[138].value == 0 && pt[139].term != 0 &&
pt[139].term != 0 && pt[139].value != 0 && ( TR > pt+138 || pt[139].value != 0 && (TR > pt + 138 || TR_FZ > pt + 138))
TR_FZ > pt+138) )
jmp_deb(4); jmp_deb(4);
} }
if (vsc_count == 287939LL) if (vsc_count == 287939LL)
@ -277,8 +279,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
if (vsc_count == 173118LL) if (vsc_count == 173118LL)
jmp_deb(1); jmp_deb(1);
if (!(vsc_count >= 287934LL && vsc_count <= 287939LL) && if (!(vsc_count >= 287934LL && vsc_count <= 287939LL) &&
!(vsc_count >= 173100LL && vsc_count <= 173239LL) && !(vsc_count >= 173100LL && vsc_count <= 173239LL) && vsc_count != -1)
vsc_count != -1)
return; return;
if (vsc_count == 51021) { if (vsc_count == 51021) {
printf("Here I go\n"); printf("Here I go\n");
@ -287,38 +288,40 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
} }
if (vsc_count > 52000) exit(0); if (vsc_count > 52000)
exit(0);
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
if (vsc_count == 837074) { if (vsc_count == 837074) {
printf("Here I go\n"); printf("Here I go\n");
} }
if (gc_calls < 1) { if (gc_calls < 1) {
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
} }
{ {
CELL *env_ptr = ENV; CELL *env_ptr = ENV;
PredEntry *p; PredEntry *p;
while (env_ptr) { while (env_ptr) {
PredEntry *pe = EnvPreg(env_ptr[E_CP]); PredEntry *pe = EnvPreg(env_ptr[E_CP]);
printf("%p->",env_ptr,pe); printf("%p->", env_ptr, pe);
if (vsc_count == 52LL) printf("\n"); if (vsc_count == 52LL)
printf("\n");
if (p == pe) { if (p == pe) {
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
return; return;
} }
if (env_ptr != NULL) if (env_ptr != NULL)
env_ptr = (CELL *)(env_ptr[E_E]); env_ptr = (CELL *)(env_ptr[E_E]);
} }
printf("\n"); printf("\n");
} }
#endif #endif
fprintf(stderr,"%lld ",vsc_count); fprintf(stderr, "%lld ", vsc_count);
#if defined(THREADS) || defined(YAPOR) #if defined(THREADS) || defined(YAPOR)
fprintf(stderr,"(%d)", worker_id); fprintf(stderr, "(%d)", worker_id);
#endif #endif
/* check_trail_consistency(); */ /* check_trail_consistency(); */
if (pred == NULL) { if (pred == NULL) {
@ -338,7 +341,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
else else
s = (char *)RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE; s = (char *)RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$')) /* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */ return; */
send_tracer_message("CALL: ", s, arity, mname, args); send_tracer_message("CALL: ", s, arity, mname, args);
break; break;
case try_or: case try_or:
@ -362,7 +365,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
send_tracer_message("FAIL ", NULL, 0, NULL, args); send_tracer_message("FAIL ", NULL, 0, NULL, args);
mname = (char *)RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE; mname = (char *)RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) { if (arity == 0) {
s = (char *)RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; s = (char *)RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL); send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL);
} else { } else {
@ -378,9 +381,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
mname = (char *)RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE; mname = (char *)RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (arity == 0) if (arity == 0)
s = (char *)RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; s = (char *)RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
else else
s = (char *)RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE; s = (char *)RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
send_tracer_message("RETRY LOADER: ", s, 0, mname, NULL); send_tracer_message("RETRY LOADER: ", s, 0, mname, NULL);
} }
break; break;
@ -390,12 +393,12 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
mname = (char *)RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE; mname = (char *)RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
arity = pred->ArityOfPE; arity = pred->ArityOfPE;
if (pred->ModuleOfPred == IDB_MODULE) { if (pred->ModuleOfPred == IDB_MODULE) {
s = "recorded"; s = "recorded";
arity = 3; arity = 3;
} else if (arity == 0) { } else if (arity == 0) {
s = (char *)RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; s = (char *)RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
} else { } else {
s = (char *)RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE; s = (char *)RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
} }
send_tracer_message("RETRY: ", s, arity, mname, args); send_tracer_message("RETRY: ", s, arity, mname, args);
} }
@ -405,41 +408,34 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
UNLOCK(Yap_heap_regs->low_level_trace_lock); UNLOCK(Yap_heap_regs->low_level_trace_lock);
} }
void void toggle_low_level_trace(void) {
toggle_low_level_trace(void)
{
Yap_do_low_level_trace = !Yap_do_low_level_trace; Yap_do_low_level_trace = !Yap_do_low_level_trace;
} }
static Int start_low_level_trace( USES_REGS1 ) static Int start_low_level_trace(USES_REGS1) {
{
Yap_do_low_level_trace = TRUE; Yap_do_low_level_trace = TRUE;
return(TRUE); return (TRUE);
} }
static Int total_choicepoints( USES_REGS1 ) static Int total_choicepoints(USES_REGS1) {
{ return Yap_unify(MkIntegerTerm(LOCAL_total_choicepoints), ARG1);
return Yap_unify(MkIntegerTerm(LOCAL_total_choicepoints),ARG1);
} }
static Int reset_total_choicepoints( USES_REGS1 ) static Int reset_total_choicepoints(USES_REGS1) {
{
LOCAL_total_choicepoints = 0; LOCAL_total_choicepoints = 0;
return TRUE; return TRUE;
} }
static Int show_low_level_trace( USES_REGS1 ) static Int show_low_level_trace(USES_REGS1) {
{ fprintf(stderr, "Call counter=%lld\n", vsc_count);
fprintf(stderr,"Call counter=%lld\n",vsc_count); return (TRUE);
return(TRUE);
} }
#ifdef THREADS #ifdef THREADS
static Int start_low_level_trace2( USES_REGS1 ) static Int start_low_level_trace2(USES_REGS1) {
{ thread_trace = IntegerOfTerm(Deref(ARG1)) + 1;
thread_trace = IntegerOfTerm(Deref(ARG1))+1;
Yap_do_low_level_trace = TRUE; Yap_do_low_level_trace = TRUE;
return(TRUE); return (TRUE);
} }
#endif #endif
@ -449,52 +445,52 @@ static Int start_low_level_trace2( USES_REGS1 )
Stop displaying messages at procedure entry and retry. Stop displaying messages at procedure entry and retry.
Note that using this compile-time option will slow down execution, even if messages are Note that using this compile-time option will slow down execution, even if
messages are
not being output. not being output.
*/ */
static Int stop_low_level_trace( USES_REGS1 ) static Int stop_low_level_trace(USES_REGS1) {
{
Yap_do_low_level_trace = FALSE; Yap_do_low_level_trace = FALSE;
LOCAL_do_trace_primitives = TRUE; LOCAL_do_trace_primitives = TRUE;
#if DEBUG_LOCKS #if DEBUG_LOCKS
debug_locks = TRUE; debug_locks = TRUE;
#endif #endif
return(TRUE); return (TRUE);
} }
volatile int v_wait; volatile int v_wait;
static Int vsc_wait( USES_REGS1 ) static Int vsc_wait(USES_REGS1) {
{ while (!v_wait)
while (!v_wait); ;
return true; return true;
} }
static Int vsc_go( USES_REGS1 ) static Int vsc_go(USES_REGS1) {
{ v_wait = 1;
v_wait=1;
return true; return true;
} }
void void Yap_InitLowLevelTrace(void) {
Yap_InitLowLevelTrace(void) Yap_InitCPred("start_low_level_trace", 0, start_low_level_trace,
{ SafePredFlag);
Yap_InitCPred("start_low_level_trace", 0, start_low_level_trace, SafePredFlag); /** @pred start_low_level_trace
/** @pred start_low_level_trace
Begin display of messages at procedure entry and retry. Begin display of messages at procedure entry and retry.
*/ */
#if THREADS #if THREADS
Yap_InitCPred("start_low_level_trace", 1, start_low_level_trace2, SafePredFlag); Yap_InitCPred("start_low_level_trace", 1, start_low_level_trace2,
SafePredFlag);
#endif #endif
Yap_InitCPred("stop_low_level_trace", 0, stop_low_level_trace, SafePredFlag); Yap_InitCPred("stop_low_level_trace", 0, stop_low_level_trace, SafePredFlag);
Yap_InitCPred("show_low_level_trace", 0, show_low_level_trace, SafePredFlag); Yap_InitCPred("show_low_level_trace", 0, show_low_level_trace, SafePredFlag);
Yap_InitCPred("total_choicepoints", 1, total_choicepoints, SafePredFlag); Yap_InitCPred("total_choicepoints", 1, total_choicepoints, SafePredFlag);
Yap_InitCPred("reset_total_choicepoints", 0, reset_total_choicepoints, SafePredFlag); Yap_InitCPred("reset_total_choicepoints", 0, reset_total_choicepoints,
SafePredFlag);
Yap_InitCPred("vsc_wait", 0, vsc_wait, SafePredFlag); Yap_InitCPred("vsc_wait", 0, vsc_wait, SafePredFlag);
Yap_InitCPred("vsc_go", 0, vsc_go, SafePredFlag); Yap_InitCPred("vsc_go", 0, vsc_go, SafePredFlag);
} }

5
C/userpreds.c
View File

@ -17,7 +17,7 @@
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
a
/* /*
* This file is an entry for user defined C-predicates. * This file is an entry for user defined C-predicates.
* *
@ -51,8 +51,7 @@ a
/* You should include here the prototypes for all static functions */ /* You should include here the prototypes for all static functions */
#ifdef EUROTRA #ifdef EUROTRA
static int static int p_clean(void);
p_clean(void);
static int p_namelength(void); static int p_namelength(void);
static int p_getpid(void); static int p_getpid(void);
static int p_exit(void); static int p_exit(void);

1
C/utilpreds.c
View File

@ -4607,7 +4607,6 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
{ {
register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace();
Int numbv0 = numbv;
register tr_fr_ptr TR0 = TR; register tr_fr_ptr TR0 = TR;
CELL *InitialH = HR; CELL *InitialH = HR;

105
C/write.c
View File

@ -50,7 +50,7 @@ typedef enum {
symbol /* the previous term was a symbol like +, -, *, .... */ symbol /* the previous term was a symbol like +, -, *, .... */
} wtype; } wtype;
typedef StreamDesc *wrf; typedef StreamDesc *wrf;
typedef struct union_slots { typedef struct union_slots {
Int old; Int old;
@ -117,7 +117,8 @@ static void putAtom(Atom, int, struct write_globs *);
static void writeTerm(Term, int, int, int, struct write_globs *, static void writeTerm(Term, int, int, int, struct write_globs *,
struct rewind_term *); struct rewind_term *);
#define wrputc(WF, X) (X)->stream_wputc(X-GLOBAL_Stream, WF) /* writes a character */ #define wrputc(WF, X) \
(X)->stream_wputc(X - GLOBAL_Stream, WF) /* writes a character */
/* /*
protect bracket from merging with previoous character. protect bracket from merging with previoous character.
@ -181,10 +182,10 @@ static void wrputn(Int n,
protect_close_number(wglb, ob); protect_close_number(wglb, ob);
} }
inline static void inline static void wrputs(char *s, StreamDesc *stream) {
wrputs(char *s, StreamDesc *stream) {
int c; int c;
while ((c = *s++)) wrputc(c, stream); while ((c = *s++))
wrputc(c, stream);
} }
static void wrputws(wchar_t *s, wrf stream) /* writes a string */ static void wrputws(wchar_t *s, wrf stream) /* writes a string */
@ -294,9 +295,9 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
{ {
#if THREADS #if THREADS
char s[256]; char s[256];
#endif #endif
wrf stream = wglb->stream; wrf stream = wglb->stream;
int sgn; int sgn;
int ob; int ob;
@ -375,27 +376,28 @@ static void wrputf(Float f, struct write_globs *wglb) /* writes a float */
wrputc(' ', stream); wrputc(' ', stream);
} }
/* use SWI's format_float */ /* use SWI's format_float */
sprintf(buf, (char *)floatFormat(),f); sprintf(buf, (char *)floatFormat(), f);
wrputs(buf, stream); wrputs(buf, stream);
#endif #endif
protect_close_number(wglb, ob); protect_close_number(wglb, ob);
} }
int Yap_FormatFloat(Float f, char **s, size_t sz) { int Yap_FormatFloat(Float f, char **s, size_t sz) {
CACHE_REGS CACHE_REGS
struct write_globs wglb; struct write_globs wglb;
int sno; int sno;
char *so; char *so;
sno = Yap_open_buf_write_stream(*s, sz, &GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0); sno = Yap_open_buf_write_stream(
if (sno < 0) *s, sz, &GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0);
if (sno < 0)
return FALSE; return FALSE;
wglb.stream = GLOBAL_Stream+sno; wglb.stream = GLOBAL_Stream + sno;
wrputf(f, &wglb); wrputf(f, &wglb);
so = Yap_MemExportStreamPtr(sno); so = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno); Yap_CloseStream(sno);
*s = so; *s = so;
return TRUE; return TRUE;
} }
@ -420,11 +422,11 @@ static int wrputblob(AtomEntry *ref, int Quote_illegal,
struct write_globs *wglb) { struct write_globs *wglb) {
wrf stream = wglb->stream; wrf stream = wglb->stream;
int rc; int rc;
int Yap_write_blob(AtomEntry *ref, StreamDesc *stream); int Yap_write_blob(AtomEntry * ref, StreamDesc * stream);
if ((rc = Yap_write_blob(ref, stream))) { if ((rc = Yap_write_blob(ref, stream))) {
return rc; return rc;
} }
lastw = alphanum; lastw = alphanum;
return 1; return 1;
} }
@ -485,7 +487,8 @@ static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
wrputc('\'', stream); /* be careful about quotes */ wrputc('\'', stream); /* be careful about quotes */
return; return;
} }
if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' && ch != '`') { if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' &&
ch != '`') {
wrputc(ch, stream); wrputc(ch, stream);
} else { } else {
switch (ch) { switch (ch) {
@ -557,7 +560,7 @@ static void write_string(const unsigned char *s,
{ {
StreamDesc *stream = wglb->stream; StreamDesc *stream = wglb->stream;
utf8proc_int32_t chr, qt; utf8proc_int32_t chr, qt;
unsigned char *ptr = (unsigned char *) s; unsigned char *ptr = (unsigned char *)s;
if (wglb->Write_strings) if (wglb->Write_strings)
qt = '`'; qt = '`';
@ -565,7 +568,7 @@ static void write_string(const unsigned char *s,
qt = '"'; qt = '"';
wrputc(qt, stream); wrputc(qt, stream);
do { do {
ptr += get_utf8(ptr, &chr); ptr += get_utf8(ptr, &chr);
if (chr == '\0') if (chr == '\0')
break; break;
write_quoted(chr, qt, stream); write_quoted(chr, qt, stream);
@ -880,7 +883,7 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
struct rewind_term nrwt; struct rewind_term nrwt;
nrwt.parent = rwt; nrwt.parent = rwt;
nrwt.u_sd.s.ptr = 0; nrwt.u_sd.s.ptr = 0;
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) { if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
putAtom(Atom3Dots, wglb->Quote_illegal, wglb); putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
return; return;
@ -911,10 +914,10 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
EX = oEX; EX = oEX;
return; return;
} }
if (wglb->Use_portray) if (wglb->Use_portray)
if (callPortray(t, &EX, wglb->stream-GLOBAL_Stream PASS_REGS)) { if (callPortray(t, &EX, wglb->stream - GLOBAL_Stream PASS_REGS)) {
EX = oEX; EX = oEX;
return; return;
} }
if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) { if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) {
putString(t, wglb); putString(t, wglb);
@ -986,8 +989,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} }
#endif #endif
if (wglb->Use_portray) { if (wglb->Use_portray) {
if (callPortray(t, &EX, wglb->stream-GLOBAL_Stream PASS_REGS)) { if (callPortray(t, &EX, wglb->stream - GLOBAL_Stream PASS_REGS)) {
EX = oEX; EX = oEX;
return; return;
} }
} }
@ -1200,7 +1203,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
EX = oEX; EX = oEX;
} }
void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int priority) void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
int priority)
/* term to be written */ /* term to be written */
/* consumer */ /* consumer */
/* write options */ /* write options */
@ -1208,11 +1212,11 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio
CACHE_REGS CACHE_REGS
struct write_globs wglb; struct write_globs wglb;
struct rewind_term rwt; struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot(PASS_REGS1); yhandle_t sls = Yap_CurrentSlot(PASS_REGS1);
if (!mywrite) { if (!mywrite) {
CACHE_REGS CACHE_REGS
wglb.stream = GLOBAL_Stream+LOCAL_c_error_stream; wglb.stream = GLOBAL_Stream + LOCAL_c_error_stream;
} else } else
wglb.stream = mywrite; wglb.stream = mywrite;
wglb.lw = start; wglb.lw = start;
@ -1246,30 +1250,27 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, int prio
} }
} }
restore_from_write(&rwt, &wglb); restore_from_write(&rwt, &wglb);
Yap_CloseSlots( sls ); Yap_CloseSlots(sls);
} }
char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length,
char * encoding_t *encp, int flags) {
Yap_TermToString(Term t, char *s, size_t sz, size_t *length, encoding_t *encp, int flags)
{
CACHE_REGS CACHE_REGS
int sno = Yap_open_buf_write_stream(s, sz, encp, flags); int sno = Yap_open_buf_write_stream(s, sz, encp, flags);
int old_output_stream = LOCAL_c_output_stream; int old_output_stream = LOCAL_c_output_stream;
if (sno < 0) if (sno < 0)
return NULL; return NULL;
LOCAL_c_output_stream = sno; LOCAL_c_output_stream = sno;
if (encp) if (encp)
GLOBAL_Stream[sno].encoding = *encp; GLOBAL_Stream[sno].encoding = *encp;
else else
GLOBAL_Stream[sno].encoding = LOCAL_encoding; GLOBAL_Stream[sno].encoding = LOCAL_encoding;
Yap_plwrite (t, GLOBAL_Stream+sno, 0, flags, 1200); Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, 1200);
s = Yap_MemExportStreamPtr( sno ); s = Yap_MemExportStreamPtr(sno);
Yap_CloseStream( sno ); Yap_CloseStream(sno);
LOCAL_c_output_stream = old_output_stream; LOCAL_c_output_stream = old_output_stream;
if ( EX == 0 ) return s; if (EX == 0)
return s;
return NULL; return NULL;
} }