keep on working on exs.
This commit is contained in:
Vitor Santos Costa
parent
bc3555dfbf
commit
7ce963b63c
|
|
@ -2099,7 +2099,7 @@ X_API void YAP_ClearExceptions(void) {
|
|||
Yap_ResetException(worker_id);
|
||||
}
|
||||
|
||||
X_API int YAP_InitConsult(int mode, const char *fname, char *full, int *osnop) {
|
||||
X_API int YAP_InitConsult(int mode, const char *fname, char **full, int *osnop) {
|
||||
CACHE_REGS
|
||||
int sno;
|
||||
BACKUP_MACHINE_REGS();
|
||||
|
|
@ -2114,19 +2114,25 @@ X_API int YAP_InitConsult(int mode, const char *fname, char *full, int *osnop) {
|
|||
fl = Yap_AbsoluteFile(fname, true);
|
||||
if (!fl || !fl[0]) {
|
||||
pop_text_stack(lvl);
|
||||
*full = NULL;
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
bool consulted = (mode == YAP_CONSULT_MODE);
|
||||
sno = Yap_OpenStream(fl, "r", MkAtomTerm(Yap_LookupAtom(fl)), LOCAL_encoding);
|
||||
if (sno < 0)
|
||||
return sno;
|
||||
if (!Yap_ChDir(dirname((char *)fl))) return -1;
|
||||
if (sno < 0 ||
|
||||
!Yap_ChDir(dirname((char *)fl))) {
|
||||
pop_text_stack(lvl);
|
||||
*full = NULL;
|
||||
return -1;
|
||||
}
|
||||
LOCAL_PrologMode = UserMode;
|
||||
|
||||
Yap_init_consult(consulted, fl);
|
||||
GLOBAL_Stream[sno].name = Yap_LookupAtom(fl);
|
||||
GLOBAL_Stream[sno].user_name = MkAtomTerm(Yap_LookupAtom(fname));
|
||||
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
|
||||
pop_text_stack(lvl);
|
||||
*full = pop_output_text_stack(lvl, fl);
|
||||
RECOVER_MACHINE_REGS();
|
||||
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
||||
return sno;
|
||||
|
|
@ -2285,8 +2291,6 @@ X_API bool YAP_CompileClause(Term t) {
|
|||
}
|
||||
RECOVER_MACHINE_REGS();
|
||||
if (!ok) {
|
||||
t = Yap_GetException();
|
||||
Yap_DebugPlWrite(t);
|
||||
return NULL;
|
||||
}
|
||||
return ok;
|
||||
|
|
|
|||
|
|
@ -2724,7 +2724,7 @@ static Int new_meta_pred(USES_REGS1) {
|
|||
|
||||
pe = new_pred(Deref(ARG1), Deref(ARG2), "meta_predicate");
|
||||
if (EndOfPAEntr(pe))
|
||||
return FALSE;
|
||||
return false;
|
||||
PELOCK(30, pe);
|
||||
arity = pe->ArityOfPE;
|
||||
if (arity == 0)
|
||||
|
|
|
|||
941
C/errors.c
941
C/errors.c
File diff suppressed because it is too large
Load Diff
586
C/exec.c
586
C/exec.c
|
|
@ -47,7 +47,7 @@ static choiceptr cp_from_integer(Term cpt USES_REGS) {
|
|||
*/
|
||||
Term Yap_cp_as_integer(choiceptr cp) {
|
||||
CACHE_REGS
|
||||
return cp_as_integer(cp PASS_REGS);
|
||||
return cp_as_integer(cp PASS_REGS);
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -127,7 +127,7 @@ inline static bool CallMetaCall(Term t, Term mod USES_REGS) {
|
|||
*/
|
||||
Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
|
||||
CACHE_REGS
|
||||
Term ts[4];
|
||||
Term ts[4];
|
||||
ts[0] = g;
|
||||
ts[1] = cp_as_integer(B PASS_REGS); /* p_current_choice_point */
|
||||
ts[2] = g;
|
||||
|
|
@ -140,8 +140,8 @@ Term Yap_ExecuteCallMetaCall(Term g, Term mod) {
|
|||
|
||||
Term Yap_PredicateIndicator(Term t, Term mod) {
|
||||
CACHE_REGS
|
||||
// generate predicate indicator in this case
|
||||
Term ti[2];
|
||||
// generate predicate indicator in this case
|
||||
Term ti[2];
|
||||
t = Yap_YapStripModule(t, &mod);
|
||||
if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) {
|
||||
ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t)));
|
||||
|
|
@ -214,7 +214,7 @@ static Int save_env_b(USES_REGS1) {
|
|||
static PredEntry *new_pred(Term t, Term tmod, char *pname) {
|
||||
Term t0 = t;
|
||||
|
||||
restart:
|
||||
restart:
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t0, pname);
|
||||
return NULL;
|
||||
|
|
@ -392,7 +392,7 @@ inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) {
|
|||
int j = -n;
|
||||
Term t0 = t, mod0 = mod;
|
||||
|
||||
restart_exec:
|
||||
restart_exec:
|
||||
if (IsVarTerm(t)) {
|
||||
return CallError(INSTANTIATION_ERROR, t0, mod0 PASS_REGS);
|
||||
} else if (IsAtomTerm(t)) {
|
||||
|
|
@ -431,8 +431,8 @@ restart_exec:
|
|||
}
|
||||
if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled) {
|
||||
return EnterCreepMode(
|
||||
copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS),
|
||||
mod PASS_REGS);
|
||||
copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS),
|
||||
mod PASS_REGS);
|
||||
}
|
||||
if (arity > MaxTemps) {
|
||||
return CallError(TYPE_ERROR_CALLABLE, t0, mod0 PASS_REGS);
|
||||
|
|
@ -441,8 +441,8 @@ restart_exec:
|
|||
/* You thought we would be over by now */
|
||||
/* but no meta calls require special preprocessing */
|
||||
// if (pen->PredFlags & (MetaPredFlag | UndefPredFlag)) {
|
||||
// Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
|
||||
//return (CallMetaCall(t0, mod0 PASS_REGS));
|
||||
// Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS);
|
||||
//return (CallMetaCall(t0, mod0 PASS_REGS));
|
||||
//}
|
||||
/* now let us do what we wanted to do from the beginning !! */
|
||||
/* I cannot use the standard macro here because
|
||||
|
|
@ -649,7 +649,7 @@ static Int execute_clause(USES_REGS1) { /* '$execute_clause'(Goal) */
|
|||
yamop *code;
|
||||
Term clt = Deref(ARG3);
|
||||
|
||||
restart_exec:
|
||||
restart_exec:
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
|
||||
return FALSE;
|
||||
|
|
@ -817,8 +817,8 @@ static bool watch_cut(Term ext USES_REGS) {
|
|||
}
|
||||
CELL *port_pt = deref_ptr(RepAppl(task) + 2);
|
||||
CELL *completion_pt = deref_ptr(RepAppl(task) + 4);
|
||||
if ((ex_mode = Yap_HasException())) {
|
||||
e = Yap_GetException();
|
||||
if (LOCAL_CommittedError) {
|
||||
e = MkErrorTerm(LOCAL_CommittedError);
|
||||
Term t;
|
||||
if (active) {
|
||||
t = Yap_MkApplTerm(FunctorException, 1, &e);
|
||||
|
|
@ -873,8 +873,9 @@ static bool watch_retry(Term d0 USES_REGS) {
|
|||
// just do the frrpest
|
||||
if (B >= B0 && !ex_mode && !active)
|
||||
return true;
|
||||
if ((ex_mode = Yap_HasException())) {
|
||||
e = Yap_GetException();
|
||||
if (LOCAL_CommittedError &&
|
||||
LOCAL_CommittedError->errorNo != YAP_NO_ERROR) {
|
||||
e = MkErrorTerm(LOCAL_CommittedError);
|
||||
if (active) {
|
||||
t = Yap_MkApplTerm(FunctorException, 1, &e);
|
||||
} else {
|
||||
|
|
@ -980,9 +981,9 @@ static Int cleanup_on_exit(USES_REGS1) {
|
|||
|
||||
static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) {
|
||||
CACHE_REGS
|
||||
if (creeping) {
|
||||
Yap_signal(YAP_CREEP_SIGNAL);
|
||||
}
|
||||
if (creeping) {
|
||||
Yap_signal(YAP_CREEP_SIGNAL);
|
||||
}
|
||||
CurrentModule = omod;
|
||||
Yap_CloseSlots(sl);
|
||||
if (out) {
|
||||
|
|
@ -1012,7 +1013,7 @@ static Int _user_expand_goal(USES_REGS1) {
|
|||
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
|
||||
ARG2 = Yap_GetFromSlot(h2);
|
||||
if ((pe = RepPredProp(
|
||||
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
|
||||
Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE))) &&
|
||||
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
|
||||
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
|
||||
return complete_ge(true, omod, sl, creeping);
|
||||
|
|
@ -1022,7 +1023,7 @@ static Int _user_expand_goal(USES_REGS1) {
|
|||
ARG3 = Yap_GetFromSlot(h2);
|
||||
/* user:goal_expansion(A,CurMod,B) */
|
||||
if ((pe = RepPredProp(
|
||||
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
|
||||
Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE))) &&
|
||||
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
|
||||
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
|
||||
return complete_ge(true, omod, sl, creeping);
|
||||
|
|
@ -1034,7 +1035,7 @@ static Int _user_expand_goal(USES_REGS1) {
|
|||
/* user:goal_expansion(A,B) */
|
||||
if (cmod != USER_MODULE && /* we have tried this before */
|
||||
(pe = RepPredProp(
|
||||
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
|
||||
Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE))) &&
|
||||
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
|
||||
Yap_execute_pred(pe, NULL PASS_REGS, false)) {
|
||||
return complete_ge(true, omod, sl, creeping);
|
||||
|
|
@ -1054,7 +1055,7 @@ static Int do_term_expansion(USES_REGS1) {
|
|||
|
||||
ARG1 = g;
|
||||
if ((pe = RepPredProp(
|
||||
Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
|
||||
Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE))) &&
|
||||
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
|
||||
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
|
||||
return complete_ge(true, omod, sl, creeping);
|
||||
|
|
@ -1073,7 +1074,7 @@ static Int do_term_expansion(USES_REGS1) {
|
|||
ARG1 = Yap_MkApplTerm(FunctorModule, 2, mg_args);
|
||||
ARG2 = Yap_GetFromSlot(h2);
|
||||
if ((pe = RepPredProp(
|
||||
Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
|
||||
Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE))) &&
|
||||
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
|
||||
Yap_execute_pred(pe, NULL, false PASS_REGS)) {
|
||||
return complete_ge(true, omod, sl, creeping);
|
||||
|
|
@ -1091,7 +1092,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */
|
|||
return EnterCreepMode(t, mod PASS_REGS);
|
||||
}
|
||||
t = Yap_YapStripModule(t, &mod);
|
||||
restart_exec:
|
||||
restart_exec:
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1");
|
||||
return false;
|
||||
|
|
@ -1390,86 +1391,86 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
|
|||
|
||||
sigjmp_buf signew, *sighold = LOCAL_RestartEnv;
|
||||
LOCAL_RestartEnv = &signew;
|
||||
REGSTORE *old_rs = Yap_regp;
|
||||
|
||||
if (top && (lval = sigsetjmp(signew, 1)) != 0) {
|
||||
switch (lval) {
|
||||
case 1: { /* restart */
|
||||
switch (lval) {
|
||||
case 1: { /* restart */
|
||||
/* otherwise, SetDBForThrow will fail entering critical mode */
|
||||
LOCAL_PrologMode = UserMode;
|
||||
/* find out where to cut to */
|
||||
/* siglongjmp resets the TR hardware register */
|
||||
/* TR and B are crucial, they might have been changed, or not */
|
||||
restore_TR();
|
||||
restore_B();
|
||||
/* H is not so important, because we're gonna backtrack */
|
||||
restore_H();
|
||||
/* set stack */
|
||||
ASP = (CELL *) PROTECT_FROZEN_B(B);
|
||||
/* forget any signals active, we're reborne */
|
||||
LOCAL_Signals = 0;
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
LOCAL_PrologMode = UserMode;
|
||||
P = (yamop *) FAILCODE;
|
||||
}
|
||||
break;
|
||||
case 2: {
|
||||
/* arithmetic exception */
|
||||
/* must be done here, otherwise siglongjmp will clobber all the
|
||||
* registers
|
||||
*/
|
||||
/* reset the registers so that we don't have trash in abstract
|
||||
* machine */
|
||||
Yap_set_fpu_exceptions(
|
||||
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
|
||||
P = (yamop *) FAILCODE;
|
||||
LOCAL_PrologMode = UserMode;
|
||||
}
|
||||
break;
|
||||
case 3: { /* saved state */
|
||||
LOCAL_CBorder = OldBorder;
|
||||
LOCAL_RestartEnv = sighold;
|
||||
LOCAL_PrologMode = UserMode;
|
||||
return false;
|
||||
}
|
||||
case 4:
|
||||
/* abort */
|
||||
/* can be called from anywhere, must reset registers,
|
||||
*/
|
||||
while (B) {
|
||||
LOCAL_ActiveError->errorNo = ABORT_EVENT;
|
||||
Yap_JumpToEnv();
|
||||
}
|
||||
LOCAL_PrologMode = UserMode;
|
||||
P = (yamop *) FAILCODE;
|
||||
LOCAL_RestartEnv = sighold;
|
||||
return false;
|
||||
break;
|
||||
case 5:
|
||||
// going up, unless there is no up to go to. or someone
|
||||
// but we should inform the caller on what happened.
|
||||
|
||||
Yap_regp = old_rs;
|
||||
restore_TR();
|
||||
restore_B();
|
||||
/* H is not so important, because we're gonna backtrack */
|
||||
restore_H();
|
||||
/* set stack */
|
||||
ASP = (CELL *) PROTECT_FROZEN_B(B);
|
||||
|
||||
if (B == NULL || B->cp_b == NULL || (CELL*)(B->cp_b) > LCL0 - LOCAL_CBorder) {
|
||||
LOCAL_RestartEnv = sighold;
|
||||
LOCAL_CBorder = OldBorder;
|
||||
return false;
|
||||
}
|
||||
P = FAILCODE;
|
||||
|
||||
LOCAL_PrologMode = UserMode;
|
||||
/* find out where to cut to */
|
||||
/* siglongjmp resets the TR hardware register */
|
||||
/* TR and B are crucial, they might have been changed, or not */
|
||||
restore_TR();
|
||||
restore_B();
|
||||
/* H is not so important, because we're gonna backtrack */
|
||||
restore_H();
|
||||
/* set stack */
|
||||
ASP = (CELL *) PROTECT_FROZEN_B(B);
|
||||
/* forget any signals active, we're reborne */
|
||||
LOCAL_Signals = 0;
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
LOCAL_PrologMode = UserMode;
|
||||
P = (yamop *) FAILCODE;
|
||||
}
|
||||
break;
|
||||
case 2: {
|
||||
/* arithmetic exception */
|
||||
/* must be done here, otherwise siglongjmp will clobber all the
|
||||
* registers
|
||||
*/
|
||||
/* reset the registers so that we don't have trash in abstract
|
||||
* machine */
|
||||
Yap_set_fpu_exceptions(
|
||||
getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
|
||||
P = (yamop *) FAILCODE;
|
||||
LOCAL_PrologMode = UserMode;
|
||||
}
|
||||
break;
|
||||
case 3: { /* saved state */
|
||||
LOCAL_CBorder = OldBorder;
|
||||
LOCAL_RestartEnv = sighold;
|
||||
LOCAL_PrologMode = UserMode;
|
||||
return false;
|
||||
}
|
||||
case 4:
|
||||
/* abort */
|
||||
/* can be called from anywhere, must reset registers,
|
||||
*/
|
||||
while (B) {
|
||||
LOCAL_ActiveError->errorNo = ABORT_EVENT;
|
||||
Yap_JumpToEnv();
|
||||
}
|
||||
LOCAL_PrologMode = UserMode;
|
||||
P = (yamop *) FAILCODE;
|
||||
LOCAL_RestartEnv = sighold;
|
||||
return false;
|
||||
break;
|
||||
case 5:
|
||||
// going up, unless there is no up to go to. or someone
|
||||
// but we should inform the caller on what happened.
|
||||
|
||||
// Yap_regp = old_rs;
|
||||
restore_TR();
|
||||
restore_B();
|
||||
/* H is not so important, because we're gonna backtrack */
|
||||
restore_H();
|
||||
/* set stack */
|
||||
Yap_JumpToEnv();
|
||||
ASP = (CELL *) PROTECT_FROZEN_B(B);
|
||||
|
||||
if (B == NULL || B->cp_b == NULL || (CELL*)(B->cp_b) > LCL0 - LOCAL_CBorder) {
|
||||
LOCAL_RestartEnv = sighold;
|
||||
LOCAL_CBorder = OldBorder;
|
||||
return false;
|
||||
}
|
||||
P = FAILCODE;
|
||||
|
||||
}
|
||||
}
|
||||
YENV = ASP;
|
||||
YENV[E_CB] = Unsigned(B);
|
||||
out = Yap_absmi(0);
|
||||
/* make sure we don't leave a FAIL signal hanging around */
|
||||
out = Yap_absmi(0);
|
||||
/* make sure we don't leave a FAIL signal hanging around */
|
||||
Yap_get_signal(YAP_FAIL_SIGNAL);
|
||||
if (!Yap_has_a_signal())
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
|
|
@ -1543,7 +1544,7 @@ static bool do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) {
|
|||
|
||||
bool Yap_exec_absmi(bool top, yap_reset_t has_reset) {
|
||||
CACHE_REGS
|
||||
return exec_absmi(top, has_reset PASS_REGS);
|
||||
return exec_absmi(top, has_reset PASS_REGS);
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -1572,7 +1573,7 @@ void Yap_fail_all(choiceptr bb USES_REGS) {
|
|||
DEPTH = B->cp_depth;
|
||||
#endif /* DEPTH_LIMIT */
|
||||
YENV = ENV = B->cp_env;
|
||||
/* recover local stack */
|
||||
/* recover local stack */
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH = ENV[E_DEPTH];
|
||||
#endif
|
||||
|
|
@ -1685,7 +1686,7 @@ bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) {
|
|||
|
||||
bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
|
||||
CACHE_REGS
|
||||
Prop pe;
|
||||
Prop pe;
|
||||
PredEntry *ppe;
|
||||
CELL *pt;
|
||||
/* preserve the current restart environment */
|
||||
|
|
@ -1722,7 +1723,7 @@ bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) {
|
|||
|
||||
void Yap_trust_last(void) {
|
||||
CACHE_REGS
|
||||
ASP = B->cp_env;
|
||||
ASP = B->cp_env;
|
||||
CP = B->cp_cp;
|
||||
HR = B->cp_h;
|
||||
#ifdef DEPTH_LIMIT
|
||||
|
|
@ -1740,7 +1741,7 @@ void Yap_trust_last(void) {
|
|||
|
||||
Term Yap_RunTopGoal(Term t, bool handle_errors) {
|
||||
CACHE_REGS
|
||||
yamop *CodeAdr;
|
||||
yamop *CodeAdr;
|
||||
Prop pe;
|
||||
PredEntry *ppe;
|
||||
CELL *pt;
|
||||
|
|
@ -1755,9 +1756,9 @@ Term Yap_RunTopGoal(Term t, bool handle_errors) {
|
|||
LOCAL_PrologMode &= ~TopGoalMode;
|
||||
return (FALSE);
|
||||
} if (IsPairTerm(t)) {
|
||||
Term ts[2];
|
||||
ts[0] = t;
|
||||
ts[1] = (CurrentModule == 0? TermProlog: CurrentModule);
|
||||
Term ts[2];
|
||||
ts[0] = t;
|
||||
ts[1] = (CurrentModule == 0? TermProlog: CurrentModule);
|
||||
t = Yap_MkApplTerm(FunctorCsult,2,ts);
|
||||
}
|
||||
if (IsAtomTerm(t)) {
|
||||
|
|
@ -1978,7 +1979,7 @@ static Int cut_up_to_next_disjunction(USES_REGS1) {
|
|||
*/
|
||||
bool Yap_Reset(yap_reset_t mode, bool hard) {
|
||||
CACHE_REGS
|
||||
int res = TRUE;
|
||||
int res = TRUE;
|
||||
|
||||
Yap_ResetException(worker_id);
|
||||
/* first, backtrack to the root */
|
||||
|
|
@ -2017,7 +2018,7 @@ bool is_cleanup_cp(choiceptr cp_b) {
|
|||
return pe == PredSafeCallCleanup;
|
||||
}
|
||||
|
||||
static Int JumpToEnv(USES_REGS1) {
|
||||
static Int JumpToEnv(USES_REGS1) {
|
||||
choiceptr handler = B;
|
||||
/* just keep the throwm object away, we don't need to care about it
|
||||
*/
|
||||
|
|
@ -2027,7 +2028,8 @@ bool is_cleanup_cp(choiceptr cp_b) {
|
|||
// DBTerm *dbt = Yap_RefToException();
|
||||
while (handler
|
||||
&& Yap_PredForChoicePt(handler, NULL) != PredDollarCatch
|
||||
&& LOCAL_CBorder < LCL0 - (CELL *)handler && handler->cp_ap != NOCODE
|
||||
&& LOCAL_CBorder < LCL0 - (CELL *)handler
|
||||
&& handler->cp_ap != NOCODE
|
||||
&& handler->cp_b != NULL
|
||||
) {
|
||||
//if (handler->cp_ap != NOCODE)
|
||||
|
|
@ -2039,236 +2041,230 @@ bool is_cleanup_cp(choiceptr cp_b) {
|
|||
Yap_signal(YAP_FAIL_SIGNAL);
|
||||
}
|
||||
|
||||
//B = handler;
|
||||
B = handler;
|
||||
P = FAILCODE;
|
||||
return true;
|
||||
}
|
||||
|
||||
bool Yap_JumpToEnv(void) {
|
||||
CACHE_REGS
|
||||
if (LOCAL_PrologMode & TopGoalMode)
|
||||
return true;
|
||||
if (LOCAL_PrologMode & TopGoalMode)
|
||||
return true;
|
||||
return JumpToEnv(PASS_REGS1);
|
||||
}
|
||||
|
||||
/* This does very nasty stuff!!!!! */
|
||||
static Int jump_env(USES_REGS1) {
|
||||
Term t = Deref(ARG1);
|
||||
Term t = Deref(ARG1), t0 = t, t1;
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t, "throw ball must be bound");
|
||||
return false;
|
||||
} else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorError) {
|
||||
Term t2;
|
||||
Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS);
|
||||
// LOCAL_Error_TYPE = ERROR_EVENT;
|
||||
Term t1 = ArgOfTerm(1, t);
|
||||
if (IsApplTerm(t1) && IsAtomTerm((t2 = ArgOfTerm(1, t1)))) {
|
||||
LOCAL_ActiveError->errorAsText = RepAtom(AtomOfTerm(t2))->StrOfAE;
|
||||
LOCAL_ActiveError->classAsText = RepAtom(NameOfFunctor(FunctorOfTerm(t1)))->StrOfAE;
|
||||
} else if (IsAtomTerm(t)) {
|
||||
LOCAL_ActiveError->errorAsText = RepAtom(AtomOfTerm(t1))->StrOfAE;
|
||||
LOCAL_ActiveError->classAsText = NULL;
|
||||
}
|
||||
} else {
|
||||
Yap_prolog_add_culprit(LOCAL_ActiveError PASS_REGS);
|
||||
LOCAL_ActiveError->errorAsText = NULL;
|
||||
LOCAL_ActiveError->classAsText = NULL;
|
||||
//return true;
|
||||
}
|
||||
LOCAL_ActiveError->prologPredName = NULL;
|
||||
bool out = JumpToEnv(PASS_REGS1);
|
||||
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
|
||||
LCL0 - (CELL *)B > LOCAL_CBorder) {
|
||||
// we're failing up to the top layer
|
||||
}
|
||||
return out;
|
||||
} else if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorError
|
||||
&& (t1 = ArgOfTerm(1, t))
|
||||
&& IsPairTerm((t = ArgOfTerm(2, t)))
|
||||
&& IsApplTerm((t = HeadOfTerm(t)))) {
|
||||
LOCAL_ActiveError = Yap_UserError(t, t1, LOCAL_ActiveError);
|
||||
} else {
|
||||
LOCAL_Error_TYPE = THROW_EVENT;
|
||||
LOCAL_ActiveError->errorAsText = NULL;
|
||||
LOCAL_ActiveError->errorRawTerm = Yap_SaveTerm(t);
|
||||
LOCAL_ActiveError->classAsText = NULL;
|
||||
//return true;
|
||||
}
|
||||
|
||||
/* set up a meta-call based on . context info */
|
||||
static Int generate_pred_info(USES_REGS1) {
|
||||
ARG1 = ARG3 = ENV[-EnvSizeInCells - 1];
|
||||
ARG4 = ENV[-EnvSizeInCells - 3];
|
||||
ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS);
|
||||
return TRUE;
|
||||
bool out = JumpToEnv(PASS_REGS1);
|
||||
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
|
||||
LCL0 - (CELL *)B > LOCAL_CBorder) {
|
||||
// we're failing up to the top layer
|
||||
}
|
||||
LOCAL_CommittedError = Yap_GetException();
|
||||
return out;
|
||||
}
|
||||
|
||||
void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
|
||||
Term h0var;
|
||||
// getchar();
|
||||
/* set up a meta-call based on . context info */
|
||||
static Int generate_pred_info(USES_REGS1) {
|
||||
ARG1 = ARG3 = ENV[-EnvSizeInCells - 1];
|
||||
ARG4 = ENV[-EnvSizeInCells - 3];
|
||||
ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
|
||||
Term h0var;
|
||||
// getchar();
|
||||
#if PUSH_REGS
|
||||
/* Guarantee that after a longjmp we go back to the original abstract
|
||||
machine registers */
|
||||
/* Guarantee that after a longjmp we go back to the original abstract
|
||||
machine registers */
|
||||
#ifdef THREADS
|
||||
if (myworker_id) {
|
||||
REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs;
|
||||
pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
|
||||
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs;
|
||||
}
|
||||
/* may be run by worker_id on behalf on myworker_id */
|
||||
if (myworker_id) {
|
||||
REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs;
|
||||
pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
|
||||
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs;
|
||||
}
|
||||
/* may be run by worker_id on behalf on myworker_id */
|
||||
#else
|
||||
Yap_regp = &Yap_standard_regs;
|
||||
Yap_regp = &Yap_standard_regs;
|
||||
#endif
|
||||
#endif /* PUSH_REGS */
|
||||
CACHE_REGS
|
||||
Yap_ResetException(worker_id);
|
||||
Yap_PutValue(AtomBreak, MkIntTerm(0));
|
||||
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id)) +
|
||||
1; // +1: hack to ensure the gc does not try to mark mistakenly
|
||||
LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id);
|
||||
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap);
|
||||
/* notice that an initial choice-point and environment
|
||||
*must* be created for the garbage collector to work */
|
||||
B = NULL;
|
||||
ENV = NULL;
|
||||
P = CP = YESCODE;
|
||||
CACHE_REGS
|
||||
Yap_ResetException(LOCAL_ActiveError);
|
||||
Yap_PutValue(AtomBreak, MkIntTerm(0));
|
||||
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
HR = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id)) +
|
||||
1; // +1: hack to ensure the gc does not try to mark mistakenly
|
||||
LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id);
|
||||
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap);
|
||||
/* notice that an initial choice-point and environment
|
||||
*must* be created for the garbage collector to work */
|
||||
B = NULL;
|
||||
ENV = NULL;
|
||||
P = CP = YESCODE;
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH = RESET_DEPTH();
|
||||
DEPTH = RESET_DEPTH();
|
||||
#endif
|
||||
STATIC_PREDICATES_MARKED = FALSE;
|
||||
if (full_reset) {
|
||||
HR = H0+1;
|
||||
h0var = MkVarTerm();
|
||||
REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var);
|
||||
REMOTE_GcCurrentPhase(myworker_id) = 0L;
|
||||
REMOTE_GcPhase(myworker_id) =
|
||||
Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id)));
|
||||
STATIC_PREDICATES_MARKED = FALSE;
|
||||
if (full_reset) {
|
||||
HR = H0+1;
|
||||
h0var = MkVarTerm();
|
||||
REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var);
|
||||
REMOTE_GcCurrentPhase(myworker_id) = 0L;
|
||||
REMOTE_GcPhase(myworker_id) =
|
||||
Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id)));
|
||||
#if COROUTINING
|
||||
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);
|
||||
h0var = MkVarTerm();
|
||||
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
|
||||
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);
|
||||
h0var = MkVarTerm();
|
||||
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
|
||||
#endif
|
||||
Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id);
|
||||
} else {
|
||||
HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id));
|
||||
}
|
||||
Yap_InitPreAllocCodeSpace(myworker_id);
|
||||
Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id);
|
||||
} else {
|
||||
HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id));
|
||||
}
|
||||
Yap_InitPreAllocCodeSpace(myworker_id);
|
||||
#ifdef FROZEN_STACKS
|
||||
H_FZ = HR;
|
||||
H_FZ = HR;
|
||||
#ifdef YAPOR_SBA
|
||||
BSEG =
|
||||
BSEG =
|
||||
#endif /* YAPOR_SBA */
|
||||
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
|
||||
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
|
||||
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
#endif /* FROZEN_STACKS */
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
/* the first real choice-point will also have AP=FAIL */
|
||||
/* always have an empty slots for people to use */
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
/* the first real choice-point will also have AP=FAIL */
|
||||
/* always have an empty slots for people to use */
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
LOCAL = REMOTE(myworker_id);
|
||||
worker_id = myworker_id;
|
||||
LOCAL = REMOTE(myworker_id);
|
||||
worker_id = myworker_id;
|
||||
#endif /* THREADS */
|
||||
Yap_RebootSlots(myworker_id);
|
||||
Yap_RebootSlots(myworker_id);
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
PP = NULL;
|
||||
PREG_ADDR = NULL;
|
||||
PP = NULL;
|
||||
PREG_ADDR = NULL;
|
||||
#endif
|
||||
cut_c_initialize(myworker_id);
|
||||
Yap_PrepGoal(0, NULL, NULL PASS_REGS);
|
||||
cut_c_initialize(myworker_id);
|
||||
Yap_PrepGoal(0, NULL, NULL PASS_REGS);
|
||||
#ifdef FROZEN_STACKS
|
||||
H_FZ = HR;
|
||||
H_FZ = HR;
|
||||
#ifdef YAPOR_SBA
|
||||
BSEG =
|
||||
BSEG =
|
||||
#endif /* YAPOR_SBA */
|
||||
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
|
||||
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
|
||||
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
#endif /* FROZEN_STACKS */
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
#ifdef TABLING
|
||||
/* ensure that LOCAL_top_dep_fr is always valid */
|
||||
if (REMOTE_top_dep_fr(myworker_id))
|
||||
DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
|
||||
/* ensure that LOCAL_top_dep_fr is always valid */
|
||||
if (REMOTE_top_dep_fr(myworker_id))
|
||||
DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
|
||||
#endif
|
||||
}
|
||||
|
||||
int Yap_dogc(int extra_args, Term *tp USES_REGS) {
|
||||
UInt arity;
|
||||
yamop *nextpc;
|
||||
int i;
|
||||
|
||||
if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) {
|
||||
arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
|
||||
nextpc = P;
|
||||
} else {
|
||||
arity = 0;
|
||||
nextpc = CP;
|
||||
}
|
||||
|
||||
int Yap_dogc(int extra_args, Term *tp USES_REGS) {
|
||||
UInt arity;
|
||||
yamop *nextpc;
|
||||
int i;
|
||||
|
||||
if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) {
|
||||
arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
|
||||
nextpc = P;
|
||||
} else {
|
||||
arity = 0;
|
||||
nextpc = CP;
|
||||
}
|
||||
for (i = 0; i < extra_args; i++) {
|
||||
XREGS[arity + i + 1] = tp[i];
|
||||
}
|
||||
if (!Yap_gc(arity + extra_args, ENV, nextpc)) {
|
||||
return FALSE;
|
||||
}
|
||||
for (i = 0; i < extra_args; i++) {
|
||||
tp[i] = XREGS[arity + i + 1];
|
||||
}
|
||||
return TRUE;
|
||||
for (i = 0; i < extra_args; i++) {
|
||||
XREGS[arity + i + 1] = tp[i];
|
||||
}
|
||||
if (!Yap_gc(arity + extra_args, ENV, nextpc)) {
|
||||
return FALSE;
|
||||
}
|
||||
for (i = 0; i < extra_args; i++) {
|
||||
tp[i] = XREGS[arity + i + 1];
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
void Yap_InitExecFs(void) {
|
||||
CACHE_REGS
|
||||
YAP_opaque_handler_t catcher_ops;
|
||||
memset(&catcher_ops, 0, sizeof(catcher_ops));
|
||||
catcher_ops.cut_handler = watch_cut;
|
||||
catcher_ops.fail_handler = watch_retry;
|
||||
setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops);
|
||||
void Yap_InitExecFs(void) {
|
||||
CACHE_REGS
|
||||
YAP_opaque_handler_t catcher_ops;
|
||||
memset(&catcher_ops, 0, sizeof(catcher_ops));
|
||||
catcher_ops.cut_handler = watch_cut;
|
||||
catcher_ops.fail_handler = watch_retry;
|
||||
setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops);
|
||||
|
||||
Term cm = CurrentModule;
|
||||
Yap_InitComma();
|
||||
Yap_InitCPred("$execute", 1, execute, 0);
|
||||
Yap_InitCPred("$execute", 2, execute2, 0);
|
||||
Yap_InitCPred("$execute", 3, execute3, 0);
|
||||
Yap_InitCPred("$execute", 4, execute4, 0);
|
||||
Yap_InitCPred("$execute", 5, execute5, 0);
|
||||
Yap_InitCPred("$execute", 6, execute6, 0);
|
||||
Yap_InitCPred("$execute", 7, execute7, 0);
|
||||
Yap_InitCPred("$execute", 8, execute8, 0);
|
||||
Yap_InitCPred("$execute", 9, execute9, 0);
|
||||
Yap_InitCPred("$execute", 10, execute10, 0);
|
||||
Yap_InitCPred("$execute", 11, execute11, 0);
|
||||
Yap_InitCPred("$execute", 12, execute12, 0);
|
||||
Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0);
|
||||
Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0);
|
||||
Yap_InitCPred("call_with_args", 1, execute_0, 0);
|
||||
Yap_InitCPred("call_with_args", 2, execute_1, 0);
|
||||
Yap_InitCPred("call_with_args", 3, execute_2, 0);
|
||||
Yap_InitCPred("call_with_args", 4, execute_3, 0);
|
||||
Yap_InitCPred("call_with_args", 5, execute_4, 0);
|
||||
Yap_InitCPred("call_with_args", 6, execute_5, 0);
|
||||
Yap_InitCPred("call_with_args", 7, execute_6, 0);
|
||||
Yap_InitCPred("call_with_args", 8, execute_7, 0);
|
||||
Yap_InitCPred("call_with_args", 9, execute_8, 0);
|
||||
Yap_InitCPred("call_with_args", 10, execute_9, 0);
|
||||
Yap_InitCPred("call_with_args", 11, execute_10, 0);
|
||||
Term cm = CurrentModule;
|
||||
Yap_InitComma();
|
||||
Yap_InitCPred("$execute", 1, execute, 0);
|
||||
Yap_InitCPred("$execute", 2, execute2, 0);
|
||||
Yap_InitCPred("$execute", 3, execute3, 0);
|
||||
Yap_InitCPred("$execute", 4, execute4, 0);
|
||||
Yap_InitCPred("$execute", 5, execute5, 0);
|
||||
Yap_InitCPred("$execute", 6, execute6, 0);
|
||||
Yap_InitCPred("$execute", 7, execute7, 0);
|
||||
Yap_InitCPred("$execute", 8, execute8, 0);
|
||||
Yap_InitCPred("$execute", 9, execute9, 0);
|
||||
Yap_InitCPred("$execute", 10, execute10, 0);
|
||||
Yap_InitCPred("$execute", 11, execute11, 0);
|
||||
Yap_InitCPred("$execute", 12, execute12, 0);
|
||||
Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0);
|
||||
Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0);
|
||||
Yap_InitCPred("call_with_args", 1, execute_0, 0);
|
||||
Yap_InitCPred("call_with_args", 2, execute_1, 0);
|
||||
Yap_InitCPred("call_with_args", 3, execute_2, 0);
|
||||
Yap_InitCPred("call_with_args", 4, execute_3, 0);
|
||||
Yap_InitCPred("call_with_args", 5, execute_4, 0);
|
||||
Yap_InitCPred("call_with_args", 6, execute_5, 0);
|
||||
Yap_InitCPred("call_with_args", 7, execute_6, 0);
|
||||
Yap_InitCPred("call_with_args", 8, execute_7, 0);
|
||||
Yap_InitCPred("call_with_args", 9, execute_8, 0);
|
||||
Yap_InitCPred("call_with_args", 10, execute_9, 0);
|
||||
Yap_InitCPred("call_with_args", 11, execute_10, 0);
|
||||
#ifdef DEPTH_LIMIT
|
||||
Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0);
|
||||
Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0);
|
||||
#endif
|
||||
Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag);
|
||||
Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
|
||||
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
|
||||
Yap_InitCPred("$ ", 1,
|
||||
current_choice_point, 0);
|
||||
CurrentModule = HACKS_MODULE;
|
||||
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("cut_at", 1, clean_ifcp, SafePredFlag);
|
||||
CurrentModule = cm;
|
||||
Yap_InitCPred("$restore_regs", 1, restore_regs,
|
||||
NoTracePredFlag | SafePredFlag);
|
||||
Yap_InitCPred("$restore_regs", 2, restore_regs2,
|
||||
NoTracePredFlag | SafePredFlag);
|
||||
Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag);
|
||||
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
|
||||
SafePredFlag);
|
||||
Yap_InitCPred("$jump_env_and_store_ball", 1, jump_env, 0);
|
||||
Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0);
|
||||
Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
|
||||
Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
|
||||
Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
|
||||
0);
|
||||
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0);
|
||||
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
|
||||
}
|
||||
Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag);
|
||||
Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
|
||||
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
|
||||
Yap_InitCPred("$ ", 1,
|
||||
current_choice_point, 0);
|
||||
CurrentModule = HACKS_MODULE;
|
||||
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("cut_at", 1, clean_ifcp, SafePredFlag);
|
||||
CurrentModule = cm;
|
||||
Yap_InitCPred("$restore_regs", 1, restore_regs,
|
||||
NoTracePredFlag | SafePredFlag);
|
||||
Yap_InitCPred("$restore_regs", 2, restore_regs2,
|
||||
NoTracePredFlag | SafePredFlag);
|
||||
Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag);
|
||||
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
|
||||
SafePredFlag);
|
||||
Yap_InitCPred("throw", 1, jump_env, 0);
|
||||
Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0);
|
||||
Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
|
||||
Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
|
||||
Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
|
||||
0);
|
||||
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0);
|
||||
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -159,15 +159,14 @@ static void consult(const char *b_file USES_REGS) {
|
|||
Functor functor_query = Yap_MkFunctor(Yap_LookupAtom("?-"), 1);
|
||||
Functor functor_command1 = Yap_MkFunctor(Yap_LookupAtom(":-"), 1);
|
||||
Functor functor_compile2 = Yap_MkFunctor(Yap_LookupAtom("c_compile"), 1);
|
||||
|
||||
char *full;
|
||||
|
||||
/* consult in C */
|
||||
int lvl = push_text_stack();
|
||||
char *full = Malloc(YAP_FILENAME_MAX + 1);
|
||||
full[0] = '\0';
|
||||
/* the consult mode does not matter here, really */
|
||||
if ((osno = Yap_CheckAlias(AtomLoopStream)) < 0)
|
||||
osno = 0;
|
||||
c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, full, &oactive);
|
||||
c_stream = YAP_InitConsult(YAP_BOOT_MODE, b_file, &full, &oactive);
|
||||
if (c_stream < 0) {
|
||||
fprintf(stderr, "[ FATAL ERROR: could not open file %s ]\n", b_file);
|
||||
pop_text_stack(lvl);
|
||||
|
|
|
|||
29
CXX/yapi.cpp
29
CXX/yapi.cpp
|
|
@ -433,11 +433,10 @@ bool YAPEngine::call(YAPPredicate ap, YAPTerm ts[]) {
|
|||
// allow Prolog style exceotion handling
|
||||
// don't forget, on success these bindings will still be there);
|
||||
result = YAP_LeaveGoal(false, &q);
|
||||
Term terr;
|
||||
|
||||
if ((terr = Yap_GetException()) != 0) {
|
||||
if (LOCAL_CommittedError != nullptr) {
|
||||
std::cerr << "Exception received by " << __func__ << "( "
|
||||
<< YAPTerm(terr).text() << ").\n Forwarded...\n\n";
|
||||
<< YAPError(LOCAL_CommittedError).text() << ").\n Forwarded...\n\n";
|
||||
// Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm);
|
||||
// throw YAPError();
|
||||
}
|
||||
|
|
@ -481,12 +480,9 @@ bool YAPEngine::mgoal(Term t, Term tmod) {
|
|||
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
|
||||
|
||||
result = (bool)YAP_EnterGoal(ap, nullptr, &q);
|
||||
Term terr;
|
||||
if ((terr = Yap_GetException()) != 0) {
|
||||
if (LOCAL_CommittedError != nullptr) {
|
||||
std::cerr << "Exception received by " << __func__ << "( "
|
||||
<< YAPTerm(terr).text() << ").\n Forwarded...\n\n";
|
||||
// Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm);
|
||||
// throw YAPError();
|
||||
<< YAPError(LOCAL_CommittedError).text() << ").\n Forwarded...\n\n";
|
||||
}
|
||||
|
||||
{
|
||||
|
|
@ -547,13 +543,12 @@ Term YAPEngine::fun(Term t) {
|
|||
q.cp = CP;
|
||||
// make sure this is safe
|
||||
// allow Prolog style exception handling
|
||||
Term terr;
|
||||
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
|
||||
|
||||
bool result = (bool)YAP_EnterGoal(ap, nullptr, &q);
|
||||
if ((terr = Yap_GetException()) != 0) {
|
||||
if (LOCAL_CommittedError != nullptr) {
|
||||
std::cerr << "Exception received by " << __func__ << "( "
|
||||
<< YAPTerm(terr).text() << ").\n Forwarded...\n\n";
|
||||
<< YAPError(LOCAL_CommittedError).text() << ").\n Forwarded...\n\n";
|
||||
// Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm);
|
||||
// throw YAPError();
|
||||
}
|
||||
|
|
@ -673,16 +668,12 @@ bool YAPQuery::next() {
|
|||
YAP_LeaveGoal(false, &q_h);
|
||||
Yap_CloseHandles(q_handles);
|
||||
q_open = false;
|
||||
if (Yap_HasException()) {
|
||||
terr = Yap_GetException();
|
||||
yap_error_descriptor_t *tp = LOCAL_ActiveError->top_error;
|
||||
memset(LOCAL_ActiveError, 0, sizeof(yap_error_descriptor_t));
|
||||
LOCAL_ActiveError->top_error = tp;
|
||||
std::cerr << "Exception at " << __func__ << "() " << YAPTerm(terr).text()
|
||||
<< ").\n\n\n";
|
||||
if (LOCAL_CommittedError != nullptr) {
|
||||
// Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm);
|
||||
// throw YAPError();
|
||||
Term es[2];
|
||||
es[0] = TermError;
|
||||
es[1] = terr;
|
||||
es[1] = MkErrorTerm(LOCAL_CommittedError);
|
||||
Functor f = Yap_MkFunctor(Yap_LookupAtom("print_message"), 2);
|
||||
YAP_RunGoalOnce(Yap_MkApplTerm(f, 2, es));
|
||||
// Yap_PopTermFromDB(LOCAL_ActiveError->errorTerm);
|
||||
|
|
|
|||
15
CXX/yapi.hh
15
CXX/yapi.hh
|
|
@ -42,6 +42,14 @@ extern "C" {
|
|||
|
||||
#include <stddef.h>
|
||||
|
||||
|
||||
#if YAP_PYTHON
|
||||
|
||||
#include <Python.h>
|
||||
|
||||
extern bool python_in_python;
|
||||
#endif
|
||||
|
||||
#include "Yap.h"
|
||||
|
||||
#include "Yatom.h"
|
||||
|
|
@ -100,13 +108,6 @@ X_API extern void YAP_UserBackCutCPredicate(const char *name,
|
|||
X_API extern YAP_Term YAP_ReadBuffer(const char *s, YAP_Term *tp);
|
||||
|
||||
|
||||
#if YAP_PYTHON
|
||||
|
||||
#include <Python.h>
|
||||
|
||||
extern bool python_in_python;
|
||||
#endif
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -40,6 +40,11 @@ public:
|
|||
if (ID != YAP_NO_ERROR) {};
|
||||
std::cerr << "Error detected" << ID << "\n";
|
||||
}
|
||||
YAPError(yap_error_descriptor_t *des){
|
||||
ID = des->errorNo;
|
||||
if (ID != YAP_NO_ERROR) {};
|
||||
std::cerr << "Error detected" << ID << "\n";
|
||||
}
|
||||
/// error handler object with initial data when receiving the error term
|
||||
YAPError(yap_error_number id, YAPTerm culprit, std::string txt);
|
||||
|
||||
|
|
|
|||
12
H/Yatom.h
12
H/Yatom.h
|
|
@ -1601,14 +1601,22 @@ INLINE_ONLY inline EXTERN const char *AtomTermName(Term t) {
|
|||
return RepAtom(AtomOfTerm(t))->rep.uStrOfAE;
|
||||
}
|
||||
|
||||
extern bool Yap_ResetException(int wid);
|
||||
extern Term MkErrorTerm(yap_error_descriptor_t *t);
|
||||
|
||||
extern bool Yap_ResetException(yap_error_descriptor_t *i);
|
||||
extern bool Yap_HasException(void);
|
||||
extern Term Yap_GetException(void);
|
||||
extern yap_error_descriptor_t * Yap_GetException(void);
|
||||
extern void Yap_PrintException(void);
|
||||
INLINE_ONLY inline EXTERN bool Yap_HasException(void) {
|
||||
return LOCAL_ActiveError->errorNo != YAP_NO_ERROR;
|
||||
}
|
||||
|
||||
INLINE_ONLY inline EXTERN Term MkSysError(yap_error_descriptor_t *i) {
|
||||
Term et = MkAddressTerm(i);
|
||||
return Yap_MkApplTerm( FunctorException, 1, &et);
|
||||
}
|
||||
yap_error_descriptor_t *Yap_UserError( Term t, Term t1, yap_error_descriptor_t *i);
|
||||
|
||||
extern bool Yap_RaiseException(void);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -195,6 +195,7 @@ LOCAL(ADDR, TrailTop);
|
|||
|
||||
/* error handling info, designed to be easy to pass to the foreign world */
|
||||
LOCAL_INIT(yap_error_descriptor_t *, ActiveError, calloc(sizeof(yap_error_descriptor_t), 1));
|
||||
LOCAL_INIT(yap_error_descriptor_t *, CommittedError, calloc(sizeof(yap_error_descriptor_t), 1));
|
||||
/// pointer to an exception term, from throw
|
||||
LOCAL(jmp_buf, IOBotch);
|
||||
|
||||
|
|
|
|||
|
|
@ -156,6 +156,7 @@ E(CALL_COUNTER_UNDERFLOW_EVENT, EVENT, "call_counter_underflow")
|
|||
E(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, EVENT, "pred_entry_counter_underflow")
|
||||
E(RETRY_COUNTER_UNDERFLOW_EVENT, EVENT, "retry_counter_underflow")
|
||||
E(INTERRUPT_EVENT, EVENT, "interrupt")
|
||||
E(USER_EVENT, EVENT, "user event")
|
||||
|
||||
E(TYPE_ERROR_ARRAY, TYPE_ERROR, "array")
|
||||
E(TYPE_ERROR_ATOM, TYPE_ERROR, "atom")
|
||||
|
|
|
|||
|
|
@ -408,7 +408,7 @@ extern X_API void YAP_Write(YAP_Term t, FILE *s, int);
|
|||
|
||||
extern X_API FILE *YAP_TermToStream(YAP_Term t);
|
||||
|
||||
extern X_API int YAP_InitConsult(int mode, const char *filename, char *buf,
|
||||
extern X_API int YAP_InitConsult(int mode, const char *filename, char **buf,
|
||||
int *previous_sno);
|
||||
|
||||
extern X_API void YAP_EndConsult(int s, int *previous_sno, const char *previous_cwd);
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@ set(PL_BOOT_SOURCES
|
|||
load_foreign.yap
|
||||
messages.yap
|
||||
meta.yap
|
||||
metadecls.yap
|
||||
modules.yap
|
||||
newmod.yap
|
||||
os.yap
|
||||
|
|
|
|||
27
pl/boot.yap
27
pl/boot.yap
|
|
@ -119,8 +119,6 @@ print_message(L,E) :-
|
|||
format( user_error, '~w in bootstrap: got ~w~n',[L,E])
|
||||
).
|
||||
|
||||
|
||||
|
||||
'$undefp0'([M|G], _Action) :-
|
||||
stream_property( loop_stream, file_name(F)),
|
||||
stream_property( loop_stream, line_number(L)),
|
||||
|
|
@ -129,6 +127,25 @@ print_message(L,E) :-
|
|||
|
||||
:- '$undefp_handler'('$undefp0'(_,_),prolog).
|
||||
|
||||
/**
|
||||
* @pred $system_meta_predicates'( +L )
|
||||
*
|
||||
* @param L declare a set of system meta-predicates
|
||||
*
|
||||
* @return system predicates
|
||||
*/
|
||||
'$system_meta_predicates'([]).
|
||||
'$system_meta_predicates'([P|L]) :-
|
||||
functor(P,N,A),
|
||||
'$new_meta_pred'(P, prolog),
|
||||
G = ('$meta_predicate'(N,_M2,A,P) :- true),
|
||||
'$compile'(G, assertz, G, prolog, _R),
|
||||
'$system_meta_predicates'(L).
|
||||
|
||||
:- '$mk_dynamic'( '$meta_predicate'(_N,_M,_A,_P), prolog).
|
||||
:- '$new_multifile'( '$meta_predicate'(_N,_M,_A,_P), prolog).
|
||||
:- '$new_multifile'('$full_clause_optimisation'(_H, _M, _B0, _BF), prolog).
|
||||
:- '$new_multifile'('$exec_directive'(_,_,_,_,_), prolog).
|
||||
|
||||
/**
|
||||
|
||||
|
|
@ -175,7 +192,6 @@ print_message(L,E) :-
|
|||
% These are pseudo declarations
|
||||
% so that the user will get a redefining system predicate
|
||||
|
||||
|
||||
% just create a choice-point
|
||||
% the 6th argument marks the time-stamp.
|
||||
'$do_log_upd_clause'(_,_,_,_,_,_).
|
||||
|
|
@ -232,8 +248,9 @@ print_message(L,E) :-
|
|||
:- c_compile('bootlists.yap').
|
||||
:- c_compile('consult.yap').
|
||||
:- c_compile('preddecls.yap').
|
||||
:- c_compile('preddyns.yap').
|
||||
:- c_compile('meta.yap').
|
||||
:- c_compile('metadecls.yap').
|
||||
:- c_compile('preddyns.yap').
|
||||
:- c_compile('builtins.yap').
|
||||
:- c_compile('newmod.yap').
|
||||
|
||||
|
|
@ -461,5 +478,3 @@ If this hook preodicate succeeds it must instantiate the _Action_ argument to t
|
|||
:- ensure_loaded('../pl/pathconf.yap').
|
||||
|
||||
:- yap_flag(user:unknown,error).
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -72,7 +72,6 @@ The style_check/1 built-in is now deprecated. Please use
|
|||
%
|
||||
% A Small style checker for YAP
|
||||
|
||||
:- op(1150, fx, [multifile,discontiguous]).
|
||||
|
||||
style_check(V) :- var(V), !, fail.
|
||||
style_check(V) :-
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
s444444444444444444444444444444444444444444444444444444444444444444444444/*************************************************************************
|
||||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
|
|
@ -74,6 +74,20 @@ s444444444444444444444444444444444444444444444444444444444444444444444444/******
|
|||
|
||||
:- use_system_module( '$_preds', ['$current_predicate'/4]).
|
||||
|
||||
|
||||
:- '$system_meta_predicates'([
|
||||
compile(:),
|
||||
consult(:),
|
||||
db_files(:),
|
||||
ensure_loaded(:),
|
||||
exo_files(:),
|
||||
load_files(:,+),
|
||||
reconsult(:),
|
||||
use_module(:),
|
||||
use_module(:,+),
|
||||
use_module(?,:,+)
|
||||
] ).
|
||||
|
||||
/**
|
||||
|
||||
@defgroup YAPConsulting Loading files into YAP
|
||||
|
|
|
|||
|
|
@ -63,12 +63,7 @@ system_error(Type,Goal) :-
|
|||
|
||||
|
||||
'$do_error'(Type,Goal) :-
|
||||
% format('~w~n', [Type]),
|
||||
ancestor_location(Call, Caller),
|
||||
throw(error(Type, [
|
||||
[g|g(Goal)],
|
||||
[p|Call],
|
||||
[e|Caller]])).
|
||||
throw(error(Type, [error(Goal)])).
|
||||
|
||||
/**
|
||||
* @pred system_error( +Error, +Cause, +Culprit)
|
||||
|
|
@ -82,13 +77,8 @@ system_error(Type,Goal) :-
|
|||
*
|
||||
*/
|
||||
system_error(Type,Goal,Culprit) :-
|
||||
% format('~w~n', [Type]),
|
||||
ancestor_location(Call, Caller),
|
||||
throw(error(Type, [
|
||||
[i|Culprit],
|
||||
[g|g(Goal)],
|
||||
[p|Call],
|
||||
[e|Caller]])).
|
||||
ancestor_location(Goal, Culprit),
|
||||
throw(error(Type, [error(Goal, Culprit)])).
|
||||
|
||||
'$do_pi_error'(type_error(callable,Name/0),Message) :- !,
|
||||
'$do_error'(type_error(callable,Name),Message).
|
||||
|
|
|
|||
111
pl/messages.yap
111
pl/messages.yap
|
|
@ -68,7 +68,7 @@ handling in YAP:
|
|||
|
||||
An error record comsists of An ISO compatible descriptor of the format
|
||||
|
||||
error(errror_kind(Culprit,..), Info)
|
||||
error(errror_kind(Culprit,..), In)
|
||||
|
||||
In YAP, the info field describes:
|
||||
|
||||
|
|
@ -213,6 +213,9 @@ compose_message( loaded(included,AbsFileName,Mod,Time,Space), _Level) --> !,
|
|||
compose_message( loaded(What,AbsoluteFileName,Mod,Time,Space), _Level) --> !,
|
||||
[ '~a ~a in module ~a, ~d msec ~d bytes' -
|
||||
[What, AbsoluteFileName,Mod,Time,Space] ].
|
||||
compose_message(error(signal(SIG,_), _), _) -->
|
||||
!,
|
||||
[ 'UNEXPECTED SIGNAL: ~a' - [SIG] ].
|
||||
compose_message(trace_command(C), _Leve) -->
|
||||
!,
|
||||
[ '~a is not a valid debugger command.' - [C] ].
|
||||
|
|
@ -227,20 +230,74 @@ compose_message(myddas_version(Version), _Leve) -->
|
|||
[ 'MYDDAS version ~a' - [Version] ].
|
||||
compose_message(yes, _Level) --> !,
|
||||
[ 'yes'- [] ].
|
||||
compose_message(Term, Level) -->
|
||||
compose_message(error(E, exception(Exc)), Level) -->
|
||||
{ '$show_consult_level'(LC) },
|
||||
location( Term, Level, LC),
|
||||
main_message( Term, Level, LC ),
|
||||
c_goal( Term, Level ),
|
||||
caller( Term, Level ),
|
||||
extra_info( Term, Level ),
|
||||
location( Exc, Level, LC),
|
||||
main_message( Exc, Level, LC ),
|
||||
c_goal( Exc, Level ),
|
||||
caller( Exc, Level ),
|
||||
extra_info( Exc, Level ),
|
||||
!,
|
||||
[nl,nl].
|
||||
compose_message(Term, Level) -->
|
||||
compose_message(error(E,[I|Is]), Level) -->
|
||||
{ Level == error -> true ; Level == warning },
|
||||
{ '$show_consult_level'(LC) },
|
||||
main_message( Term, Level, LC),
|
||||
{ '$show_consult_level'(LC),
|
||||
translate_info([I|Is], In))
|
||||
},
|
||||
compose_message( e(Err, In), Level),
|
||||
[nl,nl].
|
||||
compose_message(Throw), _Leve) -->
|
||||
!,
|
||||
[ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ].
|
||||
|
||||
translate_info([I1|I2],exception(R) ) :-
|
||||
!,
|
||||
'$new_exception'(R),
|
||||
tinfo(R, [I1|I2], []).
|
||||
translate_info(E, none ).
|
||||
|
||||
tinfo(_Reg) -->
|
||||
!.
|
||||
tinfo(Reg) -->
|
||||
addinfo(Reg),
|
||||
tinfo(Reg).
|
||||
|
||||
addinfo( Desc) -->
|
||||
( [[p|p(M,Na,Ar,File,FilePos)]]
|
||||
->
|
||||
{
|
||||
'$query_exception'(prologPredFile, Desc, File),
|
||||
'$query_exception'(prologPredLine, Desc, FilePos),
|
||||
'$query_exception'(prologPredModule, Desc, M),
|
||||
'$query_exception'(prologPredName, Desc, Na),
|
||||
'$query_exception'(prologPredArity, Desc, Ar)
|
||||
}
|
||||
;
|
||||
[e|p(M,Na,Ar,File,FilePos)], Desc)
|
||||
->
|
||||
{
|
||||
'$query_exception'(prologPredFile, Desc, File),
|
||||
'$query_exception'(prologPredLine, Desc, FilePos),
|
||||
'$query_exception'(prologPredModule, Desc, M),
|
||||
'$query_exception'(prologPredName, Desc, Na),
|
||||
'$query_exception'(prologPredArity, Desc, Ar)
|
||||
}
|
||||
;
|
||||
[[c|c(File, Line, Func)]]
|
||||
->
|
||||
{
|
||||
'$query_exception'(errorFile, Desc, File),
|
||||
'$query_exception'(errorFunction, Desc, Func),
|
||||
'$query_exception'(errorLine, Desc, Line)
|
||||
}
|
||||
;
|
||||
[[g|g(Call)]
|
||||
->
|
||||
{
|
||||
'$query_exception'(errorGoal, Desc, Call)
|
||||
}
|
||||
).
|
||||
|
||||
|
||||
location(error(syntax_error(_),info(between(_,LN,_), FileName, _ChrPos, _Err)), _ , _) -->
|
||||
!,
|
||||
|
|
@ -249,28 +306,28 @@ location(error(syntax_error(_),info(between(_,LN,_), FileName, _ChrPos, _Err)),
|
|||
location(error(style_check(style_check(_,LN,FileName,_ ) ),_), _ , _) -->
|
||||
!,
|
||||
[ '~a:~d:0 ' - [FileName,LN] ] .
|
||||
location( error(_,Desc), Level, LC ) -->
|
||||
location( error(_,exception(Desc)), Level, LC ) -->
|
||||
{ source_location(F0, L),
|
||||
stream_property(_Stream, alias(loop_stream)),
|
||||
!,
|
||||
'$query_exception'(prologPredModule, Desc, M),
|
||||
'$query_exception'(prologPredName, Desc, Na),
|
||||
'$query_exception'(prologPredArity, Desc, Ar),
|
||||
display_consulting( F0, Level, LC )
|
||||
'$query_exception'(prologPredArity, Desc, Ar)
|
||||
},
|
||||
display_consulting( F0, Level, LC ),
|
||||
[ '~a:~d:0 ~a in ~a:~q/~d:'-[F0, L,Level,M,Na,Ar] ].
|
||||
location( error(_,Desc), Level, LC ) -->
|
||||
{ '$query_exception'(prologPredFile, Desc, File),
|
||||
display_consulting( File, Level, LC ),
|
||||
location( error(_,exception(Desc)), Level, LC ) -->
|
||||
{ '$query_exception'(prologPredFile, Desc, File),
|
||||
'$query_exception'(prologPredLine, Desc, FilePos),
|
||||
'$query_exception'(prologPredModule, Desc, M),
|
||||
'$query_exception'(prologPredName, Desc, Na),
|
||||
'$query_exception'(prologPredArity, Desc, Ar)
|
||||
},
|
||||
display_consulting( File, Level, LC ),
|
||||
[ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ].
|
||||
|
||||
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
|
||||
main_message(error(Msg,Info), _, _) --> {var(Info)}, !,
|
||||
main_message(error(Msg,In), _, _) --> {var(In)}, !,
|
||||
[ ' error: uninstantiated message ~w~n.' - [Msg], nl ].
|
||||
main_message( error(syntax_error(Msg),info(between(L0,LM,LF),_Stream, _Pos, Term)), Level, LC ) -->
|
||||
!,
|
||||
|
|
@ -336,8 +393,8 @@ display_consulting( F, Level, LC) -->
|
|||
display_consulting(_F, _, _LC) -->
|
||||
[].
|
||||
|
||||
caller( error(_,Desc), _) -->
|
||||
{
|
||||
caller( error(_,exception(Desc)), _) -->
|
||||
{
|
||||
'$query_exception'(errorGoal, Desc, Call),
|
||||
Call \= [],
|
||||
'$query_exception'(prologPredFile, Desc, File),
|
||||
|
|
@ -352,8 +409,8 @@ caller( error(_,Desc), _) -->
|
|||
[nl],
|
||||
['~*|exception raised from ~a:~q:~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
|
||||
[nl].
|
||||
caller( error(_,Desc), _) -->
|
||||
{
|
||||
caller( error(_,exception(Desc)), _) -->
|
||||
{
|
||||
'$query_exception'(prologPredFile, Desc, File),
|
||||
File \= [],
|
||||
'$query_exception'(prologPredLine, Desc, FilePos),
|
||||
|
|
@ -364,7 +421,7 @@ caller( error(_,Desc), _) -->
|
|||
!,
|
||||
['~*|exception raised from ~a:~q/~d, ~a:~d:0: '-[10,M,Na,Ar,File, FilePos]],
|
||||
[nl].
|
||||
caller( error(_,Desc), _) -->
|
||||
caller( error(_,exception(Desc)), _) -->
|
||||
{
|
||||
'$query_exception'(errorGoal, Desc, Call),
|
||||
Call \= [] },
|
||||
|
|
@ -374,8 +431,8 @@ caller( error(_,Desc), _) -->
|
|||
caller( _, _) -->
|
||||
[].
|
||||
|
||||
c_goal( error(_,Desc), Level ) -->
|
||||
{ '$query_exception'(errorFile, Desc, Func),
|
||||
c_goal( error(_,exception(Desc)), Level ) -->
|
||||
{ '$query_exception'(errorFile, Desc, File),
|
||||
Func \= [],
|
||||
'$query_exception'(errorFunction, Desc, File),
|
||||
'$query_exception'(errorLine, Desc, Line)
|
||||
|
|
@ -389,9 +446,9 @@ c_goal( _, _Level ) --> [].
|
|||
prolog_message(X) -->
|
||||
system_message(X).
|
||||
|
||||
system_message(error(Msg,Info)) -->
|
||||
( { var(Msg) } ; { var(Info)} ), !,
|
||||
['bad error ~w' - [error(Msg,Info)]].
|
||||
system_message(error(Msg,In)) -->
|
||||
( { var(Msg) } ; { var(In)} ), !,
|
||||
['bad error ~w' - [error(Msg,In)]].
|
||||
system_message(error(consistency_error(Who),Where)) -->
|
||||
[ 'CONSISTENCY ERROR (arguments not compatible with format)- ~w ~w' - [Who,Where] ].
|
||||
system_message(error(context_error(Goal,Who),Where)) -->
|
||||
|
|
|
|||
143
pl/meta.yap
143
pl/meta.yap
|
|
@ -23,22 +23,20 @@ For example, the declaration for call/1 and setof/3 are:
|
|||
:- meta_predicate call(0), setof(?,0,?).
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
meta_predicate declaration
|
||||
implemented by asserting $meta_predicate(SourceModule,Functor,Arity,Declaration)
|
||||
The meta_predicate declaration is
|
||||
implemented by:
|
||||
|
||||
- asserting `$meta_predicate(SourceModule,Functor,Arity,Declaration)`
|
||||
- setting up a `MetaPredicate` flag in the internal predicate descriptor.
|
||||
*/
|
||||
|
||||
% directive now meta_predicate Ps :- $meta_predicate(Ps).
|
||||
|
||||
:- use_system_module( '$_arith', ['$c_built_in'/4]).
|
||||
|
||||
|
||||
:- dynamic prolog:'$meta_predicate'/4.
|
||||
|
||||
:- multifile prolog:'$meta_predicate'/4,
|
||||
'$inline'/2,
|
||||
'$full_clause_optimisation'/4.
|
||||
|
||||
meta_predicate(P) :-
|
||||
source_module(SM),
|
||||
'$meta_predicate'(P, SM).
|
||||
|
||||
'$meta_predicate'(P,M) :-
|
||||
var(P),
|
||||
|
|
@ -66,7 +64,7 @@ meta_predicate declaration
|
|||
'$meta_predicate'( _D, _M ).
|
||||
|
||||
'$install_meta_predicate'(P,M,_F,_N) :-
|
||||
'$new_meta_pred'(P, M),
|
||||
'$new_meta_pred'(P, M),
|
||||
fail.
|
||||
'$install_meta_predicate'(_P,M,F,N) :-
|
||||
( M = prolog -> M2 = _ ; M2 = M),
|
||||
|
|
@ -220,8 +218,8 @@ meta_predicate declaration
|
|||
%
|
||||
%
|
||||
% head variab'$expand_goals'(M:G,G1,GO,HM,SM,,_M,HVars)les.
|
||||
% goals or arguments/sub-arguments?
|
||||
% I cannot use call here because of format/3
|
||||
% goals or arguments/sub-arguments?
|
||||
% I cannot use call here because of format/3
|
||||
% modules:
|
||||
% A4: module for body of clause (this is the one used in looking up predicates)
|
||||
% A5: context module (this is the current context
|
||||
|
|
@ -231,16 +229,16 @@ meta_predicate declaration
|
|||
%'$expand_goals'(V,NG,NG,HM,SM,BM,HVars):- writeln(V), fail.
|
||||
'$expand_goals'(V,NG,NGO,HM,SM,BM,HVars-H) :-
|
||||
var(V),
|
||||
!,
|
||||
!,
|
||||
( lists:identical_member(V, HVars)
|
||||
->
|
||||
'$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H)
|
||||
'$expand_goals'(call(V),NG,NGO,HM,SM,BM,HVars-H)
|
||||
;
|
||||
( atom(BM)
|
||||
->
|
||||
NG = call(BM:V),
|
||||
NGO = '$execute_in_mod'(V,BM)
|
||||
;
|
||||
->
|
||||
NG = call(BM:V),
|
||||
NGO = '$execute_in_mod'(V,BM)
|
||||
;
|
||||
'$expand_goals'(call(BM:V),NG,NGO,HM,SM,BM,HVars-H)
|
||||
)
|
||||
).
|
||||
|
|
@ -500,112 +498,3 @@ expand_goal(Input, Output) :-
|
|||
'$yap_strip_module'(SM:G, M, IG),
|
||||
'$expand_goals'(IG, _, GF0, M, SM, M, HVars-G),
|
||||
'$yap_strip_module'(M:GF0, MF, GF).
|
||||
|
||||
:- '$install_meta_predicate'((0,0),prolog,(','),2).
|
||||
|
||||
meta_predicate(P) :-
|
||||
source_module(SM),
|
||||
'$meta_predicate'(P, SM).
|
||||
|
||||
|
||||
|
||||
:- meta_predicate
|
||||
abolish(:),
|
||||
abolish(:,+),
|
||||
all(?,0,-),
|
||||
assert(:),
|
||||
assert(:,+),
|
||||
assert_static(:),
|
||||
asserta(:),
|
||||
asserta(:,+),
|
||||
asserta_static(:),
|
||||
assertz(:),
|
||||
assertz(:,+),
|
||||
assertz_static(:),
|
||||
at_halt(0),
|
||||
bagof(?,0,-),
|
||||
bb_get(:,-),
|
||||
bb_put(:,+),
|
||||
bb_delete(:,?),
|
||||
bb_update(:,?,?),
|
||||
call(0),
|
||||
call(1,?),
|
||||
call(2,?,?),
|
||||
call(3,?,?,?),
|
||||
call_with_args(0),
|
||||
call_with_args(1,?),
|
||||
call_with_args(2,?,?),
|
||||
call_with_args(3,?,?,?),
|
||||
call_with_args(4,?,?,?,?),
|
||||
call_with_args(5,?,?,?,?,?),
|
||||
call_with_args(6,?,?,?,?,?,?),
|
||||
call_with_args(7,?,?,?,?,?,?,?),
|
||||
call_with_args(8,?,?,?,?,?,?,?,?),
|
||||
call_with_args(9,?,?,?,?,?,?,?,?,?),
|
||||
call_cleanup(0,0),
|
||||
call_cleanup(0,?,0),
|
||||
call_residue(0,?),
|
||||
call_residue_vars(0,?),
|
||||
call_shared_object_function(:,+),
|
||||
catch(0,?,0),
|
||||
clause(:,?),
|
||||
clause(:,?,?),
|
||||
compile(:),
|
||||
consult(:),
|
||||
current_predicate(:),
|
||||
current_predicate(?,:),
|
||||
db_files(:),
|
||||
depth_bound_call(0,+),
|
||||
discontiguous(:),
|
||||
ensure_loaded(:),
|
||||
exo_files(:),
|
||||
findall(?,0,-),
|
||||
findall(?,0,-,?),
|
||||
forall(0,0),
|
||||
format(+,:),
|
||||
format(+,+,:),
|
||||
freeze(?,0),
|
||||
hide_predicate(:),
|
||||
if(0,0,0),
|
||||
ignore(0),
|
||||
incore(0),
|
||||
initializon(0),
|
||||
multifile(:),
|
||||
nospy(:),
|
||||
not(0),
|
||||
notrace(0),
|
||||
once(0),
|
||||
phrase(2,?),
|
||||
phrase(2,?,+),
|
||||
predicate_property(:,?),
|
||||
predicate_statistics(:,-,-,-),
|
||||
on_exception(+,0,0),
|
||||
qsave_program(+,:),
|
||||
reconsult(:),
|
||||
retract(:),
|
||||
retract(:,?),
|
||||
retractall(:),
|
||||
reconsult(:),
|
||||
setof(?,0,-),
|
||||
setup_call_cleanup(0,0,0),
|
||||
setup_call_catcher_cleanup(0,0,?,0),
|
||||
spy(:),
|
||||
stash_predicate(:),
|
||||
use_module(:),
|
||||
use_module(:,+),
|
||||
use_module(?,:,+),
|
||||
when(+,0),
|
||||
with_mutex(+,0),
|
||||
with_output_to(?,0),
|
||||
'->'(0 , 0),
|
||||
'*->'(0 , 0),
|
||||
';'(0 , 0),
|
||||
^(+,0),
|
||||
{}(0,?,?),
|
||||
','(2,2,?,?),
|
||||
';'(2,2,?,?),
|
||||
'|'(2,2,?,?),
|
||||
->(2,2,?,?),
|
||||
\+(2,?,?),
|
||||
\+( 0 )
|
||||
.
|
||||
|
|
|
|||
|
|
@ -0,0 +1,101 @@
|
|||
|
||||
/**
|
||||
* @file metadecl.yap
|
||||
* @author VITOR SANTOS COSTA <vsc@vcosta-laptop.dcc.fc.up.pt>
|
||||
* @date Sat Apr 7 03:08:03 2018
|
||||
*
|
||||
* @brief meta=declarations to run early.
|
||||
*
|
||||
* @ingroup YAPMetaPredicates
|
||||
*
|
||||
*/
|
||||
|
||||
|
||||
:- '$system_meta_predicates'([
|
||||
abolish(:),
|
||||
abolish(:,+),
|
||||
all(?,0,-),
|
||||
assert(:),
|
||||
assert(:,+),
|
||||
assert_static(:),
|
||||
asserta(:),
|
||||
asserta(:,+),
|
||||
asserta_static(:),
|
||||
assertz(:),
|
||||
assertz(:,+),
|
||||
assertz_static(:),
|
||||
at_halt(0),
|
||||
bagof(?,0,-),
|
||||
bb_get(:,-),
|
||||
bb_put(:,+),
|
||||
bb_delete(:,?),
|
||||
bb_update(:,?,?),
|
||||
call(0),
|
||||
call(1,?),
|
||||
call(2,?,?),
|
||||
call(3,?,?,?),
|
||||
call_with_args(0),
|
||||
call_with_args(1,?),
|
||||
call_with_args(2,?,?),
|
||||
call_with_args(3,?,?,?),
|
||||
call_with_args(4,?,?,?,?),
|
||||
call_with_args(5,?,?,?,?,?),
|
||||
call_with_args(6,?,?,?,?,?,?),
|
||||
call_with_args(7,?,?,?,?,?,?,?),
|
||||
call_with_args(8,?,?,?,?,?,?,?,?),
|
||||
call_with_args(9,?,?,?,?,?,?,?,?,?),
|
||||
call_cleanup(0,0),
|
||||
call_cleanup(0,?,0),
|
||||
call_residue(0,?),
|
||||
call_residue_vars(0,?),
|
||||
call_shared_object_function(:,+),
|
||||
clause(:,?),
|
||||
clause(:,?,?),
|
||||
current_predicate(:),
|
||||
current_predicate(?,:),
|
||||
depth_bound_call(0,+),
|
||||
findall(?,0,-),
|
||||
findall(?,0,-,?),
|
||||
forall(0,0),
|
||||
format(+,:),
|
||||
format(+,+,:),
|
||||
freeze(?,0),
|
||||
hide_predicate(:),
|
||||
if(0,0,0),
|
||||
ignore(0),
|
||||
incore(0),
|
||||
initializon(0),
|
||||
nospy(:),
|
||||
not(0),
|
||||
notrace(0),
|
||||
once(0),
|
||||
phrase(2,?),
|
||||
phrase(2,?,+),
|
||||
predicate_property(:,?),
|
||||
predicate_statistics(:,-,-,-),
|
||||
on_exception(+,0,0),
|
||||
qsave_program(+,:),
|
||||
retract(:),
|
||||
retract(:,?),
|
||||
retractall(:),
|
||||
reconsult(:),
|
||||
setof(?,0,-),
|
||||
setup_call_cleanup(0,0,0),
|
||||
setup_call_catcher_cleanup(0,0,?,0),
|
||||
spy(:),
|
||||
stash_predicate(:),
|
||||
when(+,0),
|
||||
with_mutex(+,0),
|
||||
with_output_to(?,0),
|
||||
'->'(0 , 0),
|
||||
'*->'(0 , 0),
|
||||
';'(0 , 0),
|
||||
','(0 , 0),
|
||||
^(+,0),
|
||||
{}(0,?,?),
|
||||
','(2,2,?,?),
|
||||
';'(2,2,?,?),
|
||||
'|'(2,2,?,?),
|
||||
->(2,2,?,?),
|
||||
\+(2,?,?),
|
||||
\+( 0 )]).
|
||||
|
|
@ -25,6 +25,15 @@
|
|||
|
||||
:- use_system_module( '$_errors', ['$do_error'/2]).
|
||||
|
||||
|
||||
:- '$system_meta_predicates'([
|
||||
discontiguous(:),
|
||||
multifile(:)
|
||||
]
|
||||
).
|
||||
|
||||
:- op(1150, fx, [multifile,discontiguous]).
|
||||
|
||||
'$log_upd'(1).
|
||||
|
||||
/**
|
||||
|
|
|
|||
23
pl/top.yap
23
pl/top.yap
|
|
@ -1,3 +1,19 @@
|
|||
/**
|
||||
* @file top.yap
|
||||
* @author VITOR SANTOS COSTA <vsc@vcosta-laptop.dcc.fc.up.pt>
|
||||
* @date Sat Apr 7 03:14:17 2018
|
||||
*
|
||||
* @brief top-level implementation plus system booting.x
|
||||
*
|
||||
* @defgroup Top-Level and Boot Predicates
|
||||
* @ingroup YAPControl
|
||||
*
|
||||
*/
|
||||
|
||||
:- '$system_meta_predicates'([
|
||||
catch(0,?,0),
|
||||
log_event(+,:)]).
|
||||
|
||||
|
||||
live :- '$live'.
|
||||
|
||||
|
|
@ -64,8 +80,8 @@ live :- '$live'.
|
|||
% 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),
|
||||
'$command'(Command,Varnames,Pos,top),
|
||||
current_prolog_flag(break_level, BreakLevel),
|
||||
(
|
||||
BreakLevel \= 0
|
||||
->
|
||||
|
|
@ -985,9 +1001,6 @@ stopped, and the exception is sent to the ancestor goals until reaching
|
|||
a matching catch/3, or until reaching top-level.
|
||||
|
||||
*/
|
||||
throw(Ball) :-
|
||||
% get current jump point
|
||||
'$jump_env_and_store_ball'(Ball).
|
||||
|
||||
'$run_toplevel_hooks' :-
|
||||
current_prolog_flag(break_level, 0 ),
|
||||
|
|
|
|||
Reference in New Issue