diff --git a/C/exec.c b/C/exec.c index 25d5bbd31..73a1059b0 100755 --- a/C/exec.c +++ b/C/exec.c @@ -1,19 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: exec.c * -* Last rev: 8/2/88 * -* mods: * -* comments: Execute Prolog code * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: exec.c * + * Last rev: 8/2/88 * + * mods: * + * comments: Execute Prolog code * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98"; #endif @@ -33,1174 +33,1174 @@ static Int p_execute0( USES_REGS1 ); static Term cp_as_integer(choiceptr cp USES_REGS) { - return(MkIntegerTerm(LCL0-(CELL *)cp)); + return(MkIntegerTerm(LCL0-(CELL *)cp)); } static choiceptr cp_from_integer(Term cpt USES_REGS) { - return (choiceptr)(LCL0-IntegerOfTerm(cpt)); + return (choiceptr)(LCL0-IntegerOfTerm(cpt)); } Term Yap_cp_as_integer(choiceptr cp) { - CACHE_REGS - return cp_as_integer(cp PASS_REGS); + CACHE_REGS + return cp_as_integer(cp PASS_REGS); } static inline Int CallPredicate(PredEntry *pen, choiceptr cut_pt, yamop *code USES_REGS) { #ifdef LOW_LEVEL_TRACER - if (Yap_do_low_level_trace) - low_level_trace(enter_pred,pen,XREGS+1); + if (Yap_do_low_level_trace) + low_level_trace(enter_pred,pen,XREGS+1); #endif /* LOW_LEVEL_TRACE */ #ifdef DEPTH_LIMIT - if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ - if (pen->ModuleOfPred) { - if (DEPTH == MkIntTerm(0)) { - UNLOCK(pen->PELock); - return FALSE; - } - else DEPTH = RESET_DEPTH(); - } - } else if (pen->ModuleOfPred) - DEPTH -= MkIntConstant(2); + if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ + if (pen->ModuleOfPred) { + if (DEPTH == MkIntTerm(0)) { + UNLOCK(pen->PELock); + return FALSE; + } + else DEPTH = RESET_DEPTH(); + } + } else if (pen->ModuleOfPred) + DEPTH -= MkIntConstant(2); #endif /* DEPTH_LIMIT */ - if (P->opc != EXECUTE_CPRED_OP_CODE) { - CP = P; - ENV = YENV; - YENV = ASP; - } - /* make sure we have access to the user given cut */ - YENV[E_CB] = (CELL) cut_pt; - P = code; - return TRUE; + if (P->opc != EXECUTE_CPRED_OP_CODE) { + CP = P; + ENV = YENV; + YENV = ASP; + } + /* make sure we have access to the user given cut */ + YENV[E_CB] = (CELL) cut_pt; + P = code; + return TRUE; } inline static Int CallMetaCall(Term t, Term mod USES_REGS) { - ARG1 = t; - ARG2 = cp_as_integer(B PASS_REGS); /* p_save_cp */ - ARG3 = t; - if (mod) { - ARG4 = mod; - } else { - ARG4 = TermProlog; - } - return CallPredicate(PredMetaCall, B, PredMetaCall->CodeOfPred PASS_REGS); + ARG1 = t; + ARG2 = cp_as_integer(B PASS_REGS); /* p_save_cp */ + ARG3 = t; + if (mod) { + ARG4 = mod; + } else { + ARG4 = TermProlog; + } + return CallPredicate(PredMetaCall, B, PredMetaCall->CodeOfPred PASS_REGS); } Term Yap_ExecuteCallMetaCall(Term mod) { - CACHE_REGS - Term ts[4]; - ts[0] = ARG1; - ts[1] = cp_as_integer(B PASS_REGS); /* p_save_cp */ - ts[2] = ARG1; - ts[3] = mod; - return Yap_MkApplTerm(PredMetaCall->FunctorOfPred,4,ts); + CACHE_REGS + Term ts[4]; + ts[0] = ARG1; + ts[1] = cp_as_integer(B PASS_REGS); /* p_save_cp */ + ts[2] = ARG1; + ts[3] = mod; + return Yap_MkApplTerm(PredMetaCall->FunctorOfPred,4,ts); } Term Yap_PredicateIndicator(Term t, Term mod) { - CACHE_REGS - // generate predicate indicator in this case - Term ti[2]; - t = Yap_StripModule( t, &mod ); - if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) { - ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t))); - ti[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t))); - } else if (IsPairTerm(t)) { - ti[0] = MkAtomTerm(AtomDot); - ti[1] = MkIntTerm(2); - } else { - ti[0] = t; - ti[1] = MkIntTerm(0); - } - t = Yap_MkApplTerm(FunctorSlash, 2, ti); - if (mod != CurrentModule) { - ti[0] = mod; - ti[1] = t; - return Yap_MkApplTerm(FunctorModule, 2, ti); - } - return t; + CACHE_REGS + // generate predicate indicator in this case + Term ti[2]; + t = Yap_StripModule( t, &mod ); + if (IsApplTerm(t) && !IsExtensionFunctor(FunctorOfTerm(t))) { + ti[0] = MkAtomTerm(NameOfFunctor(FunctorOfTerm(t))); + ti[1] = MkIntegerTerm(ArityOfFunctor(FunctorOfTerm(t))); + } else if (IsPairTerm(t)) { + ti[0] = MkAtomTerm(AtomDot); + ti[1] = MkIntTerm(2); + } else { + ti[0] = t; + ti[1] = MkIntTerm(0); + } + t = Yap_MkApplTerm(FunctorSlash, 2, ti); + if (mod != CurrentModule) { + ti[0] = mod; + ti[1] = t; + return Yap_MkApplTerm(FunctorModule, 2, ti); + } + return t; } static Int CallError(yap_error_number err, Term t, Term mod USES_REGS) { - if (yap_flags[LANGUAGE_MODE_FLAG] == 1) { - return(CallMetaCall(t, mod PASS_REGS)); - } else { - if (err == TYPE_ERROR_CALLABLE) { - t = Yap_StripModule(t, &mod); + if (isoLanguageFlag()) { + return(CallMetaCall(t, mod PASS_REGS)); + } else { + if (err == TYPE_ERROR_CALLABLE) { + t = Yap_StripModule(t, &mod); + } + Yap_Error(err, t, "call/1"); + return FALSE; } - Yap_Error(err, t, "call/1"); - return FALSE; - } } static Int p_save_cp( USES_REGS1 ) { - Term t = Deref(ARG1); - Term td; + Term t = Deref(ARG1); + Term td; #if SHADOW_HB - register CELL *HBREG = HB; + register CELL *HBREG = HB; #endif - if (!IsVarTerm(t)) return(FALSE); - td = cp_as_integer(B PASS_REGS); - YapBind((CELL *)t,td); - return TRUE; + if (!IsVarTerm(t)) return(FALSE); + td = cp_as_integer(B PASS_REGS); + YapBind((CELL *)t,td); + return TRUE; } static Int p_save_env_b( USES_REGS1 ) { - Term t = Deref(ARG1); - Term td; + Term t = Deref(ARG1); + Term td; #if SHADOW_HB - register CELL *HBREG = HB; + register CELL *HBREG = HB; #endif - if (!IsVarTerm(t)) return(FALSE); - td = cp_as_integer((choiceptr)YENV[E_CB] PASS_REGS); - YapBind((CELL *)t,td); - return TRUE; + if (!IsVarTerm(t)) return(FALSE); + td = cp_as_integer((choiceptr)YENV[E_CB] PASS_REGS); + YapBind((CELL *)t,td); + return TRUE; } static Int p_trail_suspension_marker( USES_REGS1 ) { - Term t = Deref(ARG1); - - TrailTerm(TR) = AbsPair((CELL*)t); - TR++; - return TRUE; + Term t = Deref(ARG1); + + TrailTerm(TR) = AbsPair((CELL*)t); + TR++; + return TRUE; } inline static Int do_execute(Term t, Term mod USES_REGS) { - Term t0 = t; - /* first do predicate expansion, even before you process signals. + Term t0 = t; + /* first do predicate expansion, even before you process signals. This way you don't get to spy goal_expansion(). */ - if (PRED_GOAL_EXPANSION_ALL) { - /* disable creeping when we do goal expansion */ - if (!LOCAL_InterruptsDisabled && - Yap_get_signal( YAP_CREEP_SIGNAL ) ) { - CalculateStackGap( PASS_REGS1 ); + if (PRED_GOAL_EXPANSION_ALL) { + /* disable creeping when we do goal expansion */ + if (!LOCAL_InterruptsDisabled && + Yap_get_signal( YAP_CREEP_SIGNAL ) ) { + CalculateStackGap( PASS_REGS1 ); + } + return CallMetaCall(ARG1, mod PASS_REGS); + } else if (Yap_has_a_signal() && + !LOCAL_InterruptsDisabled && + !(LOCAL_PrologMode & (AbortMode|InterruptMode|SystemMode))) { + return EnterCreepMode(t, mod PASS_REGS); } - return CallMetaCall(ARG1, mod PASS_REGS); - } else if (Yap_has_a_signal() && - !LOCAL_InterruptsDisabled && - !(LOCAL_PrologMode & (AbortMode|InterruptMode|SystemMode))) { - return EnterCreepMode(t, mod PASS_REGS); - } - restart_exec: - if (IsVarTerm(t)) { - return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); - } else if (IsApplTerm(t)) { - register Functor f = FunctorOfTerm(t); - register CELL *pt; - PredEntry *pen; - unsigned int i, arity; - - f = FunctorOfTerm(t); - if (IsExtensionFunctor(f)) { - return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); - } - arity = ArityOfFunctor(f); - if (arity > MaxTemps) { - return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); - } - pen = RepPredProp(PredPropByFunc(f, mod)); - /* You thought we would be over by now */ - /* but no meta calls require special preprocessing */ - if (pen->PredFlags & (GoalExPredFlag|MetaPredFlag)) { - if (f == FunctorModule) { - Term tmod = ArgOfTerm(1,t); - if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { - mod = tmod; - t = ArgOfTerm(2,t); - goto restart_exec; - } else { - if (IsVarTerm(tmod)) { - return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); - } else { - return CallError(TYPE_ERROR_ATOM, t0, mod PASS_REGS); - } - } - } else { - return CallMetaCall(t, mod PASS_REGS); - } - } - /* now let us do what we wanted to do from the beginning !! */ - /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ - pt = RepAppl(t)+1; - for (i = 1; i <= arity; i++) { +restart_exec: + if (IsVarTerm(t)) { + return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); + } else if (IsApplTerm(t)) { + register Functor f = FunctorOfTerm(t); + register CELL *pt; + PredEntry *pen; + unsigned int i, arity; + + f = FunctorOfTerm(t); + if (IsExtensionFunctor(f)) { + return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); + } + arity = ArityOfFunctor(f); + if (arity > MaxTemps) { + return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); + } + pen = RepPredProp(PredPropByFunc(f, mod)); + /* You thought we would be over by now */ + /* but no meta calls require special preprocessing */ + if (pen->PredFlags & (GoalExPredFlag|MetaPredFlag)) { + if (f == FunctorModule) { + Term tmod = ArgOfTerm(1,t); + if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { + mod = tmod; + t = ArgOfTerm(2,t); + goto restart_exec; + } else { + if (IsVarTerm(tmod)) { + return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); + } else { + return CallError(TYPE_ERROR_ATOM, t0, mod PASS_REGS); + } + } + } else { + return CallMetaCall(t, mod PASS_REGS); + } + } + /* now let us do what we wanted to do from the beginning !! */ + /* I cannot use the standard macro here because + otherwise I would dereference the argument and + might skip a svar */ + pt = RepAppl(t)+1; + for (i = 1; i <= arity; i++) { #if YAPOR_SBA - Term d0 = *pt++; - if (d0 == 0) -` XREGS[i] = (CELL)(pt-1); - else - XREGS[i] = d0; + Term d0 = *pt++; + if (d0 == 0) + ` XREGS[i] = (CELL)(pt-1); + else + XREGS[i] = d0; #else - - - XREGS[i] = *pt++; + + + XREGS[i] = *pt++; #endif + } + return (CallPredicate(pen, B, pen->CodeOfPred PASS_REGS)); + } else if (IsAtomTerm(t)) { + PredEntry *pe; + Atom a = AtomOfTerm(t); + + if (a == AtomTrue || a == AtomOtherwise || a == AtomCut) + return(TRUE); + else if (a == AtomFail || (a == AtomFalse && !RepPredProp(PredPropByAtom(a, mod))->ModuleOfPred) ) + return(FALSE); + /* call may not define new system predicates!! */ + pe = RepPredProp(PredPropByAtom(a, mod)); + return (CallPredicate(pe, B, pe->CodeOfPred PASS_REGS)); + } else if (IsIntTerm(t)) { + return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); + } else { + /* Is Pair Term */ + return(CallMetaCall(t, mod PASS_REGS)); } - return (CallPredicate(pen, B, pen->CodeOfPred PASS_REGS)); - } else if (IsAtomTerm(t)) { - PredEntry *pe; - Atom a = AtomOfTerm(t); - - if (a == AtomTrue || a == AtomOtherwise || a == AtomCut) - return(TRUE); - else if (a == AtomFail || (a == AtomFalse && !RepPredProp(PredPropByAtom(a, mod))->ModuleOfPred) ) - return(FALSE); - /* call may not define new system predicates!! */ - pe = RepPredProp(PredPropByAtom(a, mod)); - return (CallPredicate(pe, B, pe->CodeOfPred PASS_REGS)); - } else if (IsIntTerm(t)) { - return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); - } else { - /* Is Pair Term */ - return(CallMetaCall(t, mod PASS_REGS)); - } } static Term copy_execn_to_heap(Functor f, CELL *pt, unsigned int n, unsigned int arity, Term mod USES_REGS) { - CELL *h0 = HR; - Term tf; - unsigned int i; - - if (arity == 2 && - NameOfFunctor(f) == AtomDot) { - for (i = 0; i MaxTemps) { - return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); - } - pen = RepPredProp(PredPropByFunc(f, mod)); - /* You thought we would be over by now */ - /* but no meta calls require special preprocessing */ - if (pen->PredFlags & (GoalExPredFlag|MetaPredFlag)) { - Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS); - return(CallMetaCall(t, mod PASS_REGS)); - } - /* now let us do what we wanted to do from the beginning !! */ - /* I cannot use the standard macro here because + if (PRED_GOAL_EXPANSION_ALL) { + /* disable creeping when we do goal expansion */ + if (Yap_get_signal( YAP_CREEP_SIGNAL ) && + !LOCAL_InterruptsDisabled) { + CalculateStackGap( PASS_REGS1 ); + } + t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS); + return CallMetaCall(t, mod PASS_REGS); + } else if (Yap_has_a_signal() && + !LOCAL_InterruptsDisabled) { + return EnterCreepMode(copy_execn_to_heap(f, pt, n, arity, CurrentModule PASS_REGS), mod PASS_REGS); + } + if (arity > MaxTemps) { + return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); + } + pen = RepPredProp(PredPropByFunc(f, mod)); + /* You thought we would be over by now */ + /* but no meta calls require special preprocessing */ + if (pen->PredFlags & (GoalExPredFlag|MetaPredFlag)) { + Term t = copy_execn_to_heap(f, pt, n, arity, mod PASS_REGS); + return(CallMetaCall(t, mod PASS_REGS)); + } + /* now let us do what we wanted to do from the beginning !! */ + /* I cannot use the standard macro here because otherwise I would dereference the argument and might skip a svar */ - for (i = 1; i <= arity-n; i++) { + for (i = 1; i <= arity-n; i++) { #if YAPOR_SBA - Term d0 = *pt++; - if (d0 == 0) - XREGS[i] = (CELL)(pt-1); - else - XREGS[i] = d0; + Term d0 = *pt++; + if (d0 == 0) + XREGS[i] = (CELL)(pt-1); + else + XREGS[i] = d0; #else - XREGS[i] = *pt++; + XREGS[i] = *pt++; #endif - } - for (i = arity-n+1; i <= arity; i++,j++) { - XREGS[i] = HR[j]; - } - return CallPredicate(pen, B, pen->CodeOfPred PASS_REGS); + } + for (i = arity-n+1; i <= arity; i++,j++) { + XREGS[i] = HR[j]; + } + return CallPredicate(pen, B, pen->CodeOfPred PASS_REGS); } // enter locked static Int EnterCreepMode(Term t, Term mod USES_REGS) { - PredEntry *PredCreep; - - if (Yap_get_signal( YAP_CDOVF_SIGNAL ) ) { - ARG1 = t; - if (!Yap_locked_growheap(FALSE, 0, NULL)) { - Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at meta-call"); + PredEntry *PredCreep; + + if (Yap_get_signal( YAP_CDOVF_SIGNAL ) ) { + ARG1 = t; + if (!Yap_locked_growheap(FALSE, 0, NULL)) { + Yap_Error(OUT_OF_HEAP_ERROR, TermNil, "YAP failed to grow heap at meta-call"); + } + if (!Yap_has_a_signal()) { + return do_execute(ARG1, mod PASS_REGS); + } } - if (!Yap_has_a_signal()) { - return do_execute(ARG1, mod PASS_REGS); - } - } - PredCreep = RepPredProp(PredPropByFunc(FunctorCreep,1)); - PP = PredCreep; - if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule) { - ARG1 = MkPairTerm(ArgOfTerm(1,t),ArgOfTerm(2,t)); - } else { - if (mod) { - ARG1 = MkPairTerm(mod,t); + PredCreep = RepPredProp(PredPropByFunc(FunctorCreep,1)); + PP = PredCreep; + if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == FunctorModule) { + ARG1 = MkPairTerm(ArgOfTerm(1,t),ArgOfTerm(2,t)); } else { - ARG1 = MkPairTerm(TermProlog,t); + if (mod) { + ARG1 = MkPairTerm(mod,t); + } else { + ARG1 = MkPairTerm(TermProlog,t); + } } - } - CalculateStackGap( PASS_REGS1 ); - P_before_spy = P; - return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS); + CalculateStackGap( PASS_REGS1 ); + P_before_spy = P; + return CallPredicate(PredCreep, B, PredCreep->CodeOfPred PASS_REGS); } static Int p_execute( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - return do_execute(t, CurrentModule PASS_REGS); + Term t = Deref(ARG1); + return do_execute(t, CurrentModule PASS_REGS); } static void heap_store(Term t USES_REGS) { - if (IsVarTerm(t)) { - if (VarOfTerm(t) < HR) { - *HR++ = t; + if (IsVarTerm(t)) { + if (VarOfTerm(t) < HR) { + *HR++ = t; + } else { + RESET_VARIABLE(HR); + Bind_Local(VarOfTerm(t), (CELL)HR); + HR++; + } } else { - RESET_VARIABLE(HR); - Bind_Local(VarOfTerm(t), (CELL)HR); - HR++; + *HR++ = t; } - } else { - *HR++ = t; - } } static Int p_execute2( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - return do_execute_n(t, CurrentModule, 1 PASS_REGS); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + return do_execute_n(t, CurrentModule, 1 PASS_REGS); } static Int p_execute3( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - return do_execute_n(t, CurrentModule, 2 PASS_REGS); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + return do_execute_n(t, CurrentModule, 2 PASS_REGS); } static Int p_execute4( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - return do_execute_n(t, CurrentModule, 3 PASS_REGS); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + return do_execute_n(t, CurrentModule, 3 PASS_REGS); } static Int p_execute5( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - heap_store(Deref(ARG5) PASS_REGS); - return do_execute_n(t, CurrentModule, 4 PASS_REGS); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + heap_store(Deref(ARG5) PASS_REGS); + return do_execute_n(t, CurrentModule, 4 PASS_REGS); } static Int p_execute6( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - heap_store(Deref(ARG5) PASS_REGS); - heap_store(Deref(ARG6) PASS_REGS); - return do_execute_n(t, CurrentModule, 5 PASS_REGS); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + heap_store(Deref(ARG5) PASS_REGS); + heap_store(Deref(ARG6) PASS_REGS); + return do_execute_n(t, CurrentModule, 5 PASS_REGS); } static Int p_execute7( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - heap_store(Deref(ARG5) PASS_REGS); - heap_store(Deref(ARG6) PASS_REGS); - heap_store(Deref(ARG7) PASS_REGS); - return do_execute_n(t, CurrentModule, 6 PASS_REGS); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + heap_store(Deref(ARG5) PASS_REGS); + heap_store(Deref(ARG6) PASS_REGS); + heap_store(Deref(ARG7) PASS_REGS); + return do_execute_n(t, CurrentModule, 6 PASS_REGS); } static Int p_execute8( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - heap_store(Deref(ARG5) PASS_REGS); - heap_store(Deref(ARG6) PASS_REGS); - heap_store(Deref(ARG7) PASS_REGS); - heap_store(Deref(ARG8) PASS_REGS); - return do_execute_n(t, CurrentModule, 7 PASS_REGS); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + heap_store(Deref(ARG5) PASS_REGS); + heap_store(Deref(ARG6) PASS_REGS); + heap_store(Deref(ARG7) PASS_REGS); + heap_store(Deref(ARG8) PASS_REGS); + return do_execute_n(t, CurrentModule, 7 PASS_REGS); } static Int p_execute9( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - heap_store(Deref(ARG5) PASS_REGS); - heap_store(Deref(ARG6) PASS_REGS); - heap_store(Deref(ARG7) PASS_REGS); - heap_store(Deref(ARG8) PASS_REGS); - heap_store(Deref(ARG9) PASS_REGS); - return do_execute_n(t, CurrentModule, 8 PASS_REGS); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + heap_store(Deref(ARG5) PASS_REGS); + heap_store(Deref(ARG6) PASS_REGS); + heap_store(Deref(ARG7) PASS_REGS); + heap_store(Deref(ARG8) PASS_REGS); + heap_store(Deref(ARG9) PASS_REGS); + return do_execute_n(t, CurrentModule, 8 PASS_REGS); } static Int p_execute10( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - heap_store(Deref(ARG5) PASS_REGS); - heap_store(Deref(ARG6) PASS_REGS); - heap_store(Deref(ARG7) PASS_REGS); - heap_store(Deref(ARG8) PASS_REGS); - heap_store(Deref(ARG9) PASS_REGS); - heap_store(Deref(ARG10) PASS_REGS); - return(do_execute_n(t, CurrentModule, 9 PASS_REGS)); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + heap_store(Deref(ARG5) PASS_REGS); + heap_store(Deref(ARG6) PASS_REGS); + heap_store(Deref(ARG7) PASS_REGS); + heap_store(Deref(ARG8) PASS_REGS); + heap_store(Deref(ARG9) PASS_REGS); + heap_store(Deref(ARG10) PASS_REGS); + return(do_execute_n(t, CurrentModule, 9 PASS_REGS)); } static Int p_execute11( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - heap_store(Deref(ARG5) PASS_REGS); - heap_store(Deref(ARG6) PASS_REGS); - heap_store(Deref(ARG7) PASS_REGS); - heap_store(Deref(ARG8) PASS_REGS); - heap_store(Deref(ARG9) PASS_REGS); - heap_store(Deref(ARG10) PASS_REGS); - heap_store(Deref(ARG11) PASS_REGS); - return(do_execute_n(t, CurrentModule, 10 PASS_REGS)); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + heap_store(Deref(ARG5) PASS_REGS); + heap_store(Deref(ARG6) PASS_REGS); + heap_store(Deref(ARG7) PASS_REGS); + heap_store(Deref(ARG8) PASS_REGS); + heap_store(Deref(ARG9) PASS_REGS); + heap_store(Deref(ARG10) PASS_REGS); + heap_store(Deref(ARG11) PASS_REGS); + return(do_execute_n(t, CurrentModule, 10 PASS_REGS)); } static Int p_execute12( USES_REGS1 ) { /* '$execute'(Goal) */ - Term t = Deref(ARG1); - heap_store(Deref(ARG2) PASS_REGS); - heap_store(Deref(ARG3) PASS_REGS); - heap_store(Deref(ARG4) PASS_REGS); - heap_store(Deref(ARG5) PASS_REGS); - heap_store(Deref(ARG6) PASS_REGS); - heap_store(Deref(ARG7) PASS_REGS); - heap_store(Deref(ARG8) PASS_REGS); - heap_store(Deref(ARG9) PASS_REGS); - heap_store(Deref(ARG10) PASS_REGS); - heap_store(Deref(ARG11) PASS_REGS); - heap_store(Deref(ARG12) PASS_REGS); - return(do_execute_n(t, CurrentModule, 11 PASS_REGS)); + Term t = Deref(ARG1); + heap_store(Deref(ARG2) PASS_REGS); + heap_store(Deref(ARG3) PASS_REGS); + heap_store(Deref(ARG4) PASS_REGS); + heap_store(Deref(ARG5) PASS_REGS); + heap_store(Deref(ARG6) PASS_REGS); + heap_store(Deref(ARG7) PASS_REGS); + heap_store(Deref(ARG8) PASS_REGS); + heap_store(Deref(ARG9) PASS_REGS); + heap_store(Deref(ARG10) PASS_REGS); + heap_store(Deref(ARG11) PASS_REGS); + heap_store(Deref(ARG12) PASS_REGS); + return(do_execute_n(t, CurrentModule, 11 PASS_REGS)); } static Int p_execute_clause( USES_REGS1 ) { /* '$execute_clause'(Goal) */ - Term t = Deref(ARG1); - Term mod = Deref(ARG2); - choiceptr cut_cp = cp_from_integer(Deref(ARG4) PASS_REGS); - unsigned int arity; - Prop pe; - yamop *code; - Term clt = Deref(ARG3); - - restart_exec: - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1"); - return FALSE; - } else if (IsAtomTerm(t)) { - Atom a = AtomOfTerm(t); - pe = PredPropByAtom(a, mod); - } else if (IsApplTerm(t)) { - register Functor f = FunctorOfTerm(t); - register unsigned int i; - register CELL *pt; - - if (IsExtensionFunctor(f)) - return(FALSE); - if (f == FunctorModule) { - Term tmod = ArgOfTerm(1,t); - if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { - mod = tmod; - t = ArgOfTerm(2,t); - goto restart_exec; - } - } - pe = PredPropByFunc(f, mod); - arity = ArityOfFunctor(f); - if (arity > MaxTemps) { - return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); - } - /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ - pt = RepAppl(t)+1; - for (i = 1; i <= arity; ++i) { + Term t = Deref(ARG1); + Term mod = Deref(ARG2); + choiceptr cut_cp = cp_from_integer(Deref(ARG4) PASS_REGS); + unsigned int arity; + Prop pe; + yamop *code; + Term clt = Deref(ARG3); + +restart_exec: + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1"); + return FALSE; + } else if (IsAtomTerm(t)) { + Atom a = AtomOfTerm(t); + pe = PredPropByAtom(a, mod); + } else if (IsApplTerm(t)) { + register Functor f = FunctorOfTerm(t); + register unsigned int i; + register CELL *pt; + + if (IsExtensionFunctor(f)) + return(FALSE); + if (f == FunctorModule) { + Term tmod = ArgOfTerm(1,t); + if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { + mod = tmod; + t = ArgOfTerm(2,t); + goto restart_exec; + } + } + pe = PredPropByFunc(f, mod); + arity = ArityOfFunctor(f); + if (arity > MaxTemps) { + return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); + } + /* I cannot use the standard macro here because + otherwise I would dereference the argument and + might skip a svar */ + pt = RepAppl(t)+1; + for (i = 1; i <= arity; ++i) { #if YAPOR_SBA - Term d0 = *pt++; - if (d0 == 0) - XREGS[i] = (CELL)(pt-1); - else - XREGS[i] = d0; + Term d0 = *pt++; + if (d0 == 0) + XREGS[i] = (CELL)(pt-1); + else + XREGS[i] = d0; #else - XREGS[i] = *pt++; + XREGS[i] = *pt++; #endif + } + } else { + return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); } - } else { - return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); - } - /* N = arity; */ - /* call may not define new system predicates!! */ - if (RepPredProp(pe)->PredFlags & MegaClausePredFlag) { - code = Yap_MegaClauseFromTerm(clt); - } else { - code = Yap_ClauseFromTerm(clt)->ClCode; - } - if (Yap_get_signal(YAP_CREEP_SIGNAL)) { - Yap_signal(YAP_CREEP_SIGNAL); - } - return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS); + /* N = arity; */ + /* call may not define new system predicates!! */ + if (RepPredProp(pe)->PredFlags & MegaClausePredFlag) { + code = Yap_MegaClauseFromTerm(clt); + } else { + code = Yap_ClauseFromTerm(clt)->ClCode; + } + if (Yap_get_signal(YAP_CREEP_SIGNAL)) { + Yap_signal(YAP_CREEP_SIGNAL); + } + return CallPredicate(RepPredProp(pe), cut_cp, code PASS_REGS); } static Int p_execute_in_mod( USES_REGS1 ) { /* '$execute'(Goal) */ - return(do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS)); + return(do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS)); } static Int p_do_goal_expansion( USES_REGS1 ) { - Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL); - Int out = FALSE; - PredEntry *pe; - Term cmod = Deref(ARG2); - - ARG2 = ARG3; - - /* CurMod:goal_expansion(A,B) */ - if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) && - pe->OpcodeOfPred != FAIL_OPCODE && - pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { - out = TRUE; + Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL); + Int out = FALSE; + PredEntry *pe; + Term cmod = Deref(ARG2); + + ARG2 = ARG3; + + /* CurMod:goal_expansion(A,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, cmod) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + Yap_execute_pred(pe, NULL PASS_REGS, false) ) { + out = TRUE; + ARG3 = ARG2; + goto complete; + } + /* system:goal_expansion(A,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + Yap_execute_pred(pe, NULL PASS_REGS, false) ) { + out = TRUE; + ARG3 = ARG2; + goto complete; + } ARG3 = ARG2; - goto complete; - } - /* system:goal_expansion(A,B) */ - if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, SYSTEM_MODULE ) ) ) && - pe->OpcodeOfPred != FAIL_OPCODE && - pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { - out = TRUE; - ARG3 = ARG2; - goto complete; - } - ARG3 = ARG2; - ARG2 = cmod; - /* user:goal_expansion(A,CurMod,B) */ - if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE ) ) ) && - pe->OpcodeOfPred != FAIL_OPCODE && - pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { - out = TRUE; - goto complete; - } - ARG2 = ARG3; - /* user:goal_expansion(A,B) */ - if ( cmod != USER_MODULE && /* we have tried this before */ - (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE ) ) ) && - pe->OpcodeOfPred != FAIL_OPCODE && - pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { - ARG3 = ARG2; - out = TRUE; - } - complete: - if (creeping) { - Yap_signal( YAP_CREEP_SIGNAL ); - } - return out; + ARG2 = cmod; + /* user:goal_expansion(A,CurMod,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion, USER_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + Yap_execute_pred(pe, NULL PASS_REGS, false) ) { + out = TRUE; + goto complete; + } + ARG2 = ARG3; + /* user:goal_expansion(A,B) */ + if ( cmod != USER_MODULE && /* we have tried this before */ + (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorGoalExpansion2, USER_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + Yap_execute_pred(pe, NULL PASS_REGS, false) ) { + ARG3 = ARG2; + out = TRUE; + } +complete: + if (creeping) { + Yap_signal( YAP_CREEP_SIGNAL ); + } + return out; } static Int p_do_term_expansion( USES_REGS1 ) { - Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL); - Int out = FALSE; - PredEntry *pe; - Term cmod = CurrentModule; - - /* CurMod:term_expansion(A,B) */ - if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) && - pe->OpcodeOfPred != FAIL_OPCODE && - pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { - out = TRUE; - goto complete; - } - /* system:term_expansion(A,B) */ - if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE ) ) ) && - pe->OpcodeOfPred != FAIL_OPCODE && - pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { - out = TRUE; - goto complete; - } - /* user:term_expansion(A,B) */ - if ( cmod != USER_MODULE && /* we have tried this before */ - (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE ) ) ) && - pe->OpcodeOfPred != FAIL_OPCODE && - pe->OpcodeOfPred != UNDEF_OPCODE && - Yap_execute_pred(pe, NULL PASS_REGS) ) { - out = TRUE; - } - complete: - if (creeping) { - Yap_signal(YAP_CREEP_SIGNAL); - } - return out; + Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL); + Int out = FALSE; + PredEntry *pe; + Term cmod = CurrentModule; + + /* CurMod:term_expansion(A,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, cmod) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + Yap_execute_pred(pe, NULL PASS_REGS, false) ) { + out = TRUE; + goto complete; + } + /* system:term_expansion(A,B) */ + if ( (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, SYSTEM_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + Yap_execute_pred(pe, NULL PASS_REGS, false) ) { + out = TRUE; + goto complete; + } + /* user:term_expansion(A,B) */ + if ( cmod != USER_MODULE && /* we have tried this before */ + (pe = RepPredProp(Yap_GetPredPropByFunc(FunctorTermExpansion, USER_MODULE ) ) ) && + pe->OpcodeOfPred != FAIL_OPCODE && + pe->OpcodeOfPred != UNDEF_OPCODE && + Yap_execute_pred(pe, NULL PASS_REGS, false) ) { + out = TRUE; + } +complete: + if (creeping) { + Yap_signal(YAP_CREEP_SIGNAL); + } + return out; } static Int p_execute0( USES_REGS1 ) { /* '$execute0'(Goal,Mod) */ - Term t = Deref(ARG1), t0 = t; - Term mod = Deref(ARG2); - unsigned int arity; - Prop pe; - - if (Yap_has_a_signal() && - !LOCAL_InterruptsDisabled) { - return EnterCreepMode(t, mod PASS_REGS); - } - restart_exec: - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1"); - return FALSE; - } else if (IsAtomTerm(t)) { - Atom a = AtomOfTerm(t); - pe = PredPropByAtom(a, mod); - } else if (IsApplTerm(t)) { - register Functor f = FunctorOfTerm(t); - register unsigned int i; - register CELL *pt; - - if (IsExtensionFunctor(f)) - return FALSE; - if (f == FunctorModule) { - Term tmod = ArgOfTerm(1,t); - if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { - mod = tmod; - t = ArgOfTerm(2,t); - goto restart_exec; - } else { - if (IsVarTerm(tmod)) { - return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); - } else { - return CallError(TYPE_ERROR_ATOM, t0, mod PASS_REGS); - } - } + Term t = Deref(ARG1), t0 = t; + Term mod = Deref(ARG2); + unsigned int arity; + Prop pe; + + if (Yap_has_a_signal() && + !LOCAL_InterruptsDisabled) { + return EnterCreepMode(t, mod PASS_REGS); } - pe = PredPropByFunc(f, mod); - // Yap_DebugPlWrite(mod);fprintf(stderr,"\n"); - arity = ArityOfFunctor(f); - if (arity > MaxTemps) { - return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); - } - /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ - pt = RepAppl(t)+1; - for (i = 1; i <= arity; ++i) { +restart_exec: + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR,ARG3,"call/1"); + return FALSE; + } else if (IsAtomTerm(t)) { + Atom a = AtomOfTerm(t); + pe = PredPropByAtom(a, mod); + } else if (IsApplTerm(t)) { + register Functor f = FunctorOfTerm(t); + register unsigned int i; + register CELL *pt; + + if (IsExtensionFunctor(f)) + return FALSE; + if (f == FunctorModule) { + Term tmod = ArgOfTerm(1,t); + if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { + mod = tmod; + t = ArgOfTerm(2,t); + goto restart_exec; + } else { + if (IsVarTerm(tmod)) { + return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); + } else { + return CallError(TYPE_ERROR_ATOM, t0, mod PASS_REGS); + } + } + } + pe = PredPropByFunc(f, mod); + // Yap_DebugPlWrite(mod);fprintf(stderr,"\n"); + arity = ArityOfFunctor(f); + if (arity > MaxTemps) { + return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); + } + /* I cannot use the standard macro here because + otherwise I would dereference the argument and + might skip a svar */ + pt = RepAppl(t)+1; + for (i = 1; i <= arity; ++i) { #if YAPOR_SBA - Term d0 = *pt++; - if (d0 == 0) - XREGS[i] = (CELL)(pt-1); - else - XREGS[i] = d0; + Term d0 = *pt++; + if (d0 == 0) + XREGS[i] = (CELL)(pt-1); + else + XREGS[i] = d0; #else - XREGS[i] = *pt++; + XREGS[i] = *pt++; #endif + } + } else { + Yap_Error(TYPE_ERROR_CALLABLE, t,"call/1"); + return FALSE; } - } else { - Yap_Error(TYPE_ERROR_CALLABLE, t,"call/1"); - return FALSE; - } - /* N = arity; */ - /* call may not define new system predicates!! */ - return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred PASS_REGS); + /* N = arity; */ + /* call may not define new system predicates!! */ + return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred PASS_REGS); } static Int p_execute_nonstop( USES_REGS1 ) { /* '$execute_nonstop'(Goal,Mod) */ - Term t = Deref(ARG1), t0 = t; - Term mod = Deref(ARG2); - unsigned int arity; - Prop pe; - - restart_exec: - if (IsVarTerm(mod)) { - mod = CurrentModule; - } else if (!IsAtomTerm(mod)) { - Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1"); - return FALSE; - } - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,ARG1,"call/1"); - return FALSE; - } else if (IsAtomTerm(t)) { - Atom a = AtomOfTerm(t); - pe = PredPropByAtom(a, mod); - } else if (IsApplTerm(t)) { - register Functor f = FunctorOfTerm(t); - register unsigned int i; - register CELL *pt; - - if (IsExtensionFunctor(f)) - return(FALSE); - if (f == FunctorModule) { - Term tmod = ArgOfTerm(1,t); - if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { - mod = tmod; - t = ArgOfTerm(2,t); - goto restart_exec; - } else { - if (IsVarTerm(tmod)) { - return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); - } else { - return CallError(TYPE_ERROR_ATOM, t, mod PASS_REGS); - } - } + Term t = Deref(ARG1), t0 = t; + Term mod = Deref(ARG2); + unsigned int arity; + Prop pe; + +restart_exec: + if (IsVarTerm(mod)) { + mod = CurrentModule; + } else if (!IsAtomTerm(mod)) { + Yap_Error(TYPE_ERROR_ATOM, ARG2, "call/1"); + return FALSE; } - pe = PredPropByFunc(f, mod); - arity = ArityOfFunctor(f); - if (arity > MaxTemps) { - return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); - } - /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ - pt = RepAppl(t)+1; - for (i = 1; i <= arity; ++i) { + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR,ARG1,"call/1"); + return FALSE; + } else if (IsAtomTerm(t)) { + Atom a = AtomOfTerm(t); + pe = PredPropByAtom(a, mod); + } else if (IsApplTerm(t)) { + register Functor f = FunctorOfTerm(t); + register unsigned int i; + register CELL *pt; + + if (IsExtensionFunctor(f)) + return(FALSE); + if (f == FunctorModule) { + Term tmod = ArgOfTerm(1,t); + if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { + mod = tmod; + t = ArgOfTerm(2,t); + goto restart_exec; + } else { + if (IsVarTerm(tmod)) { + return CallError(INSTANTIATION_ERROR, t0, mod PASS_REGS); + } else { + return CallError(TYPE_ERROR_ATOM, t, mod PASS_REGS); + } + } + } + pe = PredPropByFunc(f, mod); + arity = ArityOfFunctor(f); + if (arity > MaxTemps) { + return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); + } + /* I cannot use the standard macro here because + otherwise I would dereference the argument and + might skip a svar */ + pt = RepAppl(t)+1; + for (i = 1; i <= arity; ++i) { #if YAPOR_SBA - Term d0 = *pt++; - if (d0 == 0) - XREGS[i] = (CELL)(pt-1); - else - XREGS[i] = d0; + Term d0 = *pt++; + if (d0 == 0) + XREGS[i] = (CELL)(pt-1); + else + XREGS[i] = d0; #else - XREGS[i] = *pt++; + XREGS[i] = *pt++; #endif + } + } else { + Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1"); + return FALSE; } - } else { - Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1"); - return FALSE; - } - /* N = arity; */ - /* call may not define new system predicates!! */ - if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { - if (!LOCAL_InterruptsDisabled && - Yap_get_signal(YAP_CREEP_SIGNAL)) { - Yap_signal(YAP_CREEP_SIGNAL); - } + /* N = arity; */ + /* call may not define new system predicates!! */ + if (RepPredProp(pe)->PredFlags & SpiedPredFlag) { + if (!LOCAL_InterruptsDisabled && + Yap_get_signal(YAP_CREEP_SIGNAL)) { + Yap_signal(YAP_CREEP_SIGNAL); + } #if defined(YAPOR) || defined(THREADS) - if (RepPredProp(pe)->PredFlags & LogUpdatePredFlag) { - PP = RepPredProp(pe); - PELOCK(80,PP); - } + if (RepPredProp(pe)->PredFlags & LogUpdatePredFlag) { + PP = RepPredProp(pe); + PELOCK(80,PP); + } #endif - return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS); - } else { if (Yap_get_signal( YAP_CREEP_SIGNAL ) && - !LOCAL_InterruptsDisabled && - (!(RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) || - RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) { - Yap_signal(YAP_CREEP_SIGNAL); + return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->cs.p_code.TrueCodeOfPred PASS_REGS); + } else { if (Yap_get_signal( YAP_CREEP_SIGNAL ) && + !LOCAL_InterruptsDisabled && + (!(RepPredProp(pe)->PredFlags & (AsmPredFlag|CPredFlag)) || + RepPredProp(pe)->OpcodeOfPred == Yap_opcode(_call_bfunc_xx))) { + Yap_signal(YAP_CREEP_SIGNAL); + } + return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred PASS_REGS); } - return CallPredicate(RepPredProp(pe), B, RepPredProp(pe)->CodeOfPred PASS_REGS); - } } static Term slice_module_for_call_with_args(Term tin, Term *modp, int arity) { - if (IsVarTerm(tin)) { - Yap_Error(INSTANTIATION_ERROR,tin,"call_with_args/%d", arity); - return 0L; - } - while (IsApplTerm(tin)) { - Functor f = FunctorOfTerm(tin); - Term newmod; - if (f != FunctorModule) { - Yap_Error(TYPE_ERROR_ATOM,tin,"call_with_args/%d", arity); - return 0L; + if (IsVarTerm(tin)) { + Yap_Error(INSTANTIATION_ERROR,tin,"call_with_args/%d", arity); + return 0L; } - newmod = ArgOfTerm(1,tin); - if (IsVarTerm(newmod)) { - Yap_Error(INSTANTIATION_ERROR,tin,"call_with_args/%d",arity); - return 0L; - } else if (!IsAtomTerm(newmod)) { - Yap_Error(TYPE_ERROR_ATOM,newmod,"call_with_args/%d",arity); - return 0L; + while (IsApplTerm(tin)) { + Functor f = FunctorOfTerm(tin); + Term newmod; + if (f != FunctorModule) { + Yap_Error(TYPE_ERROR_ATOM,tin,"call_with_args/%d", arity); + return 0L; + } + newmod = ArgOfTerm(1,tin); + if (IsVarTerm(newmod)) { + Yap_Error(INSTANTIATION_ERROR,tin,"call_with_args/%d",arity); + return 0L; + } else if (!IsAtomTerm(newmod)) { + Yap_Error(TYPE_ERROR_ATOM,newmod,"call_with_args/%d",arity); + return 0L; + } + *modp = newmod; + tin = ArgOfTerm(2,tin); } - *modp = newmod; - tin = ArgOfTerm(2,tin); - } - if (!IsAtomTerm(tin)) { - Yap_Error(TYPE_ERROR_ATOM,tin,"call_with_args/%d",arity); - return 0L; - } - return tin; + if (!IsAtomTerm(tin)) { + Yap_Error(TYPE_ERROR_ATOM,tin,"call_with_args/%d",arity); + return 0L; + } + return tin; } static Int p_execute_0( USES_REGS1 ) { /* '$execute_0'(Goal) */ - Term mod = CurrentModule; - Term t = slice_module_for_call_with_args(Deref(ARG1),&mod,0); - if (!t) - return FALSE; - return do_execute(t, mod PASS_REGS); + Term mod = CurrentModule; + Term t = slice_module_for_call_with_args(Deref(ARG1),&mod,0); + if (!t) + return FALSE; + return do_execute(t, mod PASS_REGS); } static Int call_with_args(int i USES_REGS) { - Term mod = CurrentModule, t; - int j; - - t = slice_module_for_call_with_args(Deref(ARG1),&mod,i); - if (!t) - return FALSE; - for (j=0;jcp_h = HR; - B->cp_tr = TR; - B->cp_cp = CP; - B->cp_ap = NOCODE; - B->cp_env = ENV; - B->cp_b = saved_b; + B = (choiceptr)ASP; + B--; + B->cp_h = HR; + B->cp_tr = TR; + B->cp_cp = CP; + B->cp_ap = NOCODE; + B->cp_env = ENV; + B->cp_b = saved_b; #ifdef DEPTH_LIMIT - B->cp_depth = DEPTH; + B->cp_depth = DEPTH; #endif /* DEPTH_LIMIT */ - YENV = ASP = (CELL *)B; - YENV[E_CB] = (CELL)B; - HB = HR; - CP = YESCODE; + YENV = ASP = (CELL *)B; + YENV[E_CB] = (CELL)B; + HB = HR; + CP = YESCODE; } static Int do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) { - choiceptr saved_b = B; - Int out; - - Yap_PrepGoal(arity, pt, saved_b PASS_REGS); - P = (yamop *) CodeAdr; - S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */ - - out = exec_absmi(top, YAP_EXEC_ABSMI PASS_REGS); - Yap_flush(); - // if (out) { - // out = Yap_GetFromSlot(sl); - // } - // Yap_RecoverSlots(1); - return out; + choiceptr saved_b = B; + Int out; + + Yap_PrepGoal(arity, pt, saved_b PASS_REGS); + P = (yamop *) CodeAdr; + S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0))); /* A1 mishaps */ + + out = exec_absmi(top, YAP_EXEC_ABSMI PASS_REGS); + Yap_flush(); + // if (out) { + // out = Yap_GetFromSlot(sl); + // } + // Yap_RecoverSlots(1); + return out; } Int Yap_exec_absmi(bool top, yap_reset_t has_reset) { - CACHE_REGS + CACHE_REGS return exec_absmi(top, has_reset PASS_REGS); } @@ -1208,809 +1208,833 @@ Yap_exec_absmi(bool top, yap_reset_t has_reset) void Yap_fail_all( choiceptr bb USES_REGS ) { - yamop *saved_p, *saved_cp; - - saved_p = P; - saved_cp = CP; - /* prune away choicepoints */ - while (B && B->cp_b != bb) { - B = B->cp_b; + yamop *saved_p, *saved_cp; + + saved_p = P; + saved_cp = CP; + /* prune away choicepoints */ + while (B && B->cp_b != bb) { + B = B->cp_b; #ifdef YAPOR - CUT_prune_to(B); + CUT_prune_to(B); #endif - } - P = FAILCODE; - Yap_exec_absmi( true, YAP_EXEC_ABSMI); - /* recover stack space */ - HR = B->cp_h; - TR = B->cp_tr; + } + P = FAILCODE; + Yap_exec_absmi( true, YAP_EXEC_ABSMI); + /* recover stack space */ + HR = B->cp_h; + TR = B->cp_tr; #ifdef DEPTH_LIMIT - DEPTH = B->cp_depth; + DEPTH = B->cp_depth; #endif /* DEPTH_LIMIT */ - YENV = ENV = B->cp_env; - /* recover local stack */ -#ifdef DEPTH_LIMIT - DEPTH= ENV[E_DEPTH]; -#endif - /* make sure we prune C-choicepoints */ - if (POP_CHOICE_POINT(B->cp_b)) - { - POP_EXECUTE(); - } - ENV = (CELL *)(ENV[E_E]); - /* ASP should be set to the top of the local stack when we - did the call */ - ASP = B->cp_env; - /* YENV should be set to the current environment */ - YENV = ENV = (CELL *)((B->cp_env)[E_E]); - B = B->cp_b; - //SET_BB(B); - HB = PROTECT_FROZEN_H(B); - CP = saved_cp; - P = saved_p; -} - -int -Yap_execute_pred(PredEntry *ppe, CELL *pt USES_REGS) -{ - yamop *saved_p, *saved_cp; - yamop *CodeAdr; - Int out; - - saved_p = P; - saved_cp = CP; - - PELOCK(81,ppe); - CodeAdr = ppe->CodeOfPred; - UNLOCK(ppe->PELock); - out = do_goal(CodeAdr, ppe->ArityOfPE, pt, false PASS_REGS); - - if (out == 1) { - choiceptr cut_B; - /* we succeeded, let's prune */ - /* restore the old environment */ - /* get to previous environment */ - cut_B = (choiceptr)ENV[E_CB]; - { - /* Note that - cut_B == (choiceptr)ENV[E_CB] */ - while (POP_CHOICE_POINT(ENV[E_CB])) - { - POP_EXECUTE(); - } - } -#ifdef YAPOR - CUT_prune_to(cut_B); -#endif /* YAPOR */ -#ifdef TABLING - if (B != cut_B) { - while (B->cp_b < cut_B) { - B = B->cp_b; - } -#ifdef TABLING - abolish_incomplete_subgoals(B); -#endif - } -#endif /* TABLING */ - B = cut_B; - CP = saved_cp; - P = saved_p; - ASP = ENV; + YENV = ENV = B->cp_env; + /* recover local stack */ #ifdef DEPTH_LIMIT DEPTH= ENV[E_DEPTH]; #endif + /* make sure we prune C-choicepoints */ + if (POP_CHOICE_POINT(B->cp_b)) + { + POP_EXECUTE(); + } ENV = (CELL *)(ENV[E_E]); - /* we have failed, and usually we would backtrack to this B, - trouble is, we may also have a delayed cut to do */ - if (B != NULL) - HB = B->cp_h; - YENV = ENV; - return TRUE; - } else if (out == 0) { - P = saved_p; - CP = saved_cp; - HR = B->cp_h; -#ifdef DEPTH_LIMIT - DEPTH= B->cp_depth; -#endif /* ASP should be set to the top of the local stack when we - did the call */ + did the call */ ASP = B->cp_env; /* YENV should be set to the current environment */ YENV = ENV = (CELL *)((B->cp_env)[E_E]); B = B->cp_b; - SET_BB(B); + //SET_BB(B); HB = PROTECT_FROZEN_H(B); - return(FALSE); - } else { - Yap_Error(SYSTEM_ERROR,TermNil,"emulator crashed"); - return(FALSE); - } + CP = saved_cp; + P = saved_p; +} + +int +Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) +{ + yamop *saved_p, *saved_cp; + yamop *CodeAdr; + Int out; + + saved_p = P; + saved_cp = CP; + + PELOCK(81,ppe); + CodeAdr = ppe->CodeOfPred; + UNLOCK(ppe->PELock); + out = do_goal(CodeAdr, ppe->ArityOfPE, pt, false PASS_REGS); + + if (out == 1) { + choiceptr cut_B; + /* we succeeded, let's prune */ + /* restore the old environment */ + /* get to previous environment */ + cut_B = (choiceptr)ENV[E_CB]; + { + /* Note that + cut_B == (choiceptr)ENV[E_CB] */ + while (POP_CHOICE_POINT(ENV[E_CB])) + { + POP_EXECUTE(); + } + } +#ifdef YAPOR + CUT_prune_to(cut_B); +#endif /* YAPOR */ +#ifdef TABLING + if (B != cut_B) { + while (B->cp_b < cut_B) { + B = B->cp_b; + } +#ifdef TABLING + abolish_incomplete_subgoals(B); +#endif + } +#endif /* TABLING */ + B = cut_B; + CP = saved_cp; + P = saved_p; + ASP = ENV; +#ifdef DEPTH_LIMIT + DEPTH= ENV[E_DEPTH]; +#endif + ENV = (CELL *)(ENV[E_E]); + /* we have failed, and usually we would backtrack to this B, + trouble is, we may also have a delayed cut to do */ + if (B != NULL) + HB = B->cp_h; + YENV = ENV; + // should we catch the exception or pass it through? + // We'll pass it through + if (EX && pass_ex) { + Term ball = Yap_PopTermFromDB( EX ); + EX = NULL; + Yap_JumpToEnv( ball ); + return FALSE; + } + return TRUE; + } else if (out == 0) { + P = saved_p; + CP = saved_cp; + HR = B->cp_h; +#ifdef DEPTH_LIMIT + DEPTH= B->cp_depth; +#endif + /* ASP should be set to the top of the local stack when we + did the call */ + ASP = B->cp_env; + /* YENV should be set to the current environment */ + YENV = ENV = (CELL *)((B->cp_env)[E_E]); + B = B->cp_b; + SET_BB(B); + HB = PROTECT_FROZEN_H(B); + // should we catch the exception or pass it through? + // We'll pass it through + if (EX && pass_ex) { + Term ball = Yap_PopTermFromDB( EX ); + EX = NULL; + Yap_JumpToEnv( ball ); + return FALSE; + } + return(FALSE); + } else { + Yap_Error(SYSTEM_ERROR,TermNil,"emulator crashed"); + return(FALSE); + } } Int -Yap_execute_goal(Term t, int nargs, Term mod) +Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) { - CACHE_REGS - Prop pe; - PredEntry *ppe; - CELL *pt; - /* preserve the current restart environment */ - /* visualc*/ - /* just keep the difference because of possible garbage collections */ - - - if (IsAtomTerm(t)) { - Atom a = AtomOfTerm(t); - pt = NULL; - pe = PredPropByAtom(a, mod); - } else if (IsApplTerm(t)) { - Functor f = FunctorOfTerm(t); - - if (IsBlobFunctor(f)) { - Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1"); - return(FALSE); + CACHE_REGS + Prop pe; + PredEntry *ppe; + CELL *pt; + /* preserve the current restart environment */ + /* visualc*/ + /* just keep the difference because of possible garbage collections */ + + + if (IsAtomTerm(t)) { + Atom a = AtomOfTerm(t); + pt = NULL; + pe = PredPropByAtom(a, mod); + } else if (IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + + if (IsBlobFunctor(f)) { + Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1"); + return(FALSE); + } + /* I cannot use the standard macro here because + otherwise I would dereference the argument and + might skip a svar */ + pt = RepAppl(t)+1; + pe = PredPropByFunc(f, mod); + } else { + Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1"); + return(FALSE); } - /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ - pt = RepAppl(t)+1; - pe = PredPropByFunc(f, mod); - } else { - Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1"); - return(FALSE); - } - ppe = RepPredProp(pe); - if (pe == NIL) { - return CallMetaCall(t, mod PASS_REGS); - } - return Yap_execute_pred(ppe, pt PASS_REGS); - + ppe = RepPredProp(pe); + if (pe == NIL) { + return CallMetaCall(t, mod PASS_REGS); + } + return Yap_execute_pred(ppe, pt, pass_ex PASS_REGS); + } void Yap_trust_last(void) { - CACHE_REGS - ASP = B->cp_env; - CP = B->cp_cp; - HR = B->cp_h; + CACHE_REGS + ASP = B->cp_env; + CP = B->cp_cp; + HR = B->cp_h; #ifdef DEPTH_LIMIT - DEPTH= B->cp_depth; + DEPTH= B->cp_depth; #endif - YENV= ASP = B->cp_env; - ENV = (CELL *)((B->cp_env)[E_E]); - B = B->cp_b; - P = (yamop *)(ENV[E_CP]); - if (B) { - SET_BB(B); - HB = PROTECT_FROZEN_H(B); - } + YENV= ASP = B->cp_env; + ENV = (CELL *)((B->cp_env)[E_E]); + B = B->cp_b; + P = (yamop *)(ENV[E_CP]); + if (B) { + SET_BB(B); + HB = PROTECT_FROZEN_H(B); + } } Term Yap_RunTopGoal(Term t) { - CACHE_REGS - yamop *CodeAdr; - Prop pe; - PredEntry *ppe; - CELL *pt; - UInt arity; - Term mod = CurrentModule; - Term goal_out = 0; - - restart_runtopgoal: - if (IsAtomTerm(t)) { - Atom a = AtomOfTerm(t); - pt = NULL; - pe = PredPropByAtom(a, CurrentModule); - arity = 0; - } else if (IsApplTerm(t)) { - Functor f = FunctorOfTerm(t); - - if (IsBlobFunctor(f)) { - Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1"); - return(FALSE); + CACHE_REGS + yamop *CodeAdr; + Prop pe; + PredEntry *ppe; + CELL *pt; + UInt arity; + Term mod = CurrentModule; + Term goal_out = 0; + +restart_runtopgoal: + if (IsAtomTerm(t)) { + Atom a = AtomOfTerm(t); + pt = NULL; + pe = PredPropByAtom(a, CurrentModule); + arity = 0; + } else if (IsApplTerm(t)) { + Functor f = FunctorOfTerm(t); + + if (IsBlobFunctor(f)) { + Yap_Error(TYPE_ERROR_CALLABLE,t,"call/1"); + return(FALSE); + } + if (f == FunctorModule) { + Term tmod = ArgOfTerm(1,t); + if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { + mod = tmod; + t = ArgOfTerm(2,t); + goto restart_runtopgoal; + } else { + if (IsVarTerm(tmod)) { + Yap_Error(INSTANTIATION_ERROR,t,"call/1"); + } else { + Yap_Error(TYPE_ERROR_ATOM,t,"call/1"); + } + return FALSE; + } + } + /* I cannot use the standard macro here because + otherwise I would dereference the argument and + might skip a svar */ + pe = PredPropByFunc(f, mod); + pt = RepAppl(t)+1; + arity = ArityOfFunctor(f); + } else { + Yap_Error(TYPE_ERROR_CALLABLE,Yap_PredicateIndicator(t, mod),"call/1"); + return(FALSE); } - if (f == FunctorModule) { - Term tmod = ArgOfTerm(1,t); - if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { - mod = tmod; - t = ArgOfTerm(2,t); - goto restart_runtopgoal; - } else { - if (IsVarTerm(tmod)) { - Yap_Error(INSTANTIATION_ERROR,t,"call/1"); - } else { - Yap_Error(TYPE_ERROR_ATOM,t,"call/1"); - } - return FALSE; - } + ppe = RepPredProp(pe); + if (pe == NIL) { + /* we must always start the emulator with Prolog code */ + return FALSE; } - /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ - pe = PredPropByFunc(f, mod); - pt = RepAppl(t)+1; - arity = ArityOfFunctor(f); - } else { - Yap_Error(TYPE_ERROR_CALLABLE,Yap_PredicateIndicator(t, mod),"call/1"); - return(FALSE); - } - ppe = RepPredProp(pe); - if (pe == NIL) { - /* we must always start the emulator with Prolog code */ - return FALSE; - } - PELOCK(82,ppe); - CodeAdr = ppe->CodeOfPred; - UNLOCK(ppe->PELock); + PELOCK(82,ppe); + CodeAdr = ppe->CodeOfPred; + UNLOCK(ppe->PELock); + #if !USE_SYSTEM_MALLOC - if (LOCAL_TrailTop - HeapTop < 2048) { - LOCAL_PrologMode = BootMode; - Yap_Error(OUT_OF_TRAIL_ERROR,TermNil, - "unable to boot because of too little Trail space"); - } + if (LOCAL_TrailTop - HeapTop < 2048) { + LOCAL_PrologMode = BootMode; + Yap_Error(OUT_OF_TRAIL_ERROR,TermNil, + "unable to boot because of too little Trail space"); + } #endif - goal_out = do_goal(CodeAdr, arity, pt, true PASS_REGS); - return goal_out; + goal_out = do_goal(CodeAdr, arity, pt, true PASS_REGS); + return goal_out; } static void restore_regs(Term t, int restore_all USES_REGS) { - if (IsApplTerm(t)) { - Int i; - Int max = ArityOfFunctor(FunctorOfTerm(t))-4; - CELL *ptr = RepAppl(t)+5; - - P = (yamop *)IntegerOfTerm(ptr[-4]); - CP = (yamop *)IntegerOfTerm(ptr[-3]); - ENV = (CELL *)(LCL0-IntegerOfTerm(ptr[-2])); - YENV = (CELL *)(LCL0-IntegerOfTerm(ptr[-1])); - for (i = 0; i < max; i += 2) { - Int j = IntOfTerm(ptr[0]); - XREGS[j] = ptr[1]; - ptr+=2; + if (IsApplTerm(t)) { + Int i; + Int max = ArityOfFunctor(FunctorOfTerm(t))-4; + CELL *ptr = RepAppl(t)+5; + + P = (yamop *)IntegerOfTerm(ptr[-4]); + CP = (yamop *)IntegerOfTerm(ptr[-3]); + ENV = (CELL *)(LCL0-IntegerOfTerm(ptr[-2])); + YENV = (CELL *)(LCL0-IntegerOfTerm(ptr[-1])); + for (i = 0; i < max; i += 2) { + Int j = IntOfTerm(ptr[0]); + XREGS[j] = ptr[1]; + ptr+=2; + } } - } } /* low level voodoo to restore temporary registers after a call */ static Int p_restore_regs( USES_REGS1 ) { - Term t = Deref(ARG1); - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,t,"support for coroutining"); - return(FALSE); - } - if (IsAtomTerm(t)) return(TRUE); - restore_regs(t, FALSE PASS_REGS); - return(TRUE); + Term t = Deref(ARG1); + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR,t,"support for coroutining"); + return(FALSE); + } + if (IsAtomTerm(t)) return(TRUE); + restore_regs(t, FALSE PASS_REGS); + return(TRUE); } /* low level voodoo to cut and then restore temporary registers after a call */ static Int p_restore_regs2( USES_REGS1 ) { - - Term t = Deref(ARG1), d0; - choiceptr pt0; - Int d; - - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR,t,"support for coroutining"); - return(FALSE); - } - d0 = Deref(ARG2); - if (!IsAtomTerm(t)) { - restore_regs(t, TRUE PASS_REGS); - } - if (IsVarTerm(d0)) { - Yap_Error(INSTANTIATION_ERROR,d0,"support for coroutining"); - return(FALSE); - } - if (!IsIntegerTerm(d0)) { - return(FALSE); - } - d = IntegerOfTerm(d0); - if (!d) - return TRUE; -#if YAPOR_SBA - pt0 = (choiceptr)d; -#else - pt0 = (choiceptr)(LCL0-d); -#endif - /* find where to cut to */ - if ((CELL *)pt0 != LCL0 && pt0 > B) { - /* Wow, we're gonna cut!!! */ - while (B->cp_b < pt0) { - while (POP_CHOICE_POINT(B->cp_b)) - { - POP_EXECUTE(); - } - HB = B->cp_h; - Yap_TrimTrail(); - B = B->cp_b; + + Term t = Deref(ARG1), d0; + choiceptr pt0; + Int d; + + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR,t,"support for coroutining"); + return(FALSE); } + d0 = Deref(ARG2); + if (!IsAtomTerm(t)) { + restore_regs(t, TRUE PASS_REGS); + } + if (IsVarTerm(d0)) { + Yap_Error(INSTANTIATION_ERROR,d0,"support for coroutining"); + return(FALSE); + } + if (!IsIntegerTerm(d0)) { + return(FALSE); + } + d = IntegerOfTerm(d0); + if (!d) + return TRUE; +#if YAPOR_SBA + pt0 = (choiceptr)d; +#else + pt0 = (choiceptr)(LCL0-d); +#endif + /* find where to cut to */ + if ((CELL *)pt0 != LCL0 && pt0 > B) { + /* Wow, we're gonna cut!!! */ + while (B->cp_b < pt0) { + while (POP_CHOICE_POINT(B->cp_b)) + { + POP_EXECUTE(); + } + HB = B->cp_h; + Yap_TrimTrail(); + B = B->cp_b; + } #ifdef TABLING - abolish_incomplete_subgoals(B); + abolish_incomplete_subgoals(B); #endif #ifdef YAPOR - CUT_prune_to(pt0); + CUT_prune_to(pt0); #endif /* YAPOR */ - B = pt0; - } - return(TRUE); + B = pt0; + } + return(TRUE); } static Int p_clean_ifcp( USES_REGS1 ) { - Term t = Deref(ARG1); - choiceptr pt0; - - if (IsVarTerm(t)) { - Yap_Error(INSTANTIATION_ERROR, t, "cut_at/1"); - return FALSE; - } - if (!IsIntegerTerm(t)) { - Yap_Error(TYPE_ERROR_INTEGER, t, "cut_at/1"); - return FALSE; - } + Term t = Deref(ARG1); + choiceptr pt0; + + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR, t, "cut_at/1"); + return FALSE; + } + if (!IsIntegerTerm(t)) { + Yap_Error(TYPE_ERROR_INTEGER, t, "cut_at/1"); + return FALSE; + } #if YAPOR_SBA - pt0 = (choiceptr)IntegerOfTerm(t); + pt0 = (choiceptr)IntegerOfTerm(t); #else - pt0 = cp_from_integer(t PASS_REGS); + pt0 = cp_from_integer(t PASS_REGS); #endif - if (pt0 < B) { - /* this should never happen */ + if (pt0 < B) { + /* this should never happen */ + return TRUE; + } else if (pt0 == B) { + while (POP_CHOICE_POINT(B->cp_b)) + { + POP_EXECUTE(); + } + B = B->cp_b; + HB = B->cp_h; + } else { + pt0->cp_ap = (yamop *)TRUSTFAILCODE; + } return TRUE; - } else if (pt0 == B) { - while (POP_CHOICE_POINT(B->cp_b)) - { - POP_EXECUTE(); - } - B = B->cp_b; - HB = B->cp_h; - } else { - pt0->cp_ap = (yamop *)TRUSTFAILCODE; - } - return TRUE; } static int disj_marker(yamop *apc) { - op_numbers opnum = Yap_op_from_opcode(apc->opc); - - return opnum == _or_else || opnum == _or_last; + op_numbers opnum = Yap_op_from_opcode(apc->opc); + + return opnum == _or_else || opnum == _or_last; } static Int p_cut_up_to_next_disjunction( USES_REGS1 ) { - choiceptr pt0 = B; - CELL *qenv = (CELL *)ENV[E_E]; - - while (pt0 && - !( qenv == pt0->cp_env && disj_marker(pt0->cp_ap))) { - pt0 = pt0->cp_b; - } - if (!pt0) - return TRUE; + choiceptr pt0 = B; + CELL *qenv = (CELL *)ENV[E_E]; + + while (pt0 && + !( qenv == pt0->cp_env && disj_marker(pt0->cp_ap))) { + pt0 = pt0->cp_b; + } + if (!pt0) + return TRUE; #ifdef YAPOR - CUT_prune_to(pt0); + CUT_prune_to(pt0); #endif /* YAPOR */ - /* find where to cut to */ - if (SHOULD_CUT_UP_TO(B,pt0)) { - B = pt0; + /* find where to cut to */ + if (SHOULD_CUT_UP_TO(B,pt0)) { + B = pt0; #ifdef TABLING - abolish_incomplete_subgoals(B); + abolish_incomplete_subgoals(B); #endif /* TABLING */ - } - HB = B->cp_h; - Yap_TrimTrail(); - return TRUE; + } + HB = B->cp_h; + Yap_TrimTrail(); + return TRUE; } +bool +Yap_Reset(yap_reset_t mode) +{ + CACHE_REGS + int res = TRUE; + + if (EX) { + LOCAL_BallTerm = EX; + } + EX = NULL; + Yap_ResetExceptionTerm( 0 ); + LOCAL_UncaughtThrow = FALSE; + /* first, backtrack to the root */ + while (B->cp_b) { + B = B->cp_b; + } + // B shoul lead to CP with _ystop0,, + P = FAILCODE; + res = Yap_exec_absmi( true, mode ); + /* reinitialise the engine */ + // Yap_InitYaamRegs( worker_id ); + GLOBAL_Initialised = true; + ENV = LCL0; + ASP = (CELL *)B; + /* the first real choice-point will also have AP=FAIL */ + /* always have an empty slots for people to use */ + P = CP = YESCODE; + // ensure that we have slots where we need them + Yap_RebootSlots( worker_id ); + return res; +} + + static int is_cleanup_cp(choiceptr cp_b) { - PredEntry *pe; - - if (cp_b->cp_ap->opc != ORLAST_OPCODE) - return FALSE; + PredEntry *pe; + + if (cp_b->cp_ap->opc != ORLAST_OPCODE) + return FALSE; #ifdef YAPOR - pe = cp_b->cp_ap->y_u.Osblp.p0; + pe = cp_b->cp_ap->y_u.Osblp.p0; #else - pe = cp_b->cp_ap->y_u.p.p; + pe = cp_b->cp_ap->y_u.p.p; #endif /* YAPOR */ - /* + /* it has to be a cleanup and it has to be a completed goal, otherwise the throw will be caught anyway. - */ - return pe == PredSafeCallCleanup; + */ + return pe == PredSafeCallCleanup; } static Int JumpToEnv(Term t USES_REGS) { #ifndef YAPOR - yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,l), + yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,l), *catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred,l); #else - yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,Otapl), + yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred,Otapl), *catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred,Otapl); #endif - CELL *env, *env1; - choiceptr handler, previous = NULL; + CELL *env, *env1; + choiceptr handler, previous = NULL; + + /* throws cannot interrupt throws */ + if (EX) + return FALSE; + /* just keep the throwed object away, we don't need to care about it */ + if (!(LOCAL_BallTerm = Yap_StoreTermInDB(t, 0))) { + Yap_RestartYap( 1 ); + } + /* careful, previous step may have caused a stack shift, + so get pointers here */ + handler = B; + env1 = ENV; + do { + /* find the first choicepoint that may be a catch */ + while (handler && + handler->cp_ap != pos) { + /* we are already doing a catch */ + if (handler->cp_ap == catchpos) { + P = (yamop *)FAILCODE; + return TRUE; - /* throws cannot interrupt throws */ - if (EX) - return FALSE; - /* just keep the throwed object away, we don't need to care about it */ - if (!(LOCAL_BallTerm = Yap_StoreTermInDB(t, 0))) { - Yap_RestartYap( 1 ); - } - /* careful, previous step may have caused a stack shift, - so get pointers here */ - handler = B; - env1 = ENV; - do { - /* find the first choicepoint that may be a catch */ - while (handler != NULL && handler->cp_ap != pos) { - /* we are already doing a catch */ - if (handler->cp_ap == catchpos) { - P = (yamop *)FAILCODE; - return TRUE; - } - /* we have a cleanup handler in the middle */ - if (is_cleanup_cp(handler)) { - /* keep it around */ - if (previous == NULL) { - B = handler; - } else { - previous->cp_b = handler; - } - previous = handler; -#ifdef TABLING - } else { - if (handler->cp_ap != NOCODE) { - abolish_incomplete_subgoals(handler); - } -#endif /* TABLING */ - } - /* we reached C-Code */ - if (handler->cp_ap == NOCODE) { - /* up to the C-code to deal with this! */ - LOCAL_UncaughtThrow = TRUE; - if (previous == NULL) - B = handler; - else - previous->cp_b = handler; - EX = LOCAL_BallTerm; - LOCAL_BallTerm = NULL; - P = (yamop *)FAILCODE; - /* make sure failure will be seen at next port */ - if (LOCAL_PrologMode & AsyncIntMode) { - Yap_signal(YAP_FAIL_SIGNAL); - } - HB = B->cp_h; - return TRUE; - } - /* make sure we prune C-choicepoints */ - while (POP_CHOICE_POINT(handler->cp_b)) - { - POP_EXECUTE(); - } - handler = handler->cp_b; + P = (yamop *)FAILCODE; + /* make sure failure will be seen at next port */ + if (LOCAL_PrologMode & AsyncIntMode) { + Yap_signal(YAP_FAIL_SIGNAL); + } + HB = B->cp_h; + return TRUE; + } + /* make sure we prune C-choicepoints */ + while (POP_CHOICE_POINT(handler->cp_b)) + { + POP_EXECUTE(); + } + handler = handler->cp_b; + } + /* uncaught throw */ + if (handler == NULL) { + LOCAL_UncaughtThrow = TRUE; + Yap_RestartYap( 1 ); + } + /* is it a continuation? */ + env = handler->cp_env; + while (env > env1) { + env1 = ENV_Parent(env1); + } + /* yes, we found it ! */ + // while (env < ENV) + // env = ENV_Paren t(env); + if (env == env1) { + break; + } + /* oops, try next */ + handler = handler->cp_b; + } while (TRUE); + /* step one environment above, otherwise we'll redo the original goal */ + if (previous == NULL) { + B = handler; + } else { + // EX = t; + previous->cp_b = handler; } - /* uncaught throw */ - if (handler == NULL) { - LOCAL_UncaughtThrow = TRUE; - Yap_RestartYap( 1 ); - } - /* is it a continuation? */ - env = handler->cp_env; - while (env > env1) { - env1 = ENV_Parent(env1); - } - /* yes, we found it ! */ - // while (env < ENV) - // env = ENV_Parent(env); - if (env == env1) { - break; - } - /* oops, try next */ - handler = handler->cp_b; - } while (TRUE); - /* step one environment above, otherwise we'll redo the original goal */ - if (previous == NULL) { - B = handler; - } else { - // EX = t; - previous->cp_b = handler; - } - /* make sure we get rid of trash in the trail */ - handler->cp_cp = (yamop *)env[E_CP]; - handler->cp_env = (CELL *)env[E_E]; - handler->cp_ap = catchpos; - - /* can recover Heap thanks to copy term :-( */ - /* B->cp_h = H; */ - /* I could backtrack here, but it is easier to leave the unwinding + /* make sure we get rid of trash in the trail */ + handler->cp_cp = (yamop *)env[E_CP]; + handler->cp_env = (CELL *)env[E_E]; + handler->cp_ap = catchpos; + + /* can recover Heap thanks to copy term :-( */ + /* B->cp_h = H; */ + /* I could backtrack here, but it is easier to leave the unwinding to the emulator */ - if (LOCAL_PrologMode & AsyncIntMode) { - Yap_signal(YAP_FAIL_SIGNAL); - } - P = (yamop *)FAILCODE; - HB = B->cp_h; - /* try to recover space */ - /* can only do that when we recover space */ - /* first, simulate backtracking */ - /* so that I will execute op_fail */ - return TRUE; + if (LOCAL_PrologMode & AsyncIntMode) { + Yap_signal(YAP_FAIL_SIGNAL); + } + P = (yamop *)FAILCODE; + HB = B->cp_h; + /* try to recover space */ + /* can only do that when we recover space */ + /* first, simulate backtracking */ + /* so that I will execute op_fail */ + return TRUE; } Int Yap_JumpToEnv(Term t) { - CACHE_REGS - if (LOCAL_PrologMode & BootMode) { - return FALSE; - } - return JumpToEnv(t PASS_REGS); + CACHE_REGS + if (LOCAL_PrologMode & BootMode) { + return FALSE; + } + return JumpToEnv(t PASS_REGS); } /* This does very nasty stuff!!!!! */ static Int p_jump_env( USES_REGS1 ) { - return(JumpToEnv(Deref(ARG1) PASS_REGS)); + return(JumpToEnv(Deref(ARG1) PASS_REGS)); } /* set up a meta-call based on . context info */ static Int p_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; + 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 ) { - Term h0var; - // getchar(); + Term h0var; + // getchar(); #if PUSH_REGS - /* Guarantee that after a longjmp we go back to the original abstract + /* Guarantee that after a longjmp we go back to the original abstract machine registers */ #ifdef THREADS - CACHE_REGS - if (myworker_id) { - REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs; - pthread_setspecific(Yap_yaamregs_key, (const void *)rs); - REMOTE_PL_local_data_p(myworker_id)->reg_cache = rs; - REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs; - REFRESH_CACHE_REGS - } - /* may be run by worker_id on behalf on myworker_id */ + CACHE_REGS + 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; + REFRESH_CACHE_REGS + } + /* 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 */ - Yap_ResetExceptionTerm ( myworker_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 since for the garbage collector to work */ - B = NULL; - ENV = NULL; - P = CP = YESCODE; + Yap_ResetExceptionTerm ( myworker_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 since 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 (REMOTE_GlobalArena(myworker_id) == 0L || - REMOTE_GlobalArena(myworker_id) == TermNil) { - } else { - HR = RepAppl(REMOTE_GlobalArena(myworker_id)); - } - REMOTE_GlobalArena(myworker_id) = TermNil; - Yap_AllocateDefaultArena(128*1024, 2, myworker_id); - Yap_InitPreAllocCodeSpace( myworker_id ); + STATIC_PREDICATES_MARKED = FALSE; + if (REMOTE_GlobalArena(myworker_id) == 0L || + REMOTE_GlobalArena(myworker_id) == TermNil) { + } else { + HR = RepAppl(REMOTE_GlobalArena(myworker_id)); + } + REMOTE_GlobalArena(myworker_id) = TermNil; + Yap_AllocateDefaultArena(128*1024, 2, 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); + 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 */ #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_RebootSlots( myworker_id ); - 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))); + Yap_RebootSlots( myworker_id ); + 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 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 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 } static Int p_uncaught_throw( USES_REGS1 ) { - Int out = LOCAL_UncaughtThrow; - LOCAL_UncaughtThrow = FALSE; /* just caught it */ - return out; + Int out = LOCAL_UncaughtThrow; + LOCAL_UncaughtThrow = FALSE; /* just caught it */ + return out; } Term Yap_GetException(void) { - CACHE_REGS - Term t = 0L; - if (LOCAL_BallTerm) { - do { - t = Yap_PopTermFromDB(LOCAL_BallTerm); - if (t == 0) { - if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); - return FALSE; - } - } else { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growstack(LOCAL_BallTerm->NOfCells*CellSize)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); - return FALSE; - } - } - } - } while (t == 0); - LOCAL_BallTerm = NULL; - } - return t; + CACHE_REGS + Term t = 0L; + if (LOCAL_BallTerm) { + do { + t = Yap_PopTermFromDB(LOCAL_BallTerm); + if (t == 0) { + if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growglobal(NULL)) { + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, LOCAL_ErrorMessage); + return FALSE; + } + } else { + LOCAL_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growstack(LOCAL_BallTerm->NOfCells*CellSize)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage); + return FALSE; + } + } + } + } while (t == 0); + LOCAL_BallTerm = NULL; + } + return t; } static Int p_reset_exception( USES_REGS1 ) { - Term t; - EX = NULL; - t = Yap_GetException(); - if (!t) - return FALSE; - return Yap_unify(t, ARG1); + Term t; + EX = NULL; + t = Yap_GetException(); + if (!t) + return FALSE; + return Yap_unify(t, ARG1); } void Yap_ResetExceptionTerm(int wid) { - Yap_ReleaseTermFromDB(REMOTE_BallTerm(wid)); - REMOTE_BallTerm(wid) = NULL; + Yap_ReleaseTermFromDB(REMOTE_BallTerm(wid)); + REMOTE_BallTerm(wid) = NULL; } static Int p_get_exception( USES_REGS1 ) { - Term t = Yap_GetException(); - if (!t) - return FALSE; - return Yap_unify(t, ARG1); + Term t = Yap_GetException(); + if (!t) + return FALSE; + return Yap_unify(t, ARG1); } 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; + 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; } void Yap_InitExecFs(void) { - CACHE_REGS - Term cm = CurrentModule; - Yap_InitComma(); - Yap_InitCPred("$execute", 1, p_execute, 0); - Yap_InitCPred("$execute", 2, p_execute2, 0); - Yap_InitCPred("$execute", 3, p_execute3, 0); - Yap_InitCPred("$execute", 4, p_execute4, 0); - Yap_InitCPred("$execute", 5, p_execute5, 0); - Yap_InitCPred("$execute", 6, p_execute6, 0); - Yap_InitCPred("$execute", 7, p_execute7, 0); - Yap_InitCPred("$execute", 8, p_execute8, 0); - Yap_InitCPred("$execute", 9, p_execute9, 0); - Yap_InitCPred("$execute", 10, p_execute10, 0); - Yap_InitCPred("$execute", 11, p_execute11, 0); - Yap_InitCPred("$execute", 12, p_execute12, 0); - Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0); - Yap_InitCPred("$execute_wo_mod", 2, p_execute_in_mod, 0); - Yap_InitCPred("call_with_args", 1, p_execute_0, 0); - Yap_InitCPred("call_with_args", 2, p_execute_1, 0); - Yap_InitCPred("call_with_args", 3, p_execute_2, 0); - Yap_InitCPred("call_with_args", 4, p_execute_3, 0); - Yap_InitCPred("call_with_args", 5, p_execute_4, 0); - Yap_InitCPred("call_with_args", 6, p_execute_5, 0); - Yap_InitCPred("call_with_args", 7, p_execute_6, 0); - Yap_InitCPred("call_with_args", 8, p_execute_7, 0); - Yap_InitCPred("call_with_args", 9, p_execute_8, 0); - Yap_InitCPred("call_with_args", 10, p_execute_9, 0); - Yap_InitCPred("call_with_args", 11, p_execute_10, 0); + CACHE_REGS + Term cm = CurrentModule; + Yap_InitComma(); + Yap_InitCPred("$execute", 1, p_execute, 0); + Yap_InitCPred("$execute", 2, p_execute2, 0); + Yap_InitCPred("$execute", 3, p_execute3, 0); + Yap_InitCPred("$execute", 4, p_execute4, 0); + Yap_InitCPred("$execute", 5, p_execute5, 0); + Yap_InitCPred("$execute", 6, p_execute6, 0); + Yap_InitCPred("$execute", 7, p_execute7, 0); + Yap_InitCPred("$execute", 8, p_execute8, 0); + Yap_InitCPred("$execute", 9, p_execute9, 0); + Yap_InitCPred("$execute", 10, p_execute10, 0); + Yap_InitCPred("$execute", 11, p_execute11, 0); + Yap_InitCPred("$execute", 12, p_execute12, 0); + Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0); + Yap_InitCPred("$execute_wo_mod", 2, p_execute_in_mod, 0); + Yap_InitCPred("call_with_args", 1, p_execute_0, 0); + Yap_InitCPred("call_with_args", 2, p_execute_1, 0); + Yap_InitCPred("call_with_args", 3, p_execute_2, 0); + Yap_InitCPred("call_with_args", 4, p_execute_3, 0); + Yap_InitCPred("call_with_args", 5, p_execute_4, 0); + Yap_InitCPred("call_with_args", 6, p_execute_5, 0); + Yap_InitCPred("call_with_args", 7, p_execute_6, 0); + Yap_InitCPred("call_with_args", 8, p_execute_7, 0); + Yap_InitCPred("call_with_args", 9, p_execute_8, 0); + Yap_InitCPred("call_with_args", 10, p_execute_9, 0); + Yap_InitCPred("call_with_args", 11, p_execute_10, 0); #ifdef DEPTH_LIMIT - Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0); + Yap_InitCPred("$execute_under_depth_limit", 2, p_execute_depth_limit, 0); #endif - Yap_InitCPred("$execute0", 2, p_execute0, NoTracePredFlag); - Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop,NoTracePredFlag ); - Yap_InitCPred("$execute_clause", 4, p_execute_clause, 0); - Yap_InitCPred("$current_choice_point", 1, p_save_cp, 0); - Yap_InitCPred("$current_choicepoint", 1, p_save_cp, 0); - CurrentModule = HACKS_MODULE; - Yap_InitCPred("current_choice_point", 1, p_save_cp, 0); - Yap_InitCPred("current_choicepoint", 1, p_save_cp, 0); - Yap_InitCPred("env_choice_point", 1, p_save_env_b, 0); - Yap_InitCPred("trail_suspension_marker", 1, p_trail_suspension_marker, 0); - Yap_InitCPred("cut_at", 1, p_clean_ifcp, SafePredFlag); - CurrentModule = cm; - Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag); - Yap_InitCPred("$restore_regs", 1, p_restore_regs, NoTracePredFlag|SafePredFlag); - Yap_InitCPred("$restore_regs", 2, p_restore_regs2, NoTracePredFlag|SafePredFlag); - Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag); - Yap_InitCPred("qpack_clean_up_to_disjunction", 0, p_cut_up_to_next_disjunction, SafePredFlag); - Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0); - Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, 0); - Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, 0); - Yap_InitCPred("$reset_exception", 1, p_reset_exception, 0); - Yap_InitCPred("$do_goal_expansion", 3, p_do_goal_expansion, 0); - Yap_InitCPred("$do_term_expansion", 2, p_do_term_expansion, 0); - Yap_InitCPred("$get_exception", 1, p_get_exception, 0); + Yap_InitCPred("$execute0", 2, p_execute0, NoTracePredFlag); + Yap_InitCPred("$execute_nonstop", 2, p_execute_nonstop,NoTracePredFlag ); + Yap_InitCPred("$execute_clause", 4, p_execute_clause, 0); + Yap_InitCPred("$current_choice_point", 1, p_save_cp, 0); + Yap_InitCPred("$current_choicepoint", 1, p_save_cp, 0); + CurrentModule = HACKS_MODULE; + Yap_InitCPred("current_choice_point", 1, p_save_cp, 0); + Yap_InitCPred("current_choicepoint", 1, p_save_cp, 0); + Yap_InitCPred("env_choice_point", 1, p_save_env_b, 0); + Yap_InitCPred("trail_suspension_marker", 1, p_trail_suspension_marker, 0); + Yap_InitCPred("cut_at", 1, p_clean_ifcp, SafePredFlag); + CurrentModule = cm; + Yap_InitCPred("$pred_goal_expansion_on", 0, p_pred_goal_expansion_on, SafePredFlag); + Yap_InitCPred("$restore_regs", 1, p_restore_regs, NoTracePredFlag|SafePredFlag); + Yap_InitCPred("$restore_regs", 2, p_restore_regs2, NoTracePredFlag|SafePredFlag); + Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag); + Yap_InitCPred("qpack_clean_up_to_disjunction", 0, p_cut_up_to_next_disjunction, SafePredFlag); + Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, 0); + Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, 0); + Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, 0); + Yap_InitCPred("$reset_exception", 1, p_reset_exception, 0); + Yap_InitCPred("$do_goal_expansion", 3, p_do_goal_expansion, 0); + Yap_InitCPred("$do_term_expansion", 2, p_do_term_expansion, 0); + Yap_InitCPred("$get_exception", 1, p_get_exception, 0); }