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

Represent more thread properties internally. Updated predicate threads/0 to also show thread detached status.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1766 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
pmoura 2007-01-02 02:51:31 +00:00
parent 57c480e165
commit 44adaf58cd
1 changed files with 81 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

141
pl/threads.yap
View File

@ -28,7 +28,7 @@
no_threads, !. no_threads, !.
'$init_thread0' :- '$init_thread0' :-
'$create_mq'(0), '$create_mq'(0),
'$add_thread_alias'(main, 0, '$init_thread0'), '$record_thread_info'(0, main, [0, 0, 0], false, '$init_thread0'),
recorda('$thread_defaults', [0, 0, 0, false], _). recorda('$thread_defaults', [0, 0, 0, false], _).
'$top_thread_goal'(G, Detached) :- '$top_thread_goal'(G, Detached) :-
@ -61,7 +61,8 @@ thread_create(Goal, Id) :-
( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ), ( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ),
'$thread_options'([], [], Stack, Trail, System, Detached, G0), '$thread_options'([], [], Stack, Trail, System, Detached, G0),
'$thread_new_tid'(Id), '$thread_new_tid'(Id),
'$clean_db_on_id'(Id), '$erase_thread_info'(Id),
'$record_thread_info'(Id, [Stack, Trail, System], Detached),
'$create_mq'(Id), '$create_mq'(Id),
'$create_thread'(Goal, Stack, Trail, System, Detached, Id). '$create_thread'(Goal, Stack, Trail, System, Detached, Id).
@ -71,29 +72,40 @@ thread_create(Goal, Id, Options) :-
( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ), ( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ),
'$thread_options'(Options, Alias, Stack, Trail, System, Detached, G0), '$thread_options'(Options, Alias, Stack, Trail, System, Detached, G0),
'$thread_new_tid'(Id), '$thread_new_tid'(Id),
'$clean_db_on_id'(Id), '$erase_thread_info'(Id),
'$add_thread_alias'(Alias, Id, G0), ( var(Alias) ->
'$record_thread_info'(Id, [Stack, Trail, System], Detached)
; '$record_thread_info'(Id, Alias, [Stack, Trail, System], Detached, G0)
),
'$create_mq'(Id), '$create_mq'(Id),
'$create_thread'(Goal, Stack, Trail, System, Detached, Id). '$create_thread'(Goal, Stack, Trail, System, Detached, Id).
'$clean_db_on_id'(Id) :- '$erase_thread_info'(Id) :-
recorded('$thread_exit_status', [Id|_], R), recorded('$thread_exit_status', [Id|_], R),
erase(R), erase(R),
fail. fail.
'$clean_db_on_id'(Id) :- '$erase_thread_info'(Id) :-
recorded('$thread_alias',[Id|_],R), recorded('$thread_alias',[Id|_],R),
erase(R), erase(R),
fail. fail.
'$clean_db_on_id'(Id) :- '$erase_thread_info'(Id) :-
recorded('$thread_exit_hook',[Id|_],R), recorded('$thread_sizes', [Id|_], R),
erase(R), erase(R),
fail. fail.
'$clean_db_on_id'(_). '$erase_thread_info'(Id) :-
recorded('$thread_detached', [Id|_], R),
erase(R),
fail.
'$erase_thread_info'(Id) :-
recorded('$thread_exit_hook', [Id|_], R),
erase(R),
fail.
'$erase_thread_info'(_).
'$thread_options'(V, _, _, _, _, _, G) :- var(V), !, '$thread_options'(V, _, _, _, _, _, G) :- var(V), !,
'$do_error'(instantiation_error,G). '$do_error'(instantiation_error,G).
'$thread_options'([], [], Stack, Trail, System, Detached, _) :- '$thread_options'([], _, Stack, Trail, System, Detached, _) :-
recorded('$thread_defaults', [DefaultStack, DefaultTrail, DefaultSystem, DefaultDetached], _), recorded('$thread_defaults', [DefaultStack, DefaultTrail, DefaultSystem, DefaultDetached], _),
( var(Stack) -> Stack = DefaultStack; true ), ( var(Stack) -> Stack = DefaultStack; true ),
( var(Trail) -> Trail = DefaultTrail; true ), ( var(Trail) -> Trail = DefaultTrail; true ),
@ -118,14 +130,20 @@ thread_create(Goal, Id, Options) :-
'$thread_option'(Option, _, _, _, _, _, G0) :- '$thread_option'(Option, _, _, _, _, _, G0) :-
'$do_error'(domain_error(thread_option,Option),G0). '$do_error'(domain_error(thread_option,Option),G0).
'$add_thread_alias'(Alias, Id, G) :- '$record_thread_info'(_, Alias, _, _, Goal) :-
recorded('$thread_alias',[_|Alias],_), !, recorded('$thread_alias', [_|Alias], _), !,
'$do_error'(permission_error(create,thread,alias(Alias)),G). '$do_error'(permission_error(create,thread,alias(Alias)), Goal).
'$add_thread_alias'(Alias, Id, _) :- '$record_thread_info'(Id, Alias, Sizes, Detached, _) :-
recorda('$thread_alias',[Id|Alias],_). recorda('$thread_alias', [Id|Alias], _),
'$record_thread_info'(Id, Sizes, Detached).
thread_defaults(Defaults) :- nonvar(Defaults), !, '$record_thread_info'(Id, Sizes, Detached) :-
'$do_error'(type_error(variable,Id),thread_defaults(Defaults)). recorda('$thread_sizes', [Id|Sizes], _),
recorda('$thread_detached', [Id|Detached], _).
thread_defaults(Defaults) :-
nonvar(Defaults), !,
'$do_error'(type_error(variable,Id), thread_defaults(Defaults)).
thread_defaults([stack(Stack), trail(Trail), system(System), detached(Detached)]) :- thread_defaults([stack(Stack), trail(Trail), system(System), detached(Detached)]) :-
recorded('$thread_defaults',[Stack, Trail, System, Detached], _). recorded('$thread_defaults',[Stack, Trail, System, Detached], _).
@ -215,11 +233,7 @@ thread_self(Id) :-
'$do_error'(domain_error(thread_or_alias, Id), thread_self(Id)). '$do_error'(domain_error(thread_or_alias, Id), thread_self(Id)).
thread_self(Id) :- thread_self(Id) :-
'$thread_self'(Id0), '$thread_self'(Id0),
'$check_thread_alias'(Id0,Id). '$thread_id_to_alias'(Id0,Id).
'$check_thread_alias'(Id0,Id) :-
recorded('$thread_alias',[Id0|Id],_), !.
'$check_thread_alias'(Id,Id).
/* Exit status may be either true, false, exception(Term), or exited(Term) */ /* Exit status may be either true, false, exception(Term), or exited(Term) */
thread_join(Id, Status) :- thread_join(Id, Status) :-
@ -227,7 +241,7 @@ thread_join(Id, Status) :-
'$do_error'(type_error(variable,Status),thread_join(Id, Status)). '$do_error'(type_error(variable,Status),thread_join(Id, Status)).
thread_join(Id, Status) :- thread_join(Id, Status) :-
'$check_thread_or_alias'(Id, thread_join(Id, Status)), '$check_thread_or_alias'(Id, thread_join(Id, Status)),
'$check_thread_alias'(Id0,Id), '$thread_id_to_alias'(Id0,Id),
'$thread_join'(Id0), '$thread_join'(Id0),
'$erase_thread_aliases'(Id0), '$erase_thread_aliases'(Id0),
recorded('$thread_exit_status',[Id0|Status],R), recorded('$thread_exit_status',[Id0|Status],R),
@ -242,14 +256,14 @@ thread_join(Id, Status) :-
thread_cancel(Id) :- thread_cancel(Id) :-
'$check_thread_or_alias'(Id, thread_cancel(Id)), '$check_thread_or_alias'(Id, thread_cancel(Id)),
'$check_thread_alias'(Id0,Id), '$thread_id_to_alias'(Id0,Id),
'$erase_thread_aliases'(Id0), '$erase_thread_aliases'(Id0),
'$unlock_all_thread_mutexes'(Id0), '$unlock_all_thread_mutexes'(Id0),
'$thread_destroy'(Id0). '$thread_destroy'(Id0).
thread_detach(Id) :- thread_detach(Id) :-
'$check_thread_or_alias'(Id, thread_detach(Id)), '$check_thread_or_alias'(Id, thread_detach(Id)),
'$check_thread_alias'(Id0,Id), '$thread_id_to_alias'(Id0,Id),
'$detach_thread'(Id0). '$detach_thread'(Id0).
thread_exit(Term) :- thread_exit(Term) :-
@ -276,33 +290,13 @@ thread_at_exit(Goal) :-
'$thread_self'(Id0), '$thread_self'(Id0),
recordz('$thread_exit_hook',[Id0|Goal],_). recordz('$thread_exit_hook',[Id0|Goal],_).
current_thread(Tid, Status) :- current_thread(Id, Status) :-
var(Tid), !, thread_property(Id, status(Status)).
'$cur_threads'(0, Tid, Status).
current_thread(Tid, Status) :-
( atom(Tid) ; integer(Tid) ), !,
'$check_thread_alias'(Id0,Tid),
'$valid_thread'(Id0),
'$thr_status'(Id0, Status).
current_thread(Tid, Status) :-
'$do_error'(type_error(integer,Tid),current_thread(Tid, Status)).
'$cur_threads'(Tid, TidName, Status) :-
'$valid_thread'(Tid),
'$thr_status'(Tid, Status),
'$tid_to_alias'(Tid,TidName).
'$cur_threads'(Tid, TidF, Status) :-
'$valid_thread'(Tid),
Tid1 is Tid+1,
'$cur_threads'(Tid1, TidF, Status).
'$thr_status'(Tid, Status) :- '$thread_id_to_alias'(Id, Alias) :-
recorded('$thread_exit_status', [Tid|Status], _), !. recorded('$thread_alias', [Id|Alias], _), !.
'$thr_status'(_, running). '$thread_id_to_alias'(Id, Id).
'$tid_to_alias'(Tid,TidName) :-
recorded('$thread_alias', [Tid|TidName], _), !.
'$tid_to_alias'(Tid,Tid).
mutex_create(V) :- mutex_create(V) :-
@ -581,7 +575,7 @@ thread_sleep(Time) :-
thread_signal(Id, Goal) :- thread_signal(Id, Goal) :-
'$check_thread_or_alias'(Id, thread_signal(Id, Goal)), '$check_thread_or_alias'(Id, thread_signal(Id, Goal)),
'$check_callable'(Goal, thread_signal(Id, Goal)). '$check_callable'(Goal, thread_signal(Id, Goal)).
'$check_thread_alias'(Id0, Id), '$thread_id_to_alias'(Id0, Id),
( recorded('$thread_signal', [Id0| _], R), erase(R), fail ( recorded('$thread_signal', [Id0| _], R), erase(R), fail
; true ; true
), ),
@ -602,27 +596,51 @@ thread_property(Prop) :-
thread_property(Id, Prop) :- thread_property(Id, Prop) :-
( nonvar(Id) -> ( nonvar(Id) ->
'$check_thread_or_alias'(Id, thread_property(Id, Prop)) '$check_thread_or_alias'(Id, thread_property(Id, Prop))
; true ; '$current_thread'(Id)
), ),
'$check_thread_property'(Prop, thread_property(Id, Prop)), '$check_thread_property'(Prop, thread_property(Id, Prop)),
'$check_thread_alias'(Id0, Id), '$thread_id_to_alias'(Id0, Id),
'$thread_property'(Id0, Prop). '$thread_property'(Id0, Prop).
'$thread_property'(Id, alias(Alias)) :- '$thread_property'(Id, alias(Alias)) :-
recorded('$thread_alias', [Id|Alias], _). recorded('$thread_alias', [Id|Alias], _).
'$thread_property'(Id, status(Status)) :- '$thread_property'(Id, status(Status)) :-
'$thr_status'(Id, Status). ( recorded('$thread_exit_status', [Id|Exit], _) ->
Status = Exit
; Status = running
).
'$thread_property'(Id, detached(Detached)) :-
recorded('$thread_detached', [Id|Detached], _).
'$thread_property'(Id, stack(Stack)) :-
recorded('$thread_sizes', [Id, Stack, _, _], _).
'$thread_property'(Id, trail(Trail)) :-
recorded('$thread_sizes', [Id, _, Trail, _], _).
'$thread_property'(Id, system(System)) :-
recorded('$thread_sizes', [Id, _, _, System], _).
'$current_thread'(Id) :-
'$current_thread'(0, Id).
'$current_thread'(Id, Id) :-
'$valid_thread'(Id).
'$current_thread'(Id, NextId) :-
'$valid_thread'(Id),
Id2 is Id + 1,
'$current_thread'(Id2, NextId).
threads :- threads :-
write('--------------------------------------------------------------'), nl, write('------------------------------------------------------------------------'), nl,
format("~t~a~38+~n", 'Thread Status'), format("~t~a~48+~n", 'Thread Detached Status'),
write('--------------------------------------------------------------'), nl, write('------------------------------------------------------------------------'), nl,
current_thread(Thread, Status), thread_property(Thread, detached(Detached)),
format("~t~q~30+ ~q~n", [Thread, Status]), thread_property(Thread, status(Status)),
'$thread_id_to_alias'(Thread, Alias),
format("~t~q~30+~33|~w~42|~q~n", [Alias, Detached, Status]),
fail. fail.
threads :- threads :-
write('--------------------------------------------------------------'), nl. write('------------------------------------------------------------------------'), nl.
'$check_thread_or_alias'(Term, Goal) :- '$check_thread_or_alias'(Term, Goal) :-
@ -644,5 +662,8 @@ threads :-
'$check_thread_property'(alias(_), _) :- !. '$check_thread_property'(alias(_), _) :- !.
'$check_thread_property'(detached(_), _) :- !. '$check_thread_property'(detached(_), _) :- !.
'$check_thread_property'(status(_), _) :- !. '$check_thread_property'(status(_), _) :- !.
'$check_thread_property'(stack(_), _) :- !.
'$check_thread_property'(trail(_), _) :- !.
'$check_thread_property'(system(_), _) :- !.
'$check_thread_property'(Term, Goal) :- '$check_thread_property'(Term, Goal) :-
'$do_error'(domain_error(thread_property, Term), Goal). '$do_error'(domain_error(thread_property, Term), Goal).