This commit is contained in:
Vítor Santos Costa 2019-05-19 09:48:13 +01:00
parent c3a254e44d
commit 0e47ddc802
5 changed files with 110 additions and 93 deletions

View File

@ -2322,7 +2322,7 @@ static Int new_system_predicate(
} }
static Int static Int
p_is_system_predicate(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */ is_system_predicate(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
PredEntry *pe; PredEntry *pe;
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
@ -2341,7 +2341,7 @@ static Int
} }
static Int static Int
p_is_opaque_predicate(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */ is_opaque_predicate(USES_REGS1) { /* '$is_multifile'(+S,+Mod) */
PredEntry *pe; PredEntry *pe;
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
bool out; bool out;
@ -4323,9 +4323,9 @@ void Yap_InitCdMgr(void) {
TestPredFlag | SafePredFlag); TestPredFlag | SafePredFlag);
Yap_InitCPred("$new_system_predicate", 3, new_system_predicate, Yap_InitCPred("$new_system_predicate", 3, new_system_predicate,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);
Yap_InitCPred("$is_system_predicate", 2, p_is_system_predicate, Yap_InitCPred("$is_system_predicate", 2, is_system_predicate,
TestPredFlag | SafePredFlag); TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_opaque_predicate", 2, p_is_opaque_predicate, Yap_InitCPred("$is_opaque_predicate", 2, is_opaque_predicate,
TestPredFlag | SafePredFlag); TestPredFlag | SafePredFlag);
Yap_InitCPred("$new_discontiguous", 3, p_new_discontiguous, Yap_InitCPred("$new_discontiguous", 3, p_new_discontiguous,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);

View File

@ -322,10 +322,11 @@ static bool getLine(int inp) {
rl_instream = GLOBAL_Stream[inp].file; rl_instream = GLOBAL_Stream[inp].file;
const unsigned char *myrl_line = NULL; const unsigned char *myrl_line = NULL;
StreamDesc *s = GLOBAL_Stream + inp; StreamDesc *s = GLOBAL_Stream + inp;
bool shouldPrompt = Yap_DoPrompt(s);
/* window of vulnerability opened */ /* window of vulnerability opened */
LOCAL_PrologMode |= ConsoleGetcMode; LOCAL_PrologMode |= ConsoleGetcMode;
if (Yap_DoPrompt(s)) { // no output so far if (true || shouldPrompt) { // no output so far
rl_set_signals(); rl_set_signals();
myrl_line = (unsigned char *)readline(LOCAL_Prompt); myrl_line = (unsigned char *)readline(LOCAL_Prompt);
rl_clear_signals(); rl_clear_signals();

View File

@ -303,16 +303,16 @@ be lost.
'$trace'(Mod:G, A1) :- '$trace'(Mod:G, A1) :-
G =.. L, G =.. L,
lists:append( L, [A1], NL), lists:append( L, [A1], NL),
NG =.. NL, NG =.. NL,
'$trace'(Mod:NG). '$trace'(Mod:NG).
'$trace'(Mod:G, A1, A2) :- '$trace'(Mod:G, A1, A2) :-
G =.. L, G =.. L,
lists:append( L, [A1, A2], NL), lists:append( L, [A1, A2], NL),
NG =.. NL, NG =.. NL,
'$trace'(Mod:NG). '$trace'(Mod:NG).
'$trace'(Mod:G, A1, A2, A3) :- '$trace'(Mod:G, A1, A2, A3) :-
G =.. L, G =.. L,
@ -358,36 +358,39 @@ be lost.
'$debugger_output'. '$debugger_output'.
'$debugger_input' :- '$debugger_input' :-
stream_property(_,alias(debugger_input)), stream_property(_,alias(debugger_input)),
!. !.
'$debugger_input' :- '$debugger_input' :-
S = user_input, S = user_input,
stream_property(S,tty(true)), stream_property(S,tty(true)),
% stream_property(S,input), % stream_property(S,input),
!, !,
set_stream(S,alias(debugger_input)). set_stream(S,alias(debugger_input)).
'$debugger_input' :- '$debugger_input' :-
current_prolog_flag(unix, true ), !, current_prolog_flag(unix, true ),
open('/dev/tty', read, _S, [alias(debugger_input),bom(false)]). !,
open('/dev/tty', read, _S, [alias(debugger_input),bom(false)]).
'$debugger_input' :- '$debugger_input' :-
current_prolog_flag(windows, true ), !, current_prolog_flag(windows, true ),
open('CONIN$', read, _S, [alias(debugger_input),bom(false)]). !,
open('CONIN$', read, _S, [alias(debugger_input),bom(false)]).
'$debugger_output' :- '$debugger_output' :-
stream_property(_,alias(debugger_output)), stream_property(_,alias(debugger_output)),
!. !.
'$debugger_output' :- '$debugger_output' :-
S = user_error, S = user_error,
stream_property(S,tty(true)), stream_property(S,tty(true)),
% stream_property(S,output), % stream_property(S,output),
!, !,
set_stream(S,alias(debugger_output)). set_stream(S,alias(debugger_output)).
'$debugger_output' :- '$debugger_output' :-
current_prolog_flag(unix, true ), !, current_prolog_flag(unix, true ),
open('/dev/tty', write, _S, [alias(debugger_output)]). !,
open('/dev/tty', write, _S, [alias(debugger_output)]).
'$debugger_output' :- '$debugger_output' :-
current_prolog_flag(windows, true ), !, current_prolog_flag(windows, true ),
open('CONOUT$', write, _S, [alias(debugger_output)]). !,
open('CONOUT$', write, _S, [alias(debugger_output)]).
'$trace_meta_call'( G, M, CP ) :- '$trace_meta_call'( G, M, CP ) :-
@ -398,13 +401,18 @@ be lost.
% debug a complex query % debug a complex query
% %
'$trace_query'(V, M, _CP, _) :- '$trace_query'(V, M, _CP, _) :-
var(V), !, call(M:V). var(V),
!,
call(M:V).
'$trace_query'(!, _, CP, _) :- '$trace_query'(!, _, CP, _) :-
!, '$$cut_by'(CP). !,
'$$cut_by'(CP).
'$trace_query'('$cut_by'(M), _, _, _) :- '$trace_query'('$cut_by'(M), _, _, _) :-
!, '$$cut_by'(M). !,
'$$cut_by'(M).
'$trace_query'('$$cut_by'(M), _, _, _) :- '$trace_query'('$$cut_by'(M), _, _, _) :-
!, '$$cut_by'(M). !,
'$$cut_by'(M).
'$trace_query'(M:G, _, CP,S) :- '$trace_query'(M:G, _, CP,S) :-
!, !,
'$yap_strip_module'(M:G, M0, G0), '$yap_strip_module'(M:G, M0, G0),
@ -416,33 +424,33 @@ be lost.
'$trace_query'(A, M, CP, S) -> '$trace_query'(A, M, CP, S) ->
'$trace_query'(B, M, CP, S). '$trace_query'(B, M, CP, S).
'$trace_query'((A;B), M, CP, S) :- !, '$trace_query'((A;B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S); '$trace_query'(A, M, CP, S);
'$trace_query'(B, M, CP, S). '$trace_query'(B, M, CP, S).
'$trace_query'((A|B), M, CP, S) :- !, '$trace_query'((A|B), M, CP, S) :- !,
'$trace_query'(A, M, CP, S); '$trace_query'(A, M, CP, S);
'$trace_query'(B, M, CP, S). '$trace_query'(B, M, CP, S).
'$trace_query'((\+ A), M, CP, S) :- !, '$trace_query'((\+ A), M, CP, S) :- !,
'$trace_query'(A, M, CP, S). '$trace_query'(A, M, CP, S).
'$trace_query'(G, M,_CP,S) :- '$trace_query'(G, M,_CP,S) :-
'$is_metapredicate'(G, prolog), '$is_metapredicate'(G, prolog),
!, !,
'$debugger_expand_meta_call'(M:G, [], G1), '$debugger_expand_meta_call'(M:G, [], G1),
strip_module(M:G1, MF, NG), strip_module(M:G1, MF, NG),
% spy a literal % spy a literal
'$id_goal'(L), '$id_goal'(L),
catch( catch(
'$trace_goal'(NG, MF, L, S), '$trace_goal'(NG, MF, L, S),
E, E,
'$TraceError'(E, G, M, L, S) '$TraceError'(E, G, M, L, S)
). ).
'$trace_query'(G, M, _CP, H) :- '$trace_query'(G, M, _CP, H) :-
% spy a literal % spy a literal
'$id_goal'(L), '$id_goal'(L),
catch( catch(
'$trace_goal'(G, M, L, H), '$trace_goal'(G, M, L, H),
E, E,
'$TraceError'(E, G, M, L, H) '$TraceError'(E, G, M, L, H)
). ).
%% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo) %% @pred $trace_goal( +Goal, +Module, +CallId, +CallInfo)
@ -676,22 +684,21 @@ be lost.
'$port'(P,G,Module,L,Deterministic, Info) :- '$port'(P,G,Module,L,Deterministic, Info) :-
% at this point we are done with leap or skip % at this point we are done with leap or skip
repeat, repeat,
'$trace_msg'(P,G,Module,L,Deterministic), flush_output,
'$clear_input'(debugger_input),
'$trace_msg'(P,G,Module,L,Deterministic),
( (
'$unleashed'(P) -> '$unleashed'(P) ->
'$action'('\n',P,L,G,Module,Info), '$action'('\n',P,L,G,Module,Info),
nl(debugger_output) nl(debugger_output)
; ;
write(debugger_output,' ? '), prompt1(' ? '),
'$clear_input'(debugger_input), get_char(debugger_input,C),
get_char(debugger_input,C), '$action'(C,P,L,G,Module,_Info)
'$action'(C,P,L,G,Module,_Info)
), ),
!. !.
'$trace_msg'(P,G,Module,L,Deterministic) :- '$trace_msg'(P,G,Module,L,Deterministic) :-
flush_output(user_output),
flush_output(user_error),
functor(P,P0,_), functor(P,P0,_),
(P = exit, Deterministic \= deterministic -> Det = '?' ; Det = ' '), (P = exit, Deterministic \= deterministic -> Det = '?' ; Det = ' '),
('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '), ('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '),
@ -954,11 +961,17 @@ be lost.
'$deb_inc_in_sterm_oldie'(C,[],C). '$deb_inc_in_sterm_oldie'(C,[],C).
'$get_sterm_list'(L0,C,N,L) :- '$get_sterm_list'(L0,C,N,L) :-
( C =:= "^", N =\= 0 -> get_code(debugger_input, CN), ( C =:= "^", N =\= 0 ->
'$get_sterm_list'([N|L0],CN,0,L) ; get_code(debugger_input, CN),
C >= "0", C =< "9" -> NN is 10*N+C-"0", get_code(debugger_input, CN), '$get_sterm_list'([N|L0],CN,0,L)
'$get_sterm_list'(L0,CN,NN,L); ;
C =:= 10 -> (N =:= 0 -> L = L0 ; L=[N|L0]) ). C >= "0", C =< "9" ->
NN is 10*N+C-"0", get_code(debugger_input, CN),
'$get_sterm_list'(L0,CN,NN,L)
;
C =:= 10 ->
(N =:= 0 -> L = L0 ; L=[N|L0])
).
'$deb_get_sterm_in_g'([],G,G). '$deb_get_sterm_in_g'([],G,G).
'$deb_get_sterm_in_g'([H|T],G,A) :- '$deb_get_sterm_in_g'([H|T],G,A) :-
@ -1007,18 +1020,21 @@ be lost.
'$debugger_skip_trace_query'([CP|CPs],CPs1) :- '$debugger_skip_trace_query'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !, yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_),
'$debugger_skip_trace_query'(CPs,CPs1). !,
'$debugger_skip_trace_query'(CPs,CPs1).
'$debugger_skip_trace_query'(CPs,CPs). '$debugger_skip_trace_query'(CPs,CPs).
'$debugger_skip_traces'([CP|CPs],CPs1) :- '$debugger_skip_traces'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !, yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_),
'$debugger_skip_traces'(CPs,CPs1). !,
'$debugger_skip_traces'(CPs,CPs1).
'$debugger_skip_traces'(CPs,CPs). '$debugger_skip_traces'(CPs,CPs).
'$debugger_skip_loop_spy2'([CP|CPs],CPs1) :- '$debugger_skip_loop_spy2'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !, yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_),
'$debugger_skip_loop_spy2'(CPs,CPs1). !,
'$debugger_skip_loop_spy2'(CPs,CPs1).
'$debugger_skip_loop_spy2'(CPs,CPs). '$debugger_skip_loop_spy2'(CPs,CPs).
'$debugger_expand_meta_call'( G, VL, M:G2 ) :- '$debugger_expand_meta_call'( G, VL, M:G2 ) :-
@ -1026,9 +1042,9 @@ be lost.
'$yap_strip_module'( G0, M, G1 ), '$yap_strip_module'( G0, M, G1 ),
( (
'$is_system_predicate'(G0,M) -> '$is_system_predicate'(G0,M) ->
'$debugger_process_meta_arguments'(G1, M, G2) '$debugger_process_meta_arguments'(G1, M, G2)
; ;
G1 = G2 G1 = G2
). ).
'$debugger_process_meta_arguments'(G, M, G1) :- '$debugger_process_meta_arguments'(G, M, G1) :-
@ -1045,13 +1061,13 @@ be lost.
'$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$trace'(M1:G1)|BG1s]) :- '$ldebugger_process_meta_args'([G|BGs], M, [N|BMs], ['$trace'(M1:G1)|BG1s]) :-
number(N), number(N),
N >= 0, N >= 0,
'$yap_strip_module'( M:G, M1, G1 ), '$yap_strip_module'( M:G, M1, G1 ),
functor(G1, Na, _), functor(G1, Na, _),
Na \= '$trace', Na \= '$trace',
!, !,
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s). '$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
'$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :- '$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :-
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s). '$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
'$creep'(creep) :- '$creep'. '$creep'(creep) :- '$creep'.

