COMPILATION LISTING OF SEGMENT ed_mgt Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/09/85 1146.2 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright (c) 1972 by Massachusetts Institute of * 5* * Technology and Honeywell Information Systems, Inc. * 6* * * 7* * * 8* ****************************************************** */ 9 /* format: style4 */ 10 ed_mgt: procedure options (variable); 11 12 /* ed_mgt - edit "master_group_table" 13* which gives load control parameters for the load control groups 14* and work class definitions for the work classes used by the priority scheduler 15* 16* Modified by T. Casey, June 1975, to edit work class information for priority scheduler 17* Modified by T. Casey, October 1975 to fix bugs 18* Modified by T. Casey, October 1976 to add deadline scheduler parameters. 19* Modified by T. Casey, Sept 1977, to fix bugs in print and verify requests, 20* . and to permit the deletion of a group (which used to produce a warning). 21* Modified by T. Casey, November 1978, to add group parameters: absentee_(max min pct). 22* Modified May 1979 by T. Casey for MR7.0a to fix bug in verify (re the above absentee parameters). 23* Modified July 1981 by J. Bongiovanni for governed work classes 24* Modified 1984-09-17 BIM to remove call to reformat_mgt_, 25* add page_weight support. 26* Modified 1984-09-26 by E. Swenson to fix bug introduced by above change. 27**/ 28 1 1 /* BEGIN INCLUDE FILE ... mgt.incl.pl1 */ 1 2 1 3 /* Modified May 1975 by T. Casey to add priority scheduler parameters */ 1 4 /* Modified Summer '76 RE Mullen to add deadline parameters */ 1 5 /* Modified by T. Casey, November 1978, to add group parameters: absentee_(max min pct limit). */ 1 6 /* Modified July 1981 by J. Bongiovanni to add max_pct */ 1 7 1 8 /* At login each user process is placed in that load control group specified in either 1 9* the project's SAT entry or the user's PDT entry. This group is remembered 1 10* in the user table entry for that process (ATE, DUTE, AUTE). 1 11* 1 12* MGT groups map each process into a set of processes called a work_class 1 13* as a function of shift and whether or not the process is absentee -- 1 14* also per group limits on the number of group members are given. 1 15* 1 16* The work_class entries in the MGT specify the configuration 1 17* of the hardcore scheduler on a per shift basis. If a work_class has the 1 18* realtime attribute, member processes will be given precisely specified 1 19* response characteristics. If running in deadline_not_percent mode on 1 20* a given shift then members of other work_classes will be given approximate 1 21* response characteristics; otherwise other work_classes will be given 1 22* percentages of whatever cpu time is unused by realtime processes. 1 23* REM */ 1 24 1 25 dcl MGT_version_3 fixed bin int static init (3); /* versions >= 2 contain work class definitions */ 1 26 /* versions >= 3 contain deadline info */ 1 27 1 28 /* the mgt is based on mgtp, which is declared as either static or automatic, in each procedure that uses it */ 1 29 1 30 dcl 1 mgt based (mgtp) aligned, /* the Master Group Table defines load control groups 1 31* and work classes */ 1 32 2 1 /* BEGIN INCLUDE FILE author.incl.pl1 */ 2 2 2 3 /* the "author" items must always be the first ones in the table. The 2 4* module which moves the converted table to the System Control process 2 5* fills in these data items and assumes them to be at the head of the segment 2 6* regardless of the specific table's actual declaration. The variables 2 7* "lock" and "last_install_time" used to be "process_id" and "ev_channel" 2 8* respectively. For tables installed in multiple processes, these 2 9* are to be used to lock out multiple installations. */ 2 10 2 11 /* Lock should be used as a modification lock. Since, in general, 2 12* entries may not be moved in system tables, even by installations, 2 13* it is sufficient for only installers and programs that change threads 2 14* to set or respect the lock. Simply updating data in an entry 2 15* requires no such protection. 2 16* 2 17* Last_install_time is used by readers of system tables to detect 2 18* installations or other serious modifications. By checking it before 2 19* and after copying a block of data, they can be protected against 2 20* modifications. 2 21* 2 22* Modules that set the lock should save proc_group_id, and then 2 23* put their group id there for the time they hold the lock. 2 24* if they do not actually install the, they should restore the group id. 2 25**/ 2 26 2 27 2 author aligned, /* validation data about table's author */ 2 28 3 proc_group_id char (32), /* process-group-id (personid.projectid.tag) */ 2 29 3 lock bit (36), /* installation lock */ 2 30 3 update_attributes bit (1) unal, /* update/add/delete attributes */ 2 31 3 update_authorization bit (1) unal, /* update only authorizations */ 2 32 3 deferral_notified bit (1) unal, /* installer notified of deferral of installation */ 2 33 3 pad bit (33) unaligned, 2 34 3 last_install_time fixed bin (71), 2 35 3 table char (4), /* name of table, e.g., SAT MGT TTT RTDT PDT etc. */ 2 36 3 w_dir char (64), /* author's working directory */ 2 37 2 38 /* END INCLUDE FILE author.incl.pl1 */ 1 33 1 34 /* the author structure occupies 29 words */ 1 35 2 max_size fixed bin, /* maximum size of table */ 1 36 2 current_size fixed bin, /* current number of entries */ 1 37 2 total_units fixed bin, /* total units allocated */ 1 38 2 version_indicator char (8), /* = "VERSION " for version 2 and later 1 39* (the first version of the mgt had no version number) */ 1 40 2 version fixed bin, /* version of the mgt (if version_indicator = "VERSION ") */ 1 41 2 switches aligned, 1 42 3 wc_initialized bit (1) unaligned, /* = "1"b if work classes >1 have been defined */ 1 43 3 prio_sked_enabled bit (1) unaligned, /* if this switch is turned off, the priority scheduler will not 1 44* be used by the answering service (all processes will be 1 45* put in work class 1 regardless of what the mgt says) */ 1 46 3 prio_sked_on_tape bit (1) unaligned, /* "1"b if a.s. initialization finds the priority scheduler 1 47* on the system tape */ 1 48 3 deadline_mode (0:7) bit (1) unal, /* 0 => %, 1 => deadlines (per shift) */ 1 49 3 mgt_pad1 bit (25) unaligned, /* rest of the word */ 1 50 2 user_wc_defined (16) bit (1) unaligned, /* current set of defined work classes */ 1 51 2 shift_defined (0:7) bit (1) unaligned, /* which shifts are used at this site */ 1 52 2 mgt_pad2 bit (12) unaligned, /* rest of the word */ 1 53 2 user_wc_min_pct (16) fixed bin, /* current percents for the defined work classes */ 1 54 /* the above variables occupy a total of 24 words */ 1 55 2 mgt_pad3 (11) fixed bin, /* pad the mgt header to 64 words (29 + 24 + 11) */ 1 56 1 57 2 entry (100), /* array of entries */ 1 58 3 fill (32) fixed bin; /* 32 words each */ 1 59 /* the first 16 are work classes; the rest, load control groups */ 1 60 1 61 dcl mgtep ptr; /* both types of mgt entries are based on this pointer */ 1 62 1 63 dcl 1 group based (mgtep) aligned, /* a single entry in the mgt */ 1 64 2 group_id char (8), /* group name */ 1 65 2 max_prim fixed bin, /* maximum number of primary units (-1 is special) */ 1 66 2 n_prim fixed bin, /* current number of primary units */ 1 67 2 n_sec fixed bin, /* current number of secondary units */ 1 68 2 n_eo fixed bin, /* current number of edit-only users */ 1 69 2 absolute_max fixed bin, /* Absolute maximum number of units (prime and sec) */ 1 70 2 minu fixed bin, /* Constant number of units in maxprim */ 1 71 2 num fixed bin, /* Numerator of fraction of maxunits given to maxprim */ 1 72 2 denom fixed bin, /* Denominator. Usually = normal maxunits */ 1 73 2 minamax fixed bin, /* Constant part of abs max */ 1 74 2 num1 fixed bin, /* Numerator of abs max fraction */ 1 75 2 denom1 fixed bin, /* Denominator of abs max fraction */ 1 76 2 int_wc (0:7) fixed bin (17) unaligned, /* interactive work classes, per shift */ 1 77 2 abs_wc (0:7) fixed bin (17) unaligned, /* absentee work classes, per shift */ 1 78 /* used halfwords to avoid using up all the pad - 1 79* we might need it later */ 1 80 2 absentee aligned, /* switches controlling absentee processes in this group */ 1 81 3 allowed bit (1) unaligned, /* if off, absentee users must be moved to another group */ 1 82 3 default_group bit (1) unaligned, /* if on, this is one of the groups they can be moved to */ 1 83 3 default_queue (4) bit (1) unaligned, /* if on, this is the default group for this queue */ 1 84 /* ed_mgt and up_mgt_ enforce one default group per queue */ 1 85 3 mgt_pad4 bit (30) unaligned, /* rest of the word */ 1 86 2 absentee_max fixed bin (17) unal, /* max absentees allowed from this group */ 1 87 2 absentee_min fixed bin (17) unal, /* min absentees allowed from this group */ 1 88 2 absentee_pct fixed bin (17) unal, /* this % of abs_maxu allowed to be occupied by this group */ 1 89 2 absentee_limit fixed bin (17) unal, /* result of applying above 3 parameters to current abs_maxu */ 1 90 2 n_abs fixed bin (17) unal, /* current number of background absentee users */ 1 91 2 mgt_pad5a fixed bin (17) unal, /* rest of the word */ 1 92 2 mgt_pad5 (7) fixed bin; /* pad mgt entry to 32 words */ 1 93 1 94 dcl 1 work_class based (mgtep) aligned, 1 95 2 wc_name char (8), /* overlays group.group_id, but can only be 1 96* one of the strings "1" through "16" */ 1 97 2 switches aligned, 1 98 3 defined (0:7) bit (1) unaligned, /* which shifts this work class is defined on */ 1 99 3 absentee_allowed (0:7) bit (1) unaligned, /* "1"b if absentee jobs allowed in this work class and shift */ 1 100 /* ed_mgt and up_mgt_ enforce consistency between these 1 101* and the group.absentee switches */ 1 102 3 realtime (0:7) bit (1) unaligned, /* "1"b if this work class has realtime deadlines */ 1 103 3 mgt_pad6 bit (12) unaligned, /* rest of word */ 1 104 2 min_pct (0:7) fixed bin, /* percent, on each shift */ 1 105 2 int_response (0:7) fixed bin (17) unal, /* response to interaction(.01sec) */ 1 106 2 int_quantum (0:7) fixed bin (17) unal, /* first time slice after interaction(.01sec) */ 1 107 2 response (0:7) fixed bin (17) unal, /* time between time slices(.01sec) */ 1 108 2 quantum (0:7) fixed bin (17) unal, /* second and following time slices(.01sec) */ 1 109 2 max_pct (0:7) fixed bin (17) unal, /* governed percent on each shift (0=>not governed */ 1 110 2 mgt_pad7 (1) fixed bin; /* pad mgt entry to 32 words */ 1 111 1 112 /* END INCLUDE FILE ... mgt.incl.pl1 */ 29 3 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 3 2* 3 3* Values for the "access mode" argument so often used in hardcore 3 4* James R. Davis 26 Jan 81 MCR 4844 3 5* Added constants for SM access 4/28/82 Jay Pattin 3 6* Added text strings 03/19/85 Chris Jones 3 7**/ 3 8 3 9 3 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 3 11 dcl ( 3 12 N_ACCESS init ("000"b), 3 13 R_ACCESS init ("100"b), 3 14 E_ACCESS init ("010"b), 3 15 W_ACCESS init ("001"b), 3 16 RE_ACCESS init ("110"b), 3 17 REW_ACCESS init ("111"b), 3 18 RW_ACCESS init ("101"b), 3 19 S_ACCESS init ("100"b), 3 20 M_ACCESS init ("010"b), 3 21 A_ACCESS init ("001"b), 3 22 SA_ACCESS init ("101"b), 3 23 SM_ACCESS init ("110"b), 3 24 SMA_ACCESS init ("111"b) 3 25 ) bit (3) internal static options (constant); 3 26 3 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 3 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 3 29 3 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 3 31 static options (constant); 3 32 3 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 3 34 static options (constant); 3 35 3 36 dcl ( 3 37 N_ACCESS_BIN init (00000b), 3 38 R_ACCESS_BIN init (01000b), 3 39 E_ACCESS_BIN init (00100b), 3 40 W_ACCESS_BIN init (00010b), 3 41 RW_ACCESS_BIN init (01010b), 3 42 RE_ACCESS_BIN init (01100b), 3 43 REW_ACCESS_BIN init (01110b), 3 44 S_ACCESS_BIN init (01000b), 3 45 M_ACCESS_BIN init (00010b), 3 46 A_ACCESS_BIN init (00001b), 3 47 SA_ACCESS_BIN init (01001b), 3 48 SM_ACCESS_BIN init (01010b), 3 49 SMA_ACCESS_BIN init (01011b) 3 50 ) fixed bin (5) internal static options (constant); 3 51 3 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 30 4 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 4 2 /* format: style2,^inddcls,idind32 */ 4 3 4 4 declare 1 terminate_file_switches based, 4 5 2 truncate bit (1) unaligned, 4 6 2 set_bc bit (1) unaligned, 4 7 2 terminate bit (1) unaligned, 4 8 2 force_write bit (1) unaligned, 4 9 2 delete bit (1) unaligned; 4 10 4 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 4 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 4 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 4 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 4 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 4 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 4 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 4 18 4 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 31 32 33 34 dcl arg_count fixed bin; 35 dcl created_new_mgt bit (1) aligned; 36 dcl dn char (168), 37 en char (32), 38 grp char (8), 39 change_code char (20), 40 (i, j, k, n) fixed bin, 41 mgtp1 ptr init (null), 42 comm char (8), 43 movelen fixed bin, 44 ap ptr, 45 al fixed bin (21), 46 bchr char (al) unaligned based (ap), 47 code fixed bin (35), 48 mgtp ptr init (null), /* ptr to master group table (work copy) */ 49 qq ptr, 50 ask_$ask_clr entry options (variable), 51 ask_$ask_flo entry options (variable), 52 ask_$ask_int entry options (variable), 53 ask_$ask_yn entry options (variable), 54 ask_ entry options (variable), 55 ask_$ask_n entry options (variable), 56 ask_$ask_nint entry options (variable), 57 ask_$ask_nflo entry options (variable), 58 ask_$ask_c entry options (variable), 59 ask_$ask_cint entry options (variable), 60 ask_$ask_cflo entry options (variable), 61 ask_$ask_setline entry (char (*)), 62 btemp bit (1) aligned, 63 itemp fixed bin, 64 ftemp float bin; 65 66 dcl (addr, fixed, float, hbound, index, length, max, min, mod, 67 null, reverse, size, string, substr, verify) builtin; 68 69 dcl program_interrupt condition; 70 dcl cleanup condition; 71 72 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 73 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 74 dcl expand_pathname_$add_suffix entry (character (*), character (*), character (*), character (*), 75 fixed binary (35)); 76 dcl pathname_ entry (character (*), character (*)) returns (character (168)); 77 dcl ioa_ entry options (variable); 78 dcl ioa_$rsnnl entry options (variable); 79 dcl ioa_$nnl entry options (variable); 80 dcl com_err_ entry options (variable); 81 dcl com_err_$suppress_name entry () options (variable); 82 dcl initiate_file_$create entry (character (*), character (*), bit (*), pointer, bit (1) aligned, 83 fixed binary (24), fixed binary (35)); 84 dcl terminate_file_ entry (pointer, fixed binary (24), bit (*), fixed binary (35)); 85 dcl get_temp_segment_ entry (character (*), pointer, fixed binary (35)); 86 dcl release_temp_segment_ entry (character (*), pointer, fixed binary (35)); 87 dcl get_group_id_ entry () returns (char (32)); 88 dcl get_wdir_ entry () returns (character (168)); 89 90 dcl error_table_$unimplemented_version fixed bin (35) ext static; 91 92 dcl mgtix fixed bin; 93 dcl change_item fixed bin; 94 dcl change_type fixed bin; 95 dcl (fshift, lshift, nshift) fixed bin; 96 dcl (mxval, nval) fixed bin; 97 dcl flag fixed bin; 98 dcl (gcfirst, gclast) fixed bin; 99 dcl undefwc fixed bin; 100 dcl shift fixed bin; 101 dcl shift_pct fixed bin; 102 dcl no_abs_count fixed bin; 103 104 dcl dflt_g (4) fixed bin; 105 dcl ival (8) fixed bin; 106 dcl fval (8) float bin; 107 dcl bval (8) bit (1) aligned; 108 dcl shifts (8) fixed bin; 109 dcl shf (8) fixed bin; /* set by get_shift_spec: list of shifts to be changed */ 110 dcl nshf fixed bin; 111 112 dcl print_pct_ignored bit (1) aligned; 113 dcl default_absentee bit (1) aligned; 114 dcl int_wc bit (1) aligned; 115 dcl gcsw bit (1) aligned; 116 dcl wcsw bit (1) aligned; 117 dcl wcundef bit (1) aligned; 118 dcl (got_shift_spec, got_int_abs, got_values) bit (1) aligned; 119 dcl (padflt, pawc, pagrp, patot, paxrf) bit (1) aligned; 120 dcl no_abs bit (1) aligned; 121 122 dcl shift_used (0:7) bit (1) aligned; 123 dcl q (4) bit (1) aligned; 124 dcl dflt_q (4) bit (1) unaligned; 125 126 dcl wcp ptr; 127 128 dcl char32 char (32); 129 130 dcl change_entry_type (2:26) fixed bin int static options (constant) init /* entry types that each change_code is valid for: 131* 0=header,1=group,2=work class,3=group OR work class */ 132 (0, /* 2: prio sked */ 133 (9) 1, /* 3-11: maxu thru wc */ 134 3, /* 12: absentee */ 135 (7) 2, /* 13-19: pct thru mode */ 136 (2) 0, /* 20,21: normal moce, shifts */ 137 (3) 1, /* 22-24: absentee_(max min pct) */ 138 (2) 2); /* 25: max_pct, 26: page_weight */ 139 140 141 dcl change_types (2:26) fixed bin int static options (constant) init /* data types for each item that change deals with */ 142 (3, 2, 0, 2, 1, 1, 1, 1, 2, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 1, 1, 1, 4, 4); 143 /* 0=char;1=float;2=float*10;3=yes/no;4=variable_format */ 144 145 dcl vtypes (11:26) fixed bin int static options (constant) init /* mapping between change_item and value type, 146* for the variable format change items */ 147 (1, 3, 1, 3, 2, 2, 2, 2, 3, 3, 0, 0, 0, 0, 1, 1); /* 1=integer;2=floating point;3=keyword */ 148 149 150 dcl change_names (2:26) char (12) int static options (constant) init (/* ITEM - names used in prompting messages */ 151 "prio_sked" /* 2 */ 152 , "max_prim" /* 3 */ 153 , "id" /* 4 */ 154 , "abs_max" /* 5 */ 155 , "numerator" /* 6 */ 156 , "denominator" /* 7 */ 157 , "num1" /* 8 */ 158 , "denom1" /* 9 */ 159 , "constant" /* 10 */ 160 , "work_class" /* 11 */ 161 , "absentee y/n" /* 12 */ 162 , "percent(s)" /* 13 */ 163 , "defined y/n" /* 14 */ 164 , "int_resp" /* 15 */ 165 , "int_quantum" /* 16 */ 166 , "resp" /* 17 */ 167 , "quantum" /* 18 */ 168 , "mode norm/rt" /* 19 */ 169 , "deadline/pct" /* 20 */ 170 , "shifts" /* 21 */ 171 , "absentee_max" /* 22 */ 172 , "absentee_min" /* 23 */ 173 , "absentee_pct" /* 24 */ 174 , "max_pct(s)" /* 25 */ 175 , "page_weight" /* 26 */ 176 ); 177 178 dcl change_items (50) fixed bin int static options (constant) init /* correspondence between the 50 change_codes and the 26 items */ 179 (1, 1, 2, 2, 3, 3, 3, 3, 4, 5, 5, 5, 6, 6, 7, 7, 7, 8, 9, 9, 10, 10, 10, 11, 11, 12, 13, 13, 13, 14, 14, 180 15, 15, 16, 16, 17, 17, 18, 18, 19, 20, 20, 21, 22, 23, 24, 25, 25, 26, 26); 181 182 dcl change_codes (50) char (12) int static options (constant) init ( 183 /* CODE ITEM - names that user can give in change request */ 184 185 /* control items - used to exit from change mode */ 186 187 "*" /* 1 1 */ 188 , "." /* 2 1 */ 189 190 /* header items (see additional header items below) */ 191 192 , "prio" /* 3 2 */ 193 , "prio_sked" /* 4 2 */ 194 195 /* group items */ 196 197 , "maxu" /* 5 3 */ 198 , "max_prim" /* 6 3 */ 199 , "maxp" /* 7 3 */ 200 , "m" /* 8 3 */ 201 , "id" /* 9 4 */ 202 , "abs" /* 10 5 */ 203 , "abs_max" /* 11 5 */ 204 , "minamax" /* 12 5 */ 205 , "numerator" /* 13 6 */ 206 , "num" /* 14 6 */ 207 , "denominator" /* 15 7 */ 208 , "den" /* 16 7 */ 209 , "denom" /* 17 7 */ 210 , "num1" /* 18 8 */ 211 , "denom1" /* 19 9 */ 212 , "den1" /* 20 9 */ 213 , "constant" /* 21 10 */ 214 , "const" /* 22 10 */ 215 , "con" /* 23 10 */ 216 , "work_class" /* 24 11 */ 217 , "wc" /* 25 11 */ 218 219 /* both group and work class item */ 220 221 , "absentee" /* 26 12 */ 222 223 /* work class only items */ 224 225 , "percent" /* 27 13 */ 226 , "pct" /* 28 13 */ 227 , "%" /* 29 13 */ 228 , "defined" /* 30 14 */ 229 , "def" /* 31 14 */ 230 , "int_resp" /* 32 15 */ 231 , "ir" /* 33 15 */ 232 , "int_quantum" /* 34 16 */ 233 , "iq" /* 35 16 */ 234 , "resp" /* 36 17 */ 235 , "r" /* 37 17 */ 236 , "quantum" /* 38 18 */ 237 , "q" /* 39 18 */ 238 , "mode" /* 40 19 */ 239 240 /* additional header items */ 241 242 , "normal_mode" /* 41 20 */ 243 , "norm" /* 42 20 */ 244 , "shifts" /* 43 21 */ 245 , "absentee_max" /* 44 22 */ 246 , "absentee_min" /* 45 23 */ 247 , "absentee_pct" /* 46 24 */ 248 249 /* additional work class only items */ 250 251 , "max_percent" /* 47 25 */ 252 , "max_pct" /* 48 25 */ 253 , "page_weight" /* 49 26 */ 254 , "pw" /* 50 26 */ 255 ); 256 257 258 declare ME char (32) int static init ("ed_mgt") options (constant); 259 declare DEFAULT_MGT_PATH char (168) init ("MGT.mgt") int static options (constant); 260 261 262 call cu_$arg_count (arg_count, code); 263 if code ^= 0 then do; 264 call com_err_ (code, ME); 265 return; 266 end; 267 268 if arg_count > 1 then do; 269 call com_err_$suppress_name (0, ME, "Usage: ed_mgt {pathname}"); 270 return; 271 end; 272 273 if arg_count = 0 then do; 274 ap = addr (DEFAULT_MGT_PATH); 275 al = length (rtrim (DEFAULT_MGT_PATH)); 276 end; 277 278 else call cu_$arg_ptr (1, ap, al, (0)); 279 280 call expand_pathname_$add_suffix (bchr, "mgt", dn, en, code); 281 if code ^= 0 then do; 282 call com_err_ (code, "ed_mgt", bchr); 283 return; 284 end; 285 286 created_new_mgt = "0"b; 287 mgtp, mgtp1 = null (); 288 on cleanup call clean_up; 289 call initiate_file_$create (dn, en, RW_ACCESS, mgtp1, created_new_mgt, (0), code); 290 if code ^= 0 then do; 291 call com_err_ (code, ME, "^a", pathname_ (dn, en)); 292 call clean_up; 293 end; 294 295 call get_temp_segment_ (ME, mgtp, code); 296 if code ^= 0 then do; 297 call com_err_ (code, ME, "Internal error; cannot get a temp segment."); 298 call clean_up; 299 end; 300 301 on condition (program_interrupt) go to main1; 302 303 if ^(created_new_mgt | mgtp1 -> mgt.version_indicator ^= "VERSION ") then 304 mgtp -> mgt = mgtp1 -> mgt; 305 306 else do; 307 call ioa_ ("Creating new MGT ^a.", pathname_ (dn, en)); 308 call initialize_mgt; 309 end; 310 311 if mgt.version ^= MGT_version_3 then do; /* if not current version, see what it is */ 312 call com_err_ (error_table_$unimplemented_version, 313 ME, "MGT version is ^d, must be ^d.", 314 mgt.version, MGT_version_3); 315 call clean_up; 316 return; 317 end; /* end version not 3 */ 318 319 320 /* Initialize current position and enter request loop */ 321 322 mgtix = 17; /* group 1 */ 323 mgtep = addr (mgt.entry (17)); /* gotta start somewhere */ 324 if mgt.current_size < mgtix then do; /* nobody home? */ 325 call ioa_ ("no groups defined, ""add"" assumed"); 326 go to acom; 327 end; 328 329 /* Come here after an error, to clear any typed ahead input before prompting for next request */ 330 331 main1: call ask_$ask_clr; 332 333 /* Come here to prompt for another request */ 334 335 main: call ask_ ("type ", comm); /* get command */ 336 mgtep = addr (mgt.entry (mgtix)); /* mgtep gets moved around - 337* mgtix is the true "current pointer" */ 338 if comm = "quit" then goto qcom; 339 else if comm = "q" then 340 qcom: 341 exit: do; 342 call clean_up; 343 return; 344 end; 345 else if comm = "write" | comm = "w" 346 then do; /* write? */ 347 wcom: 348 created_new_mgt = "0"b; /* don't delete me! */ 349 350 mgtp1 -> mgt = mgtp -> mgt; 351 352 call terminate_file_ (mgtp1, 36 * (64 + mgtp1 -> mgt.current_size * 32), TERM_FILE_TRUNC | TERM_FILE_BC, (0)); 353 354 goto main; /* leave pointer where it was, after a write */ 355 end; 356 else if comm = "f" then go to fcom; /* find */ 357 else if comm = "find" then do; 358 fcom: call ask_ ("group ", grp); 359 do i = 1 to mgt.current_size; 360 mgtep = addr (mgt.entry (i)); 361 if group.group_id = grp then do; 362 mgtix = i; 363 go to pentry; 364 end; 365 end; 366 call ioa_ ("group ""^a"" not found", grp); 367 go to main1; 368 end; 369 else if comm = "c" then go to ccom; /* change */ 370 else if comm = "change" then do; 371 372 ccom: gcsw = "0"b; /* not global change */ 373 if mgtix <= 16 then wcsw = "1"b; 374 else wcsw = "0"b; 375 call change; 376 end; 377 378 else if comm = "gc" then goto gccom; 379 else if comm = "global_change" then do; 380 gccom: gcsw = "1"b; 381 call ask_ ("entry type ", change_code); 382 if change_code = "load_control_group" then goto lctype; 383 if substr (change_code, 1, 5) = "group" then goto lctype; /* allow singular or plural */ 384 else if change_code = "lcg" then do; 385 lctype: wcsw = "0"b; 386 end; 387 else if change_code = "work_class" then goto wctype; 388 else if change_code = "wc" then do; 389 wctype: wcsw = "1"b; 390 end; 391 else do; 392 call ioa_ ("bad entry type: ""^a""^/must be ""work_class"" or ""load_control_group""", change_code); 393 call ask_$ask_clr; 394 goto gccom; 395 end; 396 397 call change; 398 end; 399 400 else if comm = "p" then go to pcom; 401 else if comm = "print" then do; 402 pcom: 403 if mgtix > 16 then 404 call prgp (mgtep); 405 else do; 406 wcundef = ""b; 407 call prwc (mgtep); 408 if wcundef then do; 409 call ioa_ (" is undefined"); 410 wcundef = ""b; 411 end; 412 end; 413 end; 414 415 else if comm = "p*" then go to pacom; 416 else if comm = "pa" then go to pacom; 417 else if comm = "pall" then do; 418 pacom: 419 420 padflt = "1"b; /* assume no optional arguments */ 421 patot, pawc, pagrp, paxrf = "0"b; 422 paloop: call ask_$ask_n (char32, flag); /* check for optional arguments */ 423 if flag = 0 then goto no_pa_arg; /* if nothing there */ 424 if substr (char32, 1, 3) = "tot" then do; /* allow "tot", "total", "totals" */ 425 patot = "1"b; 426 pa_arg: padflt = "0"b; /* remember that some args were given */ 427 call ask_$ask_c (char32, flag); /* get rid of it from line */ 428 goto paloop; /* go see if more */ 429 end; 430 else if char32 = "lcg" then goto pa_grp; 431 else if substr (char32, 1, 5) = "group" then goto pa_grp; /* allow singular or plural form */ 432 else if substr (char32, 1, 18) = "load_control_group" then do; 433 pa_grp: pagrp = "1"b; 434 goto pa_arg; 435 end; 436 else if char32 = "wc" then goto pa_wc; 437 else if substr (char32, 1, 10) = "work_class" then do; /* allow singular or plural form */ 438 pa_wc: pawc = "1"b; 439 goto pa_arg; 440 end; 441 else if char32 = "xref" then goto pa_xref; 442 else if char32 = "cref" then goto pa_xref; 443 else if substr (char32, 1, 5) = "cross" then do; /* allow cross reference, in any form */ 444 pa_xref: paxrf = "1"b; 445 goto pa_arg; 446 end; 447 448 no_pa_arg: /* fall thru if no match, or come here if no typed ahead arg */ 449 if padflt then /* if no args given, use the default */ 450 patot, pawc, pagrp, paxrf = "1"b; /* which is to print everything */ 451 452 /* now, print the stuff */ 453 454 if patot then do; /* if we are to print totals from mgt header */ 455 call ioa_ ("max_size ^d", mgt.max_size); 456 call ioa_ ("current_size ^d", mgt.current_size); 457 call ioa_ ("total_units ^d", mgt.total_units); 458 call ioa_ ("prio_sked_enabled: ^[yes^;no^]", mgt.switches.prio_sked_enabled); 459 call ioa_ ("wc_initialized: ^[yes^;no^]", mgt.switches.wc_initialized); 460 call print_shfs (mgt.shift_defined, "defined shifts: ", "^x^d"); 461 call print_bvals (mgt.shift_defined, "scheduling mode:", "^x^[d^;%^]", mgt.switches.deadline_mode); 462 end; 463 464 465 if pagrp then /* if we should print all groups */ 466 do n = 17 to mgt.current_size; /* do so */ 467 qq = addr (mgt.entry (n)); 468 call prgp (qq); 469 end; 470 471 if pawc then do; /* if we should print all work classes */ 472 wcundef = ""b; /* we check for a series of undefined work classes */ 473 do n = 1 to 16; /* to avoid aggravating the user */ 474 qq = addr (mgt.entry (n)); /* by printing a long list of "... is undefined" lines */ 475 if wcundef then do; /* if the previous one was undefined */ 476 if string (qq -> work_class.switches.defined) ^= ""b then do; /* but this one is defined */ 477 plast: wcundef = ""b; 478 if undefwc = n - 1 then /* if only the last one was undefined */ 479 call ioa_ (" is undefined"); 480 else call ioa_ ("-^d are undefined", n - 1); 481 if n <= 16 then /* if not entered at plast to print "last few undefined" */ 482 call prwc (qq); /* go print the current work class */ 483 end; 484 end; 485 else do; /* previous one was not undefined */ 486 call prwc (qq); 487 if wcundef then /* prwc checks, and sets this switch */ 488 undefwc = n; /* remember the first undefined one in the series */ 489 end; 490 end; 491 if wcundef then /* if last few were undefined */ 492 goto plast; /* go print message to that effect */ 493 end; 494 495 if paxrf then /* if we are to print a cross reference */ 496 call pxref; /* go do so */ 497 498 499 end; 500 501 else if comm = "a" then go to acom; 502 else if comm = "add" then do; 503 acom: call ask_ ("group ", grp); 504 do mgtix = 1 to mgt.current_size; 505 mgtep = addr (mgt.entry (mgtix)); 506 if group.group_id = grp then do; 507 if mgtix < 17 then call ioa_ ("use the ""change"" request to define a work class"); 508 else call ioa_ ("group ""^a"" already exists", grp); 509 go to main1; 510 end; 511 end; 512 mgtix = mgt.current_size + 1; 513 mgtep = addr (mgt.entry (mgtix)); 514 group.group_id = grp; 515 group.minamax = 32767; /* will have to change this if Multics gets really big */ 516 group.absentee.allowed = "1"b; /* by default */ 517 call ask_$ask_flo ("constant ", ftemp); 518 if ftemp < 0e0 then group.max_prim = -1; 519 else group.minu = ftemp * 10; 520 521 if mgt.switches.wc_initialized then /* if work classes (other than the initial 522* default of 1) have been defined */ 523 call ask_$ask_int ("work class ", itemp); /* keep it simple - just ask for one */ 524 else itemp = 1; /* none defined - use the initial default work class */ 525 do i = 0 to 7; 526 if mgt.shift_defined (i) then 527 group.int_wc (i), group.abs_wc (i) = itemp; 528 else group.int_wc (i), group.abs_wc (i) = 0; 529 end; 530 531 mgt.current_size = mgtix; 532 end; 533 534 else if comm = "delete" then do; 535 if mgtix <= 16 then do; 536 call ioa_ ("use the ""change"" request to undefine a work class"); 537 goto main1; 538 end; 539 do i = mgtix + 1 to mgt.current_size; 540 mgt.entry (i - 1) = mgt.entry (i); 541 end; 542 mgt.current_size = mgt.current_size - 1; 543 mgtix = min (mgtix, mgt.current_size); /* in case we deleted the last group */ 544 mgtep = addr (mgt.entry (mgtix)); 545 goto pentry; /* tell user the current group has changed */ 546 end; 547 548 else if comm = "n" then go to ncom; 549 else if comm = "next" then do; 550 ncom: mgtix = mgtix + 1; 551 if mgtix > mgt.current_size then do; 552 call ioa_ ("EOF"); 553 mgtix = mgt.current_size; 554 end; 555 mgtep = addr (mgt.entry (mgtix)); 556 goto pentry; 557 end; 558 else if comm = "top" then go to tcom; 559 else if comm = "t" then go to tcom; 560 else if comm = "-" then do; 561 mgtix = mgtix - 1; 562 if mgtix <= 0 then do; 563 call ioa_ ("TOP"); 564 tcom: mgtix = 1; 565 end; 566 mgtep = addr (mgt.entry (mgtix)); 567 goto pentry; 568 end; 569 570 else if comm = "verify" then goto vcom; 571 else if comm = "v" then do; 572 vcom: call verify_mgt; 573 end; 574 575 else if comm = "define" then call define; 576 else if comm = "redefine" then call redefine; 577 else if comm = "undefine" then call undefine; 578 579 else do; /* ? */ 580 call ioa_ ("illegal command ""^a""", comm); 581 go to main1; 582 end; 583 584 /* Fall thru to here after executing a request, unless: 585* 1) an error occurred and we went directly to main1 to flush possible typeahead; or 586* 2) we moved the current pointer and went to pentry (just below) to print the name of the new current entry. 587**/ 588 589 go to main; 590 591 pentry: /* come here to print line telling user where he is */ 592 call ask_$ask_n (char32, flag); /* see if anything typed ahead */ 593 if flag ^= 0 then goto main; /* if user typed ahead, we assume he knows where he is */ 594 if mgtix <= 16 then 595 call ioa_ ("work class: ^a", work_class.wc_name); 596 else call ioa_ ("group: ^a", group.group_id); 597 goto main; 598 599 600 601 /* ****************************************************************************************************************** */ 602 603 604 /* Internal procedures, in alphabetic order */ 605 606 607 ask_cval: proc (vtype, where, flag); 608 609 dcl (flag, vtype, where) fixed bin; 610 611 if vtype = 1 then 612 call ask_$ask_cint (ival (where), flag); 613 else if vtype = 2 then 614 call ask_$ask_cflo (fval (where), flag); 615 else if vtype = 3 then 616 call ask_ckey (bval (where), flag); 617 618 return; 619 620 end ask_cval; 621 622 623 /* ****************************************************************************************************************** */ 624 625 626 ask_key: proc (bval, prompt); 627 628 dcl prompt char (*); 629 dcl bval bit (1) aligned; 630 dcl (prompt_sw, remove_sw, yn_sw) bit (1) aligned; 631 dcl (flag, local_flag) fixed bin; 632 633 prompt_sw, remove_sw = "1"b; 634 yn_sw = ""b; 635 goto key_common; 636 637 /* ********** */ 638 639 ask_ckey: entry (bval, flag); 640 flag = 0; 641 prompt_sw, yn_sw = ""b; 642 remove_sw = "1"b; 643 goto key_common; 644 645 /* ********** */ 646 647 ask_nkey: entry (bval, flag); 648 649 flag = 0; 650 prompt_sw, remove_sw, yn_sw = ""b; 651 goto key_common; 652 653 /* ********** */ 654 655 ask_yn: entry (bval, prompt); 656 657 prompt_sw, yn_sw = "1"b; 658 remove_sw = ""b; 659 goto dont_ask_key; /* caller already asked, and char32 contains the response */ 660 661 /* ********** */ 662 663 ask_cyn: entry (bval, flag); 664 665 remove_sw, prompt_sw = ""b; 666 yn_sw = "1"b; 667 goto dont_ask_key; /* caller already asked, as above */ 668 669 /* ********** */ 670 671 key_common: 672 673 if prompt_sw then 674 ask_key_again: call ask_ ("^a ", char32, prompt); 675 else do; 676 call ask_$ask_n (char32, flag); 677 if flag = 0 then return; 678 end; 679 680 dont_ask_key: 681 682 local_flag = 0; 683 if change_item = 12 | change_item = 14 | yn_sw then 684 call scan_key ("allowed,yes,y,on,1,ok,^allowed,not_allowed,no,n,off,0", (6), bval, local_flag); 685 else if change_item = 19 then 686 call scan_key ("realtime,rt,normal,norm", (2), bval, local_flag); 687 else if change_item = 20 then 688 call scan_key ("deadline,percent,pct,%", (1), bval, local_flag); 689 690 if local_flag = 0 then do; /* no match with keywords */ 691 if prompt_sw then do; /* but caller insists on getting one */ 692 call ioa_ ("bad value: ""^a""", char32); 693 call ask_$ask_clr; /* flush typeahead */ 694 goto ask_key_again; /* and go insist */ 695 end; 696 else flag = -1; /* caller just wants to know, 697* so say "something there but not what you want" */ 698 end; 699 700 else /* there was a match */ 701 if ^prompt_sw then do; /* if caller was not insisting */ 702 flag = 1; /* tell him we found good value */ 703 if remove_sw then 704 call ask_$ask_c (char32, local_flag); /* read it again to remove it from the input line */ 705 end; 706 707 return; 708 709 end ask_key; 710 711 712 /* ****************************************************************************************************************** */ 713 714 715 ask_val: proc (vtype, where, prompt); 716 717 dcl (vtype, where) fixed bin; 718 dcl prompt char (*); 719 720 if vtype = 1 then 721 call ask_$ask_int ("^a ", ival (where), prompt); 722 else if vtype = 2 then do; 723 call ask_$ask_flo ("^a ", fval (where), prompt); 724 if change_item >= 15 & change_item <= 18 then/* int_resp, int_quantum, resp, or quantum */ 725 fval (where) = fval (where) * 100e0 + .005e0; 726 end; 727 else if vtype = 3 then 728 call ask_key (bval (where), prompt); 729 730 return; 731 732 end ask_val; 733 734 735 /* ****************************************************************************************************************** */ 736 737 738 assign_value: proc (vtype, to, from); 739 740 dcl (from, to, vtype) fixed bin; 741 742 if vtype = 1 then 743 ival (to) = ival (from); 744 else if vtype = 2 then 745 fval (to) = fval (from); 746 else if vtype = 3 then 747 bval (to) = bval (from); 748 749 return; 750 751 end assign_value; 752 753 754 /* ****************************************************************************************************************** */ 755 756 757 change: proc; 758 759 /* procedure to implement the change subcommand. it is called by both the 760* change and global_change requests. it dechange_codes one change request and makes 761* the change (to one entry or all entries of the specified type), and then 762* reads the next request. the "." and "*" requests cause exit from the change subcommand */ 763 764 dcl i fixed bin; 765 766 ask_code: call ask_ ("code ", change_code); 767 do i = 1 to hbound (change_codes, 1) 768 while (change_code ^= change_codes (i)); 769 end; 770 if i > hbound (change_codes, 1) then do; /* not found */ 771 call ioa_ ("bad change code: ""^a""", change_code); 772 change_clr: call ask_$ask_clr; 773 goto ask_code; 774 end; 775 776 change_item = change_items (i); /* pick up which variable is to be changed */ 777 change_type = change_types (change_item); /* and what type it is */ 778 779 if change_item = 1 then return; /* "." or "*" */ 780 781 /* See of change_code is valid for entry type being changed */ 782 783 if change_entry_type (change_item) ^= 0 then do; /* if change_code is for a header item, it is ok; otherwise, check */ 784 if wcsw & change_entry_type (change_item) = 1 then do; 785 /* we're changing a work class, but change_code is for groups only */ 786 call ioa_ ("code ""^a"" is not legal for a work class", change_code); 787 goto change_clr; 788 end; 789 790 else if ^wcsw & change_entry_type (change_item) = 2 then do; 791 /* we're changing a group, but change_code is for work classes only */ 792 call ioa_ ("code ""^a"" is not legal for a load control group", change_code); 793 goto change_clr; 794 end; 795 /* notice that we fall thru for change_entry_type = 3, which means 796* "valid for both group and work class" */ 797 end; 798 799 goto ask_type (change_type); /* go read value(s) from the input line */ 800 801 ask_type (0): /* character string */ 802 ask_type (3): /* yes or no word */ 803 call ask_ ("^a ", char32, change_names (change_item)); 804 805 if change_type = 3 then 806 call ask_yn (bval (1), change_names (change_item)); 807 808 goto asked_type; 809 810 ask_type (1): /* float */ 811 ask_type (2): /* float*10e0 */ 812 call ask_$ask_flo ("^a ", ftemp, change_names (change_item)); 813 814 if change_type = 2 then /* if float*10e0 */ 815 if ftemp > 0e0 then /* and value is not negative */ 816 ftemp = ftemp * 10e0; /* multiply it by 10 */ 817 818 goto asked_type; 819 820 /* variable format - got to look ahead on the line to see what we have */ 821 822 ask_type (4): 823 824 /* "c absentee" for a group is different from all the other variable format requests 825* 826* it can be either of: 827* c absentee 828* c absentee queue |none 829**/ 830 831 if change_item = 12 & ^wcsw then do; /* if that's what we have */ 832 ask_abs: call ask_ ("""yes"" or ""no"" or ""queue""", char32); 833 if char32 = "queue" then goto abs_q; 834 else if char32 = "q" then do; 835 abs_q: call get_int_list ("queue(s)", 4, nval); 836 837 q (*) = "0"b; 838 do i = 1 to nval; /* if nval = 0, q(*) stays = "0"b, which is what we want */ 839 if ival (i) <= 0 then goto badq; 840 if ival (i) > 4 then do; 841 badq: call ioa_ ("bad absentee queue number: ^d", ival (i)); 842 call ask_$ask_clr; 843 goto abs_q; 844 end; 845 846 q (ival (i)) = "1"b; 847 end; 848 default_absentee = "1"b; /* we are changing this group's default absentee switch */ 849 end; 850 851 else do; /* changing the absentee allowed bit */ 852 call ask_cyn (bval (1), itemp); /* see if yes or no word there */ 853 if itemp <= 0 then do; /* not a yes or no word */ 854 call ioa_ ("bad value: ^a", char32); 855 call ask_$ask_clr; 856 goto ask_abs; 857 end; 858 default_absentee = "0"b; /* we are not changing this group's default absentee switch */ 859 end; 860 861 end; /* end of "c absentee for a group" do group */ 862 863 /* all the other variable format requests */ 864 865 else do; 866 867 /* * ITEM FORMAT ( "[]" denotes an optional argument) 868* * 11 work_class [shift spec] [int|abs] 869* * 12 absentee [shift spec] 870* * 13 percent [shift spec] 871* * 14 defined [shift spec] 872* * 15 int_resp [shift spec] 873* * 16 int_quantum [shift spec] 874* * 17 resp [shift spec] 875* * 18 quantum [shift spec] 876* * 19 mode [shift spec] <"normal" or "realtime" per-shift mode indicators> 877* * 25 max_percent [shift spec] 878* * 879* * THE ABOVE APPLY SEPARATELY TO EACH WORK CLASS 880* * 881* * THE FOLLOWING APPLY TO ALL WORK CLASSES AND ARE STORED IN THE MGT HEADER 882* * 883* * 20 normal_mode [shift spec] <"deadline" or "percent" per-shift mode indicators> 884* * 21 shifts (can be i j k OR m-n OR mixture) 885* * 886* * There are several comments below, related to whether or not "values" have been typed ahead. 887* * These refer only to the values described in "< >" brackets above. 888* * They specifically exclude the shift spec and the int|abs indicators. 889* * The significant point here is that, if a list of values is typed ahead, omitted 890* * shift specification information takes on default values that are a function 891* * of the number of values typed ahead, but if a list of values is not typed ahead, 892* * then the shift spec is prompted for and must be given. A different path 893* * is taken through the code below in each of these two cases. 894* * 895* * The default when one value is given is "shift all" (all defined shifts get set to the one value). 896* * When a list of values is given, the default is "shift S1" where S1 is the lowest 897* * numbered defined shift, and the values are assigned to successive defined shifts, starting with S1. 898* * 899* * */ 900 901 /* set up default shift specification */ 902 903 nshf = 0; /* no shifts have actually been given by the user */ 904 fshift = -1; /* scan for defined shifts starting after -1 (i.e. at zero) */ 905 mxval = 0; /* initialize counter for defined shifts */ 906 call set_default_shift_spec; /* go count defined shifts and remember their numbers */ 907 /* mxval now = number of defined shifts 908* (= number of values we can use) */ 909 lshift, nshift = 0; /* only used when shift spec given, but clear garbage anyway */ 910 911 got_shift_spec, got_int_abs, got_values = "0"b; 912 int_wc = "1"b; /* the default is interactive work class */ 913 914 look_ahead: call ask_$ask_n (char32, flag); /* look at next word without removing it from line */ 915 916 if flag ^= 0 then do; /* something was typed ahead */ 917 918 if ^got_shift_spec & change_item ^= 21 919 & substr (char32, 1, 5) = "shift" then do; 920 call get_shift_spec; 921 goto look_ahead; /* go look for more typed ahead stuff */ 922 end; 923 924 else if ^got_int_abs 925 & change_item = 11 then do; /* check for "int" or "abs" */ 926 got_int_abs = check_int_abs (); 927 if got_int_abs then goto look_ahead; /* go look for more typed ahead stuff */ 928 else goto check_values; /* go see if this is values */ 929 end; 930 931 else do; /* must be values that were typed ahead */ 932 check_values: 933 nval = 0; /* so we can tell if we got any values */ 934 if change_item = 21 /* shifts */ 935 & ck_int (char32, (0), (0)) then /* and we have shift number(s) */ 936 call get_int_list (change_names (change_item), (8), nval); 937 else call look_ahead_value (vtypes (change_item), nval); 938 939 if nval > 0 then got_values = "1"b; 940 else do; 941 call ioa_ ("""^a"" unrecognized", char32); 942 call ask_$ask_clr; 943 end; 944 945 end; /* from here, we fall thru to the label "asked_type", without 946* looking for any more type ahead, or prompting for anything */ 947 end; /* end of "there is type ahead" do group */ 948 949 else do; /* there is no more type ahead */ 950 /* NOTE: this do group is not entered if values were typed ahead; 951* and note again that "values" do not include the 952* shift_spec or int|abs items */ 953 if ^got_shift_spec then /* if shift not already given */ 954 call get_shift_spec; /* go ask user for it */ 955 956 if change_item = 11 then /* if this is "c work_class" */ 957 if ^got_int_abs then /* and int|abs was not already given */ 958 call get_int_abs; /* go ask user for it */ 959 960 /* we know values were not already given, or we would not be here */ 961 if change_item = 21 then /* shifts */ 962 call get_int_list (change_names (change_item), (8), nval); 963 else call get_values (vtypes (change_item), change_names (change_item), nval); 964 965 end; /* end "no more type ahead" do group */ 966 end; /* end of "all other variable formats" do group */ 967 968 asked_type: 969 970 /* we now have all the info necessary to make a change */ 971 972 if gcsw then do; /* if global change */ 973 if wcsw then do; 974 gcfirst = 1; 975 gclast = 16; 976 end; 977 else do; 978 gcfirst = 17; 979 gclast = mgt.current_size; 980 end; 981 982 do i = gcfirst to gclast; 983 mgtep = addr (mgt.entry (i)); 984 call change_one_item; 985 end; 986 end; 987 988 else call change_one_item; /* regular change */ 989 990 goto ask_code; 991 992 end change; 993 994 995 /* ****************************************************************************************************************** */ 996 997 998 change_one_item: proc; 999 1000 /* procedure to change one item in one mgt entry; called in a loop over all 1001* entries of one type, for the global_change request, or just once, for the change request */ 1002 1003 dcl i fixed bin; 1004 1005 goto item (change_item); 1006 1007 /* item 1 is a "." or "*" which exits from change without coming here */ 1008 1009 item (2): mgt.switches.prio_sked_enabled = bval (1); /* prio, prio_sked */ 1010 return; 1011 1012 item (3): if ftemp = -1e0 then group.max_prim = -1; /* maxu, max_prim, maxp */ 1013 else do; 1014 call ioa_ ("warning: changing max_prim to value not -1"); 1015 group.max_prim = ftemp; 1016 end; 1017 return; 1018 1019 item (4): group.group_id = char32; /* id */ 1020 return; 1021 1022 item (5): if ftemp < 0 then group.minamax = 32767; /* Multics will never get that big ... */ 1023 else group.minamax = ftemp; /* abs, abs_max, minamax */ 1024 return; 1025 1026 item (6): group.num = ftemp; /* numerator, num */ 1027 return; 1028 1029 item (7): group.denom = ftemp; /* denominator, denom, den */ 1030 return; 1031 1032 item (8): group.num1 = ftemp; /* num1 */ 1033 return; 1034 1035 item (9): group.denom1 = ftemp; /* denom1, den1 */ 1036 return; 1037 1038 item (10): group.minu = ftemp; /* constant, const, con */ 1039 return; 1040 1041 item (11): do i = 1 to nshf; /* work_class, wc */ 1042 if int_wc then 1043 group.int_wc (shf (i)) = ival (i); 1044 else group.abs_wc (shf (i)) = ival (i); 1045 end; 1046 return; 1047 1048 item (12): /* absentee */ 1049 if ^wcsw then do; /* c absentee for a group */ 1050 if default_absentee then do; 1051 do i = 1 to 4; 1052 group.absentee.default_queue (i) = q (i); 1053 end; 1054 if string (group.absentee.default_queue) ^= ""b then /* if it is the default for any queues */ 1055 group.absentee.default_group = "1"b; /* flag it as a default absentee group */ 1056 else group.absentee.default_group = "0"b; /* otherwise clear possible old value */ 1057 end; 1058 else group.absentee.allowed = bval (1); 1059 end; 1060 1061 /* items above are all for groups - those below, for work classes */ 1062 1063 else do i = 1 to nshf; /* item 12 can be for group or work class */ 1064 if (^gcsw | work_class.switches.defined (shf (i))) then 1065 work_class.switches.absentee_allowed (shf (i)) = bval (i); 1066 end; 1067 1068 return; 1069 1070 item (13): do i = 1 to nshf; /* percent, pct, % */ 1071 if (^gcsw | work_class.switches.defined (shf (i))) then 1072 work_class.min_pct (shf (i)) = ival (i); 1073 end; 1074 return; 1075 1076 item (14): do i = 1 to nshf; /* defined, def */ 1077 work_class.switches.defined (shf (i)) = bval (i); 1078 if mgtix ^= 1 then /* if we are defining a wc other than 1 */ 1079 mgt.switches.wc_initialized = "1"b; /* this is no longer a transitional MGT */ 1080 end; 1081 return; 1082 1083 item (15): /* int_resp, ir */ 1084 item (16): /* int_quantum, iq */ 1085 item (17): /* resp, r */ 1086 item (18): /* quantum, q */ 1087 item (19): /* mode */ 1088 1089 do i = 1 to nshf; 1090 if (^gcsw | work_class.switches.defined (shf (i))) then 1091 if change_item = 15 then /* int_resp */ 1092 work_class.int_response (shf (i)) = fixed (fval (i)); 1093 else if change_item = 16 then /* int_quantum */ 1094 work_class.int_quantum (shf (i)) = fixed (fval (i)); 1095 else if change_item = 17 then /* resp */ 1096 work_class.response (shf (i)) = fixed (fval (i)); 1097 else if change_item = 18 then /* quantum */ 1098 work_class.quantum (shf (i)) = fixed (fval (i)); 1099 else /* change_item = 19 (mode) */ 1100 work_class.switches.realtime (shf (i)) = bval (i); 1101 end; 1102 return; 1103 1104 item (25): /* max_percent, max_pct */ 1105 do i = 1 to nshf; 1106 if (^gcsw | work_class.switches.defined (shf (i))) then 1107 work_class.max_pct (shf (i)) = ival (i); 1108 end; 1109 return; 1110 1111 item (26): 1112 call ioa_ ("Page_weight is not yet supported."); 1113 return; 1114 1115 1116 1117 /* items above are per-work_class items; those below are header items, that apply to all work classes */ 1118 1119 1120 item (20): /* normal_mode, norm */ 1121 do i = 1 to nshf; 1122 mgt.switches.deadline_mode (shf (i)) = bval (i); 1123 end; 1124 return; 1125 1126 item (21): /* shifts */ 1127 mgt.shift_defined (*) = ""b; /* clear list of defined shifts - we have a new one */ 1128 do i = 1 to nval; /* count of defined shifts is in nval, not nshf */ 1129 mgt.shift_defined (ival (i)) = "1"b; 1130 end; 1131 return; 1132 1133 item (22): /* absentee_max */ 1134 if ftemp > 3276.6e0 & ftemp < 3276.8e0 then /* perpetuate an old design error */ 1135 ftemp = 32767e0; 1136 group.absentee_max = ftemp; 1137 return; 1138 1139 item (23): /* absentee_min */ 1140 group.absentee_min = ftemp; 1141 return; 1142 1143 item (24): /* absentee_pct */ 1144 if ftemp < 1e0 then /* if user typed 0.10 for 10% */ 1145 ftemp = ftemp * 100e0; /* multiply by 100, since we store it as an integer */ 1146 group.absentee_pct = ftemp; 1147 return; 1148 1149 1150 end change_one_item; 1151 1152 1153 /* ****************************************************************************************************************** */ 1154 1155 1156 ck_int: proc (char_int, f, n) returns (bit (1)); 1157 1158 /* procedure to decode a number (or pair of numbers) of the following form: 1159* n 1160* m-n 1161* 1162* and return the first value and the number of consecutive values implied by the pair. 1163* m and n can be any of the digits 0 thru 7 */ 1164 1165 dcl char_int char (*); 1166 dcl (f, n) fixed bin; 1167 dcl (i, j) fixed bin; 1168 dcl digits char (8) int static init ("01234567"); 1169 1170 if substr (char_int, 2) = "" then goto onedigit; 1171 else if substr (char_int, 4) = "" then goto hyph; 1172 else goto bad; 1173 onedigit: 1174 i = index (digits, substr (char_int, 1, 1)); /* look up the digit */ 1175 if i = 0 then goto bad; /* not one of 0 thru 7 */ 1176 n = 1; /* one value returned */ 1177 f = i - 1; /* its value */ 1178 goto good; 1179 1180 hyph: 1181 if substr (char_int, 2, 1) ^= "-" then goto bad; 1182 i = index (digits, substr (char_int, 1, 1)); /* scan digits starting at 0 */ 1183 if i = 0 then goto bad; 1184 j = index (digits, substr (char_int, 3, 1)); /* therefore i and j are 1+ value of digit */ 1185 if j = 0 then goto bad; 1186 if j < i then goto bad; /* "6-3" is bad - user must say "3-6" */ 1187 f = i - 1; /* first value */ 1188 n = j - f; /* number of values */ 1189 /* for example, "3-6" => f=3,n=4, since i=4,j=7 */ 1190 1191 good: return ("1"b); 1192 bad: return ("0"b); 1193 1194 end ck_int; 1195 1196 1197 /* ****************************************************************************************************************** */ 1198 1199 1200 copy_shift: proc (tsh, fsh); 1201 1202 dcl (fsh, tsh) fixed bin; 1203 dcl i fixed bin; 1204 1205 do i = 1 to 16; 1206 mgtep = addr (mgt.entry (i)); 1207 if work_class.switches.defined (fsh) then do;/* only if wc defined on this shift */ 1208 work_class.switches.defined (tsh) = "1"b; 1209 work_class.switches.absentee_allowed (tsh) = work_class.switches.absentee_allowed (fsh); 1210 work_class.switches.realtime (tsh) = work_class.switches.realtime (fsh); 1211 work_class.min_pct (tsh) = work_class.min_pct (fsh); 1212 work_class.max_pct (tsh) = work_class.max_pct (fsh); 1213 work_class.int_response (tsh) = work_class.int_response (fsh); 1214 work_class.int_quantum (tsh) = work_class.int_quantum (fsh); 1215 work_class.response (tsh) = work_class.response (fsh); 1216 work_class.quantum (tsh) = work_class.quantum (fsh); 1217 end; 1218 end; 1219 1220 do i = 17 to mgt.current_size; 1221 mgtep = addr (mgt.entry (i)); 1222 group.int_wc (tsh) = group.int_wc (fsh); 1223 group.abs_wc (tsh) = group.abs_wc (fsh); 1224 end; 1225 1226 return; 1227 1228 end copy_shift; 1229 1230 1231 /* ****************************************************************************************************************** */ 1232 1233 1234 default_shift: proc (sh); 1235 1236 dcl sh fixed bin; 1237 dcl i fixed bin; 1238 1239 mgtep = addr (mgt.entry (1)); /* work class 1 is the only one, by default */ 1240 work_class.switches.defined (sh) = "1"b; 1241 work_class.switches.absentee_allowed (sh) = "1"b; 1242 work_class.switches.realtime (sh) = ""b; 1243 work_class.min_pct (sh) = 100; 1244 work_class.max_pct (sh) = 0; 1245 work_class.int_response (sh) = 400; 1246 work_class.int_quantum (sh) = 50; 1247 work_class.response (sh) = 3200; 1248 work_class.quantum (sh) = 100; 1249 1250 call undefine_wc (sh, 2, 16); /* make sure of no garbage in wc 2-16 */ 1251 1252 do i = 17 to mgt.current_size; 1253 mgtep = addr (mgt.entry (i)); 1254 group.int_wc (sh) = 1; 1255 group.abs_wc (sh) = 1; 1256 end; 1257 1258 return; 1259 1260 end default_shift; 1261 1262 1263 /* ****************************************************************************************************************** */ 1264 1265 1266 define: proc; 1267 1268 dcl (like_sw, redefine_sw, undefine_sw) bit (1) aligned; 1269 dcl (i, lsh) fixed bin; 1270 1271 redefine_sw, undefine_sw = ""b; 1272 1273 define_common: 1274 call get_shift_list (nval); 1275 if ^undefine_sw then 1276 call get_like_shift (lsh, like_sw); 1277 1278 do i = 1 to nval; /* shifts to be defined are in ival(1) thru ival(nval) */ 1279 if redefine_sw | ^shift_is_defined (ival (i)) then do; /* if it's ok to change this shift */ 1280 if undefine_sw then 1281 call undefine_shift (ival (i)); 1282 else if like_sw then 1283 call copy_shift (ival (i), lsh); 1284 else call default_shift (ival (i)); 1285 1286 if undefine_sw then mgt.shift_defined (ival (i)) = ""b; 1287 else mgt.shift_defined (ival (i)) = "1"b; 1288 end; 1289 1290 else call ioa_ ("shift ^d already defined; use redefine to change it", ival (i)); 1291 end; 1292 1293 return; 1294 1295 redefine: entry; 1296 1297 redefine_sw = "1"b; 1298 undefine_sw = ""b; 1299 goto define_common; 1300 1301 undefine: entry; 1302 1303 redefine_sw, undefine_sw = "1"b; 1304 goto define_common; 1305 1306 end define; 1307 1308 1309 /* ****************************************************************************************************************** */ 1310 1311 1312 get_int_abs: proc; 1313 1314 /* procedure to read the interactive|absentee specification; 1315* it may be "interactive", "absentee", "int" or "abs"; 1316* this entry point prompts for it if it was not typed ahead; 1317* the check_int_abs entry point checks if it was typed ahead, 1318* if so, reads it and returns "1"b, if not, returns "0"b */ 1319 1320 dcl cksw bit (1) aligned; 1321 1322 cksw = "0"b; 1323 1324 call ask_ ("""interactive"" or ""absentee"" ", char32); 1325 1326 int_abs_common: 1327 if char32 = "interactive" then goto int; 1328 if char32 = "int" then do; 1329 int: int_wc = "1"b; 1330 goto exit_ok; 1331 end; 1332 else if char32 = "absentee" then goto abs; 1333 else if char32 = "abs" then do; 1334 abs: int_wc = "0"b; 1335 goto exit_ok; 1336 end; 1337 else do; 1338 if cksw then goto exit_ng; /* go return "0"b */ 1339 call ioa_ ("bad value: ""^a""", char32); 1340 call ask_$ask_clr; 1341 goto int_abs_common; /* insist */ 1342 end; 1343 1344 exit_ng: return ("0"b); 1345 exit_ok: if cksw then do; 1346 call ask_$ask_c (char32, flag); /* remove it from the line */ 1347 return ("1"b); 1348 end; 1349 else return; 1350 1351 check_int_abs: entry returns (bit (1)); 1352 cksw = "1"b; 1353 call ask_$ask_n (char32, flag); 1354 if flag = 0 then goto exit_ng; /* nothing typed ahead */ 1355 goto int_abs_common; /* something there - go see if it is "int" or "abs" */ 1356 1357 end get_int_abs; 1358 1359 1360 /* ****************************************************************************************************************** */ 1361 1362 1363 get_int_list: proc (prompt, mxv, nv); 1364 1365 /* procedure to read a list, prompting for it if not typed ahead; 1366* the list is of the form: 1367* i j k-l m n-o p ... 1368* that is, integers, or pairs of the form m-n; 1369* m-n pairs are expanded into m m+1 ... n-1 n; 1370* 1371* prompt is the prompting message; 1372* mxv is the most values the caller wants; 1373* nv is the actual number of values returned; 1374* values are returned in ival(1) thru ival(nv). 1375**/ 1376 1377 dcl prompt char (*); 1378 dcl (mxv, nv) fixed bin; 1379 dcl i fixed bin; 1380 dcl (f, n) fixed bin; 1381 1382 ask_int_list: 1383 call ask_ ("^a ", char32, prompt); 1384 nv = 0; /* initialize counter */ 1385 if char32 = "none" then return; /* the list is empty */ 1386 if ^ck_int (char32, f, n) then do; /* bad value */ 1387 bad_int: call ioa_ ("bad value: ""^a""", char32); 1388 call ask_$ask_clr; 1389 goto ask_int_list; 1390 end; 1391 1392 get_int_loop: 1393 if nv + n > mxv then /* if m-n pair expands into too many values */ 1394 goto bad_int; /* go complain and start over */ 1395 1396 do i = 0 to n - 1; /* this loop stores values for both m-n pairs and single values */ 1397 nv = nv + 1; 1398 ival (nv) = f + i; 1399 end; 1400 1401 if nv = mxv then return; /* if we have gotten max allowed values */ 1402 1403 call ask_$ask_n (char32, flag); /* see if anything typed ahead */ 1404 if flag = 0 then return; /* nothing */ 1405 if ^ck_int (char32, f, n) then return; /* something, but not right form */ 1406 call ask_$ask_c (char32, flag); /* right form: read it again to remove it from the line */ 1407 goto get_int_loop; /* go decode and store it */ 1408 1409 end get_int_list; 1410 1411 1412 /* ****************************************************************************************************************** */ 1413 1414 1415 get_like_shift: proc (sh, sw); 1416 1417 dcl sh fixed bin; 1418 dcl sw bit (1) aligned; 1419 1420 sw = ""b; /* we have not gotten a "like" shift yet */ 1421 1422 call ask_$ask_n (char32, flag); /* look for type ahead */ 1423 if flag > 0 then /* there is some */ 1424 if char32 = "like" then do; /* "like" must be typed ahead if it is to be given */ 1425 call ask_$ask_c (char32, flag); /* get past "like" */ 1426 call ask_$ask_n (char32, flag); /* see what's next */ 1427 if flag > 0 then /* something there */ 1428 if char32 = "shift" then /* allow "shift" to preceed the number, if typed ahead */ 1429 call ask_$ask_c (char32, flag); /* get past "shift" */ 1430 1431 ask_like_shift: 1432 call ask_$ask_int ("like shift ", sh); /* ask for one shift number */ 1433 if sh < 0 | sh > 7 then do; 1434 call ioa_ ("illegal shift number: ^d", sh); 1435 call ask_$ask_clr; 1436 goto ask_like_shift; 1437 end; 1438 1439 sw = "1"b; /* we got a like shift */ 1440 end; 1441 1442 return; 1443 1444 end get_like_shift; 1445 1446 1447 /* ****************************************************************************************************************** */ 1448 1449 1450 get_shift_list: proc (nv); 1451 1452 dcl nv fixed bin; 1453 1454 call ask_$ask_n (char32, flag); /* see if any type ahead */ 1455 if flag > 0 then /* if there is */ 1456 if substr (char32, 1, 5) = "shift" then /* allow shift or shifts to be typed ahead */ 1457 call ask_$ask_c (char32, flag); /* get past it, if there */ 1458 ask_shifts: 1459 call get_int_list ("shifts ", (8), nv); 1460 if nv = 0 then do; 1461 call ioa_ ("some shifts must be given"); 1462 call ask_$ask_clr; 1463 goto ask_shifts; 1464 end; 1465 1466 return; 1467 1468 end get_shift_list; 1469 1470 1471 /* ****************************************************************************************************************** */ 1472 1473 1474 get_shift_spec: proc; 1475 1476 /* procedure to read a shift specification of one of the following forms, returning output as indicated: 1477* 1478* shift n nshf=1;shf(1)=n;shf(2) thru shf(mxval) = possible other shifts; mxval = how many altogether. 1479* shift m-n nshf = number of shifts defined in m-n range;shf(1) thru shf(nshf) = those shifts; mxval = 1. 1480* shift all nshf = number of shifts defined at site;shf(1) thru shf(nshf) = those shifts; mxval = 1. 1481* 1482* in all cases, fshift = shf(1); lshift = shf(nshf);nshift = lshift-fshift+1 (=nshf unless gaps in defined shifts) 1483* 1484**/ 1485 1486 dcl (f, n) fixed bin; 1487 1488 ask_shift: call ask_ ("shift(s) ", char32); /* "shift" is optional if we prompted the user */ 1489 if substr (char32, 1, 5) = "shift" then goto ask_shift; /* but required if he typed ahead */ 1490 1491 nshf = 0; /* initialize counter of specified shifts */ 1492 1493 if char32 = "all" then do; /* all defined shifts */ 1494 do shift = 0 to 7; 1495 if mgt.shift_defined (shift) then do; /* is this one defined? */ 1496 nshf = nshf + 1; /* if so, count it */ 1497 shf (nshf) = shift; /* and remember its number */ 1498 end; 1499 end; 1500 1501 fshift = shf (1); 1502 lshift = shf (nshf); 1503 nshift = lshift - fshift + 1; 1504 end; 1505 1506 else do; /* not "all" so better be a shift number or s1-s2 pair */ 1507 if ^ck_int (char32, f, n) then do; /* if not an integer or an s1-s2 pair */ 1508 call ioa_ ("bad shift value: ""^a""", char32); 1509 call ask_$ask_clr; 1510 goto ask_shift; 1511 end; 1512 1513 nshift = n; /* number of shifts */ 1514 fshift = f; /* first one */ 1515 lshift = fshift + nshift - 1; /* last one */ 1516 1517 do shift = fshift to lshift; /* fill in shift numbers in this range */ 1518 if mgt.shift_defined (shift) /* if shift defined */ 1519 | shift = fshift | shift = lshift then do; /* or is one of the shifts typed in */ 1520 nshf = nshf + 1; 1521 shf (nshf) = shift; 1522 end; 1523 end; 1524 end; 1525 1526 got_shift_spec = "1"b; /* remember that user gave it and we are not using the default */ 1527 mxval = 1; /* we expect one value, to be assigned to all specified shifts */ 1528 1529 if nshift > 1 then return; /* provided that more than one shift (m-n) was specified */ 1530 /* but if only a single shift number was specified, then a list 1531* of values can be given, to be assigned to successive defined 1532* shifts, starting with the one given */ 1533 mxval = 1; /* initialize counter of how many values could be given */ 1534 /* and fall thru, past the set default entry point */ 1535 1536 set_default_shift_spec: entry; /* come here to set defaults before seeing what was typed */ 1537 /* a single value is assigned to all defined shifts, by default, 1538* while the elements of a list of values are assigned 1539* to successive shifts */ 1540 do shift = fshift + 1 to 7; /* fshift is -1 if we came in at the set default entry */ 1541 if mgt.shift_defined (shift) then do; /* find all defined shifts after the specified one */ 1542 mxval = mxval + 1; /* count them in mxval */ 1543 shf (mxval) = shift; /* and remember their numbers */ 1544 end; 1545 end; 1546 1547 1548 return; 1549 1550 end get_shift_spec; 1551 1552 1553 /* ****************************************************************************************************************** */ 1554 1555 1556 get_values: proc (vtype, prompt, nv); 1557 1558 /* procedure to read a list of one or more values, prompting for them if they are not typed ahead. 1559* vtype is the value type: 1=integer;2=floating point;3=keyword. 1560* prompt is the prompting message. 1561* nv is the number of values returned. 1562* values are returned in one of the arrays: ival, fval, or bval, depending on vtype. 1563* 1564**/ 1565 1566 dcl prompt char (*); 1567 dcl (nv, vtype) fixed bin; 1568 dcl i fixed bin; 1569 1570 call ask_val (vtype, 1, prompt); 1571 nv = 1; /* we have at least one value */ 1572 1573 if mxval > 1 then /* if more than one value allowed */ 1574 do i = 2 to mxval; /* see if any more values were given */ 1575 call ask_$ask_n (char32, flag); /* look ahead without removing next word from line */ 1576 if flag ^= 0 & char32 ^= "." & char32 ^= "*" then do; /* if something there, and not terminator char */ 1577 call ask_cval (vtype, i, flag); /* see if it is of the right data type */ 1578 if flag > 0 then /* if it is, ask_cval has stored it */ 1579 nv = nv + 1; /* count it */ 1580 end; /* end something there */ 1581 end; /* end loop from 2 to mxval */ 1582 1583 /* having gotten one or more values, see what we got, and set some variables accordingly */ 1584 1585 if nv > 1 then /* if more than one value was given */ 1586 nshf = nv; /* remember to set exactly that many values */ 1587 1588 else do; /* only one value was given */ 1589 if ^got_shift_spec then /* default is "shift all" when one value given */ 1590 nshf = mxval; /* so remember to set values for all defined shifts */ 1591 1592 if nshf > 1 then /* if we want to assign values for several shifts */ 1593 do i = 2 to nshf; /* since we got only one value */ 1594 call assign_value (vtype, i, 1); /* make the right number of copies of it */ 1595 end; 1596 end; 1597 1598 return; 1599 1600 end get_values; 1601 1602 1603 /* ****************************************************************************************************************** */ 1604 1605 1606 look_ahead_value: proc (vtype, nv); 1607 1608 /* procedure to look ahead on the line for one or more typed ahead values. 1609* If none there, nv = 0 on return. If at least one there, get_values is called 1610* to get it, and any others that follow it. Values are returned as described under get_values. 1611* 1612**/ 1613 1614 dcl (nv, vtype) fixed bin; 1615 1616 nv = 0; /* until we find something */ 1617 1618 if vtype = 1 then /* integers */ 1619 call ask_$ask_nint (itemp, flag); 1620 else if vtype = 2 then /* floating points */ 1621 call ask_$ask_nflo (ftemp, flag); 1622 else if vtype = 3 then /* keywords */ 1623 call ask_nkey (btemp, flag); /* internal procedure */ 1624 1625 if flag = 1 then /* if something was there */ 1626 call get_values (vtype, "", nv); /* go get it, and others */ 1627 1628 return; 1629 1630 end look_ahead_value; 1631 1632 1633 /* ****************************************************************************************************************** */ 1634 1635 1636 prgp: proc (zp); 1637 1638 /* procedure to print all information about one group. 1639* zp is a pointer to the mgt entry containing the group. */ 1640 1641 dcl zp ptr; 1642 dcl (ctmp1, ctmp2) char (32) aligned, ii fixed bin; 1643 dcl i fixed bin; 1644 if zp -> group.minamax < 32767 then call ioa_$rsnnl ("(abs max ^.1f + ^d/^d)", ctmp1, ii, 1645 zp -> group.minamax / 1e1, zp -> group.num1, zp -> group.denom1); 1646 else ctmp1 = ""; 1647 if zp -> group.denom ^= 0 then call ioa_$rsnnl ("+ ^d/^d", ctmp2, ii, 1648 zp -> group.num, zp -> group.denom); 1649 else ctmp2 = ""; 1650 if zp -> group.max_prim < 0 then call ioa_ ("^/^8a^2x-1 ^a", 1651 zp -> group.group_id, ctmp1); 1652 else call ioa_ ("^/^8a^2x^5.1f ^a ^a", 1653 zp -> group.group_id, zp -> group.minu / 1e1, ctmp2, ctmp1); 1654 1655 call ioa_ ("int wc: ^8(^d^x^)", 1656 zp -> group.int_wc); 1657 call ioa_ ("abs wc: ^8(^d^x^)", 1658 zp -> group.abs_wc); 1659 1660 /* Print lines of the form: 1661* absentee: max min pct 1662* . MX MN PCT% 1663**/ 1664 1665 call ioa_ ("absentee:^11tmax^15tmin^19tpct^/^11t^3d^15t^3d^19t^3d%", 1666 zp -> group.absentee_max, zp -> group.absentee_min, zp -> group.absentee_pct); 1667 1668 if zp -> group.absentee.allowed then 1669 call ioa_ ("absentee allowed"); 1670 else call ioa_ ("absentee not allowed"); 1671 if zp -> group.absentee.default_group then do; 1672 call ioa_$nnl ("default group for queues:"); 1673 do i = 1 to 4; 1674 if zp -> group.absentee.default_queue (i) then 1675 call ioa_$nnl ("^x^d", i); 1676 end; 1677 call ioa_ (""); 1678 end; 1679 1680 return; 1681 1682 end prgp; 1683 1684 1685 /* ****************************************************************************************************************** */ 1686 1687 1688 print_ivals: proc (which, heading, fmt, ivals); 1689 1690 dcl (which, bvals) (0:7) bit (1) unaligned; 1691 dcl ivals (0:7) fixed bin; 1692 dcl iflts (0:7) fixed bin (17) unaligned; 1693 dcl (fmt, heading) char (*); 1694 dcl scale float bin; 1695 dcl (i, vtype) fixed bin; 1696 1697 vtype = 1; 1698 goto print_common; 1699 1700 /* ********** */ 1701 1702 print_iflt: entry (which, heading, fmt, iflts, scale); 1703 1704 vtype = 2; 1705 goto print_common; 1706 1707 /* ********** */ 1708 1709 print_bvals: entry (which, heading, fmt, bvals); 1710 1711 vtype = 3; 1712 goto print_common; 1713 1714 /* ********** */ 1715 1716 print_shfs: entry (which, heading, fmt); 1717 1718 vtype = 4; 1719 goto print_common; 1720 1721 /* ********** */ 1722 1723 print_ivals_check_zero: 1724 entry (which, heading, fmt, iflts); 1725 1726 vtype = 5; 1727 1728 /* ********** */ 1729 1730 print_common: 1731 1732 call ioa_$nnl (heading); 1733 1734 do i = 0 to 7; 1735 if which (i) then 1736 if vtype = 1 then 1737 call ioa_$nnl (fmt, ivals (i)); 1738 else if vtype = 2 then 1739 call ioa_$nnl (fmt, float (iflts (i)) / scale); 1740 else if vtype = 3 then 1741 call ioa_$nnl (fmt, bvals (i)); 1742 else if vtype = 4 then 1743 call ioa_$nnl (fmt, i); 1744 else call ioa_$nnl (fmt, (iflts (i) = 0), iflts (i)); /* vtype must be 5 */ 1745 end; 1746 call ioa_ (""); 1747 1748 return; 1749 1750 end print_ivals; 1751 1752 1753 /* ****************************************************************************************************************** */ 1754 1755 1756 prwc: proc (zp); 1757 1758 /* procedure to print all information about one work class. 1759* zp is a pointer to the mgt entry containing the work class. */ 1760 1761 dcl zp ptr; 1762 1763 call ioa_$nnl ("^/^2a", zp -> work_class.wc_name); 1764 if string (zp -> work_class.switches.defined) = ""b then do; 1765 wcundef = "1"b; 1766 return; 1767 end; 1768 1769 call print_shfs (zp -> work_class.switches.defined, "^xdefined on shifts", "^x^5d"); 1770 1771 call print_bvals (zp -> work_class.switches.defined, "^4xabsentee allowed", 1772 "^[^3xyes^;^4xno^]", zp -> work_class.switches.absentee_allowed); 1773 1774 call print_bvals (zp -> work_class.switches.defined, "^16xmode", 1775 "^[^4xrt^;^2xnorm^]", zp -> work_class.switches.realtime); 1776 1777 call print_ivals (zp -> work_class.switches.defined, "^9xmin percent", 1778 "^3x^3d", zp -> work_class.min_pct); 1779 1780 call print_ivals_check_zero (zp -> work_class.switches.defined, "^9xmax percent", 1781 "^[^6x^1s^;^3x^3d^]", zp -> work_class.max_pct); 1782 1783 1784 call print_iflt (zp -> work_class.switches.defined, "^12xint resp", 1785 "^x^5.2f", zp -> work_class.int_response, 100e0); 1786 1787 call print_iflt (zp -> work_class.switches.defined, "^9xint quantum", 1788 "^x^5.2f", zp -> work_class.int_quantum, 100e0); 1789 1790 call print_iflt (zp -> work_class.switches.defined, "^16xresp", 1791 "^x^5.2f", zp -> work_class.response, 100e0); 1792 1793 call print_iflt (zp -> work_class.switches.defined, "^13xquantum", 1794 "^x^5.2f", zp -> work_class.quantum, 100e0); 1795 1796 1797 return; 1798 1799 end prwc; 1800 1801 1802 /* ****************************************************************************************************************** */ 1803 1804 1805 pxref: proc; 1806 1807 /* procedure to print a cross reference of groups and work classes. 1808* NOTE: this code assumes that the mgt passes the "verify" checks, and no 1809* attempt is made to do anything sensible with an mgt that fails those checks. 1810* User documentation emphasizes this. */ 1811 1812 /* Scan work classes and groups - see which shifts are used, 1813* and if any groups do not allow absentees (forcing them to be moved to other groups) */ 1814 1815 print_pct_ignored = ""b; /* turned on if we must print msg explaining asterisk */ 1816 no_abs_count = 0; /* count the no-absentee groups, if any */ 1817 no_abs = ""b; /* remember if there are any at all */ 1818 nshift = 0; /* count shifts used */ 1819 shift_used (*) = ""b; /* remember which ones are used */ 1820 1821 do i = 1 to 16; /* go thru work classes */ 1822 mgtep = addr (mgt.entry (i)); /* get ptr to work class */ 1823 do shift = 0 to 7; /* go thru shifts */ 1824 if work_class.switches.defined (shift) then 1825 shift_used (shift) = "1"b; 1826 end; 1827 end; 1828 1829 do shift = 0 to 7; /* fill in array of shift numbers 1830* (for convenience in later code) */ 1831 if shift_used (shift) then do; 1832 nshift = nshift + 1; /* count shifts used */ 1833 shifts (nshift) = shift; /* and save their numbers */ 1834 end; 1835 end; 1836 1837 do i = 17 to mgt.current_size; /* go thru groups */ 1838 mgtep = addr (mgt.entry (i)); /* get ptr to group */ 1839 if ^group.absentee.allowed then do; /* if it does not allow absentees */ 1840 no_abs = "1"b; /* remember that such groups exists */ 1841 no_abs_count = no_abs_count + 1; /* and count them */ 1842 end; 1843 end; 1844 1845 /* Print heading */ 1846 1847 call ioa_$nnl ("^/Work classes defined on shift(s):"); 1848 do i = 1 to nshift; 1849 call ioa_$nnl ("^x^d", shifts (i)); 1850 end; 1851 call ioa_ ("^2/WC^13xGROUP(S)"); 1852 1853 /* Initialize for printing cross reference of each shift */ 1854 1855 lshift = -1; /* we don't print out identical shifts more than once - 1856* we just say "like shift N" */ 1857 /* lshift remembers which one it is like, while we see if there 1858* are any more like it */ 1859 ival (*) = 0; /* we use ival to remember which ones we actually printed out */ 1860 1861 /* Outer loop on shifts - but only the ones for which work classes are defined */ 1862 do i = 1 to nshift; 1863 shift = shifts (i); /* get actual shift number */ 1864 1865 /* Check for this shift being like one we already printed */ 1866 1867 if lshift >= 0 then do; /* the previous shift we looked at was like one we printed */ 1868 if shifts_alike (lshift, shift) then /* if this one is like it too */ 1869 if i < nshift then /* and there are more shifts */ 1870 goto next_shift; /* go look at next one */ 1871 else i = i + 1; /* trick to special case the last one, when the 1872* last n shifts are alike (code below says "i-1") */ 1873 /* fall thru and print message which includes this shift */ 1874 1875 /* This shift is not like the previous one. Print message for previous ones, 1876* of the form: shift(s) i j k ... like shift N */ 1877 1878 do j = 1 to nshift /* find index of first shift that was like the one printed */ 1879 while (shifts (j) ^= fshift); 1880 end; 1881 if j = i - 1 then /* if just one shift like it */ 1882 print_one_alike: 1883 call ioa_ ("^5xshift ^d like shift ^d", shifts (j), lshift); 1884 else do; 1885 call ioa_$nnl ("^5xshifts"); 1886 do k = j to i - 1; 1887 call ioa_$nnl ("^x^d", shifts (k)); 1888 end; 1889 call ioa_ ("^xlike shift ^d", lshift); 1890 end; 1891 1892 if i > nshift then goto next_shift; /* exit, if last n shifts were alike */ 1893 end; 1894 1895 /* If this shift was not like the previous one, it might still be like one of the others */ 1896 1897 lshift = -1; /* start by assuming it isn't */ 1898 if i > 1 then /* if there are any others */ 1899 do j = 1 to i - 1; /* go thru them */ 1900 if ival (shifts (j)) = 1 then /* only look at ones that were printed */ 1901 if shifts_alike (shifts (j), shift)/* compare them to this one */ 1902 then do; /* if equal */ 1903 lshift = shifts (j); /* remember the number of the earlier one */ 1904 fshift = shift; /* and remember that this one is the first one like it */ 1905 if i = nshift then do; /* special case last one like one other */ 1906 j = nshift; /* index of last shift, used for printing it */ 1907 i = i + 1; /* force exit from loop */ 1908 goto print_one_alike; 1909 end; 1910 goto next_shift; /* go look at next one */ 1911 end; 1912 end; 1913 1914 /* if we fall thru here, there is no way we can get out of printing this shift */ 1915 1916 call ioa_ ("^5xshift ^d", shift); 1917 call pxshft (shift); /* go print it */ 1918 ival (shift) = 1; /* and remember that we did so */ 1919 1920 next_shift: end; 1921 1922 if print_pct_ignored then /* if there was a realtime work class */ 1923 call ioa_ ("^/* This percent is not counted because the work class is realtime on this shift."); 1924 1925 return; 1926 1927 1928 /* ********** INTERNAL PROCEDURE WITHIN THIS INTERNAL PROCEDURE ********** */ 1929 1930 1931 shifts_alike: proc (s1, s2) returns (bit (1) aligned); 1932 1933 /* procedure to determine whether or not two shifts are alike, 1934* with respect to work class and load control group definitions */ 1935 1936 dcl (s1, s2) fixed bin; 1937 dcl i fixed bin; 1938 1939 do i = 1 to 16; 1940 mgtep = addr (mgt.entry (i)); 1941 if work_class.min_pct (s1) ^= work_class.min_pct (s2) then goto diff; 1942 if work_class.max_pct (s1) ^= work_class.max_pct (s2) then goto diff; 1943 if work_class.switches.defined (s1) ^= work_class.switches.defined (s2) then goto diff; 1944 if work_class.switches.absentee_allowed (s1) ^= work_class.switches.absentee_allowed (s2) 1945 then goto diff; 1946 end; 1947 do i = 17 to mgt.current_size; 1948 mgtep = addr (mgt.entry (i)); 1949 if group.int_wc (s1) ^= group.int_wc (s2) then goto diff; 1950 if group.abs_wc (s1) ^= group.abs_wc (s2) then goto diff; 1951 end; 1952 return ("1"b); /* we were unable to find any differences */ 1953 diff: return ("0"b); /* something was different */ 1954 1955 end shifts_alike; 1956 1957 1958 end pxref; 1959 1960 1961 /* ****************************************************************************************************************** */ 1962 1963 1964 pxshft: proc (shift); 1965 1966 /* procedure to print cross reference for one shift */ 1967 1968 dcl shift fixed bin; 1969 dcl (i, j, igrp, agrp, dfct, colct) fixed bin; 1970 dcl (int, abs, int_abs_diff) bit (1) aligned; 1971 dcl print_asterisk bit (1) aligned; 1972 1973 1974 do i = 1 to 16; /* go thru work classes, examining and printing each */ 1975 mgtep = addr (mgt.entry (i)); 1976 if ^work_class.switches.defined (shift) then goto next_wc; /* skip undefined ones */ 1977 wcp = mgtep; /* remember the ptr to it */ 1978 int_abs_diff = ""b; /* these are per-work class data */ 1979 igrp, agrp = 0; 1980 default_absentee = "0"b; 1981 string (dflt_q) = ""b; 1982 do j = 17 to mgt.current_size; /* pre-scan groups to see what we have to print */ 1983 mgtep = addr (mgt.entry (j)); 1984 if group.int_wc (shift) = i then int = "1"b; 1985 else int = ""b; 1986 if ^group.absentee.allowed then goto noabs; 1987 if group.abs_wc (shift) = i then abs = "1"b; 1988 else 1989 noabs: abs = ""b; 1990 1991 if ^int & ^abs then /* if this group does not use the work class we're printing */ 1992 goto next_group; 1993 if int ^= abs then int_abs_diff = "1"b; 1994 if int then igrp = igrp + 1; /* count interactive groups */ 1995 if abs then agrp = agrp + 1; /* count absentee groups */ 1996 if group.absentee.default_group then do;/* if this is a default absentee group */ 1997 default_absentee = "1"b; /* remember that such a group exists */ 1998 string (dflt_q) = string (dflt_q) | string (group.absentee.default_queue); 1999 /* remember which queues have defaults */ 2000 end; 2001 next_group: end; /* end of prescan loop over groups */ 2002 2003 if wcp -> work_class.switches.realtime (shift) then /* if realtime */ 2004 print_pct_ignored, print_asterisk = "1"b; /* remember to say so */ 2005 else print_asterisk = ""b; /* otherwise don't */ 2006 2007 /* now print the stuff */ 2008 2009 call ioa_$nnl ("^2d^2x^3d^[*^;%^]^[(^3d)^;^5x^1s^]^2x", i, wcp -> work_class.min_pct (shift), 2010 print_asterisk, (^print_asterisk & (wcp -> work_class.max_pct (shift) ^= 0)), 2011 wcp -> work_class.max_pct (shift)); 2012 2013 2014 if igrp > 0 then do; /* if any interactive groups in this work class */ 2015 if int_abs_diff then call ioa_$nnl ("int^x"); 2016 else call ioa_$nnl ("i&a^x"); 2017 call pxgrps (igrp, 1); /* go print igrp interactive groups */ 2018 end; 2019 2020 if agrp > 0 & int_abs_diff then do; /* if absentees not identical to interactives */ 2021 if igrp > 0 then call ioa_$nnl ("^10xabs^x"); /* if we printed interactives */ 2022 else call ioa_$nnl ("abs^x"); 2023 call pxgrps (agrp, 2); /* go print agrp absentee groups */ 2024 end; 2025 else if igrp = 0 then /* if neither interactive nor absentee groups in this wc */ 2026 call ioa_ (""); /* get back to left margin - last call was to ioa_$nnl */ 2027 2028 if default_absentee then do; /* if a default absentee group is in this work class */ 2029 call ioa_$nnl ("^2xq"); /* print which ^2xqueues */ 2030 dfct = 0; 2031 colct = 0; 2032 do j = 1 to 4; /* go over the queues */ 2033 if dflt_q (j) then do; 2034 dfct = dfct + 1; 2035 if dfct = 1 then goto prq; /* go print q number */ 2036 if j = 4 then do; /* if last one */ 2037 j = 5; /* tricky */ 2038 goto prq; /* prq says "j-1" */ 2039 end; 2040 end; 2041 else if dfct = 1 then dfct = 0; /* previous q but not this one */ 2042 else if dfct > 0 then do; /* previous few queues - print the last one */ 2043 prq: 2044 colct = colct + 2; /* count cols, for later spacing to next field */ 2045 if dfct > 2 then /* if more than 2 queues */ 2046 call ioa_$nnl ("-^d", j - 1); /* print "m-n" */ 2047 else call ioa_$nnl ("^x^d", j); /* just print a queue */ 2048 if dfct > 1 then dfct = 0; /* previous queues but not this one */ 2049 end; 2050 end; 2051 2052 colct = 11 - colct + 1; /* number of columns left to get to next field */ 2053 call ioa_$nnl ("^vxdflt", colct); 2054 2055 call pxgrps (no_abs_count, 3); /* go print groups whose absentees get put into this work class */ 2056 end; 2057 2058 next_wc: end; 2059 2060 /* ********** INTERNAL PROCEDURE WITHIN THIS INTERNAL PROCEDURE ********** */ 2061 2062 pxgrps: proc (ngroups, type); 2063 2064 /* procedure to print ngroups group names, that fit into the 2065* category specified by type. type can be 1, 2, or 3, indicating 2066* interactive, absentee, and default absentee groups, respectively. 2067* names are printed four per line, starting in column 16 */ 2068 2069 dcl (ngroups, type) fixed bin; 2070 dcl (lct, gct) fixed bin; 2071 2072 gct, lct = 0; /* initialize group and groups-per-line counters */ 2073 do j = 17 to mgt.current_size; 2074 mgtep = addr (mgt.entry (j)); 2075 if type = 1 then do; /* interactive */ 2076 if group.int_wc (shift) = i then goto prgp; 2077 else goto skip_grp; 2078 end; 2079 else if type = 2 then do; /* absentee */ 2080 if group.abs_wc (shift) = i then goto prgp; 2081 else goto skip_grp; 2082 end; 2083 else if type = 3 then do; /* default absentee */ 2084 if ^group.absentee.allowed then /* if absentees not allowed in this group */ 2085 goto prgp; /* they will have to be moved to a default absentee group */ 2086 else goto skip_grp; 2087 end; 2088 2089 prgp: gct = gct + 1; /* count groups printed */ 2090 lct = lct + 1; /* count groups on this line */ 2091 if lct >= 5 then do; 2092 lct = 1; 2093 call ioa_$nnl ("^/^14x"); 2094 end; 2095 call ioa_$nnl ("^x^8a", group.group_id); 2096 2097 skip_grp: if gct >= ngroups then goto ret; /* quit as soon as all groups are printed */ 2098 end; 2099 ret: if lct > 0 | gct = 0 then call ioa_ (""); /* carriage return, if we have printed part of a line */ 2100 return; 2101 end pxgrps; 2102 2103 2104 2105 end pxshft; 2106 2107 2108 /* ****************************************************************************************************************** */ 2109 2110 2111 scan_key: proc (keys, comma_count, bval, flag); 2112 2113 dcl keys char (*); 2114 dcl key char (32) varying; 2115 dcl (comma_count, flag) fixed bin; 2116 dcl bval bit (1) aligned; 2117 dcl (comma_offset, curpos, keypos, kln, ln, n_commas) fixed bin; 2118 2119 kln = length (keys); 2120 ln = length (char32) + 1 - verify (reverse (char32), " "); /* 1 nonblank gives 32+1-32=1 */ 2121 2122 /* See if given keyword is one of the legal ones, and if so, get its position in the set of legal ones */ 2123 2124 key = "," || substr (char32, 1, ln) || ","; /* to force match only on word delimited by commas */ 2125 if keys = substr (key, 2, kln) then keypos = 1; /* trivial case - only one legal keyword */ 2126 else if ln + 1 > kln then keypos = 0; /* keyword plus one comma longer than keys - no match possible */ 2127 else if substr (keys, 1, ln + 1) = substr (key, 2, ln + 1) then /* first legal keyword has no leading comma */ 2128 keypos = 1; 2129 else if substr (keys, kln - ln, ln + 1) = substr (key, 1, ln + 1) then /* last one has no trailing comma */ 2130 keypos = kln - ln + 1; 2131 else if ln + 2 > kln then keypos = 0; /* keyword plus two commas too long - no match possible */ 2132 else do; /* scan for match within legal keyword string */ 2133 keypos = index (keys, key); 2134 if keypos > 0 then /* if we found a match */ 2135 keypos = keypos + 1; /* move past the leading comma */ 2136 end; 2137 2138 if keypos = 0 then /* if no match */ 2139 flag = 0; /* tell caller, and do nothing else */ 2140 2141 else do; /* keyword legal, so see if it corresponds to "1"b or "0"b */ 2142 flag = 1; /* tell caller */ 2143 n_commas = 0; /* count commas before the matching key */ 2144 curpos = 1; /* start at beginning of first key */ 2145 do while (curpos < keypos); /* keep looking until we hit the matching key */ 2146 comma_offset = index (substr (keys, curpos, keypos - curpos), ","); /* look for comma */ 2147 if comma_offset > 0 then do; /* if we found one */ 2148 n_commas = n_commas + 1; /* count it */ 2149 curpos = curpos + comma_offset; /* move past it */ 2150 end; 2151 end; /* fall thru when curpos >= keypos */ 2152 2153 if n_commas < comma_count then /* if the matching key is in the first half */ 2154 bval = "1"b; /* the keyword corresponds to "1"b */ 2155 else bval = "0"b; /* if in the second half, "0"b */ 2156 2157 end; 2158 2159 return; 2160 2161 end scan_key; 2162 2163 2164 /* ****************************************************************************************************************** */ 2165 2166 2167 shift_is_defined: proc (sh) returns (bit (1) aligned); 2168 2169 dcl sh fixed bin; 2170 dcl i fixed bin; 2171 2172 do i = 1 to 16 /* look thru all work classes */ 2173 while (^addr (mgt.entry (i)) -> work_class.switches.defined (sh)); 2174 end; /* to see if any are defined on the specified shift */ 2175 2176 if i <= 16 then /* if any are */ 2177 return ("1"b); /* say yes */ 2178 else return (""b); /* else say no */ 2179 2180 end shift_is_defined; 2181 2182 /* ****************************************************************************************************************** */ 2183 2184 2185 undefine_shift: proc (sh); 2186 2187 dcl sh fixed bin; 2188 dcl i fixed bin; 2189 2190 call undefine_wc (sh, 1, 16); /* undefine work classes 1-16 on this shift */ 2191 do i = 17 to mgt.current_size; /* undefine all groups on this shift */ 2192 mgtep = addr (mgt.entry (i)); 2193 group.int_wc (sh) = 0; 2194 group.abs_wc (sh) = 0; 2195 end; 2196 2197 return; 2198 2199 end undefine_shift; 2200 2201 2202 /* ****************************************************************************************************************** */ 2203 2204 2205 undefine_wc: proc (sh, ft, lt); 2206 2207 dcl (ft, lt, sh) fixed bin; 2208 dcl i fixed bin; 2209 2210 do i = ft to lt; 2211 mgtep = addr (mgt.entry (i)); 2212 work_class.switches.defined (sh) = ""b; 2213 work_class.switches.absentee_allowed (sh) = ""b; 2214 work_class.switches.realtime (sh) = ""b; 2215 work_class.min_pct (sh) = 0; 2216 work_class.max_pct (sh) = 0; 2217 work_class.int_response (sh) = 0; 2218 work_class.int_quantum (sh) = 0; 2219 work_class.response (sh) = 0; 2220 work_class.quantum (sh) = 0; 2221 end; 2222 2223 return; 2224 2225 end undefine_wc; 2226 2227 2228 /* ****************************************************************************************************************** */ 2229 2230 2231 verify_mgt: proc; 2232 2233 /* procedure to verify the correctness and consistency of the mgt, 2234* and report all errors it finds */ 2235 2236 dcl err_max fixed bin init (5); 2237 dcl err_count fixed bin init (0); 2238 dcl warning_printed bit (1) aligned; 2239 dcl wc_printed bit (1) aligned; 2240 dcl low_pct (0:7) bit (1) aligned; 2241 dcl unused_pct (0:7) bit (1) aligned; 2242 dcl print_unused_pct bit (1) aligned; 2243 dcl pct_is_used bit (1) aligned; 2244 dcl wc_empty (0:7, 16) bit (1) aligned; 2245 2246 wc_empty = ""b; /* array initializations */ 2247 low_pct = ""b; 2248 2249 call ask_$ask_cint (itemp, flag); /* check for optional max error count */ 2250 if flag > 0 then err_max = itemp; /* if given, override default with it */ 2251 2252 /* The following code makes the same correctness tests that up_mgt_ makes, but when it 2253* finds an error, it reports it in more detail, and keeps going instead of quitting at the first error. */ 2254 2255 2256 do shift = 0 to 7; /* check consistency on each shift */ 2257 2258 shift_used (shift) = ""b; /* remember which shifts are used */ 2259 shift_pct = 0; /* sum of percentages */ 2260 no_abs = ""b; 2261 string (dflt_q) = ""b; /* keep track of absentee groups */ 2262 unused_pct (shift) = ""b; /* keep track of pcts unused because of 2263* deadline or realtime scheduling */ 2264 2265 do i = 1 to 16; /* first go thru work classes */ 2266 /* checking if defined, and adding up percentages */ 2267 wcp = addr (mgt.entry (i)); 2268 if wcp -> work_class.switches.defined (shift) then do; /* if defined */ 2269 wc_empty (shift, i) = "1"b; /* since wc defined on shift, see if it is used */ 2270 /* assume it is not used until we see that it is */ 2271 shift_used (shift) = "1"b; /* at least one is, on this shift */ 2272 2273 if mgt.switches.deadline_mode (shift) | wcp -> work_class.switches.realtime (shift) then do; 2274 pct_is_used = ""b; /* remember not to count this one's percent */ 2275 unused_pct (shift) = "1"b; /* remember to explain, if % < 100 on this shift */ 2276 end; 2277 else pct_is_used = "1"b; /* remember to add in this one's percent */ 2278 if wcp -> work_class.min_pct (shift) <= 0 then do; 2279 call ioa_ ("bad percent (^d) for work class ^d on shift ^d", 2280 wcp -> work_class.min_pct (shift), i, shift); 2281 if ^pct_is_used then 2282 call ioa_ ("(percent is ignored for realtime workclass, but must be > 0 to install MGT.)"); 2283 call count_error; 2284 end; 2285 2286 if wcp -> work_class.max_pct (shift) < 0 | wcp -> work_class.max_pct (shift) > 100 then do; 2287 call ioa_ ("bad max percent (^d) for work class ^d on shift ^d", 2288 wcp -> work_class.max_pct (shift), i, shift); 2289 call count_error; 2290 end; 2291 2292 call check_rq (wcp -> work_class.int_quantum (shift), "010"b); /* resp=0;int=1;realtm=0 */ 2293 call check_rq (wcp -> work_class.quantum (shift), "000"b); /* resp=0;int=0;realtm=0 */ 2294 if wcp -> work_class.switches.realtime (shift) then do; /* if realtime work class */ 2295 call check_rq (wcp -> work_class.int_response (shift), "111"b); /* resp=1;int=1;realtm=1 */ 2296 call check_rq (wcp -> work_class.response (shift), "101"b); /* resp=1;int=0;realtm=1 */ 2297 end; 2298 2299 if pct_is_used then /* except for realtime work classes */ 2300 shift_pct = shift_pct + wcp -> work_class.min_pct (shift); /* add up percentages */ 2301 end; 2302 end; /* end loop on work classes */ 2303 if shift_pct > 100 then do; 2304 call ioa_ ("sum of work class percents > 100 (^d) on shift ^d", shift_pct, shift); 2305 call count_error; 2306 end; 2307 else if shift_used (shift) then 2308 if shift_pct < 100 then 2309 low_pct (shift) = "1"b; 2310 2311 do i = 17 to mgt.current_size; /* now go thru all groups */ 2312 mgtep = addr (mgt.entry (i)); 2313 2314 if ^shift_used (shift) then do; /* if no work classes defined on this shift */ 2315 if group.int_wc (shift) ^= 0 then call shift_err_int; /* there better be no work classes used */ 2316 if group.abs_wc (shift) ^= 0 then call shift_err_abs; 2317 end; 2318 2319 else do; /* some work classes are defined */ 2320 wc_empty (shift, group.int_wc (shift)) = "0"b; /* not empty */ 2321 wcp = addr (mgt.entry (group.int_wc (shift))); 2322 if ^wcp -> work_class.switches.defined (shift) then /* see if this one is */ 2323 call shift_err_int; /* and complain if not */ 2324 2325 if group.absentee.allowed then do; /* if absentees allowed in this group */ 2326 wc_empty (shift, group.abs_wc (shift)) = "0"b; /* not empty */ 2327 wcp = addr (mgt.entry (group.abs_wc (shift))); 2328 if ^wcp -> work_class.switches.defined (shift) then 2329 /* make sure their work class is defined */ 2330 call shift_err_abs; /* and complain if not */ 2331 if ^wcp -> work_class.switches.absentee_allowed (shift) then do; 2332 call ioa_ ("group ""^a"" absentees on shift ^d are in work class ^d, 2333 but that work class does not allow absentees", group.group_id, shift, group.abs_wc (shift)); 2334 call count_error; 2335 end; 2336 2337 if group.absentee.default_group then do; /* if this is a default group for some queue(s) */ 2338 do j = 1 to 4; /* go thru queues */ 2339 if group.absentee.default_queue (j) then /* if it is for this queue */ 2340 if dflt_q (j) then do; /* but there already is one */ 2341 call ioa_ ("more than one default group for absentee queue ^d: 2342 group ""^a"" is an additional one (group ""^a"" is the first one)", j, group.group_id, 2343 addr (mgt.entry (dflt_g (j))) -> group.group_id); 2344 call count_error; 2345 end; 2346 2347 else do; /* otherwise, remember that we have a default for this queue */ 2348 dflt_q (j) = "1"b; 2349 dflt_g (j) = i; 2350 end; /* and remember which group, for possible error message */ 2351 end; 2352 end; 2353 end; /* end absentee allowed */ 2354 2355 else do; /* absentee not allowed in this group */ 2356 no_abs = "1"b; /* remember that there is such a group */ 2357 if group.absentee.default_group then do; 2358 call ioa_ ("group ""^a"" does not allow absentees, but is given as the default 2359 group for absentee queue ^d", group.group_id, j); 2360 call count_error; 2361 end; 2362 end; /* end absentees not allowed */ 2363 end; /* end some work classes defined on this shift */ 2364 end; /* end loop thru all groups */ 2365 2366 if no_abs then /* if a no-absentee group exists */ 2367 if string (dflt_q) ^= "1111"b then do; /* and there are not default groups for all queues */ 2368 do j = 1 to 4; /* print message for each queue */ 2369 if ^dflt_q (j) then do; 2370 call ioa_ ("There is no default group for absentee queue ^d, but there is a 2371 group that does not allow absentees", j); 2372 call count_error; 2373 end; 2374 end; 2375 end; 2376 2377 end; /* end loop on shifts */ 2378 2379 do i = 17 to mgt.current_size; /* make a last pass thru groups, checking group only parameters */ 2380 mgtep = addr (mgt.entry (i)); 2381 if group.absentee_pct < 0 | group.absentee_pct > 100 then do; 2382 call ioa_ ("illegal absentee percent (^d%) for group ""^a""", 2383 group.absentee_pct, group.group_id); 2384 call count_error; 2385 end; 2386 2387 if group.absentee_min > group.absentee_max then do; 2388 call ioa_ ("absentee_min (^d) greater than absentee_max (^d) for group ""^a""", 2389 group.absentee_min, group.absentee_max, group.group_id); 2390 call count_error; 2391 end; 2392 2393 if group.absentee_max < 0 then do; 2394 call ioa_ ("absentee_max (^d) for group ""^a"" is negative.", group.absentee_max, group.group_id); 2395 call count_error; 2396 end; 2397 end; 2398 2399 if err_count = 0 then 2400 call ioa_ ("No errors"); 2401 else call ioa_ ("^d errors - the mgt can not be installed", err_count); 2402 2403 /* Check for suspicious-looking conditions, that are not fatal errors, 2404* but are likely to be oversignts on the part of the user */ 2405 2406 warning_printed = "0"b; /* remember that we have not printed a heading line */ 2407 print_unused_pct = ""b; /* stays off unless we print a * beside some shift */ 2408 2409 do shift = 0 to 7; /* check for sum of percents < 100% on any shift */ 2410 if low_pct (shift) /* look for first such shift */ 2411 & ^mgt.switches.deadline_mode (shift) then do; /* except realtime shifts, whose pcts aren't used */ 2412 call print_warning; /* go print heading, if not already done */ 2413 call ioa_$nnl ("Sum of work class percents is < 100% on shift(s):"); 2414 do shift = shift to 7; /* go thru shifts from this one to last */ 2415 if low_pct (shift) then do; 2416 call ioa_$nnl ("^x^d^[*^]", shift, unused_pct (shift)); 2417 if unused_pct (shift) then print_unused_pct = "1"b; /* remember to explain the * */ 2418 end; 2419 end; 2420 if print_unused_pct then /* if we put asterisks beside some shifts, explain them */ 2421 call ioa_ 2422 ("^/* There are realtime work classes in this shift; their percents are not counted."); 2423 call ioa_ (""); 2424 end; 2425 end; /* inner loop runs the index of this one out to its limit */ 2426 2427 wc_printed = ""b; /* remember we have not printed wc heading */ 2428 do shift = 0 to 7; /* check for wc with no groups in it */ 2429 do i = 1 to 16; 2430 if wc_empty (shift, i) then do; /* search for first such occurrence */ 2431 call print_warning; 2432 if ^wc_printed then do; 2433 wc_printed = "1"b; 2434 call ioa_ ("The following work class(es) are unused on the indicated shifts"); 2435 end; 2436 call ioa_$nnl ("shift ^d: ", shift); 2437 do i = i to 16; /* go thru work classes from this one to last */ 2438 if wc_empty (shift, i) then 2439 call ioa_$nnl ("^x^d", i); 2440 end; 2441 call ioa_ (""); 2442 end; 2443 end; /* inner loop runs the index of this one out to its limit */ 2444 end; /* end loop on shifts */ 2445 2446 do shift = 0 to 7; 2447 do i = 1 to 16; 2448 wcp = addr (mgt.entry (i)); 2449 if wcp -> work_class.switches.defined (shift) & 2450 ^wcp -> work_class.switches.realtime (shift) then do; 2451 call check_rq (wcp -> work_class.int_response (shift), "110"b); 2452 call check_rq (wcp -> work_class.response (shift), "100"b); 2453 end; 2454 end; 2455 end; 2456 2457 do i = 17 to mgt.current_size; /* check for reasonable absentee user limits */ 2458 mgtep = addr (mgt.entry (i)); 2459 if group.absentee_max = 0 /* if max is zero */ 2460 & ^(group.absentee_min = 0 /* and min and percent are not */ 2461 & group.absentee_pct = 0) then do; /* both zero, no absentee jobs for the group can log in */ 2462 call print_warning; /* print warning heading if not already done */ 2463 call ioa_ ("group ""^a"": absentee_max=^d, absentee_min=^d, absentee_pct=^d%, so jobs from this group will never log in.", 2464 group.group_id, group.absentee_max, group.absentee_min, group.absentee_pct); 2465 end; 2466 end; 2467 2468 verify_exit: return; 2469 2470 /* ********** INTERNAL PROCEDURES WITHIN THIS INTERNAL PROCEDURE ********** */ 2471 2472 2473 check_rq: proc (val, sw); /* check response and quantum values */ 2474 2475 dcl val fixed bin (17) unaligned; 2476 dcl sw bit (3) unaligned; 2477 dcl resp bit (1) unaligned defined (sw) pos (1); 2478 dcl int bit (1) unaligned defined (sw) pos (2); 2479 dcl realtm bit (1) unaligned defined (sw) pos (3); 2480 2481 if val > 0 then return; /* positive value is ok for anything */ 2482 if resp & val = 0 then return; /* zero is ok for realtime response */ 2483 /* quantum must always be >0 */ 2484 /* realtime response must >= 0 */ 2485 /* nonrealtime response should be >= 0, 2486* but we only give warning if it is negative */ 2487 2488 if resp & ^realtm then /* if just a warning */ 2489 call print_warning; /* tell user so */ 2490 else call count_error; /* otherwise increment fatal error count */ 2491 2492 call ioa_ ("^[^;zero or ^]negative ^[int_^]^[response^;quantum^] (^.2f) for ^[realtime ^]work class ^d on shift ^d", 2493 realtm, int, resp, float (val) / 100e0, realtm, i, shift); 2494 2495 return; 2496 2497 end check_rq; 2498 2499 2500 /* ********** ********** */ 2501 2502 print_warning: proc; 2503 2504 if ^warning_printed then do; 2505 call ioa_ ("Warnings (will not prevent installation of MGT):"); 2506 warning_printed = "1"b; 2507 end; 2508 return; 2509 2510 end print_warning; 2511 2512 /* ********** ********** */ 2513 2514 shift_err_int: proc; 2515 dcl wc fixed bin; 2516 dcl ia char (11); /* interactive or absentee */ 2517 wc = group.int_wc (shift); 2518 ia = "interactive"; 2519 shift_err_common: 2520 if wc = 0 then 2521 call ioa_ ("^a work class of group ""^a"" on shift ^d is undefined (=0), 2522 but work classes are defined on that shift", ia, group.group_id, shift); 2523 else call ioa_ ("work class ^d is undefined on shift ^d but is used by group ""^a"" (^a)", 2524 wc, shift, group.group_id, ia); 2525 call count_error; 2526 return; 2527 shift_err_abs: entry; 2528 wc = group.abs_wc (shift); 2529 ia = "absentee"; 2530 goto shift_err_common; 2531 end shift_err_int; 2532 2533 /* ********** ********** */ 2534 2535 count_error: proc; 2536 err_count = err_count + 1; 2537 if mod (err_count, err_max) = 0 then do; 2538 call ask_$ask_yn ("^d errors - do you wish to continue? ", char32, err_count); 2539 if char32 = "no" then goto verify_exit; /* nonlocal goto */ 2540 end; 2541 return; 2542 end count_error; 2543 2544 end verify_mgt; 2545 2546 initialize_mgt: 2547 procedure; 2548 2549 dcl wcx fixed bin; 2550 2551 mgt.author.proc_group_id = get_group_id_ (); 2552 mgt.table = "MGT"; 2553 mgt.w_dir = get_wdir_ (); 2554 mgt.max_size = hbound (mgt.entry, 1); 2555 mgt.current_size = 17; /* start with WCTE's */ 2556 mgt.total_units = 0; 2557 mgt.version_indicator = "VERSION "; 2558 mgt.version = MGT_version_3; 2559 mgt.wc_initialized = "0"b; 2560 mgt.prio_sked_enabled = "1"b; 2561 mgt.prio_sked_on_tape = "1"b; 2562 do wcx = 1 to 16; 2563 mgtep = addr (mgt.entry (wcx)); 2564 work_class.wc_name = ltrim (char (wcx)); 2565 end; 2566 2567 string (mgt.user_wc_defined) = "100000000000000"b; 2568 string (mgt.shift_defined) = (8)"1"b; /* define all shifts */ 2569 mgt.user_wc_min_pct = 100; 2570 2571 /**** We will define one work-class and one group */ 2572 2573 mgtep = addr (mgt.entry (1)); 2574 work_class.switches.defined (*) = "1"b; /* defined on all shifts */ 2575 work_class.switches.absentee_allowed (*) = "1"b; /* with absentee allowed */ 2576 work_class.min_pct (*) = 100; /* and getting all the time */ 2577 work_class.min_pct (*) = 100; 2578 work_class.int_response (*) = 400; 2579 work_class.int_quantum (*) = 50; 2580 work_class.response (*) = 3200; 2581 work_class.quantum (*) = 100; 2582 2583 mgtep = addr (mgt.entry (17)); 2584 2585 group.group_id = "Other"; 2586 group.max_prim = -1; 2587 group.int_wc = 1; 2588 group.abs_wc = 1; 2589 group.absentee.allowed = "1"b; 2590 group.absentee_max = 1000; 2591 group.absentee_pct = 100; 2592 return; 2593 end initialize_mgt; 2594 2595 clean_up: 2596 procedure; 2597 2598 if mgtp ^= null () then call release_temp_segment_ (ME, mgtp, (0)); 2599 if mgtp1 ^= null () then if created_new_mgt then 2600 call terminate_file_ (mgtp1, (0), TERM_FILE_DELETE, (0)); 2601 else call terminate_file_ (mgtp1, 36 * (64 + mgtp1 -> mgt.current_size * 32), TERM_FILE_TRUNC_BC_TERM, (0)); 2602 return; 2603 end clean_up; 2604 end ed_mgt; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/08/85 1134.5 ed_mgt.pl1 >spec>on>41-15>ed_mgt.pl1 29 1 08/10/81 1843.7 mgt.incl.pl1 >ldd>include>mgt.incl.pl1 1-33 2 04/21/82 1211.8 author.incl.pl1 >ldd>include>author.incl.pl1 30 3 04/09/85 1109.7 access_mode_values.incl.pl1 >spec>on>41-15>access_mode_values.incl.pl1 31 4 04/06/83 1239.4 terminate_file.incl.pl1 >ldd>include>terminate_file.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. DEFAULT_MGT_PATH 000040 constant char(168) initial unaligned dcl 259 set ref 274 275 ME 000112 constant char(32) initial unaligned dcl 258 set ref 264* 269* 291* 295* 297* 312* 2598* MGT_version_3 000010 internal static fixed bin(17,0) initial dcl 1-25 set ref 311 312* 2558 RW_ACCESS 000666 constant bit(3) initial unaligned dcl 3-11 set ref 289* TERM_FILE_BC constant bit(2) initial unaligned dcl 4-12 ref 352 TERM_FILE_DELETE 000647 constant bit(5) initial unaligned dcl 4-17 set ref 2599* TERM_FILE_TRUNC constant bit(1) initial unaligned dcl 4-11 ref 352 TERM_FILE_TRUNC_BC_TERM 000667 constant bit(3) initial unaligned dcl 4-15 set ref 2601* abs 000737 automatic bit(1) dcl 1970 set ref 1987* 1988* 1991 1993 1995 abs_wc 21 based fixed bin(17,0) array level 2 packed unaligned dcl 1-63 set ref 526* 528* 1044* 1223* 1223 1255* 1657* 1950 1950 1987 2080 2194* 2316 2326 2327 2332* 2528 2588* absentee 25 based structure level 2 dcl 1-63 absentee_allowed 2(08) based bit(1) array level 3 packed unaligned dcl 1-94 set ref 1064* 1209* 1209 1241* 1771* 1944 1944 2213* 2331 2575* absentee_max 26 based fixed bin(17,0) level 2 packed unaligned dcl 1-63 set ref 1136* 1665* 2387 2388* 2393 2394* 2459 2463* 2590* absentee_min 26(18) based fixed bin(17,0) level 2 packed unaligned dcl 1-63 set ref 1139* 1665* 2387 2388* 2459 2463* absentee_pct 27 based fixed bin(17,0) level 2 packed unaligned dcl 1-63 set ref 1146* 1665* 2381 2381 2382* 2459 2463* 2591* addr builtin function dcl 66 ref 274 323 336 360 467 474 505 513 544 555 566 983 1206 1221 1239 1253 1822 1838 1940 1948 1975 1983 2074 2172 2192 2211 2267 2312 2321 2327 2341 2380 2448 2458 2563 2573 2583 agrp 000733 automatic fixed bin(17,0) dcl 1969 set ref 1979* 1995* 1995 2020 2023* al 000210 automatic fixed bin(21,0) dcl 36 set ref 275* 278* 280 280 282 282 allowed 25 based bit(1) level 3 packed unaligned dcl 1-63 set ref 516* 1058* 1668 1839 1986 2084 2325 2589* ap 000206 automatic pointer dcl 36 set ref 274* 278* 280 282 arg_count 000102 automatic fixed bin(17,0) dcl 34 set ref 262* 268 273 ask_ 000022 constant entry external dcl 36 ref 335 358 381 503 671 766 801 832 1324 1382 1488 ask_$ask_c 000032 constant entry external dcl 36 ref 427 703 1346 1406 1425 1427 1455 ask_$ask_cflo 000036 constant entry external dcl 36 ref 613 ask_$ask_cint 000034 constant entry external dcl 36 ref 611 2249 ask_$ask_clr 000012 constant entry external dcl 36 ref 331 393 693 772 842 855 942 1340 1388 1435 1462 1509 ask_$ask_flo 000014 constant entry external dcl 36 ref 517 723 810 ask_$ask_int 000016 constant entry external dcl 36 ref 521 720 1431 ask_$ask_n 000024 constant entry external dcl 36 ref 422 591 676 914 1353 1403 1422 1426 1454 1575 ask_$ask_nflo 000030 constant entry external dcl 36 ref 1620 ask_$ask_nint 000026 constant entry external dcl 36 ref 1618 ask_$ask_yn 000020 constant entry external dcl 36 ref 2538 author based structure level 2 dcl 1-30 bchr based char unaligned dcl 36 set ref 280* 282* btemp 000216 automatic bit(1) dcl 36 set ref 1622* bval parameter bit(1) dcl 2116 in procedure "scan_key" set ref 2111 2153* 2155* bval parameter bit(1) dcl 629 in procedure "ask_key" set ref 626 639 647 655 663 683* 685* 687* bval 000301 automatic bit(1) array dcl 107 in procedure "ed_mgt" set ref 615* 727* 746* 746 805* 852* 1009 1058 1064 1077 1099 1122 bvals parameter bit(1) array unaligned dcl 1690 set ref 1709 1740* change_code 000170 automatic char(20) unaligned dcl 36 set ref 381* 382 383 384 387 388 392* 766* 767 771* 786* 792* change_codes 000122 constant char(12) initial array unaligned dcl 182 ref 767 767 770 change_entry_type 000616 constant fixed bin(17,0) initial array dcl 130 ref 783 784 790 change_item 000237 automatic fixed bin(17,0) dcl 93 set ref 683 683 685 687 724 724 776* 777 779 783 784 790 801 805 810 822 918 924 934 934 937 956 961 961 963 963 1005 1090 1093 1095 1097 change_items 000350 constant fixed bin(17,0) initial array dcl 178 ref 776 change_names 000432 constant char(12) initial array unaligned dcl 150 set ref 801* 805* 810* 934* 961* 963* change_type 000240 automatic fixed bin(17,0) dcl 94 set ref 777* 799 805 814 change_types 000565 constant fixed bin(17,0) initial array dcl 141 ref 777 char32 000370 automatic char(32) unaligned dcl 128 set ref 422* 424 427* 430 431 432 436 437 441 442 443 591* 671* 676* 692* 703* 801* 832* 833 834 854* 914* 918 934* 941* 1019 1324* 1326 1328 1332 1333 1339* 1346* 1353* 1382* 1385 1386* 1387* 1403* 1405* 1406* 1422* 1423 1425* 1426* 1427 1427* 1454* 1455 1455* 1488* 1489 1493 1507* 1508* 1575* 1576 1576 2120 2120 2124 2538* 2539 char_int parameter char unaligned dcl 1165 ref 1156 1170 1171 1173 1180 1182 1184 cksw 000544 automatic bit(1) dcl 1320 set ref 1322* 1338 1345 1352* cleanup 000230 stack reference condition dcl 70 ref 288 code 000211 automatic fixed bin(35,0) dcl 36 set ref 262* 263 264* 280* 281 282* 289* 290 291* 295* 296 297* colct 000735 automatic fixed bin(17,0) dcl 1969 set ref 2031* 2043* 2043 2052* 2052 2053* com_err_ 000056 constant entry external dcl 80 ref 264 282 291 297 312 com_err_$suppress_name 000060 constant entry external dcl 81 ref 269 comm 000204 automatic char(8) unaligned dcl 36 set ref 335* 338 339 345 345 356 357 369 370 378 379 400 401 415 416 417 501 502 534 548 549 558 559 560 570 571 575 576 577 580* comma_count parameter fixed bin(17,0) dcl 2115 ref 2111 2153 comma_offset 000775 automatic fixed bin(17,0) dcl 2117 set ref 2146* 2147 2149 created_new_mgt 000103 automatic bit(1) dcl 35 set ref 286* 289* 303 347* 2599 ctmp1 000634 automatic char(32) dcl 1642 set ref 1644* 1646* 1650* 1652* ctmp2 000644 automatic char(32) dcl 1642 set ref 1647* 1649* 1652* cu_$arg_count 000040 constant entry external dcl 72 ref 262 cu_$arg_ptr 000042 constant entry external dcl 73 ref 278 curpos 000776 automatic fixed bin(17,0) dcl 2117 set ref 2144* 2145 2146 2146 2149* 2149 current_size 36 based fixed bin(17,0) level 2 dcl 1-30 set ref 324 352 359 456* 465 504 512 531* 539 542* 542 543 551 553 979 1220 1252 1837 1947 1982 2073 2191 2311 2379 2457 2555* 2601 deadline_mode 43(03) based bit(1) array level 3 packed unaligned dcl 1-30 set ref 461* 1122* 2273 2410 default_absentee 000333 automatic bit(1) dcl 113 set ref 848* 858* 1050 1980* 1997* 2028 default_group 25(01) based bit(1) level 3 packed unaligned dcl 1-63 set ref 1054* 1056* 1671 1996 2337 2357 default_queue 25(02) based bit(1) array level 3 packed unaligned dcl 1-63 set ref 1052* 1054 1674 1998 2339 defined 2 based bit(1) array level 3 packed unaligned dcl 1-94 set ref 476 1064 1071 1077* 1090 1106 1207 1208* 1240* 1764 1769* 1771* 1774* 1777* 1780* 1784* 1787* 1790* 1793* 1824 1943 1943 1976 2172 2212* 2268 2322 2328 2449 2574* denom 11 based fixed bin(17,0) level 2 dcl 1-63 set ref 1029* 1647 1647* denom1 14 based fixed bin(17,0) level 2 dcl 1-63 set ref 1035* 1644* dfct 000734 automatic fixed bin(17,0) dcl 1969 set ref 2030* 2034* 2034 2035 2041 2041* 2042 2045 2048 2048* dflt_g 000255 automatic fixed bin(17,0) array dcl 104 set ref 2341 2349* dflt_q 000365 automatic bit(1) array unaligned dcl 124 set ref 1981* 1998* 1998 2033 2261* 2339 2348* 2366 2369 digits 000036 constant char(8) initial unaligned dcl 1168 ref 1173 1182 1184 dn 000104 automatic char(168) unaligned dcl 36 set ref 280* 289* 291* 291* 307* 307* en 000156 automatic char(32) unaligned dcl 36 set ref 280* 289* 291* 291* 307* 307* entry 100 based structure array level 2 dcl 1-30 set ref 323 336 360 467 474 505 513 540* 540 544 555 566 983 1206 1221 1239 1253 1822 1838 1940 1948 1975 1983 2074 2172 2192 2211 2267 2312 2321 2327 2341 2380 2448 2458 2554 2563 2573 2583 err_count 001043 automatic fixed bin(17,0) initial dcl 2237 set ref 2237* 2399 2401* 2536* 2536 2537 2538* err_max 001042 automatic fixed bin(17,0) initial dcl 2236 set ref 2236* 2250* 2537 error_table_$unimplemented_version 000076 external static fixed bin(35,0) dcl 90 set ref 312* expand_pathname_$add_suffix 000044 constant entry external dcl 74 ref 280 f 000555 automatic fixed bin(17,0) dcl 1380 in procedure "get_int_list" set ref 1386* 1398 1405* f parameter fixed bin(17,0) dcl 1166 in procedure "ck_int" set ref 1156 1177* 1187* 1188 f 000602 automatic fixed bin(17,0) dcl 1486 in procedure "get_shift_spec" set ref 1507* 1514 fixed builtin function dcl 66 ref 1090 1093 1095 1097 flag 000246 automatic fixed bin(17,0) dcl 97 in procedure "ed_mgt" set ref 422* 423 427* 591* 593 914* 916 1346* 1353* 1354 1403* 1404 1406* 1422* 1423 1425* 1426* 1427 1427* 1454* 1455 1455* 1575* 1576 1577* 1578 1618* 1620* 1622* 1625 2249* 2250 flag parameter fixed bin(17,0) dcl 631 in procedure "ask_key" set ref 639 640* 647 649* 663 676* 677 696* 702* flag parameter fixed bin(17,0) dcl 609 in procedure "ask_cval" set ref 607 611* 613* 615* flag parameter fixed bin(17,0) dcl 2115 in procedure "scan_key" set ref 2111 2138* 2142* float builtin function dcl 66 ref 1738 2492 fmt parameter char unaligned dcl 1693 set ref 1688 1702 1709 1716 1723 1735* 1738* 1740* 1742* 1744* from parameter fixed bin(17,0) dcl 740 ref 738 742 744 746 fsh parameter fixed bin(17,0) dcl 1202 ref 1200 1207 1209 1210 1211 1212 1213 1214 1215 1216 1222 1223 fshift 000241 automatic fixed bin(17,0) dcl 95 set ref 904* 1501* 1503 1514* 1515 1517 1518 1540 1878 1904* ft parameter fixed bin(17,0) dcl 2207 ref 2205 2210 ftemp 000220 automatic float bin(27) dcl 36 set ref 517* 518 519 810* 814 814* 814 1012 1015 1022 1023 1026 1029 1032 1035 1038 1133 1133 1133* 1136 1139 1143 1143* 1143 1146 1620* fval 000271 automatic float bin(27) array dcl 106 set ref 613* 723* 724* 724 744* 744 1090 1093 1095 1097 gcfirst 000247 automatic fixed bin(17,0) dcl 98 set ref 974* 978* 982 gclast 000250 automatic fixed bin(17,0) dcl 98 set ref 975* 979* 982 gcsw 000335 automatic bit(1) dcl 115 set ref 372* 380* 968 1064 1071 1090 1106 gct 000753 automatic fixed bin(17,0) dcl 2070 set ref 2072* 2089* 2089 2097 2099 get_group_id_ 000072 constant entry external dcl 87 ref 2551 get_temp_segment_ 000066 constant entry external dcl 85 ref 295 get_wdir_ 000074 constant entry external dcl 88 ref 2553 got_int_abs 000341 automatic bit(1) dcl 118 set ref 911* 924 926* 927 956 got_shift_spec 000340 automatic bit(1) dcl 118 set ref 911* 918 953 1526* 1589 got_values 000342 automatic bit(1) dcl 118 set ref 911* 939* group based structure level 1 dcl 1-63 group_id based char(8) level 2 dcl 1-63 set ref 361 506 514* 596* 1019* 1650* 1652* 2095* 2332* 2341* 2341* 2358* 2382* 2388* 2394* 2463* 2519* 2523* 2585* grp 000166 automatic char(8) unaligned dcl 36 set ref 358* 361 366* 503* 506 508* 514 hbound builtin function dcl 66 ref 767 770 2554 heading parameter char unaligned dcl 1693 set ref 1688 1702 1709 1716 1723 1730* i 000446 automatic fixed bin(17,0) dcl 764 in procedure "change" set ref 767* 767* 770 776 838* 839 840 841 846* 982* 983* i 000533 automatic fixed bin(17,0) dcl 1269 in procedure "define" set ref 1278* 1279 1280 1282 1284 1286 1287 1290* i 000655 automatic fixed bin(17,0) dcl 1643 in procedure "prgp" set ref 1673* 1674 1674* i 000614 automatic fixed bin(17,0) dcl 1568 in procedure "get_values" set ref 1573* 1577* 1592* 1594* i 000554 automatic fixed bin(17,0) dcl 1379 in procedure "get_int_list" set ref 1396* 1398* i 000520 automatic fixed bin(17,0) dcl 1237 in procedure "default_shift" set ref 1252* 1253* i 000664 automatic fixed bin(17,0) dcl 1695 in procedure "print_ivals" set ref 1734* 1735 1735 1738 1740 1742* 1744 1744* i 000510 automatic fixed bin(17,0) dcl 1203 in procedure "copy_shift" set ref 1205* 1206* 1220* 1221* i 000500 automatic fixed bin(17,0) dcl 1167 in procedure "ck_int" set ref 1173* 1175 1177 1182* 1183 1186 1187 i 001022 automatic fixed bin(17,0) dcl 2188 in procedure "undefine_shift" set ref 2191* 2192* i 001012 automatic fixed bin(17,0) dcl 2170 in procedure "shift_is_defined" set ref 2172* 2172* 2176 i 000175 automatic fixed bin(17,0) dcl 36 in procedure "ed_mgt" set ref 359* 360 362* 525* 526 526 526 528 528* 539* 540 540* 1821* 1822* 1837* 1838* 1848* 1849* 1862* 1863 1868 1871* 1871 1881 1886 1892 1898 1898 1905 1907* 1907* 2265* 2267 2269 2279* 2287* 2311* 2312 2349* 2379* 2380* 2429* 2430 2437* 2437* 2438 2438* 2447* 2448* 2457* 2458* 2492* i 000720 automatic fixed bin(17,0) dcl 1937 in procedure "shifts_alike" set ref 1939* 1940* 1947* 1948* i 001032 automatic fixed bin(17,0) dcl 2208 in procedure "undefine_wc" set ref 2210* 2211* i 000730 automatic fixed bin(17,0) dcl 1969 in procedure "pxshft" set ref 1974* 1975 1984 1987 2009* 2076 2080 i 000460 automatic fixed bin(17,0) dcl 1003 in procedure "change_one_item" set ref 1041* 1042 1042 1044 1044* 1051* 1052 1052* 1063* 1064 1064 1064* 1070* 1071 1071 1071* 1076* 1077 1077* 1083* 1090 1090 1090 1093 1093 1095 1095 1097 1097 1099 1099* 1104* 1106 1106 1106* 1120* 1122 1122* 1128* 1129* ia 001321 automatic char(11) unaligned dcl 2516 set ref 2518* 2519* 2523* 2529* iflts parameter fixed bin(17,0) array unaligned dcl 1692 set ref 1702 1723 1738 1744 1744* igrp 000732 automatic fixed bin(17,0) dcl 1969 set ref 1979* 1994* 1994 2014 2017* 2021 2025 ii 000654 automatic fixed bin(17,0) dcl 1642 set ref 1644* 1647* index builtin function dcl 66 ref 1173 1182 1184 2133 2146 initiate_file_$create 000062 constant entry external dcl 82 ref 289 int 000736 automatic bit(1) dcl 1970 in procedure "pxshft" set ref 1984* 1985* 1991 1993 1994 int defined bit(1) unaligned dcl 2478 in procedure "check_rq" set ref 2492* int_abs_diff 000740 automatic bit(1) dcl 1970 set ref 1978* 1993* 2015 2020 int_quantum 17 based fixed bin(17,0) array level 2 packed unaligned dcl 1-94 set ref 1093* 1214* 1214 1246* 1787* 2218* 2292* 2579* int_response 13 based fixed bin(17,0) array level 2 packed unaligned dcl 1-94 set ref 1090* 1213* 1213 1245* 1784* 2217* 2295* 2451* 2578* int_wc 000334 automatic bit(1) dcl 114 in procedure "ed_mgt" set ref 912* 1042 1329* 1334* int_wc 15 based fixed bin(17,0) array level 2 in structure "group" packed unaligned dcl 1-63 in procedure "ed_mgt" set ref 526* 528* 1042* 1222* 1222 1254* 1655* 1949 1949 1984 2076 2193* 2315 2320 2321 2517 2587* ioa_ 000050 constant entry external dcl 77 ref 307 325 366 392 409 455 456 457 458 459 478 480 507 508 536 552 563 580 594 596 692 771 786 792 841 854 941 1014 1111 1290 1339 1387 1434 1461 1508 1650 1652 1655 1657 1665 1668 1670 1677 1746 1851 1881 1889 1916 1922 2025 2099 2279 2281 2287 2304 2332 2341 2358 2370 2382 2388 2394 2399 2401 2420 2423 2434 2441 2463 2492 2505 2519 2523 ioa_$nnl 000054 constant entry external dcl 79 ref 1672 1674 1730 1735 1738 1740 1742 1744 1763 1847 1849 1885 1887 2009 2015 2016 2021 2022 2029 2045 2047 2053 2093 2095 2413 2416 2436 2438 ioa_$rsnnl 000052 constant entry external dcl 78 ref 1644 1647 itemp 000217 automatic fixed bin(17,0) dcl 36 set ref 521* 524* 526 852* 853 1618* 2249* 2250 ival 000261 automatic fixed bin(17,0) array dcl 105 set ref 611* 720* 742* 742 839 840 841* 846 1042 1044 1071 1106 1129 1279* 1280* 1282* 1284* 1286 1287 1290* 1398* 1859* 1900 1918* ivals parameter fixed bin(17,0) array dcl 1691 set ref 1688 1735* j 000501 automatic fixed bin(17,0) dcl 1167 in procedure "ck_int" set ref 1184* 1185 1186 1188 j 000731 automatic fixed bin(17,0) dcl 1969 in procedure "pxshft" set ref 1982* 1983* 2032* 2033 2036 2037* 2045 2047* 2073* 2074* j 000176 automatic fixed bin(17,0) dcl 36 in procedure "ed_mgt" set ref 1878* 1878* 1881 1881 1886 1898* 1900 1900 1903 1906* 2338* 2339 2339 2341* 2341 2348 2349* 2358* 2368* 2369 2370* k 000177 automatic fixed bin(17,0) dcl 36 set ref 1886* 1887* key 000764 automatic varying char(32) dcl 2114 set ref 2124* 2125 2127 2129 2133 keypos 000777 automatic fixed bin(17,0) dcl 2117 set ref 2125* 2126* 2127* 2129* 2131* 2133* 2134 2134* 2134 2138 2145 2146 keys parameter char unaligned dcl 2113 ref 2111 2119 2125 2127 2129 2133 2146 kln 001000 automatic fixed bin(17,0) dcl 2117 set ref 2119* 2125 2126 2129 2129 2131 lct 000752 automatic fixed bin(17,0) dcl 2070 set ref 2072* 2090* 2090 2091 2092* 2099 length builtin function dcl 66 ref 275 2119 2120 like_sw 000530 automatic bit(1) dcl 1268 set ref 1275* 1282 ln 001001 automatic fixed bin(17,0) dcl 2117 set ref 2120* 2124 2126 2127 2127 2129 2129 2129 2129 2131 local_flag 000423 automatic fixed bin(17,0) dcl 631 set ref 680* 683* 685* 687* 690 703* low_pct 001046 automatic bit(1) array dcl 2240 set ref 2247* 2307* 2410 2415 lsh 000534 automatic fixed bin(17,0) dcl 1269 set ref 1275* 1282* lshift 000242 automatic fixed bin(17,0) dcl 95 set ref 909* 1502* 1503 1515* 1517 1518 1855* 1867 1868* 1881* 1889* 1897* 1903* lt parameter fixed bin(17,0) dcl 2207 ref 2205 2210 max_pct 33 based fixed bin(17,0) array level 2 packed unaligned dcl 1-94 set ref 1106* 1212* 1212 1244* 1780* 1942 1942 2009 2009* 2216* 2286 2286 2287* max_prim 2 based fixed bin(17,0) level 2 dcl 1-63 set ref 518* 1012* 1015* 1650 2586* max_size 35 based fixed bin(17,0) level 2 dcl 1-30 set ref 455* 2554* mgt based structure level 1 dcl 1-30 set ref 303* 303 350* 350 mgtep 000100 automatic pointer dcl 1-61 set ref 323* 336* 360* 361 402* 407* 505* 506 513* 514 515 516 518 519 526 526 528 528 544* 555* 566* 594 596 983* 1012 1015 1019 1022 1023 1026 1029 1032 1035 1038 1042 1044 1052 1054 1054 1056 1058 1064 1064 1071 1071 1077 1090 1090 1093 1095 1097 1099 1106 1106 1136 1139 1146 1206* 1207 1208 1209 1209 1210 1210 1211 1211 1212 1212 1213 1213 1214 1214 1215 1215 1216 1216 1221* 1222 1222 1223 1223 1239* 1240 1241 1242 1243 1244 1245 1246 1247 1248 1253* 1254 1255 1822* 1824 1838* 1839 1940* 1941 1941 1942 1942 1943 1943 1944 1944 1948* 1949 1949 1950 1950 1975* 1976 1977 1983* 1984 1986 1987 1996 1998 2074* 2076 2080 2084 2095 2192* 2193 2194 2211* 2212 2213 2214 2215 2216 2217 2218 2219 2220 2312* 2315 2316 2320 2321 2325 2326 2327 2332 2332 2337 2339 2341 2357 2358 2380* 2381 2381 2382 2382 2387 2387 2388 2388 2388 2393 2394 2394 2458* 2459 2459 2459 2463 2463 2463 2463 2517 2519 2523 2528 2563* 2564 2573* 2574 2575 2576 2577 2578 2579 2580 2581 2583* 2585 2586 2587 2588 2589 2590 2591 mgtix 000236 automatic fixed bin(17,0) dcl 92 set ref 322* 324 336 362* 373 402 504* 505 507* 512* 513 531 535 539 543* 543 544 550* 550 551 553* 555 561* 561 562 564* 566 594 1078 mgtp 000212 automatic pointer initial dcl 36 set ref 36* 287* 295* 303 311 312 323 324 336 350 359 360 455 456 457 458 459 460 461 461 465 467 474 504 505 512 513 521 526 531 539 540 540 542 542 543 544 551 553 555 566 979 983 1009 1078 1122 1126 1129 1206 1220 1221 1239 1252 1253 1286 1287 1495 1518 1541 1822 1837 1838 1940 1947 1948 1975 1982 1983 2073 2074 2172 2191 2192 2211 2267 2273 2311 2312 2321 2327 2341 2379 2380 2410 2448 2457 2458 2551 2552 2553 2554 2554 2555 2556 2557 2558 2559 2560 2561 2563 2567 2568 2569 2573 2583 2598 2598* mgtp1 000202 automatic pointer initial dcl 36 set ref 36* 287* 289* 303 303 350 352* 352 2599 2599* 2601* 2601 min builtin function dcl 66 ref 543 min_pct 3 based fixed bin(17,0) array level 2 dcl 1-94 set ref 1071* 1211* 1211 1243* 1777* 1941 1941 2009* 2215* 2278 2279* 2299 2576* 2577* minamax 12 based fixed bin(17,0) level 2 dcl 1-63 set ref 515* 1022* 1023* 1644 1644 minu 7 based fixed bin(17,0) level 2 dcl 1-63 set ref 519* 1038* 1652 mod builtin function dcl 66 ref 2537 mxv parameter fixed bin(17,0) dcl 1378 ref 1363 1392 1401 mxval 000244 automatic fixed bin(17,0) dcl 96 set ref 905* 1527* 1533* 1542* 1542 1543 1573 1573 1589 n 000603 automatic fixed bin(17,0) dcl 1486 in procedure "get_shift_spec" set ref 1507* 1513 n 000200 automatic fixed bin(17,0) dcl 36 in procedure "ed_mgt" set ref 465* 467* 473* 474 478 480 481 487* n 000556 automatic fixed bin(17,0) dcl 1380 in procedure "get_int_list" set ref 1386* 1392 1396 1405* n parameter fixed bin(17,0) dcl 1166 in procedure "ck_int" set ref 1156 1176* 1188* n_commas 001002 automatic fixed bin(17,0) dcl 2117 set ref 2143* 2148* 2148 2153 ngroups parameter fixed bin(17,0) dcl 2069 ref 2062 2097 no_abs 000350 automatic bit(1) dcl 120 set ref 1817* 1840* 2260* 2356* 2366 no_abs_count 000254 automatic fixed bin(17,0) dcl 102 set ref 1816* 1841* 1841 2055* nshf 000331 automatic fixed bin(17,0) dcl 110 set ref 903* 1041 1063 1070 1076 1083 1104 1120 1491* 1496* 1496 1497 1502 1520* 1520 1521 1585* 1589* 1592 1592 nshift 000243 automatic fixed bin(17,0) dcl 95 set ref 909* 1503* 1513* 1515 1529 1818* 1832* 1832 1833 1848 1862 1868 1878 1892 1905 1906 null builtin function dcl 66 ref 36 36 287 2598 2599 num 10 based fixed bin(17,0) level 2 dcl 1-63 set ref 1026* 1647* num1 13 based fixed bin(17,0) level 2 dcl 1-63 set ref 1032* 1644* nv parameter fixed bin(17,0) dcl 1378 in procedure "get_int_list" set ref 1363 1384* 1392 1397* 1397 1398 1401 nv parameter fixed bin(17,0) dcl 1452 in procedure "get_shift_list" set ref 1450 1458* 1460 nv parameter fixed bin(17,0) dcl 1567 in procedure "get_values" set ref 1556 1571* 1578* 1578 1585 1585 nv parameter fixed bin(17,0) dcl 1614 in procedure "look_ahead_value" set ref 1606 1616* 1625* nval 000245 automatic fixed bin(17,0) dcl 96 set ref 835* 838 932* 934* 937* 939 961* 963* 1128 1273* 1278 padflt 000343 automatic bit(1) dcl 119 set ref 418* 426* 448 pagrp 000345 automatic bit(1) dcl 119 set ref 421* 433* 448* 465 pathname_ 000046 constant entry external dcl 76 ref 291 291 307 307 patot 000346 automatic bit(1) dcl 119 set ref 421* 425* 448* 454 pawc 000344 automatic bit(1) dcl 119 set ref 421* 438* 448* 471 paxrf 000347 automatic bit(1) dcl 119 set ref 421* 444* 448* 495 pct_is_used 001067 automatic bit(1) dcl 2243 set ref 2274* 2277* 2281 2299 print_asterisk 000741 automatic bit(1) dcl 1971 set ref 2003* 2005* 2009* 2009 print_pct_ignored 000332 automatic bit(1) dcl 112 set ref 1815* 1922 2003* print_unused_pct 001066 automatic bit(1) dcl 2242 set ref 2407* 2417* 2420 prio_sked_enabled 43(01) based bit(1) level 3 packed unaligned dcl 1-30 set ref 458* 1009* 2560* prio_sked_on_tape 43(02) based bit(1) level 3 packed unaligned dcl 1-30 set ref 2561* proc_group_id based char(32) level 3 dcl 1-30 set ref 2551* program_interrupt 000222 stack reference condition dcl 69 ref 301 prompt parameter char unaligned dcl 1566 in procedure "get_values" set ref 1556 1570* prompt parameter char unaligned dcl 718 in procedure "ask_val" set ref 715 720* 723* 727* prompt parameter char unaligned dcl 628 in procedure "ask_key" set ref 626 655 671* prompt parameter char unaligned dcl 1377 in procedure "get_int_list" set ref 1363 1382* prompt_sw 000420 automatic bit(1) dcl 630 set ref 633* 641* 650* 657* 665* 671 691 700 q 000361 automatic bit(1) array dcl 123 set ref 837* 846* 1052 qq 000214 automatic pointer dcl 36 set ref 467* 468* 474* 476 481* 486* quantum 27 based fixed bin(17,0) array level 2 packed unaligned dcl 1-94 set ref 1097* 1216* 1216 1248* 1793* 2220* 2293* 2581* realtime 2(16) based bit(1) array level 3 packed unaligned dcl 1-94 set ref 1099* 1210* 1210 1242* 1774* 2003 2214* 2273 2294 2449 realtm defined bit(1) unaligned dcl 2479 set ref 2488 2492* 2492* redefine_sw 000531 automatic bit(1) dcl 1268 set ref 1271* 1279 1297* 1303* release_temp_segment_ 000070 constant entry external dcl 86 ref 2598 remove_sw 000421 automatic bit(1) dcl 630 set ref 633* 642* 650* 658* 665* 703 resp defined bit(1) unaligned dcl 2477 set ref 2482 2488 2492* response 23 based fixed bin(17,0) array level 2 packed unaligned dcl 1-94 set ref 1095* 1215* 1215 1247* 1790* 2219* 2296* 2452* 2580* reverse builtin function dcl 66 ref 2120 s1 parameter fixed bin(17,0) dcl 1936 ref 1931 1941 1942 1943 1944 1949 1950 s2 parameter fixed bin(17,0) dcl 1936 ref 1931 1941 1942 1943 1944 1949 1950 scale parameter float bin(27) dcl 1694 ref 1702 1738 sh parameter fixed bin(17,0) dcl 2169 in procedure "shift_is_defined" ref 2167 2172 sh parameter fixed bin(17,0) dcl 2207 in procedure "undefine_wc" ref 2205 2212 2213 2214 2215 2216 2217 2218 2219 2220 sh parameter fixed bin(17,0) dcl 1417 in procedure "get_like_shift" set ref 1415 1431* 1433 1433 1434* sh parameter fixed bin(17,0) dcl 1236 in procedure "default_shift" set ref 1234 1240 1241 1242 1243 1244 1245 1246 1247 1248 1250* 1254 1255 sh parameter fixed bin(17,0) dcl 2187 in procedure "undefine_shift" set ref 2185 2190* 2193 2194 shf 000321 automatic fixed bin(17,0) array dcl 109 set ref 1042 1044 1064 1064 1071 1071 1077 1090 1090 1093 1095 1097 1099 1106 1106 1122 1497* 1501 1502 1521* 1543* shift 000252 automatic fixed bin(17,0) dcl 100 in procedure "ed_mgt" set ref 1494* 1495 1497* 1517* 1518 1518 1518 1521* 1540* 1541 1543* 1823* 1824 1824* 1829* 1831 1833* 1863* 1868* 1900* 1904 1916* 1917* 1918 2256* 2258 2262 2268 2269 2271 2273 2273 2275 2278 2279 2279* 2286 2286 2287 2287* 2292 2293 2294 2295 2296 2299 2304* 2307 2307 2314 2315 2316 2320 2320 2321 2322 2326 2326 2327 2328 2331 2332* 2332* 2409* 2410 2410 2414* 2414* 2415 2416* 2416 2417* 2428* 2430 2436* 2438* 2446* 2449 2449 2451 2452* 2492* 2517 2519* 2523* 2528 shift parameter fixed bin(17,0) dcl 1968 in procedure "pxshft" ref 1964 1976 1984 1987 2003 2009 2009 2009 2076 2080 shift_defined 44(16) based bit(1) array level 2 packed unaligned dcl 1-30 set ref 460* 461* 526 1126* 1129* 1286* 1287* 1495 1518 1541 2568* shift_pct 000253 automatic fixed bin(17,0) dcl 101 set ref 2259* 2299* 2299 2303 2304* 2307 shift_used 000351 automatic bit(1) array dcl 122 set ref 1819* 1824* 1831 2258* 2271* 2307 2314 shifts 000311 automatic fixed bin(17,0) array dcl 108 set ref 1833* 1849* 1863 1878 1881* 1887* 1900 1900* 1903 string builtin function dcl 66 set ref 476 1054 1764 1981* 1998* 1998 1998 2261* 2366 2567* 2568* substr builtin function dcl 66 ref 383 424 431 432 437 443 918 1170 1171 1173 1180 1182 1184 1455 1489 2124 2125 2127 2127 2129 2129 2146 sw parameter bit(1) dcl 1418 in procedure "get_like_shift" set ref 1415 1420* 1439* sw parameter bit(3) unaligned dcl 2476 in procedure "check_rq" ref 2473 2482 2482 2488 2488 2488 2488 2492 2492 2492 2492 2492 2492 2492 2492 switches 2 based structure level 2 in structure "work_class" dcl 1-94 in procedure "ed_mgt" switches 43 based structure level 2 in structure "mgt" dcl 1-30 in procedure "ed_mgt" table 14 based char(4) level 3 dcl 1-30 set ref 2552* terminate_file_ 000064 constant entry external dcl 84 ref 352 2599 2601 to parameter fixed bin(17,0) dcl 740 ref 738 742 744 746 total_units 37 based fixed bin(17,0) level 2 dcl 1-30 set ref 457* 2556* tsh parameter fixed bin(17,0) dcl 1202 ref 1200 1208 1209 1210 1211 1212 1213 1214 1215 1216 1222 1223 type parameter fixed bin(17,0) dcl 2069 ref 2062 2075 2079 2083 undefine_sw 000532 automatic bit(1) dcl 1268 set ref 1271* 1275 1280 1286 1298* 1303* undefwc 000251 automatic fixed bin(17,0) dcl 99 set ref 478 487* unused_pct 001056 automatic bit(1) array dcl 2241 set ref 2262* 2275* 2416* 2417 user_wc_defined 44 based bit(1) array level 2 packed unaligned dcl 1-30 set ref 2567* user_wc_min_pct 45 based fixed bin(17,0) array level 2 dcl 1-30 set ref 2569* val parameter fixed bin(17,0) unaligned dcl 2475 ref 2473 2481 2482 2492 verify builtin function dcl 66 ref 2120 version 42 based fixed bin(17,0) level 2 dcl 1-30 set ref 311 312* 2558* version_indicator 40 based char(8) level 2 dcl 1-30 set ref 303 2557* vtype parameter fixed bin(17,0) dcl 717 in procedure "ask_val" ref 715 720 722 727 vtype 000665 automatic fixed bin(17,0) dcl 1695 in procedure "print_ivals" set ref 1697* 1704* 1711* 1718* 1726* 1735 1738 1740 1742 vtype parameter fixed bin(17,0) dcl 740 in procedure "assign_value" ref 738 742 744 746 vtype parameter fixed bin(17,0) dcl 609 in procedure "ask_cval" ref 607 611 613 615 vtype parameter fixed bin(17,0) dcl 1567 in procedure "get_values" set ref 1556 1570* 1577* 1594* vtype parameter fixed bin(17,0) dcl 1614 in procedure "look_ahead_value" set ref 1606 1618 1620 1622 1625* vtypes 000545 constant fixed bin(17,0) initial array dcl 145 set ref 937* 963* w_dir 15 based char(64) level 3 dcl 1-30 set ref 2553* warning_printed 001044 automatic bit(1) dcl 2238 set ref 2406* 2504 2506* wc 001320 automatic fixed bin(17,0) dcl 2515 set ref 2517* 2519 2523* 2528* wc_empty 001070 automatic bit(1) array dcl 2244 set ref 2246* 2269* 2320* 2326* 2430 2438 wc_initialized 43 based bit(1) level 3 packed unaligned dcl 1-30 set ref 459* 521 1078* 2559* wc_name based char(8) level 2 dcl 1-94 set ref 594* 1763* 2564* wc_printed 001045 automatic bit(1) dcl 2239 set ref 2427* 2432 2433* wcp 000366 automatic pointer dcl 126 set ref 1977* 2003 2009 2009 2009 2267* 2268 2273 2278 2279 2286 2286 2287 2292 2293 2294 2295 2296 2299 2321* 2322 2327* 2328 2331 2448* 2449 2449 2451 2452 wcsw 000336 automatic bit(1) dcl 116 set ref 373* 374* 385* 389* 784 790 822 973 1048 wcundef 000337 automatic bit(1) dcl 117 set ref 406* 408 410* 472* 475 477* 487 491 1765* wcx 001340 automatic fixed bin(17,0) dcl 2549 set ref 2562* 2563 2564* where parameter fixed bin(17,0) dcl 717 in procedure "ask_val" ref 715 720 723 724 724 727 where parameter fixed bin(17,0) dcl 609 in procedure "ask_cval" ref 607 611 613 615 which parameter bit(1) array unaligned dcl 1690 ref 1688 1702 1709 1716 1723 1735 work_class based structure level 1 dcl 1-94 yn_sw 000422 automatic bit(1) dcl 630 set ref 634* 641* 650* 657* 666* 683 zp parameter pointer dcl 1641 in procedure "prgp" ref 1636 1644 1644 1644 1644 1647 1647 1647 1650 1650 1652 1652 1655 1657 1665 1665 1665 1668 1671 1674 zp parameter pointer dcl 1761 in procedure "prwc" ref 1756 1763 1764 1769 1771 1771 1774 1774 1777 1777 1780 1780 1784 1784 1787 1787 1790 1790 1793 1793 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial unaligned dcl 3-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 3-33 E_ACCESS internal static bit(3) initial unaligned dcl 3-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 M_ACCESS internal static bit(3) initial unaligned dcl 3-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 N_ACCESS internal static bit(3) initial unaligned dcl 3-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 REW_ACCESS internal static bit(3) initial unaligned dcl 3-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 RE_ACCESS internal static bit(3) initial unaligned dcl 3-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 RW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 R_ACCESS internal static bit(3) initial unaligned dcl 3-11 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 SA_ACCESS internal static bit(3) initial unaligned dcl 3-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 3-30 SMA_ACCESS internal static bit(3) initial unaligned dcl 3-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 SM_ACCESS internal static bit(3) initial unaligned dcl 3-11 SM_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 S_ACCESS internal static bit(3) initial unaligned dcl 3-11 S_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 TERM_FILE_FORCE_WRITE internal static bit(4) initial unaligned dcl 4-16 TERM_FILE_TERM internal static bit(3) initial unaligned dcl 4-14 TERM_FILE_TRUNC_BC internal static bit(2) initial unaligned dcl 4-13 W_ACCESS internal static bit(3) initial unaligned dcl 3-11 W_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 ask_$ask_setline 000000 constant entry external dcl 36 max builtin function dcl 66 movelen automatic fixed bin(17,0) dcl 36 size builtin function dcl 66 terminate_file_switches based structure level 1 packed unaligned dcl 4-4 NAMES DECLARED BY EXPLICIT CONTEXT. abs 011017 constant label dcl 1334 ref 1332 abs_q 006733 constant label dcl 835 ref 833 843 acom 004763 constant label dcl 503 ref 326 501 ask_abs 006703 constant label dcl 832 set ref 856 ask_ckey 005701 constant entry internal dcl 639 ref 615 ask_code 006417 constant label dcl 766 ref 773 990 ask_cval 005600 constant entry internal dcl 607 ref 1577 ask_cyn 005740 constant entry internal dcl 663 ref 852 ask_int_list 011166 constant label dcl 1382 ref 1389 ask_key 005663 constant entry internal dcl 626 ref 727 ask_key_again 005751 constant label dcl 671 ref 694 ask_like_shift 011457 constant label dcl 1431 ref 1436 ask_nkey 005712 constant entry internal dcl 647 ref 1622 ask_shift 011655 constant label dcl 1488 ref 1489 1510 ask_shifts 011602 constant label dcl 1458 ref 1463 ask_type 000000 constant label array(0:4) dcl 801 ref 799 ask_val 006236 constant entry internal dcl 715 ref 1570 ask_yn 005722 constant entry internal dcl 655 ref 805 asked_type 007333 constant label dcl 968 ref 808 818 assign_value 006365 constant entry internal dcl 738 ref 1594 bad 010342 constant label dcl 1192 ref 1172 1175 1180 1183 1185 1186 bad_int 011230 constant label dcl 1387 ref 1392 badq 006765 constant label dcl 841 ref 839 ccom 004017 constant label dcl 372 ref 369 change 006416 constant entry internal dcl 757 ref 375 397 change_clr 006476 constant label dcl 772 ref 787 793 change_one_item 007371 constant entry internal dcl 998 ref 984 988 check_int_abs 011130 constant entry internal dcl 1351 ref 926 check_rq 020106 constant entry internal dcl 2473 ref 2292 2293 2295 2296 2451 2452 check_values 007142 constant label dcl 932 ref 928 ck_int 010226 constant entry internal dcl 1156 ref 934 1386 1405 1507 clean_up 020776 constant entry internal dcl 2595 ref 288 292 298 315 342 copy_shift 010347 constant entry internal dcl 1200 ref 1282 count_error 020376 constant entry internal dcl 2535 ref 2283 2289 2305 2334 2344 2360 2372 2384 2390 2395 2490 2525 default_shift 010466 constant entry internal dcl 1234 ref 1284 define 010577 constant entry internal dcl 1266 ref 575 define_common 010602 constant label dcl 1273 ref 1299 1304 diff 014733 constant label dcl 1953 ref 1941 1942 1943 1944 1949 1950 dont_ask_key 006021 constant label dcl 680 set ref 659 667 ed_mgt 002731 constant entry external dcl 10 exit 003617 constant label dcl 339 exit_ng 011052 constant label dcl 1344 ref 1338 1354 exit_ok 011066 constant label dcl 1345 ref 1330 1335 fcom 003715 constant label dcl 358 ref 356 gccom 004042 constant label dcl 380 ref 378 394 get_int_abs 010750 constant entry internal dcl 1312 ref 956 get_int_list 011155 constant entry internal dcl 1363 ref 835 934 961 1458 get_int_loop 011257 constant label dcl 1392 ref 1407 get_like_shift 011354 constant entry internal dcl 1415 ref 1275 get_shift_list 011540 constant entry internal dcl 1450 ref 1273 get_shift_spec 011654 constant entry internal dcl 1474 ref 920 953 get_values 012060 constant entry internal dcl 1556 ref 963 1625 good 010335 constant label dcl 1191 ref 1178 hyph 010275 constant label dcl 1180 ref 1171 initialize_mgt 020435 constant entry internal dcl 2546 ref 308 int 011004 constant label dcl 1329 ref 1326 int_abs_common 010774 constant label dcl 1326 ref 1341 1355 item 000005 constant label array(2:26) dcl 1009 set ref 1005 key_common 005747 constant label dcl 671 ref 635 643 651 lctype 004102 constant label dcl 385 ref 382 383 look_ahead 007074 constant label dcl 914 ref 921 927 look_ahead_value 012245 constant entry internal dcl 1606 ref 937 main 003561 constant label dcl 335 ref 354 589 593 597 main1 003554 constant label dcl 331 ref 301 367 509 537 581 ncom 005340 constant label dcl 550 ref 548 next_group 015071 constant label dcl 2001 ref 1991 next_shift 014550 constant label dcl 1920 ref 1868 1892 1910 next_wc 015462 constant label dcl 2058 ref 1976 no_pa_arg 004353 constant label dcl 448 ref 423 noabs 015040 constant label dcl 1988 ref 1986 onedigit 010255 constant label dcl 1173 ref 1170 pa_arg 004264 constant label dcl 426 ref 434 439 445 pa_grp 004320 constant label dcl 433 ref 430 431 pa_wc 004333 constant label dcl 438 ref 436 pa_xref 004350 constant label dcl 444 ref 441 442 pacom 004231 constant label dcl 418 ref 415 416 paloop 004237 constant label dcl 422 ref 428 pcom 004160 constant label dcl 402 ref 400 pentry 005511 constant label dcl 591 ref 363 545 556 567 plast 004654 constant label dcl 477 ref 491 prgp 012340 constant entry internal dcl 1636 in procedure "ed_mgt" ref 402 468 prgp 015547 constant label dcl 2089 in procedure "pxgrps" ref 2076 2080 2084 print_bvals 013053 constant entry internal dcl 1709 ref 461 1771 1774 print_common 013135 constant label dcl 1730 ref 1698 1705 1712 1719 print_iflt 013032 constant entry internal dcl 1702 ref 1784 1787 1790 1793 print_ivals 013011 constant entry internal dcl 1688 ref 1777 print_ivals_check_zero 013115 constant entry internal dcl 1723 ref 1780 print_one_alike 014322 constant label dcl 1881 ref 1908 print_shfs 013074 constant entry internal dcl 1716 ref 460 1769 print_warning 020227 constant entry internal dcl 2502 ref 2412 2431 2462 2488 prq 015357 constant label dcl 2043 ref 2035 2038 prwc 013360 constant entry internal dcl 1756 ref 407 481 486 pxgrps 015465 constant entry internal dcl 2062 ref 2017 2023 2055 pxref 014051 constant entry internal dcl 1805 ref 495 pxshft 014735 constant entry internal dcl 1964 ref 1917 qcom 003617 constant label dcl 339 ref 338 redefine 010736 constant entry internal dcl 1295 ref 576 ret 015616 constant label dcl 2099 ref 2097 scan_key 015634 constant entry internal dcl 2111 ref 683 685 687 set_default_shift_spec 012036 constant entry internal dcl 1536 ref 906 shift_err_abs 020360 constant entry internal dcl 2527 ref 2316 2328 shift_err_common 020270 constant label dcl 2519 ref 2530 shift_err_int 020251 constant entry internal dcl 2514 ref 2315 2322 shift_is_defined 016052 constant entry internal dcl 2167 ref 1279 shifts_alike 014571 constant entry internal dcl 1931 ref 1868 1900 skip_grp 015610 constant label dcl 2097 ref 2077 2081 2086 tcom 005426 constant label dcl 564 ref 558 559 undefine 010743 constant entry internal dcl 1301 ref 577 undefine_shift 016107 constant entry internal dcl 2185 ref 1280 undefine_wc 016157 constant entry internal dcl 2205 ref 1250 2190 vcom 005446 constant label dcl 572 ref 570 verify_exit 020105 constant label dcl 2468 ref 2539 verify_mgt 016235 constant entry internal dcl 2231 ref 572 wcom 003635 constant label dcl 347 wctype 004114 constant label dcl 389 ref 387 NAMES DECLARED BY CONTEXT OR IMPLICATION. char builtin function ref 2564 ltrim builtin function ref 2564 rtrim builtin function ref 275 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 21706 22006 21361 21716 Length 22440 21361 100 416 325 2 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ed_mgt 1853 external procedure is an external procedure. on unit on line 288 64 on unit on unit on line 301 64 on unit ask_cval internal procedure shares stack frame of external procedure ed_mgt. ask_key internal procedure shares stack frame of external procedure ed_mgt. ask_val internal procedure shares stack frame of external procedure ed_mgt. assign_value internal procedure shares stack frame of external procedure ed_mgt. change internal procedure shares stack frame of external procedure ed_mgt. change_one_item internal procedure shares stack frame of external procedure ed_mgt. ck_int internal procedure shares stack frame of external procedure ed_mgt. copy_shift internal procedure shares stack frame of external procedure ed_mgt. default_shift internal procedure shares stack frame of external procedure ed_mgt. define internal procedure shares stack frame of external procedure ed_mgt. get_int_abs internal procedure shares stack frame of external procedure ed_mgt. get_int_list internal procedure shares stack frame of external procedure ed_mgt. get_like_shift internal procedure shares stack frame of external procedure ed_mgt. get_shift_list internal procedure shares stack frame of external procedure ed_mgt. get_shift_spec internal procedure shares stack frame of external procedure ed_mgt. get_values internal procedure shares stack frame of external procedure ed_mgt. look_ahead_value internal procedure shares stack frame of external procedure ed_mgt. prgp internal procedure shares stack frame of external procedure ed_mgt. print_ivals internal procedure shares stack frame of external procedure ed_mgt. prwc internal procedure shares stack frame of external procedure ed_mgt. pxref internal procedure shares stack frame of external procedure ed_mgt. shifts_alike internal procedure shares stack frame of external procedure ed_mgt. pxshft internal procedure shares stack frame of external procedure ed_mgt. pxgrps internal procedure shares stack frame of external procedure ed_mgt. scan_key internal procedure shares stack frame of external procedure ed_mgt. shift_is_defined internal procedure shares stack frame of external procedure ed_mgt. undefine_shift internal procedure shares stack frame of external procedure ed_mgt. undefine_wc internal procedure shares stack frame of external procedure ed_mgt. verify_mgt internal procedure shares stack frame of external procedure ed_mgt. check_rq internal procedure shares stack frame of external procedure ed_mgt. print_warning internal procedure shares stack frame of external procedure ed_mgt. shift_err_int internal procedure shares stack frame of external procedure ed_mgt. count_error internal procedure shares stack frame of external procedure ed_mgt. initialize_mgt internal procedure shares stack frame of external procedure ed_mgt. clean_up 98 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 MGT_version_3 ed_mgt STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME ed_mgt 000100 mgtep ed_mgt 000102 arg_count ed_mgt 000103 created_new_mgt ed_mgt 000104 dn ed_mgt 000156 en ed_mgt 000166 grp ed_mgt 000170 change_code ed_mgt 000175 i ed_mgt 000176 j ed_mgt 000177 k ed_mgt 000200 n ed_mgt 000202 mgtp1 ed_mgt 000204 comm ed_mgt 000206 ap ed_mgt 000210 al ed_mgt 000211 code ed_mgt 000212 mgtp ed_mgt 000214 qq ed_mgt 000216 btemp ed_mgt 000217 itemp ed_mgt 000220 ftemp ed_mgt 000236 mgtix ed_mgt 000237 change_item ed_mgt 000240 change_type ed_mgt 000241 fshift ed_mgt 000242 lshift ed_mgt 000243 nshift ed_mgt 000244 mxval ed_mgt 000245 nval ed_mgt 000246 flag ed_mgt 000247 gcfirst ed_mgt 000250 gclast ed_mgt 000251 undefwc ed_mgt 000252 shift ed_mgt 000253 shift_pct ed_mgt 000254 no_abs_count ed_mgt 000255 dflt_g ed_mgt 000261 ival ed_mgt 000271 fval ed_mgt 000301 bval ed_mgt 000311 shifts ed_mgt 000321 shf ed_mgt 000331 nshf ed_mgt 000332 print_pct_ignored ed_mgt 000333 default_absentee ed_mgt 000334 int_wc ed_mgt 000335 gcsw ed_mgt 000336 wcsw ed_mgt 000337 wcundef ed_mgt 000340 got_shift_spec ed_mgt 000341 got_int_abs ed_mgt 000342 got_values ed_mgt 000343 padflt ed_mgt 000344 pawc ed_mgt 000345 pagrp ed_mgt 000346 patot ed_mgt 000347 paxrf ed_mgt 000350 no_abs ed_mgt 000351 shift_used ed_mgt 000361 q ed_mgt 000365 dflt_q ed_mgt 000366 wcp ed_mgt 000370 char32 ed_mgt 000420 prompt_sw ask_key 000421 remove_sw ask_key 000422 yn_sw ask_key 000423 local_flag ask_key 000446 i change 000460 i change_one_item 000500 i ck_int 000501 j ck_int 000510 i copy_shift 000520 i default_shift 000530 like_sw define 000531 redefine_sw define 000532 undefine_sw define 000533 i define 000534 lsh define 000544 cksw get_int_abs 000554 i get_int_list 000555 f get_int_list 000556 n get_int_list 000602 f get_shift_spec 000603 n get_shift_spec 000614 i get_values 000634 ctmp1 prgp 000644 ctmp2 prgp 000654 ii prgp 000655 i prgp 000664 i print_ivals 000665 vtype print_ivals 000720 i shifts_alike 000730 i pxshft 000731 j pxshft 000732 igrp pxshft 000733 agrp pxshft 000734 dfct pxshft 000735 colct pxshft 000736 int pxshft 000737 abs pxshft 000740 int_abs_diff pxshft 000741 print_asterisk pxshft 000752 lct pxgrps 000753 gct pxgrps 000764 key scan_key 000775 comma_offset scan_key 000776 curpos scan_key 000777 keypos scan_key 001000 kln scan_key 001001 ln scan_key 001002 n_commas scan_key 001012 i shift_is_defined 001022 i undefine_shift 001032 i undefine_wc 001042 err_max verify_mgt 001043 err_count verify_mgt 001044 warning_printed verify_mgt 001045 wc_printed verify_mgt 001046 low_pct verify_mgt 001056 unused_pct verify_mgt 001066 print_unused_pct verify_mgt 001067 pct_is_used verify_mgt 001070 wc_empty verify_mgt 001320 wc shift_err_int 001321 ia shift_err_int 001340 wcx initialize_mgt THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. fx1_to_fl2 r_e_as r_ne_as alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return fl2_to_fx1 tra_ext mod_fx1 signal enable shorten_stack ext_entry int_entry set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. ask_ ask_$ask_c ask_$ask_cflo ask_$ask_cint ask_$ask_clr ask_$ask_flo ask_$ask_int ask_$ask_n ask_$ask_nflo ask_$ask_nint ask_$ask_yn com_err_ com_err_$suppress_name cu_$arg_count cu_$arg_ptr expand_pathname_$add_suffix get_group_id_ get_temp_segment_ get_wdir_ initiate_file_$create ioa_ ioa_$nnl ioa_$rsnnl pathname_ release_temp_segment_ terminate_file_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$unimplemented_version LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 002730 36 002736 262 002741 263 002751 264 002753 265 002770 268 002771 269 002774 270 003021 273 003022 274 003024 275 003026 276 003040 278 003041 280 003061 281 003117 282 003121 283 003147 286 003150 287 003151 288 003154 289 003176 290 003240 291 003242 292 003311 295 003315 296 003336 297 003340 298 003364 301 003370 303 003407 307 003425 308 003465 311 003466 312 003473 315 003525 316 003531 322 003532 323 003534 324 003536 325 003540 326 003553 331 003554 335 003561 336 003600 338 003605 339 003612 342 003617 343 003623 345 003624 347 003635 350 003636 352 003644 354 003702 356 003703 357 003710 358 003715 359 003734 360 003745 361 003751 362 003755 363 003757 365 003760 366 003762 367 004005 369 004006 370 004013 372 004017 373 004020 374 004026 375 004027 376 004030 378 004031 379 004036 380 004042 381 004044 382 004066 383 004072 384 004076 385 004102 386 004103 387 004104 388 004110 389 004114 390 004116 392 004117 393 004137 394 004144 397 004145 398 004146 400 004147 401 004154 402 004160 406 004166 407 004167 408 004171 409 004173 410 004210 413 004211 415 004212 416 004217 417 004224 418 004231 421 004233 422 004237 423 004254 424 004256 425 004262 426 004264 427 004265 428 004302 430 004303 431 004307 432 004313 433 004320 434 004322 436 004323 437 004327 438 004333 439 004335 441 004336 442 004342 443 004346 444 004350 445 004352 448 004353 454 004362 455 004364 456 004407 457 004431 458 004453 459 004476 460 004517 461 004550 465 004610 467 004623 468 004627 469 004631 471 004633 472 004635 473 004636 474 004643 475 004647 476 004651 477 004654 478 004655 480 004677 481 004725 484 004732 486 004733 487 004735 490 004741 491 004743 495 004745 499 004750 501 004751 502 004756 503 004763 504 005002 505 005013 506 005017 507 005023 508 005043 509 005063 511 005064 512 005066 513 005072 514 005075 515 005100 516 005102 517 005104 518 005126 519 005134 521 005140 524 005166 525 005170 526 005175 528 005225 529 005235 531 005237 532 005242 534 005243 535 005247 536 005252 537 005266 539 005267 540 005301 541 005310 542 005312 543 005315 544 005322 545 005325 548 005326 549 005333 550 005340 551 005341 552 005345 553 005360 555 005363 556 005367 558 005370 559 005375 560 005402 561 005407 562 005411 563 005413 564 005426 566 005430 567 005434 570 005435 571 005441 572 005446 573 005447 575 005450 576 005456 577 005463 580 005467 581 005507 589 005510 591 005511 593 005526 594 005530 596 005555 597 005577 607 005600 611 005602 613 005624 615 005646 618 005662 626 005663 633 005674 634 005677 635 005700 639 005701 640 005703 641 005705 642 005707 643 005711 647 005712 649 005714 650 005716 651 005721 655 005722 657 005733 658 005736 659 005737 663 005740 665 005742 666 005744 667 005746 671 005747 676 005777 677 006015 680 006021 683 006022 685 006063 687 006117 690 006152 691 006154 692 006156 693 006177 694 006204 696 006205 698 006210 700 006211 702 006213 703 006216 707 006235 715 006236 720 006247 722 006301 723 006303 724 006330 726 006343 727 006344 730 006364 738 006365 742 006367 744 006377 746 006406 749 006415 757 006416 766 006417 767 006436 769 006451 770 006453 771 006456 772 006476 773 006503 776 006504 777 006506 779 006510 783 006514 784 006516 786 006522 787 006542 790 006543 792 006547 793 006567 799 006570 801 006572 805 006617 808 006640 810 006641 814 006666 818 006675 822 006676 832 006703 833 006723 834 006727 835 006733 837 006742 838 006752 839 006761 840 006763 841 006765 842 007006 843 007013 846 007014 847 007016 848 007020 849 007022 852 007023 853 007025 854 007027 855 007050 856 007055 858 007056 861 007057 903 007060 904 007061 905 007063 906 007064 909 007065 911 007067 912 007072 914 007074 916 007111 918 007113 920 007124 921 007125 924 007126 926 007133 927 007140 928 007141 932 007142 934 007143 937 007204 939 007214 941 007221 942 007244 947 007251 953 007252 956 007255 961 007263 963 007312 968 007333 973 007335 974 007337 975 007341 976 007343 978 007344 979 007346 982 007351 983 007357 984 007363 985 007364 986 007366 988 007367 990 007370 998 007371 1005 007372 1009 007374 1010 007402 1012 007403 1014 007412 1015 007426 1017 007432 1019 007433 1020 007437 1022 007440 1023 007446 1024 007451 1026 007452 1027 007456 1029 007457 1030 007463 1032 007464 1033 007470 1035 007471 1036 007475 1038 007476 1039 007502 1041 007503 1042 007513 1044 007531 1045 007544 1046 007546 1048 007547 1050 007551 1051 007553 1052 007561 1053 007566 1054 007570 1056 007577 1057 007601 1058 007602 1059 007607 1063 007610 1064 007617 1066 007635 1068 007637 1070 007640 1071 007647 1073 007664 1074 007666 1076 007667 1077 007677 1078 007705 1080 007713 1081 007715 1083 007716 1090 007725 1093 007755 1095 007774 1097 010013 1099 010032 1101 010042 1102 010044 1104 010045 1106 010055 1108 010100 1109 010102 1111 010103 1113 010117 1120 010120 1122 010127 1123 010135 1124 010137 1126 010140 1128 010153 1129 010163 1130 010170 1131 010172 1133 010173 1136 010202 1137 010206 1139 010207 1141 010213 1143 010214 1146 010221 1147 010225 1156 010226 1170 010237 1171 010246 1172 010254 1173 010255 1175 010266 1176 010267 1177 010271 1178 010274 1180 010275 1182 010301 1183 010312 1184 010313 1185 010324 1186 010325 1187 010327 1188 010332 1191 010335 1192 010342 1200 010347 1205 010351 1206 010357 1207 010363 1208 010371 1209 010375 1210 010400 1211 010403 1212 010405 1213 010415 1214 010420 1215 010423 1216 010426 1218 010431 1220 010433 1221 010443 1222 010447 1223 010460 1224 010463 1226 010465 1234 010466 1239 010470 1240 010473 1241 010477 1242 010502 1243 010505 1244 010507 1245 010514 1246 010517 1247 010522 1248 010525 1250 010530 1252 010546 1253 010557 1254 010563 1255 010571 1256 010574 1258 010576 1266 010577 1271 010600 1273 010602 1275 010604 1278 010610 1279 010617 1280 010634 1282 010646 1284 010663 1286 010672 1287 010703 1288 010711 1290 010712 1291 010733 1293 010735 1295 010736 1297 010737 1298 010741 1299 010742 1301 010743 1303 010744 1304 010747 1312 010750 1322 010753 1324 010754 1326 010774 1328 011000 1329 011004 1330 011006 1332 011007 1333 011013 1334 011017 1335 011020 1338 011021 1339 011023 1340 011044 1341 011051 1344 011052 1345 011066 1346 011070 1347 011105 1349 011121 1351 011130 1352 011133 1353 011135 1354 011152 1355 011154 1363 011155 1382 011166 1384 011213 1385 011215 1386 011222 1387 011230 1388 011251 1389 011256 1392 011257 1396 011264 1397 011273 1398 011275 1399 011300 1401 011302 1403 011307 1404 011324 1405 011327 1406 011336 1407 011353 1415 011354 1420 011356 1422 011357 1423 011374 1425 011402 1426 011417 1427 011434 1431 011457 1433 011502 1434 011507 1435 011527 1436 011534 1439 011535 1442 011537 1450 011540 1454 011542 1455 011557 1458 011602 1460 011626 1461 011631 1462 011645 1463 011652 1466 011653 1474 011654 1488 011655 1489 011676 1491 011702 1493 011703 1494 011707 1495 011713 1496 011720 1497 011721 1499 011723 1501 011725 1502 011727 1503 011732 1504 011735 1507 011736 1508 011744 1509 011764 1510 011771 1513 011772 1514 011774 1515 011776 1517 012001 1518 012007 1520 012020 1521 012021 1523 012023 1526 012025 1527 012027 1529 012031 1536 012035 1540 012037 1541 012045 1542 012052 1543 012053 1545 012055 1548 012057 1556 012060 1570 012071 1571 012114 1573 012117 1575 012131 1576 012146 1577 012160 1578 012173 1581 012177 1585 012201 1589 012207 1592 012213 1594 012225 1595 012242 1598 012244 1606 012245 1616 012247 1618 012250 1620 012270 1622 012310 1625 012314 1628 012337 1636 012340 1644 012342 1646 012412 1647 012415 1649 012454 1650 012457 1652 012512 1655 012551 1657 012577 1665 012622 1668 012655 1670 012701 1671 012720 1672 012726 1673 012742 1674 012747 1676 012775 1677 012777 1680 013010 1688 013011 1697 013027 1698 013031 1702 013032 1704 013050 1705 013052 1709 013053 1711 013071 1712 013073 1716 013074 1718 013112 1719 013114 1723 013115 1726 013133 1730 013135 1734 013150 1735 013155 1738 013206 1740 013242 1742 013265 1744 013306 1745 013344 1746 013346 1748 013357 1756 013360 1763 013362 1764 013403 1765 013411 1766 013413 1769 013414 1771 013441 1774 013502 1777 013542 1780 013577 1784 013635 1787 013701 1790 013744 1793 014005 1797 014050 1805 014051 1815 014052 1816 014053 1817 014054 1818 014055 1819 014056 1821 014066 1822 014073 1823 014077 1824 014103 1826 014112 1827 014114 1829 014116 1831 014123 1832 014125 1833 014126 1835 014130 1837 014132 1838 014143 1839 014147 1840 014152 1841 014154 1843 014155 1847 014157 1848 014173 1849 014203 1850 014222 1851 014224 1855 014243 1859 014245 1862 014256 1863 014265 1867 014267 1868 014271 1871 014301 1878 014302 1880 014314 1881 014316 1885 014350 1886 014366 1887 014377 1888 014416 1889 014420 1892 014441 1897 014444 1898 014446 1900 014461 1903 014503 1904 014506 1905 014510 1906 014513 1907 014515 1908 014516 1910 014517 1912 014520 1916 014522 1917 014543 1918 014545 1920 014550 1922 014552 1925 014570 1931 014571 1939 014573 1940 014601 1941 014605 1942 014613 1943 014635 1944 014641 1946 014645 1947 014647 1948 014657 1949 014663 1950 014707 1951 014725 1952 014727 1953 014733 1964 014735 1974 014737 1975 014745 1976 014751 1977 014757 1978 014760 1979 014761 1980 014763 1981 014764 1982 014766 1983 014777 1984 015003 1985 015021 1986 015022 1987 015025 1988 015040 1991 015041 1993 015045 1994 015052 1995 015055 1996 015060 1997 015063 1998 015065 2001 015071 2003 015073 2005 015106 2009 015107 2014 015165 2015 015167 2016 015205 2017 015220 2020 015224 2021 015230 2022 015251 2023 015264 2024 015270 2025 015271 2028 015304 2029 015306 2030 015321 2031 015322 2032 015323 2033 015331 2034 015335 2035 015336 2036 015341 2037 015344 2038 015346 2040 015347 2041 015350 2042 015355 2043 015357 2045 015361 2047 015406 2048 015425 2050 015431 2052 015433 2053 015437 2055 015456 2058 015462 2105 015464 2062 015465 2072 015467 2073 015471 2074 015501 2075 015505 2076 015511 2077 015523 2079 015524 2080 015526 2081 015540 2083 015541 2084 015543 2086 015546 2089 015547 2090 015550 2091 015551 2092 015554 2093 015556 2095 015571 2097 015610 2098 015614 2099 015616 2100 015633 2111 015634 2119 015645 2120 015646 2124 015663 2125 015714 2126 015730 2127 015737 2129 015752 2131 015765 2133 015773 2134 016002 2138 016004 2142 016010 2143 016012 2144 016013 2145 016014 2146 016017 2147 016035 2148 016036 2149 016037 2151 016040 2153 016041 2155 016050 2159 016051 2167 016052 2172 016054 2174 016072 2176 016075 2178 016104 2185 016107 2190 016111 2191 016127 2192 016137 2193 016143 2194 016151 2195 016154 2197 016156 2205 016157 2210 016161 2211 016171 2212 016175 2213 016202 2214 016205 2215 016210 2216 016211 2217 016216 2218 016221 2219 016224 2220 016227 2221 016232 2223 016234 2231 016235 2236 016236 2237 016240 2246 016241 2247 016263 2249 016274 2250 016310 2256 016314 2258 016321 2259 016322 2260 016323 2261 016324 2262 016326 2265 016330 2267 016335 2268 016341 2269 016346 2271 016353 2273 016354 2274 016365 2275 016366 2276 016367 2277 016370 2278 016371 2279 016373 2281 016421 2283 016437 2286 016440 2287 016455 2289 016506 2292 016507 2293 016525 2294 016543 2295 016551 2296 016566 2299 016604 2302 016612 2303 016614 2304 016617 2305 016642 2306 016643 2307 016644 2311 016653 2312 016663 2314 016667 2315 016672 2316 016703 2317 016715 2320 016716 2321 016733 2322 016740 2325 016745 2326 016751 2327 016766 2328 016773 2331 017001 2332 017007 2334 017043 2337 017044 2338 017050 2339 017055 2341 017066 2344 017121 2345 017122 2348 017123 2349 017126 2351 017131 2353 017133 2356 017134 2357 017136 2358 017141 2360 017165 2364 017166 2366 017170 2368 017176 2369 017203 2370 017207 2372 017227 2374 017230 2377 017232 2379 017234 2380 017245 2381 017251 2382 017257 2384 017303 2387 017304 2388 017315 2390 017346 2393 017347 2394 017353 2395 017377 2397 017400 2399 017402 2401 017422 2406 017442 2407 017443 2409 017444 2410 017451 2412 017460 2413 017461 2414 017475 2415 017503 2416 017505 2417 017534 2419 017542 2420 017544 2423 017562 2425 017573 2427 017575 2428 017576 2429 017603 2430 017611 2431 017616 2432 017617 2433 017621 2434 017623 2436 017637 2437 017660 2438 017665 2440 017711 2441 017713 2443 017724 2444 017726 2446 017730 2447 017735 2448 017743 2449 017747 2451 017760 2452 017775 2454 020013 2455 020015 2457 020017 2458 020027 2459 020033 2462 020045 2463 020046 2466 020103 2468 020105 2473 020106 2481 020110 2482 020121 2488 020132 2490 020142 2492 020143 2495 020226 2502 020227 2504 020230 2505 020232 2506 020246 2508 020250 2514 020251 2517 020252 2518 020263 2519 020270 2523 020323 2525 020356 2526 020357 2527 020360 2528 020361 2529 020372 2530 020375 2535 020376 2536 020377 2537 020400 2538 020404 2539 020430 2541 020434 2546 020435 2551 020436 2552 020451 2553 020453 2554 020466 2555 020470 2556 020472 2557 020473 2558 020476 2559 020501 2560 020503 2561 020505 2562 020507 2563 020515 2564 020521 2565 020545 2567 020547 2568 020554 2569 020556 2573 020570 2574 020572 2575 020605 2576 020621 2577 020634 2578 020646 2579 020662 2580 020676 2581 020712 2583 020726 2585 020731 2586 020734 2587 020736 2588 020752 2589 020766 2590 020770 2591 020772 2592 020774 2595 020775 2598 021003 2599 021031 2601 021071 2602 021125 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved