1% ---------------------------------------------------------------------- 2% BEGIN LICENSE BLOCK 3% Version: CMPL 1.1 4% 5% The contents of this file are subject to the Cisco-style Mozilla Public 6% License Version 1.1 (the "License"); you may not use this file except 7% in compliance with the License. You may obtain a copy of the License 8% at www.eclipse-clp.org/license. 9% 10% Software distributed under the License is distributed on an "AS IS" 11% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 12% the License for the specific language governing rights and limitations 13% under the License. 14% 15% The Original Code is The ECLiPSe Constraint Logic Programming System. 16% The Initial Developer of the Original Code is Cisco Systems, Inc. 17% Portions created by the Initial Developer are 18% Copyright (C) 1995-2006 Cisco Systems, Inc. All Rights Reserved. 19% 20% Contributor(s): IC-Parc, Imperal College London 21% 22% END LICENSE BLOCK 23% 24% System: ECLiPSe Constraint Logic Programming System 25% Version: $Id: tracer.pl,v 1.3 2013/02/12 00:41:44 jschimpf Exp $ 26% ---------------------------------------------------------------------- 27 28% 29% ECLiPSe II debugger -- Port generation, part of module(sepia_kernel) 30% 31% $Id: tracer.pl,v 1.3 2013/02/12 00:41:44 jschimpf Exp $ 32% 33% Author: Joachim Schimpf, IC-Parc 34% 35 36/* 37ECLiPSe II debugger 38 39The engine notifies the debugger only at the following points: 40 41 call(OldStack, NewStack) 42 wake(OldStack, NewStack) 43 exit(Stack) 44 redo(Stack, FailDrop, RedoLevel, Which, ShowNext) 45 delay(256, make_suspension(Goal,P,S,M)) 46 47These points are synchronous in the execution, so we can easily insert 48Prolog execution there. 49 50The handler then generates ports from notifications and calls port/2 51for each port. Note that because of the mismatch between notifications 52and ports, the artificial ports normally cannot be displayed with 53arguments because the engine is already in a different state (e.g 54FAIL REDO). 55 56Ports are filtered with of_interest/5 and pre-filtered on engine level: 57 58 ==invoc && minlevel=<level=<maxlevel && 59 ( (SPIED|TRACEABLE & tracemode) || tracemode=leap && at_breakpoint) 60tracemode,invoc,minlevel,maxlevel can be set via 61trace_mode/2. 62 63*/ 64 65:- pragma(nodebug). 66:- pragma(noskip). 67 68:- export 69 struct(ports(call,exit,'*exit',redo,fail, % enum, really 70 resume,leave,delay,next,unify,spyterm,modify,else)), 71 % tf must correspond to definition in emu_export.h! 72 struct(tf(invoc,goal,depth,chp,parent,proc,prio,path,line,from,to,module)), 73 struct(trace_line(port,frame)). 74 75:- export 76 spy_var/1, 77 spy_term/2. 78 79:- export 80 new_invoc/1, % in C 81 current_td/1, % in C 82 failure_culprit/2, % in C 83 monitor_term/4, 84 trace_mode/2, 85 find_goal/3, 86 get_tf_prop/3, 87 debug_port_names/1, 88 configure_prefilter/5. 89 90%diagnostics(N) :- nl, writeln(N). 91diagnostics(_). 92 93%---------------------------------------------------------------------- 94% Port generation from notifications 95%---------------------------------------------------------------------- 96 97% Call and resume notification handler 98 99ncall(OldStack, NewStack) :- 100 call_or_wake(OldStack, NewStack, call of ports). 101 102resume(OldStack, NewStack) :- 103 call_or_wake(OldStack, NewStack, resume of ports). 104 105 call_or_wake(OldStack, NewStack, Port) :- 106 disable_tracing, 107 get_priority(P), % Don't wake anything 108 set_priority(1), 109 diagnostics(ncall(NewStack, OldStack)), 110 CurrentB = chp(_), 111 timestamp_update(CurrentB, 1), 112 113 ( NewStack = tf{parent:Parent} -> % call port 114 ( OldStack == Parent -> 115 raise_init_event % if necessary 116 ; 117 trace_exit(OldStack, CurrentB) 118 ), 119 port(Port, NewStack) 120 ; % exit port 121 trace_exit(OldStack, CurrentB) 122 ), 123 diagnostics(ncall-done), 124 !, set_priority(P), cont_debug. 125 126 127% Exit notification handler 128 129nexit(Stack) :- 130 disable_tracing, 131 get_priority(P), % Don't wake anything 132 set_priority(1), 133 diagnostics(nexit(Stack)), 134 CurrentB = chp(_), 135 timestamp_update(CurrentB, 1), 136 137 trace_exit(Stack, CurrentB), 138 !, cont_debug, set_priority(P). 139 140 141 trace_exit(Frame, NewB) :- 142 ( timestamp_older(Frame, chp of tf, NewB, 1) -> 143 port('*exit' of ports, Frame) 144 ; 145 port(exit of ports, Frame) 146 ). 147 148 149% Redo notification handler, called after the failure happened. 150% Stack: the current (restored) stack after the failure 151% FailDrop: how many levels failed (use get_fail_info/2 to get details) 152% RedoLevel: at which level the failure was caught, ie the youngest 153% common ancestor of the failed and the redone goal. 154% FailLeave: fail port or leave port 155% ShowNext: 1 if the predicate with the choice point is debuggable, 156% which means that the NEXT-port should be shown. 157 158redo(Stack, FailDrop, RedoLevel, FailLeave, ShowNext) :- 159 disable_tracing, 160 get_priority(P), % Don't wake anything 161 set_priority(1), 162 diagnostics(redo(Stack, FailDrop, RedoLevel, FailLeave, ShowNext)), 163 trace_fails_redos(Stack, RedoLevel, FailDrop, ShowNext, FailLeave), 164 !, set_priority(P), cont_debug, 165 % FAIL port: fail for correct state restoration from choicepoint 166 % LEAVE port: succeed for state restoration from aux. environment 167 FailLeave == (leave of ports). 168 169 170trace_fails_redos(0, RedoLevel, FailDrop, _ShowNext, FailLeave) :- 171 trace_failures(FailDrop, RedoLevel, 0, FailLeave). 172trace_fails_redos(Current, RedoLevel, FailDrop, ShowNext, FailLeave) :- 173 Current = tf{depth:Depth}, 174 ( Depth > RedoLevel -> 175 trace_fails_redos1(Current, RedoLevel, FailDrop) 176 ; Depth = RedoLevel -> 177 trace_failures(FailDrop, RedoLevel, Current, FailLeave), 178 ( ShowNext == 0 -> true ; port(ShowNext, Current) ) 179 ; 180 trace_failures(FailDrop, RedoLevel, Current, FailLeave) 181 ). 182 183 trace_fails_redos1(0, _RedoLevel, _FailDrop). 184 trace_fails_redos1(Current, RedoLevel, FailDrop) :- 185 Current = tf{depth:Depth,parent:Parent}, 186 ( Depth > RedoLevel -> 187 trace_fails_redos1(Parent, RedoLevel, FailDrop), 188 port(redo of ports, Current) 189 ; % Depth = RedoLevel 190 trace_failures(FailDrop, RedoLevel, Current, fail of ports) 191 ). 192 193 trace_failures(0, _Depth, _Stack, _FailLeave) :- !. 194 trace_failures(I, Depth, Stack, FailLeave) :- 195 I1 is I-1, 196 Depth1 is Depth+1, 197 get_fail_info(I1, FakeStack), 198 ( FakeStack \== [] -> 199 % get_fail_info/2 does not fill in depth and parent 200 FakeStack = tf{depth:Depth1,parent:Stack}, 201 trace_failures(I1, Depth1, FakeStack, FailLeave), 202 port(FailLeave, FakeStack) 203 ; % fail info not recorded, ignore 204 trace_failures(I1, Depth1, Stack, FailLeave) 205 ). 206 207 208 209 210% Delay notification handler for make_suspension/3,4 211% This is currently a bit funny, because it is implemented as an 212% error handler for make_suspension/4, and it is raised after the 213% suspension has been created, but before it has been unified with S. 214% That's why the latter has to be done here in the handler. 215 216ndelay(_, MakeSuspension) :- 217 disable_tracing, 218 get_priority(P), % Don't wake anything 219 set_priority(1), 220 current_td(Parent), 221 extract_suspension(MakeSuspension, S), 222 last_suspension(S), % unify S 223 diagnostics(ndelay(MakeSuspension)), 224 Parent = tf{depth:D}, 225 D1 is D+1, 226 trace_delays(Parent, D1, [S]), 227 !, set_priority(P), cont_debug. 228 229 extract_suspension(make_suspension(_,_,S), S). 230 extract_suspension(make_suspension(_,_,S,_), S). 231 232 233% Delay notification handler for suspensions created inside externals. 234% It is the external predicate's responsibility to raise the DEBUG_SUSP_EVENT 235% if any of the suspensions created within it need to be traced. 236 237bip_delay :- 238 disable_tracing, 239 get_priority(P), % Don't wake anything 240 set_priority(1), 241 delay_port_susps(Susps), % get a list of new, traceable suspensions 242 diagnostics(bip_delay(Susps)), 243 current_td(Parent), 244 Parent = tf{depth:D}, 245 D1 is D+1, 246 trace_delays(Parent, D1, Susps), 247 !, set_priority(P), cont_debug. 248 249 trace_delays(_, _, []). 250 trace_delays(Parent, Depth, [S|Susps]) :- 251 susp_to_tf(S, Stack), 252 Stack = tf{depth:Depth,parent:Parent}, 253 port((delay) of ports, Stack), 254 trace_delays(Parent, Depth, Susps). 255 256:- set_flag(bip_delay/0, invisible, on). 257 258 259% Tracing of inline-compiled builtins like +/3, arg/3, =/2, ... 260% Done via exception-events raised by the debug_call_simple and 261% debug_exit_simple instructions. 262% These handlers are executed under priority 1 because of exception mechanism. 263 264:- export bip_call/0. 265:- set_flag(bip_call/0, invisible, on). 266bip_call :- 267 % CALL port, frame already pushed 268 % If we had the OldStack, we'd call ncall(OldStack,TD) 269 current_td(TD), 270 ( TD = tf{parent:Parent} -> % call port 271 ncall(Parent,TD) 272 ; 273 writeln(error, "Illegal state in bip_call handler - ignored"), 274 cont_debug 275 ). 276 277:- export bip_exit/0. 278:- set_flag(bip_exit/0, invisible, on). 279bip_exit :- 280 disable_tracing, 281 current_td(Stack), 282 port(exit of ports, Stack), 283 pop_tf, 284 cont_debug. 285 286/* might be needed if we re-introduce shallow choicepoints 287bip_fail :- 288 disable_tracing, 289 current_td(Stack), 290 port(fail of ports, Stack), 291 pop_tf, 292 !, 293 cont_debug. 294*/ 295 296 297% Builtins for generating user-defined debugger ports 298 299:- export trace_call_port/3. 300:- tool(trace_call_port/3, trace_call_port/4). 301:- set_flag(trace_call_port/3, invisible, on). 302:- set_flag(trace_call_port/4, invisible, on). 303trace_call_port(Port, Invoc, Goal0, M) :- 304 ( integer(Invoc) ; var(Invoc) ), !, 305 ( tracing -> 306 disable_tracing, 307 get_priority(P), % Don't wake anything 308 set_priority(1), 309 lookup_module(Goal0, M, Goal, LM), 310 make_tf(1, Invoc, Goal, M, LM, P, Stack), % push frame 311 port_name_to_number(Port, PortNr), 312 port(PortNr, Stack), 313 !, 314 set_priority(P), 315 cont_debug 316 ; 317 true 318 ). 319 320 :- mode lookup_module(+,+,-,-). 321 lookup_module(LM0:G0, _, G, LM) ?- G = G0, LM = LM0. 322 lookup_module(G, M, G, M). 323 324:- export trace_point_port/3. 325:- tool(trace_point_port/3, trace_point_port/4). 326:- set_flag(trace_point_port/3, invisible, on). 327:- set_flag(trace_point_port/4, invisible, on). 328trace_point_port(Port, Invoc, Goal0, M) :- 329 ( integer(Invoc) ; var(Invoc) ), !, 330 ( tracing -> 331 trace_point_port_unchecked(Port, Invoc, Goal0, M) 332 ; 333 true 334 ). 335 336trace_point_port_unchecked(Port, Invoc, Goal0, M) :- 337 disable_tracing, 338 get_priority(P), % Don't wake anything 339 set_priority(1), 340 lookup_module(Goal0, M, Goal, LM), 341 make_tf(0, Invoc, Goal, M, LM, P, Stack), % temporary frame 342 port_name_to_number(Port, PortNr), 343 port(PortNr, Stack), 344 !, 345 set_priority(P), 346 cont_debug. 347 348:- export trace_exit_port/0. 349:- set_flag(trace_exit_port/0, invisible, on). 350trace_exit_port :- 351 ( tracing -> 352 disable_tracing, 353 get_priority(P), % Don't wake anything 354 set_priority(1), 355 current_td(Stack), 356 ( Stack = tf{} -> 357 CurrentB = chp(_), 358 timestamp_update(CurrentB, 1), 359 trace_exit(Stack, CurrentB), 360 pop_tf 361 ; 362 true % no parent to exit 363 ), 364 !, 365 set_priority(P), 366 cont_debug 367 ; 368 true 369 ). 370 371:- export trace_parent_port/1. 372:- set_flag(trace_parent_port/1, invisible, on). 373trace_parent_port(Port) :- 374 ( tracing -> 375 disable_tracing, 376 get_priority(P), % Don't wake anything 377 set_priority(1), 378 current_td(Stack), % use parent frame 379 ( Stack = tf{} -> 380 port_name_to_number(Port, PortNr), 381 port(PortNr, Stack) 382 ; 383 true % no parent 384 ), 385 !, 386 set_priority(P), 387 cont_debug 388 ; 389 true 390 ). 391 392 393% A simple term-spy implementation 394 395:- tool(spy_var/1, spy_var/2). 396:- set_flag(spy_var/1, invisible, on). 397:- set_flag(spy_var/2, invisible, on). 398spy_var(Var, M) :- 399 ( tracing -> 400 spy_term(Var, Var->constrained, M) 401 ; 402 true 403 ). 404 405 406:- tool(spy_term/2, spy_term/3). 407:- set_flag(spy_term/2, invisible, on). 408:- set_flag(spy_term/3, invisible, on). 409spy_term(Term, Cond, Module) :- 410 ( tracing -> 411 disable_tracing, 412 suspend(monitor_term(I, Term, Module, Susp), 1, Cond, Susp), 413 trace_point_port_unchecked(spyterm, I, Term, Module) 414 ; 415 true 416 ). 417 418:- demon monitor_term/4. 419:- set_flag(monitor_term/4, invisible, on). 420monitor_term(Invoc, Term, Module, Susp) :- 421 ( nonground(Term) -> true ; kill_suspension(Susp) ), 422 trace_point_port_unchecked(modify, Invoc, Term, Module). 423%monitor_term(Invoc, Term, Module, _Susp) :- 424% trace_point_port_unchecked(unmod, Invoc, Term, Module), 425% fail. 426 427 428%---------------------------------------------------------------------- 429% Port filtering 430% PortNr can be an integer (index of a built-in port) or an atom 431%---------------------------------------------------------------------- 432 433port(PortNr, Stack) :- 434 Stack = tf{invoc:Invoc,depth:Depth,proc:Proc}, 435 get_tf_prop(Stack, break, BrkPt), 436% diagnostics( of_interest(PortNr, Invoc, Depth, Proc, BrkPt)), 437 ( of_interest(PortNr, Invoc, Depth, Proc, BrkPt) -> 438 port_name(PortNr, Port), 439 Current = trace_line{port:Port,frame:Stack}, 440 % This handler is allowed to cut_to, fail and abort 441 error(252, Current) % trace line event 442 ; 443% diagnostics(no_interest), 444 true 445 ). 446 447 448configure_prefilter(Invoc, Depth, Ports, Preds, Module) :- 449 decode_range(Invoc, MinInvoc, MaxInvoc), 450 decode_range(Depth, MinDepth, MaxDepth), 451 port_spec_to_mask(Ports, 0, PortMask), 452 diagnostics(portMask=PortMask), 453% nospy(_), 454 ( Preds == spied -> LeapFlag = 1 455 ; Preds == all -> LeapFlag = 0 456 ; set_spypoints(Preds, Module, LeapFlag) 457 ), 458 !, 459 trace_mode(6, MinDepth), 460 trace_mode(7, MaxDepth), 461 trace_mode(8, MinInvoc), 462 trace_mode(9, MaxInvoc), 463 trace_mode(5, PortMask), 464 trace_mode(11, LeapFlag). 465configure_prefilter(Invoc, Depth, Ports, Preds, Module) :- 466 error(6, configure_prefilter(Invoc, Depth, Ports, Preds, Module)). 467 468 decode_range(N, 0, Max) :- var(N), !, maxint(Max). 469 decode_range(N, N, N) :- integer(N). 470 decode_range(=(N), N, N). 471 decode_range(..(Min,Max), Min, Max). 472 decode_range(Min-Max, Min, Max). 473 decode_range(>(L), Min, Max) :- Min is L+1, maxint(Max). 474 decode_range(<(H), 0, Max) :- Max is H-1. 475 decode_range(=<(Max), 0, Max). 476 decode_range(>=(Min), Min, Max) :- maxint(Max). 477 478 :- mode port_spec_to_mask(?, +, -). 479 port_spec_to_mask(Var, Mask0, Mask) :- var(Var), !, 480 Mask is Mask0 \/ any_port_mask. 481 port_spec_to_mask([], Mask, Mask) :- !. 482 port_spec_to_mask(List, Mask0, Mask) :- List = [_|_], 483 port_list_to_mask(List, Mask0, Mask). 484 port_spec_to_mask(~Ps, Mask0, Mask) :- 485 Mask is Mask0 \/ any_port_mask /\ \port_spec_to_mask(Ps, 0). 486 port_spec_to_mask(P, Mask0, Mask) :- atom(P), 487 Mask is Mask0 \/ port_name_to_mask_bit(P). 488 489 :- mode port_list_to_mask(?, +, -). 490 port_list_to_mask([], Mask, Mask). 491 port_list_to_mask([P|Ps], Mask0, Mask) :- 492 atom(P), 493 Mask1 is Mask0 \/ port_name_to_mask_bit(P), 494 port_list_to_mask(Ps, Mask1, Mask). 495 496 :- mode set_spypoints(?, +, -). 497 set_spypoints(Var, _Module, 0) :- var(Var), !. 498 set_spypoints([], _Module, 0) :- !. 499 set_spypoints([P|Ps], Module, 1) :- !, 500 set_spypoint(P, Module), 501 set_spypoints(Ps, Module, _). 502 set_spypoints(P, Module, 1) :- 503 set_spypoint(P, Module). 504 505 set_spypoint(Module:N/A, _) ?- 506 spy(N/A)@Module. 507 set_spypoint(N/A, Module) ?- 508 spy(N/A)@Module. 509 510 511%---------------------------------------------------------------------- 512% Auxiliary 513%---------------------------------------------------------------------- 514 515port_name(I, Name) :- 516 integer(I), 517 arg(I, ports{ 518 call:call, 519 exit:exit, 520 '*exit':'*exit', 521 redo:redo, 522 fail:fail, 523 resume:resume, 524 leave:leave, 525 (delay):(delay), 526 next:next, 527 unify:unify, 528 spyterm:spyterm, 529 modify:modify, 530 else:else}, 531 Name). 532port_name(I, Name) :- 533 atom(I), I = Name. 534 535:- mode debug_port_names(-). 536debug_port_names(Names) :- 537 Names = [call, 538 exit, 539 '*exit', 540 redo, 541 fail, 542 resume, 543 leave, 544 (delay), 545 next, 546 unify, 547 spyterm, 548 modify, 549 else]. 550 551any_port_mask(2'1111111111111111). 552 553:- mode port_name_to_mask_bit(+,-). 554port_name_to_mask_bit(call, 2'0000000000000001) :- !. 555port_name_to_mask_bit(exit, 2'0000000000000010) :- !. 556port_name_to_mask_bit('*exit', 2'0000000000000100) :- !. 557port_name_to_mask_bit(redo, 2'0000000000001000) :- !. 558port_name_to_mask_bit(fail, 2'0000000000010000) :- !. 559port_name_to_mask_bit(resume, 2'0000000000100000) :- !. 560port_name_to_mask_bit(leave, 2'0000000001000000) :- !. 561port_name_to_mask_bit((delay), 2'0000000010000000) :- !. 562port_name_to_mask_bit(next, 2'0000000100000000) :- !. 563port_name_to_mask_bit(unify, 2'0000001000000000) :- !. 564port_name_to_mask_bit(spyterm, 2'0000010000000000) :- !. 565port_name_to_mask_bit(modify, 2'0000100000000000) :- !. 566port_name_to_mask_bit(else, 2'0001000000000000) :- !. 567port_name_to_mask_bit(_other, 2'1000000000000000). 568 569:- mode port_name_to_number(+,-). 570port_name_to_number(call, 1) :- !. 571port_name_to_number(exit, 2) :- !. 572port_name_to_number('*exit', 3) :- !. 573port_name_to_number(redo, 4) :- !. 574port_name_to_number(fail, 5) :- !. 575port_name_to_number(resume, 6) :- !. 576port_name_to_number(leave, 7) :- !. 577port_name_to_number((delay), 8) :- !. 578port_name_to_number(next, 9) :- !. 579port_name_to_number(unify, 10) :- !. 580port_name_to_number(spyterm, 11) :- !. 581port_name_to_number(modify, 12) :- !. 582port_name_to_number(else, 13) :- !. 583port_name_to_number(Other, Other). 584 585 586find_goal(Invoc, Stack, Frame) :- 587 find_ancestor(Invoc, Stack, Frame), !. 588find_goal(Invoc, _Stack, Frame) :- 589 suspensions(Susps), 590 find_susp_with_invoc(Invoc, Susps, Frame). 591 592 find_ancestor(Invoc, Frame, Found) :- 593 Frame = tf{invoc:I,parent:Parent}, % may fail 594 ( I =:= Invoc -> 595 Frame = Found 596 ; 597 find_ancestor(Invoc, Parent, Found) 598 ). 599 600 find_susp_with_invoc(Invoc, [S|Susps], Frame) :- 601 ( get_suspension_data(S, invoc, Invoc) -> 602 susp_to_tf(S, Frame), 603 Frame = tf{depth:0,parent:0} 604 ; 605 find_susp_with_invoc(Invoc, Susps, Frame) 606 ). 607 608 609%---------------------------------------------------------------------- 610% Settings 611%---------------------------------------------------------------------- 612 613:- set_default_error_handler(253, ncall/2), reset_error_handler(253). 614:- set_default_error_handler(254, nexit/1), reset_error_handler(254). 615:- set_default_error_handler(255, redo/5), reset_error_handler(255). 616:- set_default_error_handler(256, ndelay/2), reset_error_handler(256). 617:- set_default_error_handler(257, resume/2), reset_error_handler(257). 618:- set_default_error_handler(258, bip_call/0), reset_error_handler(258). 619:- set_default_error_handler(259, bip_exit/0), reset_error_handler(259). 620%:- set_default_error_handler(251, bip_fail/0), reset_error_handler(251). 621:- set_default_error_handler(249, bip_delay/0), reset_error_handler(249). 622 623