1/* BEGIN LICENSE BLOCK 2 * Version: CMPL 1.1 3 * 4 * The contents of this file are subject to the Cisco-style Mozilla Public 5 * License Version 1.1 (the "License"); you may not use this file except 6 * in compliance with the License. You may obtain a copy of the License 7 * at www.eclipse-clp.org/license. 8 * 9 * Software distributed under the License is distributed on an "AS IS" 10 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11 * the License for the specific language governing rights and limitations 12 * under the License. 13 * 14 * The Original Code is The ECLiPSe Constraint Logic Programming System. 15 * The Initial Developer of the Original Code is Cisco Systems, Inc. 16 * Portions created by the Initial Developer are 17 * Copyright (C) 1990,2006 Cisco Systems, Inc. All Rights Reserved. 18 * 19 * Contributor(s): Mireille Ducasse, ECRC. 20 * 21 * END LICENSE BLOCK 22 */ 23%---------------------------------------------------------------------- 24%:- module_interface(opium_kernel). 25%---------------------------------------------------------------------- 26 27/* 28:- export 29 trace_first_line/1, 30 curr_line_Op/5, 31 curr_chrono_Op/1, 32 curr_port_Op/1, 33 curr_call_Op/1, 34 curr_depth_Op/1, 35 curr_pred_Op/1, 36 curr_arg_Op/1, 37 curr_arg_Op/2, 38 f_get_bare/5, 39 no_trace_Op/0. 40*/ 41:- local 42 43 struct(trace_line(port,frame)), 44 struct(tf(invoc,goal,depth,chp,parent,proc,module)), 45 46 reference(current), 47 48 variable(autoprint). 49 50 51:- import 52 configure_prefilter/5 53 from sepia_kernel. 54 55%:- begin_module(opium_light_kernel). 56 57/* 58 TRACE_FIRST_LINE(+Bool) 59 60 Tells whether the first trace line upon returning to 61 opium_light ought to be traced. 62 0 means do not trace it 63 1 means do trace it 64 65 This is needed, as there is no corouting. Queries such as 66 "next,print_line." cannot be executed as opium_light returns to the 67 traced execution after fget. 68 69 The autoprint global variable allows the equivalent 70 functionality for this particular kind of queries. 71 72*/ 73trace_first_line(Int) :- 74 setval(autoprint, Int). 75 76/* 77 In Opium the very first line of each execution is always 78 printed. It is an effective way to tell people that a tracing 79 session is starting. 80*/ 81:- trace_first_line(1). 82 83 84%---------------------------------------------------------------------- 85% The trace line event handler 86%---------------------------------------------------------------------- 87 88opium_light(_252, TraceLine) :- 89 setval(current, TraceLine), 90 ( getval(autoprint, 1) -> 91 print_line, 92 /* nl(debug_output), */ 93 setval(autoprint, 0) 94 ; 95 true 96 ), 97 get_error_handler(153, H, M), 98 set_error_handler(153, opium_toplevel_prompt/2), 99 get_flag(toplevel_module, TM), 100 set_flag(toplevel_module, opium), 101 break, % run a nested toplevel 102 set_flag(toplevel_module, TM), 103 set_error_handler(153, H)@M. 104 105opium_toplevel_prompt(_153, Module) :- 106 get_prompt(toplevel_input, _, PromptStream), 107 printf(PromptStream, " *%w*: %b", [Module]). 108 109 110%---------------------------------------------------------------------- 111% The curr_... primitives 112%---------------------------------------------------------------------- 113 114curr_line_Op(_, Call, Depth, Port, M:N/A) :- 115 getval(current, TraceLine), 116 TraceLine = trace_line with [ port:Port, frame:Frame ], 117 Frame = tf with [invoc:Call,goal:Goal,depth:Depth,module:M], 118 functor(Goal, N, A). 119 120curr_chrono_Op(_). 121 122curr_port_Op(Port) :- 123 getval(current, TraceLine), 124 TraceLine = trace_line with port:Port. 125 126curr_call_Op(Call) :- 127 getval(current, TraceLine), 128 TraceLine = trace_line with frame:(tf with invoc:Call). 129 130curr_depth_Op(Depth) :- 131 getval(current, TraceLine), 132 TraceLine = trace_line with frame:(tf with depth:Depth). 133 134curr_pred_Op(M:N/A) :- 135 getval(current, TraceLine), 136 TraceLine = trace_line with frame:Frame, 137 Frame = tf with [goal:Goal,module:M], 138 functor(Goal, N, A). 139 140curr_arg_Op(ArgList) :- 141 getval(current, TraceLine), 142 TraceLine = trace_line with frame:(tf with goal:Goal), 143 Goal =.. [_|ArgList]. 144 145curr_arg_Op(N, Arg) :- 146 getval(current, TraceLine), 147 TraceLine = trace_line with frame:(tf with goal:Goal), 148 arg(N, Goal, Arg). 149 150 151%---------------------------------------------------------------------- 152% Some basics 153%---------------------------------------------------------------------- 154 155%:- tool(f_get_bare_Op/5, f_get_bare_Op_body/6). 156f_get_bare_Op(_, Call, Depth, Port, Pred) :- 157 curr_pred(Module:_/_), 158 configure_prefilter(Call, Depth, Port, Pred, Module), 159 exit_block(end). 160 161no_trace_Op :- 162 trace_first_line(1), 163 f_get_bare_Op(_, _, _,[],_). 164 165 166%---------------------------------------------------------------------- 167% Install Opium as the trace event handler 168%---------------------------------------------------------------------- 169 170:- set_error_handler(252, opium_light/2). 171 172% Suppress the messages when entering and leaving a break level 173:- set_error_handler(158, true/0). 174:- set_error_handler(159, true/0). 175 176