COMPILATION LISTING OF SEGMENT assign_resource Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 07/18/86 1352.5 mst Fri Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 12 13 /****^ HISTORY COMMENTS: 14* 1) change(86-05-22,Martinson), approve(86-05-22,MCR7411), 15* audit(86-05-22,GJohnson), install(86-05-22,MR12.0-1061): 16* Fix assign_resource so that the -wait control argument works. 17* 2) change(86-06-04,Hartogs), approve(86-06-04,MCR7383), 18* audit(86-06-05,Coppola), install(86-07-18,MR12.0-1098): 19* Changed to use version constant in rcp_device_info.incl.pl1 20* END HISTORY COMMENTS */ 21 22 23 assign_resource: ar: procedure; 24 25 26 /* This program is a command that may be called to assign a resource controled by RCP. 27* * Created on 01/07/75 by Bill Silver. 28* * Changed on 04/02/76 by Bill Silver for "-number" and "-wait" arguments. 29* * Changed on 05/24/78 by Michael R. Jordan for tape_drive and disk_drive and the waring for tape and disk. 30* * Changed on 11/17/78 by M. R. Jordan for -speed and -den 6250. 31* * Modified 6/79 by Michael R. Jordan for 32 character resource types. 32* * Changed 05/83 by B. Braun to add active function capability (phx14713) 33* * and correct declarations of structures used in ipc_ calls (phx13447). 34* * Modified 9/83 by J. A. Bush to use tape_info_version_3 tape_info structure 35* * Modified 831010 for multiple console support... -E. A. Ranzenbach 36* * Modified 841017 to do correct cleanup handling... -M. M. Pozzo 37* * 38* * In the current implementation this command can assign only devices. 39* * Its calling sequence is: 40* * 41* * assign_resource resource_type -control_args- 42* * 43* * resource_type This argument specifies the type of resource to be 44* * assigned. Currently only device type resources can 45* * be assigned. Thus this argument must specify a known 46* * device type. If no "-device" control argument is 47* * specified RCP will attempt to assign any appropriate 48* * device of this type. 49* * 50* * The following optional control arguments are also supported. They may 51* * be used to specify the characteristics of the device to be assigned. 52* * Most of these control arguments must be followed by a value argument. 53* * 54* * (-dv | -device) Specifies that a specific device is to be assigned. 55* * Its value argument must be the name of the device. 56* * RCP will attempt to assign only this specific device. 57* * (-lg | -long) Specifies that the user wants all available information about 58* * the device that is assigned. 59* * (-com | -comment) The value argument is a comment that will be displayed 60* * to the operator when the device is assigned. If more 61* * than one term is required they should be in quotes. 62* * (-model) Device model number. 63* * (-tk | -track) For tapes, the track type. Must be 9 or 7. 64* * (-den | -density) For tapes, the density must be one of the following 65* * values: 6250, 1600, 800, 556, or 200. 66* * (-vol | -volume) The name of a volume used to qualify assignment. 67* * (-tn | -train) For printers, the print train type. 68* * (-ll | -line_length) For printer, the line length. 69* * (-sys | -system) Specifies that the user wants to be a system process. 70* * (-nb | -number) The number of similar devices to assign. 71* * (-wt | -wait) Specifies that the user wants to wait for assignments. 72* * Optional value => minutes to wait. 73* * (-speed) For tapes, the speed must be one of the following 74* * values: 75, 125, or 200. 75* * 76* * Active Function Syntax is: 77* * [ar resource_type {-control_args}] 78* * 79* * The active function returns true if an 80* * assignment was successful and returns false if the resources are 81* * unavailable. Other errors are reported by active_fnc_error_. 82* * The -long control argument is not allowed. 83**/ 84 85 /* AUTOMATIC DATA */ 86 87 dcl 1 info_buffer like tape_info; /* An input device info buffer big enough for tapes. */ 88 89 dcl 1 alist (16) aligned, /* List of assigned devices. */ 90 2 rcp_id bit (36), /* RCP ID for this assignment. */ 91 2 info like tape_info; /* Output device info structure. */ 92 93 dcl 1 event_data aligned like event_wait_info; /* Event message structure, not used. */ 94 95 dcl active_fnc bit(1); /* True if called as an active function */ 96 dcl af_return_arg_len fixed bin(21); 97 dcl af_return_arg_ptr ptr; 98 dcl arg_len fixed bin(21); /* Length of an argument string. */ 99 dcl arg_ptr ptr; /* Pointer to an argument string. */ 100 dcl argx fixed bin; /* Number of the current argument. */ 101 dcl badx fixed bin (35); /* Index to bad character. */ 102 dcl comment char (64); /* Comments to and from operator. */ 103 dcl density bit (5); /* Tape density characteristic. */ 104 dcl density_comment char (30) varying; /* Used to print density capabilities. */ 105 dcl device_flag bit (1); /* ON => user wants specific device by name. */ 106 dcl device_type char (32); /* Device type. */ 107 dcl dtypex fixed bin; /* Device type index. */ 108 dcl ecode fixed bin (35); /* error_table_ code. */ 109 dcl fixed_arg fixed bin; /* Used to convert an argumment to fixed bin. */ 110 dcl i fixed bin; 111 dcl line_length fixed bin; /* Printer line length. */ 112 dcl long_flag bit (1); /* ON => all available information. */ 113 dcl max_num_waits fixed bin; /* Maximum number of minutes to wait. */ 114 dcl num_args fixed bin; /* Number of command arguments. */ 115 dcl num_assigned fixed bin; /* Number of devices assigned so far. */ 116 dcl num_waits fixed bin; /* Number of times we have waited. */ 117 dcl number fixed bin; /* Number of devices to assign. */ 118 dcl option char (12); /* Command option string. */ 119 dcl option_code fixed bin; /* 0 => none, 1 => string, 2 => binary. */ 120 dcl print_train fixed bin; /* Printer print train characteristic. */ 121 dcl speed bit (3); /* Tape drive speed characteristics. */ 122 dcl speed_comment char (30) varying; /* Used to print speed capability. */ 123 dcl statex fixed bin; /* State of device assignment. */ 124 dcl system_flag bit (1); /* ON => user wants to be a system process. */ 125 dcl temp_ecode fixed bin (35); 126 dcl tracks fixed bin; /* Tape track characteristic. */ 127 dcl volume_name char (32); /* Tape or disk volume name. */ 128 dcl wait_flag bit (1); /* ON => waiting for assignment. */ 129 130 131 /* BASED DATA */ 132 133 dcl argument char (arg_len) based (arg_ptr); /* Used to reference argument string. */ 134 dcl af_return_arg char(af_return_arg_len) varying based (af_return_arg_ptr); 135 136 /* INTERNAL STATIC DATA */ 137 138 dcl brief_options (13) char (6) /* Brief form of command options. */ 139 internal static init ("-dv", "-lg", "-com", "-model", "-tk", "-den", 140 "-vol", "-tn", "-ll", "-sys", "-nb", "-wt", "-speed") options(constant); 141 142 dcl long_options (13) char (12) /* Long form of command options. */ 143 internal static init ("-device", "-long", "-comment", "-model", "-track", "-density", 144 "-volume", "-train", "-line_length", "-system", "-number", "-wait", "-speed") options(constant); 145 146 dcl option_codes (13) fixed bin /* Used to describe value argument. */ 147 internal static init (1, 0, 1, 2, 2, 2, 1, 2, 2, 0, 2, -2, 2) options(constant); 148 149 dcl density_names (5) char (5) varying /* Tape density capabilities. */ 150 internal static init ("200 ", "556 ", "800 ", "1600 ", "6250 ") options(constant); 151 152 dcl density_values (5) fixed bin /* Tape density values. */ 153 internal static init (200, 556, 800, 1600, 6250) options(constant); 154 155 dcl console_models (4) char (4) /* Operator's console model names. */ 156 internal static init ("IBM", "EMC", "SCC", "LCC") options(constant); 157 158 dcl speed_values (3) fixed bin /* Tape drive speed values. */ 159 internal static init (75, 125, 200) options(constant); 160 161 dcl speed_names (3) char (4) varying /* Tape drive speed names. */ 162 internal static init ("75 ", "125 ", "200 ") options(constant); 163 164 165 /* EXTERNAL ENTRIES CALLED */ 166 167 dcl cleanup condition; /* Used to unassign if trouble. */ 168 169 dcl (addr, hbound, substr, null) builtin; 170 171 dcl (error_table_$action_not_performed, 172 error_table_$bad_arg, 173 error_table_$badopt, 174 error_table_$inconsistent, 175 error_table_$noarg, 176 error_table_$not_act_fnc, 177 error_table_$resource_reserved, 178 error_table_$resource_unavailable, 179 error_table_$wrong_no_of_args) fixed bin (35) external; 180 181 dcl active_fnc_err_ entry options(variable), 182 com_err_ entry options (variable), 183 convert_ipc_code_ entry (fixed bin (35)), 184 cu_$af_arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 185 cu_$af_return_arg entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), 186 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), 187 cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)), 188 get_argument entry (fixed bin, ptr, fixed bin(21), fixed bin(35)) variable, 189 error_rtn_ entry() options(variable) variable, 190 ioa_ entry options (variable), 191 ipc_$block entry (ptr, ptr, fixed bin (35)), 192 ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)), 193 ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)), 194 rcp_$assign_device entry (char (*), ptr, fixed bin (71), char (*), bit (36) aligned, fixed bin (35)), 195 rcp_$check_assign entry (bit (36) aligned, ptr, char (*), fixed bin, fixed bin (35)), 196 rcp_$unassign entry (bit (36) aligned, bit (*), char (*), fixed bin (35)), 197 resource_info_$get_dtypex entry (char (*), char (*), fixed bin, fixed bin (35)), 198 timer_manager_$sleep entry (fixed bin (71), bit (2)); 199 1 1 /* Begin include file rcp_device_info.incl.pl1 1 2** 1 3** Created on 01/08/75 by Bill Silver. 1 4** This include file defines the RCP device info structure for a general device. 1 5**/ 1 6 1 7 1 8 /****^ HISTORY COMMENTS: 1 9* 1) change(86-06-04,Hartogs), approve(86-06-04,MCR7383), 1 10* audit(86-06-05,Coppola), install(86-07-18,MR12.0-1098): 1 11* Added DEVICE_INFO_VERSION_1 constant. 1 12* END HISTORY COMMENTS */ 1 13 1 14 1 15 dcl device_info_ptr ptr; /* Pointer to general device info structure. */ 1 16 1 17 dcl 1 device_info based(device_info_ptr) aligned, /* RCP device info structure for any device. */ 1 18 2 version_num fixed bin, /* Version number of this structure. */ 1 19 2 usage_time fixed bin, /* Number of minutes device will/may be used. */ 1 20 2 wait_time fixed bin, /* Number of minutes user will/must wait. */ 1 21 2 system_flag bit(1), /* ON => user wants to be a system process. */ 1 22 2 device_name char(8), /* Device name. */ 1 23 2 model fixed bin, /* Device model number. */ 1 24 2 qualifiers(4) fixed bin(35); /* Qualifying characteristics. */ 1 25 1 26 dcl DEVICE_INFO_VERSION_1 fixed bin int static options (constant) init (1); 1 27 1 28 /* End of include file ... rcp_device_info.incl.pl1 */ 200 201 2 1 /* Begin include file rcp_tape_info.incl.pl1 2 2* * 2 3* * Created on 12/16/74 by Bill Silver. 2 4* * Modified on 11/17/78 by Michael R. Jordan to add speed qualifier. 2 5* * Modified on 09/30/82 by J. A. Bush for version 3 structure info 2 6* * This include file defines the RCP device info structure for tapes. 2 7**/ 2 8 /* format: style4 */ 2 9 2 10 dcl tape_info_ptr ptr; /* Pointer to tape device info structure. */ 2 11 2 12 dcl tape_info_version_2 fixed bin internal static options (constant) init (2); 2 13 dcl tape_info_version_3 fixed bin internal static options (constant) init (3); 2 14 2 15 dcl 1 tape_info based (tape_info_ptr) aligned, /* RCP device info structure for tapes. */ 2 16 2 version_num fixed bin, /* Version number of this structure. */ 2 17 2 usage_time fixed bin, /* Number of minutes drive will/may be used. */ 2 18 2 wait_time fixed bin, /* Number of minutes user will/must wait. */ 2 19 2 system_flag bit (1), /* ON => user wants to be a system process. */ 2 20 2 device_name char (8), /* Tape drive name. */ 2 21 2 model fixed bin, /* Tape drive model number. */ 2 22 2 tracks fixed bin, /* Track type, 7 or 9. */ 2 23 2 density bit (36), /* Density capability: 200, 556, 800, 1600, 6250. */ 2 24 2 speed bit (36), /* Speed: 75, 125, 200. */ 2 25 2 unused_qualifier bit (36), /* Unused qualifier (must be "0"b). */ 2 26 2 volume_name char (32), /* Tape reel name. */ 2 27 2 write_flag bit (1), /* ON => writing on tape reel. */ 2 28 2 position_index fixed bin (35), /* Counter used to determine tape reel position. */ 2 29 2 30 /* Limit of version 2 structure, info below returned if version 3 or greater */ 2 31 2 32 2 volume_type fixed bin, /* Use rcp_volume_formats.incl.pl1 for decodes */ 2 33 2 volume_density fixed bin, /* 1 - 5 = 200, 556, 800, 1600, or 6250 BPI */ 2 34 2 opr_auth bit (1); /* "1"b => Operator Authentication was required */ 2 35 2 36 /* End of include file ... rcp_tape_info.incl.pl1 */ 202 203 3 1 /* Begin include file rcp_disk_info.incl.pl1 3 2** 3 3** Created on 03/31/74 by Bill Silver. 3 4** This include file defines the RCP device info structure for disks. 3 5**/ 3 6 3 7 3 8 3 9 3 10 /****^ HISTORY COMMENTS: 3 11* 1) change(86-06-03,Hartogs), approve(86-06-03,MCR7383), 3 12* audit(86-06-06,GWMay), install(86-07-18,MR12.0-1098): 3 13* Added DISK_INFO_VERSION_1 constant. 3 14* END HISTORY COMMENTS */ 3 15 3 16 3 17 dcl disk_info_ptr ptr; /* Pointer to disk device info structure. */ 3 18 3 19 dcl 1 disk_info based(disk_info_ptr) aligned, /* RCP device info structure for disks. */ 3 20 2 version_num fixed bin, /* Version number of this structure. */ 3 21 2 usage_time fixed bin, /* Number of minutes drive will/may be used. */ 3 22 2 wait_time fixed bin, /* Number of minutes user will/must wait. */ 3 23 2 system_flag bit(1), /* ON => user wants to be a system process. */ 3 24 2 device_name char(8), /* Disk drive name. */ 3 25 2 model fixed bin, /* Disk drive model number. */ 3 26 2 volume_name char(32), /* Disk pack name. */ 3 27 2 write_flag bit(1); /* ON => writing on disk pack. */ 3 28 3 29 dcl DISK_INFO_VERSION_1 fixed bin int static options (constant) init (1); 3 30 3 31 /* End of include file ... rcp_disk_info.incl.pl1 */ 204 205 4 1 /* Begin include file rcp_printer_info.incl.pl1 4 2** 4 3** Created on 01/08/75 by Bill Silver. 4 4** This include file defines the RCP device info structure for printers. 4 5**/ 4 6 4 7 4 8 /****^ HISTORY COMMENTS: 4 9* 1) change(86-06-04,Hartogs), approve(86-06-04,MCR7383), 4 10* audit(86-06-05,Coppola), install(86-07-18,MR12.0-1098): 4 11* Added version constant PRINTER_INFO_VERSION_1. 4 12* END HISTORY COMMENTS */ 4 13 4 14 4 15 dcl printer_info_ptr ptr; /* Pointer to printer device info structure. */ 4 16 4 17 dcl 1 printer_info based(printer_info_ptr) aligned, /* RCP device info structure for printers. */ 4 18 2 version_num fixed bin, /* Version number of this structure. */ 4 19 2 usage_time fixed bin, /* Number of minutes printer will/may be used. */ 4 20 2 wait_time fixed bin, /* Number of minutes user will/must wait. */ 4 21 2 system_flag bit(1), /* ON => user wants to be a system process. */ 4 22 2 device_name char(8), /* Printer name. */ 4 23 2 model fixed bin, /* Printer model number. */ 4 24 2 print_train fixed bin, /* Print train type. */ 4 25 2 line_length fixed bin; /* Printer line length. -1 => not specified. */ 4 26 4 27 dcl PRINTER_INFO_VERSION_1 fixed bin int static options (constant) init (1); 4 28 4 29 /* End of include file ... rcp_printer_info.incl.pl1 */ 206 207 5 1 /* BEGIN INCLUDE FILE ... event_wait_channel.incl.pl1 */ 5 2 5 3 /* ipc_$block wait list with one channel 5 4* 5 5* Written 9-May-79 by M. N. Davidoff. 5 6**/ 5 7 5 8 declare 1 event_wait_channel aligned, 5 9 2 n_channels fixed bin initial (1), /* number of channels */ 5 10 2 pad bit (36), 5 11 2 channel_id (1) fixed bin (71); /* event channel to wait on */ 5 12 5 13 /* END INCLUDE FILE ... event_wait_channel.incl.pl1 */ 208 209 6 1 /* BEGIN INCLUDE FILE event_wait_info.incl.pl1 */ 6 2 6 3 /* T. Casey, May 1978 */ 6 4 6 5 dcl event_wait_info_ptr ptr; 6 6 6 7 dcl 1 event_wait_info aligned based (event_wait_info_ptr), /* argument structure filled in on return from ipc_$block */ 6 8 2 channel_id fixed bin (71), /* event channel on which wakeup occurred */ 6 9 2 message fixed bin (71), /* 72 bits of information passed by sender of wakeup */ 6 10 2 sender bit (36), /* process id of sender */ 6 11 2 origin, 6 12 3 dev_signal bit (18) unaligned, /* "1"b if device signal */ 6 13 3 ring fixed bin (17) unaligned, /* ring from which sent */ 6 14 2 channel_index fixed bin; /* index of this channel in the event wait list */ 6 15 6 16 /* END INCLUDE FILE event_wait_info.incl.pl1 */ 210 211 212 /* 213* * 214* * Begin command: assign_resource, ar 215* * 216**/ 217 218 219 device_flag, /* Now initialize other variables. */ 220 long_flag, 221 system_flag, 222 wait_flag = "0"b; 223 224 dtypex, 225 ecode, 226 num_assigned, 227 event_wait_channel.channel_id(1) = 0; 228 229 number = 1; 230 231 comment = " "; 232 233 do i = 1 to hbound (alist, 1); 234 alist (i).rcp_id = "0"b; 235 end; 236 device_info_ptr = addr (info_buffer); /* All structures use the same buffer. */ 237 238 device_info.version_num = DEVICE_INFO_VERSION_1; /* Set up assignment data. Assume same version. */ 239 device_info.usage_time, /* These fields not used yet. */ 240 device_info.wait_time = 0; 241 device_info.device_name = " "; /* Blank => assign any device of specified type. */ 242 device_info.model = 0; 243 device_info.qualifiers (*) = 0; 244 245 tracks = 0; /* Initialize device characteristics. */ 246 density = "0"b; 247 volume_name = " "; 248 speed = "0"b; 249 print_train, 250 line_length = 0; 251 252 /* get command arguments */ 253 call cu_$af_return_arg (num_args, af_return_arg_ptr, af_return_arg_len, ecode); 254 if ecode = error_table_$not_act_fnc then do; 255 active_fnc = "0"b; 256 get_argument = cu_$arg_ptr; 257 error_rtn_ = com_err_; 258 end; 259 else do; /* active function case */ 260 active_fnc = "1"b; 261 get_argument = cu_$af_arg_ptr; 262 error_rtn_ = active_fnc_err_; 263 af_return_arg = "false"; 264 end; 265 266 call GET_RESOURCE_TYPE; /* Get required argument. */ 267 if ecode ^= 0 then goto MAIN_RETURN; 268 269 do argx = 2 to num_args; /* Process any optional control arguments. */ 270 call PROCESS_ARG; /* Most will be processed in pairs. */ 271 if ecode ^= 0 then goto MAIN_RETURN; /* Was there an error? */ 272 end; 273 274 call CHECK_DEVICE_INFO; /* See if device info is valid. */ 275 if ecode ^= 0 then goto MAIN_RETURN; /* Is it valid? */ 276 277 on cleanup begin; /* If user quits unassign all devices. */ 278 call CLEANUP; 279 end; 280 281 call ipc_$create_ev_chn (event_wait_channel.channel_id(1), ecode); 282 if ecode ^= 0 /* RCP needs an event channel. */ 283 then do; /* But we don't have one. */ 284 call convert_ipc_code_ (ecode); 285 call error_rtn_ (ecode, "assign_resource", "Error creating event channel."); 286 goto MAIN_RETURN; 287 end; 288 289 do while ((num_assigned < number) & (ecode = 0)); 290 call ASSIGN_DEVICE; /* Try to assign one device. */ 291 end; 292 293 if ecode ^= 0 /* Was there an error. */ 294 then goto MAIN_RETURN; /* Yes. */ 295 296 297 /* Successful assignment of resources */ 298 299 if active_fnc then af_return_arg = "true"; /* Active Function case prints no info. */ 300 else do; 301 if (long_flag) & (^device_flag) & (num_assigned > 1) 302 then call ioa_ ("^d devices assigned", num_assigned); 303 304 do number = 1 to num_assigned; /* Print info about each assigned device. */ 305 device_info_ptr = addr (alist (number).info); 306 call PRINT_DEVICE_INFO; /* Print info about one device. */ 307 end; 308 end; 309 310 num_assigned = 0; /* Don't unassign any devices. */ 311 MAIN_RETURN: 312 call CLEANUP; /* Clean up event channel. */ 313 314 return; /* We are finished. */ 315 316 317 /* 318* * 319* * This procedure will attempt to assign one device. 320* * If this device cannot be assigned because no appropriate device is 321* * currently available, then all devices assigned up to that point will 322* * be unassigned. If the user wants to wait for the assignment(s) then 323* * we will go blocked for one minute and try again. 324* * 325* */ 326 327 328 ASSIGN_DEVICE: procedure; 329 330 331 num_assigned = num_assigned + 1; /* Up count of assigned devices. */ 332 device_info_ptr = addr (info_buffer); /* Use input info structure. */ 333 334 call rcp_$assign_device (device_type, device_info_ptr, event_wait_channel.channel_id(1), comment, 335 alist (num_assigned).rcp_id, ecode); 336 if ecode ^= 0 /* Was assignment started OK? */ 337 then do; /* No. */ 338 if (ecode ^= error_table_$resource_unavailable) & 339 (ecode ^= error_table_$resource_reserved) 340 then do; /* Error during assignment. */ 341 call error_rtn_ (ecode, "assign_resource", "Error assigning ^a device ^a", 342 device_type, device_info.device_name); 343 return; 344 end; 345 end; 346 device_info_ptr = addr (alist (num_assigned).info); /* Get pointer to output info structure. */ 347 device_info.version_num = addr (info_buffer) -> device_info.version_num; 348 device_info.device_name = " "; 349 350 351 ASSIGN_LOOP: /* Loop until assignment completed. */ 352 comment = " "; 353 call rcp_$check_assign (alist (num_assigned).rcp_id, device_info_ptr, comment, statex, ecode); 354 if comment ^= " " /* Did RCP send a comment? */ 355 then if ^active_fnc then call ioa_ ("RCP comment: ^a", comment); 356 357 goto STATE (statex); /* Process current state of assignment. */ 358 359 360 STATE (0): /* Assignment completed OK. */ 361 return; 362 363 364 STATE (1): /* Short wait, block until wakeup comes. */ 365 call ipc_$block (addr (event_wait_channel), addr (event_data), ecode); 366 if ecode ^= 0 /* Error in blocking is bad. */ 367 then do; 368 call convert_ipc_code_ (ecode); 369 call error_rtn_ (ecode, "assign_resource", "Error waiting for device assignment."); 370 return; 371 end; 372 goto ASSIGN_LOOP; /* Waked up, check assignment again. */ 373 374 375 STATE (2): /* Long wait, don't support this yet. */ 376 ecode = error_table_$action_not_performed; 377 378 379 STATE (3): /* Fatal error. */ 380 if (ecode ^= error_table_$resource_unavailable) & 381 (ecode ^= error_table_$resource_reserved) 382 then do; /* Error during assignment. */ 383 call error_rtn_ (ecode, "assign_resource", "Error assigning ^a device ^a", 384 device_type, device_info.device_name); 385 return; 386 end; 387 388 if ^wait_flag /* Can't get device now, should we wait? */ 389 then do; /* No. */ 390 if active_fnc then return; 391 call error_rtn_ (ecode, "assign_resource", "Unable at this time to assign ^a device ^a", 392 device_type, device_info.device_name); 393 return; 394 end; 395 396 /* Assignment can be made if we wait. Check to see if we have already 397* * waited too many times. 398**/ 399 if num_waits = max_num_waits /* Have we waited to many times? */ 400 then do; /* Yes. */ 401 if active_fnc then return; 402 call error_rtn_ (ecode, "assign_resource", "Maximum wait of ^d minutes exceeded", max_num_waits); 403 return; 404 end; 405 406 /* We will wait for the assignment(s). First unassign any device already assigned. 407**/ 408 alist (num_assigned).rcp_id = "0"b; /* This assignment failed. */ 409 do i = 1 to (num_assigned -1); /* Unassign any devices already assigned. */ 410 call rcp_$unassign (alist (i).rcp_id, "0"b, "", temp_ecode); 411 alist (i).rcp_id = "0"b; /* Don't use this RCP ID again. */ 412 if temp_ecode ^= 0 413 then do; /* Error unassigning this device. */ 414 call error_rtn_ (temp_ecode, "assign_resource", "Error unassigning device"); 415 if ecode = 0 then ecode = temp_ecode; 416 end; 417 end; 418 419 if num_waits = 0 /* Is this the first wait? */ 420 then if ^active_fnc then call error_rtn_ (0, "assign_resource", "Waiting for device assignments"); 421 422 num_waits = num_waits + 1; /* Count number of times we have waited. */ 423 num_assigned = 0; /* No devices now assigned. */ 424 425 call timer_manager_$sleep (60, "11"b); /* Wait for one minute. */ 426 427 ecode = 0; 428 return; 429 430 end ASSIGN_DEVICE; 431 432 /* 433* * 434* * This procedure is called to validate the data entered for this device 435* * assignment. The actual testing performed depends upon the type of 436* * device being assigned. If everything is OK we will fill in the device 437* * characteristics that go with this device type. 438* * 439* */ 440 441 442 CHECK_DEVICE_INFO: procedure; 443 444 445 if (device_flag) & (number > 1) /* Only one specific device can be assigned. */ 446 then do; /* More than one is an error. */ 447 ecode = error_table_$inconsistent; 448 call error_rtn_ (ecode, "assign_resource", "Attempt to assign device ^a ^d times", 449 device_info.device_name, number); 450 end; 451 452 device_info.system_flag = system_flag; /* Tell RCP whether or not this is a system process. */ 453 goto DTYPE_CHECK (dtypex); /* Go check depending upon device type. */ 454 455 456 DTYPE_CHECK (1): /* TAPE */ 457 if (tracks = 0) & /* If no track type specified ... */ 458 (volume_name = " ") /* and no volume specified ... */ 459 then tracks = 9; /* then use default track type. */ 460 if (tracks = 7) & /* Check that tracks and density are OK. */ 461 (substr (density, 4, 2) ^= "00"b) 462 then do; /* 7 track and 1600 is invalid. */ 463 ecode = error_table_$inconsistent; 464 call error_rtn_ (ecode, "assign_resource", "Inconsistent track and density values."); 465 end; 466 tape_info_ptr = device_info_ptr; /* Get pointer to tape_info structure. */ 467 tape_info.version_num = tape_info_version_3; /* newer version than the others */ 468 tape_info.tracks = tracks; /* Fill in tape characteristics. */ 469 tape_info.density = density; 470 tape_info.volume_name = volume_name; 471 tape_info.write_flag = "0"b; 472 tape_info.position_index = 0; 473 tape_info.speed = speed; 474 tape_info.unused_qualifier = "0"b; 475 return; 476 477 478 DTYPE_CHECK (2): /* DISK */ 479 disk_info_ptr = device_info_ptr; /* Get pointer to disk_info structure. */ 480 disk_info.volume_name = volume_name; /* Fill in disk characteristics. */ 481 disk_info.write_flag = "0"b; 482 return; 483 484 485 DTYPE_CHECK (3): /* CONSOLE */ 486 if (device_info.device_name ^= " ") & /* Does user want specific device? */ 487 (substr (device_info.device_name, 1, 3) ^= "opc") 488 then do; /* Yes, but not the correct name. */ 489 ecode = error_table_$bad_arg; 490 call error_rtn_ (ecode, "assign_resource", "Illegal console device name: ^a", 491 device_info.device_name); 492 end; 493 return; 494 495 496 DTYPE_CHECK (4): /* PRINTER */ 497 printer_info_ptr = device_info_ptr; /* Get pointer to printer_info structure. */ 498 printer_info.print_train = print_train; /* Fill in printer characteristics. */ 499 printer_info.line_length = line_length; 500 return; 501 502 503 DTYPE_CHECK (5): /* PUNCH */ 504 DTYPE_CHECK (6): /* READER */ 505 return; /* Nothing to do for these device types. */ 506 507 508 DTYPE_CHECK (7): /* SPECIAL */ 509 if device_info.device_name = " " /* Did user specify a device name? */ 510 then do; /* No, for this device type he must. */ 511 ecode = error_table_$noarg; 512 call error_rtn_ (ecode, "assign_resource", "Must specify SPECIAL device name."); 513 end; 514 515 516 end CHECK_DEVICE_INFO; 517 518 /* 519* * 520* * This procedure is called when the assignment has been aborted. 521* * If we have an RCP ID we will try to unassign the device we are assigning. 522* * If we have created an event channel then we must delete it. 523* * 524* */ 525 526 527 CLEANUP: procedure; 528 529 dcl cleanup_code fixed bin (35); 530 531 do i = 1 to num_assigned; /* Unassign all assigned devices. */ 532 if alist (i).rcp_id ^= "0"b /* If we have an RCPID try to unassign. */ 533 then call rcp_$unassign (alist (i).rcp_id, "0"b, "", cleanup_code); 534 end; 535 536 if event_wait_channel.channel_id(1) = 0 then return; /* Did we created an event channel? */ 537 538 call ipc_$delete_ev_chn (event_wait_channel.channel_id(1), cleanup_code); 539 540 return; 541 542 end CLEANUP; 543 544 /* 545* * 546* * This procedure is called to get the resource type to be assigned. 547* * The resource type name must be the first argument to this command. 548* * 549* */ 550 551 552 553 GET_RESOURCE_TYPE: procedure; 554 555 556 if num_args < 1 /* Is there a resource type argument. */ 557 then do; /* No. */ 558 ecode = error_table_$noarg; 559 call error_rtn_ (ecode, "assign_resource", "No resource type specified."); 560 return; 561 end; 562 563 call get_argument (1, arg_ptr, arg_len, ecode); /* Get resource type argument. */ 564 if ecode ^= 0 565 then do; 566 call error_rtn_ (ecode, "assign_resource", "Error getting resource type argument"); 567 return; 568 end; 569 570 call resource_info_$get_dtypex (argument, device_type, dtypex, ecode); 571 if ecode ^= 0 then do; 572 call error_rtn_ (ecode, "assign_resource", "^a", argument); 573 return; 574 end; 575 else return; 576 577 578 end GET_RESOURCE_TYPE; 579 580 /* 581* * 582* * This procedure is called to get any value argument associated with this option. 583* * Processing of the value argument depends upon the option code value associated 584* * with this option. The option code values are: 585* * 586* * 0. This option argument has no accompanying value argument. 587* * 1. This option argument has a string type value argument. 588* * 2. This option argument has a binary type value argument. 589* * (-1, -2) This option argument is optional. 590* * 591* */ 592 593 594 GET_VALUE: procedure (option_num); 595 596 597 dcl option_num fixed bin; /* Number that identifies this option. */ 598 599 600 option_code = option_codes (option_num); /* Get code value for this option. */ 601 602 if option_code = 0 /* Is there an accompanying argument value? */ 603 then return; /* No, nothing else to do. */ 604 605 /* Get accompanying argument value. */ 606 if argx = num_args /* Is this the last argument? */ 607 then if option_code < 0 /* Must there be a value argument? */ 608 then do; /* No. */ 609 if option_code = -1 then arg_ptr = null (); 610 else fixed_arg = 0; 611 return; 612 end; 613 else do; /* Yes, value argument missing. */ 614 ecode = error_table_$wrong_no_of_args; 615 call error_rtn_ (ecode, "assign_resource", "No value argument for ^a", option); 616 return; 617 end; 618 619 argx = argx + 1; /* Get the next argument. */ 620 call get_argument (argx, arg_ptr, arg_len, ecode); 621 if ecode ^= 0 622 then do; 623 call error_rtn_ (ecode, "assign_resource", "Error getting argument ^d", argx); 624 return; 625 end; 626 627 if substr (argument, 1, 1) = "-" /* Is next argument a control option? */ 628 then if option_code < 0 /* Must there be a value argument? */ 629 then do; /* No, two control args in a row is OK. */ 630 argx = argx - 1; /* Process this argument over again. */ 631 if option_code = -1 then arg_ptr = null (); 632 else fixed_arg = 0; 633 return; 634 end; 635 else do; /* Yes, value argument is missing. */ 636 ecode = error_table_$wrong_no_of_args; 637 call error_rtn_ (ecode, "assign_resource", "No value argument for ^a", option); 638 return; 639 end; 640 641 if option_code = 1 /* Is argument value a string? */ 642 then return; /* Yes, no conversion necessary. */ 643 644 /* Convert argument value to binary. */ 645 fixed_arg = cv_dec_check_ (argument, badx); 646 if badx ^= 0 /* Argument contains non decimal characters. */ 647 then do; 648 ecode = error_table_$bad_arg; 649 call error_rtn_ (ecode, "assign_resource", " ""^a"" is not a decimal number.", argument); 650 return; 651 end; 652 653 654 end GET_VALUE; 655 656 /* 657* * 658* * This procedure prints information about one assigned device. 659* * 660* */ 661 662 663 PRINT_DEVICE_INFO: procedure; 664 665 if (long_flag) | (^device_flag) 666 then call ioa_ ("Device ^a assigned", device_info.device_name); 667 668 if ^long_flag then return; /* Does user want all available information? */ 669 670 goto DTYPE_INFO (dtypex); /* Other info depends upon device type. */ 671 672 673 DTYPE_INFO (1): /* TAPE */ 674 call ioa_ ("Model^-= ^d", device_info.model); 675 tape_info_ptr = device_info_ptr; /* Use tape specific info. */ 676 call ioa_ ("Tracks^-= ^d", tape_info.tracks); 677 density_comment = ""; /* Clear density comment. */ 678 do i = 1 to hbound (density_names, 1); /* Test for each possiblle density. */ 679 if substr (tape_info.density, i, 1) 680 then density_comment = density_comment || " " || density_names (i); 681 end; 682 call ioa_ ("Densities^-= ^a", density_comment); 683 speed_comment = ""; 684 do i = 1 to hbound (speed_names, 1); /* Test for each possible speed. */ 685 if substr (tape_info.speed, i, 1) 686 then speed_comment = speed_comment || " " || speed_names (i); 687 end; 688 call ioa_ ("Speed^-= ^a", speed_comment); 689 return; 690 691 692 DTYPE_INFO (3): /* CONSOLE */ 693 call ioa_ ("Model^-= ^a", console_models (device_info.model)); 694 return; 695 696 697 DTYPE_INFO (4): /* PRINTER */ 698 call ioa_ ("Model^-= ^d", device_info.model); 699 printer_info_ptr = device_info_ptr; /* Use printer specific info. */ 700 call ioa_ ("Train^-= ^d", printer_info.print_train); 701 if printer_info.line_length = -1 702 then call ioa_ ("Line Len^-= not specified"); 703 else call ioa_ ("Line Len^-= ^d", printer_info.line_length); 704 return; 705 706 707 DTYPE_INFO (2): /* DISK */ 708 DTYPE_INFO (5): /* PUNCH */ 709 DTYPE_INFO (6): /* READER */ 710 DTYPE_INFO (7): /* SPECIAL */ 711 call ioa_ ("Model^-= ^d", device_info.model); 712 return; /* No extra information for these device types. */ 713 714 715 end PRINT_DEVICE_INFO; 716 717 /* 718* * 719* * This procedure is called to process one optional control argument. 720* * Many of the control arguments have an accompanying value argument. 721* * This value must be the next argument. In this case we will process 722* * the value argument too. 723* * 724* */ 725 726 727 PROCESS_ARG: procedure; 728 729 730 call get_argument (argx, arg_ptr, arg_len, ecode); 731 if ecode ^= 0 732 then do; 733 call error_rtn_ (ecode, "assign_resource", "Error getting argument ^d", argx); 734 return; 735 end; 736 737 option = argument; /* Save option argument. */ 738 739 do i = 1 to hbound (long_options, 1); /* Look for valid option name. */ 740 if (option = brief_options (i)) | /* Is it this brief name? */ 741 (option = long_options (i)) /* Or this long name? */ 742 then do; /* Yes, one of them. */ 743 call GET_VALUE (i); /* Get value argument if any. */ 744 if ecode ^= 0 then return; /* Check for errors. */ 745 goto OPTION (i); /* Go process this option. */ 746 end; 747 end; 748 749 ecode = error_table_$badopt; /* Option name not found. */ 750 call error_rtn_ (ecode, "assign_resource", "^a", argument); 751 return; 752 753 754 OPTION (1): /* "-dv" or "-device" */ 755 device_info.device_name = argument; /* Assign a specific device. */ 756 device_flag = "1"b; 757 return; 758 759 760 OPTION (2): /* "-lg" or "-long" */ 761 if active_fnc then do; /* -lg isn't allowed in AF case */ 762 ecode = error_table_$bad_arg; 763 call error_rtn_ (ecode, "assign_resource", "Control arg not allowed for the active function. ^a", argument); 764 end; 765 766 else long_flag = "1"b; /* Return all info when device assigned. */ 767 return; 768 769 770 OPTION (3): /* "-com" or "-comment" */ 771 comment = argument; /* Save user's comment to operator. */ 772 return; 773 774 775 OPTION (4): /* "-model" */ 776 device_info.model = fixed_arg; 777 return; 778 779 780 OPTION (5): /* "-tk" or "-track" */ 781 if (fixed_arg ^= 9) & /* Validate value. */ 782 (fixed_arg ^= 7) 783 then goto BAD_ARG; 784 tracks = fixed_arg; 785 return; 786 787 788 OPTION (6): /* "-den" or "-density" */ 789 do i = 1 to hbound (density_values, 1); /* Look for a valid density value. */ 790 if fixed_arg = density_values (i) 791 then do; /* We found one. */ 792 substr (density, i, 1) = "1"b; 793 return; 794 end; 795 end; 796 goto BAD_ARG; /* Invalid value. */ 797 798 799 OPTION (7): /* "-vol" or "-volume" */ 800 volume_name = argument; 801 return; 802 803 804 OPTION (8): /* "-tn" or "-train" */ 805 print_train = fixed_arg; 806 return; 807 808 809 OPTION (9): /* "-ll" or "-line_length" */ 810 line_length = fixed_arg; 811 return; 812 813 814 OPTION (10): /* "-sys" or "-system" */ 815 system_flag = "1"b; /* User wants to be a system process. */ 816 return; 817 818 819 OPTION (11): /* "-nb" or "-number" */ 820 number = fixed_arg; /* Number of similar devices to assign. */ 821 if number > hbound (alist, 1) /* Is number too large? */ 822 then goto BAD_ARG; /* Yes, error. */ 823 return; 824 825 826 OPTION (12): /* "-wt" or "-wait" */ 827 wait_flag = "1"b; /* Remember that user wants to wait. */ 828 if (fixed_arg = 0) | /* If no wait time specified. */ 829 (fixed_arg > (24 * 60)) /* Or wait time greater tha allowed max? */ 830 then max_num_waits = (24 * 60); /* Use default of 24 hours. */ 831 else max_num_waits = fixed_arg; /* Use user's wait time. */ 832 num_waits = 0; /* Initialize actual number of waits. */ 833 return; 834 835 836 OPTION (13): /* "-speed" */ 837 do i = 1 to hbound (speed_values, 1); /* look for a valid speed value */ 838 if fixed_arg = speed_values (i) then do; /* found one */ 839 substr (speed, i, 1) = "1"b; 840 return; 841 end; 842 end; 843 goto BAD_ARG; 844 845 846 BAD_ARG: 847 ecode = error_table_$bad_arg; 848 call error_rtn_ (ecode, "assign_resource", " ""^a"" is invalid for option ^a", argument, option); 849 850 851 end PROCESS_ARG; 852 853 end assign_resource; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/18/86 1235.1 assign_resource.pl1 >spec>install>1098>assign_resource.pl1 200 1 07/18/86 1218.3 rcp_device_info.incl.pl1 >spec>install>1098>rcp_device_info.incl.pl1 202 2 04/05/83 0853.0 rcp_tape_info.incl.pl1 >ldd>include>rcp_tape_info.incl.pl1 204 3 07/18/86 1218.4 rcp_disk_info.incl.pl1 >spec>install>1098>rcp_disk_info.incl.pl1 206 4 07/18/86 1218.3 rcp_printer_info.incl.pl1 >spec>install>1098>rcp_printer_info.incl.pl1 208 5 06/29/79 1728.0 event_wait_channel.incl.pl1 >ldd>include>event_wait_channel.incl.pl1 210 6 06/29/79 1727.8 event_wait_info.incl.pl1 >ldd>include>event_wait_info.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. DEVICE_INFO_VERSION_1 constant fixed bin(17,0) initial dcl 1-26 ref 238 active_fnc 000757 automatic bit(1) unaligned dcl 95 set ref 255* 260* 299 354 390 401 419 760 active_fnc_err_ 000032 constant entry external dcl 181 ref 262 addr builtin function dcl 169 ref 236 305 332 346 347 364 364 364 364 af_return_arg based varying char dcl 134 set ref 263* 299* af_return_arg_len 000760 automatic fixed bin(21,0) dcl 96 set ref 253* 263 299 af_return_arg_ptr 000762 automatic pointer dcl 97 set ref 253* 263 299 alist 000130 automatic structure array level 1 dcl 89 set ref 233 821 arg_len 000764 automatic fixed bin(21,0) dcl 98 set ref 563* 570 570 572 572 620* 627 645 645 649 649 730* 737 750 750 754 763 763 770 799 848 848 arg_ptr 000766 automatic pointer dcl 99 set ref 563* 570 572 609* 620* 627 631* 645 649 730* 737 750 754 763 770 799 848 argument based char unaligned dcl 133 set ref 570* 572* 627 645* 649* 737 750* 754 763* 770 799 848* argx 000770 automatic fixed bin(17,0) dcl 100 set ref 269* 606 619* 619 620* 623* 630* 630 730* 733* badx 000771 automatic fixed bin(35,0) dcl 101 set ref 645* 646 brief_options 000164 constant char(6) initial array unaligned dcl 138 ref 740 channel_id 2 001132 automatic fixed bin(71,0) array level 2 dcl 5-8 set ref 224* 281* 334* 536 538* cleanup 001104 stack reference condition dcl 167 ref 277 cleanup_code 000100 automatic fixed bin(35,0) dcl 529 set ref 532* 538* com_err_ 000034 constant entry external dcl 181 ref 257 comment 000772 automatic char(64) unaligned dcl 102 set ref 231* 334* 351* 353* 354 354* 770* console_models 000050 constant char(4) initial array unaligned dcl 155 set ref 692* convert_ipc_code_ 000036 constant entry external dcl 181 ref 284 368 cu_$af_arg_ptr 000040 constant entry external dcl 181 ref 261 cu_$af_return_arg 000042 constant entry external dcl 181 ref 253 cu_$arg_ptr 000044 constant entry external dcl 181 ref 256 cv_dec_check_ 000046 constant entry external dcl 181 ref 645 density 001012 automatic bit(5) unaligned dcl 103 in procedure "ar" set ref 246* 460 469 792* density 10 based bit(36) level 2 in structure "tape_info" dcl 2-15 in procedure "ar" set ref 469* 679 density_comment 001013 automatic varying char(30) dcl 104 set ref 677* 679* 679 682* density_names 000061 constant varying char(5) initial array dcl 149 ref 678 679 density_values 000054 constant fixed bin(17,0) initial array dcl 152 ref 788 790 device_flag 001024 automatic bit(1) unaligned dcl 105 set ref 219* 301 445 665 756* device_info based structure level 1 dcl 1-17 device_info_ptr 001122 automatic pointer dcl 1-15 set ref 236* 238 239 239 241 242 243 305* 332* 334* 341 346* 347 348 353* 383 391 448 452 466 478 485 485 490 496 508 665 673 675 692 697 699 707 754 775 device_name 4 based char(8) level 2 dcl 1-17 set ref 241* 341* 348* 383* 391* 448* 485 485 490* 508 665* 754* device_type 001025 automatic char(32) unaligned dcl 106 set ref 334* 341* 383* 391* 570* disk_info based structure level 1 dcl 3-19 disk_info_ptr 001126 automatic pointer dcl 3-17 set ref 478* 480 481 dtypex 001035 automatic fixed bin(17,0) dcl 107 set ref 224* 453 570* 670 ecode 001036 automatic fixed bin(35,0) dcl 108 set ref 224* 253* 254 267 271 275 281* 282 284* 285* 289 293 334* 336 338 338 341* 353* 364* 366 368* 369* 375* 379 379 383* 391* 402* 415 415* 427* 447* 448* 463* 464* 489* 490* 511* 512* 558* 559* 563* 564 566* 570* 571 572* 614* 615* 620* 621 623* 636* 637* 648* 649* 730* 731 733* 744 749* 750* 762* 763* 846* 848* error_rtn_ 001116 automatic entry variable dcl 181 set ref 257* 262* 285 341 369 383 391 402 414 419 448 464 490 512 559 566 572 615 623 637 649 733 750 763 848 error_table_$action_not_performed 000010 external static fixed bin(35,0) dcl 171 ref 375 error_table_$bad_arg 000012 external static fixed bin(35,0) dcl 171 ref 489 648 762 846 error_table_$badopt 000014 external static fixed bin(35,0) dcl 171 ref 749 error_table_$inconsistent 000016 external static fixed bin(35,0) dcl 171 ref 447 463 error_table_$noarg 000020 external static fixed bin(35,0) dcl 171 ref 511 558 error_table_$not_act_fnc 000022 external static fixed bin(35,0) dcl 171 ref 254 error_table_$resource_reserved 000024 external static fixed bin(35,0) dcl 171 ref 338 379 error_table_$resource_unavailable 000026 external static fixed bin(35,0) dcl 171 ref 338 379 error_table_$wrong_no_of_args 000030 external static fixed bin(35,0) dcl 171 ref 614 636 event_data 000750 automatic structure level 1 dcl 93 set ref 364 364 event_wait_channel 001132 automatic structure level 1 dcl 5-8 set ref 364 364 event_wait_info based structure level 1 dcl 6-7 fixed_arg 001037 automatic fixed bin(17,0) dcl 109 set ref 610* 632* 645* 775 780 780 784 790 804 809 819 828 828 831 838 get_argument 001112 automatic entry variable dcl 181 set ref 256* 261* 563 620 730 hbound builtin function dcl 169 ref 233 678 684 739 788 821 836 i 001040 automatic fixed bin(17,0) dcl 110 set ref 233* 234* 409* 410 411* 531* 532 532* 678* 679 679* 684* 685 685* 739* 740 740 743* 745* 788* 790 792* 836* 838 839* info 1 000130 automatic structure array level 2 dcl 89 set ref 305 346 info_buffer 000100 automatic structure level 1 unaligned dcl 87 set ref 236 332 347 ioa_ 000050 constant entry external dcl 181 ref 301 354 665 673 676 682 688 692 697 700 701 703 707 ipc_$block 000052 constant entry external dcl 181 ref 364 ipc_$create_ev_chn 000054 constant entry external dcl 181 ref 281 ipc_$delete_ev_chn 000056 constant entry external dcl 181 ref 538 line_length 001041 automatic fixed bin(17,0) dcl 111 in procedure "ar" set ref 249* 499 809* line_length 10 based fixed bin(17,0) level 2 in structure "printer_info" dcl 4-17 in procedure "ar" set ref 499* 701 703* long_flag 001042 automatic bit(1) unaligned dcl 112 set ref 219* 301 665 668 766* long_options 000115 constant char(12) initial array unaligned dcl 142 ref 739 740 max_num_waits 001043 automatic fixed bin(17,0) dcl 113 set ref 399 402* 828* 831* model 6 based fixed bin(17,0) level 2 dcl 1-17 set ref 242* 673* 692 697* 707* 775* n_channels 001132 automatic fixed bin(17,0) initial level 2 dcl 5-8 set ref 5-8* null builtin function dcl 169 ref 609 631 num_args 001044 automatic fixed bin(17,0) dcl 114 set ref 253* 269 556 606 num_assigned 001045 automatic fixed bin(17,0) dcl 115 set ref 224* 289 301 301* 304 310* 331* 331 334 346 353 408 409 423* 531 num_waits 001046 automatic fixed bin(17,0) dcl 116 set ref 399 419 422* 422 832* number 001047 automatic fixed bin(17,0) dcl 117 set ref 229* 289 304* 305* 445 448* 819* 821 option 001050 automatic char(12) unaligned dcl 118 set ref 615* 637* 737* 740 740 848* option_code 001053 automatic fixed bin(17,0) dcl 119 set ref 600* 602 606 609 627 631 641 option_codes 000100 constant fixed bin(17,0) initial array dcl 146 ref 600 option_num parameter fixed bin(17,0) dcl 597 ref 594 600 position_index 24 based fixed bin(35,0) level 2 dcl 2-15 set ref 472* print_train 7 based fixed bin(17,0) level 2 in structure "printer_info" dcl 4-17 in procedure "ar" set ref 498* 700* print_train 001054 automatic fixed bin(17,0) dcl 120 in procedure "ar" set ref 249* 498 804* printer_info based structure level 1 dcl 4-17 printer_info_ptr 001130 automatic pointer dcl 4-15 set ref 496* 498 499 699* 700 701 703 qualifiers 7 based fixed bin(35,0) array level 2 dcl 1-17 set ref 243* rcp_$assign_device 000060 constant entry external dcl 181 ref 334 rcp_$check_assign 000062 constant entry external dcl 181 ref 353 rcp_$unassign 000064 constant entry external dcl 181 ref 410 532 rcp_id 000130 automatic bit(36) array level 2 dcl 89 set ref 234* 334* 353* 408* 410* 411* 532 532* resource_info_$get_dtypex 000066 constant entry external dcl 181 ref 570 speed 001055 automatic bit(3) unaligned dcl 121 in procedure "ar" set ref 248* 473 839* speed 11 based bit(36) level 2 in structure "tape_info" dcl 2-15 in procedure "ar" set ref 473* 685 speed_comment 001056 automatic varying char(30) dcl 122 set ref 683* 685* 685 688* speed_names 000037 constant varying char(4) initial array dcl 161 ref 684 685 speed_values 000045 constant fixed bin(17,0) initial array dcl 158 ref 836 838 statex 001067 automatic fixed bin(17,0) dcl 123 set ref 353* 357 substr builtin function dcl 169 set ref 460 485 627 679 685 792* 839* system_flag 3 based bit(1) level 2 in structure "device_info" dcl 1-17 in procedure "ar" set ref 452* system_flag 001070 automatic bit(1) unaligned dcl 124 in procedure "ar" set ref 219* 452 814* tape_info based structure level 1 dcl 2-15 tape_info_ptr 001124 automatic pointer dcl 2-10 set ref 466* 467 468 469 470 471 472 473 474 675* 676 679 685 tape_info_version_3 constant fixed bin(17,0) initial dcl 2-13 ref 467 temp_ecode 001071 automatic fixed bin(35,0) dcl 125 set ref 410* 412 414* 415 timer_manager_$sleep 000070 constant entry external dcl 181 ref 425 tracks 7 based fixed bin(17,0) level 2 in structure "tape_info" dcl 2-15 in procedure "ar" set ref 468* 676* tracks 001072 automatic fixed bin(17,0) dcl 126 in procedure "ar" set ref 245* 456 456* 460 468 784* unused_qualifier 12 based bit(36) level 2 dcl 2-15 set ref 474* usage_time 1 based fixed bin(17,0) level 2 dcl 1-17 set ref 239* version_num based fixed bin(17,0) level 2 in structure "device_info" dcl 1-17 in procedure "ar" set ref 238* 347* 347 version_num based fixed bin(17,0) level 2 in structure "tape_info" dcl 2-15 in procedure "ar" set ref 467* volume_name 001073 automatic char(32) unaligned dcl 127 in procedure "ar" set ref 247* 456 470 480 799* volume_name 13 based char(32) level 2 in structure "tape_info" dcl 2-15 in procedure "ar" set ref 470* volume_name 7 based char(32) level 2 in structure "disk_info" dcl 3-19 in procedure "ar" set ref 480* wait_flag 001103 automatic bit(1) unaligned dcl 128 set ref 219* 388 826* wait_time 2 based fixed bin(17,0) level 2 dcl 1-17 set ref 239* write_flag 23 based bit(1) level 2 in structure "tape_info" dcl 2-15 in procedure "ar" set ref 471* write_flag 17 based bit(1) level 2 in structure "disk_info" dcl 3-19 in procedure "ar" set ref 481* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. DISK_INFO_VERSION_1 internal static fixed bin(17,0) initial dcl 3-29 PRINTER_INFO_VERSION_1 internal static fixed bin(17,0) initial dcl 4-27 event_wait_info_ptr automatic pointer dcl 6-5 tape_info_version_2 internal static fixed bin(17,0) initial dcl 2-12 NAMES DECLARED BY EXPLICIT CONTEXT. ASSIGN_DEVICE 001203 constant entry internal dcl 328 ref 290 ASSIGN_LOOP 001327 constant label dcl 351 ref 372 BAD_ARG 004230 constant label dcl 846 set ref 780 796 821 843 CHECK_DEVICE_INFO 002047 constant entry internal dcl 442 ref 274 CLEANUP 002354 constant entry internal dcl 527 ref 278 311 DTYPE_CHECK 000004 constant label array(7) dcl 456 ref 453 DTYPE_INFO 000013 constant label array(7) dcl 673 ref 670 GET_RESOURCE_TYPE 002443 constant entry internal dcl 553 ref 266 GET_VALUE 002643 constant entry internal dcl 594 ref 743 MAIN_RETURN 001176 constant label dcl 311 ref 267 271 275 286 293 OPTION 000022 constant label array(13) dcl 754 ref 745 PRINT_DEVICE_INFO 003164 constant entry internal dcl 663 ref 306 PROCESS_ARG 003654 constant entry internal dcl 727 ref 270 STATE 000000 constant label array(0:3) dcl 360 ref 357 ar 000611 constant entry external dcl 23 assign_resource 000621 constant entry external dcl 23 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 4640 4732 4307 4650 Length 5316 4307 72 350 330 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME ar 1048 external procedure is an external procedure. on unit on line 277 64 on unit ASSIGN_DEVICE internal procedure shares stack frame of external procedure ar. CHECK_DEVICE_INFO internal procedure shares stack frame of external procedure ar. CLEANUP 86 internal procedure is called by several nonquick procedures. GET_RESOURCE_TYPE internal procedure shares stack frame of external procedure ar. GET_VALUE internal procedure shares stack frame of external procedure ar. PRINT_DEVICE_INFO internal procedure shares stack frame of external procedure ar. PROCESS_ARG internal procedure shares stack frame of external procedure ar. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME CLEANUP 000100 cleanup_code CLEANUP ar 000100 info_buffer ar 000130 alist ar 000750 event_data ar 000757 active_fnc ar 000760 af_return_arg_len ar 000762 af_return_arg_ptr ar 000764 arg_len ar 000766 arg_ptr ar 000770 argx ar 000771 badx ar 000772 comment ar 001012 density ar 001013 density_comment ar 001024 device_flag ar 001025 device_type ar 001035 dtypex ar 001036 ecode ar 001037 fixed_arg ar 001040 i ar 001041 line_length ar 001042 long_flag ar 001043 max_num_waits ar 001044 num_args ar 001045 num_assigned ar 001046 num_waits ar 001047 number ar 001050 option ar 001053 option_code ar 001054 print_train ar 001055 speed ar 001056 speed_comment ar 001067 statex ar 001070 system_flag ar 001071 temp_ecode ar 001072 tracks ar 001073 volume_name ar 001103 wait_flag ar 001112 get_argument ar 001116 error_rtn_ ar 001122 device_info_ptr ar 001124 tape_info_ptr ar 001126 disk_info_ptr ar 001130 printer_info_ptr ar 001132 event_wait_channel ar THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_var_desc call_var call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ com_err_ convert_ipc_code_ cu_$af_arg_ptr cu_$af_return_arg cu_$arg_ptr cv_dec_check_ ioa_ ipc_$block ipc_$create_ev_chn ipc_$delete_ev_chn rcp_$assign_device rcp_$check_assign rcp_$unassign resource_info_$get_dtypex timer_manager_$sleep THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$bad_arg error_table_$badopt error_table_$inconsistent error_table_$noarg error_table_$not_act_fnc error_table_$resource_reserved error_table_$resource_unavailable error_table_$wrong_no_of_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 5 8 000604 23 000610 219 000627 224 000633 229 000640 231 000642 233 000645 234 000651 235 000653 236 000655 238 000657 239 000661 241 000663 242 000666 243 000667 245 000701 246 000702 247 000703 248 000706 249 000707 253 000711 254 000726 255 000732 256 000733 257 000737 258 000742 260 000743 261 000745 262 000751 263 000754 266 000765 267 000766 269 000770 270 000777 271 001000 272 001002 274 001004 275 001005 277 001007 278 001023 279 001030 281 001031 282 001042 284 001044 285 001053 286 001102 289 001103 290 001111 291 001112 293 001113 299 001115 301 001131 304 001160 305 001167 306 001172 307 001173 310 001175 311 001176 314 001202 328 001203 331 001204 332 001205 334 001207 336 001246 338 001250 341 001255 343 001315 346 001316 347 001322 348 001324 351 001327 353 001332 354 001365 357 001414 360 001416 364 001417 366 001436 368 001440 369 001447 370 001476 372 001477 375 001500 379 001503 383 001511 385 001551 388 001552 390 001554 391 001557 393 001617 399 001620 401 001623 402 001626 403 001661 408 001662 409 001665 410 001675 411 001725 412 001730 414 001732 415 001764 417 001770 419 001772 422 002026 423 002027 425 002030 427 002045 428 002046 442 002047 445 002050 447 002055 448 002060 452 002120 453 002123 456 002125 460 002135 463 002142 464 002145 466 002174 467 002176 468 002200 469 002203 470 002206 471 002211 472 002212 473 002213 474 002216 475 002217 478 002220 480 002221 481 002225 482 002226 485 002227 489 002242 490 002245 493 002300 496 002301 498 002302 499 002305 500 002307 503 002310 508 002311 511 002320 512 002323 516 002352 527 002353 531 002361 532 002372 534 002424 536 002427 538 002431 540 002442 553 002443 556 002444 558 002447 559 002452 560 002501 563 002502 564 002520 566 002522 567 002551 570 002552 571 002602 572 002604 573 002641 575 002642 594 002643 600 002645 602 002650 606 002652 609 002657 610 002664 611 002665 614 002666 615 002671 616 002727 619 002730 620 002731 621 002745 623 002747 624 003002 627 003003 630 003012 631 003014 632 003022 633 003023 636 003024 637 003027 638 003065 641 003066 645 003072 646 003117 648 003121 649 003124 650 003162 654 003163 663 003164 665 003165 668 003215 670 003220 673 003222 675 003245 676 003247 677 003271 678 003272 679 003277 681 003344 682 003347 683 003370 684 003371 685 003377 687 003444 688 003447 689 003470 692 003471 694 003515 697 003516 699 003541 700 003543 701 003565 703 003606 704 003627 707 003630 712 003653 727 003654 730 003655 731 003671 733 003673 734 003726 737 003727 739 003734 740 003741 743 003755 744 003757 745 003762 747 003764 749 003766 750 003771 751 004026 754 004027 756 004035 757 004037 760 004040 762 004042 763 004045 764 004103 766 004104 767 004106 770 004107 772 004114 775 004115 777 004120 780 004121 784 004126 785 004127 788 004130 790 004135 792 004141 793 004144 795 004145 796 004147 799 004150 801 004155 804 004156 806 004160 809 004161 811 004163 814 004164 816 004166 819 004167 821 004171 823 004173 826 004174 828 004176 831 004205 832 004206 833 004207 836 004210 838 004215 839 004221 840 004224 842 004225 843 004227 846 004230 848 004233 851 004275 ----------------------------------------------------------- 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