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) 1999-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_tty.pl,v 1.7 2009/07/16 09:11:24 jschimpf Exp $ 26% ---------------------------------------------------------------------- 27 28% 29% ECLiPSe II debugger -- TTY Interface 30% 31% $Id: tracer_tty.pl,v 1.7 2009/07/16 09:11:24 jschimpf Exp $ 32% 33% Authors: Joachim Schimpf, IC-Parc 34% Kish Shen, IC-Parc 35% 36 37:- module(tracer_tty). 38 39:- pragma(nodebug). 40:- pragma(system). 41 42%:- import struct(tf), struct(trace_line) from sepia_kernel. 43:- import sepia_kernel. 44 45:- local 46 struct(inspect(type,top,path,written,module,goalf)), 47 48 reference(exec_state), 49 50 variable(next_cmd), 51 variable(indent_step), 52 variable(dbg_format_string), 53 variable(dbg_goal_format_string), 54 variable(dbg_print_depth), 55 variable(show_module). 56 57:- export 58 print_trace_line/1. 59 60 61:- import 62 set_default_error_handler/2, 63 configure_prefilter/5, 64 trace_mode/2, 65 get_attribute/3, 66 get_tf_prop/3, 67 failure_culprit/2, 68 find_goal/3, 69 meta_attributes/1, 70 monitor_term/4, 71 new_invoc/1, 72 timestamp_older/4, 73 current_td/1, 74 cut_to_stamp/2 75 from sepia_kernel. 76 77:- lib(development_support). 78 79:- local break/0. 80 81%---------------------------------------------------------------------- 82% Tracer TTY interface 83%---------------------------------------------------------------------- 84 85 86% Make a separate file descriptor for the debugger input so that it 87% doesn't get mixed up with the standard input of the debugged program. 88:- ( get_stream_info(input, fd, FD) -> open(dup(FD), read, debug_input) 89 ; set_stream(debug_input, input) ). 90:- set_stream(debug_output, output). 91 92trace_start_handler_tty :- 93 clear_cmd. 94 95trace_line_handler_tty(_, Current) :- 96 setval(exec_state, Current), 97 print_trace_line(Current), 98 interact(Current, Cont), 99 call(Cont). % may cut_to/fail 100 101:- set_default_error_handler(250, trace_start_handler_tty/0), 102 reset_event_handler(250). 103:- set_default_error_handler(252, trace_line_handler_tty/2), 104 reset_event_handler(252). 105 106print_trace_line(trace_line{port:Port, frame:Frame}) :- 107 Frame = tf{invoc:Invoc,goal:Goal,depth:Depth,prio:Prio,module:M}, 108 !, 109 % print priority only if not the normal 12 110 (Prio == 12 -> PrioS = "" ; concat_string([<,Prio,>], PrioS)), 111 ( get_tf_prop(Frame, skip, on) -> Prop = 0'S ; Prop = 0' ), 112 ( get_tf_prop(Frame, break) =\= 0 -> Spied = 0'# 113 ; get_tf_prop(Frame, spy, on) -> Spied = 0'+ ; Spied = 0' ), 114 Indent is Depth*getval(indent_step), 115 printf(debug_output, "%c%c%*c(%d) %d %A%s ", 116 [Prop, Spied, Indent, 0' , Invoc, Depth, Port, PrioS]), 117 ( getval(show_module,on) -> MGoal = Goal@M ; MGoal = [Goal] ), 118 getval(dbg_goal_format_string, Format), 119 printf(debug_output, Format, MGoal)@M. 120print_trace_line(inspect{type:Type,module:M,written:[CurrentTerm|_],path:Pos}) :- 121 (Pos == [], Type == goal -> 122 getval(dbg_format_string, Format) 123 ; 124 getval(dbg_goal_format_string, Format) 125 ), 126 printf(debug_output, Format, [CurrentTerm])@M, 127 printf(debug_output, "%n INSPECT ", []), 128 print_current_summary(debug_output, CurrentTerm, M). 129 130 131print_suspensions([], _, _) :- 132 writeln(debug_output, "\n------------ end ------------"). 133print_suspensions([S|Ss], Kind, Prio) :- 134 ( get_suspension_data(S, state, Kind) -> 135 ( Prio = all -> 136 print_suspension(S) 137 ; get_suspension_data(S, priority, Prio) -> 138 print_suspension(S) 139 ; 140 true 141 ) 142 ; 143 true 144 ), 145 print_suspensions(Ss, Kind, Prio). 146 147 print_suspension(S) :- 148 get_suspension_data(S, goal, Goal), 149 get_suspension_data(S, module, M), 150 get_suspension_data(S, invoc, Invoc), 151 get_suspension_data(S, priority, Prio), 152 ( get_suspension_data(S, spy, on) -> Spied = 0'+ ; Spied = 0' ), 153 printf(debug_output, "%n %c(%d) <%d> ", [Spied, Invoc, Prio]), 154 getval(dbg_goal_format_string, Format), 155 printf(debug_output, Format, Goal)@M. 156 157 158% print ancestor if it exists, otherwise fail 159 160print_ancestor(Stack, Anc) :- 161 parent(Stack, Anc), 162 Anc = tf{}, % may fail 163 ( timestamp_older(Anc, chp of tf, Stack, chp of tf) -> 164 print_trace_line(trace_line{port:'*....', frame:Anc}) 165 ; 166 print_trace_line(trace_line{port:'....', frame:Anc}) 167 ). 168 169print_ancestors_bottom_up(Stack) :- 170 parent(Stack, Anc), 171 ( Anc = tf{} -> 172 print_ancestors_bottom_up(Anc), 173 print_ancestor(Stack, _), 174 nl(debug_output) 175 ; 176 true 177 ). 178 179 parent(0, 0) :- !. 180 parent(tf{parent:Parent}, Parent). 181 182 183% 184% Print prompt, read and execute commmands 185% 186% - Display commands are immediately excecuted and call interact/2 again 187% - Continuation commands set the global debugger parameters and succeed 188% 189interact(Current, Cont) :- 190 ( getval(next_cmd, Num-Cmd) -> 191 printf(debug_output, " %%> %d", [Num]) 192 ; 193 write(debug_output, " %> "), flush(debug_output), 194 tyi_num(debug_input, Num, Cmd) 195 ), 196 ( do_tracer_command(Cmd, Current, Num, Cont) -> 197 true 198 ; 199 printf(error, "%n *** Command doesn't exist, is not applicable here, or was aborted: %c%n%b", [Cmd]), 200 clear_cmd, 201 interact(Current, Cont) 202 ). 203 204 205% 206% do_tracer_command(Command, CurrentTraceLine, Count, Cont) 207% 208% Command is a single-character command 209% CurrentTraceLine is one of 210% trace_line{...} 211% inspect{...} 212% Count is the numeric argument given to the command (default 0) 213% Cont is a goal to execute before continuing 214 215:- mode do_tracer_command(+,+,+,-). 216do_tracer_command(0'a, _Current, _N, Cont) :- !, 217 confirm("abort"), 218 getval(exec_state, CurrentPort), 219 trace_mode(5, 0), 220 ( CurrentPort = trace_line{port:leave} -> 221 % don't abort, we may not have any catching block! 222 % just behave like n (nodebug) 223 Cont = true 224 ; 225 Cont = abort 226 ). 227 228do_tracer_command(0'b, Current, _, Cont) :- !, 229 writeln(debug_output, "break"), 230 break, 231 print_trace_line(Current), 232 interact(Current, Cont). 233 234do_tracer_command(13, Current, 0, Cont) :- 235 Current = trace_line{}, 236 !, 237 do_tracer_command(0'c, Current, 0, Cont). 238do_tracer_command(0'c, _Current, N, true) :- !, 239 writeln(debug_output, "creep"), 240 trace_mode(0, []), 241 store_cmd(0'c, N). 242 243do_tracer_command(0'd, Current, _, Cont) :- !, 244 get_param_default("delayed goals with prio", all, Prio), 245 write(debug_output, "------- delayed goals -------"), 246 suspensions(Susps), 247 print_suspensions(Susps, 0, Prio), 248 print_trace_line(Current), 249 interact(Current, Cont). 250 251do_tracer_command(0'f, Current, _, Cont) :- !, 252 get_goal_stack(Current, Port, Stack), 253 get_param_default("fail goal", here, N), 254 ( N = here -> 255 ( Port = '....' -> 256 Cont = (cut_to_stamp(Stack, chp of tf),fail) 257 ; Port = fail ; Port = leave -> 258 % already failing: don't fail again, we would miss a choicepoint 259 % turn it into a creep instead... 260 trace_mode(0, []), 261 Cont = true 262 ; 263 Cont = fail 264 ) 265 ; 266 ( find_goal(N, Stack, Frame) -> 267 Cont = (cut_to_stamp(Frame, chp of tf),fail) 268 ; 269 printf(error, "*** Goal (%d) not available!%b", [N]), 270 interact(Current, Cont) 271 ) 272 ). 273 274do_tracer_command(0'g, Current, _, Cont) :- !, 275 get_goal_stack(Current, _, Frame), 276 writeln(debug_output, "ancestor"), 277 ( print_ancestor(Frame, NewFrame) -> 278 interact(trace_line{port:'....', frame:NewFrame}, Cont) 279 ; 280 interact(Current, Cont) 281 ). 282 283do_tracer_command(0'G, Current, _N, Cont) :- !, 284 get_goal_stack(Current, _, Frame), 285 (confirm("print all ancestors") -> 286 print_ancestors_bottom_up(Frame) ; true 287 ), 288 print_trace_line(Current), 289 interact(Current, Cont). 290 291do_tracer_command(0'i, Current, _, true) :- !, 292 get_goal_stack(Current, _, tf{invoc:Invoc}), 293 get_param_default("jump to invoc", Invoc, N), 294 trace_mode(1, N). 295 296do_tracer_command(0'j, Current, 0, true) :- !, 297 get_goal_stack(Current, _, tf{depth:Depth}), 298 Depth1 is max(0,Depth-1), 299 get_param_default("jump to level", Depth1, N), 300 ( N < Depth -> trace_mode(3, N) ; trace_mode(4, N) ). 301 302do_tracer_command(0'l, _Current, N, true) :- !, 303 writeln(debug_output, "leap"), 304 trace_mode(2, []), 305 store_cmd(0'l, N). 306 307do_tracer_command(0'm, Current, _N, Cont) :- !, 308 ( getval(show_module, off) -> 309 writeln(debug_output, "show module"), 310 setval(show_module, on) 311 ; 312 writeln(debug_output, "don't show module"), 313 setval(show_module, off) 314 ), 315 print_trace_line(Current), 316 interact(Current, Cont). 317 318do_tracer_command(0'n, _Current, _N, true) :- !, 319 confirm("nodebug"), 320 trace_mode(5, 0). 321 322do_tracer_command(0'o, Current, _N, Cont) :- !, 323 change_output_mode, 324 print_trace_line(Current), 325 interact(Current, Cont). 326 327do_tracer_command(0'q, Current, _N, Cont) :- !, 328 writeln(debug_output, "query culprit"), 329 ( failure_culprit(CulpritInvoc, LastInvoc) -> 330 ( CulpritInvoc > LastInvoc -> 331 printf(debug_output, "failure culprit was (%d) - ", [CulpritInvoc]), 332 get_param_default("jump to invoc", CulpritInvoc, N), 333 trace_mode(1, N), 334 Cont = true 335 ; 336 get_goal_stack(Current, Port, _), 337 ( CulpritInvoc = CulpritInvoc, nonmember(Port, [fail,leave]) -> 338 printf(debug_output, 339 "failure culprit was (%d) - the goal you are currently at", 340 [CulpritInvoc]) 341 ; 342 printf(debug_output, 343 "failure culprit was (%d) - rerun and type q to jump there", 344 [CulpritInvoc]) 345 ), 346 interact(Current, Cont) 347 ) 348 ; 349 write(debug_output, "no failure culprit stored yet"), 350 interact(Current, Cont) 351 ). 352 353do_tracer_command(0'N, _Current, _N, true) :- !, 354 confirm("nodebug permanently"), 355 trace_mode(5, 0), 356 set_flag(debugging, nodebug). 357 358do_tracer_command(0's, Current, N, true) :- !, 359 get_goal_stack(Current, _, tf{depth:Depth}), 360 writeln(debug_output, "skip"), 361 trace_mode(3, Depth), 362 store_cmd(0's, N). 363 364do_tracer_command(0'u, Current, _, Cont) :- !, 365 get_param_default("scheduled goals with prio", all, Prio), 366 write(debug_output, "------ scheduled goals ------"), 367 suspensions(Susps), 368 print_suspensions(Susps, 1, Prio), 369 print_trace_line(Current), 370 interact(Current, Cont). 371 372do_tracer_command(0'x, Current, 0, Cont) :- !, 373 getval(exec_state, ExecCurrent), 374 ExecCurrent = trace_line{frame:Stack}, 375 Stack = tf{invoc:Invoc}, 376 get_param_default("examine goal", Invoc, N), 377 ( find_goal(N, Stack, NewFrame) -> 378 NewCurrent = trace_line{port:'....', frame:NewFrame}, 379 print_trace_line(NewCurrent), 380 interact(NewCurrent, Cont) 381 ; 382 printf(error, "*** Goal (%d) not available!%b", [N]), 383 interact(Current, Cont) 384 ). 385 386do_tracer_command(0'v, Current, _N, Cont) :- !, 387 confirm("var/term spy"), 388 current_term(Current, Term, Module), 389 new_invoc(I), 390 printf(debug_output, "Var/term spy set up with invocation number (%d)", [I]), 391 suspend(monitor_term(I, Term, Module, Susp), 1, Term->constrained, Susp), 392 interact(Current, Cont). 393 394do_tracer_command(0'w, Current, N0, Cont) :- !, 395 writeln(debug_output, "write source lines"), 396 (N0 == 0 -> N = 4 ; N = N0), % 4 is default 397 Current = trace_line{frame:tf{path:File,line:Line}}, 398 ( File \== '' -> 399 ( write_n_lines_around_current(File, Line, N) -> 400 true 401 ; 402 printf(debug_output, "Unable to find source lines in %w.%n", 403 [File]) 404 ) 405 ; 406 writeln(debug_output, "No source information.") 407 ), 408 interact(Current, Cont). 409 410do_tracer_command(0'=, Current, _N0, Cont) :- !, 411 Current = trace_line{frame:tf{path:File,line:Line}}, 412 ( File \== '' -> 413 writeln(debug_output, "Source position:"), 414 printf(debug_output, "%w:%w%n", [File,Line]) 415 ; 416 writeln(debug_output, "No source information.") 417 ), 418 interact(Current, Cont). 419 420do_tracer_command(0'z, Current, _N, true) :- !, 421 get_goal_stack(Current, ThisPort, _), 422 printf(debug_output, "zap to port: [%w] %b", [~(ThisPort)]), 423 block(( 424 read_port_list(debug_input, Ports), 425 ( var(Ports) -> Ports = ~(ThisPort) ; true ), 426 configure_prefilter(_, _, Ports, _, dontcare) 427 ), abort, fail). 428 429do_tracer_command(0'<, Current, _, Cont) :- !, 430 getval(dbg_print_depth, N0), 431 get_param_default("set print_depth", N0, N), 432 N > 0, 433% set_flag(print_depth, N), 434 setval(dbg_print_depth, N), 435 update_format_strings, 436 print_trace_line(Current), 437 interact(Current, Cont). 438 439do_tracer_command(0'>, Current, _, Cont) :- !, 440 get_param("set indent step width", N), 441 setval(indent_step, N), 442 print_trace_line(Current), 443 interact(Current, Cont). 444 445do_tracer_command(0'+, Current, _N, Cont) :- !, 446 writeln(debug_output, "spy"), 447 get_goal_stack(Current, _, Frame), 448 Frame = tf{goal:Goal}, 449 functor(Goal, F, A), 450 get_tf_prop(Frame, module, DM), 451 block(set_flag(F/A, spy, on)@DM, abort, true ) , 452 print_trace_line(Current), 453 interact(Current, Cont). 454 455do_tracer_command(0'-, Current, _N, Cont) :- !, 456 writeln(debug_output, "nospy"), 457 get_goal_stack(Current, _, Frame), 458 Frame = tf{goal:Goal}, 459 functor(Goal, F, A), 460 get_tf_prop(Frame, module, DM), 461 block(set_flag(F/A, spy, off)@DM, abort, true ) , 462 print_trace_line(Current), 463 interact(Current, Cont). 464 465do_tracer_command(0'&, Current, _N, Cont) :- !, 466 get_flag(extension, development), 467 writeln(debug_output, "Fake stack:"), 468 getval(exec_state, trace_line{frame:Stack}), 469 print_trace_stack(Stack), 470 interact(Current, Cont). 471 472do_tracer_command(0'*, Current, _N, Cont) :- !, 473 get_flag(extension, development), 474 writeln(debug_output, "True stack:"), 475 current_td(Stack), 476 print_trace_stack(Stack), 477 interact(Current, Cont). 478 479do_tracer_command(0'!, Current, _N, Cont) :- !, 480 get_flag(extension, development), 481 trace_mode(13, []), % abstract instruction tracing on/off 482 interact(Current, Cont). 483 484do_tracer_command(0'p, Current, _N, Cont) :- !, 485 nl(debug_output), 486 ( Current = inspect{path:Pos, written:Written, module:M} -> 487 reverse(Pos, RPos), reverse(Written, RWritten), 488 print_inspect_path(RPos, RWritten, M), 489 flush(debug_output) 490 ; writeln(debug_output, "Not inspecting subterm.") 491 ), 492 interact(Current, Cont). 493 494do_tracer_command(0'., Current, _N, Cont) :- 495 Current = inspect{written:[CurrentTerm|_], module:M}, !, 496 writeln(debug_output, "structure definition:"), 497 (compound(CurrentTerm) -> 498 (named_structure(CurrentTerm, M, Defs, A) -> 499 print_struct_names(1, A, debug_output, Defs), 500 nl(debug_output) 501 ; 502 functor(CurrentTerm, F, A), 503 printf(debug_output, "No struct definition for term %w/%w@%w.\n", [F,A,M]) 504 ) 505 506 ; writeln(debug_output, "Current subterm not compound term.") 507 ), 508 interact(Current, Cont). 509 510do_tracer_command(0'., Current, _N, Cont) :- 511 Current = trace_line{frame:Frame}, !, 512 Frame = tf{goal:G,module:M}, 513 nonvar(G), 514 functor(G, N, A), 515 atom(N), 516 nl(debug_output), 517 print_source(debug_output, N/A, M), 518 interact(Current, Cont). 519 520do_tracer_command(0'B, Frame, N, Cont) :- !, % move down 521 N1 is max(1, N), % default is 1 522 get_inspect_frame(Frame, Frame1), 523 move_down(N1, Frame1, Frame2), 524 interact(Frame2, Cont). 525 526do_tracer_command(0'C, Frame, N, Cont) :- !, % move right 527 writeln(debug_output, "right subterm"), 528 N1 is max(1, N), % default is 1 529 get_inspect_frame(Frame, Frame1), 530 move_right(N1, Frame1, Frame2), 531 interact(Frame2, Cont). 532 533do_tracer_command(0'D, Frame, N, Cont) :- !, % move left 534 writeln(debug_output, "left subterm"), 535 N1 is max(1, N), % default is 1 536 get_inspect_frame(Frame, Frame1), 537 move_left(N1, Frame1, Frame2), 538 interact(Frame2, Cont). 539 540do_tracer_command(0'A, Frame, N, Cont) :- !, % move up 541 writeln(debug_output, "up subterm"), 542 N1 is max(1, N), % default is 1 543 get_inspect_frame(Frame, Frame1), 544 move_up(N1, Frame1, Frame2), 545 interact(Frame2, Cont). 546 547do_tracer_command(13, Frame, N, Cont) :- 548 Frame = inspect{}, 549 !, 550 nl(debug_output), 551 get_inspect_frame(Frame, Frame1), 552 inspect_subterm(N, Frame1, Frame2), 553 interact(Frame2, Cont). 554 555do_tracer_command(0'#, Frame, _, Cont) :- !, 556 get_param("inspect arg #", N), 557 get_inspect_frame(Frame, Frame1), 558 inspect_subterm(N, Frame1, Frame2), 559 interact(Frame2, Cont). 560 561do_tracer_command(0'h, Current, N, Cont) :- !, 562 do_tracer_command(0'?, Current, N, Cont). 563do_tracer_command(0'?, Current, _N, Cont) :- !, 564 writeln(debug_output, "\n\n\ 565Continue execution:\n\ 566 [N]c creep [N times]\n\ 567 <cr> creep [once]\n\ 568 i[N] jump to invocation number N (default: current)\n\ 569 j[N] jump to level N (default: parent)\n\ 570 [N]l leap to spypoint [N times]\n\ 571 n nodebug (continue with tracer off)\n\ 572 q jump to the most recent failure's culprit\n\ 573 [N]s skip subgoal [N times]\n\ 574 v var (really: term) modification skip\n\ 575 z zap to port\n\ 576\n\ 577Modify execution:\n\ 578 a abort\n\ 579 f fail here\n\ 580 f[N] fail goal with invocation number N\n\ 581\n\ 582Print data:\n\ 583 d[N] print delayed goals [of priority N]\n\ 584 G print ancestors (call stack)\n\ 585 u[N] print scheduled goals [of priority N]\n\ 586 . print predicate source or structure definition\n\ 587 = print source file name and line number for current goal\n\ 588 [N]w print +/-N surrounding source lines for current goal\n\ 589\n\ 590Navigate/inspect:\n\ 591 g goto ancestor goal (caller)\n\ 592 x[N] examine goal with invoc N (default: back to current port)\n\ 593 0 move to top of inspected term\n\ 594 # move to top of inspected term\n\ 595 #[N] move down to Nth argument\n\ 596 N<cr> move down to Nth argument\n\ 597 [N]<up> move up [N times] (alternative: A)\n\ 598 [N]<left> move left [N times] (alternative: D)\n\ 599 [N]<right> move right [N times] (alternative: C)\n\ 600 [N]<down> move down default arg. [N times] (alternative: B)\n\ 601 p show inspection path\n\ 602\n\ 603Setting options:\n\ 604 m display the caller module\n\ 605 o change print options\n\ 606 <[N] set print_depth to N\n\ 607 >[N] set indentation step width to N\n\ 608 + set spy point on displayed predicate\n\ 609 - remove spy point from displayed predicate\n\ 610\n\ 611Other:\n\ 612 b break level\n\ 613 h,? help\n\ 614 N tracer off permanently\n\ 615"), 616 interact(Current, Cont). 617 618%---------------------------------------------------------------------- 619% Auxiliary 620%---------------------------------------------------------------------- 621 622% A version of tyi/2 which allows an optional newline when used on non-tty 623% streams (for pseudo-terminals that don't have raw mode, e.g. inside emacs) 624:- local tyi/2. 625tyi(S, C) :- 626 eclipse_language:tyi(S, C), 627 ( get_stream_info(S, device, tty) -> 628 true 629 ; newline(C) -> 630 true 631 ; 632 eclipse_language:tyi(S, NL), 633 ( newline(NL) -> true ; unget(S) ) 634 ). 635 636 637% read a number and the next non-numeric character 638% the number get echoed, the terminator not 639 640tyi_num(Stream, Number, Terminator) :- 641 tyi_num(Stream, 0, Number, Terminator). 642 643 tyi_num(Stream, Num0, Num, Terminator) :- 644 tyi(Stream, Char), 645 ( char_num(Char, Digit) -> 646 Num1 is 10*Num0 + Digit, 647 tyo(debug_output, Char), 648 tyi_num(Stream, Num1, Num, Terminator) 649 ; backspace(Char) -> 650 ( Num0 > 0 -> 651 Num1 is Num0//10, 652 write(debug_output, "\b \b"), flush(debug_output), 653 tyi_num(Stream, Num1, Num, Terminator) 654 ; 655 tyi_num(Stream, Num0, Num, Terminator) 656 ) 657 ; newline(Char) -> 658 Num = Num0, Terminator = Char 659 ; 660 Num = Num0, Terminator = Char 661 ). 662 663 backspace(8). 664 backspace(127). 665 666 newline(13). 667 newline(10). 668 669 char_num(0'0, 0). 670 char_num(0'1, 1). 671 char_num(0'2, 2). 672 char_num(0'3, 3). 673 char_num(0'4, 4). 674 char_num(0'5, 5). 675 char_num(0'6, 6). 676 char_num(0'7, 7). 677 char_num(0'8, 8). 678 char_num(0'9, 9). 679 680 681confirm(Prompt) :- 682 printf(debug_output, "%s? [y] %b", [Prompt]), 683 tyi(debug_input, Char), 684 ( backspace(Char) -> fail 685 ; newline(Char) -> nl(debug_output) 686 ; Char = 0'y -> nl(debug_output) 687 ; Char = 0'Y -> nl(debug_output) 688 ; Char = 0'n -> fail 689 ; Char = 0'N -> fail 690 ; nl(debug_output), confirm(Prompt) ). 691 692get_param_default(Prompt, Default, N) :- 693 printf(debug_output, "%s: [%w]? %b", [Prompt,Default]), 694 tyi_num(debug_input, 0, N1, Char), 695 newline(Char), % may fail 696 nl(debug_output), 697 ( N1 = 0 -> N=Default ; N=N1 ). 698 699get_param(Prompt, N) :- 700 printf(debug_output, "%s: %b", [Prompt]), 701 tyi_num(debug_input, 0, N, Char), 702 newline(Char), % may fail 703 nl(debug_output). 704 705clear_cmd :- 706 setval(next_cmd, 0). 707 708store_cmd(_Cmd, 0) :- !. 709store_cmd(_Cmd, 1) :- !, 710 clear_cmd. 711store_cmd(Cmd, N) :- 712 N1 is N-1, 713 setval(next_cmd, N1-Cmd). 714 715 716current_term(trace_line{frame: 717 tf{goal:Term,module:Module}}, Term, Module). 718current_term(inspect{written:[Term|_],module:Module}, Term, Module). 719 720 721print_trace_stack(0). 722print_trace_stack(Frame) :- 723 Frame = tf{invoc:Invoc,goal:Goal,depth:D,parent:Parent}, 724 ( get_tf_prop(Frame, skip, on) -> Prop = 0'S ; Prop = 0' ), 725 ( get_tf_prop(Frame, spy, on) -> Spied = 0'+ ; Spied = 0' ), 726 get_tf_prop(Frame, ?, FF), 727 printf(debug_output, ">> [%2r] %c%c(%d) %d ", [FF,Prop,Spied,Invoc,D]), 728 getval(dbg_goal_format_string, Format), 729 printf(debug_output, Format, Goal), 730 nl(debug_output), 731 print_trace_stack(Parent). 732 733% returns the goal stack from both trace_line and inspect frames 734get_goal_stack(trace_line{port:Port,frame:Stack}, Port, Stack) :- !. 735get_goal_stack(inspect{goalf:Stack}, Port, Stack) :- 736 Port = '....'. 737 738 739break :- 740 ( current_module(toplevel) -> 741 toplevel:break 742 ; 743 writeln(warning_output, "No toplevel in this configuration") 744 ). 745 746 747%---------------------------------------------------------------------- 748% Inspect subterms 749%---------------------------------------------------------------------- 750 751get_inspect_frame(trace_line{frame:Frame}, New) ?- !, 752 Frame = tf{goal:Goal,module:Module}, 753 written_term(Goal, Goal, WGoal, Module), 754 New = inspect{top:Goal,path:[],module:Module,written:[WGoal],type:goal,goalf:Frame}. 755get_inspect_frame(Frame, Frame). % the default case, placed last 756 757inspect_subterm(0, inspect{top:Top,module:Module,type:Type,goalf:Tf}, Frame) ?- !, 758% N == 0 jump to top-level 759 written_term(Top, Top, WTop, Module), 760 Frame = inspect{top:Top,written:[WTop],path:[],module:Module,type:Type,goalf:Tf}, 761 print_trace_line(Frame). 762 763inspect_subterm(Choice, inspect{top:Top,type:Type,path:Pos0,module:Module,written:Written0,goalf:Tf}, Frame) :- 764 Written0 = [CurrentTerm|_], 765 meta(CurrentTerm), Choice> 0, !, 766 (block(get_attribute(CurrentTerm,RawAttribute,Choice), _, fail) -> 767 meta_attributes(Atts), 768 member([AttName|Choice], Atts), 769 Pos1 = [AttName-Choice|Pos0], 770 written_term(Top, RawAttribute, Attribute, Module), 771 Written = [Attribute|Written0] 772 773 ; printf(debug_output, "%nInvalid attribute.%n", []), 774 Pos1 = Pos0, Written = Written0 775 ), 776 Frame = inspect{top:Top,type:Type,module:Module,path:Pos1,written:Written,goalf:Tf}, 777 print_trace_line(Frame). 778 779 780inspect_subterm(N, inspect{top:Top,type:Type,path:Pos,module:Module,written:Written,goalf:Tf}, Frame) :- 781 N > 0, !, % get Nth arg 782 Written = [CurrentTerm|_], 783 (nonvar(CurrentTerm), 784 functor(CurrentTerm, _F, A), 785 N =< A -> 786 arg(N, CurrentTerm, RawNewTerm), 787 written_term(Top, RawNewTerm, NewTerm, Module), 788 % print transformed term just in case printf_with_current_mode 789 % does not print RawNewTerm as expected 790 Pos1 = [N|Pos], Written1 = [NewTerm|Written] 791 ; write(debug_output, 'Out of range.....'), 792 nl(debug_output), 793 Pos1 = Pos, Written1 = Written 794 ), 795 Frame = inspect{top:Top,module:Module,path:Pos1, 796 written:Written1,type:Type,goalf:Tf}, 797 print_trace_line(Frame). 798 799 800move_down(N, inspect{path:Pos,top:Top,written:Written,module:Module,type:Type,goalf:Tf}, Frame) :- 801 current_pos(Pos, CPos), 802 traverse_down(N, 0, CPos, Top, Pos, Written, Type, Tf, Frame, Module). 803 804 805traverse_down(N, N, CPos, Top, Pos, Written, Type, Tf, Frame, Module) :- !, 806 printf(debug_output, "down subterm %d for %d levels%n", [CPos,N]), 807 Frame = inspect{top:Top,path:Pos,written:Written,module:Module,type:Type,goalf:Tf}, 808 print_trace_line(Frame). 809traverse_down(N, M, CPos, Top, Pos, Written0, Type, Tf, Frame, Module) :- 810 M1 is M + 1, 811 Written0 = [CurrentTerm|_], 812 (nonvar(CurrentTerm), 813 functor(CurrentTerm, _, A), 814 CPos =< A -> 815 arg(CPos, CurrentTerm, RawNewTerm), 816 written_term(Top, RawNewTerm, NewTerm, Module), 817 traverse_down(N, M1, CPos, Top, [CPos|Pos], [NewTerm|Written0], Type, Tf, Frame, Module) 818 ; printf(debug_output, "Out of range after traversing down argument %d for %d levels%n", [CPos, M]), 819 Frame = inspect{top:Top,module:Module,path:Pos,written:Written0,type:Type,goalf:Tf}, 820 print_trace_line(Frame) 821 ). 822 823 824move_up(N, inspect{top:Top,module:Module,written:Written0,path:Pos, 825 type:Type,goalf:Gf}, Frame) :- 826 port_remove_levels(N, Pos, Pos1, _), 827 reverse(Pos1, RPos), reverse(Written0, RWritten0), 828 port_get_new_subterm(RPos, RWritten0, WrittenFront, []), 829 Frame = inspect{top:Top,module:Module,written:WrittenFront, 830 type:Type,path:Pos1,goalf:Gf}, 831 print_trace_line(Frame). 832 833move_left(M, inspect{top:Top,written:Written0,path:Pos,module:Module, 834 type:Type,goalf:Gf}, Frame) :- 835 move_path_left(M, Pos, Pos1, N1, Status), 836 (Status \== false -> 837 Written0 = [_|Written1], 838 Written1 = [ParentTerm|_], 839 arg(N1, ParentTerm, RawNewTerm), 840 written_term(Top, RawNewTerm, NewTerm, Module), 841 Written0 = [_|Written1], Written2 = [NewTerm|Written1] 842 843 ; nl(debug_output), writeln(debug_output, 'Out of range.....'), 844 nl(debug_output), 845 Written2 = Written0 846 ), 847 Frame = inspect{top:Top,written:Written2,path:Pos1, 848 type:Type,module:Module,goalf:Gf}, 849 print_trace_line(Frame). 850 851move_path_left(M, Pos, Pos1, N1, Status) :- 852 (Pos = [N|Pos0], % move to N-M 853 integer(N) -> 854 (N > M -> 855 N1 is N-M, Status = true 856 ; N1 is 1, Status = out 857 ), 858 Pos1 = [N1|Pos0] 859 860 ; Status = false, 861 Pos1 = Pos 862 ). 863 864move_right(M, inspect{top:Top,written:Written0,path:Pos,module:Module, 865 type:Type,goalf:Gf}, Frame) :- 866 (Pos = [N|Pos0], integer(N) -> % move to N+1 867 Written0 = [_|Written1], 868 Written1 = [ParentTerm|_], 869 functor(ParentTerm, _F, A), 870 N1 is min(N+M, A), 871 arg(N1, ParentTerm, RawNewTerm), 872 written_term(Top, RawNewTerm, NewTerm, Module), 873 Written2 = [NewTerm|Written1], 874 Pos1 = [N1|Pos0] 875 876 ; % Pos == [] or attributed var. 877 nl(debug_output), writeln(debug_output, 'Out of range.....'), 878 nl(debug_output), 879 Pos1 = Pos, Written2 = Written0 880 ), 881 Frame = inspect{top:Top,written:Written2,path:Pos1,module:Module, 882 type:Type,goalf:Gf}, 883 print_trace_line(Frame). 884 885 886/* inspect subterm aux **************************/ 887 888port_get_new_subterm([], [Term|_], [Term|Front], Front) :- !. 889port_get_new_subterm([_N|Pos], [Term|Written], Acc, Front) :- 890 port_get_new_subterm(Pos, Written, Acc, [Term|Front]). 891 892 893% extracting current position from path 894current_pos([], 1) :- !. 895current_pos([_-_|_], 1) :- !. % attributed variable 896current_pos([CPos|_], CPos). 897 898print_current_summary(Stream, Term, _) :- meta(Term), !, 899 printf(Stream, "(attributes ", []), 900 valid_attributes_listing(Term, ValidAttsL), 901 (foreach(Spec, ValidAttsL) do 902 printf(debug_output, "%s ", Spec) 903 ), 904 put(Stream, 0')). 905print_current_summary(Stream, [_|_], _Module) ?- !, 906 printf(Stream, "(list 1-head 2-tail)", []). 907print_current_summary(Stream, Term, Module) :- compound(Term), !, 908 functor(Term, F, A), 909 functor(Defs, F, A), 910 ( current_struct(F, Defs)@Module -> 911 printf(Stream, "(struct %w/%w)", [F,A]) 912 ; 913 printf(Stream, "(%w/%w)", [F,A]) 914 ). 915print_current_summary(Stream, Term, _Module) :- 916 type_of(Term, Type), 917 ( Type = goal -> printf(Stream, "(suspension)", []) 918 ; printf(Stream, "(%w)", [Type]) ). 919 920 921print_inspect_path(Path, [Top|Written], Mod) :- 922 write(debug_output, "Subterm path: "), 923 print_inspect_path1(Path, Written, Top, Mod). 924 925print_inspect_path1([], [], _Parent, _Mod) :- !, % at top 926 writeln(debug_output, "at toplevel"). 927print_inspect_path1([Pos|Path], [T|Written], Parent, Mod) :- 928 print_one_position(Pos, Parent, Mod), 929 (Path \== [] -> 930 write(debug_output, ","), 931 print_inspect_path1(Path, Written, T, Mod) 932 ; nl(debug_output) 933 ). 934 935print_one_position(Attr-_, _, _) :- 936 printf(debug_output, " attr: %w", [Attr]). 937print_one_position(Pos, T, Mod) :- 938 (compound(T) -> 939 (named_structure(T, Mod, Def, _) -> 940 arg(Pos, Def, Field), 941 functor(T, F, _), 942 printf(debug_output, " %w of %w (%w)", [Field, F, Pos]) 943 ; printf(debug_output, " %w", [Pos]) 944 ) 945 946 ; printf(" %w", [Pos]) 947 ). 948 949 950%---------------------------------------------------------------------- 951% Print source 952%---------------------------------------------------------------------- 953 954write_n_lines_around_current(File, CurrentLN, N) :- 955 get_file_info(File, readable, on), 956 open(File, read, S), 957 printf(debug_output, "%w:%n", [File]), 958 ( 959 FirstLN is max(CurrentLN - N,1), 960 ( for(_,2,FirstLN), param(S) do 961 read_string(S, end_of_line, _, _) 962 ), 963 ( for(I,FirstLN,max(CurrentLN-1,1)), param(S) do 964 read_string(S, end_of_line, _, Line), 965 printf(debug_output, "%5d %w%n", [I, Line]) 966 ), 967 read_string(S, end_of_line, _, CurrentLine), 968 printf(debug_output, "%5d> %w%n", [CurrentLN, CurrentLine]), 969 ( ( for(I,CurrentLN+1,CurrentLN+N), param(S) do 970 % read_string may fail due to end of file 971 read_string(S, end_of_line, _, Line), 972 printf(debug_output, "%5d %w%n", [I, Line]) 973 ) -> 974 true 975 ; 976 true 977 ), 978 close(S) 979 ; 980 close(S), 981 fail 982 ). 983 984 985%---------------------------------------------------------------------- 986% Changing output mode 987%---------------------------------------------------------------------- 988 989change_output_mode :- 990 get_flag(output_mode, Mode), 991 repeat, 992 printf(debug_output, 'current output mode is "%w", toggle char: %b', [Mode]), 993 string_list(Mode, ModeList), 994 tyi(debug_input, Opt), 995 tyo(debug_output, Opt), 996 ( valid_output_option(Opt, _, ExcludedOpts) -> 997 subtract(ModeList, ExcludedOpts, CleanModeList), 998 ( delete(Opt, CleanModeList, NewModeList) -> true 999 ; NewModeList = [Opt|CleanModeList] ), 1000 string_list(NewMode0, NewModeList), 1001 set_flag(output_mode, NewMode0), 1002 get_flag(output_mode, NewMode) 1003 ; newline(Opt) -> 1004 NewMode = Mode 1005 ; 1006 printf(debug_output, "%nValid output modes are:%n", []), 1007 valid_output_option(Char, Descr, _), 1008 printf(debug_output, " %c %s%n", [Char,Descr]), 1009 fail 1010 ), 1011 !, % repeat 1012 printf(debug_output, '%nnew output mode is "%w".%n', [NewMode]), 1013 update_format_strings. 1014 1015 1016 1017read_port_list(Stream, Ports) :- 1018 read_string(Stream, end_of_line, _, String), 1019 ( String = "" -> 1020 true 1021 ; 1022 ( substring(String,"~",1) -> String1 = String 1023 ; concat_string(["[",String,"]"], String1) ), 1024 term_string(Ports, String1) 1025 ). 1026 1027update_format_strings :- 1028 get_flag(output_mode, OM), 1029 getval(dbg_print_depth, PD), 1030 concat_string(["%",PD,OM,"w"], DF), 1031 setval(dbg_format_string, DF), 1032 concat_string(["%",PD,OM,"Gw"], DGF), 1033 setval(dbg_goal_format_string, DGF). 1034 1035 1036%-------------------------------------------------------- 1037% Handling of the interruption to abort, debug, exit ... 1038% This is complicated now because of the parallel case. 1039%-------------------------------------------------------- 1040 1041:- export interrupt_prolog/0. 1042:- skipped interrupt_prolog/0. 1043interrupt_prolog :- 1044 setval(control_c_option, _), 1045 mutex(control_c_lock, prompt_for_option(Option, Worker)), 1046 do_option(Option, Worker). 1047 1048prompt_for_option(Option, TypeInWorker) :- 1049 getval(control_c_option, X), 1050 ( var(X) -> 1051 nl, 1052 ask_option(Option), 1053 get_flag(worker, TypeInWorker), 1054 setval(control_c_option, Option-TypeInWorker) 1055 ; 1056 X = Option-TypeInWorker % already typed in other worker 1057 ). 1058 1059% move printing of interrupt message to warning_output and receive option 1060% on input, as debug_input and debug_output may be used differently by 1061% user's application. Kish Shen 2000-8-11 1062ask_option(Option) :- 1063 repeat, 1064 nl(debug_output), 1065 write(warning_output, 'interruption: type '), 1066 write_options, 1067 write(warning_output, 'or h for help : ? '), 1068 flush(warning_output), 1069 tyi(input, AnyCase), 1070 lower_case(AnyCase, Option), 1071 option_message(Option, Error, Message), 1072 writeln(warning_output, Message), 1073 (Error = (help) -> help_debug ; true), 1074 Error = valid, % repeat if 'help' or 'invalid' 1075 !. % quit loop if valid 1076 1077lower_case(Case, LowerCase) :- 1078 (Case >= 0'a -> 1079 LowerCase = Case 1080 ; 1081 LowerCase is Case + (0'a - 0'A) 1082 ). 1083 1084current_option(0'a, valid, abort). 1085current_option(0'b, valid, 'break level'). 1086current_option(0'c, valid, continue). 1087current_option(0'd, Error, Message) :- 1088 ( get_flag(worker, 0) -> % sequential 1089 (get_flag(debugging, nodebug) -> 1090 Error = invalid, 1091 Message = 'debugger is off' 1092 ; 1093 Error = valid, 1094 Message = 'switch debugger to creep mode' 1095 ) 1096 ; 1097 Error = invalid, 1098 Message = 'not available in parallel execution' 1099 ). 1100current_option(0'e, valid, exit). 1101current_option(0'h, help, help). 1102 1103option_message(Option, Error, Message) :- 1104 current_option(Option, Error, Message), !. 1105option_message(_, invalid, 'invalid option'). 1106 1107% Option handling: 1108% abort - on all workers 1109% break - on one worker 1110% debug - sequential only 1111% cont - on all workers 1112% exit - on one worker 1113do_option(0'a, _) :- 1114 abort. 1115do_option(0'b, Worker) :- (get_flag(worker, Worker) -> break ; true). 1116do_option(0'c, _). 1117do_option(0'd, 0) :- 1118 clear_cmd, % clear any existing command 1119 trace_mode(0, []). 1120do_option(0'e, Worker) :- (get_flag(worker, Worker) -> halt ; true). 1121 1122write_options :- 1123 current_option(Option, valid, _), 1124 printf(warning_output, '%c, ', Option), 1125 fail. 1126write_options. 1127 1128help_debug :- 1129 current_option(Option, valid, Message), 1130 printf(debug_output, ' %c : %w\n', [Option, Message]), 1131 fail. 1132help_debug :- 1133 writeln(debug_output, ' h : help\n'), 1134 flush(debug_output). 1135 1136 1137%---------------------------------------------------------------------- 1138% Init global settings 1139%---------------------------------------------------------------------- 1140 1141:- setval(next_cmd, 0), 1142 setval(indent_step, 0), 1143 setval(dbg_print_depth, 5), 1144 setval(show_module, off), 1145 update_format_strings. 1146 1147:- local variable(control_c_lock). 1148:- mutex_init(control_c_lock). 1149:- local variable(control_c_option). 1150 1151 1152% Interrupt handlers 1153 1154try_set_interrupt_handler(I, H) :- 1155 current_interrupt(_, I) -> set_interrupt_handler(I, H) ; true. 1156 1157:- import reset/0 from sepia_kernel. 1158 1159:- export 1160 it_reset/1, 1161 it_handler/1, 1162 it_overflow/0. 1163 1164it_reset(Sig) :- 1165 it_handler(Sig), 1166 reset. 1167 1168it_handler(Sig):- 1169 printf(error, "Signal %d%n%b", [Sig]). 1170 1171it_overflow:- 1172 write(error, "Segmentation violation - possible reasons are:\n" 1173 "- a faulty external C function\n" 1174 "- certain operations on circular terms\n" 1175 "- machine stack overflow\n" 1176 "- an internal error in ECLiPSe\n" 1177 ), 1178 flush(error), 1179 reset. 1180 1181:- get_flag(hostarch, Arch), 1182 ( (Arch == "i386_nt" ; Arch == "x86_64_nt") -> 1183 % Handle interrupt at least synchronously 1184 set_interrupt_handler(int, event/1), 1185 set_event_handler(int, interrupt_prolog/0) 1186 ; 1187 % Keyboard interrupt 1188 set_interrupt_handler(int, interrupt_prolog/0), 1189 1190 ( peer(X), peer_get_property(X,type,embed) -> 1191 % If we are embedded, don't touch the handlers 1192 true 1193 ; 1194 % Standalone: try to catch as much as possible 1195 try_set_interrupt_handler(hup, halt/0), 1196 try_set_interrupt_handler(quit, halt/0), 1197 try_set_interrupt_handler(abrt, halt/0), 1198 try_set_interrupt_handler(ill, it_reset/1), 1199 try_set_interrupt_handler(trap, it_handler/1), 1200 try_set_interrupt_handler(iot, it_handler/1), 1201 try_set_interrupt_handler(emt, it_handler/1), 1202 try_set_interrupt_handler(fpe, it_reset/1), 1203 try_set_interrupt_handler(bus, it_reset/1), 1204 try_set_interrupt_handler(segv, it_overflow/0), 1205 try_set_interrupt_handler(sys, it_handler/1), 1206 try_set_interrupt_handler(pipe, it_handler/1), 1207 try_set_interrupt_handler(term, abort/0), 1208 try_set_interrupt_handler(urg, it_handler/1), 1209 try_set_interrupt_handler(ttou, true/0) 1210 ) 1211 ). 1212 1213