1 /* ******************************************************
  2    *                                                    *
  3    *                                                    *
  4    * Copyright (c) 1972 by Massachusetts Institute of   *
  5    * Technology and Honeywell Information Systems, Inc. *
  6    *                                                    *
  7    *                                                    *
  8    ****************************************************** */
  9 
 10 progress:
 11 pg:
 12      proc;
 13 
 14 /* The progress command concatenates its arguments, and executes them as a command
 15    line.  While executing it, progress (pg) prints out the progress of the process -
 16    the cpu time used since starting, and percent of real time.  It also gives
 17    an indication of paging activity (page faults per second of cpu time).
 18 
 19    Originally written Jan 1973 by Dan Bricklin.
 20    Modified by M.A.Meer Oct 1975 to fix brief bug and allow long command lines.
 21    Modified 761026 by PG to switch to iox_.
 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 /* program */
 85 
 86           briefsw = "0"b;                                   /* we don't start in brief, usually */
 87 
 88           if io_switch = null
 89           then io_switch = iox_$user_io;
 90 
 91           call cu_$arg_ptr (1, argp, arglen, code);         /* see if we have any options */
 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;                                     /* print interval messages */
153 
154           on cleanup call cleanup_handler;                  /* what to do on cleanup */
155 
156           line_len = 0;
157 
158           farg = argno + 1;                                 /* keep index of first non option arg */
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;                                            /* allow long line */
172 
173 dcl  line char (line_len) aligned init ("");
174 
175                len = 1;                                     /* index to insert chars */
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); /* get initial time values */
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 /* this option changes the time between calls */
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;