diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

a few more fixes to support timing and to improve message queues.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1012 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2004-03-02 16:44:58 +00:00
parent 4eeceb6549
commit ddc7b3a0bc
13 changed files with 136 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
pl/init.yap
View File

@@ -66,6 +66,7 @@ not(G) :- '$current_module'(Module), '$meta_call'(not(G),Module).
'sockets.yap',
'sort.yap',
'setof.yap',
'statistics.yap',
'strict_iso.yap',
'tabling.yap',
'threads.yap',

43
pl/threads.yap
View File

@@ -277,7 +277,8 @@ message_queue_create(Cond) :-
var(Cond), !,
mutex_create(Mutex),
'$cond_create'(Cond),
recorda('$queue',q(Cond,Mutex,Cond), _).
'$mq_iname'(Cond, CName),
recorda('$queue',q(Cond,Mutex,Cond,CName), _).
message_queue_create(Name) :-
atom(Name),
recorded('$thread_alias',[Name|_],_), !,
@@ -291,18 +292,26 @@ message_queue_create(Name) :-
'$create_mq'(Name) :-
mutex_create(Mutex),
'$cond_create'(Cond),
recorda('$queue',q(Name,Mutex,Cond),_).
'$mq_iname'(Name, CName),
recorda('$queue',q(Name,Mutex,Cond, CName),_).
'$mq_iname'(I,X) :-
integer(I), !,
number_codes(I,Codes),
atom_codes(X, [0'$,0'M,0'Q,0'_|Codes]).
'$mq_iname'(A,X) :-
atom_concat('$MQ_NAME_KEY_',A,X).
message_queue_destroy(Name) :-
var(Name), !,
'$do_error'(instantiation_error,message_queue_destroy(Name)).
message_queue_destroy(Queue) :-
recorded('$queue',q(Queue,Mutex,Cond),R), !,
recorded('$queue',q(Queue,Mutex,Cond,CName),R), !,
erase(R),
'$cond_destroy'(Cond),
mutex_destroy(Mutex),
'$clean_mqueue'(Queue).
'$clean_mqueue'(CName).
message_queue_destroy(Queue) :-
atom(Queue), !,
'$do_error'(existence_error(queue,Queue),message_queue_destroy(QUeue)).
@@ -310,7 +319,7 @@ message_queue_destroy(Name) :-
'$do_error'(type_error(atom,Name),message_queue_destroy(Name)).
'$clean_mqueue'(Queue) :-
recorded('$msg_queue',q(Queue,_),R),
recorded(Queue,_,R),
erase(R),
fail.
'$clean_mqueue'(_).
@@ -319,9 +328,9 @@ thread_send_message(Queue, Term) :-
recorded('$thread_alias',[Queue|Id],_), !,
thread_send_message(Id, Term).
thread_send_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond),_),
recorded('$queue',q(Queue,Mutex,Cond,Key),_),
mutex_lock(Mutex),
recordz('$msg_queue',q(Queue,Term),_),
recordz(Key,Term,_),
'$cond_broadcast'(Cond),
mutex_unlock(Mutex).
@@ -330,29 +339,29 @@ thread_get_message(Term) :-
thread_get_message(Id, Term).
thread_get_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond),_),
recorded('$queue',q(Queue,Mutex,Cond,Key),_),
mutex_lock(Mutex),
'$thread_get_message_loop'(Queue, Term, Mutex, Cond).
'$thread_get_message_loop'(Key, Term, Mutex, Cond).
'$thread_get_message_loop'(Queue, Term, Mutex, _) :-
recorded('$msg_queue',q(Queue,Term),R), !,
'$thread_get_message_loop'(Key, Term, Mutex, _) :-
recorded(Key,Term,R), !,
erase(R),
mutex_unlock(Mutex).
'$thread_get_message_loop'(Queue, Term, Mutex, Cond) :-
'$thread_get_message_loop'(Key, Term, Mutex, Cond) :-
'$cond_wait'(Cond, Mutex),
'$thread_get_message_loop'(Queue, Term, Mutex, Cond).
'$thread_get_message_loop'(Key, Term, Mutex, Cond).
thread_peek_message(Term) :-
'$thread_self'(Id),
thread_peek_message(Id, Term).
thread_peek_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,_),_),
recorded('$queue',q(Queue,Mutex,_,Key),_),
mutex_lock(Mutex),
'$thread_peek_message2'(Queue, Term, Mutex).
'$thread_peek_message2'(Key, Term, Mutex).
'$thread_peek_message2'(Queue, Term, Mutex) :-
recorded('$msg_queue',q(Queue,Term),_), !,
'$thread_peek_message2'(Key, Term, Mutex) :-
recorded(Key,Term,_), !,
mutex_unlock(Mutex).
'$thread_peek_message2'(_, _, Mutex) :-
mutex_unlock(Mutex),

95
pl/utils.yap
View File

