|
0
|
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
|
|
|
12 Tokio to prolog compiler
|
|
|
13 Runtime routine
|
|
|
14 with register list
|
|
|
15
|
|
|
16 Mon Aug 5 09:01:29 JST 1985
|
|
|
17 fix put_queue Fri Jan 24 11:47:11 JST 1986
|
|
|
18 add tracer Sun Jun 22 12:47:21 JST 1986
|
|
|
19 fix empty/notempty Wed Mar 9 09:24:47 JST 1988
|
|
|
20 reducing compile time Fri Oct 14 03:27:08 JST 1988
|
|
|
21 add mcom and fix chop Sat Aug 5 22:25:15 JST 1989
|
|
|
22 meta call supported Sun Aug 6 00:55:42 JST 1989
|
|
|
23 $Header$
|
|
|
24 */
|
|
|
25
|
|
|
26 :-dynamic(r_fififi/1).
|
|
|
27 :-dynamic(r_skip/1).
|
|
|
28
|
|
|
29 r_header :-
|
|
|
30 write('
|
|
|
31 Tokio to prolog compiler $Revision$ $Date$
|
|
|
32 try ?- tokio_help.
|
|
|
33 ').
|
|
|
34
|
|
|
35 user_help :- tokio_help.
|
|
|
36 tokio_help :-
|
|
|
37 nl, r_header,nl,
|
|
|
38 write(' com(File). : compile & compile program. '),nl,
|
|
|
39 write(' com(File,Output).: compile & counsult & save file. '),nl,
|
|
|
40 write(' pcom(File,Predicate-heads). : compile specified predicates. '),nl,
|
|
|
41 write(' pcom(File,Predicate-heads,Output).: compile specified predicates. '),nl,
|
|
|
42 write(' mcom(File). : preprocess '),nl,
|
|
|
43 write(' mcom(File,Output).: preprocess & outputfile.'),nl,
|
|
|
44 write(' restart(File). : run tokio save file. '),nl,
|
|
|
45 write(' tokiodebug. : All computation will be traced. '),nl,
|
|
|
46 write(' tokionodebug. : Debug mode is switched off. '),nl,
|
|
|
47 write(' tokiodebugging. : Display some informations about tracing. '),nl,
|
|
|
48 write(' notimebacktrack. : no time backtrack.. '),nl,
|
|
|
49 write(' timebacktrack. : time backtrack.. '),nl,
|
|
|
50 write(' tokio. : start tokio top-level. '),nl,
|
|
|
51 write(' tokio predicate. : run tokio program. '),nl,
|
|
|
52 write(' reset_macro. : Reset Macro Definition. com predicates also reset Macros.'),nl.
|
|
|
53 % write(' tokiospy : All predicate will be traced. '),nl,
|
|
|
54 % write(' tokiospy(F/N) : Predicate F which have N arity will be traced.'),nl,
|
|
|
55 % write(' tokionospy : All spy point are removed. '),nl,
|
|
|
56 % write(' tokionospy(F/N) : Spy point F/N will be removed. '),nl,
|
|
|
57 % write(' tokiodebugat(T) : Tracing will be start at time=Time. '),nl,
|
|
|
58 % write(' tokionodebugat : Start point of tracing is removed. '),nl,
|
|
|
59
|
|
|
60 r_tokio0(Goals) :-
|
|
|
61 cputime(Time),
|
|
|
62 r_do_solve(Goals, C),
|
|
|
63 cputime(Time1),
|
|
|
64 T is (Time1-Time), % sec
|
|
|
65 r_tokiostats(C, T).
|
|
|
66 r_tokio0(_Goals) :- nl, write('--fail--'), nl.
|
|
|
67
|
|
|
68 r_do_solve(Goals,C) :-
|
|
|
69 r_put_queue(Goals, X, true, Q, Q1),
|
|
|
70 r_notEmpty(Q),
|
|
|
71 ( recorded(tokiodebug, on, _), !,
|
|
|
72 r_solve_t(X,C,0,Q,Q1);
|
|
|
73 recorded(timebacktrack, off, _), !,
|
|
|
74 r_solve_d(X,C,0,Q,Q1);
|
|
|
75 r_solve(X,C,0,Q,Q1)).
|
|
|
76
|
|
|
77 notimebacktrack :- recorded(timebacktrack,_,Ref),erase(Ref),fail.
|
|
|
78 notimebacktrack :- recorda(timebacktrack,off,_Ref).
|
|
|
79 timebacktrack :- recorded(timebacktrack,_,Ref),erase(Ref),fail.
|
|
|
80 timebacktrack :- recorda(timebacktrack,on,_Ref).
|
|
|
81
|
|
|
82 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
83 % Quick and Easy Compile
|
|
|
84 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
85 r_put_queue(X, Y, Y, Q, Q) :- var(X),!,
|
|
|
86 write('cannot call variable:'),write(X),nl.
|
|
|
87 r_put_queue(X, (unifyNow(X,Xn),Xn,Y), Y, Q, Q) :- systemp(X),!.
|
|
|
88 % Tokio's varible is local, so, meta call is also local to
|
|
|
89 % its value. But I don't care about its arguments.
|
|
|
90 r_put_queue('$t'(Now,_Next),Z, Z1,Q, Q1) :- !,
|
|
|
91 r_put_queue(Now, Z, Z1,Q, Q1).
|
|
|
92 r_put_queue((X,Y), Z, Z1, Q, Q1) :- !,
|
|
|
93 r_put_queue(X,Z, Z2, Q,Q2),
|
|
|
94 r_put_queue(Y,Z2,Z1,Q2,Q1).
|
|
|
95 r_put_queue(#P, (r_always(P,Q,Q1),Y), Y, Q, Q1) :- !.
|
|
|
96 r_put_queue(next(P), (r_next(P,Q,Q1),Y), Y, Q, Q1) :- !.
|
|
|
97 r_put_queue(length(N), (r_length(M,Q),Y), Y, Q, Q) :- !, % restricted length
|
|
|
98 M is N.
|
|
|
99 r_put_queue(P, (P1,Y), Y, Q, Q1) :-
|
|
|
100 functor(P, H, N), N2 is N+2, N1 is N+1,
|
|
|
101 functor(P1, H, N2), arg(N1, P1, Q), arg(N2, P1, Q1),
|
|
|
102 r_put_queue_arg(N,P,P1).
|
|
|
103
|
|
|
104 r_put_queue_arg(0,_,_) :- !.
|
|
|
105 r_put_queue_arg(M,F,F1) :-
|
|
|
106 arg(M,F,FA),arg(M,F1,FA),M1 is M-1,
|
|
|
107 r_put_queue_arg(M1,F,F1).
|
|
|
108
|
|
|
109 r_tokiostats(L, T) :- nl,
|
|
|
110 write(L), write(' clock and '),
|
|
|
111 write(T), write(' sec. '), nl.
|
|
|
112
|
|
|
113 r_always(X,['$t'((r_always(Xn,Q,Q2),N),F,E,C)|Q],Q1) :-
|
|
|
114 unifyNowNext(X,Xx,Xn),
|
|
|
115 'tokio_call'(Xx,['$t'(N,F,E,C)|Q2],Q1).
|
|
|
116 r_next(X,['$t'(N,F,E,C)|Q], % same as next(tokio_call(X))
|
|
|
117 ['$t'(N1,F,E,C)|Q1]) :- unifyNext(X,Xn),
|
|
|
118 r_put_queue(Xn,N,N1,Q,Q1).
|
|
|
119
|
|
|
120 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
121 % Tokio Temporal Resolution
|
|
|
122 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
123 r_solve(r_end,_Fin,_Now,_X,_Y) :- !.
|
|
|
124 r_solve(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
|
|
|
125 ['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-
|
|
|
126 NextTime is Now+1,
|
|
|
127 nl,write('t'),write(Now),write(':'),ttyflush,
|
|
|
128 call(X),
|
|
|
129 r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
|
|
|
130 r_solve(Next1, Fin, NextTime, Futures, True).
|
|
|
131 r_solve(_,_,Now,_,_) :- B is Now-1, B>0, nl,write(b),write(B),write(':'),
|
|
|
132 ttyflush,!,fail.
|
|
|
133
|
|
|
134 r_solve_t(r_end,_Fin,_Now,_X,_Y) :- !.
|
|
|
135 r_solve_t(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
|
|
|
136 ['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-
|
|
|
137 r_tokioDebug(t(Empty,X,Fin,Now,F,K,Next,Futures,True),Now),
|
|
|
138 NextTime is Now+1,
|
|
|
139 nl,write('t'),write(Now),write(':'),ttyflush,
|
|
|
140 call(X),
|
|
|
141 r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
|
|
|
142 r_solve_t(Next1, Fin, NextTime, Futures, True).
|
|
|
143 r_solve_t(_,_,Now,_,_) :- B is Now-1, B>0, nl,write(b),write(B),write(':'),
|
|
|
144 ttyflush,!,fail.
|
|
|
145
|
|
|
146 r_solve_d(r_end,_Fin,_Now,_X,_Y) :- !.
|
|
|
147 r_solve_d(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
|
|
|
148 ['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-!,
|
|
|
149 NextTime is Now+1, call(X),
|
|
|
150 r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
|
|
|
151 r_solve_d(Next1, Fin, NextTime, Futures, True).
|
|
|
152
|
|
|
153 r_exec_fin_keep(empty, Fin, Fin, F, _, _, r_end) :- !, % end at this time
|
|
|
154 call(F).
|
|
|
155 r_exec_fin_keep(notEmpty, Now, Fin, _, K, Next, Next) :-
|
|
|
156 Now \== Fin,
|
|
|
157 call(K).
|
|
|
158
|
|
|
159 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
160 % Chop Operator Runtime
|
|
|
161 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
162 r_subBegin(['$t'(_,_,_,'$'(_,Now,_))|Q], % original interval
|
|
|
163 ['$t'((r_subBegin(Q,SQ,SQ1,Fin),N),F,K,'$'(Fin,Now,E))|SQ],
|
|
|
164 ['$t'(N,F,K,'$'(Fin,Now,E))|SQ1],Fin). % subinterval's Fin
|
|
|
165
|
|
|
166 r_subFin( ['$t'(_, F , _, '$'(Fin,Fin,empty)) | _ ], % outer fin?
|
|
|
167 ['$t'(_, true, _, '$'(Fin,Fin,empty)) | _ ]) :-
|
|
|
168 call(F).
|
|
|
169
|
|
|
170 r_subNotFin( LaterLoop, '$'(Q,Q1,QF,QF1),
|
|
|
171 ['$t'(N, F, K, '$'(OuterFin,Now,notEmpty)) | Q ],
|
|
|
172 ['$t'(N1, F1, K1, '$'(OuterFin,Now,notEmpty)) | Q1 ],
|
|
|
173 ['$t'(N, F, K, '$'(Fin,Now,Empty)) | QF ],
|
|
|
174 ['$t'((LaterLoop,N1), F1, K1, '$'(Fin,Now,Empty)) | QF1 ]) :-
|
|
|
175 r_sub_check(OuterFin,Now,Fin).
|
|
|
176
|
|
|
177 r_sub_check(OuterFin,Now,Fin) :- var(OuterFin),!,
|
|
|
178 r_sub_check2(Fin,Now).
|
|
|
179 r_sub_check(OuterFin,Now,Fin) :-
|
|
|
180 OuterFin > Now,r_sub_check3(OuterFin,Now,Fin). %%%% Fin > Now, OuterFin > Now
|
|
|
181 r_sub_check2(Fin,_Now) :- var(Fin),!. %%%% freeze(Fin,Fin>Now).
|
|
|
182 r_sub_check2(Fin,Now) :- Fin>Now.
|
|
|
183 r_sub_check3(_OuterFin,_Now,Fin) :- var(Fin),!. %%%% freeze(Fin,(N<F,F<O))
|
|
|
184 r_sub_check3(OuterFin,Now,Fin) :- Now<Fin,Fin<OuterFin.
|
|
|
185
|
|
|
186 %%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
187 % meta call ( same restriction as top level )
|
|
|
188 %%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
189 tokio_call(A,Q,Q) :- var(A),!,
|
|
|
190 write('uninstantiated meta call'),nl.
|
|
|
191 tokio_call(A,Q,Q1) :-
|
|
|
192 r_put_queue(A, X, true, Q, Q1),
|
|
|
193 call(X).
|
|
|
194
|
|
|
195 %%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
196 % Tokio System Call
|
|
|
197 %%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
198 % Thanks for Prof. Esterline and Dr. Kilis
|
|
|
199 r_empty(['$t'(_,_,_,'$'(F,F,empty))|_]).
|
|
|
200 r_notEmpty(['$t'(_,_,_,'$'(F,N,notEmpty))|_]):- F\==N.
|
|
|
201
|
|
|
202 r_length( 0, ['$t'(_,_,_,'$'(Fin,Fin,empty))|_] ) :-!.
|
|
|
203 r_length( L, ['$t'(_,_,_,'$'(Fin,Now,notEmpty))|_] ) :-
|
|
|
204 Fin is Now+L.
|
|
|
205
|
|
|
206 r_cputime(X) :- statistics(runtime,[X1,_]),X is X1/1000.
|
|
|
207 r_cputime(X,Q,Q) :- r_cputime(X).
|
|
|
208
|
|
|
209
|
|
|
210 %%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
211 % Static Variable Runtime
|
|
|
212 %%%%%%%%%%%%%%%%%%%%%%%%%%%
|
|
|
213 r_set_value(Name,Value) :- var(Value),!,
|
|
|
214 write('Assign non fixed value = '),
|
|
|
215 write(Name),nl.
|
|
|
216 r_set_value(Name,Value) :-
|
|
|
217 %%%%%%% r_check(Name,Time),
|
|
|
218 recorded(Name,(Name,V,_Time),_),!,V=Value.
|
|
|
219 r_set_value(Name,Value) :-
|
|
|
220 %%%%%%% r_check(Name,Time),
|
|
|
221 recorda(Name,(Name,Value,_Time),_).
|
|
|
222 r_set_value(Name,Value) :-
|
|
|
223 recorded(Name,(Name,Value,_),Ref),
|
|
|
224 erase(Ref),!,fail.
|
|
|
225
|
|
|
226 r_set_value(Name,Value,_Time) :- var(Value),!,
|
|
|
227 write('Assign non fixed value = '),
|
|
|
228 write(Name),nl.
|
|
|
229 r_set_value(Name,Value,Time) :-
|
|
|
230 recorded(Name,(Name,V,Time),_),!,V=Value.
|
|
|
231 r_set_value(Name,Value,Time) :-
|
|
|
232 recorda(Name,(Name,Value,Time),_).
|
|
|
233 r_set_value(Name,Value,Time) :-
|
|
|
234 recorded(Name,(Name,Value,Time),Ref),
|
|
|
235 erase(Ref),!,fail.
|
|
|
236
|
|
|
237 % Special Cases
|
|
|
238
|
|
|
239 % #(A=B)
|
|
|
240 % variable vs varible
|
|
|
241 % variable vs time constance
|
|
|
242 % *i <= ??
|
|
|
243
|
|
|
244 r_eq(A,B,['$t'((r_eq(C,D,E,F),G),H,I,J)|E],['$t'(G,H,I,J)|F]) :-
|
|
|
245 unifyNowNext(A,K,C),unifyNowNext(B,K,D).
|
|
|
246 r_eqn(A,B,['$t'((r_eqn(C,B,D,E),F),G,H,I)|D],['$t'(F,G,H,I)|E]) :-
|
|
|
247 unifyNowNext(A,B,C).
|
|
|
248 r_assign(Static,A,['$t'((r_assign(Static,A,B,C),D),(r_set_value(Static,A,Time),E),F,G)|B],
|
|
|
249 ['$t'(D,E,F,G)|C]):- G='$'(_Fin,Time,_Empty).
|
|
|
250
|
|
|
251
|
|
|
252
|
|
|
253 % r_check(Name,Time) :-
|
|
|
254 % recorded(time,Time,_),
|
|
|
255 % ( recorded(Name,(Name,Value1,Time),_),
|
|
|
256 % report_conflict(Name,Name,Time)
|
|
|
257 % ; true),
|
|
|
258 % ( recorded(r_write,(Name,Bus),_),(
|
|
|
259 % recorded(Bus,(Name2,Time),_),
|
|
|
260 % report_conflict(Name,Name2,Time)
|
|
|
261 % ; recorda(Bus,(Name,Time),_))
|
|
|
262 % ; true),!.
|
|
|
263
|
|
|
264 r_read_value(Name,Value) :- recorded(Name,(Name,Value1,_),_),!,
|
|
|
265 % recorded(time,Time,_),
|
|
|
266 % recorda(Name,(Name,Value1,Time),_),
|
|
|
267 % ( recorded(r_read,(Name,Bus),_),(
|
|
|
268 % recorded(Bus,(Name2,Time),_),Name2 \= Name,
|
|
|
269 % report_conflict(Name,Name2,Time)
|
|
|
270 % ; recorda(Bus,Name,_))
|
|
|
271 % ; true),!,
|
|
|
272 Value = Value1.
|
|
|
273 r_read_value(Name,_Value) :- nl,
|
|
|
274 write('Reference Not assigned value -- '),
|
|
|
275 write(Name),nl.
|
|
|
276
|
|
|
277 init_static :- recorded(r_static,Name,_),recorded(Name,_,Ref),
|
|
|
278 erase(Ref),fail.
|
|
|
279 init_static :- abolish(r_skip,1),
|
|
|
280 assert(r_skip(-1)).
|
|
|
281
|
|
|
282 reset_static :- recorded(r_static,Name,Iref),recorded(Name,_,Ref),
|
|
|
283 erase(Ref),erase(Iref),fail.
|
|
|
284
|
|
|
285 static([]) :- !.
|
|
|
286 static([H|T]) :- !,static(H),static(T).
|
|
|
287
|
|
|
288
|
|
|
289 % static(Name=Bus) :- !,static(Name),static(Bus),
|
|
|
290 % r_read_bus(Name,Bus),r_write_bus(Name,Bus).
|
|
|
291 % static(Name=[RBus,WBus]) :- !,static(Name),static(Bus),
|
|
|
292 % r_read_bus(Name,RBus),r_write_bus(Name,WBus).
|
|
|
293 static(Name) :- functor(Name,_H,_),recorded(r_static,Name,_),!.
|
|
|
294 static(Name) :- functor(Name,_H,_),recordz(r_static,Name,_).
|
|
|
295
|
|
|
296 static_memory(L) :- static(L).
|
|
|
297 static_register(L) :- static(L).
|
|
|
298
|
|
|
299 r_read_bus(Name,Bus) :-
|
|
|
300 (recorded(r_read,(Name,Bus),_);recordz(r_read,(Name,Bus),_)).
|
|
|
301 r_write_bus(Name,Bus) :-
|
|
|
302 (recorded(r_write,(Name,Bus),_);recordz(r_write,(Name,Bus),_)).
|
|
|
303
|
|
|
304 /* :- static(time). */
|
|
|
305
|
|
|
306 % r_report_conflict(Name,Name2,Time) :- nl,
|
|
|
307 % write('Conflict *'),
|
|
|
308 % write(Name),write(' and *'),
|
|
|
309 % write(Name2),write(' at '),
|
|
|
310 % write(Time).
|
|
|
311
|
|
|
312 % A \= A :-!,fail.
|
|
|
313 % _ \= _.
|
|
|
314
|
|
|
315 append([],X,X).
|
|
|
316 append([H|X],Y,[H|Z]) :- append(X,Y,Z).
|
|
|
317
|
|
|
318 member(H,[H|_]) :-!.
|
|
|
319 member(H,[_|T]) :- member(H,T).
|
|
|
320
|
|
|
321 /* for ttyflush */
|
|
|
322
|
|
|
323 /* :- (ttyflush ; assert(ttyflush) ). */
|
|
|
324
|
|
|
325 /* end of runtime */
|
