1
2
3
4
5
6
7
8
9
10 progress:
11 pg:
12 proc;
13
14
15
16
17
18
19
20
21
22
23
24
25 dcl
26 addr builtin,
27 arg char (arglen) based (argp) unaligned,
28 arg_list_ptr ptr,
29 arglen fixed bin,
30 argno fixed bin,
31 argp ptr,
32 briefsw bit (1),
33 cleanup condition,
34 clock_ entry returns (fixed bin (71)),
35 code fixed bin (35),
36 com_err_ entry options (variable),
37 cpu_delta1 float bin,
38 cpu_delta2 float bin,
39 cpu_percent1 float bin,
40 cpu_percent2 float bin,
41 cpu_sw bit (1) int static init ("1"b),
42 cpu_time_and_paging_ entry (fixed bin, fixed bin (71), fixed bin),
43 cput1 fixed bin (71),
44 cput2 fixed bin (71),
45 cput3 fixed bin (71),
46 cu_$arg_list_ptr entry (ptr),
47 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)),
48 cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr),
49 cu_$cp entry (ptr, fixed bin, fixed bin (35)),
50 cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)),
51 divide builtin,
52 error_table_$badopt fixed bin (35) ext,
53 farg fixed bin,
54 i fixed bin,
55 io_switch ptr int static init (null),
56 ioa_$ioa_switch entry options (variable),
57 iox_$look_iocb entry (char (*), ptr, fixed bin (35)),
58 iox_$user_io ptr external static,
59 len fixed bin,
60 line char (256) init (" "),
61 line_len fixed bin,
62 max builtin,
63 null builtin,
64 on_sw bit (1) int static init ("1"b),
65 pf_per_sec float bin,
66 pf1 fixed bin,
67 pf2 fixed bin,
68 pf3 fixed bin,
69 pp1 fixed bin,
70 pp2 fixed bin,
71 pp3 fixed bin,
72 real_delta1 float bin,
73 real_delta2 float bin,
74 realt1 fixed bin (71),
75 realt2 fixed bin (71),
76 realt3 fixed bin (71),
77 (index, substr) builtin,
78 time_between_calls fixed bin (71) int static init (10000000),
79 timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry),
80 timer_manager_$cpu_call entry (fixed bin (71), bit (2), entry),
81 timer_manager_$reset_alarm_call entry (entry),
82 timer_manager_$reset_cpu_call entry (entry);
83 ^L
84
85
86 briefsw = "0"b;
87
88 if io_switch = null
89 then io_switch = iox_$user_io;
90
91 call cu_$arg_ptr (1, argp, arglen, code);
92 if code = 0 then
93 if index (arg, "-") = 1 then do;
94
95 if arg = "-brief" | arg = "-bf"
96 then do;
97 briefsw = "1"b;
98 argno = 1;
99 go to common;
100 end;
101
102 if arg = "-increment" | arg = "-ic" then go to get_delta;
103
104 if arg = "-os" | arg = "-output_switch" | arg = "-output_stream"
105 then do;
106 call cu_$arg_ptr (2, argp, arglen, code);
107 if code ^= 0
108 then do;
109 call com_err_ (code, "progress", "Switchname missing.");
110 return;
111 end;
112
113 call iox_$look_iocb (arg, io_switch, code);
114 if code ^= 0
115 then do;
116 call com_err_ (code, "progress", "^a", arg);
117 return;
118 end;
119 return;
120 end;
121
122 if arg = "-on"
123 then do;
124 on_sw = "1"b;
125 return;
126 end;
127
128 if arg = "-off"
129 then do;
130 on_sw = "0"b;
131 return;
132 end;
133
134 if arg = "-cput"
135 then do;
136 cpu_sw = "1"b;
137 go to get_delta;
138 end;
139
140 if arg = "-realt"
141 then do;
142 cpu_sw = "0"b;
143 go to get_delta;
144 end;
145
146 call com_err_ (error_table_$badopt, "progress", arg);
147 return;
148 end;
149
150 argno = 0;
151 common:
152 on_sw = "1"b;
153
154 on cleanup call cleanup_handler;
155
156 line_len = 0;
157
158 farg = argno + 1;
159
160 loop:
161 argno = argno + 1;
162 call cu_$arg_ptr (argno, argp, arglen, code);
163 if code = 0 then do;
164 line_len = line_len + arglen + 1;
165 go to loop;
166 end;
167
168
169 call cu_$arg_list_ptr (arg_list_ptr);
170
171 begin;
172
173 dcl line char (line_len) aligned init ("");
174
175 len = 1;
176 do i = farg to argno - 1;
177 call cu_$arg_ptr_rel (i, argp, arglen, code, arg_list_ptr);
178 substr (line, len, arglen) = arg;
179 len = len + arglen + 1;
180 end;
181
182 call cpu_time_and_paging_ (pf1, cput1, pp1);
183 realt1 = clock_ ();
184
185 pf2 = pf1;
186 cput2 = cput1;
187 pp2 = pp1;
188 realt2 = realt1;
189
190 if ^briefsw then
191 if cpu_sw then call timer_manager_$cpu_call (cput1 + time_between_calls, "00"b, interval);
192 else call timer_manager_$alarm_call (realt1 + time_between_calls, "00"b, interval);
193
194 call cu_$cp (addr (line), line_len, code);
195
196 if ^briefsw then
197 if cpu_sw then call timer_manager_$reset_cpu_call (interval);
198 else call timer_manager_$reset_alarm_call (interval);
199
200 call cpu_time_and_paging_ (pf3, cput3, pp3);
201 realt3 = clock_ ();
202
203 cpu_delta1 = float (cput3 - cput1)/1000000.0;
204 real_delta1 = float (realt3 - realt1)/1000000.0;
205 cpu_percent1 = float (100 * cpu_delta1)/real_delta1;
206 pf_per_sec = float (pf3 - pf1)/cpu_delta1;
207
208 call ioa_$ioa_switch (io_switch, "finished: ^.2f/^.2f = ^.2f% (^.2f (^f))",
209 cpu_delta1, real_delta1, cpu_percent1, pf_per_sec, pf3-pf1);
210
211 end;
212
213 return;
214 ^L
215
216
217 get_delta:
218 call cu_$arg_ptr (2, argp, arglen, code);
219 if code ^= 0 then do;
220 call com_err_ (code, "progress", "This argument is the time interval in seconds.");
221 return;
222 end;
223
224 i = cv_dec_check_ (arg, code);
225 if code ^= 0 then do;
226 call com_err_ (0, "progress", "Bad number: ^a", arg);
227 return;
228 end;
229
230 time_between_calls = 1000000 * i;
231
232 return;
233 ^L
234 cleanup_handler:
235 proc;
236
237 if cpu_sw then call timer_manager_$reset_cpu_call (interval);
238 else call timer_manager_$reset_alarm_call (interval);
239
240 return;
241
242 end;
243 ^L
244 interval:
245 proc;
246
247 call cpu_time_and_paging_ (pf3, cput3, pp3);
248 realt3 = clock_ ();
249
250 cpu_delta1 = float (cput3 - cput1)/1000000.0;
251 real_delta1 = float (realt3 - realt1)/1000000.0;
252 cpu_percent1 = float (100 * cpu_delta1)/real_delta1;
253 cpu_delta2 = float (cput3 - cput2)/1000000.0;
254 real_delta2 = float (realt3 - realt2)/1000000.0;
255 cpu_percent2 = float (100 * cpu_delta2)/real_delta2;
256 pf_per_sec = float (pf3 - pf2)/cpu_delta2;
257
258 if on_sw then call ioa_$ioa_switch (io_switch, "^.2f/^.2f = ^.2f%, ^.2f/^.2f = ^.2f% (^.2f (^f))",
259 cpu_delta1, real_delta1, cpu_percent1, cpu_delta2, real_delta2, cpu_percent2,
260 pf_per_sec, pf3-pf2);
261
262 cput2 = cput3;
263 pf2 = pf3;
264 realt2 = realt3;
265 pp2 = pp3;
266
267 if cpu_sw then call timer_manager_$cpu_call (cput3 + time_between_calls, "00"b, interval);
268 else call timer_manager_$alarm_call (realt3 + time_between_calls, "00"b, interval);
269
270 return;
271
272 end;
273
274 end;