View File

@ -112,7 +112,7 @@ mode and the existing spy-points, when the debugger is on.
print_message(warning,no_match(nospy(M:F/N))) print_message(warning,no_match(nospy(M:F/N)))
). ).
'$do_suspy'(S, F, N, T, M) :- '$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M), '$is_system_predicate'(T,M),
'$predicate_flags'(T,M,F,F), '$predicate_flags'(T,M,F,F),
F /\ 0x118dd080 =\= 0, F /\ 0x118dd080 =\= 0,
( S = spy -> ( S = spy ->
@ -486,7 +486,7 @@ notrace(G) :-
current_prolog_flag( debug, false ) current_prolog_flag( debug, false )
-> true -> true
; ;
'$system_predicate'(G,Module) '$is_opaque_zpredicate'(G,Module)
-> true -> true
; ;
'$is_private'(G,Module) '$is_private'(G,Module)
@ -507,7 +507,7 @@ notrace(G) :-
GN > GoalNo GN > GoalNo
). ).
'$creep_is_on_at_entry'(G,M,_GoalNo) :- '$creep_is_on_at_entry'(G,M,_GoalNo) :-
\+ '$system_predicate'(G,M), \+ '$is_system_predicate'(G,M),
'__NB_getval__'('$debug_state',state(Step, _GN, Spy,_), fail), '__NB_getval__'('$debug_state',state(Step, _GN, Spy,_), fail),
( (
Step \= zip Step \= zip

View File

@ -382,13 +382,13 @@ live :-
write_term(user_error,Answ,Opts). write_term(user_error,Answ,Opts).
'$another' :- '$another' :-
format(user_error,' ? ',[]),
'$clear_input'(user_input), '$clear_input'(user_input),
prompt1(' ? '),
get_code(user_input,C), get_code(user_input,C),
'$do_another'(C). '$do_another'(C).
'$do_another'(C) :- '$do_another'(C) :-
( C=:= ";" -> ( C=:= ";" ->
skip(user_input,10), skip(user_input,10),
% '$add_nl_outside_console', % '$add_nl_outside_console',
fail fail
@ -703,7 +703,7 @@ write_query_answer( Bindings ) :-
'$loop'(Stream,exo) :- '$loop'(Stream,exo) :-
prolog_flag(agc_margin,Old,0), prolog_flag(agc_margin,Old,0),
prompt1(': '), prompt(_,' '), prompt1(': '), prompt(_,'| '),
source_module(OldModule,OldModule), source_module(OldModule,OldModule),
repeat, repeat,
'$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error, '$system_catch'(dbload_from_stream(Stream, OldModule, exo), '$db_load', Error,
@ -712,7 +712,7 @@ write_query_answer( Bindings ) :-
!. !.
'$loop'(Stream,db) :- '$loop'(Stream,db) :-
prolog_flag(agc_margin,Old,0), prolog_flag(agc_margin,Old,0),
prompt1(': '), prompt(_,' '), prompt1(': '), prompt(_,'| '),
source_module(OldModule,OldModule), source_module(OldModule,OldModule),
repeat, repeat,
'$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, user:'$LoopError'(Error, db) '$system_catch'(dbload_from_stream(Stream, OldModule, db), '$db_load', Error, user:'$LoopError'(Error, db)
@ -1017,7 +1017,7 @@ log_event( String, Args ) :-
DBON = true DBON = true
-> ->
( (
'__NB_getval__'('$debug_state',state(_, _, _, _,on), fail), '__NB_getval__'('$debug_state',state( _, _, _,on), fail),
( (
var(LF) var(LF)
-> ->