1
2
3
4
5
6
7
8
9
10 test_timer_manager:proc;
11
12
13
14 dcl time fixed bin(71) aligned;
15
16 dcl time_char char(24);
17
18 dcl flags bit(2);
19 dcl (cex,cin) fixed bin(71) int static;
20
21 dcl status bit(72) aligned;
22 dcl j fixed bin(17);
23 dcl i fixed bin(17);
24 dcl chan fixed bin(71);
25 dcl (inhibit,command,timer_type,signal_type,time_type,routine) char(10) varying;
26 dcl release_label label int static;
27 dcl (addr,null,substr) builtin;
28
29 dcl call_entry entry variable;
30
31 dcl condition_ ext entry(char(*),entry);
32 dcl ios_$order ext entry(char(*),char(*),ptr,bit(72) aligned);
33 dcl test_timer_manager$external ext entry;
34 dcl test_timer_manager$wexternal ext entry;
35 dcl ipc_$create_ev_chn ext entry(fixed bin(71),fixed bin(17));
36 dcl ipc_$decl_ev_call_chn ext entry(fixed bin(71),entry,ptr,fixed bin(17),fixed bin(17));
37 dcl read_list_$prompt ext entry options(variable);
38 dcl (timer_manager_$alarm_call,timer_manager_$cpu_call,timer_manager_$alarm_call_inhibit,
39 timer_manager_$cpu_call_inhibit) ext entry(fixed bin(71),bit(2),entry);
40 dcl (timer_manager_$sleep,timer_manager_$sleep_lss) ext entry(fixed bin(71),bit(2));
41 dcl (timer_manager_$reset_alarm_call,timer_manager_$reset_cpu_call) ext entry(entry);
42 dcl (timer_manager_$reset_alarm_wakeup,timer_manager_$reset_cpu_wakeup) ext entry(fixed bin(71));
43 dcl (timer_manager_$alarm_interrupt,timer_manager_$cpu_time_interrupt) ext entry;
44 dcl debug ext entry;
45 dcl ioa_ ext entry options(variable);
46 dcl hcs_$usage_values ext entry(fixed bin(17),fixed bin(71));
47 dcl clock_ ext entry returns(fixed bin(71));
48 dcl (timer_manager_$cpu_wakeup,timer_manager_$alarm_wakeup) ext entry(fixed bin(71),bit(2),fixed bin(71));
49 dcl date_time_ ext entry(fixed bin(71), char(*));
50
51 call condition_("cput",timer_manager_$cpu_time_interrupt);
52 call condition_("alrm",timer_manager_$alarm_interrupt);
53
54 call ipc_$create_ev_chn(cex,j);
55 call ipc_$create_ev_chn(cin,j);
56 call ipc_$decl_ev_call_chn(cex,test_timer_manager$wexternal,null,5,j);
57 call ipc_$decl_ev_call_chn(cin,winternal,null,5,j);
58
59 release_label = command_loop;
60
61
62 command_loop:
63
64 call read_list_$prompt("c:",command);
65
66 if command = "debug" then call debug;
67
68 else if command = "release" then go to release_label;
69
70 else if command = "return" then do;
71 call ios_$order("user_i/o","start",null,status);
72 return;
73 end;
74
75 else if command = "time" then do;
76 get_type: call read_list_$prompt("type? ", time_type);
77 if substr(time_type,1,2) = "cp" then call hcs_$usage_values(j,time);
78 else if substr(time_type,1,2) = "al" then time = clock_();
79 else do;
80 call ioa_("Types are alarm or cpu.");
81 go to get_type;
82 end;
83 call date_time_(time, time_char);
84 call ioa_("^a",time_char);
85 end;
86
87 else if command = "loop" then do;
88 call read_list_$prompt("How many times? ",j);
89
90 do i = 1 to j;
91 call hcs_$usage_values(j,time);
92 end;
93 end;
94
95 else
96 reread: if command = "set" then do;
97 call read_list_$prompt("Alarm or cpu? ",timer_type,"Wakeup or call? ",signal_type,
98 "Routine external or internal? ",routine,
99 "Inhibited or enabled? ",inhibit,
100 "Absolute or relative? ",time_type,
101 "When? ",time);
102 if substr(routine,1,2) = "ex" then do; chan = cex;
103 if substr(signal_type,1,1) = "c" then
104 call find_entry(call_entry); end;
105 else if substr(routine,1,3) = "int" then chan = cin;
106 else go to reread;
107
108 if substr(time_type,1,1) = "a" then flags = "00"b;
109 else if substr(time_type,1,1) = "r" then flags = "10"b;
110 else go to reread;
111
112 if substr(timer_type,1,2) = "al"
113 then if substr(signal_type,1,1) = "w"
114 then call timer_manager_$alarm_wakeup(time,flags,chan);
115 else if substr(signal_type,1,1)="c"
116 then if chan = cex then if substr(inhibit,1,3)="inh"
117 then call timer_manager_$alarm_call_inhibit(time,flags,call_entry);
118 else call timer_manager_$alarm_call(time,flags,call_entry);
119 else if substr(inhibit,1,3)="inh"
120 then call timer_manager_$alarm_call_inhibit(time,flags,internal);
121 else call timer_manager_$alarm_call(time,flags,internal);
122 else go to reread;
123
124 else if substr(timer_type,1,2) = "cp"
125 then if substr(signal_type,1,1) = "w"
126 then call timer_manager_$cpu_wakeup(time,flags,chan);
127 else if substr(signal_type,1,1)= "c"
128 then if chan = cex then if substr(inhibit,1,3)="inh"
129 then call timer_manager_$cpu_call_inhibit(time,flags,call_entry);
130 else call timer_manager_$cpu_call(time,flags,call_entry);
131 else if substr(inhibit,1,3)="inh"
132 then call timer_manager_$cpu_call_inhibit(time,flags,internal);
133 else call timer_manager_$cpu_call(time,flags,internal);
134 else go to reread;
135
136 end;
137
138 else if command = "reset" then do;
139
140 call read_list_$prompt("Alarm or cpu? ",timer_type,"Wakeup or call? ",signal_type,
141 "Routine external or internal? ",routine);
142
143 if substr(routine,1,2) = "ex" then do; chan = cex;
144 if substr(signal_type,1,1) = "c" then
145 call find_entry(call_entry); end;
146 else if substr(routine,1,2) = "in" then chan = cin;
147 else go to reread;
148
149 if substr(timer_type,1,2) = "al"
150 then if substr(signal_type,1,1) = "w"
151 then call timer_manager_$reset_alarm_wakeup(chan);
152 else if substr(signal_type,1,1) = "c"
153 then if chan = cex then call timer_manager_$reset_alarm_call(call_entry);
154 else call timer_manager_$reset_alarm_call(internal);
155 else go to reread;
156 else if substr(timer_type,1,2) = "cp"
157 then if substr(signal_type,1,1) = "w"
158 then call timer_manager_$reset_cpu_wakeup(chan);
159 else if substr(signal_type,1,1) = "c"
160 then if chan = cex then call timer_manager_$reset_cpu_call(call_entry);
161 else call timer_manager_$reset_cpu_call(internal);
162 else go to reread;
163 else go to reread;
164
165 end;
166
167 else if substr(command,1,5) = "sleep" then do;
168
169 read_again: call read_list_$prompt("Absolute or relative? ",time_type,"How long? ",time);
170
171 if substr(time_type,1,1) = "a" then flags = "00"b;
172 else if substr(time_type,1,1) = "r" then flags = "10"b;
173 else go to read_again;
174
175 if substr(command,6,4) = "_lss" then call timer_manager_$sleep_lss(time,flags);
176 else call timer_manager_$sleep(time,flags);
177
178 end;
179
180 else call ioa_("The legal commands are:
181
182 set
183 reset
184 time
185 sleep
186 sleep_lss
187 loop
188 debug
189 return
190 release
191 ");
192
193 go to command_loop;
194
195 external:entry(mcptr1,name1);
196
197 dcl mcptr1 ptr;
198 dcl name1 char(*);
199
200 if name1 = "cput"
201 then call hcs_$usage_values(j,time);
202 else time = clock_();
203
204 call date_time_(time,time_char);
205 call ioa_("external ^a ^p ^a",name1,mcptr1,time_char);
206
207 go to command_loop;
208
209 wexternal:entry(msgptr);
210
211 dcl msgptr ptr;
212
213 dcl 1 ev_message based(msgptr),
214 2 event_channel fixed bin(71),
215 2 message char(8) aligned,
216 2 sending_process bit(36);
217
218 if ev_message.message = "alarm___" then time = clock_();
219 else call hcs_$usage_values(j,time);
220
221 call date_time_(time,time_char);
222 call ioa_("wexternal ^a ^a",ev_message.message,time_char);
223
224 go to command_loop;
225
226 internal:proc(mcptr2,name2);
227
228 dcl j fixed bin(17), time fixed bin(71);
229
230 dcl mcptr2 ptr;
231 dcl name2 char(*);
232
233 if name2 = "cput" then call hcs_$usage_values(j,time);
234 else time = clock_();
235
236 call date_time_(time,time_char);
237 call ioa_("internal ^a ^p ^a",name2,mcptr2,time_char);
238
239 end;
240
241 winternal:proc(msgptr1);
242
243 dcl j fixed bin(17), time fixed bin(71);
244
245 dcl msgptr1 ptr;
246
247 dcl 1 ev_message based(msgptr1),
248 2 event_channel fixed bin(71),
249 2 message char(8) aligned;
250
251 if message = "alarm___" then time = clock_();
252 else call hcs_$usage_values(j,time);
253
254 call date_time_(time,time_char);
255 call ioa_("winternal ^a ^a",message,time_char);
256
257 end;
258 find_entry: proc(call_entry);
259
260 dcl call_name char(168) varying;
261
262 dcl call_entry entry variable;
263 dcl 1 structure based(addr(call_entry)),
264 2 segp pointer,
265 2 actp pointer;
266
267 dcl (lg,posn) fixed bin(35);
268
269 dcl ref_name char(168);
270 dcl entry_name char(32);
271
272 dcl index builtin;
273
274 dcl error_table_$segknown ext fixed bin(35);
275 dcl expand_path_ ext entry (ptr,fixed bin(35),ptr,ptr,fixed bin(35));
276 dcl hcs_$initiate_count ext entry (char(*),char(*),char(*),fixed bin(24),fixed bin(2),ptr,fixed bin(35));
277 dcl hcs_$make_ptr ext entry (ptr,char(*),char(*),ptr,fixed bin(35));
278 dcl com_err_ ext entry options(variable);
279
280 dcl code fixed bin(35);
281
282 ask_name: call read_list_$prompt("Calling what program? ",call_name);
283
284 if call_name= "." then do;
285 call_entry = test_timer_manager$external;
286 return; end;
287
288 ref_name = call_name;
289 lg = length(call_name);
290 actp = null;
291
292
293
294 posn = index(call_name, "$");
295 if posn^=0 then do;
296 ref_name = substr(call_name,1,posn-1);
297 entry_name = substr(call_name,posn+1,lg-posn);
298 lg = posn-1;
299 end;
300 else entry_name = substr(ref_name,1,32);
301
302
303
304 posn = index(ref_name, ">");
305 if posn=0 then do;
306 posn = index(ref_name, "<");
307 if posn=0 then go to ref_okay;
308 end;
309 call expand_path_(addr(call_name),lg,addr(ref_name),addr(entry_name),code);
310 if code^=0 then do;
311 call com_err_(code,"test_timer_manager");
312 go to ask_name; end;
313 call hcs_$initiate_count(ref_name,entry_name,ref_name,0,1,segp,code);
314 if code^=0 then
315 if code^=error_table_$segknown then do;
316 call com_err_(code,"test_timer_manager");
317 go to ask_name; end;
318
319 ref_okay: call hcs_$make_ptr(null(),ref_name,entry_name,segp,code);
320 if code^=0 then do;
321 call com_err_(code,"test_timer_manager");
322 go to ask_name; end;
323
324 return;
325 end find_entry;
326 end;