COMPILATION LISTING OF SEGMENT build_resource_desc_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 08/14/86 1048.9 mst Thu 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 /****^ HISTORY COMMENTS: 13* 1) change(86-07-28,Hartogs), approve(86-07-28,MCR7463), 14* audit(86-08-06,Lippard), install(86-08-14,MR12.0-1123): 15* Make changes to disallow specifying less than 1 resource for reservation. 16* END HISTORY COMMENTS */ 17 18 build_resource_desc_: 19 proc (P_inargs, P_areap, P_cargp, P_rscp, P_cargidx, P_errmsg, P_code); 20 21 /* Written at some point or another by R.J.C. Kissel */ 22 /* Last modified 06/17/81 by C. D. Tavares to make "" as an acs_path not be 23* expanded to [wd]. */ 24 25 dcl P_inargs dim (*) char (*) varying; 26 dcl error_table_$unimplemented_version 27 fixed bin (35) external; 28 29 P_rscp = null (); 30 P_errmsg = ""; 31 P_code = error_table_$unimplemented_version; 32 return; 33 34 35 36 /* Local Variables */ 37 38 dcl DUMB_acs_path char (168); /* To pacify Tavares. */ 39 dcl acarg_idx fixed bin; /* Index into the additional control arg array. */ 40 dcl apply_defaults bit (1) aligned; /* True if defaults to be applied to resource_descriptions */ 41 dcl argument char (256) varying; 42 /* Holds arguments to be processed. */ 43 dcl array_args bit (1); /* True if the arguments are in the array, P_inargs. */ 44 dcl attr_type fixed bin; /* 0-absolute, 1-relative, 2-multiple. */ 45 dcl carg_idx fixed bin; /* Index into the resource description control arg array. */ 46 dcl cargs_given bit (1); /* True if any control arguments have been given. */ 47 dcl code fixed bin (35); /* System status code. */ 48 dcl resource_type char (32); /* Used to get primary resource type. */ 49 dcl exists bit (1); /* Indicates wheter or not the argument exists. */ 50 dcl item_idx fixed bin; /* Index into resource_descriptions items. */ 51 dcl names_given bit (1); /* True if any names of resources are given. */ 52 dcl number_given bit (1); /* True if the "-nb" control arg is specified. */ 53 dcl num_of_rscs fixed bin; /* The number of resources described by the caller. */ 54 dcl nvals fixed bin; /* Number of values to skip index. */ 55 dcl reservation bit (1); /* True if a reservation structure is needed. */ 56 57 dcl 1 rsc_info aligned like resource_descriptions.item; 58 dcl caller_area area (261129) based (P_areap); 59 60 /* Global Variables */ 61 62 dcl arg_idx fixed bin; /* Get_Next_Arg..index of arg in command line. */ 63 dcl name_stack_ptr ptr; /* Save_Name, Get_Name..storage pointer. */ 64 dcl name_tail_ptr ptr; /* Save_Name, Get_Name..storage pointer. */ 65 dcl nargs fixed bin; /* Get_Next_Arg..number of args in command line. */ 66 dcl rdp_stack_ptr ptr; /* Save_Pointer, Get_Pointer..storage pointer. */ 67 dcl rdp_tail_ptr ptr; /* Save_Pointer, Get_Pointer..storage pointer. */ 68 69 /* Global Based Variables */ 70 71 dcl 1 acargs aligned based (P_cargp), 72 2 number fixed bin, 73 2 arg (0b refer (acargs.number)), 74 3 long_name char (32), 75 3 short_name char (32), 76 3 nvals fixed bin; 77 78 dcl acarg_indicies (acargs.number) based (P_cargidx); 79 80 /* Global Constants */ 81 82 dcl C_rd_cargs (24) char (32) internal static options (constant) initial ("-acc", 83 /* 1 */ 84 "-access_class", /* 2 */ 85 "-acs_path", /* 3 */ 86 "-alloc", /* 4 */ 87 "-attr", /* 5 */ 88 "-attributes", /* 6 */ 89 "-charge_type", /* 7 */ 90 "-com", /* 8 */ 91 "-comment", /* 9 */ 92 "-crgtp", /* 10 */ 93 "-loc", /* 11 */ 94 "-location", /* 12 */ 95 "-lock", /* 13 */ 96 "-nb", /* 14 */ 97 "-number", /* 15 */ 98 "-ow", /* 16 */ 99 "-owner", /* 17 */ 100 "-pacc", /* 18 */ 101 "-pattr", /* 19 */ 102 "-potential_access_class", /* 20 */ 103 "-potential_attributes", /* 21 */ 104 "-release_lock", /* 22 */ 105 "-rll", /* 23 */ 106 "-uid" /* 24 */); 107 108 /* Include Files */ 109 110 /* --------------- BEGIN include file resource_control_desc.incl.pl1 --------------- */ 1 2 1 3 /* Written by R.J.C. Kissel 3/78. */ 1 4 /* Modified 09/28/78 by C. D. Tavares */ 1 5 1 6 dcl 1 resource_descriptions based (resource_desc_ptr) aligned, 1 7 2 version_no fixed bin, /* caller must set this to resource_desc_version_1 */ 1 8 2 n_items fixed bin, /* Number of resources described by this structure. */ 1 9 2 item (Resource_count refer (resource_descriptions.n_items)) aligned, 1 10 3 type char (32), /* e.g., "tape_drive" */ 1 11 3 name char (32), /* e.g., "tapa_03" */ 1 12 3 uid bit (36), /* The resource unique id. */ 1 13 3 potential_attributes bit (72), /* resource's permissible attributes */ 1 14 3 attributes (2) bit (72), /* RCP attribute description (output) */ 1 15 3 desired_attributes (4) bit (72), /* desired attributes (input) */ 1 16 3 potential_aim_range (2) bit (72), /* Lowest and highest possible AIM bounds for resource */ 1 17 3 aim_range (2) bit (72), /* Current AIM range */ 1 18 3 owner char (32), /* e.g., "Smith.Project" */ 1 19 3 acs_path char (168), /* Access control segment pathname. */ 1 20 3 location char (168), /* String describing location in unusual cases */ 1 21 3 comment char (168), /* User-settable comment string */ 1 22 3 charge_type char (32), /* accounting identifier for this resource */ 1 23 3 rew bit (3) unaligned, /* user's effective access to resource */ 1 24 3 (usage_lock, /* This resource may not be acquired or used. */ 1 25 release_lock, /* The owner is not allowed to release the resource. */ 1 26 awaiting_clear, /* Resource awaiting manual clear */ 1 27 user_alloc) bit (1) unaligned, /* User claims volume contains useful data */ 1 28 3 pad2 bit (29) unaligned, /* Ignored field. */ 1 29 3 given aligned, /* each of these bits says the corresponding */ 1 30 /* item is significant on input */ 1 31 (4 (name, 1 32 uid, 1 33 potential_attributes, 1 34 desired_attributes, 1 35 potential_aim_range, 1 36 aim_range, 1 37 owner, 1 38 acs_path, 1 39 location, 1 40 comment, 1 41 charge_type, 1 42 usage_lock, 1 43 release_lock, 1 44 user_alloc) bit (1), 1 45 4 pad1 bit (22)) unaligned, 1 46 3 state bit (36) aligned, /* For use of resource_control_ only */ 1 47 3 status_code fixed bin (35); /* Standard system status code for this resource. */ 1 48 1 49 1 50 /* Note that the reservation description must always be used with a resource 1 51* description structure. When they are used together the two structures must 1 52* have the same number of entries, i.e. Resource_count is the same for both. */ 1 53 1 54 1 55 dcl 1 reservation_description based (resource_res_ptr) aligned, 1 56 2 version_no fixed bin, /* The version number for this structure. */ 1 57 2 reserved_for char (32), /* Group id of reserved for process. */ 1 58 2 reserved_by char (32), /* Group id of reserved by process. */ 1 59 2 reservation_id fixed bin (71), /* Reservation id of this reservation group. */ 1 60 2 group_starting_time fixed bin (71), /* Starting time for this reservation group. */ 1 61 2 asap_duration fixed bin (71), /* Duration after which as soon as possible is no longer good. */ 1 62 2 flags aligned, 1 63 (3 auto_expire bit (1), /* Should reservation expire when this process terminates. */ 1 64 3 asap bit (1), /* Make this reservation group as soon as possible. */ 1 65 3 rel bit (1), /* Times are relative/absolute. */ 1 66 3 sec bit (1)) unaligned, /* Times are in sec/microsec. */ 1 67 2 n_items fixed bin, /* Number of resources reserved in this group. */ 1 68 2 reservation_group (Resource_count refer (reservation_description.n_items)), 1 69 3 starting_time fixed bin (71), /* When this resource res. starts in the group. */ 1 70 3 duration fixed bin (71); /* Duration of this resource res. in the group. */ 1 71 1 72 dcl (resource_desc_ptr, 1 73 resource_res_ptr) pointer; 1 74 1 75 dcl (resource_desc_version_1 initial (1), 1 76 resource_res_version_1 initial (1)) internal static options (constant); 1 77 1 78 dcl Resource_count fixed bin; /* The number of resources described in the structures. */ 1 79 1 80 /* ---------------- END include file resource_control_desc.incl.pl1 ---------------- */ 110 111 112 /* External Entries */ 113 114 dcl absolute_pathname_$add_suffix 115 entry (char (*), char (*), char (*), fixed bin (35)); 116 dcl convert_authorization_$from_string_range 117 entry (bit (72) aligned dim (2), char (*), fixed bin (35)); 118 dcl cu_$arg_count_rel entry (fixed bin, ptr); 119 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr); 120 dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 121 dcl cv_rcp_attributes_$from_string 122 entry (char (*), bit (72) dim (2) aligned, char (*) varying, fixed bin (35)); 123 dcl cv_rcp_attributes_$modify_rel 124 entry (bit (72) dim (2) aligned, bit (72) dim (4) aligned, bit (72) dim (2) aligned); 125 dcl cv_rcp_attributes_$from_string_rel 126 entry (char (*), bit (72) dim (4) aligned, char (*) varying, fixed bin (35)); 127 dcl cv_rcp_attributes_$test_valid 128 entry (char (*), bit (72) dim (2) aligned, fixed bin, fixed bin (35)); 129 dcl get_group_id_ entry () returns (char (32)); 130 dcl resource_info_$defaults 131 entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); 132 dcl resource_info_$get_primary_type 133 entry (char (*), char (*), fixed bin (35)); 134 135 /* External Constants */ 136 137 dcl error_table_$badcall 138 fixed bin (35) external; 139 dcl error_table_$bad_index 140 fixed bin (35) external; 141 dcl error_table_$badopt fixed bin (35) external; 142 dcl error_table_$inconsistent 143 fixed bin (35) external; 144 dcl error_table_$rcp_attr_not_permitted 145 fixed bin (35) external; 146 dcl error_table_$rcp_bad_attributes 147 fixed bin (35) external; 148 dcl error_table_$bad_conversion 149 fixed bin (35) external; 150 dcl error_table_$noarg fixed bin (35) external; 151 152 /* Builtin Functions and Conditions */ 153 154 dcl (convert, bit, divide, fixed, hbound, lbound, length, maxlength, null, rtrim, substr, unspec) 155 builtin; 156 157 dcl (area, cleanup, conversion) 158 condition; 159 160 from_arglist: 161 entry (P_clinep, P_areap, P_cargp, P_rscp, P_apply_defaults, P_cargidx, P_errmsg, P_code); 162 163 dcl ( 164 P_clinep ptr, /* Input -- to caller's command line. */ 165 P_areap ptr, /* Input -- to caller's area. */ 166 P_cargp ptr, /* Input -- to additional control arg descriptions. */ 167 P_rscp ptr, /* Output -- to resource_descriptions structure. */ 168 P_apply_defaults bit (1) aligned, /* Input -- ON if defaults wanted in resource_descriptions */ 169 P_cargidx ptr, /* Output -- to an array of indicies for the additional cargs. */ 170 P_errmsg char (*) varying, /* Output -- descriptive error message. */ 171 P_code fixed bin (35) /* Output -- standard status code. */ 172 ) parameter; 173 174 /* 175* 176* D_E_S_C_R_I_P_T_I_O_N_ 177* 178* This subroutine takes a pointer to a command line and uses cu_$arg_ptr_rel 179* to get individual arguments. It parses the command line looking first at the 180* additional control arguments, if any are specified, and then at the control 181* arguments for a resource description. 182* Resource description control arguments and non-control arguments are used 183* to fill in a resource_descriptions structure. This structure will be allocated 184* in the caller supplied area and a pointer returned. 185* If additional control arguments are found then the index of the argument 186* in the command line is returned in the caller supplied array. An error is recognized 187* if there are not enough arguments left on the command line to supply the values 188* required by the control argument. Otherwise, these values are simply skipped 189* and parsing continues. It is the caller's responsibility to pick up and process 190* these control arguments when control is returned to him. A zero value for the 191* index means that the corresponding control argument was not found. 192* The returned error message may be used along with the error code in a call 193* to com_err_ to output a meaningful error message. 194* 195* 196* J_O_U_R_N_A_L_I_Z_A_T_I_O_N_ 197* 198* 1) Written 10/78 by R.J.C. Kissel. 199* 2) Modified 3/79 by R.J.C. Kissel to get and use the defaults in the RTDT. 200* 3) Modified 08/79 by C. D. Tavares to only apply defaults when required, not all the time. 201* 202**/ 203 204 205 206 207 208 209 210 211 212 213 214 call Initialize (); 215 apply_defaults = P_apply_defaults; 216 rdp_stack_ptr = null (); /* These are only used by the Cleanup_Handler */ 217 rdp_tail_ptr = null (); /* for this entry point. */ 218 array_args = "0"b; 219 reservation = "0"b; 220 arg_idx = 0; 221 222 call cu_$arg_count_rel (nargs, P_clinep); 223 224 on cleanup 225 call Cleanup_Handler (); 226 227 call Process_Resource_Spec (); 228 229 /* 230* 231* All the arguments have been successfully processed, now we will allocate 232* the structure that the caller wants to have filled in. We can do this because 233* now we know the number of resources it must describe. Then we will fill in 234* the information we have found. 235* Note that if the caller gave us a null area pointer then we are done and will 236* just return. 237* 238**/ 239 240 call Fill_Resource_Desc (); 241 242 P_rscp = resource_desc_ptr; 243 P_errmsg = ""; /* Everything is all right. */ 244 P_code = 0; 245 return; 246 247 reserve: 248 entry (P_inargs, P_areap, P_cargp, P_rscp, P_resp, P_cargidx, P_errmsg, P_code); 249 250 dcl P_resp ptr parameter; /* Output -- to resource reservation structure. */ 251 252 /* 253* 254* D_E_S_C_R_I_P_T_I_O_N_ 255* 256* This subroutine perfors many of the same functions as the from_arglist 257* entry point. However, the arguments are taken from an input array 258* rather than a command line. Also, this entry must build a resource 259* reservation structure, and it must handle multiple resource specifications 260* separated by the -resource_type or -rsct control argument. 261* 262* 263* J_O_U_R_N_A_L_I_Z_A_T_I_O_N_ 264* 265* 1) Written 12/78 by R.J.C. Kissel. 266* 2) Modified 3/79 by R.J.C. Kissel to get and use the defaults in the RTDT. 267* 268**/ 269 270 /* Local Variables */ 271 272 dcl rdp ptr; /* To the saved resource_descriptions structures. */ 273 dcl total_rscs fixed bin; /* Total of num_of_rscs for each resource specification. */ 274 dcl mitem_idx fixed bin; /* Item index for the master resource_description structure. */ 275 276 277 278 279 280 281 282 283 284 285 rdp_stack_ptr = null (); 286 rdp_tail_ptr = null (); 287 288 array_args = "1"b; /* The arguments are in an array. */ 289 reservation = "1"b; /* Multiple resource specifications are allowed. */ 290 arg_idx = 0; 291 total_rscs = 0; 292 293 nargs = hbound (P_inargs, 1); 294 295 call Initialize (); /* To close a small cleanup window. */ 296 apply_defaults = "0"b; 297 on cleanup 298 call Cleanup_Handler (); 299 300 /* 301* This loop processes all of the resource specifications in the resource 302* description. They are separated by the -resource_type or -rsct control 303* argument which Process_Resource_Spec recognizes. The arg_idx keeps 304* track of how far we have gotten. A pointer to the resource_descriptions 305* structure for each specification is saved for later use. 306**/ 307 308 do while (arg_idx < nargs); /* arg_idx is controlled by Process_Resource_Spec. */ 309 call Initialize (); 310 call Process_Resource_Spec (); 311 call Fill_Resource_Desc (); 312 call Save_Pointer (resource_desc_ptr); 313 total_rscs = total_rscs + num_of_rscs; 314 end; 315 316 /* 317* Now that we know everything we can allocate the final structures 318* and fill them in from the saved information. 319**/ 320 321 if P_areap ^= null () 322 then do; /* Allocate stuff for the caller. */ 323 Resource_count = total_rscs; 324 325 on area 326 goto ERROR_area; 327 allocate resource_descriptions in (caller_area) set (resource_desc_ptr); 328 allocate reservation_description in (caller_area) set (resource_res_ptr); 329 revert area; 330 331 /* Now copy the information we have gathered. */ 332 333 call Get_Pointer (rdp); 334 if rdp = null () 335 then goto ERROR_badone; /* There must be at least one at hhis point. */ 336 337 mitem_idx = 1; 338 339 do while (rdp ^= null ()); /* Loop through all saved structures. */ 340 do item_idx = 1 to rdp -> resource_descriptions.n_items; 341 resource_descriptions.item (mitem_idx) = rdp -> resource_descriptions.item (item_idx); 342 mitem_idx = mitem_idx + 1; 343 end; 344 345 free rdp -> resource_descriptions; 346 call Get_Pointer (rdp); 347 end; 348 349 /* Fill in the constant information in the two structures. */ 350 351 resource_descriptions.version_no = resource_desc_version_1; 352 reservation_description.version_no = resource_res_version_1; 353 reservation_description.reserved_for = get_group_id_ (); 354 reservation_description.reserved_by = get_group_id_ (); 355 reservation_description.reservation_id = 0b; 356 reservation_description.group_starting_time = 0b; 357 reservation_description.asap_duration = 0b; 358 reservation_description.flags.auto_expire = "1"b; 359 reservation_description.flags.asap = "0"b; 360 reservation_description.flags.rel = "0"b; 361 reservation_description.flags.sec = "0"b; 362 reservation_description.reservation_group (*).starting_time = 0b; 363 reservation_description.reservation_group (*).duration = 0b; 364 end; /* Allocate stuff for the caller. */ 365 366 else do; /* Caller wants nothing. */ 367 resource_desc_ptr = null (); 368 resource_res_ptr = null (); 369 end; 370 /* Caller wants nothing. */ 371 P_rscp = resource_desc_ptr; 372 P_resp = resource_res_ptr; 373 374 /* 375* P_errmsg has already been initialized to the null string in Initialize. We don't 376* want to set it here because it may contain some auxillary information that is 377* described in the comment in Process_Resource_Spec in the attribute processing section. 378**/ 379 380 P_code = 0; 381 return; 382 383 /* 384* 385* All error handling is done here. There is a separate label for each possible 386* error. These are in the main program so that the subroutines can make non-local 387* transfers out of the current environment and then return to the caller after 388* building the error message. 389* 390**/ 391 392 ERROR_acarg: 393 P_errmsg = "After " || rtrim (acargs.arg (acarg_idx).long_name) || "."; 394 P_code = error_table_$noarg; 395 call Cleanup_Handler (); 396 return; 397 398 ERROR_allocarg: 399 P_errmsg = argument || "not on or off."; 400 P_code = error_table_$badopt; 401 call Cleanup_Handler (); 402 return; 403 404 ERROR_area: 405 P_errmsg = "Error allocating storage necessary for program operation."; 406 P_code = error_table_$badcall; 407 call Cleanup_Handler (); 408 return; 409 410 ERROR_attr: 411 P_errmsg = "Bad attribute specification: " || argument || "."; 412 P_code = code; 413 call Cleanup_Handler (); 414 return; 415 416 ERROR_badarg: 417 P_errmsg = argument; 418 P_code = error_table_$badopt; 419 call Cleanup_Handler (); 420 return; 421 422 ERROR_badnb: 423 P_errmsg = argument; 424 P_code = error_table_$bad_conversion; 425 call Cleanup_Handler (); 426 return; 427 428 ERROR_badone: 429 P_errmsg = "From build_resource_desc_."; 430 P_code = error_table_$bad_index; 431 call Cleanup_Handler (); 432 return; 433 434 ERROR_cagiv: 435 P_errmsg = "resource name " || argument || " appears after a control argument."; 436 P_code = error_table_$badcall; 437 call Cleanup_Handler (); 438 return; 439 440 ERROR_defaults: 441 P_errmsg = "Error obtaining defaults for " || rtrim (rsc_info.type) || "."; 442 P_code = code; 443 call Cleanup_Handler (); 444 return; 445 446 ERROR_exterr: 447 P_errmsg = ""; /* Error produced by an external call, just use code. */ 448 P_code = code; 449 call Cleanup_Handler (); 450 return; 451 452 ERROR_lownb: 453 P_errmsg = "Number must be 1 or greater to be valid."; 454 P_code = error_table_$bad_conversion; 455 call Cleanup_Handler (); 456 return; 457 458 ERROR_noarg: 459 P_errmsg = "After " || argument; 460 P_code = error_table_$noarg; 461 call Cleanup_Handler (); 462 return; 463 464 ERROR_noname: 465 P_errmsg = "After -name."; 466 P_code = error_table_$noarg; 467 call Cleanup_Handler (); 468 return; 469 470 ERROR_nonb: 471 P_errmsg = "-number with explicit names."; 472 P_code = error_table_$inconsistent; 473 call Cleanup_Handler (); 474 return; 475 476 ERROR_notype: 477 P_errmsg = "A resource type must always be specified."; 478 P_code = error_table_$badcall; 479 call Cleanup_Handler (); 480 return; 481 482 ERROR_pacc: 483 P_errmsg = "Bad access bounds specification: " || argument || "."; 484 P_code = code; 485 call Cleanup_Handler (); 486 return; 487 488 ERROR_pattr: 489 P_errmsg = argument; 490 P_code = code; 491 call Cleanup_Handler (); 492 return; 493 494 ERROR_prota: 495 P_errmsg = """*"" not allowed in potential attributes."; 496 P_code = error_table_$rcp_attr_not_permitted; 497 call Cleanup_Handler (); 498 return; 499 500 ERROR_type: 501 P_errmsg = "Unrecognized resource type: " || argument || "."; 502 P_code = code; 503 call Cleanup_Handler (); 504 return; 505 506 ERROR_uid: 507 P_errmsg = argument; 508 P_code = error_table_$bad_conversion; 509 call Cleanup_Handler (); 510 return; 511 512 513 Initialize: 514 proc (); 515 516 /* 517* 518* All the local and global variables are initialized here, unless they are 519* assigned to at their first use. 520* 521**/ 522 523 argument = ""; 524 num_of_rscs = 0b; 525 names_given = "0"b; 526 number_given = "0"b; 527 cargs_given = "0"b; 528 name_stack_ptr = null (); 529 name_tail_ptr = null (); 530 resource_desc_ptr = null (); 531 resource_res_ptr = null (); 532 533 unspec (rsc_info) = "0"b; 534 535 /* 536* 537* Now we will initialize all the cahracter strings in the structure to 538* null string instead of zero bit strings. This will make the output 539* easier to read. 540* 541**/ 542 543 rsc_info.type = ""; 544 rsc_info.name = ""; 545 rsc_info.owner = ""; 546 rsc_info.acs_path = ""; 547 rsc_info.location = ""; 548 rsc_info.comment = ""; 549 rsc_info.charge_type = ""; 550 551 end Initialize; 552 553 Process_Resource_Spec: 554 proc (); 555 556 /* 557* 558* The resource type must be the first argument and must always be present. 559* volume or a device. 560* The -resource_type or -rsct control argument is optional and will 561* be ignored. 562* 563**/ 564 565 call Get_Next_Arg (argument, exists); /* Get the type. */ 566 if ^exists 567 then goto ERROR_notype; 568 569 if argument = "-resource_type" | argument = "-rsct" 570 then call Get_Next_Arg (argument, exists); 571 572 call resource_info_$get_primary_type ((argument), resource_type, code); 573 /* Check the type. */ 574 if code ^= 0 575 then goto ERROR_type; 576 577 rsc_info.type = resource_type; /* use primary type */ 578 579 /* 580* 581* Now process the rest of the arguments supplied by the caller. If there are 582* any names they must be first, before any control arguments. Anything beginning 583* with "-" unless it is preceded by "-name" or "-nm" is assumed to be a control 584* argument, anything else is assumed to be a name. A control argument is checked 585* against the additional control argument array supplied by the caller first, and then 586* against the known resource description control arguments. 587* If this is a reservation then multiple resource types may appear 588* separated by -resource_type or -rsct. Therefore, if "reservation" is 589* true and one of these control arguments is found, we return to the 590* caller because we have processed a complete resource specification. 591* Notice that "arg_idx" points to the -resource_type or -rsct argument. 592* 593**/ 594 595 call Get_Next_Arg (argument, exists); 596 597 do while (exists); /* Loop through arguments. */ 598 599 if reservation & (argument = "-resource_type" | argument = "-rsct") 600 then goto DONE; 601 602 if substr (argument, 1, 1) ^= "-" | argument = "-name" | argument = "-nm" 603 then do; /* This is a name. */ 604 if argument = "-name" | argument = "-nm" 605 then do; /* Get the real name. */ 606 call Get_Next_Arg (argument, exists); 607 if ^exists 608 then goto ERROR_noname; 609 end; /* Get the real name. */ 610 611 if cargs_given 612 then goto ERROR_cagiv; /* Any names must be before control args. */ 613 614 call Save_Name (argument); 615 616 num_of_rscs = num_of_rscs + 1; 617 names_given = "1"b; 618 end; /* This is a name. */ 619 620 else if Is_Acarg (argument, acarg_idx) 621 then do; /* Look for additional cargs before cargs. */ 622 cargs_given = "1"b; 623 acarg_indicies (acarg_idx) = arg_idx; 624 do nvals = 1 to acargs.arg (acarg_idx).nvals; 625 /* Skip over values. */ 626 call Get_Next_Arg (argument, exists); 627 if ^exists 628 then goto ERROR_acarg; /* Make sure they are there. */ 629 end; /* Skip over values. */ 630 end; /* Look for additional cargs before cargs. */ 631 632 else if Is_Carg (argument, carg_idx) 633 then do; /* This is a resource description carg. */ 634 635 if carg_idx < lbound (CARG, 1) | carg_idx > hbound (CARG, 1) 636 then goto ERROR_badone; /* Program malfunction. */ 637 638 cargs_given = "1"b; 639 640 goto CARG (carg_idx); /* Essentially a case statement. */ 641 642 CARG (2): 643 CARG (1): /* -access_class, -acc */ 644 call Get_Next_Arg (argument, exists); 645 if ^exists 646 then goto ERROR_noarg; 647 648 call convert_authorization_$from_string_range (rsc_info.aim_range, (argument), code); 649 if code ^= 0 650 then goto ERROR_pacc; 651 rsc_info.given.aim_range = "1"b; 652 goto ESAC; 653 654 CARG (3): /* -acs_path */ 655 call Get_Next_Arg (argument, exists); 656 if ^exists 657 then goto ERROR_noarg; 658 659 if argument = "" then 660 rsc_info.acs_path = ""; 661 662 else do; 663 call absolute_pathname_$add_suffix 664 ((argument), "acs", DUMB_acs_path, code); 665 if code ^= 0 666 then goto ERROR_exterr; 667 rsc_info.acs_path = DUMB_acs_path; 668 end; 669 670 rsc_info.given.acs_path = "1"b; 671 goto ESAC; 672 673 CARG (4): /* -alloc */ 674 call Get_Next_Arg (argument, exists); 675 if ^exists 676 then goto ERROR_noarg; 677 678 if argument = "on" 679 then rsc_info.user_alloc = "1"b; 680 else if argument = "off" 681 then rsc_info.user_alloc = "0"b; 682 else goto ERROR_allocarg; 683 684 rsc_info.given.user_alloc = "1"b; 685 goto ESAC; 686 687 CARG (6): 688 CARG (5): /* -attributes, -attr */ 689 call Get_Next_Arg (argument, exists); 690 if ^exists 691 then goto ERROR_noarg; 692 693 call cv_rcp_attributes_$from_string_rel ((rsc_info.type), rsc_info.desired_attributes, argument, 694 code); 695 if code ^= 0 696 then goto ERROR_attr; 697 698 rsc_info.given.desired_attributes = "1"b; 699 700 /* 701* Now we will do a kludgey thing. In order that parse_resource_desc_ can know that 702* the user specified attributes, we will set the status code for this resource to 1. 703* This is necessary because currently either names or attributes 704* are allowed but not both, and we will lose the information about what the user said 705* because setting default attributes always says that attributes were given. Finally, 706* we need to know that attributes were given in rcp_reserve_ so we can do the right thing. 707* This code can be eliminated when both names and attributes are allowed in a resource 708* type specification. 709**/ 710 711 rsc_info.status_code = 1; 712 goto ESAC; 713 714 CARG (7): 715 CARG (10): /* -charge_type, -crgtp */ 716 call Get_Next_Arg (argument, exists); 717 if ^exists 718 then goto ERROR_noarg; 719 720 rsc_info.charge_type = argument; 721 rsc_info.given.charge_type = "1"b; 722 goto ESAC; 723 724 CARG (9): 725 CARG (8): /* -comment, -com */ 726 call Get_Next_Arg (argument, exists); 727 if ^exists 728 then goto ERROR_noarg; 729 730 rsc_info.comment = argument; 731 rsc_info.given.comment = "1"b; 732 goto ESAC; 733 734 CARG (12): 735 CARG (11): /* -location, -loc */ 736 call Get_Next_Arg (argument, exists); 737 if ^exists 738 then goto ERROR_noarg; 739 740 rsc_info.location = argument; 741 rsc_info.given.location = "1"b; 742 goto ESAC; 743 744 CARG (13): /* -lock */ 745 call Get_Next_Arg (argument, exists); 746 if ^exists 747 then goto ERROR_noarg; 748 749 if argument = "on" 750 then rsc_info.usage_lock = "1"b; 751 752 else if argument = "off" 753 then rsc_info.usage_lock = "0"b; 754 755 else goto ERROR_allocarg; 756 757 rsc_info.given.usage_lock = "1"b; 758 goto ESAC; 759 760 CARG (14): 761 CARG (15): /* -number, -nb */ 762 if names_given 763 then goto ERROR_nonb; 764 765 call Get_Next_Arg (argument, exists); 766 if ^exists 767 then goto ERROR_noarg; 768 769 on conversion 770 goto ERROR_badnb; 771 if convert (num_of_rscs, argument) < 1 then goto ERROR_lownb; 772 num_of_rscs = num_of_rscs + convert (num_of_rscs, argument); 773 revert conversion; 774 775 number_given = "1"b; /* For later use. */ 776 goto ESAC; 777 778 CARG (16): 779 CARG (17): /* -owner, -ow */ 780 call Get_Next_Arg (argument, exists); 781 if ^exists 782 then goto ERROR_noarg; 783 784 rsc_info.owner = argument; 785 rsc_info.given.owner = "1"b; 786 goto ESAC; 787 788 CARG (18): 789 CARG (20): /* -potential_access_class, -pacc */ 790 call Get_Next_Arg (argument, exists); 791 if ^exists 792 then goto ERROR_noarg; 793 794 call convert_authorization_$from_string_range (rsc_info.potential_aim_range, (argument), code); 795 if code ^= 0 796 then goto ERROR_pacc; 797 rsc_info.given.potential_aim_range = "1"b; 798 goto ESAC; 799 800 CARG (19): 801 CARG (21): /* -potential_attributes, -pattr */ 802 call Get_Next_Arg (argument, exists); 803 if ^exists 804 then goto ERROR_noarg; 805 806 /* 807* 808* Convert the caller supplied attribute string, we will use rsc_info.attributes 809* as temporary storage since it has the right dimensionality. It will be cleaned 810* up later. 811* 812**/ 813 814 call cv_rcp_attributes_$from_string ((rsc_info.type), rsc_info.attributes, argument, code); 815 if code ^= 0 816 then goto ERROR_pattr; 817 /* 818* 819* Now test the second (protected attributes) string returned. If any 820* "1" bits are present then the caller specified an "*" which is not allowed for 821* potential attributes. Otherwise, we are only interested in the first (current 822* attributes) string. 823* 824* */ 825 826 if rsc_info.attributes (2) 827 then goto ERROR_prota; 828 829 /* 830* 831* Now test the attributes string to make sure it is absolute or multiple 832* since that is what a potential attribute string must be. 833* 834**/ 835 836 call cv_rcp_attributes_$test_valid ((rsc_info.type), rsc_info.attributes, attr_type, code); 837 if attr_type = 1 /* 1 is a relative attribute string. */ 838 then code = error_table_$rcp_bad_attributes; 839 840 if code ^= 0 841 then goto ERROR_pattr; 842 843 rsc_info.potential_attributes = rsc_info.attributes (1); 844 rsc_info.attributes (*) = "0"b; /* Clean up after ourselves. */ 845 rsc_info.given.potential_attributes = "1"b; 846 goto ESAC; 847 848 CARG (22): 849 CARG (23): /* -release_lock, -rll */ 850 call Get_Next_Arg (argument, exists); 851 if ^exists 852 then goto ERROR_noarg; 853 854 if argument = "on" 855 then rsc_info.release_lock = "1"b; 856 857 else if argument = "off" 858 then rsc_info.release_lock = "0"b; 859 860 else goto ERROR_allocarg; 861 862 rsc_info.given.release_lock = "1"b; 863 goto ESAC; 864 865 CARG (24): /* -uid */ 866 call Get_Next_Arg (argument, exists); 867 if ^exists 868 then goto ERROR_noarg; 869 870 rsc_info.uid = bit (fixed (cv_oct_check_ ((argument), code), 36)); 871 if code ^= 0 872 then goto ERROR_uid; 873 874 rsc_info.given.uid = "1"b; 875 goto ESAC; 876 877 ESAC: /* End of the pseudo case statement. */ 878 end; /* This is a resource description carg. */ 879 880 else goto ERROR_badarg; /* Unrecognized argument. */ 881 882 call Get_Next_Arg (argument, exists); /* Keep the loop going. */ 883 end; /* Loop through arguments. */ 884 885 /* 886* 887* Now that everything is ok make some final checks and settings. If 888* neither the number of resources no the names of any resources have been 889* specified then the default number of resources is one. Also, if any names 890* have been given then we can set the names given bit in rsc_info because 891* it must be on for each item in the resource_descriptions structure. 892* 893**/ 894 895 DONE: /* Only called if reservation = "1"b and a -resource_type or -rsct argument is found. */ 896 if ^names_given & ^number_given 897 then num_of_rscs = 1b; 898 899 rsc_info.given.name = names_given; 900 901 end Process_Resource_Spec; 902 903 Fill_Resource_Desc: 904 proc (); 905 906 if P_areap ^= null () 907 then do; /* Caller wants the structure. */ 908 Resource_count = num_of_rscs; 909 910 on area 911 goto ERROR_area; 912 allocate resource_descriptions in (caller_area) set (resource_desc_ptr); 913 revert area; 914 915 /* 916* 917* Now set the constant information and defaults in the structure. Do this by looping 918* through the structure to set up each item. If desired attributes are given, they must be applied 919* to the defaults in a special way. Potential attributes are never a relative 920* attribute string so defaults need not be used. Note that n_items is already set by the 921* allocation, and the type is set by setting the defaults. 922* 923**/ 924 925 do item_idx = lbound (resource_descriptions.item, 1) to hbound (resource_descriptions.item, 1) by 1; 926 /* Set all items to null values. */ 927 928 unspec (resource_descriptions.item (item_idx)) = "0"b; 929 930 resource_descriptions.item (item_idx).type = ""; 931 resource_descriptions.item (item_idx).name = ""; 932 resource_descriptions.item (item_idx).owner = ""; 933 resource_descriptions.item (item_idx).acs_path = ""; 934 resource_descriptions.item (item_idx).location = ""; 935 resource_descriptions.item (item_idx).comment = ""; 936 resource_descriptions.item (item_idx).charge_type = ""; 937 end; /* Set all items to null values. */ 938 939 resource_descriptions.version_no = resource_desc_version_1; 940 941 do item_idx = lbound (resource_descriptions.item, 1) to hbound (resource_descriptions.item, 1) by 1; 942 /* Fill in each item. */ 943 944 resource_descriptions.item (item_idx).type = rsc_info.type; 945 946 if rsc_info.given.uid 947 then resource_descriptions.item (item_idx).uid = rsc_info.uid; 948 949 if rsc_info.given.potential_attributes 950 then resource_descriptions.item (item_idx).potential_attributes = rsc_info.potential_attributes; 951 952 if rsc_info.given.desired_attributes 953 then do; /* Apply these specially. */ 954 955 /* Copy these for now to get them in the right form. */ 956 957 resource_descriptions.item (item_idx).attributes (1) = 958 resource_descriptions.item (item_idx).desired_attributes (1); 959 resource_descriptions.item (item_idx).attributes (2) = 960 resource_descriptions.item (item_idx).desired_attributes (2); 961 962 call cv_rcp_attributes_$modify_rel (resource_descriptions.item (item_idx).attributes (*), 963 rsc_info.desired_attributes, resource_descriptions.item (item_idx).attributes (*)); 964 965 /* Now copy the results back where they belong. */ 966 967 resource_descriptions.item (item_idx).desired_attributes (1) = 968 resource_descriptions.item (item_idx).attributes (1); 969 resource_descriptions.item (item_idx).desired_attributes (2) = 970 resource_descriptions.item (item_idx).attributes (2); 971 resource_descriptions.item (item_idx).desired_attributes (3) = "0"b; 972 resource_descriptions.item (item_idx).desired_attributes (4) = "0"b; 973 974 /* Now clean up our mess. */ 975 976 resource_descriptions.item (item_idx).attributes (*) = "0"b; 977 end; /* Apply these specially. */ 978 979 if rsc_info.given.potential_aim_range 980 then resource_descriptions.item (item_idx).potential_aim_range (*) = 981 rsc_info.potential_aim_range (*); 982 983 if rsc_info.given.aim_range 984 then resource_descriptions.item (item_idx).aim_range (*) = rsc_info.aim_range (*); 985 986 if rsc_info.given.owner 987 then resource_descriptions.item (item_idx).owner = rsc_info.owner; 988 989 if rsc_info.given.acs_path 990 then resource_descriptions.item (item_idx).acs_path = rsc_info.acs_path; 991 992 if rsc_info.given.location 993 then resource_descriptions.item (item_idx).location = rsc_info.location; 994 995 if rsc_info.given.comment 996 then resource_descriptions.item (item_idx).comment = rsc_info.comment; 997 998 if rsc_info.given.charge_type 999 then resource_descriptions.item (item_idx).charge_type = rsc_info.charge_type; 1000 1001 if rsc_info.given.usage_lock 1002 then resource_descriptions.item (item_idx).usage_lock = rsc_info.usage_lock; 1003 1004 if rsc_info.given.release_lock 1005 then resource_descriptions.item (item_idx).release_lock = rsc_info.release_lock; 1006 1007 if rsc_info.given.user_alloc 1008 then resource_descriptions.item (item_idx).user_alloc = rsc_info.user_alloc; 1009 1010 /* 1011* For now we will copy the given bits, although they really should be or'ed 1012* with the ones set by the defaults. Also, we will always set the desired 1013* attributes bit on so that rcp_reserve_ can use the defaults. 1014**/ 1015 1016 resource_descriptions.item (item_idx).given = rsc_info.given; 1017 1018 if names_given 1019 then do; /* Fill in the name. */ 1020 call Get_Name (argument, exists); 1021 if ^exists 1022 then goto ERROR_badone; 1023 1024 resource_descriptions.item (item_idx).name = argument; 1025 resource_descriptions.item (item_idx).given.name = "1"b; 1026 end; /* Fill in the name. */ 1027 1028 else resource_descriptions.item (item_idx).name = ""; 1029 1030 if apply_defaults then do; 1031 call resource_info_$defaults ((rsc_info.type), "", resource_desc_ptr, item_idx, code); 1032 if code ^= 0 1033 then goto ERROR_defaults; 1034 end; 1035 1036 end; /* Fill in each item. */ 1037 end; /* Caller wants the structure. */ 1038 1039 end Fill_Resource_Desc; 1040 1041 Get_Next_Arg: 1042 proc (P_arg, P_arg_exists); 1043 1044 dcl ( 1045 P_arg char (*) varying, /* Output -- the argument found. */ 1046 P_arg_exists bit (1) /* Output -- there was an argument to find. */ 1047 ) parameter; 1048 1049 /* 1050* 1051* D_E_S_C_R_I_P_T_I_O_N_ 1052* 1053* This internal procedure does everything necessary to obtain the next 1054* argument, either from the command line or an input array of character strings. 1055* Certain variables are declared globally in the main program which should be 1056* "own" variables for this procedure because of a deficiency in Multics PL1. 1057* 1058**/ 1059 1060 /* Local Variables */ 1061 1062 dcl based_arg char (arg_len) based (arg_ptr); 1063 dcl arg_len fixed bin; 1064 dcl arg_ptr ptr; 1065 1066 arg_idx = arg_idx + 1; /* We want the next one. */ 1067 1068 if arg_idx > nargs 1069 then do; /* No more args. */ 1070 arg_idx = arg_idx - 1; /* Always point at a good argument, or 0. */ 1071 P_arg_exists = "0"b; 1072 /* P_arg is left alone for error processing if necessary. */ 1073 end; /* No more args. */ 1074 1075 else do; /* Get the next arg. */ 1076 if reservation 1077 then do; /* Argument in array. */ 1078 P_arg = P_inargs (arg_idx); 1079 P_arg_exists = "1"b; 1080 end; /* Argument in array. */ 1081 1082 else do; /* Argument in command line. */ 1083 call cu_$arg_ptr_rel (arg_idx, arg_ptr, arg_len, code, P_clinep); 1084 if code ^= 0 1085 then goto ERROR_exterr; 1086 1087 if arg_len > maxlength (P_arg) 1088 then ; /* May want to log this sometime. */ 1089 1090 P_arg = based_arg; 1091 P_arg_exists = "1"b; 1092 end; /* Argument in command line. */ 1093 end; /* Get the next arg. */ 1094 1095 end Get_Next_Arg; 1096 1097 Save_Name: 1098 proc (P_name); 1099 1100 dcl P_name char (*) varying parameter; 1101 /* Input -- name to save. */ 1102 1103 /* 1104* 1105* D_E_S_C_R_I_P_T_I_O_N_ 1106* 1107* This internal subroutine saves character string arguments which are passed to it. 1108* It does so by allocating stroage and building a LIFO list of names. Note that 1109* name_stack_ptr and name_tail_ptr are initialized in the main program to "null". 1110* 1111**/ 1112 1113 /* Local Variables */ 1114 1115 dcl name_len fixed bin; /* Length of the name to store. */ 1116 dcl nip ptr; /* Name item pointer. */ 1117 dcl 1 name_item aligned based, 1118 2 len fixed bin, 1119 2 name char (name_len refer (name_item.len)), 1120 2 next ptr; 1121 1122 name_len = length (P_name); 1123 1124 on area 1125 goto ERROR_area; 1126 allocate name_item set (nip); 1127 revert area; 1128 1129 nip -> name_item.name = P_name; 1130 nip -> name_item.next = null (); 1131 1132 if name_stack_ptr = null () 1133 then name_stack_ptr = nip; /* Only done the first time. */ 1134 1135 if name_tail_ptr ^= null () 1136 then name_tail_ptr -> name_item.next = nip; 1137 1138 name_tail_ptr = nip; 1139 1140 end Save_Name; 1141 1142 Get_Name: 1143 proc (P_name, P_name_exists); 1144 1145 dcl ( 1146 P_name char (*) varying, /* Output -- the next name in the list. */ 1147 P_name_exists bit (1) /* Output -- whether or not there is a name. */ 1148 ) parameter; 1149 1150 /* 1151* 1152* D_E_S_C_R_I_P_T_I_O_N_ 1153* 1154* This internal subroutine gets the next name from the LIFO list built by 1155* Save_Name. It frees the list as it goes. It also sets a flag to indicate 1156* whether or not a name was found. 1157* 1158**/ 1159 1160 /* Local Variables */ 1161 1162 dcl nip ptr; /* Name item pointer. */ 1163 dcl 1 name_item aligned based, 1164 2 len fixed bin, 1165 2 name char (0b refer (name_item.len)), 1166 2 next ptr; 1167 1168 if name_stack_ptr = null () 1169 then do; 1170 P_name = ""; 1171 P_name_exists = "0"b; 1172 end; 1173 1174 else do; 1175 nip = name_stack_ptr; 1176 P_name = nip -> name_item.name; 1177 P_name_exists = "1"b; 1178 name_stack_ptr = nip -> name_item.next; 1179 free nip -> name_item; 1180 end; 1181 1182 end Get_Name; 1183 1184 Save_Pointer: 1185 proc (P_ptr); 1186 1187 dcl P_ptr ptr parameter; /* Input -- the pointer to be saved. */ 1188 1189 /* Local Variables */ 1190 1191 dcl rip ptr; 1192 dcl 1 rdp_item aligned based, 1193 2 next ptr, 1194 2 data ptr; 1195 1196 on area 1197 goto ERROR_area; 1198 allocate rdp_item set (rip); 1199 revert area; 1200 1201 rip -> rdp_item.data = P_ptr; 1202 rip -> rdp_item.next = null (); 1203 1204 if rdp_stack_ptr = null () 1205 then rdp_stack_ptr = rip; /* Only done the first time. */ 1206 1207 if rdp_tail_ptr ^= null () 1208 then rdp_tail_ptr -> rdp_item.next = rip; 1209 1210 rdp_tail_ptr = rip; 1211 1212 end Save_Pointer; 1213 1214 Get_Pointer: 1215 proc (P_ptr); 1216 1217 dcl P_ptr ptr parameter; /* Output -- the next pointer in the list. */ 1218 1219 /* Local Variables */ 1220 1221 dcl rip ptr; 1222 dcl 1 rdp_item aligned based, 1223 2 next ptr, 1224 2 data ptr; 1225 1226 if rdp_stack_ptr = null () 1227 then P_ptr = null (); 1228 1229 else do; 1230 rip = rdp_stack_ptr; 1231 P_ptr = rip -> rdp_item.data; 1232 rdp_stack_ptr = rip -> rdp_item.next; 1233 free rip -> rdp_item; 1234 end; 1235 1236 end Get_Pointer; 1237 1238 Is_Acarg: 1239 proc (P_arg, P_idx) returns (bit (1)); 1240 1241 dcl ( 1242 P_arg char (*) varying, /* Input -- argument to check. */ 1243 P_idx fixed bin /* Output -- index in caller supplied array. */ 1244 ) parameter; 1245 1246 /* 1247* 1248* D_E_S_C_R_I_P_T_I_O_N_ 1249* 1250* This internal subroutine checks th input argument against a caller 1251* supplied array of additional control argument names. The index in the caller 1252* supplied array is returned as well as an indication as to whether or not a match 1253* was found. 1254* At some time we may wany to require that the input array be alphabetical 1255* and do a binary search. 1256* 1257**/ 1258 1259 /* Local Variables */ 1260 1261 dcl idx fixed bin; 1262 dcl found bit (1); 1263 dcl num_args fixed bin; 1264 1265 if P_cargp = null | P_cargidx = null () 1266 then do; /* No array given. */ 1267 P_idx = 0; 1268 found = "0"b; 1269 end; /* No array given. */ 1270 1271 else do; /* Array given. */ 1272 num_args = P_cargp -> acargs.number; 1273 1274 do idx = 1 to num_args 1275 while (P_arg ^= P_cargp -> acargs.arg (idx).long_name 1276 & P_arg ^= P_cargp -> acargs.arg (idx).short_name); 1277 end; 1278 1279 if idx > num_args 1280 then do; /* Did not find it. */ 1281 P_idx = 0; 1282 found = "0"b; 1283 end; /* Did not find it. */ 1284 1285 else do; /* Found it. */ 1286 P_idx = idx; 1287 found = "1"b; 1288 end; /* Found it. */ 1289 end; /* Array given. */ 1290 1291 return (found); 1292 1293 end Is_Acarg; 1294 1295 Is_Carg: 1296 proc (P_arg, P_idx) returns (bit (1)); 1297 1298 dcl ( 1299 P_arg char (*) varying, /* Input -- argument to check. */ 1300 P_idx fixed bin /* Output -- index into the known cargs. */ 1301 ) parameter; 1302 1303 /* 1304* 1305* D_E_S_C_R_I_P_T_I_O_N_ 1306* 1307* This internal subroutine checks the input argument against the known list 1308* of resource description control arguments. The index in this list is returned 1309* as well as an indication of whether or not a match was found in the list. 1310* A binary search will be used so the list of control arguments must always 1311* be alphabetical. Notice that by definition of arrays, lbound, and hbound that 1312* the loop is executed at least once. 1313* 1314**/ 1315 1316 /* Local Variables */ 1317 1318 dcl lb fixed bin; /* Lower bound. */ 1319 dcl mp fixed bin; /* Midpoint. */ 1320 dcl ub fixed bin; /* Upper bound. */ 1321 1322 lb = lbound (C_rd_cargs, 1); /* Lower bound for the search. */ 1323 ub = hbound (C_rd_cargs, 1); /* Upper bound for the search. */ 1324 1325 do while (lb <= ub); 1326 mp = divide (lb + ub, 2, 17); /* Midpoint for the search. */ 1327 1328 if P_arg = C_rd_cargs (mp) 1329 then do; 1330 P_idx = mp; /* Found. */ 1331 return ("1"b); 1332 end; 1333 1334 if P_arg < C_rd_cargs (mp) 1335 then ub = mp - 1; 1336 else lb = mp + 1; 1337 end; 1338 1339 P_idx = 0; /* Not found. */ 1340 return ("0"b); 1341 1342 end Is_Carg; 1343 1344 Cleanup_Handler: 1345 proc (); 1346 1347 /* 1348* 1349* D_E_S_C_R_I_P_T_I_O_N_ 1350* 1351* This internal procedure cleans up before returning to the caller. 1352* Essentially, this just means checking for any storage which may have been 1353* allocated and freeing it if necessary. It is not called if the program 1354* terminates normally. 1355* Any error codes or conditions produced by this subroutine will either be 1356* handled immediately or ignored as appropriate. 1357* 1358**/ 1359 1360 dcl nip ptr; /* Name item pointer. */ 1361 dcl 1 name_item aligned based, 1362 2 len fixed bin, 1363 2 name char (0b refer (name_item.len)), 1364 2 next ptr; 1365 1366 dcl rip ptr; /* Rdp item pointer. */ 1367 dcl 1 rdp_item aligned based, 1368 2 next ptr, 1369 2 data ptr; 1370 1371 dcl rdp ptr; 1372 1373 1374 if resource_desc_ptr ^= null () 1375 then free resource_descriptions in (caller_area); 1376 1377 if resource_res_ptr ^= null () 1378 then free reservation_description in (caller_area); 1379 1380 do while (name_stack_ptr ^= null ()); 1381 nip = name_stack_ptr; 1382 name_stack_ptr = nip -> name_item.next; 1383 free nip -> name_item; 1384 end; 1385 1386 do while (rdp_stack_ptr ^= null ()); 1387 rip = rdp_stack_ptr; 1388 rdp_stack_ptr = rip -> rdp_item.next; 1389 rdp = rip -> rdp_item.data; 1390 if rdp ^= null () 1391 then free rdp -> resource_descriptions in (caller_area); 1392 free rip -> rdp_item; 1393 end; 1394 1395 /* Set the output parameters except for the error message and code. */ 1396 1397 if reservation 1398 then P_resp = null (); 1399 P_rscp = null (); 1400 if P_cargidx ^= null () & P_cargp ^= null () 1401 then acarg_indicies = 0b; /* An array assignment. */ 1402 1403 end Cleanup_Handler; 1404 1405 end build_resource_desc_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/14/86 1048.9 build_resource_desc_.pl1 >spec>install>1124>build_resource_desc_.pl1 110 1 02/13/79 1715.0 resource_control_desc.incl.pl1 >ldd>include>resource_control_desc.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. C_rd_cargs 000030 constant char(32) initial array unaligned dcl 82 ref 1322 1323 1328 1334 DUMB_acs_path 000100 automatic char(168) unaligned dcl 38 set ref 663* 667 P_apply_defaults parameter bit(1) dcl 163 ref 160 215 P_areap parameter pointer dcl 163 ref 18 160 247 321 327 328 906 912 1374 1377 1390 P_arg parameter varying char dcl 1298 in procedure "Is_Carg" ref 1295 1328 1334 P_arg parameter varying char dcl 1241 in procedure "Is_Acarg" ref 1238 1274 1274 P_arg parameter varying char dcl 1044 in procedure "Get_Next_Arg" set ref 1041 1078* 1087 1090* P_arg_exists parameter bit(1) unaligned dcl 1044 set ref 1041 1071* 1079* 1091* P_cargidx parameter pointer dcl 163 ref 18 160 247 623 1265 1400 1400 P_cargp parameter pointer dcl 163 ref 18 160 247 392 624 1265 1272 1274 1274 1400 1400 P_clinep parameter pointer dcl 163 set ref 160 222* 1083* P_code parameter fixed bin(35,0) dcl 163 set ref 18 31* 160 244* 247 380* 394* 400* 406* 412* 418* 424* 430* 436* 442* 448* 454* 460* 466* 472* 478* 484* 490* 496* 502* 508* P_errmsg parameter varying char dcl 163 set ref 18 30* 160 243* 247 392* 398* 404* 410* 416* 422* 428* 434* 440* 446* 452* 458* 464* 470* 476* 482* 488* 494* 500* 506* P_idx parameter fixed bin(17,0) dcl 1241 in procedure "Is_Acarg" set ref 1238 1267* 1281* 1286* P_idx parameter fixed bin(17,0) dcl 1298 in procedure "Is_Carg" set ref 1295 1330* 1339* P_inargs parameter varying char array dcl 25 ref 18 247 293 1078 P_name parameter varying char dcl 1145 in procedure "Get_Name" set ref 1142 1170* 1176* P_name parameter varying char dcl 1100 in procedure "Save_Name" ref 1097 1122 1129 P_name_exists parameter bit(1) unaligned dcl 1145 set ref 1142 1171* 1177* P_ptr parameter pointer dcl 1187 in procedure "Save_Pointer" ref 1184 1201 P_ptr parameter pointer dcl 1217 in procedure "Get_Pointer" set ref 1214 1226* 1231* P_resp parameter pointer dcl 250 set ref 247 372* 1397* P_rscp parameter pointer dcl 163 set ref 18 29* 160 242* 247 371* 1399* Resource_count 000612 automatic fixed bin(17,0) dcl 1-78 set ref 323* 327 327 328 328 908* 912 912 absolute_pathname_$add_suffix 000012 constant entry external dcl 114 ref 663 acarg_idx 000152 automatic fixed bin(17,0) dcl 39 set ref 392 620* 623 624 acarg_indicies based fixed bin(17,0) array dcl 78 set ref 623* 1400* acargs based structure level 1 dcl 71 acs_path 57 000301 automatic char(168) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 546* 659* 667* 989 acs_path 266(07) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 670* 989 acs_path 61 based char(168) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 933* 989* aim_range 266(05) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 651* 983 aim_range 45 based bit(72) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 983* aim_range 43 000301 automatic bit(72) array level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 648* 983 apply_defaults 000153 automatic bit(1) dcl 40 set ref 215* 296* 1030 area 000614 stack reference condition dcl 157 ref 325 329 910 913 1124 1127 1196 1199 arg 1 based structure array level 2 dcl 71 arg_idx 000572 automatic fixed bin(17,0) dcl 62 set ref 220* 290* 308 623 1066* 1066 1068 1070* 1070 1078 1083* arg_len 000116 automatic fixed bin(17,0) dcl 1063 set ref 1083* 1087 1090 arg_ptr 000120 automatic pointer dcl 1064 set ref 1083* 1090 argument 000154 automatic varying char(256) dcl 41 set ref 398 410 416 422 434 458 482 488 500 506 523* 565* 569 569 569* 572 595* 599 599 602 602 602 604 604 606* 614* 620* 626* 632* 642* 648 654* 659 663 673* 678 680 687* 693* 714* 720 724* 730 734* 740 744* 749 752 765* 771 772 778* 784 788* 794 800* 814* 848* 854 857 865* 870 882* 1020* 1024 array_args 000255 automatic bit(1) unaligned dcl 43 set ref 218* 288* asap 30(01) based bit(1) level 3 packed unaligned dcl 1-55 set ref 359* asap_duration 26 based fixed bin(71,0) level 2 dcl 1-55 set ref 357* attr_type 000256 automatic fixed bin(17,0) dcl 44 set ref 836* 837 attributes 25 based bit(72) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 957* 959* 962* 962* 967 969 976* attributes 23 000301 automatic bit(72) array level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 814* 826 836* 843 844* auto_expire 30 based bit(1) level 3 packed unaligned dcl 1-55 set ref 358* based_arg based char unaligned dcl 1062 ref 1090 bit builtin function dcl 154 ref 870 caller_area based area(261129) dcl 58 ref 327 328 912 1374 1377 1390 carg_idx 000257 automatic fixed bin(17,0) dcl 45 set ref 632* 635 635 640 cargs_given 000260 automatic bit(1) unaligned dcl 46 set ref 527* 611 622* 638* charge_type 266(10) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 721* 998 charge_type 255 000301 automatic char(32) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 549* 720* 998 charge_type 257 based char(32) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 936* 998* cleanup 000622 stack reference condition dcl 157 ref 224 297 code 000261 automatic fixed bin(35,0) dcl 47 set ref 412 442 448 484 490 502 572* 574 648* 649 663* 665 693* 695 794* 795 814* 815 836* 837* 840 870* 871 1031* 1032 1083* 1084 comment 203 000301 automatic char(168) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 548* 730* 995 comment 205 based char(168) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 935* 995* comment 266(09) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 731* 995 conversion 000000 stack reference condition dcl 157 ref 769 773 convert builtin function dcl 154 ref 771 772 convert_authorization_$from_string_range 000014 constant entry external dcl 116 ref 648 794 cu_$arg_count_rel 000016 constant entry external dcl 118 ref 222 cu_$arg_ptr_rel 000020 constant entry external dcl 119 ref 1083 cv_oct_check_ 000022 constant entry external dcl 120 ref 870 cv_rcp_attributes_$from_string 000024 constant entry external dcl 121 ref 814 cv_rcp_attributes_$from_string_rel 000030 constant entry external dcl 125 ref 693 cv_rcp_attributes_$modify_rel 000026 constant entry external dcl 123 ref 962 cv_rcp_attributes_$test_valid 000032 constant entry external dcl 127 ref 836 data 2 based pointer level 2 in structure "rdp_item" dcl 1367 in procedure "Cleanup_Handler" ref 1389 data 2 based pointer level 2 in structure "rdp_item" dcl 1192 in procedure "Save_Pointer" set ref 1201* data 2 based pointer level 2 in structure "rdp_item" dcl 1222 in procedure "Get_Pointer" ref 1231 desired_attributes 31 based bit(72) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 957 959 967* 969* 971* 972* desired_attributes 266(03) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 698* 952 desired_attributes 27 000301 automatic bit(72) array level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 693* 962* divide builtin function dcl 154 ref 1326 duration 34 based fixed bin(71,0) array level 3 dcl 1-55 set ref 363* error_table_$bad_conversion 000056 external static fixed bin(35,0) dcl 148 ref 424 454 508 error_table_$bad_index 000044 external static fixed bin(35,0) dcl 139 ref 430 error_table_$badcall 000042 external static fixed bin(35,0) dcl 137 ref 406 436 478 error_table_$badopt 000046 external static fixed bin(35,0) dcl 141 ref 400 418 error_table_$inconsistent 000050 external static fixed bin(35,0) dcl 142 ref 472 error_table_$noarg 000060 external static fixed bin(35,0) dcl 150 ref 394 460 466 error_table_$rcp_attr_not_permitted 000052 external static fixed bin(35,0) dcl 144 ref 496 error_table_$rcp_bad_attributes 000054 external static fixed bin(35,0) dcl 146 ref 837 error_table_$unimplemented_version 000010 external static fixed bin(35,0) dcl 26 ref 31 exists 000272 automatic bit(1) unaligned dcl 49 set ref 565* 566 569* 595* 597 606* 607 626* 627 642* 645 654* 656 673* 675 687* 690 714* 717 724* 727 734* 737 744* 746 765* 766 778* 781 788* 791 800* 803 848* 851 865* 867 882* 1020* 1021 fixed builtin function dcl 154 ref 870 flags 30 based structure level 2 dcl 1-55 found 000131 automatic bit(1) unaligned dcl 1262 set ref 1268* 1282* 1287* 1291 get_group_id_ 000034 constant entry external dcl 129 ref 353 354 given 266 000301 automatic structure level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 1016 given 270 based structure array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 1016* group_starting_time 24 based fixed bin(71,0) level 2 dcl 1-55 set ref 356* hbound builtin function dcl 154 ref 293 635 925 941 1323 idx 000130 automatic fixed bin(17,0) dcl 1261 set ref 1274* 1274 1274* 1279 1286 item 2 based structure array level 2 dcl 1-6 set ref 341* 341 925 925 928* 941 941 item_idx 000273 automatic fixed bin(17,0) dcl 50 set ref 340* 341* 925* 928 930 931 932 933 934 935 936* 941* 944 946 949 957 957 959 959 962 962 967 967 969 969 971 972 976 979 983 986 989 992 995 998 1001 1004 1007 1016 1024 1025 1028 1031* lb 000142 automatic fixed bin(17,0) dcl 1318 set ref 1322* 1325 1326 1336* lbound builtin function dcl 154 ref 635 925 941 1322 len based fixed bin(17,0) level 2 in structure "name_item" dcl 1117 in procedure "Save_Name" set ref 1126* 1129 1130 1135 len based fixed bin(17,0) level 2 in structure "name_item" dcl 1163 in procedure "Get_Name" ref 1176 1178 1179 len based fixed bin(17,0) level 2 in structure "name_item" dcl 1361 in procedure "Cleanup_Handler" ref 1382 1383 length builtin function dcl 154 ref 1122 location 131 000301 automatic char(168) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 547* 740* 992 location 266(08) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 741* 992 location 133 based char(168) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 934* 992* long_name 1 based char(32) array level 3 dcl 71 ref 392 1274 maxlength builtin function dcl 154 ref 1087 mitem_idx 000633 automatic fixed bin(17,0) dcl 274 set ref 337* 341 342* 342 mp 000143 automatic fixed bin(17,0) dcl 1319 set ref 1326* 1328 1330 1334 1334 1336 n_items 1 based fixed bin(17,0) level 2 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 327* 340 345 912* 925 941 1374 1390 n_items 31 based fixed bin(17,0) level 2 in structure "reservation_description" dcl 1-55 in procedure "build_resource_desc_" set ref 328* 362 363 1377 name 12 based char(32) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 931* 1024* 1028* name 1 based char level 2 in structure "name_item" dcl 1163 in procedure "Get_Name" ref 1176 name 266 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 899* name 270 based bit(1) array level 4 in structure "resource_descriptions" packed unaligned dcl 1-6 in procedure "build_resource_desc_" set ref 1025* name 10 000301 automatic char(32) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 544* name 1 based char level 2 in structure "name_item" dcl 1117 in procedure "Save_Name" set ref 1129* name_item based structure level 1 dcl 1117 in procedure "Save_Name" set ref 1126 name_item based structure level 1 dcl 1361 in procedure "Cleanup_Handler" ref 1383 name_item based structure level 1 dcl 1163 in procedure "Get_Name" ref 1179 name_len 000100 automatic fixed bin(17,0) dcl 1115 set ref 1122* 1126 1126 name_stack_ptr 000574 automatic pointer dcl 63 set ref 528* 1132 1132* 1168 1175 1178* 1380 1381 1382* name_tail_ptr 000576 automatic pointer dcl 64 set ref 529* 1135 1135 1138* names_given 000274 automatic bit(1) unaligned dcl 51 set ref 525* 617* 760 895 899 1018 nargs 000600 automatic fixed bin(17,0) dcl 65 set ref 222* 293* 308 1068 next based pointer level 2 in structure "rdp_item" dcl 1367 in procedure "Cleanup_Handler" ref 1388 next based pointer level 2 in structure "rdp_item" dcl 1222 in procedure "Get_Pointer" ref 1232 next based pointer level 2 in structure "name_item" dcl 1117 in procedure "Save_Name" set ref 1130* 1135* next based pointer level 2 in structure "name_item" dcl 1163 in procedure "Get_Name" ref 1178 next based pointer level 2 in structure "name_item" dcl 1361 in procedure "Cleanup_Handler" ref 1382 next based pointer level 2 in structure "rdp_item" dcl 1192 in procedure "Save_Pointer" set ref 1202* 1207* nip 000102 automatic pointer dcl 1116 in procedure "Save_Name" set ref 1126* 1129 1130 1132 1135 1138 nip 000100 automatic pointer dcl 1360 in procedure "Cleanup_Handler" set ref 1381* 1382 1383 nip 000120 automatic pointer dcl 1162 in procedure "Get_Name" set ref 1175* 1176 1178 1179 null builtin function dcl 154 ref 29 216 217 285 286 321 334 339 367 368 528 529 530 531 906 1130 1132 1135 1168 1202 1204 1207 1226 1226 1265 1265 1374 1377 1380 1386 1390 1397 1399 1400 1400 num_args 000132 automatic fixed bin(17,0) dcl 1263 set ref 1272* 1274 1279 num_of_rscs 000276 automatic fixed bin(17,0) dcl 53 set ref 313 524* 616* 616 771 772* 772 772 895* 908 number based fixed bin(17,0) level 2 dcl 71 ref 1272 1400 number_given 000275 automatic bit(1) unaligned dcl 52 set ref 526* 775* 895 nvals 21 based fixed bin(17,0) array level 3 in structure "acargs" dcl 71 in procedure "build_resource_desc_" ref 624 nvals 000277 automatic fixed bin(17,0) dcl 54 in procedure "build_resource_desc_" set ref 624* owner 51 based char(32) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 932* 986* owner 47 000301 automatic char(32) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 545* 784* 986 owner 266(06) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 785* 986 potential_aim_range 37 000301 automatic bit(72) array level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 794* 979 potential_aim_range 266(04) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 797* 979 potential_aim_range 41 based bit(72) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 979* potential_attributes 23 based bit(72) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 949* potential_attributes 21 000301 automatic bit(72) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 843* 949 potential_attributes 266(02) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 845* 949 rdp 000630 automatic pointer dcl 272 in procedure "build_resource_desc_" set ref 333* 334 339 340 341 345 346* rdp 000104 automatic pointer dcl 1371 in procedure "Cleanup_Handler" set ref 1389* 1390 1390 rdp_item based structure level 1 dcl 1222 in procedure "Get_Pointer" ref 1233 rdp_item based structure level 1 dcl 1367 in procedure "Cleanup_Handler" ref 1392 rdp_item based structure level 1 dcl 1192 in procedure "Save_Pointer" set ref 1198 rdp_stack_ptr 000602 automatic pointer dcl 66 set ref 216* 285* 1204 1204* 1226 1230 1232* 1386 1387 1388* rdp_tail_ptr 000604 automatic pointer dcl 67 set ref 217* 286* 1207 1207 1210* rel 30(02) based bit(1) level 3 packed unaligned dcl 1-55 set ref 360* release_lock 267(04) based bit(1) array level 3 in structure "resource_descriptions" packed unaligned dcl 1-6 in procedure "build_resource_desc_" set ref 1004* release_lock 265(04) 000301 automatic bit(1) level 2 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 854* 857* 1004 release_lock 266(12) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 862* 1004 reservation 000300 automatic bit(1) unaligned dcl 55 set ref 219* 289* 599 1076 1397 reservation_description based structure level 1 dcl 1-55 set ref 328 1377 reservation_group 32 based structure array level 2 dcl 1-55 reservation_id 22 based fixed bin(71,0) level 2 dcl 1-55 set ref 355* reserved_by 11 based char(32) level 2 dcl 1-55 set ref 354* reserved_for 1 based char(32) level 2 dcl 1-55 set ref 353* resource_desc_ptr 000606 automatic pointer dcl 1-72 set ref 242 312* 327* 341 351 367* 371 530* 912* 925 925 928 930 931 932 933 934 935 936 939 941 941 944 946 949 957 957 959 959 962 962 967 967 969 969 971 972 976 979 983 986 989 992 995 998 1001 1004 1007 1016 1024 1025 1028 1031* 1374 1374 resource_desc_version_1 constant fixed bin(17,0) initial dcl 1-75 ref 351 939 resource_descriptions based structure level 1 dcl 1-6 set ref 327 345 912 1374 1390 resource_info_$defaults 000036 constant entry external dcl 130 ref 1031 resource_info_$get_primary_type 000040 constant entry external dcl 132 ref 572 resource_res_ptr 000610 automatic pointer dcl 1-72 set ref 328* 352 353 354 355 356 357 358 359 360 361 362 363 368* 372 531* 1377 1377 resource_res_version_1 constant fixed bin(17,0) initial dcl 1-75 ref 352 resource_type 000262 automatic char(32) unaligned dcl 48 set ref 572* 577 rip 000662 automatic pointer dcl 1221 in procedure "Get_Pointer" set ref 1230* 1231 1232 1233 rip 000100 automatic pointer dcl 1191 in procedure "Save_Pointer" set ref 1198* 1201 1202 1204 1207 1210 rip 000102 automatic pointer dcl 1366 in procedure "Cleanup_Handler" set ref 1387* 1388 1389 1392 rsc_info 000301 automatic structure level 1 dcl 57 set ref 533* rtrim builtin function dcl 154 ref 392 440 sec 30(03) based bit(1) level 3 packed unaligned dcl 1-55 set ref 361* short_name 11 based char(32) array level 3 dcl 71 ref 1274 starting_time 32 based fixed bin(71,0) array level 3 dcl 1-55 set ref 362* status_code 270 000301 automatic fixed bin(35,0) level 2 dcl 57 set ref 711* substr builtin function dcl 154 ref 602 total_rscs 000632 automatic fixed bin(17,0) dcl 273 set ref 291* 313* 313 323 type 000301 automatic char(32) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 440 543* 577* 693 814 836 944 1031 type 2 based char(32) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 930* 944* ub 000144 automatic fixed bin(17,0) dcl 1320 set ref 1323* 1325 1326 1334* uid 22 based bit(36) array level 3 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 946* uid 20 000301 automatic bit(36) level 2 in structure "rsc_info" dcl 57 in procedure "build_resource_desc_" set ref 870* 946 uid 266(01) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 874* 946 unspec builtin function dcl 154 set ref 533* 928* usage_lock 266(11) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 757* 1001 usage_lock 265(03) 000301 automatic bit(1) level 2 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 749* 752* 1001 usage_lock 267(03) based bit(1) array level 3 in structure "resource_descriptions" packed unaligned dcl 1-6 in procedure "build_resource_desc_" set ref 1001* user_alloc 265(06) 000301 automatic bit(1) level 2 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 678* 680* 1007 user_alloc 267(06) based bit(1) array level 3 in structure "resource_descriptions" packed unaligned dcl 1-6 in procedure "build_resource_desc_" set ref 1007* user_alloc 266(13) 000301 automatic bit(1) level 3 in structure "rsc_info" packed unaligned dcl 57 in procedure "build_resource_desc_" set ref 684* 1007 version_no based fixed bin(17,0) level 2 in structure "resource_descriptions" dcl 1-6 in procedure "build_resource_desc_" set ref 351* 939* version_no based fixed bin(17,0) level 2 in structure "reservation_description" dcl 1-55 in procedure "build_resource_desc_" set ref 352* NAMES DECLARED BY EXPLICIT CONTEXT. CARG 000000 constant label array(24) dcl 642 ref 635 635 640 Cleanup_Handler 006176 constant entry internal dcl 1344 ref 224 297 395 401 407 413 419 425 431 437 443 449 455 461 467 473 479 485 491 497 503 509 DONE 004521 constant label dcl 895 ref 599 ERROR_acarg 001337 constant label dcl 392 ref 627 ERROR_allocarg 001436 constant label dcl 398 set ref 680 752 857 ERROR_area 001477 constant label dcl 404 set ref 325 910 1124 1196 ERROR_attr 001525 constant label dcl 410 ref 695 ERROR_badarg 001575 constant label dcl 416 ref 632 ERROR_badnb 001623 constant label dcl 422 ref 769 ERROR_badone 001651 constant label dcl 428 ref 334 635 1021 ERROR_cagiv 001677 constant label dcl 434 set ref 611 ERROR_defaults 001750 constant label dcl 440 ref 1032 ERROR_exterr 002031 constant label dcl 446 set ref 665 1084 ERROR_lownb 002046 constant label dcl 452 ref 771 ERROR_noarg 002074 constant label dcl 458 ref 645 656 675 690 717 727 737 746 766 781 791 803 851 867 ERROR_noname 002134 constant label dcl 464 set ref 607 ERROR_nonb 002162 constant label dcl 470 set ref 760 ERROR_notype 002210 constant label dcl 476 set ref 566 ERROR_pacc 002236 constant label dcl 482 ref 649 795 ERROR_pattr 002306 constant label dcl 488 set ref 815 840 ERROR_prota 002333 constant label dcl 494 set ref 826 ERROR_type 002361 constant label dcl 500 ref 574 ERROR_uid 002431 constant label dcl 506 ref 871 ESAC 004503 constant label dcl 877 ref 652 671 685 712 722 732 742 758 776 786 798 846 863 875 Fill_Resource_Desc 004535 constant entry internal dcl 903 ref 240 311 Get_Name 005617 constant entry internal dcl 1142 ref 1020 Get_Next_Arg 005350 constant entry internal dcl 1041 ref 565 569 595 606 626 642 654 673 687 714 724 734 744 765 778 788 800 848 865 882 Get_Pointer 005756 constant entry internal dcl 1214 ref 333 346 Initialize 002457 constant entry internal dcl 513 ref 214 295 309 Is_Acarg 006002 constant entry internal dcl 1238 ref 620 Is_Carg 006111 constant entry internal dcl 1295 ref 632 Process_Resource_Spec 002524 constant entry internal dcl 553 ref 227 310 Save_Name 005504 constant entry internal dcl 1097 ref 614 Save_Pointer 005703 constant entry internal dcl 1184 ref 312 build_resource_desc_ 000575 constant entry external dcl 18 from_arglist 000642 constant entry external dcl 160 reserve 000761 constant entry external dcl 247 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7006 7070 6360 7016 Length 7350 6360 62 244 425 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME build_resource_desc_ 455 external procedure is an external procedure. on unit on line 224 64 on unit on unit on line 297 64 on unit on unit on line 325 64 on unit Initialize internal procedure shares stack frame of external procedure build_resource_desc_. Process_Resource_Spec 341 internal procedure enables or reverts conditions. on unit on line 769 64 on unit Fill_Resource_Desc 127 internal procedure enables or reverts conditions. on unit on line 910 64 on unit Get_Next_Arg internal procedure shares stack frame of internal procedure Process_Resource_Spec. Save_Name 76 internal procedure enables or reverts conditions. on unit on line 1124 64 on unit Get_Name internal procedure shares stack frame of internal procedure Fill_Resource_Desc. Save_Pointer 72 internal procedure enables or reverts conditions. on unit on line 1196 64 on unit Get_Pointer internal procedure shares stack frame of external procedure build_resource_desc_. Is_Acarg internal procedure shares stack frame of internal procedure Process_Resource_Spec. Is_Carg internal procedure shares stack frame of internal procedure Process_Resource_Spec. Cleanup_Handler 71 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME Cleanup_Handler 000100 nip Cleanup_Handler 000102 rip Cleanup_Handler 000104 rdp Cleanup_Handler Fill_Resource_Desc 000120 nip Get_Name Process_Resource_Spec 000116 arg_len Get_Next_Arg 000120 arg_ptr Get_Next_Arg 000130 idx Is_Acarg 000131 found Is_Acarg 000132 num_args Is_Acarg 000142 lb Is_Carg 000143 mp Is_Carg 000144 ub Is_Carg Save_Name 000100 name_len Save_Name 000102 nip Save_Name Save_Pointer 000100 rip Save_Pointer build_resource_desc_ 000100 DUMB_acs_path build_resource_desc_ 000152 acarg_idx build_resource_desc_ 000153 apply_defaults build_resource_desc_ 000154 argument build_resource_desc_ 000255 array_args build_resource_desc_ 000256 attr_type build_resource_desc_ 000257 carg_idx build_resource_desc_ 000260 cargs_given build_resource_desc_ 000261 code build_resource_desc_ 000262 resource_type build_resource_desc_ 000272 exists build_resource_desc_ 000273 item_idx build_resource_desc_ 000274 names_given build_resource_desc_ 000275 number_given build_resource_desc_ 000276 num_of_rscs build_resource_desc_ 000277 nvals build_resource_desc_ 000300 reservation build_resource_desc_ 000301 rsc_info build_resource_desc_ 000572 arg_idx build_resource_desc_ 000574 name_stack_ptr build_resource_desc_ 000576 name_tail_ptr build_resource_desc_ 000600 nargs build_resource_desc_ 000602 rdp_stack_ptr build_resource_desc_ 000604 rdp_tail_ptr build_resource_desc_ 000606 resource_desc_ptr build_resource_desc_ 000610 resource_res_ptr build_resource_desc_ 000612 Resource_count build_resource_desc_ 000630 rdp build_resource_desc_ 000632 total_rscs build_resource_desc_ 000633 mitem_idx build_resource_desc_ 000662 rip Get_Pointer THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp cat_realloc_chars call_ext_out_desc call_ext_out call_int_this call_int_other_desc call_int_other return_mac tra_ext_1 enable_op shorten_stack ext_entry_desc int_entry int_entry_desc any_to_any_truncate_op_alloc_ alloc_storage op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. absolute_pathname_$add_suffix convert_authorization_$from_string_range cu_$arg_count_rel cu_$arg_ptr_rel cv_oct_check_ cv_rcp_attributes_$from_string cv_rcp_attributes_$from_string_rel cv_rcp_attributes_$modify_rel cv_rcp_attributes_$test_valid get_group_id_ resource_info_$defaults resource_info_$get_primary_type THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_conversion error_table_$bad_index error_table_$badcall error_table_$badopt error_table_$inconsistent error_table_$noarg error_table_$rcp_attr_not_permitted error_table_$rcp_bad_attributes error_table_$unimplemented_version LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000567 29 000621 30 000623 31 000630 32 000632 160 000633 214 000661 215 000662 216 000666 217 000670 218 000671 219 000672 220 000673 222 000674 224 000705 227 000727 240 000733 242 000737 243 000742 244 000750 245 000751 247 000752 285 001005 286 001007 288 001010 289 001012 290 001013 291 001014 293 001015 295 001021 296 001022 297 001023 308 001045 309 001051 310 001052 311 001056 312 001062 313 001070 314 001072 321 001073 323 001100 325 001102 327 001121 328 001134 329 001147 333 001150 334 001152 337 001156 339 001160 340 001164 341 001175 342 001211 343 001212 345 001214 346 001222 347 001224 351 001225 352 001227 353 001231 354 001244 355 001257 356 001261 357 001262 358 001263 359 001265 360 001267 361 001271 362 001273 363 001310 364 001324 367 001325 368 001327 371 001330 372 001333 380 001335 381 001336 392 001337 394 001425 395 001431 396 001435 398 001436 400 001466 401 001472 402 001476 404 001477 406 001515 407 001520 408 001524 410 001525 412 001565 413 001570 414 001574 416 001575 418 001613 419 001616 420 001622 422 001623 424 001641 425 001644 426 001650 428 001651 430 001667 431 001672 432 001676 434 001677 436 001737 437 001743 438 001747 440 001750 442 002021 443 002024 444 002030 446 002031 448 002037 449 002041 450 002045 452 002046 454 002064 455 002067 456 002073 458 002074 460 002123 461 002127 462 002133 464 002134 466 002152 467 002155 468 002161 470 002162 472 002200 473 002203 474 002207 476 002210 478 002226 479 002231 480 002235 482 002236 484 002276 485 002301 486 002305 488 002306 490 002324 491 002326 492 002332 494 002333 496 002351 497 002354 498 002360 500 002361 502 002421 503 002424 504 002430 506 002431 508 002447 509 002452 510 002456 513 002457 523 002460 524 002461 525 002462 526 002463 527 002464 528 002465 529 002467 530 002470 531 002471 533 002472 543 002475 544 002500 545 002503 546 002506 547 002511 548 002514 549 002517 551 002522 553 002523 565 002531 566 002546 569 002555 572 002604 574 002636 577 002645 595 002651 597 002665 599 002672 602 002706 604 002731 606 002735 607 002751 611 002760 614 002766 616 003000 617 003002 618 003004 620 003005 622 003030 623 003033 624 003040 626 003054 627 003070 629 003077 630 003102 632 003103 635 003132 638 003150 640 003153 642 003155 645 003172 648 003201 649 003233 651 003242 652 003245 654 003246 656 003263 659 003272 663 003304 665 003343 667 003352 670 003356 671 003360 673 003361 675 003376 678 003405 680 003416 684 003431 685 003433 687 003434 690 003451 693 003460 695 003511 698 003517 711 003522 712 003524 714 003525 717 003542 720 003551 721 003556 722 003560 724 003561 727 003576 730 003605 731 003612 732 003614 734 003615 737 003632 740 003641 741 003646 742 003650 744 003651 746 003666 749 003675 752 003706 757 003721 758 003723 760 003724 765 003732 766 003747 769 003756 771 003775 772 004014 773 004017 775 004020 776 004022 778 004023 781 004040 784 004047 785 004054 786 004056 788 004057 791 004074 794 004103 795 004135 797 004144 798 004147 800 004150 803 004165 814 004174 815 004225 826 004233 836 004241 837 004272 840 004301 843 004306 844 004311 845 004327 846 004331 848 004332 851 004347 854 004356 857 004367 862 004402 863 004404 865 004405 867 004422 870 004431 871 004471 874 004477 875 004502 882 004503 883 004520 895 004521 899 004527 901 004533 903 004534 906 004542 908 004550 910 004552 912 004571 913 004606 925 004607 928 004616 930 004624 931 004631 932 004636 933 004643 934 004647 935 004653 936 004657 937 004663 939 004665 941 004667 944 004700 946 004706 949 004715 952 004725 957 004730 959 004736 962 004742 967 004757 969 004770 971 004774 972 004777 976 005001 979 005024 983 005054 986 005104 989 005116 992 005130 995 005142 998 005154 1001 005166 1004 005200 1007 005212 1016 005224 1018 005231 1020 005234 1021 005250 1024 005257 1025 005270 1026 005273 1028 005274 1030 005300 1031 005302 1032 005336 1036 005344 1039 005347 1041 005350 1066 005361 1068 005363 1070 005366 1071 005370 1073 005375 1076 005376 1078 005400 1079 005426 1080 005432 1083 005433 1084 005453 1087 005461 1090 005464 1091 005476 1095 005502 1097 005503 1122 005517 1124 005523 1126 005542 1127 005556 1129 005557 1130 005565 1132 005575 1135 005602 1138 005615 1140 005616 1142 005617 1168 005630 1170 005635 1171 005640 1172 005644 1175 005645 1176 005647 1177 005662 1178 005666 1179 005676 1182 005701 1184 005702 1196 005710 1198 005727 1199 005733 1201 005734 1202 005740 1204 005742 1207 005747 1210 005754 1212 005755 1214 005756 1226 005760 1230 005767 1231 005771 1232 005774 1233 005777 1236 006001 1238 006002 1265 006013 1267 006025 1268 006027 1269 006030 1272 006031 1274 006034 1277 006066 1279 006070 1281 006073 1282 006075 1283 006076 1286 006077 1287 006101 1291 006103 1295 006111 1322 006122 1323 006124 1325 006126 1326 006131 1328 006134 1330 006146 1331 006150 1334 006155 1336 006162 1337 006165 1339 006166 1340 006170 1344 006175 1374 006203 1377 006216 1380 006231 1381 006237 1382 006241 1383 006252 1384 006255 1386 006256 1387 006263 1388 006265 1389 006270 1390 006273 1392 006304 1393 006306 1397 006307 1399 006314 1400 006317 1403 006343 ----------------------------------------------------------- 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