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

fixes

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-01-27 10:17:27 +00:00
parent 63e8e89dab
commit f3f524960c
23 changed files with 423 additions and 376 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
C/cdmgr.c
View File

@ -117,7 +117,7 @@ restart:
return NULL; return NULL;
} else if (IsAtomTerm(t)) { } else if (IsAtomTerm(t)) {
PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod)); PredEntry *ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
return ap; return ap;
} else if (IsIntegerTerm(t) && tmod == IDB_MODULE) { } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
return Yap_FindLUIntKey(IntegerOfTerm(t)); return Yap_FindLUIntKey(IntegerOfTerm(t));
} else if (IsPairTerm(t)) { } else if (IsPairTerm(t)) {
@ -1918,11 +1918,10 @@ void Yap_EraseStaticClause(StaticClause *cl, PredEntry *ap, Term mod) {
if (is_live(ap)) { if (is_live(ap)) {
ap->OpcodeOfPred = FAIL_OPCODE; ap->OpcodeOfPred = FAIL_OPCODE;
} else { } else {
ap->OpcodeOfPred = UNDEF_OPCODE; ap->OpcodeOfPred = UNDEF_OPCODE;
ap->PredFlags |= UndefPredFlag; ap->PredFlags |= UndefPredFlag;
} }
ap->cs.p_code.TrueCodeOfPred = (yamop ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
*)(&(ap->OpcodeOfPred));
} else { } else {
yamop *ncl = cl->ClNext->ClCode; yamop *ncl = cl->ClNext->ClCode;
ap->cs.p_code.FirstClause = ncl; ap->cs.p_code.FirstClause = ncl;
@ -2029,9 +2028,9 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
if (mode == assertz && LOCAL_consult_level && mod == CurrentModule) if (mode == assertz && LOCAL_consult_level && mod == CurrentModule)
mode = consult; mode = consult;
*/ */
code_adr = Yap_cclause(t, 5, mod, code_adr = Yap_cclause(t, 5, mod, Deref(ARG3)); /* vsc: give the number of
Deref(ARG3)); /* vsc: give the number of arguments to arguments to cclause() in case there is a
cclause() in case there is a overflow */ overflow */
t = Deref(ARG1); /* just in case there was an heap overflow */ t = Deref(ARG1); /* just in case there was an heap overflow */
if (!LOCAL_ErrorMessage) { if (!LOCAL_ErrorMessage) {
YAPEnterCriticalSection(); YAPEnterCriticalSection();
@ -2065,27 +2064,26 @@ Atom Yap_ConsultingFile(USES_REGS1) {
/* consult file *file*, *mode* may be one of either consult or reconsult */ /* consult file *file*, *mode* may be one of either consult or reconsult */
void Yap_init_consult(int mode, const char *filenam) { void Yap_init_consult(int mode, const char *filenam) {
CACHE_REGS CACHE_REGS
if (!LOCAL_ConsultSp) { if (!LOCAL_ConsultSp) {
InitConsultStack(); InitConsultStack();
} }
if (LOCAL_ConsultSp >= LOCAL_ConsultLow + 6) { if (LOCAL_ConsultSp >= LOCAL_ConsultLow + 6) {
expand_consult(); expand_consult();
} }
LOCAL_ConsultSp--; LOCAL_ConsultSp--;
LOCAL_ConsultSp->f_name = (const unsigned char *)filenam; LOCAL_ConsultSp->f_name = (const unsigned char *)filenam;
LOCAL_ConsultSp--; LOCAL_ConsultSp--;
LOCAL_ConsultSp->mode = mode; LOCAL_ConsultSp->mode = mode;
LOCAL_ConsultSp--; LOCAL_ConsultSp--;
LOCAL_ConsultSp->c = (LOCAL_ConsultBase - LOCAL_ConsultSp); LOCAL_ConsultSp->c = (LOCAL_ConsultBase - LOCAL_ConsultSp);
LOCAL_ConsultBase = LOCAL_ConsultSp; LOCAL_ConsultBase = LOCAL_ConsultSp;
#if !defined(YAPOR) && !defined(YAPOR_SBA) #if !defined(YAPOR) && !defined(YAPOR_SBA)
/* if (LOCAL_consult_level == 0) /* if (LOCAL_consult_level == 0)
do_toggle_static_predicates_in_use(TRUE); */ do_toggle_static_predicates_in_use(TRUE); */
#endif #endif
LOCAL_consult_level++; LOCAL_consult_level++;
LOCAL_LastAssertedPred = NULL; LOCAL_LastAssertedPred = NULL;
} }
static Int p_startconsult(USES_REGS1) { /* '$start_consult'(+Mode) */ static Int p_startconsult(USES_REGS1) { /* '$start_consult'(+Mode) */
@ -2381,7 +2379,7 @@ static Int p_rmspy(USES_REGS1) { /* '$rm_spy'(+T,+Mod) */
******************************************************************/ ******************************************************************/
static Int static Int
number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */ number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */
Term t = Deref(ARG1); Term t = Deref(ARG1);
Term mod = Deref(ARG2); Term mod = Deref(ARG2);
int ncl = 0; int ncl = 0;
@ -2411,25 +2409,25 @@ number_of_clauses(USES_REGS1) { /* '$number_of_clauses'(Predicate,M,N) */
* sets the multi-file flag * sets the multi-file flag
* */ * */
static Int new_multifile(USES_REGS1) { static Int new_multifile(USES_REGS1) {
PredEntry *pe; PredEntry *pe;
Atom at; Atom at;
arity_t arity; arity_t arity;
pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile"); pe = new_pred(Deref(ARG1), Deref(ARG2), "multifile");
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return FALSE; return FALSE;
PELOCK(30, pe); PELOCK(30, pe);
arity = pe->ArityOfPE; arity = pe->ArityOfPE;
if (arity == 0) if (arity == 0)
at = (Atom)pe->FunctorOfPred; at = (Atom)pe->FunctorOfPred;
else else
at = NameOfFunctor(pe->FunctorOfPred); at = NameOfFunctor(pe->FunctorOfPred);
if (pe->PredFlags & MultiFileFlag) { if (pe->PredFlags & MultiFileFlag) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
return true; return true;
} }
if (pe->PredFlags & (TabledPredFlag|ForeignPredFlags)) { if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) {
UNLOCKPE(26, pe); UNLOCKPE(26, pe);
addcl_permission_error(RepAtom(at), arity, FALSE); addcl_permission_error(RepAtom(at), arity, FALSE);
return false; return false;
@ -2537,7 +2535,7 @@ static Int
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return FALSE; return FALSE;
return (pe->ModuleOfPred == 0 || return (pe->ModuleOfPred == 0 ||
pe->PredFlags & (SystemPredFlags|ForeignPredFlags)); pe->PredFlags & (SystemPredFlags | ForeignPredFlags));
UNLOCKPE(44, pe); UNLOCKPE(44, pe);
return (out); return (out);
} }
@ -2709,6 +2707,42 @@ static Int p_is_dynamic(USES_REGS1) { /* '$is_dynamic'(+P) */
return (out); return (out);
} }
/* @pred '$new_multifile'(+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);
return true;
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(RepAtom(at), arity, FALSE);
return false;
}
pe->PredFlags |= MetaPredFlag;
if (!(pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag))) {
/* static */
pe->PredFlags |= (SourcePredFlag | CompiledPredFlag);
}
UNLOCKPE(43, pe);
return true;
}
static Int p_is_metapredicate(USES_REGS1) { /* '$is_metapredicate'(+P) */ static Int p_is_metapredicate(USES_REGS1) { /* '$is_metapredicate'(+P) */
PredEntry *pe; PredEntry *pe;
bool out; bool out;
@ -4072,7 +4106,7 @@ static Int
#ifdef TABLING #ifdef TABLING
| TabledPredFlag | TabledPredFlag
#endif /* TABLING */ #endif /* TABLING */
)) { )) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t, Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, t,
"dbload_get_space/4"); "dbload_get_space/4");
return FALSE; return FALSE;
@ -4609,9 +4643,9 @@ static bool pred_flag_clause(Functor f, Term mod, const char *name,
} }
#endif #endif
tn = Yap_MkApplTerm(f, 2, s); tn = Yap_MkApplTerm(f, 2, s);
yamop *code_adr = yamop *code_adr = Yap_cclause(tn, 2, mod, tn); /* vsc: give the number of
Yap_cclause(tn, 2, mod, tn); /* vsc: give the number of arguments to arguments to cclause() in case there is a overflow
cclause() in case there is a overflow */ */
if (LOCAL_ErrorMessage) { if (LOCAL_ErrorMessage) {
return false; return false;
} }
@ -4709,6 +4743,7 @@ void Yap_InitCdMgr(void) {
Yap_InitCPred("$owner_file", 3, owner_file, SafePredFlag); Yap_InitCPred("$owner_file", 3, owner_file, SafePredFlag);
Yap_InitCPred("$set_owner_file", 3, p_set_owner_file, SafePredFlag); Yap_InitCPred("$set_owner_file", 3, p_set_owner_file, SafePredFlag);
Yap_InitCPred("$mk_dynamic", 2, mk_dynamic, SafePredFlag); Yap_InitCPred("$mk_dynamic", 2, mk_dynamic, SafePredFlag);
Yap_InitCPred("$new_meta_pred", 2, new_meta_pred, SafePredFlag);
Yap_InitCPred("$sys_export", 2, p_sys_export, TestPredFlag | SafePredFlag); Yap_InitCPred("$sys_export", 2, p_sys_export, TestPredFlag | SafePredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag); Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);
Yap_InitCPred("$number_of_clauses", 3, number_of_clauses, Yap_InitCPred("$number_of_clauses", 3, number_of_clauses,

105
C/modules.c
View File

@ -54,7 +54,7 @@ static ModEntry *initMod(AtomEntry *toname, AtomEntry *ae) {
n->NextME = CurrentModules; n->NextME = CurrentModules;
CurrentModules = n; CurrentModules = n;
n->AtomOfME = ae; n->AtomOfME = ae;
n->NextOfPE =NULL; n->NextOfPE = NULL;
n->OwnerFile = Yap_ConsultingFile(PASS_REGS1); n->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
AddPropToAtom(ae, (PropEntry *)n); AddPropToAtom(ae, (PropEntry *)n);
Yap_setModuleFlags(n, parent); Yap_setModuleFlags(n, parent);
@ -259,7 +259,7 @@ static Int change_module(USES_REGS1) { /* $change_module(N) */
} }
static Int current_module1(USES_REGS1) { /* $current_module(Old) static Int current_module1(USES_REGS1) { /* $current_module(Old)
*/ */
if (CurrentModule) if (CurrentModule)
return Yap_unify_constant(ARG1, CurrentModule); return Yap_unify_constant(ARG1, CurrentModule);
return Yap_unify_constant(ARG1, TermProlog); return Yap_unify_constant(ARG1, TermProlog);
@ -374,57 +374,58 @@ static Int new_system_module(USES_REGS1) {
} }
static Int strip_module(USES_REGS1) { static Int strip_module(USES_REGS1) {
Term t1 = Deref(ARG1), tmod = CurrentModule; Term t1 = Deref(ARG1), tmod = CurrentModule;
if (tmod == PROLOG_MODULE) { if (tmod == PROLOG_MODULE) {
tmod = TermProlog; tmod = TermProlog;
} }
t1 = Yap_StripModule(t1, &tmod); t1 = Yap_StripModule(t1, &tmod);
if (!t1) { if (!t1) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module"); Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return FALSE; return FALSE;
} }
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod); return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
} }
static Int yap_strip_clause(USES_REGS1) { static Int yap_strip_clause(USES_REGS1) {
Term t1 = Deref(ARG1), tmod = LOCAL_SourceModule; Term t1 = Deref(ARG1), tmod = LOCAL_SourceModule;
if (tmod == PROLOG_MODULE) { if (tmod == PROLOG_MODULE) {
tmod = TermProlog; tmod = TermProlog;
}
t1 = Yap_StripModule(t1, &tmod);
if (IsVarTerm(t1) || IsVarTerm(tmod)) {
Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module");
return false;
} else if (IsApplTerm(t1)) {
Functor f = FunctorOfTerm(t1);
if (IsExtensionFunctor(f)) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return false;
} }
t1 = Yap_StripModule(t1, &tmod); if (f == FunctorAssert || f == FunctorDoubleArrow) {
if (IsVarTerm(t1) || IsVarTerm(tmod)) { Term thmod = tmod;
Term th = ArgOfTerm(1, t1);
th = Yap_StripModule(th, &thmod);
if (IsVarTerm(th)) {
Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module"); Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module");
return false; return false;
} else if (IsApplTerm(t1)) { } else if (IsVarTerm(thmod)) {
Functor f = FunctorOfTerm(t1); Yap_Error(INSTANTIATION_ERROR, thmod, "trying to obtain module");
if (IsExtensionFunctor(f)) { return false;
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module"); } else if (IsIntTerm(th) ||
return false; (IsApplTerm(th) && IsExtensionFunctor(FunctorOfTerm(t1)))) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return false;
} else if (!IsAtomTerm(thmod)) {
Yap_Error(TYPE_ERROR_ATOM, thmod, "trying to obtain module");
return false;
} }
if (f == FunctorAssert || f == FunctorDoubleArrow) { }
Term thmod = tmod;
Term th = ArgOfTerm(1, t1);
th = Yap_StripModule(th, &thmod);
if (IsVarTerm(th)) {
Yap_Error(INSTANTIATION_ERROR, t1, "trying to obtain module");
return false;
} else if (IsVarTerm(thmod)) {
Yap_Error(INSTANTIATION_ERROR, thmod, "trying to obtain module");
return false;
} else if (IsIntTerm(th) || (IsApplTerm(th) && IsExtensionFunctor(FunctorOfTerm(t1)))) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return false;
}else if (!IsAtomTerm(thmod)) {
Yap_Error(TYPE_ERROR_ATOM, thmod, "trying to obtain module");
return false;
}
}
} else if (IsIntTerm(t1) || IsIntTerm(tmod) ) { } else if (IsIntTerm(t1) || IsIntTerm(tmod)) {
Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module"); Yap_Error(TYPE_ERROR_CALLABLE, t1, "trying to obtain module");
return false; return false;
} }
return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod); return Yap_unify(ARG3, t1) && Yap_unify(ARG2, tmod);
} }
Term Yap_YapStripModule(Term t, Term *modp) { Term Yap_YapStripModule(Term t, Term *modp) {
@ -504,7 +505,7 @@ static Int context_module(USES_REGS1) {
* @param Mod is the current text source module. * @param Mod is the current text source module.
* *
* : _Mod_ is the current read-in or source module. * : _Mod_ is the current read-in or source module.
*/ */
static Int source_module(USES_REGS1) { static Int source_module(USES_REGS1) {
if (LOCAL_SourceModule == PROLOG_MODULE) { if (LOCAL_SourceModule == PROLOG_MODULE) {
return Yap_unify(ARG1, TermProlog); return Yap_unify(ARG1, TermProlog);
@ -518,7 +519,7 @@ static Int source_module(USES_REGS1) {
* @param Mod is the current text source module. * @param Mod is the current text source module.
* *
* : _Mod_ is the current read-in or source module. * : _Mod_ is the current read-in or source module.
*/ */
static Int current_source_module(USES_REGS1) { static Int current_source_module(USES_REGS1) {
Term t; Term t;
if (LOCAL_SourceModule == PROLOG_MODULE) { if (LOCAL_SourceModule == PROLOG_MODULE) {
@ -609,14 +610,15 @@ void Yap_InitModulesC(void) {
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);
Yap_InitCPred("$change_module", 1, change_module, Yap_InitCPred("$change_module", 1, change_module,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);
Yap_InitCPred("strip_module", 3, strip_module, SafePredFlag | SyncPredFlag); Yap_InitCPred("strip_module", 3, strip_module, SafePredFlag | SyncPredFlag);
Yap_InitCPred("$yap_strip_module", 3, yap_strip_module, SafePredFlag | SyncPredFlag); Yap_InitCPred("$yap_strip_module", 3, yap_strip_module,
SafePredFlag | SyncPredFlag);
Yap_InitCPred("source_module", 1, source_module, SafePredFlag | SyncPredFlag); Yap_InitCPred("source_module", 1, source_module, SafePredFlag | SyncPredFlag);
Yap_InitCPred("current_source_module", 2, current_source_module, Yap_InitCPred("current_source_module", 2, current_source_module,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);
Yap_InitCPred("$yap_strip_clause", 3, yap_strip_clause, Yap_InitCPred("$yap_strip_clause", 3, yap_strip_clause,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);
Yap_InitCPred("context_module", 1, context_module, 0); Yap_InitCPred("context_module", 1, context_module, 0);
Yap_InitCPred("$is_system_module", 1, is_system_module, SafePredFlag); Yap_InitCPred("$is_system_module", 1, is_system_module, SafePredFlag);
Yap_InitCPred("$copy_operators", 2, copy_operators, 0); Yap_InitCPred("$copy_operators", 2, copy_operators, 0);
Yap_InitCPred("new_system_module", 1, new_system_module, SafePredFlag); Yap_InitCPred("new_system_module", 1, new_system_module, SafePredFlag);
@ -628,6 +630,7 @@ void Yap_InitModulesC(void) {
void Yap_InitModules(void) { void Yap_InitModules(void) {
CACHE_REGS CACHE_REGS
CurrentModules = NULL;
LookupSystemModule(MkAtomTerm(AtomProlog)); LookupSystemModule(MkAtomTerm(AtomProlog));
LOCAL_SourceModule = MkAtomTerm(AtomProlog); LOCAL_SourceModule = MkAtomTerm(AtomProlog);
LookupModule(USER_MODULE); LookupModule(USER_MODULE);

66
C/yap-args.c
View File

@ -156,7 +156,7 @@ static void start_modules(void) {
const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR, const char *Yap_BINDIR, *Yap_ROOTDIR, *Yap_SHAREDIR, *Yap_LIBDIR, *Yap_DLLDIR,
*Yap_PLDIR, *Yap_BOOTPLDIR, *Yap_BOOTSTRAPPLDIR, *Yap_COMMONSDIR, *Yap_PLDIR, *Yap_BOOTPLDIR, *Yap_BOOTSTRAPPLDIR, *Yap_COMMONSDIR,
*Yap_STARTUP, *Yap_BOOTFILE; *Yap_STARTUP, *Yap_OUTPUT_STARTUP, *Yap_BOOTFILE;
/* do initial boot by consulting the file boot.yap */ /* do initial boot by consulting the file boot.yap */
static void consult(const char *b_file USES_REGS) { static void consult(const char *b_file USES_REGS) {
@ -237,18 +237,20 @@ typedef struct config {
const char **commons; const char **commons;
const char **dll; const char **dll;
const char **ss; const char **ss;
const char **oss;
const char **bootpl; const char **bootpl;
} config_t; } config_t;
const char *gd_root[] = {"@RootDir", "[root]", "(execdir).."}; const char *gd_root[] = {"@RootDir", "[root]", "(execdir)/.."};
const char *gd_lib[] = {"@LibDir", "[lib]", "(root)lib"}; const char *gd_lib[] = {"@LibDir", "[lib]", "(root)/lib"};
const char *gd_share[] = {"@ShareDir", "[share]", "(root)share"}; const char *gd_share[] = {"@ShareDir", "[share]", "(root)/share"};
const char *gd_include[] = {"@IncludeDir", "[include]", "(root)include"}; const char *gd_include[] = {"@IncludeDir", "[include]", "(root)/include"};
const char *gd_dll[] = {"@DLLDir", "(lib)Yap"}; const char *gd_dll[] = {"@DLLDir", "(lib)/Yap"};
const char *gd_pl[] = {"@PlDir", "(share)Yap"}; const char *gd_pl[] = {"@PlDir", "(share)/Yap"};
const char *gd_commons[] = {"@CommonsDir", "(share)PrologCommons"}; const char *gd_commons[] = {"@CommonsDir", "(share)/PrologCommons"};
const char *gd_ss[] = {"@SavedState", "(dll)startup.yss"}; const char *gd_ss[] = {"(dll)"};
const char *gd_bootpl[] = {"@PrologBootFile", "(pl)pl/boot.yap"}; const char *gd_oss[] = {"."};
const char *gd_bootpl[] = {"(pl)/pl"};
static config_t *gnu(config_t *i) { static config_t *gnu(config_t *i) {
i->root = gd_root; i->root = gd_root;
@ -259,6 +261,7 @@ static config_t *gnu(config_t *i) {
i->pl = gd_pl; i->pl = gd_pl;
i->commons = gd_commons; i->commons = gd_commons;
i->ss = gd_ss; i->ss = gd_ss;
i->oss = gd_oss;
i->bootpl = gd_bootpl; i->bootpl = gd_bootpl;
return i; return i;
@ -299,31 +302,30 @@ char *location(YAP_init_args *iap, const char *inp, char *out) {
if (strstr(inp + 1, "root") == inp + 1 && Yap_ROOTDIR && if (strstr(inp + 1, "root") == inp + 1 && Yap_ROOTDIR &&
Yap_ROOTDIR[0] != '\0') { Yap_ROOTDIR[0] != '\0') {
strcpy(out, Yap_ROOTDIR); strcpy(out, Yap_ROOTDIR);
strcat(out, "/");
strcat(out, inp + strlen("(root)")); strcat(out, inp + strlen("(root)"));
} else if (strstr(inp + 1, "bin") == inp + 1 && Yap_BINDIR && } else if (strstr(inp + 1, "bin") == inp + 1 && Yap_BINDIR &&
Yap_BINDIR[0] != '\0') { Yap_BINDIR[0] != '\0') {
strcpy(out, Yap_BINDIR); strcpy(out, Yap_BINDIR);
strcat(out, "/");
strcat(out, inp + strlen("(bin)")); strcat(out, inp + strlen("(bin)"));
} else if (strstr(inp + 1, "lib") == inp + 1 && Yap_LIBDIR && } else if (strstr(inp + 1, "lib") == inp + 1 && Yap_LIBDIR &&
Yap_LIBDIR[0] != '\0') { Yap_LIBDIR[0] != '\0') {
strcpy(out, Yap_LIBDIR); strcpy(out, Yap_LIBDIR);
strcat(out, "/");
strcat(out, inp + strlen("(lib)")); strcat(out, inp + strlen("(lib)"));
} else if (strstr(inp + 1, "dll") == inp + 1 && Yap_DLLDIR &&
Yap_DLLDIR[0] != '\0') {
strcpy(out, Yap_DLLDIR);
strcat(out, inp + strlen("(dll)"));
} else if (strstr(inp + 1, "share") == inp + 1 && Yap_SHAREDIR && } else if (strstr(inp + 1, "share") == inp + 1 && Yap_SHAREDIR &&
Yap_SHAREDIR[0] != '\0') { Yap_SHAREDIR[0] != '\0') {
strcpy(out, Yap_SHAREDIR); strcpy(out, Yap_SHAREDIR);
strcat(out, "/");
strcat(out, inp + strlen("(share)")); strcat(out, inp + strlen("(share)"));
} else if (strstr(inp + 1, "pl") == inp + 1 && Yap_PLDIR && } else if (strstr(inp + 1, "pl") == inp + 1 && Yap_PLDIR &&
Yap_PLDIR[0] != '\0') { Yap_PLDIR[0] != '\0') {
strcpy(out, Yap_PLDIR); strcpy(out, Yap_PLDIR);
strcat(out, "/");
strcat(out, inp + strlen("(pl)")); strcat(out, inp + strlen("(pl)"));
} else if (strstr(inp + 1, "execdir") == inp + 1) { } else if (strstr(inp + 1, "execdir") == inp + 1) {
char *buf = Malloc(YAP_FILENAME_MAX + 1); char *buf = Malloc(YAP_FILENAME_MAX + 1);
const char *ex = Yap_AbsoluteFile(Yap_FindExecutable(), buf, false); const char *ex = Yap_AbsoluteFile(Yap_FindExecutable(), buf, true);
if (ex != NULL) { if (ex != NULL) {
strcpy(out, dirname((char *)ex)); strcpy(out, dirname((char *)ex));
strcat(out, "/"); strcat(out, "/");
@ -441,28 +443,32 @@ char *location(YAP_init_args *iap, const char *inp, char *out) {
* @return * @return
*/ */
static const char *find_directory(YAP_init_args *iap, const char *paths[], static const char *find_directory(YAP_init_args *iap, const char *paths[],
char *filename) { const char *filename) {
int lvl = push_text_stack(); int lvl = push_text_stack();
char *out = Malloc(YAP_FILENAME_MAX + 1); char *out = Malloc(YAP_FILENAME_MAX + 1);
const char *inp; const char *inp;
char *full; char *full;
if (filename) { if (filename) {
strcpy(out, filename);
full = Malloc(YAP_FILENAME_MAX + 1); full = Malloc(YAP_FILENAME_MAX + 1);
if (Yap_IsAbsolutePath(out, true)) {
// out = Yap_AbsoluteFile(out, full, true);
out = pop_output_text_stack(lvl, out);
return out;
}
} }
int i = 0; int i = 0;
while ((inp = paths[i++]) != NULL) { while ((inp = paths[i++]) != NULL) {
out[0] = '\0'; out[0] = '\0';
char *o = location(iap, inp, out), *no; char *o = location(iap, inp, out);
if (o && o[0] && Yap_isDirectory(o)) { if (o && o[0] && Yap_isDirectory(o)) {
if (filename) { if (filename) {
o = realpath(o, full); o = realpath(o, full);
strcat(o, "/"); strcat(o, "/");
strcat(o, filename); strcat(o, filename);
return o;
} else {
o = pop_output_text_stack(lvl, o);
return o;
} }
o = pop_output_text_stack(lvl, o);
return o;
} }
} }
pop_text_stack(lvl); pop_text_stack(lvl);
@ -480,8 +486,15 @@ static void Yap_set_locations(YAP_init_args *iap) {
Yap_DLLDIR = find_directory(iap, template->dll, NULL); Yap_DLLDIR = find_directory(iap, template->dll, NULL);
Yap_PLDIR = find_directory(iap, template->pl, NULL); Yap_PLDIR = find_directory(iap, template->pl, NULL);
Yap_COMMONSDIR = find_directory(iap, template->commons, NULL); Yap_COMMONSDIR = find_directory(iap, template->commons, NULL);
Yap_STARTUP = find_directory(iap, template->ss, NULL); if (iap->SavedState == NULL)
Yap_BOOTFILE = find_directory(iap, template->bootpl, NULL); iap->SavedState = "startup.yss";
Yap_STARTUP = find_directory(iap, template->ss, iap->SavedState);
if (iap->OutputSavedState == NULL)
iap->OutputSavedState = "startup.yss";
Yap_OUTPUT_STARTUP = find_directory(iap, template->ss, iap->OutputSavedState);
if (iap->PrologBootFile == NULL)
iap->PrologBootFile = "boot.yap";
Yap_BOOTFILE = find_directory(iap, template->bootpl, iap->PrologBootFile);
if (Yap_ROOTDIR) if (Yap_ROOTDIR)
setAtomicGlobalPrologFlag(HOME_FLAG, setAtomicGlobalPrologFlag(HOME_FLAG,
MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR))); MkAtomTerm(Yap_LookupAtom(Yap_ROOTDIR)));
@ -640,7 +653,7 @@ X_API YAP_file_type_t YAP_parse_yap_arguments(int argc, char *argv[],
iap->PrologBootFile = *++argv; iap->PrologBootFile = *++argv;
argc--; argc--;
} else { } else {
iap->PrologBootFile = NULL; iap->PrologBootFile = "boot.yap";
} }
iap->install = true; iap->install = true;
break; break;
@ -1166,6 +1179,7 @@ X_API YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true); setBooleanGlobalPrologFlag(SAVED_PROGRAM_FLAG, true);
CurrentModule = LOCAL_SourceModule = USER_MODULE; CurrentModule = LOCAL_SourceModule = USER_MODULE;
init_globals(yap_init); init_globals(yap_init);
YAP_RunGoalOnce(TermInitProlog);
start_modules(); start_modules();
return end_init(yap_init, YAP_QLY); return end_init(yap_init, YAP_QLY);
@ -1175,7 +1189,7 @@ X_API YAP_file_type_t YAP_Init(YAP_init_args *yap_init) {
start_modules(); start_modules();
consult(Yap_BOOTFILE PASS_REGS); consult(Yap_BOOTFILE PASS_REGS);
if (yap_init->install) { if (yap_init->install) {
Term t = MkAtomTerm(Yap_LookupAtom(YAP_STARTUP)); Term t = MkAtomTerm(Yap_LookupAtom(Yap_OUTPUT_STARTUP));
Term g = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("qsave_program"), 1), Term g = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("qsave_program"), 1),
1, &t); 1, &t);
YAP_RunGoalOnce(g); YAP_RunGoalOnce(g);

12
CXX/yapi.cpp
View File

@ -854,12 +854,12 @@ void YAPEngine::doInit(YAP_file_type_t BootMode) {
#if YAP_PYTHON #if YAP_PYTHON
do_init_python(); do_init_python();
#endif #endif
std::string s = "initialize_prolog"; // std::string s = "initialize_prolog";
YAPPredicate p = YAPPredicate(YAPAtomTerm(s)); // YAPPredicate p = YAPPredicate(MkAtomTerm(Yap_LookupAtom(s.c_str())));
YAPQuery initq = YAPQuery(YAPPredicate(p), nullptr); // YAPQuery initq = YAPQuery(YAPPredicate(p), nullptr);
if (initq.next()) { // if (initq.next()) {
initq.cut(); // initq.cut();
} // }
CurrentModule = TermUser; CurrentModule = TermUser;
} }

6
CXX/yapq.hh
View File

@ -189,9 +189,9 @@ public:
struct X_API YAPEngineArgs : YAP_init_args { struct X_API YAPEngineArgs : YAP_init_args {
public: public:
YAPEngineArgs() : yap_boot_params() { YAPEngineArgs() : yap_boot_params() {
char s[32]; const std::string *s = new std::string("startup.yss");
strcpy(s, "startup.yss"); Embedded = true;
Yap_InitDefaults(this, s, 0, nullptr); Yap_InitDefaults(this, (char *)s->c_str(), 0, nullptr);
#if YAP_PYTHON #if YAP_PYTHON
Embedded = true; Embedded = true;
python_in_python = Py_IsInitialized(); python_in_python = Py_IsInitialized();

7
console/yap.c
View File

@ -90,6 +90,8 @@ static bool exec_top_level(int BootMode, YAP_init_args *iap) {
YAP_Term atomfalse; YAP_Term atomfalse;
YAP_Atom livegoal; YAP_Atom livegoal;
if (iap->install)
return true;
if (BootMode == YAP_BOOT_FROM_SAVED_STACKS) { if (BootMode == YAP_BOOT_FROM_SAVED_STACKS) {
/* continue executing from the frozen stacks */ /* continue executing from the frozen stacks */
YAP_ContinueGoal(); YAP_ContinueGoal();
@ -148,6 +150,7 @@ int main(int argc, char **argv)
/* End preprocessor code */ /* End preprocessor code */
bool rc = exec_top_level(BootMode, &init_args); bool rc = exec_top_level(BootMode, &init_args);
if (!rc)
return rc; return 1;
return 0;
} }

58
os/charsio.c
View File

@ -93,7 +93,7 @@ INLINE_ONLY inline EXTERN Int CharOfAtom(Atom at) {
return val; return val;
} }
int Yap_peekWideWithGetwc(int sno){ int Yap_peekWideWithGetwc(int sno) {
StreamDesc *s; StreamDesc *s;
s = GLOBAL_Stream + sno; s = GLOBAL_Stream + sno;
int ch = getwc(s->file); int ch = getwc(s->file);
@ -101,7 +101,6 @@ int Yap_peekWideWithGetwc(int sno){
return ch; return ch;
} }
int Yap_peekWithGetc(int sno) { int Yap_peekWithGetc(int sno) {
StreamDesc *s; StreamDesc *s;
s = GLOBAL_Stream + sno; s = GLOBAL_Stream + sno;
@ -110,7 +109,6 @@ int Yap_peekWithGetc(int sno) {
return ch; return ch;
} }
int Yap_peekWideWithSeek(int sno) { int Yap_peekWideWithSeek(int sno) {
StreamDesc *s; StreamDesc *s;
s = GLOBAL_Stream + sno; s = GLOBAL_Stream + sno;
@ -119,19 +117,19 @@ int Yap_peekWideWithSeek(int sno) {
Int lpos = s->linepos; Int lpos = s->linepos;
int ch = s->stream_wgetc(sno); int ch = s->stream_wgetc(sno);
if (ch == EOF) { if (ch == EOF) {
if (s->file) clearerr(s->file); if (s->file)
clearerr(s->file);
s->status &= ~Eof_Error_Stream_f; s->status &= ~Eof_Error_Stream_f;
// do not try doing error processing // do not try doing error processing
} else { } else {
Yap_SetCurInpPos(sno, pos); Yap_SetCurInpPos(sno, pos);
s->charcount = pos; s->charcount = pos;
s->linecount = line; s->linecount = line;
s->linepos = lpos; s->linepos = lpos;
} }
return ch; return ch;
} }
int Yap_peekWithSeek(int sno) { int Yap_peekWithSeek(int sno) {
StreamDesc *s; StreamDesc *s;
s = GLOBAL_Stream + sno; s = GLOBAL_Stream + sno;
@ -140,7 +138,8 @@ int Yap_peekWithSeek(int sno) {
Int lpos = s->linepos; Int lpos = s->linepos;
int ch = s->stream_getc(sno); int ch = s->stream_getc(sno);
if (ch == EOF) { if (ch == EOF) {
if (s->file) clearerr(s->file); if (s->file)
clearerr(s->file);
s->status &= ~Eof_Error_Stream_f; s->status &= ~Eof_Error_Stream_f;
// do not try doing error processing // do not try doing error processing
} else { } else {
@ -152,15 +151,14 @@ int Yap_peekWithSeek(int sno) {
return ch; return ch;
} }
int Yap_popChar(int sno) { int Yap_popChar(int sno) {
StreamDesc *s = GLOBAL_Stream + sno; StreamDesc *s = GLOBAL_Stream + sno;
s->buf.on = false; s->buf.on = false;
s->charcount = s->buf.pos; s->charcount = s->buf.pos;
s->linecount = s->buf.line; s->linecount = s->buf.line;
s->linepos = s->buf.lpos; s->linepos = s->buf.lpos;
Yap_DefaultStreamOps(s); Yap_DefaultStreamOps(s);
return s->buf.ch; return s->buf.ch;
} }
int Yap_peekWide(int sno) { int Yap_peekWide(int sno) {
@ -170,26 +168,26 @@ int Yap_peekWide(int sno) {
Int lpos = s->linepos; Int lpos = s->linepos;
int ch = s->stream_wgetc(sno); int ch = s->stream_wgetc(sno);
if (ch == EOF) { if (ch == EOF) {
if (s->file) clearerr(s->file); if (s->file)
clearerr(s->file);
s->status &= ~Eof_Error_Stream_f; s->status &= ~Eof_Error_Stream_f;
// do not try doing error processing // do not try doing error processing
} else { } else {
s->buf.on = true; s->buf.on = true;
s->buf.ch = ch; s->buf.ch = ch;
s->buf.pos = s->charcount; s->buf.pos = s->charcount;
s->buf.line = s->linecount; s->buf.line = s->linecount;
s->buf.lpos = s->linepos; s->buf.lpos = s->linepos;
s->charcount = pos; s->charcount = pos;
s->linecount = line; s->linecount = line;
s->linepos = lpos; s->linepos = lpos;
s->stream_getc = Yap_popChar; s->stream_getc = Yap_popChar;
s->stream_wgetc = Yap_popChar; s->stream_wgetc = Yap_popChar;
Yap_SetCurInpPos(sno, pos); Yap_SetCurInpPos(sno, pos);
} }
return ch; return ch;
} }
int Yap_peekChar(int sno) { int Yap_peekChar(int sno) {
StreamDesc *s = GLOBAL_Stream + sno; StreamDesc *s = GLOBAL_Stream + sno;
Int pos = s->charcount; Int pos = s->charcount;
@ -197,26 +195,26 @@ int Yap_peekChar(int sno) {
Int lpos = s->linepos; Int lpos = s->linepos;
int ch = s->stream_getc(sno); int ch = s->stream_getc(sno);
if (ch == EOF) { if (ch == EOF) {
if (s->file) clearerr(s->file); if (s->file)
clearerr(s->file);
s->status &= ~Eof_Error_Stream_f; s->status &= ~Eof_Error_Stream_f;
// do not try doing error processing // do not try doing error processing
} else { } else {
s->buf.on = true; s->buf.on = true;
s->buf.ch = ch; s->buf.ch = ch;
s->buf.pos = s->charcount; s->buf.pos = s->charcount;
s->buf.line = s->linecount; s->buf.line = s->linecount;
s->buf.lpos = s->linepos; s->buf.lpos = s->linepos;
s->charcount = pos; s->charcount = pos;
s->linecount = line; s->linecount = line;
s->linepos = lpos; s->linepos = lpos;
s->stream_getc = Yap_popChar; s->stream_getc = Yap_popChar;
s->stream_wgetc = Yap_popChar; s->stream_wgetc = Yap_popChar;
Yap_SetCurInpPos(sno, pos); Yap_SetCurInpPos(sno, pos);
} }
return ch; return ch;
} }
int Yap_peek(int sno) { return GLOBAL_Stream[sno].stream_wpeek(sno); } int Yap_peek(int sno) { return GLOBAL_Stream[sno].stream_wpeek(sno); }
static int dopeek_byte(int sno) { return GLOBAL_Stream[sno].stream_wpeek(sno); } static int dopeek_byte(int sno) { return GLOBAL_Stream[sno].stream_wpeek(sno); }

140
os/format.c
View File

@ -329,17 +329,14 @@ static Int format_copy_args(Term args, Term *targs, Int tsz) {
static void static void
format_clean_up(int sno, int sno0, format_info *finf, const unsigned char *fstr, format_clean_up(int sno, int sno0, format_info *finfo) {
const Term *targs) { if (sno >= 0 && sno != sno0) {
if (sno != sno0) { sno = format_synch(sno, sno0, finfo);
sno = format_synch(sno, sno0, finf);
Yap_CloseStream(sno); Yap_CloseStream(sno);
} }
pop_text_stack(finf->lvl); pop_text_stack(finfo->lvl);
if (targs)
Yap_FreeAtomSpace((void *)targs);
} }
static Int fetch_index_from_args(Term t) { static Int fetch_index_from_args(Term t) {
@ -368,9 +365,9 @@ static wchar_t base_dig(Int dig, Int ch) {
static Int doformat(volatile Term otail, volatile Term oargs, static Int doformat(volatile Term otail, volatile Term oargs,
int sno0 USES_REGS) { int sno0 USES_REGS) {
char tmp1[TMP_STRING_SIZE], *tmpbase; char *tmp1, *tmpbase;
int ch; int ch;
Term mytargs[8], *targs; Term *targs;
Int tnum, targ; Int tnum, targ;
const unsigned char *fstr, *fptr; const unsigned char *fstr, *fptr;
Term args; Term args;
@ -380,10 +377,17 @@ static Int doformat(volatile Term otail, volatile Term oargs,
jmp_buf format_botch; jmp_buf format_botch;
volatile void *old_handler; volatile void *old_handler;
volatile int old_pos; volatile int old_pos;
format_info finfo;
Term fmod = CurrentModule; Term fmod = CurrentModule;
bool alloc_fstr = false; bool alloc_fstr = false;
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
int l = push_text_stack();
tmp1 = Malloc(TMP_STRING_SIZE+1);
format_info *finfo = Malloc(sizeof(format_info));
// it starts here
finfo->gapi = 0;
finfo->phys_start = 0;
finfo->lstart = 0;
finfo->lvl = l;
if (GLOBAL_Stream[sno0].status & InMemory_Stream_f) { if (GLOBAL_Stream[sno0].status & InMemory_Stream_f) {
old_handler = GLOBAL_Stream[sno].u.mem_string.error_handler; old_handler = GLOBAL_Stream[sno].u.mem_string.error_handler;
@ -409,21 +413,20 @@ static Int doformat(volatile Term otail, volatile Term oargs,
args = oargs; args = oargs;
tail = otail; tail = otail;
targ = 0; targ = 0;
int l = push_text_stack();
if (IsVarTerm(tail)) { if (IsVarTerm(tail)) {
pop_text_stack(l); format_clean_up(sno0, sno, finfo );
Yap_Error(INSTANTIATION_ERROR, tail, "format/2"); Yap_Error(INSTANTIATION_ERROR, tail, "format/2");
return (FALSE); return (FALSE);
} else if ((fptr = Yap_TextToUTF8Buffer(tail))) { } else if ((fstr = Yap_TextToUTF8Buffer(tail))) {
fstr = fptr; fptr = fstr;
alloc_fstr = true; alloc_fstr = true;
} else { } else {
pop_text_stack(l); format_clean_up(sno0, sno, finfo);
Yap_Error(TYPE_ERROR_TEXT, tail, "format/2"); Yap_Error(TYPE_ERROR_TEXT, tail, "format/2");
return false; return false;
} }
if (IsVarTerm(args)) { if (IsVarTerm(args)) {
pop_text_stack(l); format_clean_up(sno0, sno, finfo);
Yap_Error(INSTANTIATION_ERROR, args, "format/2"); Yap_Error(INSTANTIATION_ERROR, args, "format/2");
return FALSE; return FALSE;
} }
@ -431,62 +434,53 @@ static Int doformat(volatile Term otail, volatile Term oargs,
fmod = ArgOfTerm(1, args); fmod = ArgOfTerm(1, args);
args = ArgOfTerm(2, args); args = ArgOfTerm(2, args);
if (IsVarTerm(fmod)) { if (IsVarTerm(fmod)) {
pop_text_stack(l); format_clean_up(sno0, sno, finfo);
Yap_Error(INSTANTIATION_ERROR, fmod, "format/2"); Yap_Error(INSTANTIATION_ERROR, fmod, "format/2");
return FALSE; return false;
} }
if (!IsAtomTerm(fmod)) { if (!IsAtomTerm(fmod)) {
pop_text_stack(l); format_clean_up(sno0, sno, finfo);
Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2"); Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2");
return FALSE; return false;
} }
if (IsVarTerm(args)) { if (IsVarTerm(args)) {
pop_text_stack(l); format_clean_up(sno0, sno, finfo);
Yap_Error(INSTANTIATION_ERROR, args, "format/2"); Yap_Error(INSTANTIATION_ERROR, args, "format/2");
return FALSE; return FALSE;
} }
} }
if (IsPairTerm(args)) { if (IsPairTerm(args)) {
Int tsz = 8; Int tsz = 16;
targs = mytargs; targs = Malloc(32*sizeof(Term));
do { do {
tnum = format_copy_args(args, targs, tsz); tnum = format_copy_args(args, targs, tsz);
if (tnum == FORMAT_COPY_ARGS_ERROR) if (tnum == FORMAT_COPY_ARGS_ERROR ||
return FALSE; tnum == FORMAT_COPY_ARGS_OVERFLOW) {
else if (tnum == FORMAT_COPY_ARGS_OVERFLOW) { format_clean_up(sno0, sno, finfo);
if (mytargs != targs) { return false;
Yap_FreeCodeSpace((char *)targs);
}
tsz += 16;
targs = (Term *)Yap_AllocAtomSpace(tsz * sizeof(Term));
} else {
break;
} }
} while (true); else if (tnum == tsz ) {
tnum += 32;
targs = Realloc(targs, tnum*sizeof(Term));
}
break;
} while (true);
} else if (args != TermNil) { } else if (args != TermNil) {
tnum = 1; tnum = 1;
mytargs[0] = args; targs = Malloc(sizeof(Term));
targs = mytargs; targs[0] = args;
} else { } else {
tnum = 0; tnum = 0;
targs = mytargs;
} }
// it starts here if ( !(GLOBAL_Stream[sno].status & InMemory_Stream_f))
finfo.gapi = 0;
finfo.phys_start = 0;
finfo.lstart = 0;
finfo.lvl = l;
if (true || !(GLOBAL_Stream[sno].status & InMemory_Stream_f))
sno = Yap_OpenBufWriteStream(PASS_REGS1); sno = Yap_OpenBufWriteStream(PASS_REGS1);
if (sno < 0) { if (sno < 0) {
if (!alloc_fstr) if (!alloc_fstr)
fstr = NULL; fstr = NULL;
if (mytargs == targs) {
targs = NULL; format_clean_up(sno, sno0, finfo);
}
format_clean_up(sno, sno0, &finfo, fstr, targs);
return false; return false;
} }
f_putc = GLOBAL_Stream[sno].stream_wputc; f_putc = GLOBAL_Stream[sno].stream_wputc;
@ -802,10 +796,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
if (!res) { if (!res) {
if (!alloc_fstr) if (!alloc_fstr)
fstr = NULL; fstr = NULL;
if (mytargs == targs) { format_clean_up(sno, sno0, finfo);
targs = NULL;
}
format_clean_up(sno, sno0, &finfo, fstr, targs);
return false; return false;
} }
ARG1 = Yap_GetFromHandle(s1); ARG1 = Yap_GetFromHandle(s1);
@ -838,10 +829,10 @@ static Int doformat(volatile Term otail, volatile Term oargs,
} }
if (!alloc_fstr) if (!alloc_fstr)
fstr = NULL; fstr = NULL;
if (mytargs == targs) { if (tnum == 0) {
targs = NULL; targs = NULL;
} }
format_clean_up(sno, sno0, &finfo, fstr, targs); format_clean_up(sno, sno0, finfo);
Yap_RaiseException(); Yap_RaiseException();
return false; return false;
} }
@ -893,43 +884,43 @@ static Int doformat(volatile Term otail, volatile Term oargs,
while (repeats--) { while (repeats--) {
f_putc(sno, (int)'\n'); f_putc(sno, (int)'\n');
} }
sno = format_synch(sno, sno0, &finfo); sno = format_synch(sno, sno0, finfo);
break; break;
case 'N': case 'N':
if (!has_repeats) if (!has_repeats)
has_repeats = 1; has_repeats = 1;
if (GLOBAL_Stream[sno].linepos != 0) { if (GLOBAL_Stream[sno].linepos != 0) {
f_putc(sno, '\n'); f_putc(sno, '\n');
sno = format_synch(sno, sno0, &finfo); sno = format_synch(sno, sno0, finfo);
} }
if (repeats > 1) { if (repeats > 1) {
Int i; Int i;
for (i = 1; i < repeats; i++) for (i = 1; i < repeats; i++)
f_putc(sno, '\n'); f_putc(sno, '\n');
} }
sno = format_synch(sno, sno0, &finfo); sno = format_synch(sno, sno0, finfo);
break; break;
/* padding */ /* padding */
case '|': case '|':
fill_pads(sno, sno0, repeats, &finfo PASS_REGS); fill_pads(sno, sno0, repeats, finfo PASS_REGS);
break; break;
case '+': case '+':
fill_pads(sno, sno0, finfo.lstart + repeats, &finfo PASS_REGS); fill_pads(sno, sno0, finfo->lstart + repeats, finfo PASS_REGS);
break; break;
case 't': { case 't': {
#if MAY_WRITR #if MAY_WRITR
if (fflush(GLOBAL_Stream[sno].file) == 0) { if (fflush(GLOBAL_Stream[sno].file) == 0) {
finfo.gap[finfo.gapi].phys = ftell(GLOBAL_Stream[sno].file); finfo->gap[finfo->gapi].phys = ftell(GLOBAL_Stream[sno].file);
} }
#else #else
finfo.gap[finfo.gapi].phys = GLOBAL_Stream[sno].u.mem_string.pos; finfo->gap[finfo->gapi].phys = GLOBAL_Stream[sno].u.mem_string.pos;
#endif #endif
finfo.gap[finfo.gapi].log = GLOBAL_Stream[sno].linepos; finfo->gap[finfo->gapi].log = GLOBAL_Stream[sno].linepos;
if (has_repeats) if (has_repeats)
finfo.gap[finfo.gapi].filler = fptr[-2]; finfo->gap[finfo->gapi].filler = fptr[-2];
else else
finfo.gap[finfo.gapi].filler = ' '; finfo->gap[finfo->gapi].filler = ' ';
finfo.gapi++; finfo-> gapi++;
} break; } break;
do_instantiation_error: do_instantiation_error:
@ -973,24 +964,24 @@ static Int doformat(volatile Term otail, volatile Term oargs,
} }
if (!alloc_fstr) if (!alloc_fstr)
fstr = NULL; fstr = NULL;
if (mytargs == targs) { if (tnum == 0) {
targs = NULL; targs = NULL;
} }
format_clean_up(sno, sno0, &finfo, fstr, targs); format_clean_up(sno, sno0, finfo);
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
return FALSE; return false;
} }
} }
/* ok, now we should have a command */ /* ok, now we should have a command */
} }
} else { } else {
if (ch == '\n') { if (ch == '\n') {
sno = format_synch(sno, sno0, &finfo); sno = format_synch(sno, sno0, finfo);
} }
f_putc(sno, ch); f_putc(sno, ch);
} }
} }
// fill_pads( sno, 0, &finfo); // fill_pads( sno, 0, finfo);
if (IsAtomTerm(tail) || IsStringTerm(tail)) { if (IsAtomTerm(tail) || IsStringTerm(tail)) {
fstr = NULL; fstr = NULL;
} }
@ -999,12 +990,9 @@ static Int doformat(volatile Term otail, volatile Term oargs,
if (GLOBAL_Stream[sno].status & InMemory_Stream_f) { if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler; GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
} }
if (!alloc_fstr) fstr = NULL;
fstr = NULL; targs = NULL;
if (mytargs == targs) { format_clean_up(sno, sno0, finfo);
targs = NULL;
}
format_clean_up(sno, sno0, &finfo, fstr, targs);
return (TRUE); return (TRUE);
} }

103
os/iopreds.c
View File

@ -199,62 +199,60 @@ static Term is_file_errors(Term t) {
return TermZERO; return TermZERO;
} }
int ResetEOF(StreamDesc *s) { int ResetEOF(StreamDesc *s) {
if (s->status & Eof_Error_Stream_f) { if (s->status & Eof_Error_Stream_f) {
Atom name = s->name; Atom name = s->name;
// Yap_CloseStream(s - GLOBAL_Stream); // Yap_CloseStream(s - GLOBAL_Stream);
Yap_Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, MkAtomTerm(name), Yap_Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, MkAtomTerm(name),
"GetC"); "GetC");
return FALSE; return FALSE;
} else if (s->status & Reset_Eof_Stream_f) { } else if (s->status & Reset_Eof_Stream_f) {
s->status &= ~Push_Eof_Stream_f; s->status &= ~Push_Eof_Stream_f;
/* reset the eof indicator on file */ /* reset the eof indicator on file */
if (feof(s->file)) if (feof(s->file))
clearerr(s->file); clearerr(s->file);
/* reset our function for reading input */ /* reset our function for reading input */
Yap_DefaultStreamOps(s); Yap_DefaultStreamOps(s);
/* next, reset our own error indicator */ /* next, reset our own error indicator */
s->status &= ~Eof_Stream_f; s->status &= ~Eof_Stream_f;
/* try reading again */ /* try reading again */
return TRUE; return TRUE;
} else { } else {
s->status |= Past_Eof_Stream_f; s->status |= Past_Eof_Stream_f;
return FALSE; return FALSE;
} }
} }
/* handle reading from a stream after having found an EOF */ /* handle reading from a stream after having found an EOF */
static int EOFWGetc(int sno) { static int EOFWGetc(int sno) {
register StreamDesc *s = &GLOBAL_Stream[sno]; register StreamDesc *s = &GLOBAL_Stream[sno];
if (s->status & Push_Eof_Stream_f) { if (s->status & Push_Eof_Stream_f) {
/* ok, we have pushed an EOF, send it away */ /* ok, we have pushed an EOF, send it away */
s->status &= ~Push_Eof_Stream_f; s->status &= ~Push_Eof_Stream_f;
return EOF;
}
if (ResetEOF(s)) {
Yap_DefaultStreamOps(s);
return (s->stream_wgetc(sno));
}
return EOF; return EOF;
}
if (ResetEOF(s)) {
Yap_DefaultStreamOps(s);
return (s->stream_wgetc(sno));
}
return EOF;
} }
static int EOFGetc(int sno) { static int EOFGetc(int sno) {
register StreamDesc *s = &GLOBAL_Stream[sno]; register StreamDesc *s = &GLOBAL_Stream[sno];
if (s->status & Push_Eof_Stream_f) { if (s->status & Push_Eof_Stream_f) {
/* ok, we have pushed an EOF, send it away */ /* ok, we have pushed an EOF, send it away */
s->status &= ~Push_Eof_Stream_f; s->status &= ~Push_Eof_Stream_f;
ResetEOF(s); ResetEOF(s);
return EOF;
}
if (ResetEOF(s)) {
Yap_DefaultStreamOps(s);
return s->stream_getc(sno);
}
return EOF; return EOF;
}
if (ResetEOF(s)) {
Yap_DefaultStreamOps(s);
return s->stream_getc(sno);
}
return EOF;
} }
static void unix_upd_stream_info(StreamDesc *s) { static void unix_upd_stream_info(StreamDesc *s) {
@ -352,18 +350,22 @@ void Yap_DefaultStreamOps(StreamDesc *st) {
st->stream_getc = Yap_popChar; st->stream_getc = Yap_popChar;
st->stream_wgetc = Yap_popChar; st->stream_wgetc = Yap_popChar;
} }
if (st->file) { if (st->file) {
st->stream_peek = Yap_peekWithGetc; if (st->status & Readline_Stream_f) {
st->stream_wpeek = Yap_peekWideWithGetwc; st->stream_peek = Yap_ReadlinePeekChar;
st->stream_wpeek = Yap_ReadlinePeekChar;
} else if (st->status & Seekable_Stream_f ) { } else {
st->stream_peek = Yap_peekWithGetc;
st->stream_wpeek = Yap_peekWideWithGetwc;
}
} else if (st->status & Seekable_Stream_f) {
st->stream_peek = Yap_peekWithSeek; st->stream_peek = Yap_peekWithSeek;
st->stream_wpeek = Yap_peekWideWithSeek; st->stream_wpeek = Yap_peekWideWithSeek;
} else { } else {
st->stream_peek = Yap_peekChar; st->stream_peek = Yap_peekChar;
st->stream_wpeek = Yap_peekWide; st->stream_wpeek = Yap_peekWide;
} }
if (st->status & Eof_Stream_f ) { if (st->status & Eof_Stream_f) {
st->stream_peek = EOFPeek; st->stream_peek = EOFPeek;
st->stream_wpeek = EOFPeek; st->stream_wpeek = EOFPeek;
st->stream_getc = EOFGetc; st->stream_getc = EOFGetc;
@ -665,7 +667,6 @@ static int NullPutc(int sno, int ch) {
return ((int)ch); return ((int)ch);
} }
/* check if we read a LOCAL_newline or an EOF */ /* check if we read a LOCAL_newline or an EOF */
int console_post_process_eof(StreamDesc *s) { int console_post_process_eof(StreamDesc *s) {
CACHE_REGS CACHE_REGS

9
os/readline.c
View File

@ -253,7 +253,7 @@ void Yap_ReadlineFlush(int sno) {
} }
} }
bool Yap_readline_clear_pending_input(StreamDesc *s) { bool Yap_readline_clear_pending_input(StreamDesc *s) {
#if HAVE_RL_CLEAR_PENDING_INPUT #if HAVE_RL_CLEAR_PENDING_INPUT
rl_clear_pending_input(); rl_clear_pending_input();
#endif #endif
@ -267,9 +267,12 @@ bool Yap_readline_clear_pending_input(StreamDesc *s) {
bool Yap_ReadlineOps(StreamDesc *s) { bool Yap_ReadlineOps(StreamDesc *s) {
if (s->status & Tty_Stream_f) { if (s->status & Tty_Stream_f) {
if (GLOBAL_Stream[0].status & (Input_Stream_f | Tty_Stream_f) && if (GLOBAL_Stream[0].status & (Input_Stream_f | Tty_Stream_f) &&
is_same_tty(s->file, GLOBAL_Stream[0].file)) is_same_tty(s->file, GLOBAL_Stream[0].file)) {
s->stream_getc = ReadlineGetc; s->stream_getc = ReadlineGetc;
s->status |= Readline_Stream_f; s->stream_peek = Yap_ReadlinePeekChar;
s->stream_wpeek = Yap_ReadlinePeekChar;
s->status |= Readline_Stream_f;
}
return true; return true;
} }
return false; return false;

6
os/sysbits.c
View File

@ -1373,12 +1373,10 @@ static Int p_mv(USES_REGS1) { /* rename(+OldName,+NewName) */
} else if (!IsAtomTerm(t2)) { } else if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom"); Yap_Error(TYPE_ERROR_ATOM, t2, "second argument to rename/2 not atom");
} else { } else {
oldname = Yap_VFAlloc((RepAtom(AtomOfTerm(t1)))->StrOfAE); oldname = RepAtom(AtomOfTerm(t1))->StrOfAE;
newname = Yap_VFAlloc((RepAtom(AtomOfTerm(t2)))->StrOfAE); newname = RepAtom(AtomOfTerm(t2))->StrOfAE;
if ((r = link(oldname, newname)) == 0 && (r = unlink(oldname)) != 0) if ((r = link(oldname, newname)) == 0 && (r = unlink(oldname)) != 0)
unlink(newname); unlink(newname);
free(oldname);
free(newname);
if (r != 0) { if (r != 0) {
#if HAVE_STRERROR #if HAVE_STRERROR
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t2, "%s in rename(%s,%s)", Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, t2, "%s in rename(%s,%s)",

2
packages/ProbLog/problog/nestedtries.yap
View File

@ -243,7 +243,7 @@
problog_define_flag(refine_anclst, problog_flag_validate_boolean, 'refine the ancestor list with their childs', false, nested_tries), problog_define_flag(refine_anclst, problog_flag_validate_boolean, 'refine the ancestor list with their childs', false, nested_tries),
problog_define_flag(anclst_represent,problog_flag_validate_in_list([list, integer]), 'represent the ancestor list', list, nested_tries) problog_define_flag(anclst_represent,problog_flag_validate_in_list([list, integer]), 'represent the ancestor list', list, nested_tries)
)). )).
:- stop_low_level_trace.
trie_replace_entry(_Trie, Entry, E, false):- trie_replace_entry(_Trie, Entry, E, false):-
trie_get_entry(Entry, Proof), trie_get_entry(Entry, Proof),

5
packages/python/swig/yap4py/yapi.py
View File

@ -11,12 +11,11 @@ from .yap import *
class Engine( YAPEngine ): class Engine( YAPEngine ):
def __init__(self, args=None,**kwargs): def __init__(self, args=None,self_contained=False,**kwargs):
# type: (object) -> object # type: (object) -> object
self.contained = False
if not args: if not args:
args = EngineArgs(**kwargs) args = EngineArgs(**kwargs)
if self.contained: if self_contained:
yap_lib_path = os.path.dirname(__file__) yap_lib_path = os.path.dirname(__file__)
args.setYapShareDir(os.path.join(yap_lib_path, "prolog")) args.setYapShareDir(os.path.join(yap_lib_path, "prolog"))
args.setYapLibDir(yap_lib_path) args.setYapLibDir(yap_lib_path)

13
packages/python/yap_kernel/yap_ipython/prolog/jupyter.yap
View File

@ -27,10 +27,11 @@
:- python_import(sys). :- python_import(sys).
user:jupyter_query(Self, Cell, Line ) :- user:jupyter_query(Self, Cell, Line ) :-
start_low_level_trace,
setup_call_cleanup( setup_call_cleanup(
enter_cell(Self), jupyter: enter_cell(Self),
jupyter_cell(Self, Cell, Line), jupyter:jupyter_cell(Self, Cell, Line),
exit_cell(Self) jupyter:exit_cell(Self)
). ).
jupyter_cell(_Self, Cell, _) :- jupyter_cell(_Self, Cell, _) :-
@ -39,7 +40,7 @@ jupyter_cell(_Self, Cell, _) :-
jupyter_cell( _Self, _, Line ) :- jupyter_cell( _Self, _, Line ) :-
blank( Line ), blank( Line ),
!. !.
jupyter_cell( Self, _, [] ) :- !. jupyter_cell( _Self, _, [] ) :- !.
jupyter_cell( Self, _, Line ) :- jupyter_cell( Self, _, Line ) :-
python_query( Self, Line ). python_query( Self, Line ).
@ -177,7 +178,7 @@ ready(_Self, Line ) :-
!. !.
ready(Self, Line ) :- ready(Self, Line ) :-
errors( Self, Line ), errors( Self, Line ),
\+ syntax_error(_,_). \+ syntax_error(_,_).
user:errors( Self, Text ) :- user:errors( Self, Text ) :-
setup_call_cleanup( setup_call_cleanup(
@ -245,7 +246,7 @@ open_events(Self, Text, Stream) :-
assert( syntax_error(Cause,LN,CharPos,Details) ) assert( syntax_error(Cause,LN,CharPos,Details) )
)). )).
close_events( Self ) :- close_events( _Self ) :-
retract( undo(G) ), retract( undo(G) ),
call(G), call(G),
fail. fail.

8
packages/python/yap_kernel/yap_ipython/yapi.py
View File

@ -61,7 +61,7 @@ class YAPInputSplitter(InputSplitter):
def __init__(self, line_input_checker=True, physical_line_transforms=None, def __init__(self, line_input_checker=True, physical_line_transforms=None,
logical_line_transforms=None): logical_line_transforms=None):
self._buffer_raw = [] self._buffer_raw = []
self._validate = True v self._validate = True
self.yapeng = None self.yapeng = None
if physical_line_transforms is not None: if physical_line_transforms is not None:
@ -524,7 +524,7 @@ class YAPRun:
return self.errors return self.errors
def jupyter_query(self, s): def jupyter_query(self, s):
# import pdb; pdb.set_trace() import pdb; pdb.set_trace()
# #
# construct a self.query from a one-line string # construct a self.query from a one-line string
# self.q is opaque to Python # self.q is opaque to Python
@ -550,8 +550,8 @@ class YAPRun:
# atom match either symbols, or if no symbol exists, sttrings, In this case # atom match either symbols, or if no symbol exists, sttrings, In this case
# variable names should match strings # variable names should match strings
#for eq in vs: #for eq in vs:
# if not isinstance(eq[0],str): # if not isinstance(eq[0],str):x
# print( "Error: Variable Name matches a Python Symbol") xf # print( "Error: Variable Name matches a Python Symbol")
# return # return
# ask = True # ask = True
# launch the query # launch the query

32
pl/CMakeLists.txt
View File

@ -65,29 +65,25 @@ install(FILES ${PL_BOOT_SOURCES}
DESTINATION ${libpl}/pl DESTINATION ${libpl}/pl
) )
install(FILES ../library/ypp.yap install(FILES ../library/ypp.yap
DESTINATION ${libpl}/library DESTINATION ${libpl}/library)
) # )
if (ANDROID) # if (ANDROID OR CMAKE_CROSSCOMPILING)
add_custom_target(STARTUP # add_custom_target(STARTUP
DEPENDS ${PL_BOOT_SOURCES} # )
) # else()
else(CMAKE_CROSSCOMPILING) add_custom_target(STARTUP ALL
add_custom_target(STARTUP ALL SOURCES DEPENDS ${CMAKE_CURRENT_BINARY_DIR}/startup.yss)
DEPENDS ${PL_BOOT_SOURCES}
add_custom_command(OUTPUT ${CMAKE_CURRENT_BINARY_DIR}/startup.yss
COMMAND yap-bin -B${CMAKE_CURRENT_SOURCE_DIR}/boot.yap --output-saved-state=${CMAKE_CURRENT_BINARY_DIR}/startup.yss
DEPENDS ${PL_BOOT_SOURCES} yap-bin
) )
#else () #else ()
#add_custom_target(STARTUP ALL #add_custom_target(STARTUP ALL
# DEPENDS ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP} # DEPENDS ${CMAKE_TOP_BINARY_DIR}/${YAP_STARTUP}
# ) # )
install(CODE
"execute_process(COMMAND ${bindir}/yap -B
VERBATIM
WORKING_DIRECTORY ${dlls}
)")
# install(CODE "execute_process(COMMAND ./yap -B install(FILES ${CMAKE_CURRENT_BINARY_DIR}/startup.yss DESTINATION ${dlls} )
# WORKING_DIRECTORY ${CMAKE_TOP_BINARY_DIR})"
# DEPENDS Py4YAP ${PL_BOOT_SOURCES} yap-bin )
endif() #endif()

7
pl/absf.yap
View File

@ -159,13 +159,6 @@ absolute_file_name(user,user) :- !.
absolute_file_name(File0,File) :- absolute_file_name(File0,File) :-
'$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File). '$absolute_file_name'(File0,[access(none),file_type(txt),file_errors(fail),solutions(first)],File).
'$full_filename'(F0, F) :-
'$absolute_file_name'(F0,[access(read),
file_type(prolog),
file_errors(fail),
solutions(first),
expand(true)],F).
'$absolute_file_name'(File,LOpts,TrueFileName) :- '$absolute_file_name'(File,LOpts,TrueFileName) :-
% must_be_of_type( atom, File ), % must_be_of_type( atom, File ),
% look for solutions % look for solutions

7
pl/boot.yap
View File

@ -165,6 +165,8 @@ print_message(L,E) :-
% This is the YAP init file % This is the YAP init file
% should be consulted first step after booting % should be consulted first step after booting
:- '$mk_dynamic'(term_expansion/2).
:- c_compile('top.yap'). :- c_compile('top.yap').
% These are pseudo declarations % These are pseudo declarations
@ -237,7 +239,12 @@ print_message(L,E) :-
:- c_compile('os.yap'). :- c_compile('os.yap').
:- c_compile('errors.yap'). :- c_compile('errors.yap').
:- '$init_prolog'.
initialize_prolog :-
'$init_prolog'.
:- set_prolog_flag(verbose, silent).
%:- set_prolog_flag(verbose_file_search, true ). %:- set_prolog_flag(verbose_file_search, true ).
%:- yap_flag(write_strings,on). %:- yap_flag(write_strings,on).
%:- start_low_level_trace. %:- start_low_level_trace.

9
pl/consult.yap
View File

@ -807,18 +807,17 @@ nb_setval('$if_le1vel',0).
), ),
fail. fail.
'$exec_initialization_goals' :- '$exec_initialization_goals' :-
'$current_module'(M),
'__NB_getval__'('$lf_status', TOpts, fail), '__NB_getval__'('$lf_status', TOpts, fail),
'$lf_opt'( initialization, TOpts, Ref), '$lf_opt'( initialization, TOpts, Ref),
nb:nb_queue_close(Ref, Answers, []), nb:nb_queue_close(Ref, Answers, []),
lists:member(G, Answers), lists:member(G, Answers),
strip_module( M:G, M0, G0), '$yap_strip_module'( G, M0, G0),
( (
catch(M0:G0, Error, user:'$LoopError'(Error, top)) catch(M0:G0, Error, user:'$LoopError'(Error, top))
-> ->
true true
; ;
format(user_error,':- ~w:~w failed.~n',[M,G]) format(user_error,':- ~w:~w failed.~n',[M0,G0])
), ),
fail. fail.
'$exec_initialization_goals'. '$exec_initialization_goals'.
@ -877,7 +876,7 @@ nb_setval('$if_le1vel',0).
'$init_win_graphics', '$init_win_graphics',
fail. fail.
'$do_startup_reconsult'(X) :- '$do_startup_reconsult'(X) :-
catch(load_files(user:X, [silent(true)]), Error, '$LoopError'(Error, consult)), catch(load_files(user:X, [silent(false)]), Error, '$LoopError'(Error, consult)),
!, !,
( current_prolog_flag(halt_after_consult, false) -> true ; halt). ( current_prolog_flag(halt_after_consult, false) -> true ; halt).
'$do_startup_reconsult'(_). '$do_startup_reconsult'(_).
@ -1096,7 +1095,7 @@ exists_source(File) :-
'$undefined'('$absolute_file_name'(F0,[],F),prolog_complete), '$undefined'('$absolute_file_name'(F0,[],F),prolog_complete),
!, !,
absolute_file_system_path(F0, F). absolute_file_system_path(F0, F).
'$full_filename'(F0, F) :- '$full_filename'(F0, F) :-
'$absolute_file_name'(F0,[access(read), '$absolute_file_name'(F0,[access(read),
file_type(prolog), file_type(prolog),
file_errors(fail), file_errors(fail),

4
pl/directives.yap
View File

@ -136,6 +136,8 @@ considered.
*/ */
'$exec_directive'(M:A, Status, _M, VL, Pos) :-
'$exec_directives'(A, Status, M, VL, Pos).
'$exec_directive'(initialization(D), _, M, _, _) :- '$exec_directive'(initialization(D), _, M, _, _) :-
'$initialization'(M:D). '$initialization'(M:D).
'$exec_directive'(initialization(D,OPT), _, M, _, _) :- '$exec_directive'(initialization(D,OPT), _, M, _, _) :-
@ -272,7 +274,7 @@ user_defined_directive(Dir,Action) :-
% %
% but YAP and SICStus do. % but YAP and SICStus do.
% %
'$process_directive'(G, _Mode, M, _VL, _Pos) :- '$process_directive'(G, _Mode, M, _VL, _Pos) :-
'$execute'(M:G), '$execute'(M:G),
!. !.
'$process_directive'(G, _Mode, M, _VL, _Pos) :- '$process_directive'(G, _Mode, M, _VL, _Pos) :-

9
pl/meta.yap
View File

@ -66,11 +66,11 @@ meta_predicate declaration
fail. fail.
'$meta_predicate'( _D, _M ). '$meta_predicate'( _D, _M ).
'$install_meta_predicate'(P,M,F,N) :- '$install_meta_predicate'(_P,M,F,N) :-
writeln(P),
retractall(prolog:'$meta_predicate'(F,M,N,_)), retractall(prolog:'$meta_predicate'(F,M,N,_)),
fail. fail.
'$install_meta_predicate'(P,M,F,N) :- '$install_meta_predicate'(P,M,F,N) :-
'$new_meta_pred'(P, M),
assertz('$meta_predicate'(F,M,N,P)). assertz('$meta_predicate'(F,M,N,P)).
% comma has its own problems. % comma has its own problems.
@ -379,7 +379,7 @@ o:p(B) :- n:g, X is 2+3, call(B).
'$user_expansion'(M0N:G0N, M1:G1), '$user_expansion'(M0N:G0N, M1:G1),
'$import_expansion'(M1:G1, M2:G2), '$import_expansion'(M1:G1, M2:G2),
'$meta_expansion'(M2:G2, M1, HVars, M2B1F), '$meta_expansion'(M2:G2, M1, HVars, M2B1F),
'$yap_strip_module'(M2B1F, M3, B1F), '$yap_strip_module'(M2B1F, M3, B1F),
'$end_goal_expansion'(B1F, G1F, GOF, HM, SM, M3, H). '$end_goal_expansion'(B1F, G1F, GOF, HM, SM, M3, H).
'$end_goal_expansion'(G, G1F, GOF, HM, SM, BM, H) :- '$end_goal_expansion'(G, G1F, GOF, HM, SM, BM, H) :-
@ -494,7 +494,7 @@ expand_goal(Input, Output) :-
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G), '$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
'$yap_strip_module'(M:GF0, MF, GF). '$yap_strip_module'(M:GF0, MF, GF).
:- '$install_meta_predicate'((_,_),_,(','),2). :- '$install_meta_predicate'((0,0),_,(','),2).
:- meta_predicate :- meta_predicate
abolish(:), abolish(:),
@ -556,6 +556,7 @@ expand_goal(Input, Output) :-
if(0,0,0), if(0,0,0),
ignore(0), ignore(0),
incore(0), incore(0),
initializon(0),
multifile(:), multifile(:),
nospy(:), nospy(:),
not(0), not(0),

1
pl/preds.yap
View File

@ -218,6 +218,7 @@ clause(V0,Q,R) :-
'$init_preds' :- '$init_preds' :-
once('$do_log_upd_clause_erase'(_,_,_,_,_,_)), once('$do_log_upd_clause_erase'(_,_,_,_,_,_)),
fail. fail.
'$init_preds'. '$init_preds'.
:- '$init_preds'. :- '$init_preds'.

65
pl/top.yap
View File

@ -1,6 +1,7 @@
live :- live :- '$live'.
initialize_prolog,
'$live' :-
repeat, repeat,
'$current_module'(Module), '$current_module'(Module),
( Module==user -> ( Module==user ->
@ -10,12 +11,6 @@ live :-
), ),
'$system_catch'('$enter_top_level',Module,Error,'$Error'(Error)). '$system_catch'('$enter_top_level',Module,Error,'$Error'(Error)).
initialize_prolog :-
'$init_system'.
'$init_globals' :- '$init_globals' :-
% set_prolog_flag(break_level, 0), % set_prolog_flag(break_level, 0),
% '$set_read_error_handler'(error), let the user do that % '$set_read_error_handler'(error), let the user do that
@ -62,20 +57,14 @@ initialize_prolog :-
current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ), current_prolog_flag(version_data, yap(Mj, Mi, Patch, _) ),
current_prolog_flag(resource_database, Saved ), current_prolog_flag(resource_database, Saved ),
format(user_error, '% YAP ~d.~d.~d-~a (compiled ~a)~n', [Mj,Mi, Patch, VERSIONGIT, AT]), format(user_error, '% YAP ~d.~d.~d-~a (compiled ~a)~n', [Mj,Mi, Patch, VERSIONGIT, AT]),
format(user_error, '% database loaded from ~a~n', [Saved]), format(user_error, '% database loaded from ~a~n', [Saved]).
fail.
'$version'.
'$init_system' :- '$init_prolog' :-
get_value('$yap_inited', true), !.
'$init_system' :-
set_value('$yap_inited', true), % start_low_level_trace,
% do catch as early as possible % do catch as early as possible
'$version', '$version',
current_prolog_flag(file_name_variables, OldF), yap_flag(file_name_variables, _OldF, true),
set_prolog_flag(file_name_variables, true),
'$init_consult', '$init_consult',
set_prolog_flag(file_name_variables, OldF), %set_prolog_flag(file_name_variables, OldF),
'$init_globals', '$init_globals',
set_prolog_flag(fileerrors, true), set_prolog_flag(fileerrors, true),
set_value('$gc',on), set_value('$gc',on),
@ -100,7 +89,6 @@ initialize_prolog :-
'$init_or_threads', '$init_or_threads',
'$run_at_thread_start'. '$run_at_thread_start'.
% Start file for yap % Start file for yap
/* I/O predicates */ /* I/O predicates */
@ -113,11 +101,11 @@ initialize_prolog :-
*/ */
/* main execution loop */ /* main execution loop */
'$read_toplevel'(Goal, Bindings) :- '$read_toplevel'(Goal, Bindings, Pos) :-
'$prompt', '$prompt',
catch(read_term(user_input, catch(read_term(user_input,
Goal, Goal,
[variable_names(Bindings), syntax_errors(dec10)]), [variable_names(Bindings), syntax_errors(dec10), term_position(Pos)]),
E, '$handle_toplevel_error'( E) ). E, '$handle_toplevel_error'( E) ).
'$handle_toplevel_error'( syntax_error(_)) :- '$handle_toplevel_error'( syntax_error(_)) :-
@ -144,7 +132,18 @@ initialize_prolog :-
get_value('$top_level_goal',GA), GA \= [], !, get_value('$top_level_goal',GA), GA \= [], !,
set_value('$top_level_goal',[]), set_value('$top_level_goal',[]),
'$run_atom_goal'(GA), '$run_atom_goal'(GA),
current_prolog_flag(break_level, BreakLevel), fail.
'$enter_top_level' :-
flush_output,
'$run_toplevel_hooks',
prompt1(' ?- '),
'$read_toplevel'(Command,Varnames,Pos),
nb_setval('$spy_gn',1),
% stop at spy-points if debugging is on.
nb_setval('$debug_run',off),
nb_setval('$debug_jump',off),
'$command'(Command,Varnames,Pos,top),
current_prolog_flag(break_level, BreakLevel),
( (
BreakLevel \= 0 BreakLevel \= 0
-> ->
@ -211,20 +210,26 @@ initialize_prolog :-
'__NB_getval__'('$if_skip_mode', skip, fail), '__NB_getval__'('$if_skip_mode', skip, fail),
\+ '$if_directive'(Command), \+ '$if_directive'(Command),
!. !.
'$execute_command'((:-G1),VL,Pos,Option,_) :- '$execute_command'((:-G),VL,Pos,Option,_) :-
% !, % !,
Option \= top, !, Option \= top,
% allow user expansion !, % allow user expansion
'$yap_strip_module'(G1, M, G2), catch(expand_term((:- G), O),_O, fail),
'$process_directive'(G2, Option, M, VL, Pos). (
'$execute_command'((?-G), VL, Pos, Option, Source) :- O = (:- G1)
->
'$yap_strip_module'(G1, M, G2),
'$process_directive'(G2, Option, M, VL, Pos)
;
'$execute_commands'(G1,VL,Pos,Option,O)
).
'$execute_command'((?-G), VL, Pos, Option, Source) :-
Option \= top, Option \= top,
!, !,
'$execute_command'(G, VL, Pos, top, Source). '$execute_command'(G, VL, Pos, top, Source).
'$execute_command'(G, VL, Pos, Option, Source) :- '$execute_command'(G, VL, Pos, Option, Source) :-
'$continue_with_command'(Option, VL, Pos, G, Source). '$continue_with_command'(Option, VL, Pos, G, Source).
'$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :- '$continue_with_command'(Where,V,'$stream_position'(C,_P,A1,A2,A3),'$source_location'(_F,L):G,Source) :-
!, !,
'$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source). '$continue_with_command'(Where,V,'$stream_position'(C,L,A1,A2,A3),G,Source).