1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 tc:  proc;
 14 
 15 /* This program includes those scheduler functions which
 16    are used infrequently enough that the code is appropriately
 17    written in pl1 and not permanently wired-down */
 18 
 19 /* Coded May 1975 by RE Mullen for priority scheduler */
 20 /* tune_work_class entry added RE Mullen for deadline scheduler */
 21 /* Modified 29 October by M. Pierret for pin_weight and io_priority */
 22 /* Modified June 1981 by J. Bongiovanni for governed work classes */
 23 /* Modified May 1982 by J. Bongiovanni for interactive_q */
 24 /* Modified November 1984 by M. Pandolf to include hc_lock. */
 25 
 26 % include tcm;
 27 % include hc_lock;
 28 % include apte;
 29 
 30 dcl 1 wci aligned like work_class_info;
 31 
 32 % include work_class_info;
 33 dcl (i, max_wc, wct_base) fixed bin;
 34 dcl  hundth_of_credits fixed bin;
 35 dcl  hundth_of_scatter fixed bin;
 36 dcl (apte_count, sum, wcnum, size_of_wct_entry) fixed bin (35);
 37 dcl  ptwp ptr;
 38 dcl  oldmask fixed bin (71);
 39 dcl  code fixed bin (35);
 40 
 41 dcl  tc_data$ external;
 42 
 43 dcl (
 44      error_table_$action_not_performed,
 45      error_table_$obsolete_function,
 46      error_table_$bad_work_class,
 47      error_table_$bad_arg)
 48      external static fixed bin (35);
 49 
 50 dcl  clock_ entry returns (fixed bin (71));
 51 dcl (pxss$lock_apt, pxss$unlock_apt) entry ();              /* only way to touch apt lock */
 52 
 53 dcl  pmut$wire_and_mask entry (fixed bin (71), ptr);
 54 dcl  pmut$unwire_unmask entry (fixed bin (71), ptr);
 55 dcl  wire_proc$wire_me entry ();
 56 dcl  wire_proc$unwire_me entry ();
 57 
 58 dcl (addr, addrel, bin, divide, fixed, rel, size) builtin;
 59 
 60 /* END DCLS */
 61 
 62 /* ^L */
 63 
 64 
 65 tune_work_class: entry (a_wctup, a_code);
 66 
 67 dcl  a_wctup ptr;
 68 dcl  wctup ptr;
 69 
 70 dcl 1 wctu_info aligned like work_class_tune_info;
 71 
 72           wctup = a_wctup;
 73           code = 0;
 74           tcmp = addr (tc_data$);
 75           wctu_info = wctup -> work_class_tune_info;
 76           if wctu_info.version < WCTI_version_3 then do;
 77                code = error_table_$obsolete_function;
 78                go to TWC_RETURN;
 79           end;
 80           i = wctu_info.wc_number;
 81           if (i<0) | (i>16) then do;
 82                code = error_table_$bad_work_class;
 83                go to TWC_RETURN;
 84           end;
 85           if ^tcm.wcte (i).defined then do;
 86                code = error_table_$bad_work_class;
 87                go to TWC_RETURN;
 88           end;
 89 
 90           if wctu_info.set.governed then
 91                if wctu_info.max_percent < 0 | wctu_info.max_percent > 100
 92                then do;
 93                     code = error_table_$bad_arg;
 94                     goto TWC_RETURN;
 95                end;
 96 
 97 
 98 /* Now set the new parameters for this work_class. */
 99 
