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

first cut at detecting error source

Browse Source
This commit is contained in:
Vítor Santos Costa 2015-09-29 23:09:12 +01:00
parent b3a262910f
commit cd7d654cca
3 changed files with 120 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
C/errors.c
View File

@ -291,7 +291,7 @@ static char tmpbuf[YAP_BUF_SIZE];
#include "YapErrors.h" #include "YapErrors.h"
/** /**
* @brief Yap_Error__ * @brief Yap_Errorp
* This function handles errors in the C code. Check errors.yap for the * This function handles errors in the C code. Check errors.yap for the
*corresponding Prolog code. *corresponding Prolog code.
* *
@ -313,7 +313,9 @@ static char tmpbuf[YAP_BUF_SIZE];
* The list includes the following options: * The list includes the following options:
* + c=c(file, line, function): where the bug was detected; * + c=c(file, line, function): where the bug was detected;
* *
* + p=p(mod, name, arity, file, line): the prolog procedure that caused the bug, * + e=p(mod, name, arity, cl, file, lin): where the code was entered;
*
* + p=p(mod, name, arity, cl, file, line): the prolog procedure that caused the bug,
*and optionally, *and optionally,
* *
* + g=g(Goal): the goal that created this mess * + g=g(Goal): the goal that created this mess
@ -327,7 +329,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
CELL nt[3]; CELL nt[3];
Functor fun; Functor fun;
bool serious; bool serious;
Term tf, error_t; Term tf, error_t, comment, culprit;
/* disallow recursive error handling */ /* disallow recursive error handling */
if (LOCAL_PrologMode & InErrorMode) { if (LOCAL_PrologMode & InErrorMode) {
@ -362,39 +364,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
tmpbuf); tmpbuf);
Yap_exit(1); Yap_exit(1);
} }
/* must do this here */ if (LOCAL_PrologMode == BootMode) {
if (type == (SYSTEM_ERROR_FATAL || type == SYSTEM_ERROR_INTERNAL
#if USE_SYSTEM_MALLOC
|| !Yap_heap_regs
#else
|| !Yap_HeapBase
#endif
)) {
{
va_start(ap, where);
char *format = NULL;
format = va_arg(ap, char *);
/* now build the error string */
if (format) {
#if HAVE_VSNPRINTF
(void)vsnprintf(tmpbuf, YAP_BUF_SIZE, format, ap);
#else
(void)vsprintf(tmpbuf, format, ap);
#endif
} else {
tmpbuf[0] = '\0';
}
va_end(ap);
}
if (LOCAL_PrologMode == UserCCallMode) {
fprintf(stderr, "%%\n%%\n");
fprintf(stderr, "%% YAP OOOPS in USER C-CODE: %s.\n", tmpbuf);
fprintf(stderr, "%%\n%%\n");
} else {
fprintf(stderr, "%%\n%%\n");
fprintf(stderr, "%% YAP OOOPS: %s.\n", tmpbuf);
fprintf(stderr, "%%\n%%\n");
}
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256); Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
fprintf(stderr, "%%\n%% PC: %s\n", (char *)HR); fprintf(stderr, "%%\n%% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256); Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, (char *)HR, 256);
@ -440,8 +410,11 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
#else #else
(void)vsprintf(tmpbuf, format, ap); (void)vsprintf(tmpbuf, format, ap);
#endif #endif
} else comment = MkAtomTerm(Yap_LookupAtom(tmpbuf));
} else {
tmpbuf[0] = '\0'; tmpbuf[0] = '\0';
comment = TermNil;
}
va_end(ap); va_end(ap);
} }
if (LOCAL_PrologMode & BootMode) { if (LOCAL_PrologMode & BootMode) {
@ -521,28 +494,36 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
MAX_ERROR_MSG_SIZE); MAX_ERROR_MSG_SIZE);
LOCAL_ErrorMessage = LOCAL_ErrorSay; LOCAL_ErrorMessage = LOCAL_ErrorSay;
} }
if (LOCAL_ErrorSay && LOCAL_ErrorSay[0])
comment = MkAtomTerm(Yap_LookupAtom( LOCAL_ErrorSay ) );
else
comment = TermNil;
} }
switch (type) { switch (type) {
case RESOURCE_ERROR_HEAP: case RESOURCE_ERROR_HEAP:
case RESOURCE_ERROR_STACK: case RESOURCE_ERROR_STACK:
case RESOURCE_ERROR_TRAIL: case RESOURCE_ERROR_TRAIL:
nt[1] = MkAtomTerm(Yap_LookupAtom(tmpbuf)); comment = MkAtomTerm(Yap_LookupAtom(tmpbuf));
break;
default: default:
{ nt[1] = TermNil;
Term stack_dump; if (comment != TermNil)
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("i")),comment), nt[1]);
if ((stack_dump = Yap_all_calls()) == 0L) { if (file && function) {
stack_dump = TermNil; Term ts[3], t3;
LOCAL_Error_Size = 0L; ts[0] = MkAtomTerm(Yap_LookupAtom(file));
} ts[1] = MkIntegerTerm(lineno);
nt[1] = MkPairTerm(MkAtomTerm(Yap_LookupAtom(tmpbuf)), ts[2] = MkAtomTerm(Yap_LookupAtom(function));
MkPairTerm(stack_dump, TermNil)); t3 = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("c"),3),3,ts);
if (type == SYNTAX_ERROR) { nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")),t3), nt[1]);
nt[1] = MkPairTerm(where, nt[1]); }
} if ((culprit=Yap_pc_location( P, B, ENV)) != TermNil ) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")),culprit), nt[1]);
}
if ((culprit=Yap_env_location( CP, B, ENV, 0)) != TermNil ) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")),culprit), nt[1]);
} }
} }
Yap_DebugPlWrite(nt[1]);
/* disable active signals at this point */ /* disable active signals at this point */
LOCAL_Signals = 0; LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);

