--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tr.pl	Thu Aug 30 14:57:44 2007 +0900
@@ -0,0 +1,325 @@
+/*
+ Copyright (C) 1988,2005, Shinji Kono 
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license, but changing it is not allowed.  You can also
+ use this wording to make the terms for other programs.
+
+ send your comments to kono@ie.u-ryukyu.ac.jp
+*/
+
+/*
+
+	Tokio to prolog compiler
+		Runtime routine
+		with register list
+
+ 					Mon Aug  5 09:01:29 JST 1985
+	fix put_queue			Fri Jan 24 11:47:11 JST 1986
+	add tracer			Sun Jun 22 12:47:21 JST 1986
+	fix empty/notempty		Wed Mar  9 09:24:47 JST 1988
+        reducing compile time   	Fri Oct 14 03:27:08 JST 1988
+	add mcom and fix chop		Sat Aug  5 22:25:15 JST 1989
+        meta call supported             Sun Aug  6 00:55:42 JST 1989
+	$Header$
+*/
+
+:-dynamic(r_fififi/1).
+:-dynamic(r_skip/1).
+
+r_header :-
+ write('
+ Tokio to prolog compiler $Revision$ $Date$
+           try ?- tokio_help.
+  ').
+
+user_help :- tokio_help.
+tokio_help :-
+    nl, r_header,nl,
+write('   com(File).       : compile & compile program.    '),nl,
+write('   com(File,Output).: compile & counsult & save file.    '),nl,
+write('   pcom(File,Predicate-heads).       : compile specified predicates.    '),nl,
+write('   pcom(File,Predicate-heads,Output).: compile specified predicates.    '),nl,
+write('   mcom(File).       : preprocess '),nl,
+write('   mcom(File,Output).: preprocess & outputfile.'),nl,
+write('   restart(File).   : run tokio save file.    '),nl,
+write('   tokiodebug.      : All computation will be traced.    '),nl,
+write('   tokionodebug.    : Debug mode is switched off.    '),nl,
+write('   tokiodebugging.  : Display some informations about tracing.    '),nl,
+write('   notimebacktrack. : no time backtrack.. '),nl,
+write('   timebacktrack.   : time backtrack.. '),nl,
+write('   tokio.           : start tokio top-level. '),nl,
+write('   tokio predicate.   : run tokio program. '),nl,
+write('   reset_macro.     : Reset Macro Definition. com predicates also reset Macros.'),nl.
+% write('   tokiospy         : All predicate will be traced.   '),nl,
+% write('   tokiospy(F/N)    : Predicate F which have N arity will be traced.'),nl,
+% write('   tokionospy       : All spy point are removed.    '),nl,
+% write('   tokionospy(F/N)  : Spy point F/N will be removed.    '),nl,
+% write('   tokiodebugat(T)  : Tracing will be start at time=Time.    '),nl,
+% write('   tokionodebugat   : Start point of tracing is removed.    '),nl,
+
+r_tokio0(Goals) :-
+    cputime(Time),
+    r_do_solve(Goals, C),
+    cputime(Time1),
+    T is (Time1-Time),				% sec
+    r_tokiostats(C, T).
+r_tokio0(_Goals) :- nl, write('--fail--'), nl.
+
+r_do_solve(Goals,C) :-
+    r_put_queue(Goals, X, true, Q, Q1),
+    r_notEmpty(Q),
+  ( recorded(tokiodebug, on, _), !,
+	r_solve_t(X,C,0,Q,Q1);
+    recorded(timebacktrack, off, _), !,
+	r_solve_d(X,C,0,Q,Q1);
+    r_solve(X,C,0,Q,Q1)).
+
+notimebacktrack :- recorded(timebacktrack,_,Ref),erase(Ref),fail.
+notimebacktrack :- recorda(timebacktrack,off,_Ref).
+timebacktrack :- recorded(timebacktrack,_,Ref),erase(Ref),fail.
+timebacktrack :- recorda(timebacktrack,on,_Ref).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Quick and Easy Compile
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+r_put_queue(X, Y, Y, Q, Q) :- var(X),!,
+	write('cannot call variable:'),write(X),nl.
+r_put_queue(X, (unifyNow(X,Xn),Xn,Y), Y, Q, Q) :- systemp(X),!.
+% Tokio's varible is local, so, meta call is also local to 
+% its value. But I don't care about its arguments.
+r_put_queue('$t'(Now,_Next),Z, Z1,Q, Q1) :- !,
+	r_put_queue(Now, Z, Z1,Q, Q1).
+r_put_queue((X,Y), Z, Z1, Q, Q1) :- !,
+    r_put_queue(X,Z, Z2, Q,Q2),
+    r_put_queue(Y,Z2,Z1,Q2,Q1).
+r_put_queue(#P, (r_always(P,Q,Q1),Y), Y, Q, Q1) :- !.
+r_put_queue(next(P), (r_next(P,Q,Q1),Y), Y, Q, Q1) :- !.
+r_put_queue(length(N), (r_length(M,Q),Y), Y, Q, Q) :- !,	% restricted length
+    M is N.
+r_put_queue(P, (P1,Y), Y, Q, Q1) :-
+    functor(P, H, N), N2 is N+2, N1 is N+1,
+    functor(P1, H, N2), arg(N1, P1, Q), arg(N2, P1, Q1),
+    r_put_queue_arg(N,P,P1).
+
+r_put_queue_arg(0,_,_) :- !.
+r_put_queue_arg(M,F,F1) :-
+    arg(M,F,FA),arg(M,F1,FA),M1 is M-1,
+    r_put_queue_arg(M1,F,F1).
+
+r_tokiostats(L, T) :-  nl,
+        write(L), write(' clock and '),
+	write(T), write(' sec. '), nl.
+
+r_always(X,['$t'((r_always(Xn,Q,Q2),N),F,E,C)|Q],Q1) :- 
+	unifyNowNext(X,Xx,Xn),
+	'tokio_call'(Xx,['$t'(N,F,E,C)|Q2],Q1).
+r_next(X,['$t'(N,F,E,C)|Q],                  % same as next(tokio_call(X))
+	['$t'(N1,F,E,C)|Q1]) :- unifyNext(X,Xn),
+	r_put_queue(Xn,N,N1,Q,Q1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Tokio Temporal Resolution
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+r_solve(r_end,_Fin,_Now,_X,_Y) :- !.
+r_solve(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
+		['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-
+	NextTime is Now+1,
+	nl,write('t'),write(Now),write(':'),ttyflush,
+	call(X),
+	r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
+	r_solve(Next1, Fin, NextTime, Futures, True).
+r_solve(_,_,Now,_,_) :- B is Now-1, B>0, nl,write(b),write(B),write(':'),
+	ttyflush,!,fail.
+
+r_solve_t(r_end,_Fin,_Now,_X,_Y) :- !.
+r_solve_t(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
+		['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-
+	r_tokioDebug(t(Empty,X,Fin,Now,F,K,Next,Futures,True),Now),
+	NextTime is Now+1,
+	nl,write('t'),write(Now),write(':'),ttyflush,
+	call(X),
+	r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
+	r_solve_t(Next1, Fin, NextTime, Futures, True).
+r_solve_t(_,_,Now,_,_) :- B is Now-1, B>0, nl,write(b),write(B),write(':'),
+	ttyflush,!,fail.
+
+r_solve_d(r_end,_Fin,_Now,_X,_Y) :- !.
+r_solve_d(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures],
+		['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-!,
+	NextTime is Now+1, call(X),
+	r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1),
+	r_solve_d(Next1, Fin, NextTime, Futures, True).
+
+r_exec_fin_keep(empty,	Fin, Fin, F, _, _, r_end) :- !,	% end at this time
+	call(F).
+r_exec_fin_keep(notEmpty,	Now, Fin, _, K, Next, Next) :-
+	Now \== Fin,
+	call(K).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Chop Operator Runtime
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+r_subBegin(['$t'(_,_,_,'$'(_,Now,_))|Q],		% original interval
+	['$t'((r_subBegin(Q,SQ,SQ1,Fin),N),F,K,'$'(Fin,Now,E))|SQ],
+	['$t'(N,F,K,'$'(Fin,Now,E))|SQ1],Fin).	% subinterval's Fin
+
+r_subFin( ['$t'(_, F   , _, '$'(Fin,Fin,empty))  | _  ],	% outer fin?
+	['$t'(_, true, _, '$'(Fin,Fin,empty))  | _  ]) :-
+	call(F).
+
+r_subNotFin( LaterLoop, '$'(Q,Q1,QF,QF1),
+	['$t'(N,  F,  K,  '$'(OuterFin,Now,notEmpty)) | Q   ],
+	['$t'(N1, F1, K1, '$'(OuterFin,Now,notEmpty)) | Q1  ],
+	['$t'(N,  F,  K,  '$'(Fin,Now,Empty)) | QF ],
+	['$t'((LaterLoop,N1), F1, K1, '$'(Fin,Now,Empty)) | QF1  ]) :-
+	r_sub_check(OuterFin,Now,Fin).
+
+r_sub_check(OuterFin,Now,Fin) :- var(OuterFin),!,
+	r_sub_check2(Fin,Now).
+r_sub_check(OuterFin,Now,Fin) :- 
+	OuterFin > Now,r_sub_check3(OuterFin,Now,Fin). %%%% Fin > Now, OuterFin > Now
+r_sub_check2(Fin,_Now) :- var(Fin),!.                  %%%% freeze(Fin,Fin>Now).
+r_sub_check2(Fin,Now) :- Fin>Now.
+r_sub_check3(_OuterFin,_Now,Fin) :- var(Fin),!.       %%%% freeze(Fin,(N<F,F<O))
+r_sub_check3(OuterFin,Now,Fin) :- Now<Fin,Fin<OuterFin.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%
+% meta call ( same restriction as top level )
+%%%%%%%%%%%%%%%%%%%%%%%%%
+tokio_call(A,Q,Q) :- var(A),!,
+	write('uninstantiated meta call'),nl.
+tokio_call(A,Q,Q1) :-
+	r_put_queue(A, X, true, Q, Q1),
+	call(X).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%
+% Tokio System Call
+%%%%%%%%%%%%%%%%%%%%%%%%%
+%  Thanks for Prof. Esterline and Dr. Kilis
+r_empty(['$t'(_,_,_,'$'(F,F,empty))|_]).
+r_notEmpty(['$t'(_,_,_,'$'(F,N,notEmpty))|_]):- F\==N.
+
+r_length( 0, ['$t'(_,_,_,'$'(Fin,Fin,empty))|_] ) :-!.
+r_length( L, ['$t'(_,_,_,'$'(Fin,Now,notEmpty))|_] ) :-
+	Fin is Now+L.
+
+r_cputime(X) :- statistics(runtime,[X1,_]),X is X1/1000.
+r_cputime(X,Q,Q) :- r_cputime(X).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Static Variable Runtime
+%%%%%%%%%%%%%%%%%%%%%%%%%%%
+r_set_value(Name,Value) :- var(Value),!,
+	write('Assign non fixed value = '),
+	write(Name),nl.
+r_set_value(Name,Value) :-
+%%%%%%%	r_check(Name,Time),
+	recorded(Name,(Name,V,_Time),_),!,V=Value.
+r_set_value(Name,Value) :-
+%%%%%%%	r_check(Name,Time),
+	recorda(Name,(Name,Value,_Time),_).
+r_set_value(Name,Value) :-
+	recorded(Name,(Name,Value,_),Ref),
+	erase(Ref),!,fail.
+
+r_set_value(Name,Value,_Time) :- var(Value),!,
+	write('Assign non fixed value = '),
+	write(Name),nl.
+r_set_value(Name,Value,Time) :-
+	recorded(Name,(Name,V,Time),_),!,V=Value.
+r_set_value(Name,Value,Time) :-
+	recorda(Name,(Name,Value,Time),_).
+r_set_value(Name,Value,Time) :-
+	recorded(Name,(Name,Value,Time),Ref),
+	erase(Ref),!,fail.
+
+% Special Cases
+
+% #(A=B)
+%    variable vs varible
+%    variable vs time constance
+% *i <= ??
+
+r_eq(A,B,['$t'((r_eq(C,D,E,F),G),H,I,J)|E],['$t'(G,H,I,J)|F]) :- 
+	unifyNowNext(A,K,C),unifyNowNext(B,K,D).
+r_eqn(A,B,['$t'((r_eqn(C,B,D,E),F),G,H,I)|D],['$t'(F,G,H,I)|E]) :- 
+	unifyNowNext(A,B,C).
+r_assign(Static,A,['$t'((r_assign(Static,A,B,C),D),(r_set_value(Static,A,Time),E),F,G)|B],
+	['$t'(D,E,F,G)|C]):- G='$'(_Fin,Time,_Empty).
+
+
+
+% r_check(Name,Time) :- 
+% 	recorded(time,Time,_),
+%	(	recorded(Name,(Name,Value1,Time),_),
+%		report_conflict(Name,Name,Time)
+%	;	true),
+%	(	recorded(r_write,(Name,Bus),_),(
+%		    recorded(Bus,(Name2,Time),_),
+%		    report_conflict(Name,Name2,Time)
+%	    	;   recorda(Bus,(Name,Time),_))
+%	; true),!.
+
+r_read_value(Name,Value) :- recorded(Name,(Name,Value1,_),_),!,
+%	recorded(time,Time,_),
+%	recorda(Name,(Name,Value1,Time),_),
+%	(	recorded(r_read,(Name,Bus),_),(
+%		    recorded(Bus,(Name2,Time),_),Name2 \= Name,
+%		    report_conflict(Name,Name2,Time)
+%		;   recorda(Bus,Name,_))
+%	;	true),!,
+	Value = Value1.
+r_read_value(Name,_Value) :- nl,
+	write('Reference Not assigned value -- '),
+	write(Name),nl.
+
+init_static :- recorded(r_static,Name,_),recorded(Name,_,Ref),
+	erase(Ref),fail.
+init_static :- abolish(r_skip,1),
+	assert(r_skip(-1)).
+
+reset_static :- recorded(r_static,Name,Iref),recorded(Name,_,Ref),
+	erase(Ref),erase(Iref),fail.
+
+static([]) :- !.
+static([H|T]) :- !,static(H),static(T).
+
+
+% static(Name=Bus) :- !,static(Name),static(Bus),
+% 	r_read_bus(Name,Bus),r_write_bus(Name,Bus).
+% static(Name=[RBus,WBus]) :- !,static(Name),static(Bus),
+% 	r_read_bus(Name,RBus),r_write_bus(Name,WBus).
+static(Name) :- functor(Name,_H,_),recorded(r_static,Name,_),!.
+static(Name) :- functor(Name,_H,_),recordz(r_static,Name,_).
+
+static_memory(L) :- static(L).
+static_register(L) :- static(L).
+
+r_read_bus(Name,Bus) :-
+	(recorded(r_read,(Name,Bus),_);recordz(r_read,(Name,Bus),_)).
+r_write_bus(Name,Bus) :-
+	(recorded(r_write,(Name,Bus),_);recordz(r_write,(Name,Bus),_)).
+
+/* :- static(time). */
+
+% r_report_conflict(Name,Name2,Time) :- nl,
+% 	write('Conflict *'),
+% 	write(Name),write(' and *'),
+% 	write(Name2),write(' at '),
+% 	write(Time).
+
+% A \= A :-!,fail.
+% _ \= _.
+
+append([],X,X).
+append([H|X],Y,[H|Z]) :- append(X,Y,Z).
+
+member(H,[H|_]) :-!.
+member(H,[_|T]) :- member(H,T).
+
+/* for ttyflush  */
+
+/* :- (ttyflush ; assert(ttyflush) ). */
+
+/* end of runtime */