Mercurial > hg > Applications > Tokio
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 */ |