1
2
3
4
5
6
7
8
9
10 abs_control: proc;
11
12
13
14
15 dcl
16 (cu_$arg_count entry (fixed bin(17)),
17 cu_$arg_ptr entry (fixed bin(17), ptr, fixed bin(17), fixed bin(35)),
18 exec_com entry (char(*)),
19 date_time_ entry (fixed bin(71),char(*)),
20 com_err_ entry options(variable),
21 cv_dec_check_ entry (char(*),fixed bin(35)) returns (fixed bin(35)),
22 ipc_$create_ev_chn entry (fixed bin(71), fixed bin(35)),
23 ipc_$decl_ev_call_chn entry(fixed bin(71), entry, ptr, fixed bin(17), fixed bin(35)),
24 hcs_$make_seg entry (char(*), char(*), char(*), fixed bin(5), ptr, fixed bin(35)),
25 hcs_$acl_add1 entry (char(*),char(*),char(*),fixed bin(5),dim(3) fixed bin(6), fixed bin(35)),
26 get_process_id_ entry() returns (bit(36)),
27 iox_$control entry(ptr, char(*), ptr, fixed bin(35)),
28 timer_manager_$sleep entry (fixed bin(71), bit(2)),
29 user_info_ entry(char(*),char(*)),
30 ioa_$rsnnl entry options(variable),
31 ioa_ entry options(variable),
32 hcs_$wakeup entry(bit(36),fixed bin(71),fixed bin(71),fixed bin(35)))
33 external;
34
35 dcl iox_$user_io ptr external;
36 dcl (null,clock) builtin;
37
38
39 dcl (elapsed_mins, elapsed_time) float bin;
40 dcl i fixed bin;
41 dcl date_string char(24);
42 dcl (dirlength, nargs, arglen, index) fixed bin(17);
43 dcl code fixed bin(35);
44 dcl ringbr(3) fixed bin(6) init(4,4,4);
45 dcl (argptr, msgptr) ptr;
46 dcl dirname char(168);
47 dcl user_id char(32);
48 dcl project_id char(12);
49
50 dcl arg char(arglen) based(argptr);
51
52 dcl 1 control_info based(segptr),
53 2 low_sleep_time fixed bin(35),
54 2 high_sleep_time fixed bin(35),
55 2 ipc_channel fixed bin(71),
56 2 ipc_second_channel fixed bin(71),
57 2 start_time fixed bin(71),
58 2 end_time fixed bin(71),
59 2 process_id bit(36),
60 2 sender_total fixed bin(35),
61 2 sender_count fixed bin(35),
62 2 (vcpusum, memusum, tcpusum, pfsum, vcpuave, memuave, tcpuave, pfave) float bin,
63 2 pad fixed bin(35),
64 2 process_array (50),
65 3 virtual_cpu float bin,
66 3 memory float bin,
67 3 total_cpu float bin,
68 3 demand_page float bin,
69 3 slave_ev_chan fixed bin(71),
70 3 slave_proc_id bit(36),
71 3 pad bit(36);
72
73 dcl event_message fixed bin(71);
74 dcl 1 ev_msg based(msgptr) aligned,
75 2 ev_channel fixed bin(71),
76 2 ev_message fixed bin(71),
77 2 sending_proc bit(36),
78 2 origin,
79 3 dev_signal bit(18) unal,
80 3 sender_ring bit(18) unal,
81 2 data_ptr ptr;
82
83 dcl (startup, ending) bit(1) aligned internal static;
84 dcl segptr ptr static init(null);
85 dcl error_table_$itt_overflow fixed bin(35) ext static;
86
87
88 startup,
89 ending = "0"b;
90 call user_info_(user_id,project_id);
91 call ioa_$rsnnl(">udd>^a>^a",dirname,dirlength,project_id,user_id);
92 call hcs_$make_seg(dirname,"abs_control_info","",01011b,segptr,code);
93 if segptr=null() then
94 do;
95 err_ret:
96 call com_err_(code,"abs_control","cannot initiate control of absentee jobs");
97 return;
98 end;
99 control_info.sender_count = 0;
100 call cu_$arg_count(nargs);
101 if nargs^=1 then if nargs ^= 3
102 then do;
103 arg_number_error:
104 startup,
105 ending = "1"b;
106 call com_err_(0,"abs_control","arg count error");
107 return;
108 end;
109 call cu_$arg_ptr(1,argptr,arglen,code);
110 control_info.sender_total = cv_dec_check_(arg,code);
111 if code^=0
112 then do;
113 arg_error:
114 startup,
115 ending = "1"b;
116 call com_err_(0,"abs_control","bad argument");
117 return;
118 end;
119 common_init:
120 index = nargs - 1;
121 control_info.low_sleep_time = 2000000;
122 control_info.high_sleep_time = 15000000;
123 if index > 0 then do;
124 call cu_$arg_ptr(index,argptr,arglen,code);
125 control_info.low_sleep_time = cv_dec_check_(arg,code) * 1e6;
126 if code ^= 0 then go to arg_error;
127 call cu_$arg_ptr(index+1,argptr,arglen,code);
128 control_info.high_sleep_time = cv_dec_check_(arg,code) * 1e6;
129 if code ^= 0 then go to arg_error;
130 if index = 1 then return;
131 end;
132
133 call hcs_$acl_add1(dirname,"abs_control_info","*.*.*",01000b,ringbr,code);
134 if code^=0 then go to err_ret;
135 call ipc_$create_ev_chn(control_info.ipc_channel, code);
136 if code^=0 then go to err_ret;
137 call ipc_$decl_ev_call_chn(control_info.ipc_channel, synch, null(), 1, code);
138 if code^=0 then go to err_ret;
139 call ipc_$create_ev_chn(control_info.ipc_second_channel, code);
140 if code^=0 then go to err_ret;
141 call ipc_$decl_ev_call_chn(control_info.ipc_second_channel, interrupt, null(), 1, code);
142 if code^=0 then go to err_ret;
143 process_id=get_process_id_();
144 return;
145
146 set_sleep_time: entry;
147 call cu_$arg_count(nargs);
148 if nargs ^= 2 then go to arg_number_error;
149 else go to common_init;
150
151 synch: entry(msgptr);
152 if ^startup then do;
153 control_info.sender_count = sender_count+1;
154 control_info.slave_proc_id(control_info.sender_count) = ev_msg.sending_proc;
155 control_info.slave_ev_chan(control_info.sender_count) = ev_msg.ev_message;
156 if control_info.sender_count = control_info.sender_total then do;
157 force_start: entry;
158 control_info.sender_total = control_info.sender_count;
159 startup = "1"b;
160 control_info.vcpusum, control_info.memusum, control_info.tcpusum, control_info.pfsum = 0e0;
161 call exec_com("reset_meters");
162 do index = 1 to control_info.sender_total;
163 event_message = index;
164 code = error_table_$itt_overflow;
165 do i=1 to 6 while(code = error_table_$itt_overflow);
166 call hcs_$wakeup(control_info.process_array(index).slave_proc_id,
167 control_info.process_array(index).slave_ev_chan, event_message, code);
168 if code = error_table_$itt_overflow
169 then call timer_manager_$sleep(10, "11"b);
170 end;
171 if code ^= 0 then call com_err_(code,"abs_control","wakeup error");
172 end;
173 control_info.sender_count = 0;
174 control_info.start_time = clock();
175 call date_time_(control_info.start_time,date_string);
176 call ioa_("^3/BEGINNING OF METERING TEST
177 end;
178 end;
179 call iox_$control (iox_$user_io,"start",null,code);
180 return;
181
182 interrupt:entry(msgptr);
183
184 if ^ending then do;
185 control_info.sender_count = control_info.sender_count+1;
186 index = ev_msg.ev_message;
187 control_info.vcpusum = control_info.vcpusum + control_info.process_array(index).virtual_cpu;
188 control_info.memusum = control_info.memusum + control_info.process_array(index).memory;
189 control_info.tcpusum = control_info.tcpusum + control_info.process_array(index).total_cpu;
190 control_info.pfsum = control_info.pfsum + control_info.process_array(index).demand_page;
191 call ioa_(" time ^.3f and memory units ^.3f from process ^d",
192 control_info.process_array(index).virtual_cpu, control_info.process_array(index).memory, index);
193 if control_info.sender_count = control_info.sender_total
194 then do;
195 force_end: entry;
196 ending = "1"b;
197 control_info.end_time = clock();
198 call date_time_(control_info.end_time,date_string);
199 call ioa_ ("^3/END OF METERING TEST
200 control_info.vcpuave = control_info.vcpusum/control_info.sender_count;
201 control_info.memuave = control_info.memusum/control_info.sender_count;
202 control_info.tcpuave = control_info.tcpusum/control_info.sender_count;
203 control_info.pfave = control_info.pfsum/control_info.sender_count;
204 call exec_com("print_meters");
205 call ioa_ ("^3/END OF SUMMARIES");
206 end;
207 end;
208 call iox_$control(iox_$user_io,"start",null,code);
209 return;
210
211 print_totals: entry;
212
213 elapsed_time = (control_info.end_time - control_info.start_time) * 1e-6;
214 elapsed_mins = elapsed_time / 6e1;
215 call ioa_(" ELAPSED REAL TIME IS ^.3f secs (^.3f mins)",
216 elapsed_time, elapsed_mins);
217 call ioa_ ("^2/SUMMARIES FOLLOW:^/");
218 call ioa_ ("NUMBER OF PROCESSES: ^d^/", control_info.sender_count);
219 call ioa_ (" VIRTUAL CPU MEMORY UNITS TOTAL CPU PAGE FAULTS");
220 call ioa_ ("TOTALS ^15.3f^15.3f^15.3f^15.0f", control_info.vcpusum, control_info.memusum,
221 control_info.tcpusum, control_info.pfsum);
222 call ioa_ ("AVERAGES ^15.3f^15.3f^15.3f^15.0f", control_info.vcpuave, control_info.memuave,
223 control_info.tcpuave, control_info.pfave);
224 return;
225
226 end abs_control;