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