comparison td.pl @ 0:cfb7c6b24319

Initial revision
author kono
date Thu, 30 Aug 2007 14:57:44 +0900
parents
children 61743469ee56
comparison
equal deleted inserted replaced
-1:000000000000 0:cfb7c6b24319
1 /*
2 Copyright (C) 1988,2005, Shinji Kono
3 Everyone is permitted to copy and distribute verbatim copies
4 of this license, but changing it is not allowed. You can also
5 use this wording to make the terms for other programs.
6
7 send your comments to kono@ie.u-ryukyu.ac.jp
8 */
9
10
11 tokiodebug_on :- recorded(tokiodebug, on, _), !.
12 tokiodebug_on :- recorda(tokiodebug, on, _),
13 write('Tokio debug mode switched on.'), nl.
14
15 tokiodebug_off :- recorded(tokiodebug, _, R), !,
16 erase(R), write('Tokio debug mode switched off.'), nl.
17 tokiodebug_off.
18
19 'tokiodebugon?' :-
20 recorded(tokiodebug, on, _), !, uhihi.
21
22 uhihi :-
23 recorded(tokiotraceat, _, _), !, fail.
24 uhihi.
25
26 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
27 % Clocked Stepping
28 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
29 r_tokioDebug(Q,Now) :-
30 r_skip(S),
31 r_tokioDebug(S,Q,Now).
32
33 r_tokioDebug(S,_Q,Now) :- S > Now,!.
34 r_tokioDebug(S,_Q,Now) :- 0<S,S < Now,!,fail.
35 r_tokioDebug(_,Q,Now) :-
36 abolish(r_skip,1),
37 assert(r_skip(-1)),!,
38 r_select(Q,Now),!,r_skip(S),(S>Now;S= -1).
39
40 r_select(Q,Now) :- repeat,nl,write('Tokio Trace t'),write(Now),write(:),
41 read(Key),r_menu(Key,Key1),
42 r_tokioDebug_menu(Key1,Q,Now),!.
43
44 r_menu(n,next):-!.
45 r_menu(d,dump):-!.
46 r_menu(s(N),skip(N)):-!.
47 r_menu(+(N),skip(N)):-!.
48 r_menu(a,abort):-!.
49 r_menu(b,break):-!.
50 r_menu(v(N),value(N)):-!.
51 r_menu(*(N),value(N)):-!.
52 r_menu(q,queue):-!.
53 r_menu(t,trace):-!.
54 r_menu(N,skip(N)):-number(N),!.
55 r_menu(h,help):-!.
56 r_menu(?,help):-!.
57 r_menu(V,V).
58
59 r_tokioDebug_menu(help,_,_) :-
60 write('help/h/? '),put(9), write(' print this'),nl,
61 write('next/n '),put(9), write(' skip to next clock'),nl,
62 write('dump/d '),put(9), write(' dump current static value'),nl,
63 write('all '),put(9), write(' all history of static value'),nl,
64 write('save(file) '),put(9), write(' save current state'),nl,
65 write('skip(n)/s(n)/+-Number'),put(9),write(' goto +-Number clock'),nl,
66 write('abort/a '),put(9), write(' abort tokio execution'),nl,
67 write('break/b '),put(9), write(' break to prolog'),nl,
68 write('value(Name)/*Name '),put(9),write(' examine static value'),nl,
69 write('queue/q '),put(9), write(' show current process queue'),nl,
70 write('trace/t '),put(9), write(' enter prolog tracer'),
71 nl,fail.
72 r_tokioDebug_menu(dump,_,_) :-
73 recorded(r_static,Name,_),record1(Name,(Name,Value,Time),_Ref),
74 write(at),write(Time),write(': '),put(9),
75 write(*Name),write( = ),write(Value),nl,fail.
76 r_tokioDebug_menu(abort,_,_Time):- !,abort.
77 r_tokioDebug_menu(break,_,_Time):- !,break,fail.
78 r_tokioDebug_menu(next,_,_Time):- !.
79 r_tokioDebug_menu(trace,_,_Time):- !,trace.
80 r_tokioDebug_menu(all,_,Time) :- % recorded(time,Now,_),!,
81 r_inc_time(Now,Time), assert(r_fififi),
82 recorded(r_static,Name,_),recorded(Name,(Name,Value,Now),_Ref),
83 (r_fififi,write(Now),write(': '),retract(r_fififi),fail; put(9)),
84 write(*),write(Name),write(' = '),write(Value),
85 nl,fail.
86 r_tokioDebug_menu(queue,Q,_Time) :-
87 numbervars(Q,0,_),r_save_queue(Q),!,fail.
88 r_tokioDebug_menu(value(Name),_Q,_) :-
89 recorded(Name,(Name,Value,Time),_Ref),
90 write(*),write(Name),write(' = '),write(Value),
91 write(' at: '),write(Time),nl,fail.
92 r_tokioDebug_menu(save(File),Q,_Time) :-
93 tell(File),
94 write((:- init_static)),write('.'),nl,
95 r_save_static,numbervars(Q,0,_),
96 r_save_queue(Q),
97 told,!,fail.
98 r_tokioDebug_menu(skip(N),_,Time) :- !,
99 M is N+Time,abolish(r_skip,1),
100 assert(r_skip(M)).
101 r_tokioDebug_menu(_,_,_Time) :- !,fail.
102
103 r_inc_time(X,Now) :- r_inc_time(X,Now,0).
104 r_inc_time(N,_Now,N).
105 r_inc_time(N,Now,M) :- M1 is M+1,M1 =< Now, r_inc_time(N,Now,M1).
106
107 r_save_static :-
108 recorded(r_static,Name,_),recorded(Name,(Value,Time),_Ref),
109 write_term((:- recordz(Name,(Value,Time),_)),[numbervars(true),quoted(true)]),
110 % writeq((:- recordz(Name,(Value,Time),_))),
111 write('.'),nl,fail.
112 r_save_static.
113
114 r_save_queue(t(Empty,X,Fin,Now,F,K,Next,Futures,True)) :-
115 nl,write((:- abolish(restart,1),recorda(time,Now,_))),write('.'),
116 nl,
117 OO = ( restart
118 :- r_solve_t(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
119 ['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) ),
120 % writeq(OO),
121 write_term(OO,[numbervars(true),quoted(true)]),
122 write('.'),nl.
123
124 restart(File) :- [-File],restart.
125
126 record1(Name,Value,Ref) :- recorded(Name,Value,Ref),!.
127
128 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
129 % Clause Tracer (N.Y.I)
130 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
131 tokiospied(G) :-
132 functor(G, F, A), A2 is A-2, recorded(tokiospy, F/A2, _), !.
133
134 tokiofailed1(_G) :- recorded(tokiofail, _, _), !.
135 tokiofailed(G) :-
136 functor(G, F, A), A2 is A-2, recorded(tokiofail, F/A2, _), !.
137
138 % tokiodebug :- recorded(tokiospy, _, R), erase(R), fail.
139 % tokiodebug :- recorded(tokiofail, _, R), erase(R), fail.
140 tokiodebug :- tokiodebug_on,
141 recorda(tokiospy, _, _), recorda(tokiofail, _, _),
142 write('All computation will be traced.'), ttynl.
143
144 % tokionodebug :- recorded(tokiospy, _, R), erase(R), fail.
145 % tokionodebug :- recorded(tokiofail, _, R), erase(R), fail.
146 % tokionodebug :- recorded(tokiotraceat, _, R), erase(R), fail.
147 tokionodebug :- tokiodebug_off.
148
149 (tokiospy) :- recorded(tokiospy, _, R), erase(R), fail.
150 (tokiospy) :- recorded(tokiofail, _, R), erase(R), fail.
151 (tokiospy) :- tokiodebug_on, recorda(tokiospy, _, _),
152 write('All Tokio reductions will be traced.'), ttynl.
153
154 tokiospy(X) :-
155 tokiodebug_on,
156 ( X=_F/_A, !, recorda(tokiospy, X, _); recorda(tokiospy, X/_, _) ),
157 write('Tokio spy-point placed on '), write(X), put("."), nl.
158
159 (tokionospy) :- recorded(tokiospy, _, R), erase(R), fail.
160 (tokionospy) :- tokiodebug_off.
161
162 tokionospy(F/A) :-
163 recorded(tokiospy, F/A, R), erase(R),
164 write('Tokio spy-point on '), write(F/A), write(' removed.'), nl, fail.
165 tokionospy(X) :-
166 recorded(tokiospy, X/_, R), erase(R),
167 write('Tokio spy-point on '), write(X), write(' removed.'), nl, fail.
168 tokionospy(_X) :- recorded(tokiospy, _, _), !.
169 tokionospy(_) :- tokiodebug_off.
170
171 tokiodebugging :- recorded(tokiodebug, on, _), !,
172 write('Tokio debug mode is switched on.'), nl,
173 tokiodebugging1.
174 tokiodebugging :- write('Tokio debug mode is switched off.'), nl.
175
176 tokiodebugging1 :-
177 ( setof(X, R^recorded(tokiospy, X, R), S), !,
178 ( S=[V|_], var(V), !, write('All Tokio reductions are traced.');
179 write('Tokio spy-points set on: '), write(S) ), nl;
180 true ).
181
182 /* end td */