1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) BULL HN Information Systems Inc., 1990   *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 
 10 
 11 /****^  HISTORY COMMENTS:
 12   1) change(90-08-07,Vu), approve(90-08-07,MCR8189),
 13      audit(90-09-24,WAAnderson), install(90-10-02,MR12.4-1036):
 14      Error message from tune_disk without arguments is malformed.
 15                                                    END HISTORY COMMENTS */
 16 
 17 
 18 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */
 19 tune_disk:
 20 td:
 21      proc;
 22 
 23 /* User level procedure to control the tuning of the disk system. */
 24 
 25 /* Created 84-05-23, by T. Oke */
 26 /* Auditting changes by Chris Jones, August 1984 */
 27 
 28 dcl       arg                    char (arg_len) based (arg_ptr);
 29 dcl       arg_count              fixed bin;
 30 dcl       arg_index              fixed bin;
 31 dcl       arg_len                fixed bin (21);
 32 dcl       arg_list_ptr           ptr;
 33 dcl       arg_ptr                ptr;
 34 
 35 dcl       brief                  bit (1) initial ("1"b);
 36 dcl       code                   fixed bin (35);
 37 dcl       i                      fixed bin;
 38 dcl       MYNAME                 char (9) static options (constant) initial ("tune_disk");
 39 dcl       prev_arg               char (256) varying;
 40 dcl       reason                 char (64) varying;
 41 dcl       stagnate               fixed bin (35);
 42 dcl       time                   float bin (27);
 43 
 44 
 45 dcl       1 o                    like opt_info_tune;
 46 dcl       1 s                    like sys_info_tune;
 47 
 48 dcl       error_table_$bad_arg   fixed bin (35) ext;
 49 dcl       error_table_$noarg     fixed bin (35) ext;
 50 
 51 dcl       cu_$arg_count_rel      entry (fixed bin, ptr, fixed bin (35));
 52 dcl       cu_$arg_list_ptr       entry (ptr);
 53 dcl       cu_$arg_ptr_rel        entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr);
 54 dcl       com_err_               entry () options (variable);
 55 dcl       hphcs_$disk_tune       entry (char (*), ptr, char (*) varying, fixed bin (35));
 56 dcl       ioa_                   entry () options (variable);
 57 
 58 dcl       (addr, after, before, bin, float, null, substr) builtin;
 59 
 60 dcl       conversion             condition;
 61 ^L
 62 /* Get arguments. */
 63 
 64           on conversion goto bad_arg;
 65 
 66           call cu_$arg_list_ptr (arg_list_ptr);
 67           call init_args;
 68 
 69           if ^get_next_arg () then do;
 70                call ioa_ (
 71                     "Usage:^a drive_name io_type -load n -response m -or-^/^a reset_max -or-^/^a reset_sys -or-^/^a stagnate seconds -or-^/^a system io_type -max n -map io_type"
 72                     , MYNAME, MYNAME, MYNAME, MYNAME, MYNAME);
 73 
 74                call ioa_ ("     io_type is one of: ^(^a ^)", io_name);
 75                return;
 76           end;
 77 
 78           else if arg = "reset_max" | arg = "reset_sys" then do;
 79                call hphcs_$disk_tune (arg, null (), reason, code);
 80                if code ^= 0 then
 81                     goto print_code;
 82                return;
 83           end;
 84           else if arg = "stagnate" then do;
 85                if ^get_next_arg () then
 86                     goto no_arg;
 87                time = float (arg);
 88                stagnate = time * 1000000.0;
 89                if stagnate < 0 | stagnate > 360000000 then do;
 90                     call com_err_ (error_table_$bad_arg, MYNAME, "0 <= stagnate time <= 6 minutes.");
 91                     return;
 92                end;
 93 
 94                call hphcs_$disk_tune (STAGNATE_TIME, addr (stagnate), reason, code);
 95                if code ^= 0 then
 96                     goto print_code;
 97                return;
 98           end;
 99 
