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

Added missing declaration for meta-predicate thread_create/2. Added support for consulting and defining the default value of detached/1 thread creation option.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1759 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
pmoura 2006-12-31 19:33:27 +00:00
parent ce1694aa15
commit 6e0c674f13
1 changed files with 26 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
pl/threads.yap
View File

@ -17,6 +17,7 @@
:- meta_predicate :- meta_predicate
thread_create(:,-,+), thread_create(:,-,+),
thread_create(:,-),
thread_at_exit(:), thread_at_exit(:),
thread_signal(+,:). thread_signal(+,:).
@ -27,7 +28,7 @@
'$init_thread0' :- '$init_thread0' :-
'$create_mq'(0), '$create_mq'(0),
'$add_thread_aliases'([main], 0), '$add_thread_aliases'([main], 0),
recorda('$thread_defaults', [0, 0, 0], _). recorda('$thread_defaults', [0, 0, 0, false], _).
'$top_thread_goal'(G, Detached) :- '$top_thread_goal'(G, Detached) :-
'$thread_self'(Id), '$thread_self'(Id),
@ -54,13 +55,14 @@
'$run_at_thread_exit'(Id0). '$run_at_thread_exit'(Id0).
thread_create(Goal, Id) :- thread_create(Goal, Id) :-
G0 = thread_create(Goal, Id),
'$check_callable'(Goal, thread_create(Goal, Id)), '$check_callable'(Goal, thread_create(Goal, Id)),
( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ), ( nonvar(Id) -> '$do_error'(type_error(variable,Id),G0) ; true ),
recorded('$thread_defaults', [Stack, Trail, System], _), '$thread_options'([], Aliases, Stack, Trail, System, Detached, G0),
'$thread_new_tid'(Id), '$thread_new_tid'(Id),
'$clean_db_on_id'(Id), '$clean_db_on_id'(Id),
'$create_mq'(Id), '$create_mq'(Id),
'$create_thread'(Goal, Stack, Trail, System, _, Id). '$create_thread'(Goal, Stack, Trail, System, Detached, Id).
thread_create(Goal, Id, Options) :- thread_create(Goal, Id, Options) :-
G0 = thread_create(Goal, Id, Options), G0 = thread_create(Goal, Id, Options),
@ -90,18 +92,19 @@ thread_create(Goal, Id, Options) :-
'$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, _, _) :- '$thread_options'([], [], Stack, Trail, System, Detached, _) :-
recorded('$thread_defaults', [DefaultStack, DefaultTrail, DefaultSystem], _), 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 ),
( var(System) -> System = DefaultSystem; true ). ( var(System) -> System = DefaultSystem; true ),
( var(Detached) -> Detached = DefaultDetached; true ).
'$thread_options'([Opt|Opts], Aliases, Stack, Trail, System, Detached, G0) :- '$thread_options'([Opt|Opts], Aliases, Stack, Trail, System, Detached, G0) :-
'$thread_option'(Opt, Aliases, Stack, Trail, System, Detached, G0, Aliases0), '$thread_option'(Opt, Aliases, Stack, Trail, System, Detached, G0, Aliases0),
'$thread_options'(Opts, Aliases0, Stack, Trail, System, Detached, G0). '$thread_options'(Opts, Aliases0, Stack, Trail, System, Detached, G0).
'$thread_option'(Option, Aliases, _, _, _, _, G0, Aliases) :- var(Option), !, '$thread_option'(Option, Aliases, _, _, _, _, G0, Aliases) :- var(Option), !,
'$do_error'(instantiation_error,G0). '$do_error'(instantiation_error,G0).
'$thread_option'(stacks(Stack), Aliases, Stack, _, _, _, G0, Aliases) :- !, '$thread_option'(stack(Stack), Aliases, Stack, _, _, _, G0, Aliases) :- !,
( \+ integer(Stack) -> '$do_error'(type_error(integer,Stack),G0) ; true ). ( \+ integer(Stack) -> '$do_error'(type_error(integer,Stack),G0) ; true ).
'$thread_option'(trail(Trail), Aliases, _, Trail, _, _, G0, Aliases) :- !, '$thread_option'(trail(Trail), Aliases, _, Trail, _, _, G0, Aliases) :- !,
( \+ integer(Trail) -> '$do_error'(type_error(integer,Trail),G0) ; true ). ( \+ integer(Trail) -> '$do_error'(type_error(integer,Trail),G0) ; true ).
@ -112,7 +115,7 @@ thread_create(Goal, Id, Options) :-
'$thread_option'(detached(B), Aliases, _, _, _, B, G0, Aliases) :- !, '$thread_option'(detached(B), Aliases, _, _, _, B, G0, Aliases) :- !,
( B \== true, B \== false -> '$do_error'(domain_error(flag_value,B+[true,false]),G0) ; true ). ( B \== true, B \== false -> '$do_error'(domain_error(flag_value,B+[true,false]),G0) ; true ).
'$thread_option'(Option, Aliases, _, _, _, _, G0, Aliases) :- '$thread_option'(Option, Aliases, _, _, _, _, G0, Aliases) :-
'$do_error'(domain_error(thread_create_option,Option+[stacks(_),trail(_),system(_),alias(_),detached(_)]),G0). '$do_error'(domain_error(thread_create_option,Option+[stack(_),trail(_),system(_),alias(_),detached(_)]),G0).
'$add_thread_aliases'([Alias|_], Id) :- '$add_thread_aliases'([Alias|_], Id) :-
recorded('$thread_alias',[_|Alias],_), !, recorded('$thread_alias',[_|Alias],_), !,
@ -124,8 +127,8 @@ thread_create(Goal, Id, Options) :-
thread_defaults(Defaults) :- nonvar(Defaults), !, thread_defaults(Defaults) :- nonvar(Defaults), !,
'$do_error'(type_error(variable,Id),thread_defaults(Defaults)). '$do_error'(type_error(variable,Id),thread_defaults(Defaults)).
thread_defaults([stack(Stack), trail(Trail), system(System)]) :- thread_defaults([stack(Stack), trail(Trail), system(System), detached(Detached)]) :-
recorded('$thread_defaults',[Stack, Trail, System], _). recorded('$thread_defaults',[Stack, Trail, System, Detached], _).
thread_set_defaults(V) :- var(V), !, thread_set_defaults(V) :- var(V), !,
'$do_error'(instantiation_error, thread_set_defaults(V)). '$do_error'(instantiation_error, thread_set_defaults(V)).
@ -146,8 +149,8 @@ thread_set_defaults(T) :-
Stack < 0, !, Stack < 0, !,
'$do_error'(domain_error(not_less_than_zero, Stack), G). '$do_error'(domain_error(not_less_than_zero, Stack), G).
'$thread_set_default'(stack(Stack), G) :- !, '$thread_set_default'(stack(Stack), G) :- !,
recorded('$thread_defaults', [_, Trail, System], _), recorded('$thread_defaults', [_, Trail, System, Detached], _),
recorda('$thread_defaults', [Stack, Trail, System], _). recorda('$thread_defaults', [Stack, Trail, System, Detached], _).
'$thread_set_default'(trail(Trail), G) :- '$thread_set_default'(trail(Trail), G) :-
\+ integer(Trail), !, \+ integer(Trail), !,
@ -156,8 +159,8 @@ thread_set_defaults(T) :-
Trail < 0, !, Trail < 0, !,
'$do_error'(domain_error(not_less_than_zero, Trail), G). '$do_error'(domain_error(not_less_than_zero, Trail), G).
'$thread_set_default'(trail(Trail), G) :- !, '$thread_set_default'(trail(Trail), G) :- !,
recorded('$thread_defaults', [Stack, _, System], _), recorded('$thread_defaults', [Stack, _, System, Detached], _),
recorda('$thread_defaults', [Stack, Trail, System], _). recorda('$thread_defaults', [Stack, Trail, System, Detached], _).
'$thread_set_default'(system(System), G) :- '$thread_set_default'(system(System), G) :-
\+ integer(System), !, \+ integer(System), !,
@ -166,8 +169,15 @@ thread_set_defaults(T) :-
System < 0, !, System < 0, !,
'$do_error'(domain_error(not_less_than_zero, System), G0). '$do_error'(domain_error(not_less_than_zero, System), G0).
'$thread_set_default'(system(System), G) :- !, '$thread_set_default'(system(System), G) :- !,
recorded('$thread_defaults', [Stack, Trail, _], _), recorded('$thread_defaults', [Stack, Trail, _, Detached], _),
recorda('$thread_defaults', [Stack, Trail, System], _). recorda('$thread_defaults', [Stack, Trail, System, Detached], _).
'$thread_set_default'(detached(Detached), G) :-
Detached \== true, Detached \== false, !,
'$do_error'(type_error(boolean, Detached), G).
'$thread_set_default'(detached(Detached), G) :- !,
recorded('$thread_defaults', [Stack, Trail, System, _], _),
recorda('$thread_defaults', [Stack, Trail, System, Detached], _).
'$thread_set_default'(Default, G) :- '$thread_set_default'(Default, G) :-
'$do_error'(domain_error(thread_default, Default), G). '$do_error'(domain_error(thread_default, Default), G).