1/************************************************************************* 2* * 3* YAP Prolog * 4* * 5* Yap Prolog was developed at NCCUP - Universidade do Porto * 6* * 7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * 8* * 9************************************************************************** 10* * 11* File: debug.pl * 12* Last rev: * 13* mods: * 14* comments: YAP's debugger * 15* * 16*************************************************************************/ 17 18/*----------------------------------------------------------------------------- 19 20 Debugging / creating spy points 21 22-----------------------------------------------------------------------------*/ 23 24:- op(900,fx,[spy,nospy]). 25 26 27% First part : setting and reseting spy points 28 29% $suspy does most of the work 30'$suspy'(V,S,M) :- var(V) , !, 31 '$do_error'(instantiation_error,M:spy(V,S)). 32'$suspy'((M:S),P,_) :- !, 33 '$suspy'(S,P,M). 34'$suspy'([],_,_) :- !. 35'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ). 36'$suspy'(F/N,S,M) :- !, 37 functor(T,F,N), 38 '$do_suspy'(S, F, N, T, M). 39'$suspy'(A,S,M) :- atom(A), !, 40 '$suspy_predicates_by_name'(A,S,M). 41'$suspy'(P,spy,M) :- !, 42 '$do_error'(domain_error(predicate_spec,P),spy(M:P)). 43'$suspy'(P,nospy,M) :- 44 '$do_error'(domain_error(predicate_spec,P),nospy(M:P)). 45 46'$suspy_predicates_by_name'(A,S,M) :- 47 % just check one such predicate exists 48 ( 49 current_predicate(A,M:_) 50 -> 51 M = EM, 52 A = NA 53 ; 54 recorded('$import','$import'(EM,M,GA,_,A,_),_), 55 functor(GA,NA,_) 56 ), 57 !, 58 '$do_suspy_predicates_by_name'(NA,S,EM). 59'$suspy_predicates_by_name'(A,spy,M) :- !, 60 print_message(warning,no_match(spy(M:A))). 61'$suspy_predicates_by_name'(A,nospy,M) :- 62 print_message(warning,no_match(nospy(M:A))). 63 64'$do_suspy_predicates_by_name'(A,S,M) :- 65 current_predicate(A,M:T), 66 functor(T,A,N), 67 '$do_suspy'(S, A, N, T, M). 68'$do_suspy_predicates_by_name'(A, S, M) :- 69 recorded('$import','$import'(EM,M,T0,_,A,N),_), 70 functor(T0,A0,N0), 71 '$do_suspy'(S, A0, N0, T, EM). 72 73 74% 75% protect against evil arguments. 76% 77'$do_suspy'(S, F, N, T, M) :- 78 recorded('$import','$import'(EM,M,T0,_,F,N),_), !, 79 functor(T0, F0, N0), 80 '$do_suspy'(S, F0, N0, T, EM). 81'$do_suspy'(S, F, N, T, M) :- 82 '$undefined'(T,M), !, 83 ( S = spy -> 84 print_message(warning,no_match(spy(M:F/N))) 85 ; 86 print_message(warning,no_match(nospy(M:F/N))) 87 ). 88'$do_suspy'(S, F, N, T, M) :- 89 '$system_predicate'(T,M), 90 '$flags'(T,M,F,F), 91 F /\ 0x118dd080 =\= 0, 92 ( S = spy -> 93 '$do_error'(permission_error(access,private_procedure,T),spy(M:F/N)) 94 ; 95 '$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N)) 96 ). 97'$do_suspy'(S, F, N, T, M) :- 98 '$undefined'(T,M), !, 99 ( S = spy -> 100 print_message(warning,no_match(spy(M:F/N))) 101 ; 102 print_message(warning,no_match(nospy(M:F/N))) 103 ). 104'$do_suspy'(S,F,N,T,M) :- 105 '$suspy2'(S,F,N,T,M). 106 107'$suspy2'(spy,F,N,T,M) :- 108 recorded('$spy','$spy'(T,M),_), !, 109 print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)). 110'$suspy2'(spy,F,N,T,M) :- !, 111 recorda('$spy','$spy'(T,M),_), 112 '$set_spy'(T,M), 113 print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)). 114'$suspy2'(nospy,F,N,T,M) :- 115 recorded('$spy','$spy'(T,M),R), !, 116 erase(R), 117 '$rm_spy'(T,M), 118 print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)). 119'$suspy2'(nospy,F,N,_,M) :- 120 print_message(informational,breakp(no,breakpoint_for,M:F/N)). 121 122'$pred_being_spied'(G, M) :- 123 recorded('$spy','$spy'(G,M),_), !. 124 125spy Spec :- 126 '$notrace'(prolog:debug_action_hook(spy(Spec))), !. 127spy L :- 128 '$current_module'(M), 129 '$suspy'(L, spy, M), fail. 130spy _ :- debug. 131 132nospy Spec :- 133 '$notrace'(prolog:debug_action_hook(nospy(Spec))), !. 134nospy L :- 135 '$current_module'(M), 136 '$suspy'(L, nospy, M), fail. 137nospy _. 138 139nospyall :- 140 '$notrace'(prolog:debug_action_hook(nospyall)), !. 141nospyall :- 142 recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail. 143nospyall. 144 145% debug mode -> debug flag = 1 146 147debug :- 148 ( nb_getval('$spy_gn',L) -> true ; nb_setval('$spy_gn',1) ), 149 '$start_debugging'(on), 150 print_message(informational,debug(debug)). 151 152'$start_debugging'(Mode) :- 153 (Mode == on -> 154 '$debug_on'(true) 155 ; 156 '$debug_on'(false) 157 ), 158 nb_setval('$debug_run',off), 159 nb_setval('$debug_jump',false). 160 161nodebug :- 162 '$debug_on'(false), 163 nb_setval('$trace',off), 164 print_message(informational,debug(off)). 165 166 % 167 % remove any debugging info after an abort. 168 % 169 170trace :- 171 nb_getval('$trace',on), !. 172trace :- 173 nb_setval('$trace',on), 174 '$start_debugging'(on), 175 print_message(informational,debug(trace)), 176 '$creep'. 177 178notrace :- 179 nodebug. 180 181/*----------------------------------------------------------------------------- 182 183 leash 184 185-----------------------------------------------------------------------------*/ 186 187 188leash(X) :- var(X), 189 '$do_error'(instantiation_error,leash(X)). 190leash(X) :- 191 '$leashcode'(X,Code), 192 set_value('$leash',Code), 193 '$show_leash'(informational,Code), !. 194leash(X) :- 195 '$do_error'(type_error(leash_mode,X),leash(X)). 196 197'$show_leash'(Msg,0) :- 198 print_message(Msg,leash([])). 199'$show_leash'(Msg,Code) :- 200 '$check_leash_bit'(Code,0x8,L3,call,LF), 201 '$check_leash_bit'(Code,0x4,L2,exit,L3), 202 '$check_leash_bit'(Code,0x2,L1,redo,L2), 203 '$check_leash_bit'(Code,0x1,[],fail,L1), 204 print_message(Msg,leash(LF)). 205 206'$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !. 207'$check_leash_bit'(_,_,L0,Name,[Name|L0]). 208 209'$leashcode'(full,0xf) :- !. 210'$leashcode'(on,0xf) :- !. 211'$leashcode'(half,0xb) :- !. 212'$leashcode'(loose,0x8) :- !. 213'$leashcode'(off,0x0) :- !. 214'$leashcode'(none,0x0) :- !. 215%'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code). 216'$leashcode'([L|M],Code) :- !, 217 '$list2Code'([L|M],Code). 218'$leashcode'(N,N) :- integer(N), N >= 0, N =< 0xf. 219 220'$list2Code'(V,_) :- var(V), !, 221 '$do_error'(instantiation_error,leash(V)). 222'$list2Code'([],0) :- !. 223'$list2Code'([V|L],_) :- var(V), !, 224 '$do_error'(instantiation_error,leash([V|L])). 225'$list2Code'([call|L],N) :- '$list2Code'(L,N1), N is 0x8 + N1. 226'$list2Code'([exit|L],N) :- '$list2Code'(L,N1), N is 0x4 + N1. 227'$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 0x2 + N1. 228'$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 0x1 + N1. 229 230/*----------------------------------------------------------------------------- 231 232 debugging 233 234-----------------------------------------------------------------------------*/ 235 236 237debugging :- 238 prolog:debug_action_hook(nospyall), !. 239debugging :- 240 ( '$debug_on'(true) -> 241 print_message(help,debug(debug)) 242 ; 243 print_message(help,debug(off)) 244 ), 245 findall(M:(N/A),(recorded('$spy','$spy'(T,M),_),functor(T,N,A)),L), 246 print_message(help,breakpoints(L)), 247 get_value('$leash',Leash), 248 '$show_leash'(help,Leash). 249 250/*----------------------------------------------------------------------------- 251 252 spy 253 254-----------------------------------------------------------------------------*/ 255 256% ok, I may have a spy point for this goal, or not. 257% if I do, I should check what mode I am in. 258% Goal/Mode Have Spy Not Spied 259% Creep Stop Stop 260% Leap Stop Create CP 261% Skip Create CP Create CP 262% FastLeap Stop Ignore 263% FastIgnore Ignore Ignore 264 265 266% flag description initial possible values 267 268% spy_gn goal number 1 1... 269% spy_trace trace 0 0, 1 270% spy_skip leap off Num (stop level) 271% debug_prompt stop at spy points on on,off 272% a flip-flop is also used 273% when 1 spying is enabled *(the same as spy stop). 274 275 276%'$spy'(G) :- write(user_error,'$spy'(G)), nl, fail. 277% 278% handle suspended goals 279% take care with hidden goals. 280% 281% $spy may be called from user code, so be careful. 282'$spy'([Mod|G]) :- 283 '$debug_on'(F), F = false, !, 284 '$execute_nonstop'(G,Mod). 285'$spy'([Mod|G]) :- 286 nb_getval('$system_mode',on), !, 287 '$execute_nonstop'(G,Mod). 288'$spy'([Mod|G]) :- 289 CP is '$last_choice_pt', 290 '$do_spy'(G, Mod, CP, no). 291 292% last argument to do_spy says that we are at the end of a context. It 293% is required to know whether we are controlled by the debugger. 294'$do_spy'(V, M, CP, Flag) :- var(V), !, '$do_spy'(call(V), M, CP, Flag). 295'$do_spy'(!, _, CP, _) :- !, '$$cut_by'(CP). 296'$do_spy'('$cut_by'(M), _, _, _) :- !, '$$cut_by'(M). 297'$do_spy'(true, _, _, _) :- !. 298%'$do_spy'(fail, _, _, _) :- !, fail. 299'$do_spy'(M:G, _, CP, CalledFromDebugger) :- !, 300 '$do_spy'(G, M, CP, CalledFromDebugger). 301'$do_spy'((A,B), M, CP, CalledFromDebugger) :- !, 302 '$do_spy'(A, M, CP, yes), 303 '$do_spy'(B, M, CP, CalledFromDebugger). 304'$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !, 305 ( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) 306 ; 307 '$do_spy'(B, M, CP, CalledFromDebugger) 308 ). 309'$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !, 310 ( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) 311 ; 312 '$do_spy'(B, M, CP, CalledFromDebugger) 313 ). 314'$do_spy'((T->A), M, CP, _) :- !, 315 ( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes) ). 316'$do_spy'((A;B), M, CP, CalledFromDebugger) :- !, 317 ( 318 '$do_spy'(A, M, CP, yes) 319 ; 320 '$do_spy'(B, M, CP, CalledFromDebugger) 321 ). 322'$do_spy'((A|B), M, CP, CalledFromDebugger) :- !, 323 ( 324 '$do_spy'(A, M, CP, yes) 325 ; 326 '$do_spy'(B, M, CP, CalledFromDebugger) 327 ). 328'$do_spy'((\+G), M, CP, CalledFromDebugger) :- !, 329 \+ '$do_spy'(G, M, CP, CalledFromDebugger). 330'$do_spy'((not(G)), M, CP, CalledFromDebugger) :- !, 331 \+ '$do_spy'(G, M, CP, CalledFromDebugger). 332'$do_spy'(G, Module, _, CalledFromDebugger) :- 333 nb_getval('$spy_gn',L), /* get goal no. */ 334 L1 is L+1, /* bump it */ 335 nb_setval('$spy_gn',L1), /* and save it globaly */ 336 b_getval('$spy_glist',History), /* get goal list */ 337 b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]), /* and update it */ 338 '$loop_spy'(L, G, Module, CalledFromDebugger). /* set creep on */ 339 340% we are skipping, so we can just call the goal, 341% while leaving the minimal structure in place. 342'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) :- 343 yap_hacks:current_choice_point(CP), 344 '$system_catch'('$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP), 345 Module, error(Event,Context), 346 '$loop_spy_event'(error(Event,Context), GoalNumber, G, Module, CalledFromDebugger)). 347 348% handle weird things happening in the debugger. 349'$loop_spy_event'('$pass'(Event), _, _, _, _) :- !, 350 throw(Event). 351'$loop_spy_event'(error('$retry_spy'(G0),_), GoalNumber, G, Module, CalledFromDebugger) :- 352 G0 >= GoalNumber, !, 353 '$loop_spy'(GoalNumber, G, Module, CalledFromDebugger). 354'$loop_spy_event'(error('$retry_spy'(GoalNumber),_), _, _, _, _) :- !, 355 throw(error('$retry_spy'(GoalNumber),[])). 356'$loop_spy_event'(error('$fail_spy'(G0),_), GoalNumber, G, Module, CalledFromDebugger) :- 357 G0 >= GoalNumber, !, 358 '$loop_fail'(GoalNumber, G, Module, CalledFromDebugger). 359'$loop_spy_event'(error('$fail_spy'(GoalNumber),_), _, _, _, _) :- !, 360 throw(error('$fail_spy'(GoalNumber),[])). 361'$loop_spy_event'(error('$done_spy'(G0),_), GoalNumber, G, _, CalledFromDebugger) :- 362 G0 >= GoalNumber, !, 363 '$continue_debugging'(CalledFromDebugger). 364'$loop_spy_event'(error('$done_spy'(GoalNumber),_), _, _, _, _) :- !, 365 throw(error('$done_spy'(GoalNumber),[])). 366'$loop_spy_event'(Event, GoalNumber, G, Module, CalledFromDebugger) :- 367 '$debug_error'(Event), 368 '$system_catch'( 369 ('$trace'(exception(Event),G,Module,GoalNumber,_),fail), 370 Module, 371 error(NewEvent,NewContext), 372 '$loop_spy_event'(error(NewEvent,NewContext), GoalNumber, G, Module, CalledFromDebugger) 373 ). 374 375 376'$debug_error'(Event) :- 377 '$Error'(Event), fail. 378'$debug_error'(_). 379 380 381% just fail here, don't really need to call debugger, the user knows what he 382% wants to do 383'$loop_fail'(_GoalNumber, _G, _Module, _CalledFromDebugger) :- 384 '$continue_debugging'(CalledFromDebugger), 385 fail. 386 387% if we are in 388'$loop_spy2'(GoalNumber, G0, Module, CalledFromDebugger, CP) :- 389/* the following choice point is where the predicate is called */ 390 ( 391 '$is_metapredicate'(G0, Module) 392 -> 393 '$meta_expansion'(G0,Module,Module,Module,G,[]) 394 ; 395 G = G0 396 ), 397 b_getval('$spy_glist',[Info|_]), /* get goal list */ 398 Info = info(_,_,_,Retry,Det,false), 399 ( 400 /* call port */ 401 '$enter_goal'(GoalNumber, G, Module), 402 '$spycall'(G, Module, CalledFromDebugger, Retry), 403 '$disable_docreep', 404 ( 405 '$debugger_deterministic_goal'(G) -> 406 Det=true 407 ; 408 Det=false 409 ), 410 /* go execute the predicate */ 411 ( 412 Retry = false -> 413 /* found an answer, so it can redo */ 414 nb_setarg(6, Info, true), 415 '$show_trace'(exit,G,Module,GoalNumber,Det), /* output message at exit */ 416 /* exit port */ 417 /* get rid of deterministic computations */ 418 ( 419 Det == true 420 -> 421 '$$cut_by'(CP) 422 ; 423 true 424 ), 425 '$continue_debugging'(CalledFromDebugger) 426 ; 427 /* backtracking from exit */ 428 /* we get here when we want to redo a goal */ 429 /* redo port */ 430 '$disable_docreep', 431 ( 432 arg(6, Info, true) 433 -> 434 '$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */ 435 nb_setarg(6, Info, false) 436 ; 437 true 438 ), 439 '$continue_debugging'(CalledFromDebugger), 440 fail /* to backtrack to spycalls */ 441 ) 442 ; 443 '$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */ 444 '$continue_debugging'(CalledFromDebugger), 445 /* fail port */ 446 fail 447 ). 448 449'$enter_goal'(GoalNumber, G, Module) :- 450 '$zip'(GoalNumber, G, Module), !. 451'$enter_goal'(GoalNumber, G, Module) :- 452 '$trace'(call, G, Module, GoalNumber, _). 453 454'$show_trace'(_, G, Module, GoalNumber,_) :- 455 '$zip'(GoalNumber, G, Module), !. 456'$show_trace'(P,G,Module,GoalNumber,Deterministic) :- 457 '$trace'(P,G,Module,GoalNumber,Deterministic). 458 459% 460% skip a goal or a port 461% 462'$zip'(GoalNumber, G, Module) :- 463 nb_getval('$debug_run',StopPoint), 464 % zip mode off, we cannot zip 465 StopPoint \= off, 466 ( 467 % skip spy points (eg, s). 468 StopPoint == spy 469 -> 470 \+ '$pred_being_spied'(G, Module) 471 ; 472 % skip goals (eg, l). 473 number(StopPoint) 474 -> 475 StopPoint < GoalNumber 476 ). 477 478 479 480% 481'$spycall'(G, M, _, _) :- 482 nb_getval('$debug_jump',true), 483 !, 484 '$execute_nonstop'(G,M). 485'$spycall'(G, M, _, _) :- 486 '$system_predicate'(G,M), 487 \+ '$is_metapredicate'(G,M), !, 488 '$execute'(M:G). 489'$spycall'(G, M, _, _) :- 490 '$system_module'(M), !, 491 '$execute'(M:G). 492'$spycall'(G, M, _, _) :- 493 '$tabled_predicate'(G,M), 494 !, 495 '$continue_debugging'(no, '$execute_nonstop'(G,M)). 496'$spycall'(G, M, CalledFromDebugger, InRedo) :- 497 '$flags'(G,M,F,F), 498 F /\ 0x18402000 =\= 0, !, % dynamic procedure, logical semantics, user-C, or source 499 % use the interpreter 500 CP is '$last_choice_pt', 501 '$clause'(G, M, Cl, _), 502 % I may backtrack to here from far away 503 '$disable_docreep', 504 ( '$do_spy'(Cl, M, CP, CalledFromDebugger) ; InRedo = true ). 505'$spycall'(G, M, CalledFromDebugger, InRedo) :- 506 '$undefined'(G, M), !, 507 '$find_goal_definition'(M, G, NM, Goal), 508 '$spycall'(Goal, NM, CalledFromDebugger, InRedo). 509'$spycall'(G, M, _, InRedo) :- 510 % I lost control here. 511 CP is '$last_choice_pt', 512 '$static_clause'(G,M,_,R), 513 % I may backtrack to here from far away 514 '$disable_docreep', 515 ( 516 '$continue_debugging'(no, '$execute_clause'(G, M, R, CP)) 517 ; 518 InRedo = true 519 ). 520 521'$tabled_predicate'(G,M) :- 522 '$flags'(G,M,F,F), 523 F /\ 0x00000040 =\= 0. 524 525'$trace'(P,G,Module,L,Deterministic) :- 526 % at this point we are done with leap or skip 527 nb_setval('$debug_run',off), 528 % make sure we run this code outside debugging mode. 529 '$debug_on'(false), 530 repeat, 531 '$trace_msg'(P,G,Module,L,Deterministic), 532 ( 533 '$unleashed'(P) -> 534 '$action'(10,P,L,G,Module,Debug), 535 put_code(user_error, 10) 536 ; 537 write(user_error,' ? '), get0(user_input,C), 538 '$action'(C,P,L,G,Module,Debug) 539 ), 540 (Debug = on 541 -> 542 '$debug_on'(true) 543 ; 544 Debug = zip 545 -> 546 '$debug_on'(true) 547 ; 548 '$debug_on'(false) 549 ), 550 !. 551 552'$trace_msg'(P,G,Module,L,Deterministic) :- 553 flush_output(user_output), 554 flush_output(user_error), 555 functor(P,P0,_), 556 (P = exit, Deterministic \= true -> Det = '?' ; Det = ' '), 557 ('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '), 558% vsc: fix this 559 % ( SL = L -> SLL = '>' ; SLL = ' '), 560 SLL = ' ', 561 ( Module\=prolog, 562 Module\=user 563 -> 564 GW = Module:G 565 ; 566 GW = G 567 ), 568 format(user_error,'~a~a~a (~d) ~q:',[Det,CSPY,SLL,L,P0]), 569 '$debugger_write'(user_error,GW). 570 571'$unleashed'(call) :- get_value('$leash',L), L /\ 2'1000 =:= 0. %' 572'$unleashed'(exit) :- get_value('$leash',L), L /\ 2'0100 =:= 0. %' 573'$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. %' 574'$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %' 575% the same as fail. 576'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %' 577 578'$debugger_write'(Stream, G) :- 579 recorded('$print_options','$debugger'(OUT),_), !, 580 write_term(Stream, G, OUT). 581'$debugger_write'(Stream, G) :- 582 writeq(Stream, G). 583 584'$action'(13,P,CallNumber,G,Module,Zip) :- !, % newline creep 585 get0(user_input,C), 586 '$action'(C,P,CallNumber,G,Module,Zip). 587%'$action'(10,_,_,_,_,on) :- % newline creep 588% nb_setval('$debug_jump',false). 589'$action'(10,_,_,_,_,on) :- !, % newline creep 590 nb_setval('$debug_jump',false). 591'$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute 592 read(user,G), 593 % don't allow yourself to be caught by creep. 594 '$debug_on'(OldDeb), 595 '$debug_on'(false), 596 ( '$execute'(G) -> true ; true), 597 '$debug_on'(OldDeb), 598% '$skipeol'(0'!), % ' 599 fail. 600'$action'(0'<,_,_,_,_,_) :- !, % <'Depth 601 '$new_deb_depth', 602 '$skipeol'(0'<), 603 fail. 604'$action'(0'^,_,_,G,_,_) :- !, % ' 605 '$print_deb_sterm'(G), 606 '$skipeol'(0'^), 607 fail. 608'$action'(0'a,_,_,_,_,off) :- !, % 'a abort 609 '$skipeol'(0'a), 610 abort. 611'$action'(0'b,_,_,_,_,_) :- !, % 'b break 612 '$skipeol'(0'b), 613 break, 614 fail. 615'$action'(0'A,_,_,_,_,_) :- !, % 'b break 616 '$skipeol'(0'A), 617 '$show_choicepoint_stack', 618 fail. 619'$action'(0'c,_,_,_,_,on) :- !, % 'c creep 620 '$skipeol'(0'c), 621 nb_setval('$debug_jump',false). 622'$action'(0'e,_,_,_,_,_) :- !, % 'e exit 623 '$skipeol'(0'e), 624 halt. 625'$action'(0'f,_,CallId,_,_,_) :- !, % 'f fail 626 '$scan_number'(0'f, CallId, GoalId), %'f 627 throw(error('$fail_spy'(GoalId),[])). 628'$action'(0'h,_,_,_,_,_) :- !, % 'h help 629 '$action_help', 630 '$skipeol'(104), 631 fail. 632'$action'(0'?,_,_,_,_,_) :- !, % '? help 633 '$action_help', 634 '$skipeol'(104), 635 fail. 636'$action'(0'p,_,_,G,Module,_) :- !, % 'p print 637 ((Module = prolog ; Module = user) -> 638 print(user_error,G), nl(user_error) 639 ; 640 print(user_error,Module:G), nl(user_error) 641 ), 642 '$skipeol'(0'p), 643 fail. 644'$action'(0'd,_,_,G,Module,_) :- !, % 'd display 645 ((Module = prolog ; Module = user) -> 646 display(user_error,G), nl(user_error) 647 ; 648 display(user_error,Module:G), nl(user_error) 649 ), 650 '$skipeol'(0'd), 651 fail. 652'$action'(0'l,_,_,_,_,on) :- !, % 'l leap 653 '$skipeol'(0'l), 654 nb_setval('$debug_run',spy), 655 nb_setval('$debug_jump',false). 656'$action'(0'z,_,_,_,_,zip) :- !, % 'z zip, fast leap 657 '$skipeol'(0'z), % 'z 658 nb_setval('$debug_run',spy), 659 nb_setval('$debug_jump',true). 660 % skip first call (for current goal), 661 % stop next time. 662'$action'(0'k,_,_,_,_,zip) :- !, % 'k zip, fast leap 663 '$skipeol'(0'k), % ' 664 nb_setval('$debug_run',spy), 665 nb_setval('$debug_jump',true). 666 % skip first call (for current goal), 667 % stop next time. 668'$action'(0'n,_,_,_,_,off) :- !, % 'n nodebug 669 '$skipeol'(0'n), % ' 670 % tell debugger never to stop. 671 nb_setval('$debug_run', -1), 672 nb_setval('$debug_jump',true), 673 nodebug. 674'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry 675 '$scan_number'(0'r,CallId,ScanNumber), % ' 676 '$debug_on'(true), 677 throw(error('$retry_spy'(ScanNumber),[])). 678'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip 679 '$skipeol'(0's), % ' 680 ( (P=call; P=redo) -> 681 nb_setval('$debug_run',CallNumber), 682 nb_setval('$debug_jump',false) 683 ; 684 '$ilgl'(0's) % ' 685 ). 686'$action'(0't,P,CallNumber,_,_,zip) :- !, % 't fast skip 687 '$skipeol'(0't), % ' 688 ( (P=call; P=redo) -> 689 nb_setval('$debug_run',CallNumber), 690 nb_setval('$debug_jump',true) 691 ; 692 '$ilgl'(0't) % ' 693 ). 694'$action'(0'+,_,_,G,M,_) :- !, % '+ spy this 695 functor(G,F,N), spy(M:(F/N)), 696 '$skipeol'(0'+), % ' 697 fail. 698'$action'(0'-,_,_,G,M,_) :- !, % '- nospy this 699 functor(G,F,N), nospy(M:(F/N)), 700 '$skipeol'(0'-), % ' 701 fail. 702'$action'(0'g,_,_,_,_,_) :- !, % 'g ancestors 703 '$scan_number'(0'g,-1,HowMany), % ' 704 '$show_ancestors'(HowMany), 705 fail. 706'$action'(C,_,_,_,_,_) :- 707 '$skipeol'(C), 708 '$ilgl'(C), 709 fail. 710 711'$continue_debugging'(yes). 712% do not need to debug! 713'$continue_debugging'(no) :- 714 '$creep'. 715 716% if we are in the interpreter, don't need to care about forcing a trace, do we? 717'$continue_debugging'(yes,G) :- !, 718 '$execute_dgoal'(G). 719% do not need to debug! 720'$continue_debugging'(_,G) :- 721 'nb_getval'('$debug_run',Zip), 722 (Zip == nodebug ; number(Zip) ; Zip = spy(_) ), !, 723 '$execute_dgoal'(G). 724'$continue_debugging'(_,G) :- 725 '$execute_creep_dgoal'(G). 726 727'$execute_dgoal'('$execute_nonstop'(G,M)) :- 728 '$execute_nonstop'(G,M). 729'$execute_dgoal'('$execute_clause'(G, M, R, CP)) :- 730 '$execute_clause'(G, M, R, CP). 731 732'$execute_creep_dgoal'('$execute_nonstop'(G,M)) :- 733 '$signal_creep', 734 '$execute_nonstop'(G,M). 735'$execute_creep_dgoal'('$execute_clause'(G, M, R, CP)) :- 736 '$signal_creep', 737 '$execute_clause'(G, M, R, CP). 738 739'$show_ancestors'(HowMany) :- 740 b_getval('$spy_glist',[_|History]), 741 ( 742 History == [] 743 -> 744 print_message(help, ancestors([])) 745 ; 746 '$show_ancestors'(History,HowMany), 747 nl(user_error) 748 ). 749 750'$show_ancestors'([],_). 751'$show_ancestors'([_|_],0) :- !. 752'$show_ancestors'([info(L,M,G,Retry,Det,_Exited)|History],HowMany) :- 753 '$show_ancestor'(L,M,G,Retry,Det,HowMany,HowMany1), 754 '$show_ancestors'(History,HowMany1). 755 756% skip exit port, we're looking at true ancestors 757'$show_ancestor'(_,_,_,_,Det,HowMany,HowMany) :- 758 nonvar(Det), !. 759% look at retry 760'$show_ancestor'(GoalNumber, M, G, Retry, _, HowMany, HowMany1) :- 761 nonvar(Retry), !, 762 HowMany1 is HowMany-1, 763 '$trace_msg'(redo, G, M, GoalNumber, _), nl(user_error). 764'$show_ancestor'(GoalNumber, M, G, _, _, HowMany, HowMany1) :- 765 HowMany1 is HowMany-1, 766 '$trace_msg'(call, G, M, GoalNumber, _), nl(user_error). 767 768 769'$action_help' :- 770 format(user_error,'newline creep a abort~n', []), 771 format(user_error,'c creep e exit~n', []), 772 format(user_error,'f Goal fail h help~n', []), 773 format(user_error,'l leap r Goal retry~n', []), 774 format(user_error,'s skip t fastskip~n', []), 775 format(user_error,'q quasiskip k quasileap~n', []), 776 format(user_error,'b break n no debug~n', []), 777 format(user_error,'p print d display~n', []), 778 format(user_error,'<D depth D < full term~n', []), 779 format(user_error,'+ spy this - nospy this~n', []), 780 format(user_error,'^ view subg ^^ view using~n', []), 781 format(user_error,'A choices g [N] ancestors~n', []), 782 format(user_error,'! g execute goal~n', []). 783 784'$ilgl'(C) :- 785 print_message(warning, trace_command(C)), 786 print_message(help, trace_help), 787 fail. 788 789'$skipeol'(10) :- !. 790'$skipeol'(_) :- get0(user,C), '$skipeol'(C). 791 792'$scan_number'(_, _, Nb) :- 793 get0(user,C), 794 '$scan_number2'(C, Nb), !. 795'$scan_number'(_, CallId, CallId). 796 797'$scan_number2'(10, _) :- !, fail. 798'$scan_number2'(0' , Nb) :- !, % ' 799 get0(user,C), 800 '$scan_number2'(C , Nb). 801'$scan_number2'(0' , Nb) :- !, %' 802 get0(user,C), 803 '$scan_number2'(C, Nb). 804'$scan_number2'(C, Nb) :- 805 '$scan_number3'(C, 0, Nb). 806 807'$scan_number3'(10, Nb, Nb) :- !, Nb > 0. 808'$scan_number3'( C, Nb0, Nb) :- 809 C >= "0", C =< "9", 810 NbI is Nb0*10+(C-"0"), 811 get0(user, NC), 812 '$scan_number3'( NC, NbI, Nb). 813 814'$print_deb_sterm'(G) :- 815 '$get_sterm_list'(L), !, 816 '$deb_get_sterm_in_g'(L,G,A), 817 recorda('$debug_sub_skel',L,_), 818 format(user_error,'~n~w~n~n',[A]). 819'$print_deb_sterm'(_) :- '$skipeol'(94). 820 821'$get_sterm_list'(L) :- 822 get0(user_input,C), 823 '$deb_inc_in_sterm_oldie'(C,L0,CN), 824 '$get_sterm_list'(L0,CN,0,L). 825 826'$deb_inc_in_sterm_oldie'(94,L0,CN) :- !, 827 get0(user_input,CN), 828 ( recorded('$debug_sub_skel',L0,_) -> true ; 829 CN = [] ). 830'$deb_inc_in_sterm_oldie'(C,[],C). 831 832'$get_sterm_list'(L0,C,N,L) :- 833 ( C =:= "^", N =\= 0 -> get0(CN), 834 '$get_sterm_list'([N|L0],CN,0,L) ; 835 C >= "0", C =< "9" -> NN is 10*N+C-"0", get0(CN), 836 '$get_sterm_list'(L0,CN,NN,L); 837 C =:= 10 -> (N =:= 0 -> L = L0 ; L=[N|L0]) ). 838 839'$deb_get_sterm_in_g'([],G,G). 840'$deb_get_sterm_in_g'([H|T],G,A) :- 841 '$deb_get_sterm_in_g'(T,G,A1), 842 arg(H,A1,A). 843 844'$new_deb_depth' :- 845 get0(user_input,C), 846 '$get_deb_depth'(C,D), 847 '$set_deb_depth'(D). 848 849'$get_deb_depth'(10,10) :- !. % default depth is 0 850'$get_deb_depth'(C,XF) :- 851 '$get_deb_depth_char_by_char'(C,0,XF). 852 853'$get_deb_depth_char_by_char'(10,X,X) :- !. 854'$get_deb_depth_char_by_char'(C,X0,XF) :- 855 C >= "0", C =< "9", !, 856 XI is X0*10+C-"0", 857 get0(user_input,NC), 858 '$get_deb_depth_char_by_char'(NC,XI,XF). 859% reset when given garbage. 860'$get_deb_depth_char_by_char'(C,_,10) :- '$skipeol'(C). 861 862'$set_deb_depth'(D) :- 863 recorded('$print_options','$debugger'(L),R), !, 864 '$delete_if_there'(L, max_depth(_), LN), 865 erase(R), 866 recorda('$print_options','$debugger'([max_depth(D)|LN]),_). 867'$set_deb_depth'(D) :- 868 recorda('$print_options','$debugger'([quoted(true),numbervars(true),portrayed(true),max_depth(D)]),_). 869 870'$delete_if_there'([], _, []). 871'$delete_if_there'([T|L], T, LN) :- !, 872 '$delete_if_there'(L, T, LN). 873'$delete_if_there'([Q|L], T, [Q|LN]) :- 874 '$delete_if_there'(L, T, LN). 875 876'$show_choicepoint_stack' :- 877 yap_hacks:current_choicepoints(Cps), 878 length(Cps,Level), 879 '$debug_show_cps'(Cps,Level). 880 881'$debug_show_cps'([],_). 882'$debug_show_cps'([C|Cps],Level) :- 883 '$debug_show_cp'(C, Level), 884 Level1 is Level-1, 885 '$debug_show_cps'(Cps, Level1). 886 887'$debug_show_cp'(C, Level) :- 888 yap_hacks:choicepoint(C,_,Module,Name,Arity,Goal,_), 889 '$continue_debug_show_cp'(Module,Name,Arity,Goal,Level). 890 891'$continue_debug_show_cp'(prolog,'$do_live',0,(_;_),Level) :- !, 892 format(user_error,' [~d] \'$toplevel\'',[Level]). 893'$continue_debug_show_cp'(prolog,'$do_log_upd_clause',4,'$do_log_upd_clause'(_,_,Goal,_),Level) :- !, 894 format(user_error,' [~d] ',[Level]), 895 '$debugger_write'(user_error,Goal), 896 nl(user_error). 897'$continue_debug_show_cp'(prolog,'$do_static_clause',5,'$do_static_clause'(_,_,Goal,_,_),Level) :- !, 898 format(user_error,' [~d] ',[Level]), 899 '$debugger_write'(user_error,Goal), 900 nl(user_error). 901'$continue_debug_show_cp'(Module,Name,Arity,_,_) :- 902 functor(G0, Name, Arity), 903 '$hidden_predicate'(G0,Module), 904 !. 905'$continue_debug_show_cp'(Module,Name,Arity,Goal,Level) :- 906 var(Goal), !, 907 format(user_error,' [~d] ~q:~q/~d~n',[Level,Module,Name,Arity]). 908'$continue_debug_show_cp'(Module,Name,Arity,(V1;V2),Level) :- 909 var(V1), var(V2), !, 910 format(user_error,' [~d] ~q:~q/~d: ;/2~n',[Level,Module,Name,Arity]). 911'$continue_debug_show_cp'(_,_,_,G,Level) :- 912 format(user_error,' [~d] ~q~n',[Level,G]). 913 914'$debugger_deterministic_goal'(G) :- 915 yap_hacks:current_choicepoints(CPs0), 916% $cps(CPs0), 917 '$debugger_skip_traces'(CPs0,CPs1), 918 '$debugger_skip_loop_spy2'(CPs1,CPs2), 919 '$debugger_skip_spycall'(CPs2,CPs3), 920 '$debugger_skip_loop_spy2'(CPs3,[Catch|_]), 921 yap_hacks:choicepoint(Catch,_,prolog,'$catch',3,'$catch'(_,'$loop_spy_event'(_,_,G,_,_),_),_). 922 923 924'$cps'([CP|CPs]) :- 925 yap_hacks:choicepoint(CP,A,B,C,D,E,F), 926 write(A:B:C:D:E:F),nl, 927 '$cps'(CPs). 928'$cps'([]). 929 930 931'$debugger_skip_spycall'([CP|CPs],CPs1) :- 932 yap_hacks:choicepoint(CP,_,prolog,'$spycall',4,(_;_),_), !, 933 '$debugger_skip_spycall'(CPs,CPs1). 934'$debugger_skip_spycall'(CPs,CPs). 935 936'$debugger_skip_traces'([CP|CPs],CPs1) :- 937 yap_hacks:choicepoint(CP,_,prolog,'$trace',4,(_;_),_), !, 938 '$debugger_skip_traces'(CPs,CPs1). 939'$debugger_skip_traces'(CPs,CPs). 940 941'$debugger_skip_loop_spy2'([CP|CPs],CPs1) :- 942 yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !, 943 '$debugger_skip_loop_spy2'(CPs,CPs1). 944'$debugger_skip_loop_spy2'(CPs,CPs). 945 946 947 948