samer@0
|
1 :- module( qutils,
|
samer@7
|
2 [ get_message_or_timeout/2
|
samer@0
|
3 , send_with_size_limit/3
|
samer@0
|
4 ]).
|
samer@0
|
5
|
samer@0
|
6 :- meta_predicate with_message(?,0).
|
samer@0
|
7 :- meta_predicate with_message_or_timeout(+,?,0,0).
|
samer@0
|
8
|
samer@2
|
9 :- use_module(library(time)).
|
samer@5
|
10 :- use_module(library(debug)).
|
samer@2
|
11
|
samer@11
|
12 % Older versions of SWI do not have alarm_at/3
|
samer@11
|
13 :- if(\+current_predicate(alarm_at/3)).
|
samer@11
|
14 %:- writeln('% Expanding alarm_at/3 to alarm_at/4.').
|
samer@11
|
15 user:goal_expansion(alarm_at(A,B,C), alarm_at(A,B,C,[])).
|
samer@11
|
16 :- endif.
|
samer@11
|
17
|
samer@0
|
18 %% get_message_or_timeout( +TimeOut, -Msg) is det.
|
samer@0
|
19 %
|
samer@0
|
20 % Time-limited wait for next term in message queue.
|
samer@0
|
21 % Waits up to TimeOut seconds for the next message that
|
samer@0
|
22 % unifies with Msg in the current thread. If none arrives,
|
samer@0
|
23 % then Msg is unified with timeout.
|
samer@0
|
24 % NB: may fail if Msg is bound on input.
|
samer@0
|
25 get_message_or_timeout(inf,Msg) :- !, thread_get_message(Msg).
|
samer@3
|
26
|
samer@9
|
27 % Older versions of SWI do not have thread_get_message/3
|
samer@3
|
28 :- if(current_predicate(thread_get_message/3)).
|
samer@3
|
29
|
samer@9
|
30 % we have thread_get_message/3 but we may or may not have the deadline/1 option
|
samer@6
|
31 :- if(current_predicate_option(thread_get_message/3,3,deadline(_))).
|
samer@6
|
32
|
samer@11
|
33 %:- writeln('% compiling get_message_or_timeout/2 using deadline/1 option.').
|
samer@8
|
34
|
samer@14
|
35 :- if((current_prolog_flag(version,Version),Version<60102)).
|
samer@14
|
36
|
samer@6
|
37 get_message_or_timeout(Deadline,Msg) :-
|
samer@13
|
38 thread_self(Thread),
|
samer@13
|
39 ( thread_get_message(Thread,Msg,[deadline(Deadline)])
|
samer@13
|
40 -> debug(qutils,'got message: ~w.',[Msg])
|
samer@13
|
41 ; Msg=timeout).
|
samer@13
|
42
|
samer@13
|
43 % ( get_time(Now), Now<Deadline
|
samer@13
|
44 % -> thread_self(Thread),
|
samer@13
|
45 % thread_get_message(Thread,Msg,[deadline(Deadline)]),
|
samer@13
|
46 % debug(qutils,'got message: ~w.',[Msg])
|
samer@13
|
47 % ; Msg=timeout
|
samer@13
|
48 % ).
|
samer@6
|
49
|
samer@6
|
50 :- else.
|
samer@6
|
51
|
samer@14
|
52 get_message_or_timeout(Deadline,Msg) :-
|
samer@14
|
53 thread_self(Thread),
|
samer@14
|
54 ( thread_get_message(Thread,Msg,[deadline(Deadline)])
|
samer@14
|
55 -> debug(qutils,'got message: ~w.',[Msg])
|
samer@14
|
56 ; Msg=timeout
|
samer@14
|
57 ).
|
samer@14
|
58
|
samer@14
|
59 :- endif.
|
samer@14
|
60
|
samer@14
|
61 :- else.
|
samer@14
|
62
|
samer@11
|
63 %:- writeln('% compiling get_message_or_timeout/2 using timeout/1 option.').
|
samer@3
|
64 get_message_or_timeout(Deadline,Msg) :-
|
samer@3
|
65 get_time(Now),
|
samer@5
|
66 ( Now>=Deadline
|
samer@5
|
67 -> Msg=timeout,
|
samer@5
|
68 debug(qutils,'deadline already missed.',[])
|
samer@3
|
69 ; Timeout is Deadline-Now,
|
samer@3
|
70 thread_self(Thread),
|
samer@5
|
71 thread_get_message(Thread,Msg,[timeout(Timeout)]),
|
samer@5
|
72 debug(qutils,'got message: ~w.',[Msg])
|
samer@3
|
73 ).
|
samer@6
|
74 :- endif.
|
samer@3
|
75
|
samer@3
|
76 :- else.
|
samer@3
|
77
|
samer@11
|
78 %:- writeln('% compiling get_message_or_timeout/2 using alarm and message send.').
|
samer@0
|
79 get_message_or_timeout(Deadline,Msg) :-
|
samer@0
|
80 get_time(Now),
|
samer@5
|
81 ( Now>=Deadline
|
samer@5
|
82 -> Msg=timeout,
|
samer@5
|
83 debug(qutils,'deadline already missed.',[])
|
samer@0
|
84 ; thread_self(Thread),
|
samer@0
|
85 setup_call_cleanup(
|
samer@0
|
86 alarm_at(Deadline, thread_send_message(Thread,timeout), Id),
|
samer@0
|
87 thread_get_message(Thread,Msg),
|
samer@5
|
88 time:remove_alarm_notrace(Id)),
|
samer@5
|
89 debug(qutils,'got message: ~w.',[Msg])
|
samer@0
|
90 ).
|
samer@0
|
91
|
samer@3
|
92 :-endif.
|
samer@3
|
93
|
samer@0
|
94 %% send_with_size_limit( +Max:natural, +Queue:queue_id, +Msg:term) is det.
|
samer@0
|
95 %
|
samer@0
|
96 % Adds term to message queue unless queue is already full.
|
samer@0
|
97 % If message queue Queu already contains more than Max elements,
|
samer@0
|
98 % then "*" is printed and the procedure succeeds. NB. the message
|
samer@0
|
99 % is discarded.
|
samer@0
|
100 send_with_size_limit(Max,Queue,Msg) :-
|
samer@0
|
101 message_queue_property(Queue,size(QSize)),
|
samer@0
|
102 ( QSize<Max -> thread_send_message(Queue,Msg)
|
samer@0
|
103 ; writeln('*')
|
samer@0
|
104 ).
|
samer@0
|
105
|