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

Merge ssh://ssh.dcc.fc.up.pt:31064/home/vsc/yap

Browse Source
This commit is contained in:
Vitor Santos Costa
2019-04-02 11:23:39 +01:00
parent 644a9ad852 63a514cad5
commit f54989e03e
185 changed files with 6604 additions and 8824 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
C/absmi.c
View File

@@ -916,24 +916,26 @@ static int interrupt_dexecute(USES_REGS1) {
static void undef_goal(USES_REGS1) {
PredEntry *pe = PredFromDefCode(P);
BEGD(d0);
/* avoid trouble with undefined dynamic procedures */
/* I assume they were not locked beforehand */
#if defined(YAPOR) || defined(THREADS)
/* avoid trouble with undefined dynamic procedures */
/* I assume they were not locked beforehand */
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
PELOCK(19, pe);
PP = pe;
}
#endif
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) {
BACKUP_MACHINE_REGS();
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) {
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);
PP = NULL;
#endif
CalculateStackGap(PASS_REGS1);
P = FAILCODE;
RECOVER_MACHINE_REGS();
return;
}
#if DEBUG
if (UndefCode == NULL || UndefCode->OpcodeOfPred == UNDEF_OPCODE) {
fprintf(stderr,"call to undefined Predicates %s ->", IndicatorOfPred(pe));
Yap_DebugPlWriteln(ARG1);
@@ -946,16 +948,28 @@ static void undef_goal(USES_REGS1) {
#endif
CalculateStackGap(PASS_REGS1);
P = FAILCODE;
RECOVER_MACHINE_REGS();
return;
}
#endif
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);
PP = NULL;
#endif
if (pe->ArityOfPE == 0) {
d0 = MkAtomTerm((Atom)(pe->FunctorOfPred));
#endif
CELL o = AbsPair(HR);
if (pe->ModuleOfPred == PROLOG_MODULE) {
if (CurrentModule == PROLOG_MODULE)
HR[0] = TermProlog;
else
HR[0] = CurrentModule;
} else {
d0 = AbsAppl(HR);
HR[0] = Yap_Module_Name(pe);
}
HR += 2;
if (pe->ArityOfPE == 0) {
HR[-1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
} else {
HR[-1] = AbsAppl(HR);
*HR++ = (CELL)pe->FunctorOfPred;
CELL *ip=HR;
UInt imax = pe->ArityOfPE;
@@ -984,30 +998,20 @@ static void undef_goal(USES_REGS1) {
ENDD(d1);
}
}
ARG1 = AbsPair(HR);
HR[1] = d0;
ENDD(d0);
if (pe->ModuleOfPred == PROLOG_MODULE) {
if (CurrentModule == PROLOG_MODULE)
HR[0] = TermProlog;
else
HR[0] = CurrentModule;
} else {
HR[0] = Yap_Module_Name(pe);
}
ARG2 = Yap_getUnknownModule(Yap_GetModuleEntry(HR[0]));
HR += 2;
ARG1 = o;
ARG2 = MkVarTerm();
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred, UndefCode, XREGS + 1);
#endif /* LOW_LEVEL_TRACE */
P = UndefCode->CodeOfPred;
RECOVER_MACHINE_REGS();
}
static void spy_goal(USES_REGS1) {
PredEntry *pe = PredFromDefCode(P);
BACKUP_MACHINE_REGS();
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
PELOCK(14, pe);
@@ -1027,6 +1031,7 @@ static void spy_goal(USES_REGS1) {
PP = NULL;
}
#endif
RECOVER_MACHINE_REGS();
return;
}
}
@@ -1044,6 +1049,7 @@ static void spy_goal(USES_REGS1) {
}
#endif
Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, "");
RECOVER_MACHINE_REGS();
return;
}
LOCAL_PredEntriesCounter--;
@@ -1055,6 +1061,7 @@ static void spy_goal(USES_REGS1) {
}
#endif
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
RECOVER_MACHINE_REGS();
return;
}
if ((pe->PredFlags & (CountPredFlag | ProfiledPredFlag | SpiedPredFlag)) ==
@@ -1066,6 +1073,7 @@ static void spy_goal(USES_REGS1) {
}
#endif
P = pe->cs.p_code.TrueCodeOfPred;
RECOVER_MACHINE_REGS();
return;
}
}
@@ -1084,6 +1092,7 @@ static void spy_goal(USES_REGS1) {
PP = NULL;
}
#endif
RECOVER_MACHINE_REGS();
return;
}
}
@@ -1153,6 +1162,7 @@ static void spy_goal(USES_REGS1) {
low_level_trace(enter_pred, pt0, XREGS + 1);
#endif /* LOW_LEVEL_TRACE */
}
RECOVER_MACHINE_REGS();
}
Int Yap_absmi(int inp) {

4
C/adtdefs.c
View File

@@ -1296,6 +1296,10 @@ Atom Yap_LookupAtomWithLength(const char *atom,
at = NameOfFunctor(pe->FunctorOfPred);
}
}
if (pe->ModuleOfPred == PROLOG_MODULE || pe->ModuleOfPred == USER_MODULE)
snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s/" UInt_FORMAT,
RepAtom(at)->StrOfAE, arity);
else
snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s:%s/" UInt_FORMAT, mods,
RepAtom(at)->StrOfAE, arity);
return LOCAL_FileNameBuf;

11
C/arrays.c
View File

@@ -1066,6 +1066,7 @@ static Int create_static_array(USES_REGS1) {
Int size;
static_array_types props;
void *address = NULL;
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR, ti, "create static array");
@@ -1134,7 +1135,15 @@ static Int create_static_array(USES_REGS1) {
props = array_of_terms;
if (args[CREATE_ARRAY_NB_TERM].used)
props = array_of_nb_terms;
/* if (args[CREATE_ARRAY_MATRIX].used) {
tprops = args[CREATE_ARRAY_TYPE].tvalue;
if (tprops == TermTrue) {
in_matrix = true;
size += sizeof(MP_INT)/sizeof(CELL);
}
}
*/
StaticArrayEntry *pp;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "create static array");

14
C/atomic.c
View File

@@ -950,7 +950,8 @@ restart_aux:
ot = ARG1;
} else if (g3) {
Int len = Yap_AtomToUnicodeLength(t3 PASS_REGS);
if (len <= 0) {
if (len < 0) {
Yap_ThrowError(-len,ARG3,"atom_concat(-X,-Y,+atom:Z");
cut_fail();
}
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);
@@ -1340,6 +1341,7 @@ restart_aux:
while (t1 != TermNil) {
inpv[i].type = YAP_STRING_ATOM, inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}
@@ -1388,6 +1390,7 @@ restart_aux:
while (t1 != TermNil) {
inpv[i].type = YAP_STRING_STRING;
inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}
@@ -1427,8 +1430,6 @@ restart_aux:
if (*tailp != TermNil) {
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else {
seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t));
seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t));
int i = 0;
Atom at;
@@ -1437,6 +1438,8 @@ restart_aux:
pop_text_stack(l);
return rc;
}
seq_tv_t *inpv = (seq_tv_t *)Malloc(n * sizeof(seq_tv_t));
seq_tv_t *out = (seq_tv_t *)Malloc(sizeof(seq_tv_t));
if (!inpv) {
LOCAL_Error_TYPE = RESOURCE_ERROR_HEAP;
goto error;
@@ -1447,6 +1450,7 @@ restart_aux:
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_CHARS |
YAP_STRING_CODES;
inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}
@@ -1463,6 +1467,7 @@ restart_aux:
}
error:
/* Error handling */
pop_text_stack(l);
if (LOCAL_Error_TYPE && Yap_HandleError("atom_concat/3")) {
goto restart_aux;
}
@@ -1493,6 +1498,7 @@ restart_aux:
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}
@@ -1542,10 +1548,12 @@ restart_aux:
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = HeadOfTerm(t1);
inpv[i].enc = ENC_ISO_UTF8;
i++;
inpv[i].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT |
YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM;
inpv[i].val.t = t2;
inpv[i].enc = ENC_ISO_UTF8;
i++;
t1 = TailOfTerm(t1);
}

44
C/c_interface.c
View File

@@ -421,8 +421,25 @@ X_API void *YAP_BlobOfTerm(Term t) {
if (IsVarTerm(t))
return NULL;
if (!IsBigIntTerm(t))
if (!IsBigIntTerm(t)) {
if (IsAtomTerm(t)) {
AtomEntry *ae = RepAtom(AtomOfTerm(t));
StaticArrayEntry *pp;
READ_LOCK(ae->ARWLock);
pp = RepStaticArrayProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
pp = RepStaticArrayProp(pp->NextOfPE);
if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
READ_UNLOCK(ae->ARWLock);
return NULL;
} else {
READ_UNLOCK(ae->ARWLock);
return pp->ValueOfVE.ints;
}
}
return NULL;
}
src = (MP_INT *)(RepAppl(t) + 2);
return (void *)(src + 1);
}
@@ -1725,6 +1742,7 @@ X_API YAP_PredEntryPtr YAP_AtomToPredInModule(YAP_Atom at, Term mod) {
return RepPredProp(PredPropByAtom(at, mod));
}
/*
static int run_emulator(USES_REGS1) {
int out;
@@ -1732,6 +1750,7 @@ static int run_emulator(USES_REGS1) {
LOCAL_PrologMode |= UserCCallMode;
return out;
}
*/
X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
CACHE_REGS
@@ -2107,7 +2126,9 @@ X_API void YAP_ClearExceptions(void) {
X_API int YAP_InitConsult(int mode, const char *fname, char **full,
int *osnop) {
CACHE_REGS
int sno;
int sno;
int lvl = push_text_stack();
BACKUP_MACHINE_REGS();
const char *fl = NULL;
if (mode == YAP_BOOT_MODE) {
@@ -2124,8 +2145,6 @@ X_API int YAP_InitConsult(int mode, const char *fname, char **full,
}
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "done init_ consult %s ",fl);
int lvl = push_text_stack();
char *d = Malloc(strlen(fl) + 1);
strcpy(d, fl);
bool consulted = (mode == YAP_CONSULT_MODE);
@@ -2134,9 +2153,9 @@ int lvl = push_text_stack();
LOCAL_encoding);
__android_log_print(
ANDROID_LOG_INFO, "YAPDroid", "OpenStream got %d ",sno);
pop_text_stack(lvl);
if (sno < 0 || !Yap_ChDir(dirname((char *)d))) {
*full = NULL;
pop_text_stack(lvl);
return -1;
}
LOCAL_PrologMode = UserMode;
@@ -2200,7 +2219,15 @@ X_API Term YAP_ReadFromStream(int sno) {
Term o;
BACKUP_MACHINE_REGS();
sigjmp_buf signew;
if (sigsetjmp(signew, 0)) {
Yap_syntax_error(LOCAL_toktide, sno, "ReadFromStream");
RECOVER_MACHINE_REGS();
return 0;
} else {
o = Yap_read_term(sno, TermNil, false);
}
RECOVER_MACHINE_REGS();
return o;
}
@@ -2210,8 +2237,10 @@ X_API Term YAP_ReadClauseFromStream(int sno, Term vs, Term pos) {
BACKUP_MACHINE_REGS();
Term t = Yap_read_term(
sno,
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs),
MkPairTerm(Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1),
MkPairTerm(
Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &vs),
MkPairTerm(
Yap_MkApplTerm(Yap_MkFunctor(AtomTermPosition, 1),
1, &pos),
TermNil)),
true);
@@ -2268,6 +2297,7 @@ X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) {
}
}
}
return out.val.c = pop_output_text_stack(l,buf);
}
/// write a a term to n user-provided buffer: make sure not tp