18
pl/errors.yap
View File

@ -217,19 +217,13 @@ to allow user-control.
'$do_error'(Type,Message) :- '$do_error'(Type,Goal) :-
format('~w~n', [Type]), format('~w~n', [Type]),
% stop_low_level_trace, ancestor_location(Call, Caller),
current_stack(local_sp(Location, throw(error(Type, [
P,CP,PP,Envs,CPs)), [g|g(Goal)],
% '$stack_dump', [p|Call],
'$compose_context'(Message, Location, CMessage), [e|Caller]])).
throw(error(Type,[context(CMessage)
,local_sp(Location,P,CP,PP,Envs,CPs)])).
'$compose_context'(context(Culprit), Caller, context(Culprit, Caller) ) :-
!.
'$compose_context'(Culprit, _Caller, context(Culprit) ).
'$do_pi_error'(type_error(callable,Name/0),Message) :- !, '$do_pi_error'(type_error(callable,Name/0),Message) :- !,

179
pl/messages.yap
View File

@ -44,7 +44,11 @@ generic informational messages
help messages (not currently implemented in YAP) help messages (not currently implemented in YAP)
+ `query` + `query`
query used in query processing (not currently implemented in YAP) query used in query processing (not currently implemented in YAP)
+ `silent` + `silent`,M,Na,Ar,File, FilePos]],
[nl, nl].
caller( error(_,Term), _) -->
{ lists:memberchk([g|g(Call)], Term) },
['~*|called from
messages that do not produce output but that can be intercepted by hooks. messages that do not produce output but that can be intercepted by hooks.
@ -192,130 +196,107 @@ compose_message(version(Version), _Leve) -->
[ '~a' - [Version] ]. [ '~a' - [Version] ].
compose_message(myddas_version(Version), _Leve) --> compose_message(myddas_version(Version), _Leve) -->
[ 'MYDDAS version ~a' - [Version] ]. [ 'MYDDAS version ~a' - [Version] ].
compose_message(yes, _Leve) --> !, compose_message(yes, _Level) --> !,
[ 'yes'- [] ]. [ 'yes'- [] ].
compose_message(Term, Level) --> compose_message(Term, Level) -->
{ Level == error -> true ; Level == warning }, { Level == error -> true ; Level == warning },
file_location(Term, Cause), location(Term, Level),
main_message(Term, Cause),
stack_dump( Term ),
extra_info( Term ),
[nl], [nl],
!. main_message( Term, Level ),
c_goal( Term, Level ),
caller( Term, Level ),
extra_info( Term, Level ),
!,
[nl].
compose_message(A-L, _Level) --> compose_message(A-L, _Level) -->
{ format(user_error,A,L) }. { format(user_error,A,L) }.
location( error(_,Term), Level ) -->
file_location(error(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) --> { lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) },
[ '~a:~d:0 ~a in ~a:~q/~d:'-[File, FilePos,Level,M,Na,Ar] ],
[nl].
location(error(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) -->
[ '~a:~d:0: ' - [FileName,LN] ] . [ '~a:~d:0: ' - [FileName,LN] ] .
file_location(warning(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) --> location(warning(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) -->
[ '~a:~d:0: ' - [FileName,LN] ] . [ '~a:~d:0: ' - [FileName,LN] ] .
file_location(style_check(_,LN,FileName,_ ), _ ) --> location(style_check(_,LN,FileName,_ ), _ ) -->
% { stream_position_data( line_count, LN) }, % { stream_position_data( line_count, LN) },
!, !,
[ '~a:~d:0: ' - [FileName,LN] ] . [ '~a:~d:0: ' - [FileName,LN] ] .
file_location(error(_,L), Goal )-->
{
lists:memberchk(context(G),L),
clause_to_indicator(G, Goal)
->
true
;
lists:memberchk(context(G,_P), L),
clause_to_indicator(G, Goal)
->
true
;
true
},
{
lists:memberchk(local_sp(LN:FileName:Mod:Ind,_P,_CP,_PP,_,_),L)
->
( var(Goal) -> Goal = Mod:Ind ; true )
;
lists:memberchk(local_sp(LN:FileName:[],_P,_CP,_PP,_,_),L)
->
true
;
prolog_load_context(file, FileName),
stream_property( Stream, alias(loop_stream) ),
stream_property( Stream, line_count( LN ) )
->
true
;
user_input = S,
stream_property( S, line_count( LN ) ),
stream_property( S, file_name( FileName ) )
},
{
nonvar(Goal)
->
true
;
Ind = 'system:0'
},
[ '~d:0: ' - [FileName,LN] ].
%file_location(Info,query) -->
% { format( user_error, 'information available is: ~n~q.~n~n ' , [Info])} .
/*print_message(error, error(Msg,[Info|local_sp(P,CP,Envs,CPs)])) :- !,
recorda(sp_info,local_sp(Msg, P,CP,PP,Envs,CPs),R),
print_message(error, error(Msg, Info)),
erase(R).
*/
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
main_message( error(syntax_error,syntax_error(Msg,between(L0,LM,LF),_Stream,Term)), _ ) --> main_message( error(syntax_error,syntax_error(Msg,between(L0,LM,LF),_Stream,Term)), _ ) -->
!, !,
['syntax error: ~s' - [Msg]], ['~*|!!! syntax error: ~s' - [10,Msg]],
[nl], [nl],
% [prefix(' ')], % [prefix(' ')],
( syntax_error_term( between(L0,LM,LF), Term ) ( syntax_error_term( between(L0,LM,LF), Term )
-> [] ->
[]
; ;
['failed_processing ~w' - [Term], ['failed_processing ~w' - [Term]],
nl] [nl]
). ).
main_message(style_check(singleton(SVs),_S,_W,P), I) --> main_message(style_check(singleton(SVs),_S,_W,P), _) -->
{ clause_to_indicator(P, I) }, { clause_to_indicator(P, I) },
[ 'singleton variable~*c ~s in ~q.' - [ NVs, 0's, SVsL, I] ], % ' [ '~*|!!! singleton variable~*c ~s in ~q.' - [ 10, NVs, 0's, SVsL, I] ],
{ svs(SVs,SVsL,[]), { svs(SVs,SVsL,[]),
( SVs = [_] -> NVs = 0 ; NVs = 1 ) ( SVs = [_] -> NVs = 0 ; NVs = 1 )
}. }.
main_message(style_check(multiple(N,A,Mod,I0),_L,File,_),_I) --> main_message(style_check(multiple(N,A,Mod,I0),_L,File,_),_) -->
[ '~a redefines ~q from ~a.' - [File, Mod:N/A, I0] ]. [ '~*|!!! ~a redefines ~q from ~a.' - [8,File, Mod:N/A, I0] ].
main_message(style_check(discontiguous(N,A,Mod),_P,_T,_M), _) --> main_message(style_check(discontiguous(N,A,Mod),_P,_T,_M), _) -->
[ 'discontiguous definition for ~p.' - [Mod:N/A] ]. [ '~*|!!! !!! discontiguous definition for ~p.' - [8,Mod:N/A] ].
main_message(error(Msg,Info), _) --> {var(Info)}, !, main_message(error(Msg,Info), _) --> {var(Info)}, !,
[ nl, '~internal YAP problem, incomplete message ~w~n.' - [Msg], nl ]. [ nl, '~*|!!! found internal YAP problem, incomplete message ~w~n.' - [8,Msg], nl ].
main_message(error(consistency_error(Who), [Where|_]), _Source) --> main_message(error(consistency_error(Who)), _Source) -->
[ 'argument ~a not consistent with ~q.'-[Who,Where] ]. [ '~*|!!! has argument ~a not consistent with type.'-[8,Who] ].
main_message(error(domain_error(Who , Type), _Where), _Source) --> main_message(error(domain_error(Who , Type), _Where), _Source) -->
[ 'value ~a should be in ~q,' - [Who,Type], nl ]. [ '~*|!!! ~q does not belong to domain ~a,' - [8,Who,Type], nl ].
main_message(error(evaluation_error(What), _Where), _Source) --> main_message(error(evaluation_error(What), _Where), _Source) -->
[ ' ~a during evaluation of arithmetic expressions,' - [What], nl ]. [ '~*|!!! caused ~a during evaluation of arithmetic expressions,' - [8,What], nl ].
main_message(error(existence_error(Who , Type), _Where), _Source) --> main_message(error(existence_error(Type , Who), _Where), _Source) -->
[ '~a ~q could not be found,' - [Who, Type], nl ]. [ '~*|!!! ~q ~a could not be found,' - [8,Type, Who], nl ].
main_message(error(permission_error(Op, Type, Id), _Where), _Source) --> main_message(error(permission_error(Op, Type, Id), _Where), _Source) -->
[ ' ~q not allowed in ~a ~q,' - [Id, Type, Op], nl ]. [ '~*|!!! ~q is not allowed in ~a ~q,' - [8, Op, Type,Id], nl ].
main_message(error(instantiation_error), _Source) --> main_message(error(instantiation_error, _Where), _Source) -->
[ 'unbound variable' - [], nl ]. [ '~*|!!! unbound variable' - [8], nl ].
main_message(error(representation_error), _Source) --> main_message(error(representation_error), _Source) -->
[ 'unbound variable' - [], nl ]. [ '~*|!!! unbound variable' - [8], nl ].
main_message(error(type_error(Type,Who), _What), _Source) --> main_message(error(type_error(Type,Who), _What), _Source) -->
[ ' ~q should be of type ~a' - [Who,Type], nl ]. [ '~*|!!! ~q should be of type ~a' - [8,Who,Type], nl ].
main_message(error(uninstantiation_error(T),_), _Source) --> main_message(error(uninstantiation_error(T),_), _Source) -->
[ 'found ~q, expected unbound variable ' - [T], nl ]. [ '~*|!!! found ~q, expected unbound variable ' - [8,T], nl ].
caller( error(_,Term), _) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) },
{ lists:memberchk([g|g(Call)], Term) },
!,
['~*|goal was ~q' - [10,Call]],
[nl],
['~*|exception raised from ~a:~q/~d, ~a:~d:0. '-[10,M,Na,Ar,File, FilePos]],
[nl].
caller( error(_,Term), _) -->
{ lists:memberchk([e|p(M,Na,Ar,File,FilePos)], Term ) },
!,
['~*|exception raised from ~a:~q/~d, ~a:~d:0. '-[10,M,Na,Ar,File, FilePos]],
[nl].
caller( error(_,Term), _) -->
{ lists:memberchk([g|g(Call)], Term) },
!,
['~*|goal ~q '-[10,Call]],
[nl].
caller( _, _) -->
[].
c_goal( error(_,Term), Level ) -->
{ lists:memberchk([c|c(File, Line, Func)], Term ) },
!,
['~*|~a raised at C-function ~a() in ~a/~d:0. '-[10, Level, Func, File, Line]],
[nl].
c_goal( _, _Level ) --> [].
stack_dump(_) --> !.
stack_dump(error(_,_)) -->
{ fail },
{ recorded(sp_info,local_sp(_Msg,_P,CP,_PP,Envs,CPs),_) },
{ Envs = [_|_] ; CPs = [_|_] }, !,
[nl],
'$hacks':display_stack_info(CPs, Envs, 20, CP).
prolog_message(X) --> prolog_message(X) -->
system_message(X). system_message(X).
@ -386,8 +367,7 @@ system_message(error(permission_error(access,static_procedure,P), Where)) -->
system_message(error(permission_error(alias,new,P), Where)) --> system_message(error(permission_error(alias,new,P), Where)) -->
[ 'PERMISSION ERROR- ~w: cannot create alias ~w' - [Where,P] ]. [ 'PERMISSION ERROR- ~w: cannot create alias ~w' - [Where,P] ].
system_message(error(permission_error(create,Name,P), Where)) --> system_message(error(permission_error(create,Name,P), Where)) -->
{ object_name(Name, ObjName) }, [ 'PERMISSION ERROR- ~w: cannot create ~a ~w' - [Where,Name,P] ].
[ 'PERMISSION ERROR- ~w: cannot create ~a ~w' - [Where,ObjName,P] ].
system_message(error(permission_error(import,M1:I,redefined,SecondMod), Where)) --> system_message(error(permission_error(import,M1:I,redefined,SecondMod), Where)) -->
[ 'PERMISSION ERROR- loading ~w: modules ~w and ~w both define ~w' - [Where,M1,SecondMod,I] ]. [ 'PERMISSION ERROR- loading ~w: modules ~w and ~w both define ~w' - [Where,M1,SecondMod,I] ].
system_message(error(permission_error(input,binary_stream,Stream), Where)) --> system_message(error(permission_error(input,binary_stream,Stream), Where)) -->
@ -536,7 +516,11 @@ domain_error(write_option, Opt) --> !,
domain_error(Domain, Opt) --> domain_error(Domain, Opt) -->
[ '~w not a valid element for ~w' - [Opt,Domain] ]. [ '~w not a valid element for ~w' - [Opt,Domain] ].
extra_info( _ ) --> []. extra_info( error(_,Extra), _ ) -->
{lists:memberchk([i|Msg], Extra)}, !,
[' Comments: ~s~nx.' - [Msg] ].
extra_info( _, _ ) -->
[].
object_name(array, array). object_name(array, array).
object_name(atom, atom). object_name(atom, atom).
@ -553,6 +537,7 @@ object_name(float, float).
object_name(in_byte, byte). object_name(in_byte, byte).
object_name(in_character, character). object_name(in_character, character).
object_name(integer, integer). object_name(integer, integer).
object_name(key, 'database key'). object_name(key, 'database key').
object_name(leash_mode, 'leash mode'). object_name(leash_mode, 'leash mode').
object_name(library, library). object_name(library, library).