100           else if arg = "system" then do;
101                s.type = get_io_type ();
102                s.max_depth, s.map = -1;
103 sys_arg_loop:
104                if ^get_next_arg () then
105                     goto sys_arg_done;
106                if arg = "-max" then do;                     /* sys max_load */
107                     if ^get_next_arg () then
108                          goto no_arg;
109                     s.max_depth = bin (arg, 35);
110                     goto sys_arg_loop;
111                end;
112                else if arg = "-map" then do;                /* sys depth map */
113                     s.map = get_io_type ();
114                     goto sys_arg_loop;
115                end;
116                goto bad_arg;
117 
118 sys_arg_done:
119                if s.map < 0 & s.max_depth < 1 then
120                     return;                                 /* nothing modified */
121 
122                call hphcs_$disk_tune (SYS_TUNE, addr (s), reason, code);
123                if code ^= 0 then
124                     goto print_code;
125                return;
126           end;
127 
128           else if arg_len > 5 then
129                if substr (arg, 1, 3) = "dsk" & substr (arg, 5, 1) = "_" then do;
130                                                             /* sub-system */
131                     o.sub_sys = before (arg, "_");          /* sub_sys name */
132                     o.dev = bin (after (arg, "_"), 17);     /* device number */
133                     o.type = get_io_type ();                /* io type to tune */
134                     o.load, o.response = -1;
135 
136 opt_arg_loop:
137                     if ^get_next_arg () then
138                          goto opt_arg_done;
139                     if arg = "-load" | arg = "-ld" then do; /* load limit */
140                          if ^get_next_arg () then
141                               goto no_arg;
142                          o.load = bin (arg, 17);
143                          goto opt_arg_loop;
144                     end;
145                     else if arg = "-response" | arg = "-rsp" then do;
146                                                             /* response */
147                          if ^get_next_arg () then
148                               goto no_arg;
149                          o.response = bin (arg, 35);
150                          goto opt_arg_loop;
151                     end;
152                     goto bad_arg;
153 
154 opt_arg_done:
155                     if o.load < 1 then do;
156                          call com_err_ (error_table_$noarg, MYNAME, "-load must be specified and >1.");
157                     end;
158 
159                     if o.response < 1 then do;
160                          call com_err_ (error_table_$noarg, MYNAME, "-response must be specified and >1.");
161                     end;
162                     if o.response < 1 | o.load < 1 then
163                          return;
164 
165                     call hphcs_$disk_tune (OPT_TUNE, addr (o), reason, code);
166                     if code ^= 0 then
167                          goto print_code;
168                     return;
169                end;
170           goto bad_arg;
171 
172 exit:
173           return;
174 
175 no_arg:
176           call com_err_ (error_table_$noarg, MYNAME, "after " || prev_arg);
177           return;
178 
179 bad_arg:
180           call com_err_ (error_table_$bad_arg, MYNAME, arg);
181           return;
182 
183 print_code:
184           call com_err_ (code, MYNAME, "Reason given is ""^a"".", reason);
185           return;
186 ^L
187 /* initialize argument processing. */
188 
189 init_args:
190      proc;
191 
192 dcl       code                   fixed bin (35);
193 
194           arg_index = 1;
195           call cu_$arg_count_rel (arg_count, arg_list_ptr, code);
196           if code ^= 0 then
197                arg_count = 0;
198           return;
199 
200 /* Get next arguments.  Returns "0"b if failure. */
201 
202 get_next_arg:
203      entry returns (bit (1));
204 
205           if arg_index <= 1 then
206                prev_arg = "";
207           else prev_arg = arg;
208 
209           if arg_index <= arg_count then do;
210                call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_len, code, arg_list_ptr);
211                if code = 0 then do;
212                     arg_index = arg_index + 1;
213                     return ("1"b);                          /* success */
214                end;
215           end;
216           return ("0"b);                                    /* no argument */
217 
218 
219 get_io_type:
220      entry returns (fixed bin);
221 
222           if ^get_next_arg () then
223                goto no_arg;
224 
225           if arg = "test" then do;
226                call com_err_ (error_table_$bad_arg, MYNAME, "Cannot set TEST parms.");
227                goto exit;
228           end;
229 
230           do i = 0 to MAX_IO_NAME;
231                if arg = io_name (i) then
232                     return (i);
233           end;
234           call com_err_ (error_table_$bad_arg, MYNAME, "Unknown IO type " || arg || ".");
235           goto exit;
236 
237      end init_args;
238 ^L
239 %include disk_tune;
240      end tune_disk;