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

undef handler

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-06-03 16:53:43 +01:00
parent 79e6e3fcc1
commit 32743f3731
13 changed files with 165 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
C/cdmgr.c
View File

@ -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);

1
H/ATOMS
View File

@ -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"

6
H/HEAPFIELDS
View File

@ -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

18
H/Tags_64bits.h
View File

@ -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))<<SHIFT_HIGH_TAG)|(LO))
#define TagBits /* 0x30000007L */ MKTAG(0x1,7)
#define TagBits /* 0x70000007L */ MKTAG(0x7,7)
#define LowTagBits /* 0x00000007L */ MKTAG(0x0,7)
#define HighTagBits /* 0x70000000L */ MKTAG(0x1,0)
#define AdrHiBit /* 0x08000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-1))
#define MaskPrim /* 0x0ffffff8L */ ((((UInt)1) << (SHIFT_HIGH_TAG))-8)
#define HighTagBits /* 0x70000000L */ MKTAG(0x7,0)
#define AdrHiBit /* 0x08000000L */ (((UInt)1) << (SHIFT_HIGH_TAG-3))
#define MaskPrim /* 0x0ffffff8L */ (((((UInt)1) << (SHIFT_HIGH_TAG-3))-1)<<3)
#define NumberTag /* 0x30000001L */ MKTAG(0x1,1)
#define AtomTag /* 0x10000001L */ MKTAG(0x0,1)
#define MAX_ABS_INT /* 0xfe00000LL */ (((Int)1) << (63-(2+4)))
#define MAX_ABS_INT /* 0xfe00000LL */ ((((Int)1) << (63-(3+3)))<<3)
/* bits that should not be used by anyone but us */
#define YAP_PROTECTED_MASK 0xe000000000000000L

3
H/YapSignals.h
View File

@ -20,6 +20,9 @@
#if HAVE_SIGNAL_H
#include <signal.h>
#endif
#if HAVE_ERRNO_H
#include <errno.h>
#endif
typedef enum
{

4
H/eval.h
View File

@ -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)

1
H/generated/iatoms.h
View File

@ -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);

2
H/generated/ihstruct.h
View File

@ -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));

1
H/generated/ratoms.h
View File

@ -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);

1
H/generated/tatoms.h
View File

@ -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;

71
H/heapgc.h
View File

@ -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

89
pl/boot.yap
View File

@ -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)]])).

66
pl/messages.yap
View File

@ -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).
/**
@}
*/