diff --git a/C/cdmgr.c b/C/cdmgr.c index 7f246a31b..ee33f367b 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -1014,6 +1014,20 @@ bool Yap_unknown(Term t) { return false; } +static Int +undef_handler(USES_REGS1) { /* '$undef_handler'(+S,+Mod) */ + PredEntry *pe; + Int out; + + pe = get_pred(Deref(ARG1), Deref(ARG2), "undef_handler"); + if (EndOfPAEntr(pe)) + return FALSE; + PELOCK(27, pe); + UndefCode = pe; + UNLOCKPE(44, pe); + return true; +} + static int source_pred(PredEntry *p, yamop *q) { if (p->PredFlags & (DynamicPredFlag | LogUpdatePredFlag)) return FALSE; @@ -4632,6 +4646,7 @@ void Yap_InitCdMgr(void) { Yap_InitCPred("$call_count_reset", 0, p_call_count_reset, SafePredFlag | SyncPredFlag); Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag); + Yap_InitCPred("$undef_handler", 2, undef_handler, SafePredFlag); Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag); Yap_InitCPred("$hide_predicate", 2, hide_predicate, SafePredFlag); Yap_InitCPred("$stash_predicate", 2, p_stash_predicate, SafePredFlag); diff --git a/H/ATOMS b/H/ATOMS index 0fd9a78ae..9092f684c 100644 --- a/H/ATOMS +++ b/H/ATOMS @@ -406,6 +406,7 @@ A Txt N "txt" A TypeError N "type_error" A Undefined N "undefined" A Undefp F "$undefp" +A Undefp0 F "$undefp0" A Underflow N "underflow" A UnificationStack N "unification_stack" A Unique N "unique" diff --git a/H/HEAPFIELDS b/H/HEAPFIELDS index 4aca1c345..b23b305c2 100644 --- a/H/HEAPFIELDS +++ b/H/HEAPFIELDS @@ -141,10 +141,10 @@ rwlock_t PredHashRWLock void /* Well-Known Predicates */ struct pred_entry *CreepCode MkPred AtomCreep 1 PROLOG_MODULE -struct pred_entry *UndefCode MkPred AtomUndefp 2 PROLOG_MODULE +struct pred_entry *UndefCode MkPred AtomUndefp0 2 PROLOG_MODULE struct pred_entry *SpyCode MkPred AtomSpy 1 PROLOG_MODULE -struct pred_entry *PredFail MkPred AtomFail 0 PROLOG_MODULE -struct pred_entry *PredTrue MkPred AtomTrue 0 PROLOG_MODULE +struct pred_entry *PredFail MkPred AtomFail 0 PROLOG_MODULE +struct pred_entry *PredTrue MkPred AtomTrue 0 PROLOG_MODULE #ifdef COROUTINING struct pred_entry *WakeUpCode MkPred AtomWakeUpGoal 2 PROLOG_MODULE #endif diff --git a/H/Tags_64bits.h b/H/Tags_64bits.h index 4f22e924a..5e9c398f1 100644 --- a/H/Tags_64bits.h +++ b/H/Tags_64bits.h @@ -1,10 +1,4 @@ - - - - - - /************************************************************************* * * * YAP Prolog %W% %G% * @@ -42,18 +36,18 @@ property list */ -#define SHIFT_HIGH_TAG 62 +#define SHIFT_HIGH_TAG 61 #define MKTAG(HI,LO) ((((UInt) (HI))< #endif +#if HAVE_ERRNO_H +#include +#endif typedef enum { diff --git a/H/eval.h b/H/eval.h index dd9411164..81be993d7 100644 --- a/H/eval.h +++ b/H/eval.h @@ -426,7 +426,11 @@ INLINE_ONLY inline EXTERN Term Yap_Eval__(Term t USES_REGS) { return Yap_InnerEval(t); } +#if HAVE_FECLEAREXCEPT inline static void Yap_ClearExs(void) { feclearexcept(FE_ALL_EXCEPT); } +#else +inline static void Yap_ClearExs(void) { } +#endif inline static yap_error_number Yap_FoundArithError__(USES_REGS1) { if (LOCAL_Error_TYPE != YAP_NO_ERROR) diff --git a/H/generated/iatoms.h b/H/generated/iatoms.h index 39f45c8a0..a5c8a450d 100644 --- a/H/generated/iatoms.h +++ b/H/generated/iatoms.h @@ -401,6 +401,7 @@ AtomTypeError = Yap_LookupAtom("type_error"); TermTypeError = MkAtomTerm(AtomTypeError); AtomUndefined = Yap_LookupAtom("undefined"); TermUndefined = MkAtomTerm(AtomUndefined); AtomUndefp = Yap_FullLookupAtom("$undefp"); TermUndefp = MkAtomTerm(AtomUndefp); + AtomUndefp0 = Yap_FullLookupAtom("$undefp0"); TermUndefp0 = MkAtomTerm(AtomUndefp0); AtomUnderflow = Yap_LookupAtom("underflow"); TermUnderflow = MkAtomTerm(AtomUnderflow); AtomUnificationStack = Yap_LookupAtom("unification_stack"); TermUnificationStack = MkAtomTerm(AtomUnificationStack); AtomUnique = Yap_LookupAtom("unique"); TermUnique = MkAtomTerm(AtomUnique); diff --git a/H/generated/ihstruct.h b/H/generated/ihstruct.h index 3e99a75ad..a88fb4fa1 100644 --- a/H/generated/ihstruct.h +++ b/H/generated/ihstruct.h @@ -129,7 +129,7 @@ #endif CreepCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomCreep,1),PROLOG_MODULE)); - UndefCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomUndefp,2),PROLOG_MODULE)); + UndefCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomUndefp0,2),PROLOG_MODULE)); SpyCode = RepPredProp(PredPropByFunc(Yap_MkFunctor(AtomSpy,1),PROLOG_MODULE)); PredFail = RepPredProp(PredPropByAtom(AtomFail,PROLOG_MODULE)); PredTrue = RepPredProp(PredPropByAtom(AtomTrue,PROLOG_MODULE)); diff --git a/H/generated/ratoms.h b/H/generated/ratoms.h index 400c1888e..c836cb449 100644 --- a/H/generated/ratoms.h +++ b/H/generated/ratoms.h @@ -401,6 +401,7 @@ AtomTypeError = AtomAdjust(AtomTypeError); TermTypeError = MkAtomTerm(AtomTypeError); AtomUndefined = AtomAdjust(AtomUndefined); TermUndefined = MkAtomTerm(AtomUndefined); AtomUndefp = AtomAdjust(AtomUndefp); TermUndefp = MkAtomTerm(AtomUndefp); + AtomUndefp0 = AtomAdjust(AtomUndefp0); TermUndefp0 = MkAtomTerm(AtomUndefp0); AtomUnderflow = AtomAdjust(AtomUnderflow); TermUnderflow = MkAtomTerm(AtomUnderflow); AtomUnificationStack = AtomAdjust(AtomUnificationStack); TermUnificationStack = MkAtomTerm(AtomUnificationStack); AtomUnique = AtomAdjust(AtomUnique); TermUnique = MkAtomTerm(AtomUnique); diff --git a/H/generated/tatoms.h b/H/generated/tatoms.h index 511346bd0..d49d7555d 100644 --- a/H/generated/tatoms.h +++ b/H/generated/tatoms.h @@ -401,6 +401,7 @@ Atom AtomTxt; Term TermTxt; Atom AtomTypeError; Term TermTypeError; Atom AtomUndefined; Term TermUndefined; Atom AtomUndefp; Term TermUndefp; +Atom AtomUndefp0; Term TermUndefp0; Atom AtomUnderflow; Term TermUnderflow; Atom AtomUnificationStack; Term TermUnificationStack; Atom AtomUnique; Term TermUnique; diff --git a/H/heapgc.h b/H/heapgc.h index 8d9944afe..1d2b2cabe 100644 --- a/H/heapgc.h +++ b/H/heapgc.h @@ -77,6 +77,75 @@ (CellPtr(B) < CellPtr(val) && CellPtr(val) <= \ LCL0 && HEAP_PTR(val)))) +#ifdef TAG_64BITS00 + +#define MARK_BIT MKTAG(0x2,0x0) +#define RMARK_BIT MKTAG(0x4,0x0) + +#define MARKED_PTR(P) MARKED_PTR__(P PASS_REGS) +#define UNMARKED_CELL(P) MARKED_PTR__(P PASS_REGS) +#define UNMARKED_MARK(P, BP) UNMARKED_MARK__(P, BP PASS_REGS) +#define MARK(P) MARK__(P PASS_REGS) +#define UNMARK(P) UNMARK__(P PASS_REGS) +#define RMARK(P) RMARK__(P PASS_REGS) +#define RMARKED(P) RMARKED__(P PASS_REGS) +#define UNRMARK(P) UNRMARK__(P PASS_REGS) + +static inline Int +MARKED_PTR__(CELL* ptr USES_REGS) +{ + return (CELL)ptr & MARK_BIT; +} + +static inline Int +UNMARKED_MARK__(CELL* ptr, char *bp USES_REGS) +{ + CELL t = *ptr; + if (t & MARK_BIT) { + return true; + } + *ptr = t | MARK_BIT; + return false; +} + +static inline void +MARK__(CELL* ptr USES_REGS) +{ + CELL t = *ptr; + *ptr = t | MARK_BIT; +} + +static inline void +UNMARK__(CELL* ptr USES_REGS) +{ + *ptr &= ~MARK_BIT; +} + +/* not really that useful */ +#define MAY_UNMARK(X) + +#define UNMARK_CELL(X) (X) + +static inline void +RMARK__(CELL* ptr USES_REGS) +{ + *ptr |= RMARK_BIT; +} + +static inline void +UNRMARK__(CELL* ptr USES_REGS) +{ + *ptr &= ~RMARK_BIT; +} + +static inline int +RMARKED__(CELL* ptr USES_REGS) +{ + return *ptr & RMARK_BIT; +} + +#else + #define MARK_BIT ((char)1) #define RMARK_BIT ((char)2) @@ -145,6 +214,8 @@ RMARKED__(CELL* ptr USES_REGS) return mcell(ptr) & RMARK_BIT; } +#endif + /* is the object pointed to by ptr marked as in a relocation chain? */ #if LONG_ADDRESSES diff --git a/pl/boot.yap b/pl/boot.yap index c82b2c748..054e7d838 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -11,7 +11,7 @@ * File: boot.yap * * Last rev: 8/2/88 * * mods: * -* comments: boot file for Prolog * +* commen ts: boot file for Prolog * * * *************************************************************************/ @@ -251,8 +251,6 @@ private(_). :- use_system_module( '$_strict_iso', ['$check_iso_strict_clause'/1, '$iso_check_goal'/2]). - - '$early_print_message'(informational, _) :- yap_flag( verbose, S), S == silent, @@ -273,89 +271,22 @@ private(_). '$handle_error'(_Action,_G0,_M0) :- fail. % cases where we cannot afford to ever fail. -'$undefp'([ImportingMod|G], _) :- +'$undefp0'([ImportingMod|G], _) :- recorded('$import','$import'(ExportingModI,ImportingMod,G,G0I,_,_),_), !, % writeln('$execute0'(G0I, ExportingModI)), '$execute0'(G0I, ExportingModI). -'$undefp'([_|print_message(Context, Msg)], _) :- !, +'$undefp0'([_|print_message(Context, Msg)], _) :- !, '$early_print_message'(Context, Msg). % undef handler -'$undefp'([M0|G0], Action) :- +'$undefp0'([M0|G0], Action) :- % make sure we do not loop on undefined predicates - '$stop_creeping'(Current), yap_flag( unknown, Action, fail), - Action\=fail, - % yap_flag( debug, Debug, false), - ( - '$undefp_search'(M0:G0, NM:NG), - ( M0 \== NM -> true ; G0 \== NG ), - NG \= fail - -> - yap_flag( unknown, _, Action), - % yap_flag( debug, _, Debug), - ( - Current == true - -> - % carry on signal processing - '$start_creep'([NM|NG], creep) - ; - '$execute0'(NG, NM) - ) - ; - yap_flag( unknown, _, Action), - '$handle_error'(Action,G0,M0) - ). - -/* -'$undefp'([M0|G0], Default) :- - G0 \= '$imported_predicate'(_,_,_,_), - G0 \= '$full_clause_optimisation'(_H, _M, _B0, _BF), - G0 \= '$expand_a_clause'(_,_,_,_), - G0 \= '$all_directives'(_), - format(user_error, 'ERROR: undefined ~a:~q.~n', [M0, G0]), fail. -*/ -'$prepare_goals'((A,B),(NA,NB),Any) :- - !, - '$prepare_goals'(A,NA,Any), - '$prepare_goals'(B,NB,Any). -'$prepare_goals'((A;B),(NA;NB),Any) :- - !, - '$prepare_goals'(A,NA,Any), - '$prepare_goals'(B,NB,Any). -'$prepare_goals'((A->B),(NA->NB),Any) :- - !, - '$prepare_goals'(A,NA,Any), - '$prepare_goals'(B,NB,Any). -'$prepare_goals'((A*->B),(NA*->NB),Any) :- - !, - '$prepare_goals'(A,NA,Any), - '$prepare_goals'(B,NB,Any). -'$prepare_goals'((\+ A),(\+ NA),Any) :- - !, - '$prepare_goals'(A,NA,Any). -'$prepare_goals'('$do_error'(Error,Goal), - (clause_location(Call, Caller), - source_module(M), - strip_module(M:Goal,M1,NGoal), - throw(error(Error, [[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]])) - ), - true) :- - !, - '$head_and_body'(NGoal,Head,_Body). -'$prepare_goals'(X is AOB, - is(X, IOp, A, B ), - true) :- - var(X), - functor(AOB, Op, 2), - arg(1, AOB, A), - arg(2, AOB, B), - !, - '$inbrary_op_as_integer'(Op,IOp). -'$prepare_goals'((A,B),(A,B),_Any). - -'$prepare_clause'((H :- B), (H:-NB)) :- - '$prepare_goals'(B,NB,Any), - Any==true. + Action \= fail, + '$handle_error'(Action,G0,M0), + clause_location(Call, Caller), + source_module(M), + strip_module(M:Goal,M1,NGoal), + throw(error(Error, [[g|g(M1:NGoal)],[p|Call],[e|Caller],[h|g(Head)]])). diff --git a/pl/messages.yap b/pl/messages.yap index 9a59e260a..ef7fdcd8d 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -882,24 +882,6 @@ confusing to YAP (who will process the error?). So we write this small stub to ensure everything os ok */ -prolog:print_message(Level, _Msg) :- - current_prolog_flag(verbose_load, silent), - stream_property(_Stream, alias(loop_stream) ), - Level \= error, - Level \= warning, - !. -prolog:print_message(Level, _Msg) :- - current_prolog_flag(verbose, silent), - Level \= error, - Level \= warning, - !. -prolog:print_message(_, _Msg) :- - % first step at hook processi --ng - '$nb_getval'('$if_skip_mode',skip,fail), - !. -prolog:print_message(banner, _Msg) :- - current_prolog_flag(verbose, silent), - !. prolog:print_message(Severity, Msg) :- ( var(Severity) @@ -916,6 +898,20 @@ prolog:print_message(Severity, Msg) :- user:portray_message(Severity, Msg) ), !. +prolog:print_message(Level, _Msg) :- + current_prolog_flag(verbose_load, silent), + stream_property(_Stream, alias(loop_stream) ), + Level = informational, + !. +prolog:print_message(Level, _Msg) :- + current_prolog_flag(verbose, silent), + Level \= error, + Level \= warning, + !. +prolog:print_message(_, _Msg) :- + % first step at hook processi --ng + '$nb_getval'('$if_skip_mode',skip,fail), + !. prolog:print_message(force(_Severity), Msg) :- !, print(user_error,Msg). % This predicate has more hooks than a pirate ship! @@ -935,6 +931,40 @@ prolog:print_message(Severity, _Term) :- format('No handler for ~a message ~q,~n',[Severity, _Term]). +% cases where we cannot afford to ever fail. +'$undefp'([ImportingMod|G], _) :- + recorded('$import','$import'(ExportingModI,ImportingMod,G,G0I,_,_),_), !, + % writeln('$execute'(G0I, ExportingModI)), + '$execute0'(G0I, ExportingModI). +% undef handler +'$undefp'([M0|G0], Action) :- + % make sure we do not loop on undefined predicates + '$stop_creeping'(Current), + yap_flag( unknown, Action, fail), + Action\=fail, + % yap_flag( debug, Debug, false), + ( + '$undefp_search'(M0:G0, NM:NG), + ( M0 \== NM -> true ; G0 \== NG ), + NG \= fail + -> + yap_flag( unknown, _, Action), + % yap_flag( debug, _, Debug), + ( + Current == true + -> + % carry on signal processing + '$start_creep'([NM|NG], creep) + ; + '$execute0'(NG, NM) + ) + ; + yap_flag( unknown, _, Action), + '$handle_error'(Action,G0,M0) + ). + +:- '$undef_handler'('$undefp'(_,_), prolog). + /** @} */