165
C/cdmgr.c
View File

@@ -74,6 +74,49 @@ static void kill_first_log_iblock(LogUpdIndex *, LogUpdIndex *, PredEntry *);
#define PredArity(p) (p->ArityOfPE)
#define TRYCODE(G, F, N) ((N) < 5 ? (op_numbers)((int)F + (N)*3) : G)
PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) {
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
return ap;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
t = Yap_MkApplTerm(FunctorCsult, 1, &t);
goto restart;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
goto restart;
}
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap;
} else {
Yap_ThrowError(TYPE_ERROR_CALLABLE, t0, pname);
}
return NULL;
}
static void InitConsultStack(void) {
CACHE_REGS
LOCAL_ConsultLow = (consult_obj *)Yap_AllocCodeSpace(sizeof(consult_obj) *
@@ -120,47 +163,6 @@ bool Yap_Consulting(USES_REGS1) {
* assertz are supported for static predicates no database predicates are
* supportted for fast predicates
*/
PredEntry *Yap_get_pred(Term t, Term tmod, const char *pname) {
Term t0 = t;
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
return ap;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) {
t = Yap_MkApplTerm(FunctorCsult, 1, &t);
goto restart;
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
goto restart;
}
PredEntry *ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
return ap;
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t0, pname);
}
return NULL;
}
/** Look for a predicate with same functor as t,
create a new one of it cannot find it.
@@ -179,7 +181,7 @@ restart:
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
@@ -349,7 +351,7 @@ static void split_megaclause(PredEntry *ap) {
mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
if (mcl->ClFlags & ExoMask) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, TermNil,
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap),
"while deleting clause from exo predicate %s/%d\n",
RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,
ap->ArityOfPE);
@@ -1469,34 +1471,30 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) {
}
static yamop *addcl_permission_error(const char *file, const char *function,
int lineno, AtomEntry *ap, Int Arity,
int lineno, PredEntry *ap,
int in_use) {
CACHE_REGS
Term culprit;
if (Arity == 0)
culprit = MkAtomTerm(AbsAtom(ap));
else
culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap), Arity), Arity);
return (in_use
? (Arity == 0
Term culprit = Yap_PredicateToIndicator( ap);
return in_use
? (ap->ArityOfPE == 0
? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "static predicate %s is in use",
ap->StrOfAE)
NameOfPred(ap)->StrOfAE)
: Yap_Error__(
false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s/" Int_FORMAT " is in use",
ap->StrOfAE, Arity))
: (Arity == 0
NameOfPred(ap), ap->ArityOfPE))
: (ap->ArityOfPE == 0
? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s is in use",
ap->StrOfAE)
NameOfPred(ap)->StrOfAE)
: Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s/" Int_FORMAT,
ap->StrOfAE, Arity)));
NameOfPred(ap)->StrOfAE, ap->ArityOfPE));
}
PredEntry *Yap_PredFromClause(Term t USES_REGS) {
@@ -1756,7 +1754,7 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
PELOCK(20, p);
/* we are redefining a prolog module predicate */
if (Yap_constPred(p)) {
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, p,
FALSE);
UNLOCKPE(30, p);
return false;
@@ -2118,6 +2116,7 @@ static Int p_startconsult(USES_REGS1) { /* '$start_consult'(+Mode) */
char *smode = RepAtom(AtomOfTerm(Deref(ARG1)))->StrOfAE;
int mode;
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomTrue);
mode = strcmp("consult", (char *)smode);
Yap_init_consult(mode, RepAtom(AtomOfTerm(Deref(ARG2)))->StrOfAE);
t = MkIntTerm(LOCAL_consult_level);
@@ -2141,6 +2140,7 @@ static void end_consult(USES_REGS1) {
/* if (LOCAL_consult_level == 0)
do_toggle_static_predicates_in_use(FALSE);*/
#endif
setBooleanLocalPrologFlag(COMPILING_FLAG, AtomFalse);
}
void Yap_end_consult(void) {
@@ -2193,7 +2193,7 @@ static Int p_purge_clauses(USES_REGS1) { /* '$purge_clauses'(+Func) */
PELOCK(21, pred);
if (pred->PredFlags & StandardPredFlag) {
UNLOCKPE(33, pred);
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t, "assert/1");
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_TermToIndicator(CurrentModule, t), "assert/1");
return (FALSE);
}
purge_clauses(pred);
@@ -2433,36 +2433,29 @@ static Int
}
/* @pred '$new_multifile'(+G,+Mod)
* declares rgi/////// the multi-file flag
* declares the multi-file flag
* */
static Int new_multifile(USES_REGS1) {
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MultiFileFlag) {
UNLOCKPE(26, pe);
return true;
}
if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
@@ -2543,7 +2536,7 @@ static Int
// if (!pe) pe = Yap_get_pred(t1, Deref(ARG2), "system_predicate");
if (EndOfPAEntr(pe))
return FALSE;
return (pe->ModuleOfPred == 0);
return (pe->ModuleOfPred == 0 || pe-> PredFlags & UserCPredFlag);
// return true;
// PELOCK(27, pe);
// out = (pe->PredFlags & SystemPredFlags);
@@ -2680,24 +2673,17 @@ static Int p_set_owner_file(USES_REGS1) { /* '$owner_file'(+P,M,F) */
static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "dynamic");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags &
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
UNLOCKPE(30, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
@@ -2711,7 +2697,7 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
}
if (pe->cs.p_code.NOfClauses != 0) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
@@ -2738,23 +2724,16 @@ static Int p_is_dynamic(USES_REGS1) { /* '$is_dynamic'(+P) */
return (out);
}
/* @pred '$new_multifile'(+G,+Mod)
/* @pred '$new_meta'(+G,+Mod)
* sets the multi-file flag
* */
static Int new_meta_pred(USES_REGS1) {
PredEntry *pe;
Atom at;
arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate");
if (EndOfPAEntr(pe))
return false;
PELOCK(30, pe);
arity = pe->ArityOfPE;
if (arity == 0)
at = (Atom)pe->FunctorOfPred;
else
at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MetaPredFlag) {
UNLOCKPE(26, pe);
@@ -2762,7 +2741,7 @@ static Int new_meta_pred(USES_REGS1) {
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, pe,
FALSE);
return false;
}
@@ -2856,10 +2835,14 @@ static Int undefp_handler(USES_REGS1) { /* '$undefp_handler'(P,Mod) */
PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "undefined/1");
if (EndOfPAEntr(pe))
return false;
PELOCK(59, pe);
if (EndOfPAEntr(pe)) {
UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def");
UNLOCKPE(59, pe);
return false;
}
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
UndefCode = Yap_get_pred(TermFail, MkIntTerm(0), "no def");
UNLOCKPE(59, pe);
return false;
}
@@ -4106,7 +4089,7 @@ static Int
| TabledPredFlag
#endif /* TABLING */
)) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t,
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, Yap_PredicateToIndicator(ap),
"dbload_get_space/4");
return FALSE;
}

5
C/cmppreds.c
View File