100           call WIRE_LOCK;                                   /* TRAFFIC CONTROLLER LOCKED */
101 
102           if wctu_info.set.resp1 then
103                tcm.wcte (i).resp1 = wctu_info.resp1;
104           if wctu_info.set.resp2 then
105                tcm.wcte (i).resp2 = wctu_info.resp2;
106           if wctu_info.set.quantum1 then
107                tcm.wcte (i).quantum1 = wctu_info.quantum1;
108           if wctu_info.set.quantum2 then
109                tcm.wcte (i).quantum2 = wctu_info.quantum2;
110           if wctu_info.set.purging then
111                if wctu_info.flags.purging then tcm.wcte (i).purging = 1;
112                else tcm.wcte (i).purging = 0;
113           if wctu_info.set.realtime then
114                if wctu_info.flags.realtime then tcm.wcte (i).realtime = 1;
115                else tcm.wcte (i).realtime = 0;
116           if wctu_info.set.maxel then
117                tcm.wcte (i).maxel = wctu_info.maxel;
118           if wctu_info.set.pin_weight then
119                tcm.wcte (i).pin_weight = wctu_info.pin_weight;
120           if wctu_info.set.io_priority then
121                tcm.wcte (i).io_priority = wctu_info.flags.io_priority;
122           if wctu_info.set.governed then do;
123                if wctu_info.max_percent = 0 then
124                     tcm.wcte (i).flags.governed = "0"b;
125                else do;
126                     hundth_of_scatter = divide (tcm.credits_per_scatter, 100, 17);
127                     tcm.wcte (i).maxf = hundth_of_scatter * wctu_info.max_percent;
128                     tcm.wcte (i).governing_credits = 0;
129                     tcm.wcte (i).flags.governed = "1"b;
130                     end;
131                if ^wctu_info.set.interactive_q              /* Use default */
132                     then tcm.wcte (i).flags.interactive_q = ^tcm.wcte (i).flags.governed;
133                end;
134                if wctu_info.set.interactive_q
135                     then tcm.wcte (i).flags.interactive_q = wctu_info.flags.interactive_q;
136 
137 
138           call UNLOCK_UNWIRE;                               /* TRAFFIC CONTROLLER LOCKED */
139 
140 TWC_RETURN:
141           a_code = code;
142           return;
143 
144 
145 
146 define_work_classes: entry (a_wcip, a_code);
147 
148 dcl  a_wcip ptr;
149 dcl  a_code fixed bin (35);
150 
151 
152 /* First copy args */
153 
154           wcip = a_wcip;
155 
156           wci = work_class_info;
157           wci.error_process_id = ""b;
158           wci.error_work_class = 0;
159           code = 0;
160 
161 /* If setting user workclasses then compute sum and max_wc */
162 /* In any case validate arguments */
163 
164           if wci.set_user_wc then do;
165                sum = 0;                                     /* Compute the sum of the "percents" */
166                max_wc = 0;                                  /* Assume only  zeroth exists */
167 
168                do i = 1 to 16;
169                     if wci.user_wc_defined (i) then do;
170                          if wci.user_wc_min_pct (i) <= 0
171                               | (wci.governed (i)
172                                    & (wci.user_wc_max_pct (i) <= 0 | wci.user_wc_max_pct (i) > 100))
173                          then do;
174                               code = error_table_$bad_arg;
175                               go to DWC_RETURN;
176                          end;
177                          sum = sum + wci.user_wc_min_pct (i);
178                          max_wc = i;
179                     end;
180                end;
181           end;
182 
183           if wci.set_system_wc then do;
184                if wci.system_wc_min_pct <= 0 then do;
185                     code = error_table_$bad_arg;
186                     go to DWC_RETURN;
187                end;
188           end;
189 
190           call WIRE_LOCK;                                   /* TRAFFIC CONTROLLER LOCKED */
191 
192 
193 /* Verify that existing processes will belong to defined work classes */
194 
195           aptep = addr (tcm.apt);
196           apte_count = tcm.apt_size;
197           size_of_wct_entry = size (wct_entry);
198           wct_base = fixed (rel (addr (tcm.wcte (0))), 18);
199 
200           if wci.set_user_wc then do;
201                do i = 1 to apte_count;
202                     if ^ apte.flags.idle then               /* Idle processes are not in wc's */
203                          if bin (apte.flags.state, 18) ^= 0 then /* Dont worry about empties */
204                               if bin (apte.flags.state, 18) ^= 5 then do; /* Dont worry about stopped */
205                                    wcnum = divide (fixed (apte.wct_index, 18) - wct_base, size_of_wct_entry, 17, 0);
206                                    if wcnum > 0 then do;
207                                         if ^ wci.user_wc_defined (wcnum) then do;
208                                              wci.error_process_id = apte.processid;
209                                              wci.error_work_class = wcnum;
210                                              go to DWC_UU_RETURN;
211                                         end;
212                                    end;
213                               end;
214                     aptep = addrel (aptep, tcm.apt_entry_size); /* Move to next APTE */
215                end;
216 
217                tcm.max_wct_index = rel (addr (tcm.wcte (max_wc)));
218 
219                if sum ^= 0 then                             /* Scheduler algorithm requires normalization to 100% */
220                     hundth_of_credits = divide (tcm.credits_per_scatter, sum, 17, 0);
221                else hundth_of_credits = 0;                  /* no user_work_classes defined */
222                hundth_of_scatter = divide (tcm.credits_per_scatter, 100, 17, 0);
223 
224 
225 /* Set per-work_class parameters as specified */
226 
227                do i = 1 to 16;
228                     if wci.user_wc_defined (i) then do;
229                          tcm.wcte (i).flags.defined = "1"b;
230                          tcm.wcte (i).minf = fixed (wci.user_wc_min_pct (i), 7) * hundth_of_credits;
231                                                             /* Set credits to a modest amount. */
232                          tcm.wcte (i).credits = tcm.wcte (i).minf + tcm.telast;
233                     end;
234                     else do;
235                          tcm.wcte (i).flags.defined = "0"b;
236                          tcm.wcte (i).credits,
237                               tcm.wcte (i).minf = 0;
238                     end;
239                     tcm.wcte (i).purging = 1;
240                     tcm.wcte (i).maxel = 0;
241                     if wci.version >= 2 & wci.user_wc_defined (i) then do;
242                          if wci.realtime (i) then tcm.wcte.realtime (i) = 1;
243                          else tcm.wcte (i).realtime = 0;
244                          tcm.wcte (i).resp1 = wci.resp1 (i);
245                          tcm.wcte (i).quantum1 = wci.quantum1 (i);
246                          tcm.wcte (i).resp2 = wci.resp2 (i);
247                          tcm.wcte (i).quantum2 = wci.quantum2 (i);
248                     end;
249                     else do;                                /* set default parms for this wc */
250                          tcm.wcte (i).resp1 = 4000000;      /* 4sec */
251                          tcm.wcte (i).quantum1 = 500000;    /* half sec */
252                          tcm.wcte (i).resp2 = 32000000;     /* 32 sec */
253                          tcm.wcte (i).quantum2 = 1000000;   /* one sec */
254                          tcm.wcte (i).realtime = 0;
255                     end;
256                     if wci.version >= 3 & wci.user_wc_defined (i)
257                          & wci.governed (i) then do;
258                          tcm.wcte (i).flags.governed = "1"b;
259                          tcm.wcte (i).maxf = hundth_of_scatter * wci.user_wc_max_pct (i);
260                     end;
261                     else tcm.wcte (i).flags.governed = "0"b;
262                     tcm.wcte (i).flags.interactive_q = ^tcm.wcte (i).flags.governed;
263                     tcm.wcte (i).governing_credits = 0;
264                end;
265           end;
266 
267 /* Set global parameters if requested. */
268 
269 
270           if wci.set_sked_mode then tcm.deadline_mode = bin (wci.deadline_mode, 1);
271           if wci.set_max_batch_elig then tcm.max_batch_elig = wci.max_batch_elig;
272 
273           if wci.set_system_wc then do;
274                tcm.wcte (0).minf = fixed (wci.system_wc_min_pct, 7)
275                     * divide (tcm.credits_per_scatter, 100, 17, 0);
276                tcm.wcte (0).credits = tcm.wcte (0).minf + tcm.telast;
277           end;
278 
279 
280 /* Re-initialize metering data */
281           if wci.set_user_wc | wci.set_system_wc then do;
282                do i = 0 to 16;
283                     tcm.wcte (i).cpu_sum,
284                          tcm.wcte (i).eligibilities = 0;
285                end;
286                tcm.define_wc_time = clock_ ();
287                tcm.processor_time_at_define_wc = tcm.processor_time;
288           end;
289 
290 DWC_UU_RETURN:
291           call UNLOCK_UNWIRE;                               /* TRAFFIC CONTROLLER UNLOCKED */
292 
293 
294 DWC_RETURN:
295           work_class_info = wci;
296           if code = 0 then
297                if (wci.error_work_class ^= 0) | (wci.error_process_id ^= ""b)
298                then code = error_table_$action_not_performed;
299           a_code = code;
300           return;
301 
302 
303 /* ^L */
304 
305 /* -------------------------------------------------------------------- */
306 
307 WIRE_LOCK: proc;
308 
309                call wire_proc$wire_me ();
310                call pmut$wire_and_mask (oldmask, ptwp);
311                tcmp = addr (tc_data$);
312                call pxss$lock_apt ();                       /* TRAFFIC CONTROLLER LOCKED HERE */
313 
314           end WIRE_LOCK;
315 
316 /* -------------------------------------------------------------------- */
317 
318 UNLOCK_UNWIRE: proc;
319 
320                call pxss$unlock_apt ();                     /* TRAFFIC CONTROLLER UNLOCKED HERE */
321                call pmut$unwire_unmask (oldmask, ptwp);
322                call wire_proc$unwire_me ();
323 
324           end UNLOCK_UNWIRE;
325 
326 
327      end tc;