@@ -371,101 +371,6 @@ current_key(A,K) :-
'$current_immediate_key'(A,K).
%%% User interface for statistics
statistics :-
'$runtime'(Runtime,_),
'$cputime'(CPUtime,_),
'$walltime'(Walltime,_),
'$statistics_heap_info'(HpSpa, HpInUse),
'$statistics_heap_max'(HpMax),
'$statistics_trail_info'(TrlSpa, TrlInUse),
'$statistics_trail_max'(TrlMax),
'$statistics_stacks_info'(StkSpa, GlobInU, LocInU),
'$statistics_global_max'(GlobMax),
'$statistics_local_max'(LocMax),
'$inform_heap_overflows'(NOfHO,TotHOTime),
'$inform_stack_overflows'(NOfSO,TotSOTime),
'$inform_trail_overflows'(NOfTO,TotTOTime),
'$inform_gc'(NOfGC,TotGCTime,TotGCSize),
'$inform_agc'(NOfAGC,TotAGCTime,TotAGCSize),
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize).
'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize,NOfAGC,TotAGCTime,TotAGCSize) :-
TotalMemory is HpSpa+StkSpa+TrlSpa,
'$format'(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
'$format'(user_error," program space~t~d bytes~35+", [HpSpa]),
'$format'(user_error,":~t ~d in use~19+", [HpInUse]),
HpFree is HpSpa-HpInUse,
'$format'(user_error,",~t ~d free~19+~n", [HpFree]),
'$format'(user_error,"~t ~d max~73+~n", [HpMax]),
'$format'(user_error," stack space~t~d bytes~35+", [StkSpa]),
StackInUse is GlobInU+LocInU,
'$format'(user_error,":~t ~d in use~19+", [StackInUse]),
StackFree is StkSpa-StackInUse,
'$format'(user_error,",~t ~d free~19+~n", [StackFree]),
'$format'(user_error," global stack:~t~35+", []),
'$format'(user_error," ~t ~d in use~19+", [GlobInU]),
'$format'(user_error,",~t ~d max~19+~n", [GlobMax]),
'$format'(user_error," local stack:~t~35+", []),
'$format'(user_error," ~t ~d in use~19+", [LocInU]),
'$format'(user_error,",~t ~d max~19+~n", [LocMax]),
'$format'(user_error," trail stack~t~d bytes~35+", [TrlSpa]),
'$format'(user_error,":~t ~d in use~19+", [TrlInUse]),
TrlFree is TrlSpa-TrlInUse,
'$format'(user_error,",~t ~d free~19+~n", [TrlFree]),
OvfTime is (TotHOTime+TotSOTime+TotTOTime)/1000,
'$format'(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
[OvfTime,NOfHO,NOfSO,NOfTO]),
TotGCTimeF is float(TotGCTime)/1000,
'$format'(user_error,"~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n",
[TotGCTimeF,NOfGC,TotGCSize]),
TotAGCTimeF is float(TotAGCTime)/1000,
'$format'(user_error,"~t~3f~12+ sec. for ~w atom garbage collections which collected ~d bytes~n",
[TotAGCTimeF,NOfAGC,TotAGCSize]),
RTime is float(Runtime)/1000,
'$format'(user_error,"~t~3f~12+ sec. runtime~n", [RTime]),
CPUTime is float(CPUtime)/1000,
'$format'(user_error,"~t~3f~12+ sec. cputime~n", [CPUTime]),
WallTime is float(Walltime)/1000,
'$format'(user_error,"~t~3f~12+ sec. elapsed time~n~n", [WallTime]),
fail.
'$statistics'(_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_).
statistics(runtime,[T,L]) :-
'$runtime'(T,L).
statistics(cputime,[T,L]) :-
'$cputime'(T,L).
statistics(walltime,[T,L]) :-
'$walltime'(T,L).
%statistics(core,[_]).
%statistics(memory,[_]).
statistics(heap,[Hp,HpF]) :-
'$statistics_heap_info'(HpM, Hp),
HpF is HpM-Hp.
statistics(program,Info) :-
statistics(heap,Info).
statistics(global_stack,[GlobInU,GlobFree]) :-
'$statistics_stacks_info'(StkSpa, GlobInU, LocInU),
GlobFree is StkSpa-GlobInU-LocInU.
statistics(local_stack,[LocInU,LocFree]) :-
'$statistics_stacks_info'(StkSpa, GlobInU, LocInU),
LocFree is StkSpa-GlobInU-LocInU.
statistics(trail,[TrlInUse,TrlFree]) :-
'$statistics_trail_info'(TrlSpa, TrlInUse),
TrlFree is TrlSpa-TrlInUse.
statistics(garbage_collection,[NOfGC,TotGCSize,TotGCTime]) :-
'$inform_gc'(NOfGC,TotGCTime,TotGCSize).
statistics(stack_shifts,[NOfHO,NOfSO,NOfTO]) :-
'$inform_heap_overflows'(NOfHO,_),
'$inform_stack_overflows'(NOfSO,_),
'$inform_trail_overflows'(NOfTO,_).
key_statistics(Key, NOfEntries, TotalSize) :-
key_statistics(Key, NOfEntries, ClSize, IndxSize),
TotalSize is ClSize+IndxSize.
%%% The unknown predicate,
% informs about what the user wants to be done when
% there are no clauses for a certain predicate */