@@ -728,7 +728,7 @@ static Int p_acomp(USES_REGS1) { /* $a_compare(?R,+X,+Y) */
The value of the expression _X_ is equal to the value of expression _Y_.
*/
/// @memberof =:=/2
static Int a_eq(Term t1, Term t2) {
CACHE_REGS
/* A =:= B */
@@ -769,7 +769,6 @@ static Int a_eq(Term t1, Term t2) {
The value of the expression _X_ is different from the value of expression
_Y_.
*/
/// @memberof =\\=/2
static Int a_dif(Term t1, Term t2) {
CACHE_REGS
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
@@ -809,7 +808,6 @@ static Int a_ge(Term t1, Term t2) { /* A >= B */
The value of the expression _X_ is less than the value of expression
_Y_.
*/
/// @memberof </2
static Int a_lt(Term t1, Term t2) { /* A < B */
CACHE_REGS
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);
@@ -825,7 +823,6 @@ static Int a_lt(Term t1, Term t2) { /* A < B */
The value of the expression _X_ is less than or equal to the value
of expression _Y_.
*/
/// @memberof =</2
static Int a_le(Term t1, Term t2) { /* A <= B */
CACHE_REGS
Int out = a_cmp(Deref(t1), Deref(t2) PASS_REGS);

5
C/dbase.c
View File

@@ -3977,6 +3977,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) {
ap->cs.p_code.LastClause = clau->ClPrev->ClCode;
}
}
clau->ClTimeEnd = ap->TimeStampOfPred;
ap->cs.p_code.NOfClauses--;
}
#ifndef THREADS
@@ -4000,7 +4001,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) {
if (ap->cs.p_code.NOfClauses > 1) {
if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
Yap_UpdateTimestamps(ap);
++ap->TimeStampOfPred;
++(ap->TimeStampOfPred);
/* fprintf(stderr,"-
* %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
ap->LastCallOfPred = LUCALL_RETRACT;
@@ -4017,7 +4018,7 @@ static void EraseLogUpdCl(LogUpdClause *clau) {
ap->LastCallOfPred = LUCALL_ASSERT;
}
}
clau->ClTimeEnd = ap->TimeStampOfPred;
//clau->ClTimeEnd = ap->TimeStampOfPred;
Yap_RemoveClauseFromIndex(ap, clau->ClCode);
/* release the extra reference */
}

112
C/errors.c
View File

@@ -41,8 +41,8 @@
#define set_key_i(k, ks, q, i, t) \
if (strcmp(ks, q) == 0) { \
i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \
return IsIntegerTerm(t); \
i->k = IsIntegerTerm(t) ? IntegerOfTerm(t) : 0; \
return IsIntegerTerm(t); \
}
#define set_key_s(k, ks, q, i, t) \
@@ -99,7 +99,7 @@ if (strcmp(ks, q) == 0) { \
#define query_key_s(k, ks, q, i) \
if (strcmp(ks, q) == 0 ) \
{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermNil; }
{ if (i->k) return MkAtomTerm(Yap_LookupAtom(i->k)); else return TermEmptyAtom; }
#define query_key_t(k, ks, q, i) \
@@ -107,6 +107,9 @@ if (strcmp(ks, q) == 0 ) \
if (i->k == NULL) return TermNil; \
Term t; if((t = Yap_BufferToTerm(i->k, TermNil) ) == 0 ) return TermNil; return t; }
static yap_error_descriptor_t *CopyException(yap_error_descriptor_t *t);
static Term queryErr(const char *q, yap_error_descriptor_t *i) {
query_key_i(errorNo, "errorNo", q, i);
query_key_i(errorClass, "errorClass", q, i);
@@ -296,10 +299,11 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
va_list ap;
va_start(ap, t);
const char *fmt;
char tmpbuf[MAXPATHLEN];
char *tmpbuf=NULL;
fmt = va_arg(ap, char *);
if (fmt != NULL) {
tmpbuf = malloc(MAXPATHLEN);
#if HAVE_VSNPRINTF
vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
#else
@@ -318,7 +322,7 @@ void Yap_InitError__(const char *file, const char *function, int lineno,
LOCAL_ActiveError->errorFile = NULL;
LOCAL_ActiveError->errorFunction = NULL;
LOCAL_ActiveError->errorLine = 0;
if (fmt) {
if (fmt && tmpbuf) {
LOCAL_Error_Size = strlen(tmpbuf);
LOCAL_ActiveError->errorMsg = malloc(LOCAL_Error_Size + 1);
strcpy((char *)LOCAL_ActiveError->errorMsg, tmpbuf);
@@ -331,15 +335,17 @@ bool Yap_PrintWarning(Term twarning) {
CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
if (twarning)
__android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)",
Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Ignore_cyclics_f));
Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
bool rc;
Term ts[2], err;
if (LOCAL_PrologMode & InErrorMode && LOCAL_ActiveError &&
if (twarning && LOCAL_PrologMode & InErrorMode &&
LOCAL_ActiveError->errorClass != WARNING &&
(err = LOCAL_ActiveError->errorNo)) {
(err = LOCAL_ActiveError->errorNo) ) {
fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
Yap_TermToBuffer(twarning,
Quote_illegal_f | Ignore_ops_f),
@@ -351,18 +357,23 @@ bool Yap_PrintWarning(Term twarning) {
fprintf(stderr, "%s:%ld/* d:%d warning */:\n",
LOCAL_ActiveError->errorFile,
LOCAL_ActiveError->errorLine, 0 );
if (!twarning)
twarning = Yap_MkFullError();
Yap_DebugPlWriteln(twarning);
LOCAL_DoingUndefp = false;
LOCAL_PrologMode &= ~InErrorMode;
CurrentModule = cmod;
return false;
}
if (!twarning)
twarning = Yap_MkFullError();
ts[1] = twarning;
ts[0] = MkAtomTerm(AtomWarning);
rc = Yap_execute_pred(pred, ts, true PASS_REGS);
LOCAL_within_print_message = false;
LOCAL_PrologMode &= ~InErrorMode;
return rc;
}
bool Yap_HandleError__(const char *file, const char *function, int lineno,
@@ -415,7 +426,7 @@ bool Yap_HandleError__(const char *file, const char *function, int lineno,
return false;
}
default:
if (LOCAL_PrologMode == UserMode)
Yap_ThrowError__(file, function, lineno, err, LOCAL_RawTerm, serr);
else
@@ -605,7 +616,6 @@ yap_error_descriptor_t *Yap_popErrorContext(bool mdnew, bool pass) {
memmove(ep, e, sizeof(*e));
ep->top_error = epp;
}
free(e);
return LOCAL_ActiveError;
}
/**
@@ -654,7 +664,7 @@ void Yap_ThrowExistingError(void) {
Term Yap_MkFullError(void)
{
yap_error_descriptor_t *i = Yap_local.ActiveError;
yap_error_descriptor_t *i = CopyException(Yap_local.ActiveError);
i->errorAsText = Yap_errorName( i->errorNo );
i->errorClass = Yap_errorClass( i-> errorNo );
i->classAsText = Yap_errorClassName(i->errorClass);
@@ -751,7 +761,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
CACHE_REGS
va_list ap;
char *fmt;
char s[MAXPATHLEN];
char *s = NULL;
switch (type) {
case SYSTEM_ERROR_INTERNAL: {
@@ -827,6 +838,7 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
va_start(ap, where);
fmt = va_arg(ap, char *);
if (fmt != NULL) {
s = malloc(MAXPATHLEN);
#if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap);
#else
@@ -876,7 +888,8 @@ yamop *Yap_Error__(bool throw, const char *file, const char *function,
if (LOCAL_DoingUndefp) {
LOCAL_DoingUndefp = false;
LOCAL_Signals = 0;
Yap_PrintWarning(MkErrorTerm(Yap_GetException(LOCAL_ActiveError)));
yap_error_descriptor_t *co = CopyException( LOCAL_ActiveError );
Yap_PrintWarning(MkErrorTerm(Yap_GetException( co )));
return P;
}
// LOCAL_ActiveError = Yap_GetException();
@@ -999,7 +1012,7 @@ bool Yap_RaiseException(void) {
bool Yap_ResetException(yap_error_descriptor_t *i) {
// reset error descriptor
if (!i)
return true;
i = LOCAL_ActiveError;
yap_error_descriptor_t *bf = i->top_error;
memset(i, 0, sizeof(*i));
i->top_error = bf;
@@ -1008,6 +1021,7 @@ bool Yap_ResetException(yap_error_descriptor_t *i) {
static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
Term MkErrorTerm(yap_error_descriptor_t *t) {
if (t->errorClass == EVENT)
return t->errorRawTerm;
@@ -1019,6 +1033,13 @@ Term MkErrorTerm(yap_error_descriptor_t *t) {
err2list(t));
}
static yap_error_descriptor_t *CopyException(yap_error_descriptor_t *t) {
yap_error_descriptor_t *n = malloc( sizeof( yap_error_descriptor_t ));
memcpy(n, t, sizeof( yap_error_descriptor_t ) );
return n;
}
static Int read_exception(USES_REGS1) {
yap_error_descriptor_t *t = AddressOfTerm(Deref(ARG1));
Term rc = MkErrorTerm(t);
@@ -1030,6 +1051,13 @@ static Int print_exception(USES_REGS1) {
Term t1 = Deref(ARG1);
if (IsAddressTerm(t1)) {
yap_error_descriptor_t *t = AddressOfTerm(t1);
if (t->parserFile && t->parserLine) {
fprintf(stderr,"\n%s:%ld:0 error: while parsing %s\n\n", t->parserFile, t->parserLine,t->errorAsText);
} else if (t->prologPredFile && t->prologPredLine) {
fprintf(stderr,"\n%s:%ld:0 error: while running %s\n\n", t->prologPredFile, t->prologPredLine,t->errorAsText);
} else if (t->errorFile && t->errorLine) {
fprintf(stderr,"\n%s:%ld:0 error: while executing %s\n\n", t->errorFile, t->errorLine,t->errorAsText);
}
printErr(t);
} else {
return Yap_WriteTerm(LOCAL_c_error_stream,t1,TermNil PASS_REGS);
@@ -1258,15 +1286,28 @@ static Int is_callable(USES_REGS1) {
return false;
}
static Int is_predicate_indicator(USES_REGS1) {
/**
* @pred is_predicate_indicator( Term, Module, Name, Arity )
*
* This predicates can be used to verify if Term is a predicate indicator, that is of the form:
* + Name/Arity
* + Name//Arity-2
* + Module:Name/Arity
* + Module:Name//Arity-2
*
* if it is, it will extract the predicate's module, name, and arity.
*
* Note: this will now accept both mod:(a/n) and
* (mod:a)/n as valid.
*/
static Int get_predicate_indicator(USES_REGS1) {
Term G = Deref(ARG1);
// Term Context = Deref(ARG2);
Term mod = CurrentModule;
G = Yap_YapStripModule(G, &mod);
if (IsVarTerm(G)) {
Yap_Error(INSTANTIATION_ERROR, G, NULL);
return false;
Yap_ThrowError(INSTANTIATION_ERROR, G, NULL);
}
if (!IsVarTerm(mod) && !IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, G, NULL);
@@ -1275,13 +1316,35 @@ static Int is_predicate_indicator(USES_REGS1) {
if (IsApplTerm(G)) {
Functor f = FunctorOfTerm(G);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
}
if (f == FunctorSlash || f == FunctorDoubleSlash) {
return true;
Term name = ArgOfTerm(1,G), arity = ArgOfTerm(2,G);
name = Yap_YapStripModule (name, &mod);
if (IsVarTerm(name)) {
Yap_ThrowError(INSTANTIATION_ERROR, name, NULL);
} else if (!IsAtomTerm(name)) {
Yap_ThrowError(TYPE_ERROR_ATOM, name, NULL);
}
if (IsVarTerm(arity)) {
Yap_ThrowError(INSTANTIATION_ERROR, arity, NULL);
} else if (!IsIntegerTerm(arity)) {
Yap_ThrowError(TYPE_ERROR_INTEGER, arity, NULL);
} else {
Int ar = IntegerOfTerm(arity);
if (ar < 0) {
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, arity, NULL);
}
if ( f == FunctorDoubleSlash) {
arity = MkIntegerTerm(ar+2);
}
return Yap_unify(mod, ARG2) &&
Yap_unify(name, ARG3) &&
Yap_unify(arity, ARG4);
}
}
}
}
Yap_Error(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
Yap_ThrowError(TYPE_ERROR_PREDICATE_INDICATOR, G, NULL);
return false;
}
@@ -1296,9 +1359,8 @@ void Yap_InitErrorPreds(void) {
Yap_InitCPred("$query_exception", 3, query_exception, 0);
Yap_InitCPred("$drop_exception", 1, drop_exception, 0);
Yap_InitCPred("$close_error", 0, close_error, HiddenPredFlag);
Yap_InitCPred("is_boolean", 2, is_boolean, TestPredFlag);
Yap_InitCPred("is_callable", 2, is_callable, TestPredFlag);
Yap_InitCPred("is_atom", 2, is_atom, TestPredFlag);
Yap_InitCPred("is_predicate_indicator", 2, is_predicate_indicator,
TestPredFlag);
Yap_InitCPred("is_boolean", 1, is_boolean, TestPredFlag);
Yap_InitCPred("is_callable", 1, is_callable, TestPredFlag);
Yap_InitCPred("is_atom", 1, is_atom, TestPredFlag);
Yap_InitCPred("get_predicate_indicator", 4, get_predicate_indicator, 0);
}

206
C/exec.c
View File

@@ -115,14 +115,18 @@ static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt,
inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
// we have a creep requesr waiting
ARG1 = t;
if (IsVarTerm(t))
Yap_ThrowError(INSTANTIATION_ERROR, t, "meta-call");
if (IsIntTerm(t) || (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t))))
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, mod), "meta-call");
ARG1 = t;
ARG2 = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ARG3 = t;
if (mod) {
ARG4 = mod;
} else {
ARG4 = TermProlog;
}
}
if (Yap_GetGlobal(AtomDebugMeta) == TermOn) {
return CallPredicate(PredTraceMetaCall, B,
PredTraceMetaCall->CodeOfPred PASS_REGS);
@@ -135,12 +139,16 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
* Transfer control to a meta-call in ARG1, cut up to B.
*
* @param g goal
* @param mod current module
* @param mod curre1nt module
* @return su
*/
Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
CACHE_REGS
Term ts[4];
if (IsVarTerm(g))
Yap_ThrowError(INSTANTIATION_ERROR, g, "meta-call");
if (IsIntTerm(g) || (IsApplTerm(g) && IsExtensionFunctor(FunctorOfTerm(g))))
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(g, mod), "meta-call");
ts[0] = g;
ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
ts[2] = g;
@@ -151,7 +159,7 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
return Yap_MkApplTerm(PredMetaCall->FunctorOfPred, 4, ts);
}
Term Yap_PredicateIndicator(Term t, Term mod) {
Term Yap_TermToIndicator(Term t, Term mod) {
CACHE_REGS
// generate predicate indicator in this case
Term ti[2];
@@ -163,11 +171,31 @@ Term Yap_PredicateIndicator(Term t, Term mod) {
ti[0] = MkAtomTerm(AtomDot);
ti[1] = MkIntTerm(2);
} else {
ti[0] = t;
ti[1] = MkIntTerm(0);
return t;
}
t = Yap_MkApplTerm(FunctorSlash, 2, ti);
if (mod != CurrentModule) {
if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) {
ti[0] = mod;
ti[1] = t;
return Yap_MkApplTerm(FunctorModule, 2, ti);
}
return t;
}
Term Yap_PredicateToIndicator(PredEntry *pe) {
CACHE_REGS
// generate predicate indicator in this case
Term ti[2];
if (pe->ArityOfPE) {
ti[0] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
ti[1] = MkIntegerTerm(ArityOfFunctor(pe->FunctorOfPred));
} else {
ti[0] = MkAtomTerm((Atom)(pe->FunctorOfPred));
ti[1] = MkIntTerm(0);
}
Term t = Yap_MkApplTerm(FunctorSlash, 2, ti);
Term mod = pe->ModuleOfPred;
if (mod != PROLOG_MODULE && mod != USER_MODULE && mod != TermProlog) {
ti[0] = mod;
ti[1] = t;
return Yap_MkApplTerm(FunctorModule, 2, ti);
@@ -182,18 +210,17 @@ static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) {
if (err == TYPE_ERROR_CALLABLE) {
t = Yap_YapStripModule(t, &mod);
}
Yap_Error(err, t, "call/1");
Yap_ThrowError(err, t, "call/1");
return false;
}
}
/** @pred current_choice_point( -CP )
*
* unify the logic variable _CP_ with a number that gives the offset of the
* current choice-point. This number is only valid as long as we do not
*backtrack by or cut
* _CP_, and is safe in the presence of stack shifting and/or garbage
*collection.
* unify the logic variable _CP_ with a number that identifies the
* last alternative taken, or current choice-point. This number is
* only valid as long as we do not backtrack by or cut _CP_, and is
* safe in the presence of stack shifting and/or garbage collection.
*/
static Int current_choice_point(USES_REGS1) {
Term t = Deref(ARG1);
@@ -208,6 +235,51 @@ static Int current_choice_point(USES_REGS1) {
return TRUE;
}
/** @pred parent_choice_point( +CP, -PCP )
*
* given that _CP_ identifies an
* alternative taken, or choice-point, _PCP_ identifies its parent.
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (!IsVarTerm(t)) {
Yap_ThrowError(INSTANTIATION_ERROR, t, "child choicr-point missing");
}
choiceptr cp = cp_from_integer(t);
if (cp == NULL || cp->cp_b == NULL)
return false;
td = cp_as_integer(cp->cp_b PASS_REGS);
YapBind((CELL *)t, td);
return TRUE;
}
/** @pred parent_choice_point( -PB )
*
* PB is a number identifying the parent of the current choice-point.
* It storing the offset of the current ch
*
* The call will fail if _CP_ is topmost in the search tree.
*/
static Int parent_choice_point1(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
if (B == NULL || B->cp_b == NULL)
return false;
td = cp_as_integer(B->cp_b PASS_REGS);
YapBind((CELL *)t, td);
return true;
}
static Int save_env_b(USES_REGS1) {
Term t = Deref(ARG1);
Term td;
@@ -229,7 +301,7 @@ static PredEntry *new_pred(Term t, Term tmod, char *pname) {
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
} else if (IsAtomTerm(t)) {
return RepPredProp(PredPropByAtom(AtomOfTerm(t), tmod));
@@ -238,17 +310,17 @@ restart:
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
Term tmod = ArgOfTerm(1, t);
if (IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
Yap_ThrowError(INSTANTIATION_ERROR, t0, pname);
return NULL;
}
if (!IsAtomTerm(tmod)) {
Yap_Error(TYPE_ERROR_ATOM, t0, pname);
Yap_ThrowError(TYPE_ERROR_ATOM, t0, pname);
return NULL;
}
t = ArgOfTerm(2, t);
@@ -485,7 +557,7 @@ static bool EnterCreepMode(Term t, Term mod USES_REGS) {
if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
ARG1 = t;
if (!Yap_locked_growheap(FALSE, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"YAP failed to grow heap at meta-call");
}
if (!Yap_has_a_signal()) {
@@ -664,7 +736,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@@ -736,9 +808,11 @@ static void prune_inner_computation(choiceptr parent) {
Int oENV = LCL0 - ENV;
cut_pt = B;
while (cut_pt->cp_b < parent) {
while (cut_pt && cut_pt->cp_b < parent) {
cut_pt = cut_pt->cp_b;
}
if (!cut_pt)
return;
#ifdef YAPOR
CUT_prune_to(cut_pt);
#endif
@@ -1022,7 +1096,7 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
return complete_ge(true , omod, sl, creeping);
}
/* system:goal_expansion(A,B) */
mg_args[0] = cmod;
@@ -1035,6 +1109,7 @@ static Int _user_expand_goal(USES_REGS1) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
ARG1 = Yap_GetFromSlot(h1);
ARG2 = cmod;
ARG3 = Yap_GetFromSlot(h2);
@@ -1042,9 +1117,11 @@ static Int _user_expand_goal(USES_REGS1) {
if ((pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
mg_args[0] = cmod;
mg_args[1] = Yap_GetFromSlot(h1);
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
@@ -1054,9 +1131,10 @@ static Int _user_expand_goal(USES_REGS1) {
(pe = RepPredProp(
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
return complete_ge(true, omod, sl, creeping);
}
Yap_ResetException(NULL);
return complete_ge(false, omod, sl, creeping);
}
@@ -1111,11 +1189,17 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
t = Yap_YapStripModule(t, &mod);
restart_exec:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG3, "call/1");
return false;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
pe = PredPropByAtom(a, mod);
} else if (IsPairTerm(t)) {
Term ts[2];
ts[0] = t;
ts[1] = (CurrentModule == 0 ? TermProlog : CurrentModule);
t = Yap_MkApplTerm(FunctorCsult, 2, ts);
goto restart_exec;
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
register unsigned int i;
@@ -1159,8 +1243,9 @@ restart_exec:
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
//Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
//return false;
return CallMetaCall(t, mod);
}
/* N = arity; */
/* call may not define new system predicates!! */
@@ -1179,11 +1264,11 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@@ -1216,8 +1301,7 @@ static Int creep_step(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod)
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE;
return CallMetaCall(t, mod);
}
/* N = arity; */
/* call may not define new system predicates!! */
@@ -1262,11 +1346,11 @@ static Int execute_nonstop(USES_REGS1) {
if (IsVarTerm(mod)) {
mod = CurrentModule;
} else if (!IsAtomTerm(mod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1");
Yap_ThrowError(TYPE_ERROR_ATOM, ARG2, "call/1");
return FALSE;
}
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "call/1");
return FALSE;
} else if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
@@ -1299,7 +1383,7 @@ static Int execute_nonstop(USES_REGS1) {
#endif
}
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return FALSE;
}
/* N = arity; */
@@ -1402,13 +1486,13 @@ static Int execute_10(USES_REGS1) { /* '$execute_10'(Goal) */
static Int execute_depth_limit(USES_REGS1) {
Term d = Deref(ARG2);
if (IsVarTerm(d)) {
Yap_Error(INSTANTIATION_ERROR, d, "depth_bound_call/2");
Yap_ThrowError(INSTANTIATION_ERROR, d, "depth_bound_call/2");
return false;
} else if (!IsIntegerTerm(d)) {
if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) {
DEPTH = RESET_DEPTH();
} else {
Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
Yap_ThrowError(TYPE_ERROR_INTEGER, d, "depth_bound_call/2");
return false;
}
} else {
@@ -1675,13 +1759,6 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* restore the old environment */
/* get to previous environment */
cut_B = (choiceptr)ENV[E_CB];
{
/* Note that
cut_B == (choiceptr)ENV[E_CB] */
while (POP_CHOICE_POINT(ENV[E_CB])) {
POP_EXECUTE();
}
}
#ifdef YAPOR
CUT_prune_to(cut_B);
#endif /* YAPOR */
@@ -1706,16 +1783,20 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
/* we have failed, and usually we would backtrack to this B,
trouble is, we may also have a delayed cut to do */
if (B != NULL)
HB = B->cp_h;
YENV = ENV;
// should we catch the exception or pass it through?
// We'll pass it through
if (pass_ex && Yap_HasException()) {
Yap_RaiseException();
// We'll pass it through
if ( Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
return false;
}
return true;
return true;
} else if (out == 0) {
P = saved_p;
CP = saved_cp;
@@ -1733,12 +1814,17 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
HB = PROTECT_FROZEN_H(B);
// should we catch the exception or pass it through?
// We'll pass it through
if (pass_ex) {
Yap_RaiseException();
if ( Yap_HasException()) {
if (pass_ex &&
((LOCAL_PrologMode & BootMode) || !CurrentModule )) {
Yap_ResetException(LOCAL_ActiveError);
} else {
Yap_RaiseException();
}
}
return false;
} else {
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
Yap_ThrowError(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed");
return false;
}
}
@@ -1761,7 +1847,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
}
/* I cannot use the standard macro here because
@@ -1770,7 +1856,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
pt = RepAppl(t) + 1;
pe = PredPropByFunc(f, mod);
} else {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
return false;
}
ppe = RepPredProp(pe);
@@ -1811,7 +1897,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
t = Yap_YapStripModule(t, &tmod);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "call/1");
Yap_ThrowError(INSTANTIATION_ERROR, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@@ -1830,7 +1916,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
Functor f = FunctorOfTerm(t);
if (IsBlobFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, t, "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@@ -1841,7 +1927,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
pt = RepAppl(t) + 1;
arity = ArityOfFunctor(f);
} else {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), "call/1");
Yap_ThrowError(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), "call/1");
LOCAL_PrologMode &= ~TopGoalMode;
return (FALSE);
}
@@ -1873,7 +1959,7 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
#if !USE_SYSTEM_MALLOC
if (LOCAL_TrailTop - HeapTop < 2048) {
Yap_Error(RESOURCE_ERROR_TRAIL, TermNil,
Yap_ThrowError(RESOURCE_ERROR_TRAIL, TermNil,
"unable to boot because of too little Trail space");
}
#endif
@@ -1903,7 +1989,7 @@ static void do_restore_regs(Term t, int restore_all USES_REGS) {
static Int restore_regs(USES_REGS1) {
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE);
}
if (IsAtomTerm(t))
@@ -1922,7 +2008,7 @@ static Int restore_regs2(USES_REGS1) {
Int d;
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, t, "support for coroutining");
return (FALSE);
}
d0 = Deref(ARG2);
@@ -1930,7 +2016,7 @@ static Int restore_regs2(USES_REGS1) {
do_restore_regs(t, TRUE PASS_REGS);
}
if (IsVarTerm(d0)) {
Yap_Error(INSTANTIATION_ERROR, d0, "support for coroutining");
Yap_ThrowError(INSTANTIATION_ERROR, d0, "support for coroutining");
return (FALSE);
}
if (!IsIntegerTerm(d0)) {
@@ -2302,6 +2388,8 @@ void Yap_InitExecFs(void) {
Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);
Yap_InitCPred("env_choice_point", 1, save_env_b, 0);
Yap_InitCPred("parent_choice_point", 1, parent_choice_point1, 0);
Yap_InitCPred("parent_choice_point", 2, parent_choice_point, 0);
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
CurrentModule = cm;
Yap_InitCPred("$restore_regs", 1, restore_regs,

142
C/flags.c
View File

@@ -26,7 +26,7 @@
/**
@defgroup YAPFlags C-code to handle Prolog flags.
@defgroup YAPFlagsC C-code to handle Prolog flags.
@ingroup YAPFlags
@{
@@ -77,6 +77,7 @@ static bool sqf(Term t2);
static bool set_error_stream(Term inp);
static bool set_input_stream(Term inp);
static bool set_output_stream(Term inp);
static bool dollar_to_lc(Term inp);
static void newFlag(Term fl, Term val);
static Int current_prolog_flag(USES_REGS1);
@@ -119,11 +120,11 @@ static Term indexer(Term inp) {
return inp;
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag index in {off,single,compact,multi,on,max}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
return TermZERO;
}
@@ -147,14 +148,14 @@ static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
return true;
}
/* bad argument, but still an atom */
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2,
Yap_ThrowError(TYPE_ERROR_ATOM, t2,
"set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}",
RepAtom(AtomOfTerm(t2))->StrOfAE);
@@ -187,14 +188,14 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= BCKQ_CHARS;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
Yap_ThrowError(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
}
@@ -225,14 +226,14 @@ static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags |= SNGQ_CHARS;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
Yap_ThrowError(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
}
@@ -244,6 +245,20 @@ static bool sqf(Term t2) {
return sqf1(new, t2 PASS_REGS);
}
static bool dollar_to_lc(Term inp) {
if (inp == TermTrue || inp == TermOn) {
Yap_chtype0['$'+1] = LC;
return true;
}
if (inp == TermFalse || inp == TermOff) {
Yap_chtype0['$'+1] = CC;
return false;
}
Yap_ThrowError(TYPE_ERROR_BOOLEAN, inp,
"dollar_to_lower_case is a boolean flag");
return TermZERO;
}
static Term isaccess(Term inp) {
if (inp == TermReadWrite || inp == TermReadOnly)
return inp;
@@ -252,11 +267,11 @@ static Term isaccess(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {read_write,read_only}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp,
Yap_ThrowError(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {read_write,read_only}");
return TermZERO;
}
@@ -302,11 +317,11 @@ static Term flagscope(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {global,module,thread}");
return TermZERO;
}
Yap_Error(TYPE_ERROR_ATOM, inp,
Yap_ThrowError(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {global,module,thread}");
return TermZERO;
}
@@ -320,7 +335,7 @@ static bool mkprompt(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (!IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
strncpy(LOCAL_Prompt, (const char *)RepAtom(AtomOfTerm(inp))->StrOfAE,
@@ -334,7 +349,7 @@ static bool getenc(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (!IsVarTerm(inp) && !IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "get_encoding");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "get_encoding");
return false;
}
return Yap_unify(inp, MkAtomTerm(Yap_LookupAtom(enc_name(LOCAL_encoding))));
@@ -348,7 +363,7 @@ return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding)
)) );
}
if (!IsAtomTerm(inp) ) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE, ENC_OCTET );
@@ -368,7 +383,7 @@ static bool typein(Term inp) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
if (!IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
Yap_ThrowError(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
CurrentModule = inp;
@@ -466,7 +481,7 @@ static bool typein(Term inp) {
static bool string( Term inp ) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false;
}
if (IsStringTerm( inp ))
@@ -481,7 +496,7 @@ static bool typein(Term inp) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
}
if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
} while (IsPairTerm( inp ) );
@@ -489,21 +504,21 @@ static bool typein(Term inp) {
do {
Term hd = HeadOfTerm(inp);
if (!IsIntTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
if (IntOfTerm(hd) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0...");
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0...");
return false;
}
} while (IsPairTerm( inp ) );
} else {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
}
if ( inp != TermNil ) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
return true;
@@ -511,7 +526,7 @@ static bool typein(Term inp) {
x static bool list_atom( Term inp ) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false;
}
Term inp0 = inp;
@@ -523,13 +538,13 @@ x static bool list_atom( Term inp ) {
}
if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\"");
Yap_ThrowError(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\"");
return false;
}
} while (IsPairTerm( inp ) );
}
if ( inp != TermNil ) {
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return false;
}
return true;
@@ -538,7 +553,7 @@ x static bool list_atom( Term inp ) {
static Term list_option(Term inp) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
Yap_ThrowError(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return inp;
}
Term inp0 = inp;
@@ -559,14 +574,14 @@ static Term list_option(Term inp) {
continue;
}
if (!Yap_IsGroundTerm(hd))
Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
Yap_ThrowError(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
return TermZERO;
}
} while (IsPairTerm(inp));
if (inp == TermNil) {
return inp0;
}
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
Yap_ThrowError(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return TermZERO;
} else /* lone option */ {
if (IsStringTerm(inp)) {
@@ -591,12 +606,12 @@ static bool agc_threshold(Term t) {
CACHE_REGS
return Yap_unify(t, MkIntegerTerm(GLOBAL_AGcThreshold));
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
Yap_ThrowError(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
return FALSE;
} else {
Int i = IntegerOfTerm(t);
if (i < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin");
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin");
return FALSE;
} else {
GLOBAL_AGcThreshold = i;
@@ -610,12 +625,12 @@ static bool gc_margin(Term t) {
if (IsVarTerm(t)) {
return Yap_unify(t, Yap_GetValue(AtomGcMargin));
} else if (!IsIntegerTerm(t)) {
Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
Yap_ThrowError(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
return FALSE;
} else {
Int i = IntegerOfTerm(t);
if (i < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin");
Yap_ThrowError(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin");
return FALSE;
} else {
CACHE_REGS
@@ -710,7 +725,7 @@ static void initFlag(flag_info *f, int fnum, bool global) {
fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry));
if (fprop == NULL) {
WRITE_UNLOCK(ae->ARWLock);
Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil,
"not enough space for new Flag %s", ae->StrOfAE);
return;
}
@@ -766,7 +781,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
return false;
fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv && !fv->global) {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to set unknown module flag");
return false;
}
@@ -783,7 +798,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
Term t;
while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) {
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
}
@@ -810,7 +825,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
me->flags |= (UNKNOWN_FAST_FAIL);
return true;
}
Yap_Error(
Yap_ThrowError(
DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for unknown flag, use one of error, fail or warning.",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
@@ -825,7 +840,7 @@ static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
me->flags &= ~(M_CHARESCAPE);
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for character_escapes flag, use true or false",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
return false;
@@ -845,7 +860,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
return false;
fv = GetFlagProp(AtomOfTerm(tflag));
if (!fv && !fv->global) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag");
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag");
return 0L;
}
// module specific stuff now
@@ -884,7 +899,7 @@ static Term getYapFlagInModule(Term tflag, Term mod) {
return TermAtom;
return TermString;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped",
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
return 0L;
}
@@ -1081,7 +1096,7 @@ static Int current_prolog_flag2(USES_REGS1) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3");
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3");
return (FALSE);
}
fv = GetFlagProp(AtomOfTerm(tflag));
@@ -1126,7 +1141,7 @@ bool setYapFlag(Term tflag, Term t2) {
FlagEntry *fv;
flag_term *tarr;
if (IsVarTerm(tflag)) {
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE);
}
if (IsStringTerm(tflag)) {
@@ -1143,7 +1158,7 @@ bool setYapFlag(Term tflag, Term t2) {
return setYapFlagInModule(tflag, t2, modt);
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
fv = GetFlagProp(AtomOfTerm(tflag));
@@ -1156,7 +1171,7 @@ bool setYapFlag(Term tflag, Term t2) {
} else if (fl == TermWarning) {
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
} else {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to set unknown flag \"%s\"",
AtomName(AtomOfTerm(tflag)));
}
@@ -1212,7 +1227,7 @@ Term getYapFlag(Term tflag) {
flag_term *tarr;
tflag = Deref(tflag);
if (IsVarTerm(tflag)) {
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
Yap_ThrowError(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE);
}
if (IsStringTerm(tflag)) {
@@ -1234,7 +1249,7 @@ Term getYapFlag(Term tflag) {
return getYapFlagInModule(tflag, modt);
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
if (tflag == TermSilent)
@@ -1250,7 +1265,7 @@ Term getYapFlag(Term tflag) {
Yap_Warning("Flag ~s does not exist",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
} else {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to use unknown flag %s",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
@@ -1353,7 +1368,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
tarr->at = TermFalse;
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s);
return false;
} else if (f == nat) {
@@ -1363,7 +1378,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
UInt r = strtoul(ss, NULL, 10);
Term t;
if (errno) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be a positive integer)", s);
return false;
}
@@ -1399,7 +1414,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
return true;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s);
return false;
} else if (f == isatom) {
@@ -1408,7 +1423,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
}
Atom r = Yap_LookupAtom(s);
if (errno) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
Yap_ThrowError(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be a positive integer)", s);
tarr->at = TermNil;
}
@@ -1519,7 +1534,7 @@ do_prolog_flag_property(Term tflag,
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
return false;
}
if (IsStringTerm(tflag)) {
@@ -1531,7 +1546,7 @@ do_prolog_flag_property(Term tflag,
tflag = Yap_YapStripModule(tflag, &modt);
} else {
free(args);
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
Yap_ThrowError(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
}
@@ -1584,7 +1599,7 @@ do_prolog_flag_property(Term tflag,
break;
case PROLOG_FLAG_PROPERTY_END:
/* break; */
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP");
Yap_ThrowError(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP");
}
}
}
@@ -1660,7 +1675,7 @@ static Int prolog_flag_property(USES_REGS1) { /* Init current_prolog_flag */
do_cut(0);
return do_prolog_flag_property(t1, Deref(ARG2) PASS_REGS);
} else {
Yap_Error(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2");
Yap_ThrowError(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2");
}
}
return false;
@@ -1693,7 +1708,7 @@ static Int do_create_prolog_flag(USES_REGS1) {
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
if (args == NULL) {
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
Yap_ThrowError(LOCAL_Error_TYPE, opts, NULL);
return false;
}
fv = GetFlagProp(AtomOfTerm(tflag));
@@ -1757,6 +1772,8 @@ void Yap_InitFlags(bool bootstrap) {
CACHE_REGS
tr_fr_ptr tr0 = TR;
flag_info *f = global_flags_setup;
int lvl = push_text_stack();
char *buf = Malloc(4098);
GLOBAL_flagCount = 0;
if (bootstrap) {
GLOBAL_Flags = (union flagTerm *)Yap_AllocCodeSpace(
@@ -1779,7 +1796,16 @@ void Yap_InitFlags(bool bootstrap) {
(union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm) * nflags);
f = local_flags_setup;
while (f->name != NULL) {
bool itf = setInitialValue(bootstrap, f->def, f->init,
char *s;
if (f->init == NULL || f->init[0] == '\0') s = NULL;
else if (strlen(f->init) < 4096) {
s = buf;
strcpy(buf, f->init);
} else {
s = Malloc(strlen(f->init)+1);
strcpy(s, f->init);
}
bool itf = setInitialValue(bootstrap, f->def, s,
LOCAL_Flags + LOCAL_flagCount);
// Term itf = Yap_BufferToTermWithPrioBindings(f->init,
// strlen(f->init)+1,
@@ -1794,7 +1820,7 @@ void Yap_InitFlags(bool bootstrap) {
if (GLOBAL_Stream[StdInStream].status & Readline_Stream_f) {
setBooleanGlobalPrologFlag(READLINE_FLAG, true);
}
pop_text_stack(lvl);
if (!bootstrap) {
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag,
cont_yap_flag, 0);

36
C/globals.c
View File

@@ -145,13 +145,13 @@ threads that are created <em>after</em> the registration.
#define Global_MkIntegerTerm(I) MkIntegerTerm(I)
static size_t big2arena_sz(CELL *arena_base) {
static UInt big2arena_sz(CELL *arena_base) {
return (((MP_INT *)(arena_base + 2))->_mp_alloc * sizeof(mp_limb_t) +
sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) /
sizeof(CELL);
}
static size_t arena2big_sz(size_t sz) {
static UInt arena2big_sz(UInt sz) {
return sz -
(sizeof(MP_INT) + sizeof(Functor) + 2 * sizeof(CELL)) / sizeof(CELL);
}
@@ -159,7 +159,7 @@ static size_t arena2big_sz(size_t sz) {
/* pointer to top of an arena */
static inline CELL *ArenaLimit(Term arena) {
CELL *arena_base = RepAppl(arena);
size_t sz = big2arena_sz(arena_base);
UInt sz = big2arena_sz(arena_base);
return arena_base + sz;
}
@@ -171,9 +171,9 @@ CELL *Yap_ArenaLimit(Term arena) {
/* pointer to top of an arena */
static inline CELL *ArenaPt(Term arena) { return (CELL *)RepAppl(arena); }
static inline size_t ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); }
static inline UInt ArenaSz(Term arena) { return big2arena_sz(RepAppl(arena)); }
static Term CreateNewArena(CELL *ptr, size_t size) {
static Term CreateNewArena(CELL *ptr, UInt size) {
Term t = AbsAppl(ptr);
MP_INT *dst;
@@ -186,9 +186,9 @@ static Term CreateNewArena(CELL *ptr, size_t size) {
return t;
}
static Term NewArena(size_t size, int wid, UInt arity, CELL *where) {
static Term NewArena(UInt size, int wid, UInt arity, CELL *where) {
Term t;
size_t new_size;
UInt new_size;
WORKER_REGS(wid)
if (where == NULL || where == HR) {
@@ -232,7 +232,7 @@ void Yap_AllocateDefaultArena(size_t gsize, int wid) {
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL);
}
static void adjust_cps(size_t size USES_REGS) {
static void adjust_cps(UInt size USES_REGS) {
/* adjust possible back pointers in choice-point stack */
choiceptr b_ptr = B;
while (b_ptr->cp_h == HR) {
@@ -290,14 +290,14 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
return TRUE;
}
CELL *Yap_GetFromArena(Term *arenap, size_t cells, UInt arity) {
CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
CACHE_REGS
restart : {
Term arena = *arenap;
CELL *max = ArenaLimit(arena);
CELL *base = ArenaPt(arena);
CELL *newH;
size_t old_sz = ArenaSz(arena), new_size;
UInt old_sz = ArenaSz(arena), new_size;
if (IN_BETWEEN(base, HR, max)) {
base = HR;
@@ -319,8 +319,8 @@ restart : {
}
static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP,
size_t old_size USES_REGS) {
size_t new_size;
UInt old_size USES_REGS) {
UInt new_size;
if (HR == oldH)
return;
@@ -354,10 +354,10 @@ static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
#define expand_stack(S0,SP,SF,TYPE) \
{ size_t sz = SF-S0, used = SP-S0; \
S0 = Realloc(S0, (1024+sz)*sizeof(TYPE) PASS_REGS); \
SP = S0+used; SF = S0+sz; }
SP = S0+used; SF = S0+(1024+sz); }
static int copy_complex_term(register CELL *pt0, register CELL *pt0_end,
bool share, bool copy_att_vars, CELL *ptf,
int share, int copy_att_vars, CELL *ptf,
CELL *HLow USES_REGS) {
int lvl = push_text_stack();
@@ -480,7 +480,7 @@ loop:
break;
default: {
/* big int */
size_t sz = (sizeof(MP_INT) + 3 * CellSize +
UInt sz = (sizeof(MP_INT) + 3 * CellSize +
((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) /
CellSize,
i;
@@ -808,10 +808,8 @@ error_handler:
}
break;
default: /* temporary space overflow */
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
return 0;
}
}
oldH = HR;

1
C/lu_absmi_insts.h
View File

@@ -470,7 +470,6 @@
LogUpdClause *lcl = PREG->y_u.OtILl.d;
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
/* fprintf(stderr,"- %p/%p %d %d %p\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->y_u.OtILl.d->ClCode);*/
#if defined(YAPOR) || defined(THREADS)
if (PP != ap) {
if (PP) UNLOCKPE(16,PP);

2
C/modules.c
View File

@@ -6,7 +6,7 @@
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
*************************************************************** f***********
**************************************************************************
* *
File: modules.c *
* Last rev: *

2
C/parser.c
View File

@@ -64,8 +64,6 @@ static void syntax_msg(const char *msg, ...) {
if (!LOCAL_ErrorMessage) {
LOCAL_ErrorMessage = malloc(MAX_ERROR_MSG_SIZE + 1);
}
LOCAL_ActiveError->parserLine = LOCAL_toktide->TokLine;
LOCAL_ActiveError->parserPos = LOCAL_toktide->TokPos;
va_start(ap, msg);
vsnprintf(LOCAL_ErrorMessage, MAX_ERROR_MSG_SIZE, msg, ap);
va_end(ap);

138
C/prim_absmi_insts.h
View File

@@ -1949,11 +1949,12 @@
Op(p_arg_vv, xxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxx.x1);
HR[1] = XREG(PREG->y_u.xxx.x2);
RESET_VARIABLE(HR + 2);
CELL HRs[3];
HRs[0] = XREG(PREG->y_u.xxx.x1);
HRs[1] = XREG(PREG->y_u.xxx.x2);
HRs[2] = TermNil;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@@ -2044,15 +2045,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_arg_cv, xxn);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
CELL *Ho = HR;
CELL HRs[3];
Term t = MkIntegerTerm(PREG->y_u.xxn.c);
HR[0] = t;
HR[1] = XREG(PREG->y_u.xxn.xi);
RESET_VARIABLE(HR + 2);
HRs[0] = t;
HRs[1] = XREG(PREG->y_u.xxn.xi);
HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
HR = Ho;
}
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
d0 = PREG->y_u.xxn.c;
@@ -2118,12 +2118,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_arg_y_vv, yxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yxx.x1);
HR[1] = XREG(PREG->y_u.yxx.x2);
HR[2] = YREG[PREG->y_u.yxx.y];
RESET_VARIABLE(HR + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
CELL HRs[3];
HRs[0] = XREG(PREG->y_u.yxx.x1);
HRs[1] = XREG(PREG->y_u.yxx.x2);
HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@@ -2215,15 +2216,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_arg_y_cv, yxn);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
CELL *Ho = HR;
CELL HRs[3];
Term t = MkIntegerTerm(PREG->y_u.yxn.c);
HR[0] = t;
HR[1] = XREG(PREG->y_u.yxn.xi);
HR[2] = YREG[PREG->y_u.yxn.y];
RESET_VARIABLE(HR + 2);
HRs[0] = t;
HRs[1] = XREG(PREG->y_u.yxn.xi);
HRs[2] = TermNil;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
HR = Ho;
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@@ -2295,12 +2294,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.xxx.x1);
HR[2] = XREG(PREG->y_u.xxx.x2);
CELL HRs[3];
HRs[0] = TermNil;
HRs[1] = XREG(PREG->y_u.xxx.x1);
HRs[2] = XREG(PREG->y_u.xxx.x2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@@ -2412,12 +2412,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_cv:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = PREG->y_u.xxc.c;
HR[2] = XREG(PREG->y_u.xxc.xi);
CELL HRs[3];
HRs[0] = TermNil;
HRs[1] = PREG->y_u.xxc.c;
HRs[2] = XREG(PREG->y_u.xxc.xi);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@@ -2517,16 +2518,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
Term ti;
CELL *hi = HR;
CELL HRs[3];
HRs[0] = TermNil;
ti = MkIntegerTerm(PREG->y_u.xxn.c);
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.xxn.xi);
HR[2] = ti;
HRs[1] = XREG(PREG->y_u.xxn.xi);
HRs[2] = ti;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HR = hi;
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@@ -2611,12 +2610,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_y:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.yxx.x1);
HR[2] = XREG(PREG->y_u.yxx.x2);
CELL HRs[3];
HRs[0] = TermNil;
HRs[1] = XREG(PREG->y_u.yxx.x1);
HRs[2] = XREG(PREG->y_u.yxx.x2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@@ -2735,12 +2735,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_y_cv:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = PREG->y_u.yxc.c;
HR[2] = XREG(PREG->y_u.yxc.xi);
CELL HRs[3];
HRs[0] = TermNil;
HRs[1] = PREG->y_u.yxc.c;
HRs[2] = XREG(PREG->y_u.yxc.xi);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@@ -2846,16 +2847,15 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
Term ti;
CELL *hi = HR;
CELL HRs[3];
ti = MkIntegerTerm((Int)(PREG->y_u.yxn.c));
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.yxn.xi);
HR[2] = ti;
HRs[0] = TermFoundVar;
HRs[1] = XREG(PREG->y_u.yxn.xi);
HRs[2] = ti;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HR = hi;
HRs);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@@ -2952,12 +2952,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_xx, xxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxx.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term HRs[3];
HRs[0] = XREG(PREG->y_u.xxx.x);
HRs[1] = HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@@ -3000,12 +3000,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_xy, xxy);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxy.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term HRs[3];
HRs[0] = XREG(PREG->y_u.xxy.x);
HRs[1] = HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@@ -3051,12 +3051,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_yx, yxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yxx.x2);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term HRs[3];
HRs[0] = XREG(PREG->y_u.yxx.x2);
HRs[1] = HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@@ -3102,12 +3102,12 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_yy, yyx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yyx.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
CELL HRs[3];
HRs[0] = XREG(PREG->y_u.yyx.x);
HRs[1] = HRs[2] = TermFoundVar;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
HRs);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);

18
C/qlyr.c
View File

@@ -663,6 +663,7 @@ static Atom do_header(FILE *stream) {
char h1[] = "exec $exec_dir/yap $0 \"$@\"\nsaved ";
Atom at;
memset(s,0,2049);
if (!maybe_read_bytes( stream, s, 2048) )
return NIL;
if (strstr(s, h0)!= s)
@@ -863,6 +864,9 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
} while (cl != NULL);
}
if (!nclauses) {
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
pp->OpcodeOfPred = FAIL_OPCODE;
return;
}
while ((read_tag(stream) == QLY_START_LU_CLAUSE)) {
@@ -947,6 +951,10 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
Yap_EraseStaticClause(cl, pp, CurrentModule);
cl = ncl;
} while (cl != NULL);
} else if (flags & MultiFileFlag) {
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
pp->OpcodeOfPred = FAIL_OPCODE;
}
for (i = 0; i < nclauses; i++) {
char *base = (void *)read_UInt(stream);
@@ -1105,17 +1113,23 @@ static Int qload_program(USES_REGS1) {
YAP_file_type_t Yap_Restore(const char *s) {
CACHE_REGS
FILE *stream = Yap_OpenRestore(s);
int lvl = push_text_stack();
const char *tmp = Yap_AbsoluteFile(s, true);
FILE *stream = Yap_OpenRestore(tmp);
if (!stream)
return -1;
GLOBAL_RestoreFile = s;
if (do_header(stream) == NIL)
if (do_header(stream) == NIL) {
pop_text_stack(lvl);
return YAP_PL;
}
read_module(stream);
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
fclose(stream);
GLOBAL_RestoreFile = NULL;
LOCAL_SourceModule = CurrentModule = USER_MODULE;
pop_text_stack(lvl);
return YAP_QLY;
}

2
C/scanner.c
View File

@@ -1592,10 +1592,12 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
while (TRUE) {
if (charp > TokImage + (sz - 1)) {
size_t sz = charp-TokImage;
TokImage = Realloc(TokImage, Yap_Min(sz * 2, sz + MBYTE));
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
}
charp = TokImage+sz;
break;
}
if (ch == 10 && trueGlobalPrologFlag(ISO_FLAG)) {

40
C/stack.c
View File

@@ -72,6 +72,10 @@ static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
#define IN_BLOCK(P, B, SZ) \
((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ))
static PredEntry *get_pred(Term t, Term tmod, char *pname) {
Term t0 = t;
@@ -86,7 +90,7 @@ static PredEntry *get_pred(Term t, Term tmod, char *pname) {
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
if (IsExtensionFunctor(fun)) {
Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, tmod), pname);
Yap_Error(TYPE_ERROR_CALLABLE, Yap_TermToIndicator(t, tmod), pname);
return NULL;
}
if (fun == FunctorModule) {
@@ -258,7 +262,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
if (check_everything && P) {
if (check_everything && P && ENV) {
PredEntry *pe = EnvPreg(P);
if (p == pe)
return true;
@@ -280,7 +284,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
PredEntry *pe;
if (!cp)
return true;
return false;
pe = EnvPreg(cp);
if (p == pe)
return true;
@@ -292,38 +296,12 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
}
}
/* now mark the choicepoint */
if (b_ptr) {
pe = PredForChoicePt(b_ptr->cp_ap, NULL);
} else
return false;
if (pe == p) {
if (check_everything)
return true;
PELOCK(38, p);
if (p->PredFlags & IndexedPredFlag) {
yamop *code_p = b_ptr->cp_ap;
yamop *code_beg = p->cs.p_code.TrueCodeOfPred;
/* FIX ME */
if (p->PredFlags & LogUpdatePredFlag) {
LogUpdIndex *cl = ClauseCodeToLogUpdIndex(code_beg);
if (find_owner_log_index(cl, code_p))
b_ptr->cp_ap = cur_log_upd_clause(pe, b_ptr->cp_ap->y_u.Otapl.d);
} else if (p->PredFlags & MegaClausePredFlag) {
StaticIndex *cl = ClauseCodeToStaticIndex(code_beg);
if (find_owner_static_index(cl, code_p))
b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d);
} else {
/* static clause */
StaticIndex *cl = ClauseCodeToStaticIndex(code_beg);
if (find_owner_static_index(cl, code_p)) {
b_ptr->cp_ap = cur_clause(pe, b_ptr->cp_ap->y_u.Otapl.d);
}
}
}
UNLOCKPE(63, pe);
return true;
}
env_ptr = b_ptr->cp_env;
b_ptr = b_ptr->cp_b;
@@ -2134,7 +2112,7 @@ static void shortstack( choiceptr b_ptr, CELL * env_ptr , buf_struct_t *bufp) {
void DumpActiveGoals(USES_REGS1) {
/* try to dump active goals */
void *ep = YENV; /* and current environment */
void *cp;
void *cp = B;
PredEntry *pe;
struct buf_struct_t buf0, *bufp = &buf0;

1
C/stdpreds.c
View File

@@ -1592,6 +1592,7 @@ void Yap_InitCPreds(void) {
Yap_udi_init();
Yap_udi_Interval_init();
Yap_InitSignalCPreds();
Yap_InitTermCPreds();
Yap_InitUserCPreds();
Yap_InitUtilCPreds();
Yap_InitSortPreds();

1415
C/terms.c Normal file
View File

File diff suppressed because it is too large Load Diff

26
C/text.c
View File

@@ -18,6 +18,7 @@
#include "Yap.h"
#include "YapEval.h"
#include "YapHeap.h"
#include "YapStreams.h"
#include "YapText.h"
#include "Yatom.h"
#include "yapio.h"
@@ -191,8 +192,10 @@ void *MallocAtLevel(size_t sz, int atL USES_REGS) {
void *Realloc(void *pt, size_t sz USES_REGS) {
struct mblock *old = pt, *o;
if (!pt)
return Malloc(sz PASS_REGS);
old--;
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), CELL);
sz = ALIGN_BY_TYPE(sz + sizeof(struct mblock), Yap_Max(CELLSIZE,sizeof(struct mblock)));
o = realloc(old, sz);
if (o->next) {
o->next->prev = o;
@@ -447,15 +450,16 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
yap_error_number err0 = LOCAL_Error_TYPE;
/* we know what the term is */
if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) {
if (!(inp->type & YAP_STRING_TERM)) {
seq_type_t inpt = inp->type & (YAP_STRING_TERM|YAP_STRING_ATOM|YAP_STRING_ATOMS_CODES);
if (!(inpt & YAP_STRING_TERM)) {
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
} else if (!IsAtomTerm(inp->val.t) && inpt == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) {
} else if (!IsStringTerm(inp->val.t) && inpt == YAP_STRING_STRING) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
inpt == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) {
LOCAL_ActiveError->errorRawTerm = inp->val.t;
} else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) &&
!IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) {
@@ -463,10 +467,11 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
}
}
if (err0 != LOCAL_Error_TYPE) {
Yap_ThrowError(LOCAL_Error_TYPE, inp->val.t, "while reading text in");
Yap_ThrowError(LOCAL_Error_TYPE,
inp->val.t, "while converting term %s", Yap_TermToBuffer(
inp->val.t, Handle_cyclics_f|Quote_illegal_f | Handle_vars_f));
}
}
if ((inp->val.t == TermNil) && inp->type & YAP_STRING_PREFER_LIST )
{
out = Malloc(4);
@@ -579,6 +584,7 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
}
pop_text_stack(lvl);
return inp->val.uc;
}
if (inp->type & YAP_STRING_WCHARS) {
@@ -590,7 +596,10 @@ unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) {
}
static Term write_strings(unsigned char *s0, seq_tv_t *out USES_REGS) {
size_t min = 0, max = strlen((char *)s0);
size_t min = 0, max;
if (s0 && s0[0]) max = strlen((char *)s0);
else max = 0;
if (out->type & (YAP_STRING_NCHARS | YAP_STRING_TRUNC)) {
if (out->type & YAP_STRING_NCHARS)
@@ -961,7 +970,6 @@ bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS) {
// else if (out->type & YAP_STRING_NCHARS &&
// const unsigned char *ptr = skip_utf8(buf)
}
if (out->type & (YAP_STRING_UPCASE | YAP_STRING_DOWNCASE)) {
if (out->type & YAP_STRING_UPCASE) {
if (!upcase(buf, out)) {

2
C/tracer.c
View File

@@ -88,7 +88,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
}
}
const char *sn = Yap_TermToBuffer(args[i],
Quote_illegal_f | Handle_vars_f);
Handle_cyclics_f|Quote_illegal_f | Handle_vars_f);
size_t sz;
if (sn == NULL) {
sn = malloc(strlen("<* error *>")+1);

2549
C/utilpreds.c
View File

File diff suppressed because it is too large Load Diff

101
C/write.c
View File

@@ -70,11 +70,11 @@ typedef struct rewind_term {
typedef struct write_globs {
StreamDesc *stream;
int Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
int Keep_terms;
int Write_Loops;
int Write_strings;
int last_atom_minus;
bool Quote_illegal, Ignore_ops, Handle_vars, Use_portray, Portray_delays;
bool Keep_terms;
bool Write_Loops;
bool Write_strings;
UInt last_atom_minus;
UInt MaxDepth, MaxArgs;
wtype lw;
} wglbs;
@@ -581,12 +581,19 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
unsigned char *s;
wtype atom_or_symbol;
wrf stream = wglb->stream;
if (atom == NULL) return;
s = RepAtom(atom)->UStrOfAE;
if (s[0] == '\0') {
if (Quote_illegal) {
wrputc('\'', stream);
wrputc('\'', stream);
}
return;
}
if (IsBlob(atom)) {
wrputblob(RepAtom(atom), Quote_illegal, wglb);
return;
}
s = RepAtom(atom)->UStrOfAE;
/* #define CRYPT_FOR_STEVE 1*/
#ifdef CRYPT_FOR_STEVE
if (Yap_GetValue(AtomCryptAtoms) != TermNil &&
@@ -726,8 +733,6 @@ static void write_list(Term t, int direction, int depth,
nrwt.u_sd.s.ptr = 0;
while (1) {
int ndirection;
int do_jump;
PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
ti = TailOfTerm(t);
@@ -735,18 +740,6 @@ static void write_list(Term t, int direction, int depth,
break;
if (!IsPairTerm(ti))
break;
ndirection = RepPair(ti) - RepPair(t);
/* make sure we're not trapped in loops */
if (ndirection > 0) {
do_jump = (direction <= 0);
} else if (ndirection == 0) {
wrputc(',', wglb->stream);
putAtom(AtomFoundVar, wglb->Quote_illegal, wglb);
lastw = separator;
return;
} else {
do_jump = (direction >= 0);
}
if (wglb->MaxDepth != 0 && depth > wglb->MaxDepth) {
if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream);
@@ -756,10 +749,7 @@ static void write_list(Term t, int direction, int depth,
return;
}
lastw = separator;
direction = ndirection;
depth++;
if (do_jump)
break;
wrputc(',', wglb->stream);
t = ti;
}
@@ -1097,46 +1087,35 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
/* write options */
{
CACHE_REGS
yhandle_t lvl = push_text_stack();
struct write_globs wglb;
struct rewind_term rwt;
yhandle_t sls = Yap_CurrentSlot();
int lvl = push_text_stack();
if (t == 0)
return;
if (!mywrite) {
CACHE_REGS
wglb.stream = GLOBAL_Stream + LOCAL_c_error_stream;
} else
wglb.stream = mywrite;
wglb.lw = start;
wglb.last_atom_minus = FALSE;
wglb.Quote_illegal = flags & Quote_illegal_f;
wglb.Handle_vars = flags & Handle_vars_f;
wglb.Use_portray = flags & Use_portray_f;
wglb.Portray_delays = flags & AttVar_Portray_f;
wglb.MaxDepth = max_depth;
wglb.MaxArgs = max_depth;
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
wglb.Keep_terms = (flags & (Use_portray_f | To_heap_f));
/* initialize wglb */
t = Deref(t);
rwt.parent = NULL;
wglb.stream = mywrite;
wglb.Ignore_ops = flags & Ignore_ops_f;
wglb.Write_strings = flags & BackQuote_String_f;
if (!(flags & Ignore_cyclics_f) && false) {
Term ts[2];
ts[0] = Yap_BreakRational(t, 0, ts + 1, TermNil PASS_REGS);
// fprintf(stderr, "%lx %lx %lx\n", t, ts[0], ts[1]);
// Yap_DebugPlWriteln(ts[0]);
// ap_DebugPlWriteln(ts[1[);
if (ts[1] != TermNil) {
t = Yap_MkApplTerm(FunctorAtSymbol, 2, ts);
}
}
/* protect slots for portray */
writeTerm(t, priority, 1, FALSE, &wglb, &rwt);
if (flags & New_Line_f) {
wglb.Use_portray = flags & Use_portray_f;
wglb.Handle_vars = flags & Handle_vars_f;
wglb.Portray_delays = flags & AttVar_Portray_f;
wglb.Keep_terms = flags & To_heap_f;
wglb.Write_Loops = flags & Handle_cyclics_f;
wglb.Quote_illegal = flags & Quote_illegal_f;
wglb.MaxArgs = 0 ;
wglb.MaxDepth = 0 ;
wglb.lw = separator;
Term tp;
if ((flags & Handle_cyclics_f) ){
tp = Yap_CyclesInTerm(t PASS_REGS);
} else {
tp = t;
}
/* protect slots for portray */
writeTerm(tp, priority, 1, false, &wglb, &rwt);
if (flags & New_Line_f) {
if (flags & Fullstop_f) {
wrputc('.', wglb.stream);
wrputc('\n', wglb.stream);
@@ -1149,6 +1128,6 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
wrputc(' ', wglb.stream);
}
}
Yap_CloseSlots(sls);
pop_text_stack(lvl);
}
}

1197
C/yap-args.c
View File

File diff suppressed because it is too large Load Diff