COMPILATION LISTING OF SEGMENT value_ Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 10/02/86 1513.4 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 13 /****^ HISTORY COMMENTS: 14* 1) change(86-08-18,JSLove), approve(86-08-18,MCR7518), 15* audit(86-08-18,Parisek), install(86-10-02,MR12.0-1175): 16* Changed to call match_star_name_ instead of value_match_. Value_match_ 17* was deleted when the new match_star_name_ was installed. 18* END HISTORY COMMENTS */ 19 20 21 value_: proc; 22 23 /* Written 11/17/80 by Steve Herbst */ 24 /* Fixed to catch deleted default value seg 08/81/81 Steve Herbst */ 25 /* Fixed for $set to create default seg unless -pp specified 12/01/81 Steve Herbst */ 26 /* Fixed to truncate value seg after compaction 02/01/82 Steve Herbst */ 27 /* Fixed value_$list_data_names to return word lengths 03/20/82 Steve Herbst */ 28 /* Modified: 29 March 1982 by G. Palter to garbage collect after adding/replacing values, to not release write lock in the 29* middle of deleting a push-down list of nodes, and to free the temporary segment used for garbage collection if the 30* user releases during GCing */ 31 /* Fixed value_$list to free allocated things on cleanup 05/24/82 Steve Herbst */ 32 /* Fixed value_$list to work on nonshareable value seg like exec_com uses 06/08/83 Steve Herbst */ 33 /* Fixed $get_path to notice hcs_$fs_get_path_name error 02/07/84 Steve Herbst */ 34 /* Fixed $list to return pushed values latest to earliest 07/26/84 Steve Herbst */ 35 /* Optimize var-setting to reuse old node if same length and type 02/15/85 Steve Herbst */ 36 37 38 /* The value database */ 39 40 dcl 1 seg aligned based (seg_ptr), /* value segment (shareable) */ 41 2 header, 42 3 version fixed bin, 43 3 banner bit (36), /* identifying decoration (= BANNER) */ 44 3 ht_size fixed bin, /* for later modifications */ 45 3 region_size fixed bin, /* explicit size or rest of seg */ 46 3 remote_area_ptr ptr, /* null=>use seg.node_region, alloc by addrel, salvage */ 47 3 lock bit (36), /* standard interprocess lock */ 48 3 salvaging_sw bit (1), /* ON while locked for salvage */ 49 3 change_count fixed bin (35), /* incremented by writer when data is changed */ 50 3 next_free_offset bit (18), /* for next node allocation in seg.node_region */ 51 3 trash_count fixed bin, /* number of nodes freed before salvage */ 52 3 offset_ht (0:60) bit (18), /* hash table of offsets into region */ 53 2 node_region (seg_region_size refer (seg.region_size)) fixed bin; /* to contain nodes */ 54 55 dcl 1 pp aligned based (pp_ptr), /* perprocess value database */ 56 2 version fixed bin, 57 2 banner bit (36), /* = PP_BANNER to distinguish from shareable seg */ 58 2 ht_size fixed bin, 59 2 remote_area_ptr ptr, /* non-null: points to an area for node allocation */ 60 2 pad (2) fixed bin, 61 2 ptr_ht (0:60) ptr unaligned; /* hash table of pointers */ 62 63 dcl 1 node_header aligned based, /* to be used in node structure */ 64 2 version fixed bin, 65 2 banner bit (36), /* for recognizing a node when salvaging (=BANNER) */ 66 2 next_offset bit (18), /* forward offset, for seg (shared) */ 67 2 next_ptr ptr unaligned, /* forward ptr, for pp (perprocess) */ 68 2 switches, 69 3 pp_sw bit (1) unaligned, /* ON for perprocess values */ 70 3 data_sw bit (1) unaligned, /* ON only for values set by $set_data etc. */ 71 3 push_sw bit (1) unaligned, /* ON if $push'ed on top of another value */ 72 3 pad bit (33) unaligned, 73 2 name_len fixed bin (21), /* length of variable name */ 74 2 value_len fixed bin (21); /* length of value string */ 75 76 dcl 1 node aligned based (node_ptr), /* a single name-value pair */ 77 2 header like node_header, 78 2 name char (node_name_len refer (node.name_len)) varying, 79 2 value char (node_value_len refer (node.value_len)) varying; 80 81 dcl 1 old_node_format aligned based, /* vestige from before version number */ 82 2 banner bit (36), /* for recognizing a node when salvaging (=BANNER) */ 83 2 next_offset bit (18), /* forward offset, for seg (shared) */ 84 2 next_ptr ptr unaligned, /* forward ptr, for pp (perprocess) */ 85 2 name_len fixed bin (21), /* length of variable name */ 86 2 value_len fixed bin (21), /* length of value string */ 87 2 name char (node_name_len refer (old_node_format.name_len)), 88 2 value char (node_value_len refer (old_node_format.value_len)); 89 90 91 /* Other structures */ 92 1 1 /* BEGIN value_structures.incl.pl1 */ 1 2 1 3 dcl (match_info_ptr, value_list_info_ptr) ptr; 1 4 dcl (alloc_name_count, alloc_pair_count) fixed bin; 1 5 dcl (alloc_max_name_len, alloc_chars_len) fixed bin (21); 1 6 1 7 dcl 1 match_info aligned based (match_info_ptr), 1 8 2 version fixed bin, /* = 1 */ 1 9 2 name_count fixed bin, 1 10 2 max_name_len fixed bin (21), 1 11 2 name_array (alloc_name_count refer (match_info.name_count)), 1 12 3 exclude_sw bit (1) unaligned, /* ON for -exclude, OFF for -match */ 1 13 3 regexp_sw bit (1) unaligned, /* ON for regular exp. without the //, OFF for starname */ 1 14 3 pad bit (34) unaligned, 1 15 3 name char (alloc_max_name_len refer (match_info.max_name_len)) varying; 1 16 1 17 dcl 1 value_list_info aligned based (value_list_info_ptr), 1 18 2 version fixed bin, /* = 1 */ 1 19 2 pair_count fixed bin, 1 20 2 chars_len fixed bin (21), 1 21 2 pairs (alloc_pair_count refer (value_list_info.pair_count)), 1 22 3 type_switches bit (36), /* correspond to the selection switches arg */ 1 23 3 (name_index, name_len) fixed bin (21), 1 24 3 (value_index, value_len) fixed bin (21), 1 25 2 chars char (alloc_chars_len refer (value_list_info.chars_len)); 1 26 1 27 dcl (match_info_version_1, value_list_info_version_1) fixed bin int static options (constant) init (1); 1 28 1 29 /* END OF value_structures.incl.pl1 */ 93 94 95 dcl 1 name_info aligned, /* pointer and length of variable name_info */ 96 2 ptr ptr, 97 2 len fixed bin (21); 98 99 dcl 1 value_info aligned, /* pointer and length of value string */ 100 2 ptr ptr, 101 2 len fixed bin (21), 102 2 seg_ptr ptr, /* for unlocking */ 103 2 change_count fixed bin; /* for unlocking */ 104 105 dcl 1 new_value_info aligned like value_info; /* value to be set */ 106 dcl 1 old_value_info aligned like value_info; /* to test against existing value */ 107 108 dcl 1 alloc_info aligned, /* for freeing char string copy of value arg */ 109 2 ptr ptr, 110 2 len fixed bin (21), 111 2 area_ptr ptr; 112 113 dcl 1 node_ptrs aligned, 114 2 this ptr, /* pointer to current (found) node */ 115 2 last ptr, /* pointer to previous node */ 116 2 segp ptr, /* pointer to seg or pp header */ 117 2 hash fixed bin; /* hash table index */ 118 119 dcl 1 sort_array aligned based (sort_array_ptr), /* for sorting var names for value_$list */ 120 2 count fixed bin, 121 2 name_ptr (sort_array.count) ptr unaligned; 122 123 dcl 1 sort_entry aligned based (sort_entry_ptr), 124 2 node_ptr ptr, 125 2 sort_field, 126 3 length fixed bin, /* simulate a varying string */ 127 3 name char (node.name_len) unaligned, 128 3 sequence pic"999999" unaligned, 129 2 next_entry ptr; 130 131 /* Constants */ 132 133 dcl MAX_TRASH_COUNT fixed bin int static options (constant) init (512); 134 135 dcl BANNER bit (36) int static options (constant) init ("707070707070"b3); 136 dcl PP_BANNER bit (36) int static options (constant) init ("070707070707"b3); 137 dcl HT_SIZE fixed int static options (constant) init (61); 138 dcl value_version_1 fixed bin int static options (constant) init (1); 139 dcl (PERMANENT init (0), PERPROCESS init (1)) fixed bin int static options (constant); 140 dcl (PERMANENT_SW init ("01"b), PERPROCESS_SW init ("10"b)) bit (2) int static options (constant); 141 142 dcl SUFFIX char (6) int static options (constant) init (".value"); 143 dcl SUFFIX_LEN fixed bin int static options (constant) init (6); 144 145 dcl BIT_TYPE fixed bin int static options (constant) init (19); 146 dcl CHAR_TYPE fixed bin int static options (constant) init (21); 147 dcl FIXED_BIN_TYPE fixed bin int static options (constant) init (1); 148 dcl PTR_TYPE fixed bin int static options (constant) init (13); 149 dcl VARYING_CHAR_TYPE fixed bin int static options (constant) init (22); 150 151 dcl WHITE char (2) int static options (constant) init (" "); /* SP HT */ 152 153 154 /* Static */ 155 156 dcl perprocess_seg_ptr ptr int static init (null); /* pointer to pp seg in process_dir */ 157 158 dcl default_seg_ptr ptr int static init (null); /* pointer to default value seg used by commands */ 159 160 161 /* Arguments */ 162 163 dcl (A_path, A_name) char (*); 164 dcl A_switches bit (36) aligned; 165 dcl A_create_sw bit (1); 166 dcl (A_area_ptr, A_data_ptr, A_new_data_ptr, A_old_data_ptr, A_remote_area_ptr, A_seg_ptr, A_value_ptr) ptr; 167 dcl (A_match_info_ptr, A_value_list_info_ptr) ptr; 168 dcl A_seg_type fixed bin; 169 dcl (A_data_size, A_new_data_size, A_old_data_size) fixed bin (18); 170 dcl A_region_size fixed bin (19); 171 dcl A_value_len fixed bin (21); 172 dcl A_code fixed bin (35); 173 174 175 /* Global arg info for options (variable) entries */ 176 177 dcl options_var_sw bit (1) aligned; 178 dcl arg_list_ptr ptr; 179 dcl (code_arg_index, old_value_arg_index) fixed bin; 180 181 182 /* Based */ 183 184 dcl char8 char (8) based; 185 dcl name_string char (name_info.len) based (name_info.ptr); 186 dcl value_string char (value_info.len) based (value_info.ptr); 187 dcl new_value_string char (new_value_info.len) based (new_value_info.ptr); 188 dcl old_value_string char (old_value_info.len) based (old_value_info.ptr); 189 dcl alloc_string char (alloc_info.len) based (alloc_info.ptr); 190 191 dcl based_area area based; 192 193 dcl bits bit (99 /* indefinite */) aligned based; /* for copying data */ 194 195 dcl 1 seg_mode_bits unaligned based (addr (seg_mode)), 196 2 pad bit (32) unaligned, 197 2 (R_BIT, E_BIT, W_BIT, pad1) bit (1) unaligned; 198 199 200 /* Automatic */ 201 202 dcl (dn, path) char (168); 203 dcl en char (32); 204 205 dcl number_picture picture"999999"; 206 207 dcl switches bit (36); 208 dcl pp_sw_arg bit (1) defined (switches) position (1); 209 dcl seg_sw_arg bit (1) defined (switches) position (2); 210 211 dcl node_offset bit (18); 212 dcl (alloc_entrypoint_sw, function_entrypoint_sw, pop_sw, push_sw, set_entrypoint_sw) bit (1) aligned init ("0"b); 213 dcl (data_entrypoint_sw, found_one_sw, local_pp_sw, locked_sw, test_entrypoint_sw) bit (1) aligned; 214 215 dcl (area_ptr, new_node_ptr, node_ptr, old_node_ptr, pp_ptr, seg_ptr) ptr; 216 dcl (sort_array_ptr, sort_entries_ptr, sort_entry_ptr, where_ptr) ptr; 217 218 dcl seg_mode fixed bin (5); 219 dcl (begin_change_count, i, saved_sort_count, sequential_number, sort_field_offset) fixed bin; 220 dcl (chars_index, node_name_len, node_value_len, saved_chars_len) fixed bin (21); 221 dcl (code, seg_code) fixed bin (35); 222 223 dcl error_table_$action_not_performed fixed bin (35) ext; 224 dcl error_table_$bad_conversion fixed bin (35) ext; 225 dcl error_table_$badcall fixed bin (35) ext; 226 dcl error_table_$boundviol fixed bin (35) ext; 227 dcl error_table_$invalid_lock_reset fixed bin (35) ext; 228 dcl error_table_$locked_by_this_process fixed bin (35) ext; 229 dcl error_table_$lower_ring fixed bin (35) ext; 230 dcl error_table_$noalloc fixed bin (35) ext; 231 dcl error_table_$noentry fixed bin (35) ext; 232 dcl error_table_$nomatch fixed bin (35) ext; 233 dcl error_table_$oldnamerr fixed bin (35) ext; 234 dcl error_table_$no_r_permission fixed bin (35) ext; 235 dcl error_table_$no_w_permission fixed bin (35) ext; 236 dcl error_table_$not_seg_type fixed bin (35) ext; 237 dcl error_table_$out_of_sequence fixed bin (35) ext; 238 239 dcl sys_info$max_seg_size fixed bin (24) ext; 240 241 dcl assign_ entry (ptr, fixed bin, fixed bin (21), ptr, fixed bin, fixed bin (21)); 242 dcl cu_$arg_list_ptr entry returns (ptr); 243 dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr); 244 dcl decode_descriptor_ entry (ptr, fixed bin, fixed bin, bit (1) aligned, fixed bin, fixed bin, fixed bin); 245 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 246 dcl get_system_free_area_ entry returns (ptr); 247 dcl get_temp_segment_ entry (char (*), ptr, fixed (35)); 248 dcl hcs_$fs_get_mode entry (ptr, fixed bin (5), fixed bin (35)); 249 dcl hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); 250 dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); 251 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 252 dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); 253 dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); 254 dcl hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)); 255 dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); 256 dcl pathname_ entry (char (*), char (*)) returns (char (168)); 257 dcl release_temp_segment_ entry (char (*), ptr, fixed (35)); 258 dcl search_file_ entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (21), fixed bin (21), 259 fixed bin (21), fixed bin (21), fixed bin (35)); 260 dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); 261 dcl set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); 262 dcl sort_items_$varying_char entry (ptr); 263 dcl user_info_ entry options (variable); 264 dcl user_info_$homedir entry (char (*)); 265 266 dcl (addr, addrel, baseno, bit, currentsize, divide, fixed) builtin; 267 dcl (length, mod, null, pointer, rel, rtrim, substr, unspec, wordno) builtin; 268 269 dcl (any_other, area, cleanup, conversion, no_write_permission, not_in_write_bracket, sub_error) condition; 270 271 defined: entry (A_seg_ptr, A_switches, A_name, A_code) returns (bit (1) aligned); 272 273 data_entrypoint_sw, options_var_sw = "0"b; 274 275 function_entrypoint_sw = "1"b; 276 277 call copy_args; 278 279 A_code = 0; 280 281 call get_ptrs (seg_ptr, pp_ptr); 282 283 if find (pp_ptr, seg_ptr, name_info, value_info, node_ptrs) then return ("1"b); 284 285 else return ("0"b); 286 287 delete: entry (A_seg_ptr, A_switches, A_name, A_code); 288 289 data_entrypoint_sw, options_var_sw = "0"b; 290 A_code = 0; 291 292 call copy_args; 293 294 call get_ptrs (seg_ptr, pp_ptr); 295 296 call lock_for_write (seg_ptr); 297 298 on cleanup call unlock_for_write (seg_ptr); 299 300 found_one_sw = "0"b; 301 DELETE: 302 if find (pp_ptr, seg_ptr, name_info, value_info, node_ptrs) then do; 303 304 found_one_sw = "1"b; 305 push_sw = node_ptrs.this -> node.push_sw; 306 307 call delete_node (node_ptrs); 308 309 if push_sw then go to DELETE; /* delete all pushed values and the original */ 310 end; 311 312 else if ^found_one_sw then A_code = error_table_$oldnamerr; 313 314 call unlock_for_write (seg_ptr); 315 316 return; 317 318 delete_data: entry (A_seg_ptr, A_switches, A_name, A_code); 319 320 options_var_sw = "0"b; 321 data_entrypoint_sw = "1"b; 322 A_code = 0; 323 324 call copy_args; 325 326 call get_ptrs (seg_ptr, pp_ptr); 327 328 call lock_for_write (seg_ptr); 329 330 on cleanup call unlock_for_write (seg_ptr); 331 332 found_one_sw = "0"b; 333 go to DELETE; 334 335 get: entry options (variable); 336 337 /* call value_$get (seg_ptr, switches, name, value_arg, code); */ 338 339 options_var_sw = "1"b; 340 code_arg_index = 5; /* global; used by return_code */ 341 arg_list_ptr = cu_$arg_list_ptr (); 342 343 call get_options_var_args (arg_list_ptr); 344 345 data_entrypoint_sw = "0"b; 346 347 GET: call get_ptrs (seg_ptr, pp_ptr); 348 349 if find (pp_ptr, seg_ptr, name_info, value_info, node_ptrs) then do; 350 351 FOUND1: call set_value_arg (arg_list_ptr, 4, value_info); /* return the value */ 352 353 if value_info.seg_ptr ^= null then /* unlock for read */ 354 if value_info.seg_ptr -> seg.change_count ^= value_info.change_count then do; 355 356 if find_in (value_info.seg_ptr, name_info, value_info, node_ptrs) then go to FOUND1; /* retry */ 357 358 else go to NOT_FOUND1; 359 end; 360 361 call return_code (0); /* zero status code */ 362 end; 363 else 364 NOT_FOUND1: call return_code (error_table_$oldnamerr); 365 366 RETURN: 367 if function_entrypoint_sw then return ("0"b); /* value_$defined */ 368 else return; 369 370 get_alloc: entry (A_seg_ptr, A_switches, A_name, A_area_ptr, A_value_ptr, A_value_len, A_code); 371 372 alloc_entrypoint_sw = "1"b; 373 data_entrypoint_sw = "0"b; 374 go to GET_DATA; 375 376 get_data: entry (A_seg_ptr, A_switches, A_name, A_area_ptr, A_data_ptr, A_data_size, A_code); 377 378 data_entrypoint_sw = "1"b; 379 GET_DATA: 380 options_var_sw = "0"b; 381 382 if A_area_ptr = null then call return_code (error_table_$noalloc); 383 384 call copy_args; 385 386 go to GET; 387 388 get_path: entry (A_path, A_code); 389 390 A_code = 0; 391 392 options_var_sw = "0"b; 393 394 if default_seg_ptr ^= null then 395 call hcs_$fs_get_path_name (default_seg_ptr, dn, 0, en, A_code); 396 397 else call get_default_path (dn, en); 398 399 if A_code = 0 then A_path = pathname_ (dn, en); 400 401 call return_code (A_code); 402 403 init_seg: entry (A_seg_ptr, A_seg_type, A_remote_area_ptr, A_region_size, A_code); 404 405 /* See if already initiated */ 406 407 options_var_sw = "0"b; 408 409 if A_seg_ptr -> seg.banner = BANNER then 410 if A_seg_type ^= PERMANENT then call return_code (error_table_$not_seg_type); 411 else if A_remote_area_ptr ^= null then call return_code (error_table_$out_of_sequence); 412 else call return_code (0); 413 else if A_seg_ptr -> pp.banner = PP_BANNER then 414 if A_seg_type ^= PERPROCESS then call return_code (error_table_$not_seg_type); 415 else if A_remote_area_ptr ^= null then call return_code (error_table_$out_of_sequence); 416 else call return_code (0); 417 418 call init_seg (A_seg_ptr); 419 420 if A_seg_type = PERPROCESS then do; 421 A_seg_ptr -> pp.banner = PP_BANNER; 422 do i = 0 to A_seg_ptr -> pp.ht_size - 1; /* fill hash table with null ptrs */ 423 A_seg_ptr -> pp.ptr_ht (i) = null; 424 end; 425 if A_remote_area_ptr ^= null then 426 A_seg_ptr -> pp.remote_area_ptr = A_remote_area_ptr; 427 else A_seg_ptr -> pp.remote_area_ptr = get_system_free_area_ (); 428 end; 429 430 else do; 431 A_seg_ptr -> seg.banner = BANNER; /* shareable seg */ 432 unspec (A_seg_ptr -> seg.offset_ht) = "0"b; 433 if A_region_size > 0 then A_seg_ptr -> seg.region_size = A_region_size; 434 end; 435 436 call return_code (0); 437 438 list: entry (A_seg_ptr, A_switches, A_match_info_ptr, A_area_ptr, A_value_list_info_ptr, A_code); 439 440 /* Using A_match_info_ptr->match_info to select, returns names/values for matching variables */ 441 442 data_entrypoint_sw = "0"b; 443 LIST: 444 options_var_sw = "0"b; 445 446 A_code = 0; 447 seg_ptr = A_seg_ptr; 448 switches = A_switches; 449 match_info_ptr = A_match_info_ptr; 450 area_ptr = A_area_ptr; 451 if area_ptr = null then area_ptr = get_system_free_area_ (); 452 453 call get_ptrs (seg_ptr, pp_ptr); 454 455 sort_entries_ptr, sort_array_ptr, value_list_info_ptr = null; 456 457 on cleanup call list_cleanup; 458 459 call get_temp_segment_ ("value_$list", sort_array_ptr, code); 460 call get_temp_segment_ ("value_$list", sort_entries_ptr, code); 461 462 sort_entry_ptr = sort_entries_ptr; 463 sort_field_offset = wordno (addr (sort_entry)) - wordno (addr (sort_entry.sort_field)); 464 sort_array.count, alloc_chars_len, sequential_number = 0; 465 466 if pp_ptr ^= null then do; /* search perprocess values */ 467 468 call list_pp (pp_ptr); 469 end; 470 471 if seg_ptr ^= null then 472 473 if seg_ptr -> seg.banner = PP_BANNER then call list_pp (seg_ptr); 474 /* a private nonshareable value seg, as for exec_com */ 475 476 else do; /* a real value seg */ 477 478 saved_chars_len = alloc_chars_len; /* in case we have to retry */ 479 saved_sort_count = sort_array.count; 480 SEARCH_SEG: 481 call lock_for_read (seg_ptr, begin_change_count); 482 483 do node_ptrs.hash = 0 to seg.ht_size - 1; 484 if seg.offset_ht (node_ptrs.hash) ^= "0"b then do; 485 486 node_ptrs.this = pointer (seg_ptr, seg.offset_ht (node_ptrs.hash)); 487 node_ptrs.last = null; 488 489 do while (node_ptrs.this ^= null); 490 491 if node_ptrs.this -> old_node_format.banner = BANNER then do; /* COMPATIBILITY */ 492 493 old_node_ptr = node_ptrs.this; 494 495 node_ptrs.this = add_node (seg_ptr, node_ptrs.this -> old_node_format.name_len, 496 node_ptrs.this -> old_node_format.value_len, node_ptrs); 497 498 call copy_old_format_node (old_node_ptr, node_ptrs.this); 499 end; 500 501 if node_ptrs.this -> node.data_sw = data_entrypoint_sw then 502 503 call match_one (node_ptrs.this); 504 505 node_ptrs.last = node_ptrs.this; 506 node_offset = node_ptrs.this -> node.next_offset; 507 if node_offset = "0"b then node_ptrs.this = null; 508 else node_ptrs.this = pointer (seg_ptr, node_offset); 509 end; 510 end; 511 end; 512 513 if seg.change_count ^= begin_change_count then do; /* changed while listing */ 514 alloc_chars_len = saved_chars_len; 515 sort_array.count = saved_sort_count; 516 go to SEARCH_SEG; /* retry the seg */ 517 end; 518 end; 519 520 if sort_array.count = 0 then do; 521 A_code = error_table_$nomatch; 522 go to LIST_RETURN; 523 end; 524 525 /* Sort the found var names alphabetically */ 526 527 call sort_items_$varying_char (sort_array_ptr); 528 529 alloc_pair_count = sort_array.count; 530 531 allocate value_list_info in (area_ptr -> based_area) set (value_list_info_ptr); 532 533 value_list_info.version = value_list_info_version_1; 534 chars_index = 1; 535 536 do i = 1 to value_list_info.pair_count; 537 538 sort_entry_ptr = addrel (sort_array.name_ptr (i), sort_field_offset); 539 /* sort_array.name(i) is addr of sort_entry.sort_field */ 540 node_ptr = sort_entry.node_ptr; 541 542 if node_ptr -> node.pp_sw then value_list_info.type_switches (i) = PERPROCESS_SW; 543 else value_list_info.type_switches (i) = PERMANENT_SW; 544 value_list_info.name_index (i) = chars_index; 545 value_list_info.name_len (i) = node_ptr -> node.name_len; 546 substr (value_list_info.chars, chars_index, value_list_info.name_len (i)) = node_ptr -> node.name; 547 chars_index = chars_index + value_list_info.name_len (i); 548 549 if data_entrypoint_sw then do; /* return word length only for data entry */ 550 value_list_info.value_index (i) = 0; 551 value_list_info.value_len (i) = divide (node_ptr -> node.value_len + 3, 4, 21, 0); 552 end; 553 else do; /* return char value otherwise */ 554 value_list_info.value_index (i) = chars_index; 555 value_list_info.value_len (i) = node_ptr -> node.value_len; 556 substr (value_list_info.chars, chars_index, value_list_info.value_len (i)) = node_ptr -> node.value; 557 chars_index = chars_index + value_list_info.value_len (i); 558 end; 559 end; 560 561 value_list_info.chars_len = chars_index - 1; 562 563 A_value_list_info_ptr = value_list_info_ptr; 564 A_code = 0; 565 LIST_RETURN: 566 call release_temp_segment_ ("value_$list", sort_array_ptr, code); 567 call release_temp_segment_ ("value_$list", sort_entries_ptr, code); 568 569 return; 570 571 572 573 list_cleanup: proc; 574 575 if sort_array_ptr ^= null then call release_temp_segment_ ("value_$list", sort_array_ptr, code); 576 if sort_entries_ptr ^= null then call release_temp_segment_ ("value_$list", sort_entries_ptr, code); 577 if value_list_info_ptr ^= null then free value_list_info in (area_ptr -> based_area); 578 579 end list_cleanup; 580 581 list_data_names: entry (A_seg_ptr, A_switches, A_match_info_ptr, A_area_ptr, A_value_list_info_ptr, A_code); 582 583 /* Same as value_$list, but works on data values (value_$set_data) and returns only names */ 584 585 data_entrypoint_sw = "1"b; 586 go to LIST; 587 588 pop: entry options (variable); 589 590 /* call value_$pop (seg_ptr, switches, name, old_value, code); */ 591 592 pop_sw = "1"b; 593 old_value_arg_index = 4; 594 code_arg_index = 5; 595 596 go to VALUE_SET; 597 598 push: entry options (variable); 599 600 /* call value_$push (seg_ptr, switches, name, new_value, old_value, code); */ 601 602 push_sw = "1"b; 603 old_value_arg_index = 5; 604 code_arg_index = 6; 605 606 go to VALUE_SET; 607 608 set: entry options (variable); 609 610 /* call value_$set (seg_ptr, switches, name, new_value, old_value, code); */ 611 612 seg_code = 0; 613 614 old_value_arg_index = 5; 615 code_arg_index = 6; 616 VALUE_SET: 617 options_var_sw = "1"b; 618 arg_list_ptr = cu_$arg_list_ptr (); 619 620 call get_options_var_args (arg_list_ptr); 621 622 data_entrypoint_sw, test_entrypoint_sw = "0"b; 623 624 SET: set_entrypoint_sw = "1"b; 625 626 call get_ptrs (seg_ptr, pp_ptr); 627 628 /* Pick up value to be set, convert to allocated char string */ 629 630 alloc_info.ptr = null; 631 alloc_info.area_ptr = get_system_free_area_ (); 632 633 locked_sw = "0"b; 634 635 on cleanup begin; 636 if alloc_info.ptr ^= null then 637 free alloc_info.ptr -> alloc_string in (alloc_info.area_ptr -> based_area); 638 if locked_sw then call unlock_for_write (seg_ptr); 639 end; 640 641 if data_entrypoint_sw then do; /* value_$set_data */ 642 643 if A_new_data_ptr = null then do; /* delete existing value */ 644 645 call lock_for_write (seg_ptr); 646 locked_sw = "1"b; 647 648 if find (pp_ptr, seg_ptr, name_info, value_info, node_ptrs) then 649 650 call delete_node (node_ptrs); 651 652 call unlock_for_write (seg_ptr); 653 654 call return_code (0); 655 end; 656 657 new_value_info.ptr = A_new_data_ptr; 658 new_value_info.len = A_new_data_size * 4; 659 end; 660 else if ^pop_sw then 661 call get_value_arg (arg_list_ptr, 4, new_value_info, alloc_info); /* convert from caller's type */ 662 663 call lock_for_write (seg_ptr); 664 locked_sw = "1"b; 665 666 if find (pp_ptr, seg_ptr, name_info, value_info, node_ptrs) then do; 667 668 if test_entrypoint_sw then do; /* compare old value to argument */ 669 670 if value_info.len < old_value_info.len then 671 TEST_FAIL: call return_code (error_table_$action_not_performed); 672 if old_value_info.len ^= 0 then 673 if substr (value_string, 1, old_value_info.len) ^= 674 substr (old_value_string, 1, old_value_info.len) then go to TEST_FAIL; 675 end; 676 677 else call set_value_arg (arg_list_ptr, old_value_arg_index, value_info); /* return old value */ 678 679 if pop_sw then do; /* delete current node only */ 680 681 call delete_node (node_ptrs); 682 683 go to SET_RETURN; 684 end; 685 686 where_ptr = node_ptrs.segp; 687 688 if push_sw then go to ADD_NODE; /* add before current node */ 689 690 if where_ptr ^= null then do; /* optimization: reuse old node if possible */ 691 local_pp_sw = (where_ptr -> seg.banner = PP_BANNER); 692 if node_ptrs.this -> node.value_len = new_value_info.len & /* reuse old node if same length and */ 693 node_ptrs.this -> node.pp_sw = local_pp_sw & /* same class (perprocess vs value seg) and */ 694 node_ptrs.this -> node.data_sw = data_entrypoint_sw then do; /* same type (data vs char) */ 695 node_ptrs.this -> node.value = new_value_string; 696 go to SET_RETURN; 697 end; 698 end; 699 end; 700 701 else do; /* no old value */ 702 703 if pop_sw then call return_code (error_table_$oldnamerr); /* no previous value */ 704 705 if test_entrypoint_sw then go to TEST_FAIL; /* test fails if no old value */ 706 707 /* No old value: first choice is to set in value segment */ 708 709 if seg_ptr ^= null then where_ptr = seg_ptr; 710 else if seg_sw_arg then call return_code (seg_code); /* return code from get_ptrs */ 711 else where_ptr = pp_ptr; 712 713 node_ptrs.this = null; /* to be sure no old node for add_node */ 714 715 value_info.ptr = where_ptr; 716 value_info.len = 0; 717 718 call set_value_arg (arg_list_ptr, old_value_arg_index, value_info); /* return zero-length string */ 719 end; 720 ADD_NODE: 721 new_node_ptr = add_node (where_ptr, name_info.len, new_value_info.len, node_ptrs); 722 723 new_node_ptr -> node.name = name_string; 724 new_node_ptr -> node.value = new_value_string; 725 726 SET_RETURN: 727 if alloc_info.ptr ^= null then 728 free alloc_info.ptr -> alloc_string in (alloc_info.area_ptr -> based_area); 729 730 if seg_ptr ^= null () then /* check if we should GC a permanent value segment */ 731 if (4 * seg.trash_count > fixed (seg.next_free_offset, 18, 0)) | (seg.trash_count > MAX_TRASH_COUNT) then 732 call compact_trash (seg_ptr); 733 734 call unlock_for_write (seg_ptr); /* IMPROVE LOCKING STRATEGY (pp?) */ 735 736 call return_code (0); 737 738 set_data: entry (A_seg_ptr, A_switches, A_name, A_new_data_ptr, A_new_data_size, 739 A_area_ptr, A_data_ptr, A_data_size, A_code); 740 741 options_var_sw = "0"b; 742 743 call copy_args; 744 745 alloc_info.ptr = null; 746 747 748 data_entrypoint_sw = "1"b; 749 test_entrypoint_sw = "0"b; 750 751 go to SET; 752 753 set_path: entry (A_path, A_create_sw, A_code); 754 755 options_var_sw = "0"b; 756 757 if A_path = "" then do; 758 call get_default_path (dn, en); 759 if dn = ">" then path = ">" || en; 760 else path = rtrim (dn) || ">" || en; 761 end; 762 else path = A_path; 763 764 call hcs_$initiate (add_suffix (path), "", "", 0, 0, seg_ptr, code); 765 if code = error_table_$noentry & A_create_sw then do; 766 call expand_pathname_ (add_suffix (path), dn, en, code); 767 if code ^= 0 then call return_code (code); 768 call hcs_$make_seg (dn, en, "", 01010b /* rw */, seg_ptr, code); 769 if seg_ptr = null then call return_code (code); 770 771 call init_seg (seg_ptr); 772 773 seg_ptr -> seg.banner = BANNER; 774 unspec (seg_ptr -> seg.offset_ht) = "0"b; 775 end; 776 777 if seg_ptr = null then call return_code (code); 778 779 on cleanup call hcs_$terminate_noname (seg_ptr, code); 780 781 call hcs_$fs_get_mode (seg_ptr, seg_mode, code); 782 if code ^= 0 then call return_code (code); /* no r: don't set */ 783 if ^addr (seg_mode) -> R_BIT then call return_code (error_table_$no_r_permission); 784 if ^addr (seg_mode) -> W_BIT then code = error_table_$no_w_permission; /* no w: set anyway but return code */ 785 786 call set_seg (seg_ptr); 787 788 call return_code (code); 789 790 test_and_set: entry options (variable); 791 792 /* call value_$test_and_set (seg_ptr, switches, name, new_value, old_value, code); */ 793 794 options_var_sw = "1"b; 795 code_arg_index = 6; 796 arg_list_ptr = cu_$arg_list_ptr (); 797 798 call get_options_var_args (arg_list_ptr); 799 800 alloc_info.ptr = null; 801 alloc_info.area_ptr = get_system_free_area_ (); 802 803 call get_value_arg (arg_list_ptr, 5, old_value_info, alloc_info); 804 805 test_entrypoint_sw = "1"b; 806 data_entrypoint_sw = "0"b; 807 808 go to SET; 809 810 test_and_set_data: entry (A_seg_ptr, A_switches, A_name, A_new_data_ptr, A_new_data_size, 811 A_old_data_ptr, A_old_data_size, A_code); 812 813 options_var_sw = "0"b; 814 815 call copy_args; 816 817 old_value_info.ptr = A_old_data_ptr; 818 old_value_info.len = A_old_data_size * 4; 819 alloc_info.ptr = null; 820 821 data_entrypoint_sw, test_entrypoint_sw = "1"b; 822 823 go to SET; 824 825 add_node: proc (P_ptr, P_name_len, P_value_len, P_node_ptrs) returns (ptr); 826 827 /* Adds a new node in place of P_node_ptrs.this -> node if any, returns ptr to new node */ 828 829 dcl P_ptr ptr; /* INPUT: ptr to segment (seg or pp) */ 830 dcl (P_name_len, P_value_len) fixed bin (21); /* INPUT: lengths for allocation */ 831 dcl 1 P_node_ptrs aligned like node_ptrs; /* INPUT: old and previous old nodes for threading */ 832 833 dcl (area_ptr, new_node_ptr) ptr; 834 dcl new_node_offset bit (18); 835 dcl next_free_word fixed bin (18); 836 837 if P_ptr -> seg.banner = PP_BANNER then do; /* perprocess-type header */ 838 839 area_ptr = P_ptr -> pp.remote_area_ptr; 840 node_name_len = P_name_len; 841 node_value_len = P_value_len; 842 843 on area call return_code (error_table_$noalloc); 844 845 allocate node in (area_ptr -> based_area) set (new_node_ptr); 846 847 new_node_ptr -> node.version = value_version_1; 848 new_node_ptr -> node.banner = BANNER; /* for the hell of it, like in seg */ 849 unspec (new_node_ptr -> node.switches) = "0"b; 850 new_node_ptr -> node.pp_sw = "1"b; 851 if data_entrypoint_sw then new_node_ptr -> node.data_sw = "1"b; 852 853 if P_ptr -> pp.ptr_ht (P_node_ptrs.hash) = P_node_ptrs.this then 854 P_ptr -> pp.ptr_ht (P_node_ptrs.hash) = null; 855 856 if P_node_ptrs.this ^= null then /* old node exists */ 857 if push_sw then do; /* inserting a new node before current one */ 858 new_node_ptr -> node.push_sw = "1"b; 859 new_node_ptr -> node.next_ptr = P_node_ptrs.this; 860 end; 861 else new_node_ptr -> node.next_ptr = P_node_ptrs.this -> node.next_ptr; /* else use its fwd thread */ 862 863 else new_node_ptr -> node.next_ptr = null; /* else end of chain */ 864 865 if P_node_ptrs.last ^= null then /* previous node in chain exists */ 866 P_node_ptrs.last -> node.next_ptr = new_node_ptr; 867 else P_ptr -> pp.ptr_ht (P_node_ptrs.hash) = new_node_ptr; /* else thread off hash table */ 868 869 if P_node_ptrs.this ^= null then 870 if push_sw then do; 871 new_node_ptr -> node.push_sw = "1"b; 872 new_node_ptr -> node.next_ptr = P_node_ptrs.this; 873 end; 874 else free P_node_ptrs.this -> node in (area_ptr -> based_area); /* else free old node */ 875 end; 876 877 else do; /* shareable seg */ 878 879 new_node_offset = P_ptr -> seg.next_free_offset; /* use next block of node_region */ 880 new_node_ptr = pointer (P_ptr, new_node_offset); 881 new_node_ptr -> node.version = value_version_1; 882 new_node_ptr -> node.banner = BANNER; /* so it's findable by salvage */ 883 unspec (new_node_ptr -> node.switches) = "0"b; 884 if data_entrypoint_sw then new_node_ptr -> node.data_sw = "1"b; 885 new_node_ptr -> node.name_len = P_name_len; 886 new_node_ptr -> node.value_len = P_value_len; 887 888 next_free_word = fixed (new_node_offset) + currentsize (new_node_ptr -> node); 889 if next_free_word >= sys_info$max_seg_size then /* past end of segment */ 890 call return_code (error_table_$boundviol); 891 P_ptr -> seg.next_free_offset = bit (next_free_word, 18); /* skip enough room for node */ 892 893 if P_node_ptrs.this ^= null then /* old node exists */ 894 if push_sw then do; /* inserting a node before current node */ 895 new_node_ptr -> node.push_sw = "1"b; 896 new_node_ptr -> node.next_offset = rel (P_node_ptrs.this); 897 end; 898 else do; /* replacing current node */ 899 if P_node_ptrs.this -> old_node_format.banner = BANNER then do; 900 new_node_ptr -> node.next_offset = P_node_ptrs.this -> old_node_format.next_offset; 901 P_ptr -> seg.trash_count = P_ptr -> seg.trash_count + 902 currentsize (P_node_ptrs.this -> old_node_format); 903 end; 904 else do; 905 new_node_ptr -> node.next_offset = P_node_ptrs.this -> node.next_offset; /* use its fwd thread */ 906 P_ptr -> seg.trash_count = P_ptr -> seg.trash_count + /* increment # of freed words */ 907 currentsize (P_node_ptrs.this -> node); /* for later compacting of segment */ 908 end; 909 end; 910 911 else new_node_ptr -> node.next_offset = "0"b; /* else end of chain */ 912 913 if P_node_ptrs.last ^= null then /* previous node in chain exists */ 914 P_node_ptrs.last -> node.next_offset = new_node_offset; 915 else P_ptr -> seg.offset_ht (P_node_ptrs.hash) = new_node_offset; /* else thread off hash table */ 916 end; 917 918 return (new_node_ptr); 919 920 end add_node; 921 922 add_suffix: proc (P_en) returns (char (*)); 923 924 /* Appends .value suffix to an entryname if not already there */ 925 926 dcl P_en char (*); /* INPUT: entryname */ 927 928 dcl entry_len fixed bin; 929 930 entry_len = length (rtrim (P_en)); 931 932 if entry_len < SUFFIX_LEN + 1 then return (rtrim (P_en) || SUFFIX); 933 else if substr (P_en, entry_len - SUFFIX_LEN + 1, SUFFIX_LEN) ^= SUFFIX then 934 return (rtrim (P_en) || SUFFIX); 935 else return (P_en); 936 937 end add_suffix; 938 939 compact_trash: proc (P_ptr); 940 941 dcl P_ptr ptr; 942 dcl (last_node_ptr, old_node_ptr, temp_node_ptr, temp_ptr) ptr; 943 dcl (next_node_offset, next_word_offset) bit (18); 944 dcl next_free_word fixed (18) unaligned unsigned; 945 dcl (i, saved_region_size) fixed; 946 947 if P_ptr -> seg.banner ^= BANNER then return; /* not shareable value seg */ 948 949 call get_temp_segment_ ("value_", temp_ptr, code); 950 if code ^= 0 then return; 951 call hcs_$truncate_seg (temp_ptr, 0, code); 952 if code ^= 0 then return; 953 954 on cleanup call release_temp_segment_ ("value_", temp_ptr, (0)); 955 956 P_ptr -> seg.salvaging_sw = "1"b; 957 958 temp_ptr -> seg.header = P_ptr -> seg.header; 959 temp_ptr -> seg.trash_count = 0; 960 temp_ptr -> seg.next_free_offset = rel (addr (P_ptr -> seg.node_region)); 961 next_word_offset = temp_ptr -> seg.next_free_offset; 962 963 do i = 0 to temp_ptr -> seg.ht_size - 1; /* for each hash table bucket */ 964 if temp_ptr -> seg.offset_ht (i) ^= "0"b then do; /* some nodes for this bucket */ 965 966 temp_ptr -> seg.offset_ht (i) = next_word_offset; 967 968 temp_node_ptr = pointer (temp_ptr, next_word_offset); 969 last_node_ptr = null; 970 971 next_node_offset = "1"b; /* dummy ^= 0 for first time through loop */ 972 973 do old_node_ptr = pointer (P_ptr, P_ptr -> seg.offset_ht (i)) 974 repeat (pointer (P_ptr, next_node_offset)) 975 while (next_node_offset ^= "0"b); 976 977 if old_node_ptr -> old_node_format.banner = BANNER then 978 979 call copy_old_format_node (old_node_ptr, temp_node_ptr); 980 981 else do; 982 temp_node_ptr -> node.name_len = old_node_ptr -> node.name_len; 983 temp_node_ptr -> node.value_len = old_node_ptr -> node.value_len; 984 temp_node_ptr -> node = old_node_ptr -> node; 985 end; 986 987 if last_node_ptr ^= null then last_node_ptr -> node.next_offset = next_word_offset; 988 989 next_free_word = fixed (next_word_offset) + currentsize (temp_node_ptr -> node); 990 next_word_offset = bit (next_free_word, 18); 991 last_node_ptr = temp_node_ptr; 992 temp_node_ptr = pointer (temp_ptr, next_word_offset); 993 994 next_node_offset = old_node_ptr -> node.next_offset; 995 end; 996 997 last_node_ptr -> node.next_offset = "0"b; /* last node in chain */ 998 end; 999 end; 1000 1001 temp_ptr -> seg.next_free_offset = next_word_offset; 1002 1003 /* Copy back to the original */ 1004 1005 saved_region_size = temp_ptr -> seg.region_size; 1006 temp_ptr -> seg.region_size, P_ptr -> seg.region_size = fixed (next_word_offset); 1007 P_ptr -> seg = temp_ptr -> seg; 1008 P_ptr -> seg.region_size = saved_region_size; 1009 1010 P_ptr -> seg.salvaging_sw = "0"b; 1011 1012 call hcs_$truncate_seg (P_ptr, fixed (next_word_offset, 19), 0); 1013 1014 call release_temp_segment_ ("value_", temp_ptr, (0)); 1015 1016 1017 end compact_trash; 1018 1019 copy_args: proc; 1020 1021 /* Copies input args for non - options(var) entrypoints */ 1022 1023 A_code = 0; 1024 1025 seg_ptr = A_seg_ptr; 1026 switches = A_switches; 1027 name_info.ptr = addr (A_name); 1028 name_info.len = length (rtrim (A_name)); 1029 1030 if name_info.len = 0 then call signal_error; 1031 1032 end copy_args; 1033 1034 copy_old_format_node: proc (P_old_ptr, P_new_ptr); 1035 1036 /* Converts an old pre-version node to the current version */ 1037 1038 dcl (P_old_ptr, P_new_ptr) ptr; 1039 1040 P_new_ptr -> node.version = value_version_1; 1041 P_new_ptr -> node.banner = P_old_ptr -> old_node_format.banner; 1042 P_new_ptr -> node.next_offset = P_old_ptr -> old_node_format.next_offset; 1043 P_new_ptr -> node.next_ptr = P_old_ptr -> old_node_format.next_ptr; 1044 unspec (P_new_ptr -> node.switches) = "0"b; 1045 P_new_ptr -> node.name_len = P_old_ptr -> old_node_format.name_len; 1046 P_new_ptr -> node.value_len = P_old_ptr -> old_node_format.value_len; 1047 P_new_ptr -> node.name = P_old_ptr -> old_node_format.name; 1048 P_new_ptr -> node.value = P_old_ptr -> old_node_format.value; 1049 1050 end copy_old_format_node; 1051 1052 delete_node: proc (P_node_ptrs); 1053 1054 /* Deletes (unthreads and frees/marks free) the node pointed to by P_node_ptrs.this */ 1055 1056 dcl 1 P_node_ptrs aligned like node_ptrs; 1057 1058 dcl pp_sw bit (1); 1059 dcl area_ptr ptr; 1060 1061 pp_sw = (P_node_ptrs.segp -> seg.banner = PP_BANNER); 1062 1063 if pp_sw then do; /* perprocess: ptrs */ 1064 1065 if P_node_ptrs.last ^= null then /* previous node in chain exists */ 1066 P_node_ptrs.last -> node.next_ptr = P_node_ptrs.this -> node.next_ptr; 1067 else P_node_ptrs.segp -> pp.ptr_ht (P_node_ptrs.hash) = P_node_ptrs.this -> node.next_ptr; 1068 1069 area_ptr = P_node_ptrs.segp -> pp.remote_area_ptr; 1070 free P_node_ptrs.this -> node in (area_ptr -> based_area); 1071 end; 1072 1073 else do; /* permanent: offsets */ 1074 1075 if P_node_ptrs.last ^= null then /* previous node in chain exists */ 1076 P_node_ptrs.last -> node.next_offset = P_node_ptrs.this -> node.next_offset; 1077 else P_node_ptrs.segp -> seg.offset_ht (P_node_ptrs.hash) = P_node_ptrs.this -> node.next_offset; 1078 1079 P_node_ptrs.segp -> seg.trash_count = P_node_ptrs.segp -> seg.trash_count + 1080 currentsize (P_node_ptrs.this -> node); /* for later compaction of seg */ 1081 1082 if (4 * P_node_ptrs.segp -> seg.trash_count > fixed (P_node_ptrs.segp -> seg.next_free_offset, 18, 0)) | 1083 (P_node_ptrs.segp -> seg.trash_count > MAX_TRASH_COUNT) then 1084 call compact_trash (P_node_ptrs.segp); 1085 end; 1086 1087 end delete_node; 1088 1089 find: proc (P_pp_ptr, P_seg_ptr, P_name_info, P_value_info, P_node_ptrs) returns (bit (1)); 1090 1091 /* Looks first in perprocess if appropriate, then in value segment. Returns "1"b if found */ 1092 1093 dcl (P_pp_ptr, P_seg_ptr) ptr; /* INPUT: header pointers */ 1094 dcl 1 P_name_info aligned like name_info; /* INPUT: variable name */ 1095 dcl 1 P_value_info aligned like value_info; /* OUTPUT: value string */ 1096 dcl 1 P_node_ptrs aligned like node_ptrs; /* OUTPUT: ptrs to current (found) and previous nodes */ 1097 1098 if P_pp_ptr ^= null then do; /* looking in perprocess */ 1099 1100 if find_in (P_pp_ptr, P_name_info, P_value_info, P_node_ptrs) then return ("1"b); 1101 end; 1102 1103 if P_seg_ptr ^= null then do; 1104 1105 if find_in (P_seg_ptr, P_name_info, P_value_info, P_node_ptrs) then return ("1"b); 1106 end; 1107 1108 return ("0"b); 1109 1110 end find; 1111 1112 find_in: proc (P_ptr, P_name_info, P_value_info, P_node_ptrs) returns (bit (1)); 1113 1114 /* Looks for the name in a specified segment; returns true if FOUND */ 1115 1116 dcl P_ptr ptr; /* INPUT: segment to look in */ 1117 dcl 1 P_name_info aligned like name_info; /* INPUT: variable name */ 1118 dcl 1 P_value_info aligned like value_info; /* OUTPUT: value string */ 1119 dcl 1 P_node_ptrs aligned like node_ptrs; /* OUTPUT: ptrs to current (found) and previous nodes */ 1120 1121 dcl name_str char (P_name_info.len) based (P_name_info.ptr); 1122 dcl hash_str char (8); 1123 dcl next_node_offset bit (18); 1124 dcl pp_sw bit (1); 1125 dcl (begin_change_count, hash_index, i) fixed bin; 1126 dcl (first_node_ptr, old_node_ptr) ptr; 1127 1128 pp_sw = (P_ptr -> seg.banner = PP_BANNER); 1129 1130 FIND: if ^pp_sw then call lock_for_read (P_ptr, begin_change_count); 1131 1132 i = length (rtrim (name_str, WHITE)); 1133 if i > 8 then hash_str = substr (name_str, i - 7, 8); 1134 else hash_str = name_str; 1135 1136 hash_index = mod (fixed (unspec (rtrim (hash_str, WHITE))), P_ptr -> seg.ht_size); 1137 1138 P_node_ptrs.this, P_node_ptrs.last = null; /* initialize to not found */ 1139 P_node_ptrs.segp = P_ptr; 1140 P_node_ptrs.hash = hash_index; 1141 1142 if pp_sw then do; 1143 first_node_ptr = P_ptr -> pp.ptr_ht (hash_index); 1144 if baseno (first_node_ptr) = "0"b | first_node_ptr = null then return ("0"b); 1145 end; 1146 else if P_ptr -> seg.offset_ht (hash_index) = "0"b then return ("0"b); 1147 1148 if pp_sw then P_node_ptrs.this = P_ptr -> pp.ptr_ht (hash_index); 1149 else P_node_ptrs.this = pointer (P_ptr, P_ptr -> seg.offset_ht (hash_index)); 1150 1151 do while (P_node_ptrs.this ^= null); /* search the list */ 1152 1153 if P_node_ptrs.this -> old_node_format.banner = BANNER then do; /* COMPATIBILITY */ 1154 1155 old_node_ptr = P_node_ptrs.this; 1156 1157 P_node_ptrs.this = add_node (P_ptr, P_node_ptrs.this -> old_node_format.name_len, 1158 P_node_ptrs.this -> old_node_format.value_len, P_node_ptrs); 1159 1160 call copy_old_format_node (old_node_ptr, P_node_ptrs.this); 1161 end; 1162 1163 if P_node_ptrs.this -> node.name = name_str & 1164 P_node_ptrs.this -> node.data_sw = data_entrypoint_sw then do; /* FOUND */ 1165 1166 P_value_info.ptr = addrel (addr (P_node_ptrs.this -> node.value), 1); /* var string's text */ 1167 P_value_info.len = P_node_ptrs.this -> node.value_len; 1168 1169 if ^pp_sw then do; /* if a shared segment */ 1170 /* make sure another process has not changed seg meanwhile */ 1171 if P_ptr -> seg.change_count ^= begin_change_count then go to FIND; /* retry */ 1172 1173 P_value_info.change_count = begin_change_count; /* for later unlocking */ 1174 P_value_info.seg_ptr = P_ptr; 1175 end; 1176 else P_value_info.seg_ptr = null; 1177 1178 return ("1"b); 1179 end; 1180 1181 P_node_ptrs.last = P_node_ptrs.this; 1182 1183 if pp_sw then P_node_ptrs.this = P_node_ptrs.this -> node.next_ptr; 1184 else do; 1185 next_node_offset = P_node_ptrs.this -> node.next_offset; 1186 if next_node_offset = "0"b then P_node_ptrs.this = null; 1187 else P_node_ptrs.this = pointer (P_ptr, next_node_offset); 1188 end; 1189 end; 1190 1191 return ("0"b); 1192 1193 end find_in; 1194 1195 get_default_path: proc (A_dn, A_en); 1196 1197 dcl (A_dn, A_en) char (*); 1198 dcl person_id char (22); 1199 1200 call user_info_$homedir (A_dn); 1201 1202 call user_info_ (person_id); 1203 A_en = rtrim (person_id) || ".value"; 1204 1205 end get_default_path; 1206 1207 get_default_ptr: proc () returns (ptr); 1208 1209 /* Returns a pointer to the current default value seg */ 1210 1211 dcl dn char (168); 1212 dcl en char (32); 1213 1214 if default_seg_ptr = null then do; 1215 1216 INITIATE: call get_default_path (dn, en); 1217 1218 call hcs_$initiate (dn, en, "", 0, 0, default_seg_ptr, code); 1219 end; 1220 1221 else do; 1222 1223 on any_other go to INITIATE; 1224 1225 if default_seg_ptr -> seg.banner ^= BANNER & default_seg_ptr -> seg.banner ^= PP_BANNER then 1226 go to INITIATE; 1227 1228 revert any_other; 1229 end; 1230 1231 return (default_seg_ptr); 1232 1233 end get_default_ptr; 1234 1235 get_options_var_args: proc (P_arg_list_ptr); 1236 1237 /* Reads the argument list and returns the values of selected arguments */ 1238 1239 dcl P_arg_list_ptr ptr; /* INPUT: ptr to argument list */ 1240 1241 dcl arg char (arg_len) based (arg_ptr); 1242 dcl based_bit36 bit (36) based; 1243 dcl based_packed_ptr ptr unaligned based; 1244 dcl based_ptr ptr aligned based; 1245 dcl based_varying_string char (261120 /* max chars in a segment */) varying based; 1246 1247 dcl (packed_sw, varying_sw) bit (1) aligned; 1248 dcl arg_ptr ptr; 1249 dcl (arg_len, arg_scale, arg_size, arg_type, ndims) fixed bin; 1250 1251 /* Argument 1 */ 1252 call decode_descriptor_ (P_arg_list_ptr, 1, arg_type, packed_sw, ndims, arg_size, arg_scale); 1253 if arg_type ^= PTR_TYPE | ndims > 1 then 1254 call signal_error; 1255 1256 call cu_$arg_ptr_rel (1, arg_ptr, arg_len, code, P_arg_list_ptr); 1257 if packed_sw then seg_ptr = arg_ptr -> based_packed_ptr; 1258 else seg_ptr = arg_ptr -> based_ptr; 1259 1260 /* Argument 2 */ 1261 call decode_descriptor_ (P_arg_list_ptr, 2, arg_type, packed_sw, ndims, arg_size, arg_scale); 1262 if arg_type ^= BIT_TYPE | ndims > 1 then 1263 call signal_error; 1264 1265 call cu_$arg_ptr_rel (2, arg_ptr, arg_len, code, P_arg_list_ptr); 1266 unspec (switches) = "0"b; 1267 substr (switches, 1, arg_size) = substr (arg_ptr -> based_bit36, 1, arg_size); 1268 1269 /* Argument 3 */ 1270 call decode_descriptor_ (P_arg_list_ptr, 3, arg_type, packed_sw, ndims, arg_size, arg_scale); 1271 if ndims > 1 then call signal_error; 1272 else if arg_type = VARYING_CHAR_TYPE then varying_sw = "1"b; 1273 else do; 1274 if arg_type ^= CHAR_TYPE then call signal_error; 1275 varying_sw = "0"b; 1276 end; 1277 1278 call cu_$arg_ptr_rel (3, arg_ptr, arg_len, code, P_arg_list_ptr); 1279 if varying_sw then do; 1280 name_info.ptr = arg_ptr; 1281 name_info.len = length (addrel (arg_ptr, -1) -> based_varying_string); 1282 end; 1283 else do; 1284 name_info.ptr = arg_ptr; 1285 name_info.len = length (rtrim (arg)); 1286 end; 1287 1288 end get_options_var_args; 1289 1290 get_ptrs: proc (P_seg_ptr, P_pp_ptr); 1291 1292 /* Depending on the value of switches: 1293* gets ptr to the perprocess value segment or returns null. 1294* validates seg_ptr or sets it to null (pointer to the value seg) */ 1295 1296 dcl P_seg_ptr ptr; /* INPUT/OUTPUT: ptr to value segment */ 1297 dcl P_pp_ptr ptr; /* OUTPUT: ptr to perprocess value segment */ 1298 1299 dcl (pp_sw, seg_sw) bit (1); 1300 1301 if ^pp_sw_arg & ^seg_sw_arg then call return_code (error_table_$badcall); 1302 else do; /* explicitly specified which to use */ 1303 pp_sw = pp_sw_arg; 1304 seg_sw = seg_sw_arg; 1305 end; 1306 1307 if pp_sw then do; /* using perprocess */ 1308 if perprocess_seg_ptr = null then do; /* first time for process */ 1309 call get_temp_segment_ ("value_", perprocess_seg_ptr, code); 1310 if code ^= 0 then call return_code (code); 1311 1312 perprocess_seg_ptr -> pp.version = value_version_1; 1313 perprocess_seg_ptr -> pp.banner = PP_BANNER; 1314 perprocess_seg_ptr -> pp.ht_size = HT_SIZE; 1315 do i = 0 to HT_SIZE-1; 1316 perprocess_seg_ptr -> ptr_ht (i) = null; 1317 end; 1318 1319 perprocess_seg_ptr -> pp.remote_area_ptr = get_system_free_area_ (); 1320 end; 1321 P_pp_ptr = perprocess_seg_ptr; 1322 end; 1323 else P_pp_ptr = null; 1324 1325 if seg_sw then do; /* using value segment */ 1326 if P_seg_ptr = null then do; /* default value seg */ 1327 P_seg_ptr = get_default_ptr (); 1328 if P_seg_ptr = null then do; /* no default value seg */ 1329 seg_code = code; 1330 if pp_sw then return; /* otherwise OK unless asking for permanent only */ 1331 else call return_code (code); 1332 end; 1333 end; 1334 1335 if P_seg_ptr -> seg.banner ^= BANNER & P_seg_ptr -> seg.banner ^= PP_BANNER then 1336 call return_code (error_table_$not_seg_type); 1337 end; 1338 else P_seg_ptr = null; 1339 1340 end get_ptrs; 1341 1342 get_value_arg: proc (P_arg_list_ptr, P_arg_index, P_value_info, P_alloc_info); 1343 1344 /* Converts caller's input value argument to ptr and length of allocated char string copy */ 1345 1346 dcl P_arg_list_ptr ptr; /* INPUT: ptr to argument list */ 1347 dcl P_arg_index fixed bin; /* INPUT: which arg to get */ 1348 dcl 1 P_value_info aligned like value_info; /* OUTPUT: structure containing ptr and length */ 1349 dcl 1 P_alloc_info aligned like alloc_info; /* OUTPUT: where char string has been allocated */ 1350 1351 dcl alloc_string char (P_alloc_info.len) based (P_alloc_info.ptr); 1352 1353 dcl based_varying_string char (261120 /* max chars in a segment */) varying based; 1354 1355 dcl packed_sw bit (1) aligned; 1356 dcl arg_ptr ptr; 1357 dcl (arg_len, arg_scale, arg_size, arg_type, ndims) fixed bin; 1358 1359 call decode_descriptor_ (P_arg_list_ptr, P_arg_index, arg_type, packed_sw, ndims, arg_size, arg_scale); 1360 if ndims > 1 then call signal_error; 1361 1362 call cu_$arg_ptr_rel (P_arg_index, arg_ptr, arg_len, code, P_arg_list_ptr); 1363 1364 /* Compute length for allocating a char string copy */ 1365 1366 if arg_type = CHAR_TYPE then P_alloc_info.len = arg_len; 1367 else if arg_type = VARYING_CHAR_TYPE then do; 1368 arg_ptr = addrel (arg_ptr, -1); 1369 P_alloc_info.len = length (arg_ptr -> based_varying_string); 1370 end; 1371 else P_alloc_info.len = 64; /* arbitrary: 16 words ought to be enough */ 1372 1373 allocate alloc_string in (alloc_info.area_ptr -> based_area) set (P_alloc_info.ptr); 1374 1375 on conversion call return_code (error_table_$bad_conversion); 1376 1377 call assign_ (P_alloc_info.ptr, CHAR_TYPE * 2, P_alloc_info.len, /* to target string */ 1378 arg_ptr, arg_type * 2 + fixed (packed_sw, 1), (arg_size)); /* from caller's arg */ 1379 1380 P_value_info.ptr = P_alloc_info.ptr; 1381 P_value_info.len = length (alloc_string); 1382 1383 end get_value_arg; 1384 1385 init_seg: proc (P_ptr); 1386 1387 /* Initializes the segment pointed to by P_ptr as a value segment */ 1388 1389 dcl P_ptr ptr; /* INPUT: ptr to value segment */ 1390 1391 on not_in_write_bracket call return_code (error_table_$lower_ring); 1392 on no_write_permission call return_code (error_table_$no_w_permission); 1393 1394 P_ptr -> seg.version = value_version_1; 1395 P_ptr -> seg.ht_size = HT_SIZE; 1396 P_ptr -> seg.remote_area_ptr = null; 1397 1398 P_ptr -> seg.next_free_offset = rel (addr (P_ptr -> seg.node_region)); 1399 P_ptr -> seg.region_size = 1400 sys_info$max_seg_size - fixed (P_ptr -> seg.next_free_offset); /* rest of segment */ 1401 1402 end init_seg; 1403 1404 list_pp: proc (P_ptr); 1405 1406 /* Does value_$list stuff for a nonshareable value seg, perprocess or otherwise (using ptrs rather than offsets) */ 1407 1408 dcl P_ptr ptr; 1409 1410 do node_ptrs.hash = 0 to P_ptr -> pp.ht_size - 1; 1411 1412 do node_ptrs.this = P_ptr -> pp.ptr_ht (node_ptrs.hash) 1413 repeat (node_ptrs.this -> node.next_ptr) while (node_ptrs.this ^= null); 1414 1415 if node_ptrs.this -> node.data_sw = data_entrypoint_sw then 1416 1417 call match_one (node_ptrs.this); 1418 end; 1419 end; 1420 1421 end list_pp; 1422 1423 lock_for_read: proc (P_ptr, P_change_count); 1424 1425 /* Locks a copy of the value seg's lock word, then returns seg.change_count */ 1426 1427 dcl P_ptr ptr; /* INPUT: ptr to value seg */ 1428 dcl P_change_count fixed bin; /* OUTPUT: seg.change_count at lock time */ 1429 1430 dcl i fixed bin; 1431 1432 if P_ptr -> seg.salvaging_sw then do; /* seg in use */ 1433 1434 do i = 1 to 10; /* try 10 times to catch seg unlocked */ 1435 1436 P_change_count = P_ptr -> seg.change_count; 1437 1438 call set_lock_$lock ((P_ptr -> seg.lock), 0, code); /* see if seg is locked (look at copy) */ 1439 if code = 0 1440 | code = error_table_$invalid_lock_reset 1441 | code = error_table_$locked_by_this_process then return; 1442 end; 1443 1444 call return_code (code); /* give up */ 1445 end; 1446 1447 else P_change_count = P_ptr -> seg.change_count; /* no need to lock except for salvage */ 1448 1449 end lock_for_read; 1450 1451 lock_for_write: proc (P_ptr); 1452 1453 /* Locks the value seg's lock word and increments seg.change_count */ 1454 1455 dcl P_ptr ptr; /* INPUT: ptr to value seg */ 1456 1457 if P_ptr = null then return; 1458 if P_ptr -> seg.banner = PP_BANNER then return; 1459 1460 on not_in_write_bracket call return_code (error_table_$lower_ring); 1461 on no_write_permission call return_code (error_table_$no_w_permission); 1462 1463 call set_lock_$lock (P_ptr -> seg.lock, 1, code); 1464 if code ^= 0 1465 & code ^= error_table_$invalid_lock_reset 1466 & code ^= error_table_$locked_by_this_process then 1467 call return_code (code); 1468 1469 if P_ptr -> seg.change_count > 10000 then P_ptr -> seg.change_count = 1; 1470 else P_ptr -> seg.change_count = P_ptr -> seg.change_count + 1; 1471 1472 end lock_for_write; 1473 1474 match_one: proc (P_ptr); 1475 1476 /* Adds P_ptr->node.name to the sort array if it matches what's in match_info. 1477* Global vars used: alloc_chars_len, data_entrypoint_sw, match_info_ptr, sort_entry_ptr, 1478* sequential_number, sort_array_ptr */ 1479 1480 dcl P_ptr ptr; 1481 dcl based_fb35 fixed bin (35) aligned based; 1482 dcl (excluded_sw, matched_sw) bit (1); 1483 dcl i fixed; 1484 dcl code fixed (35); 1485 1486 excluded_sw, matched_sw = "0"b; 1487 1488 do i = 1 to match_info.name_count; 1489 1490 if match_info.name (i) = P_ptr -> node.name then go to MATCH; 1491 1492 else if match_info.regexp_sw (i) then 1493 call search_file_ (addrel (addr (match_info.name (i)), 1), 1, length (match_info.name (i)), 1494 addrel (addr (P_ptr -> node.name), 1), 1, P_ptr -> node.name_len, 1495 0, 0, code); 1496 1497 else call match_star_name_ ((P_ptr -> node.name), (match_info.name (i)), code); 1498 1499 if code = 0 then do; 1500 MATCH: if match_info.exclude_sw (i) then excluded_sw = "1"b; 1501 else matched_sw = "1"b; 1502 end; 1503 end; 1504 1505 if excluded_sw | ^matched_sw then return; 1506 1507 /* Append a sort_entry structure to the sort_entries temp seg, describing this node */ 1508 1509 node_ptr = P_ptr; /* for sort_entry.name's length */ 1510 sort_entry.node_ptr = P_ptr; 1511 sort_entry.name = P_ptr -> node.name; 1512 sort_entry.length = P_ptr -> node.name_len + length (sort_entry.sequence); 1513 /* include sequential number to be included */ 1514 1515 /* Append a sequential number in char string form to the name, so that the order 1516* of multiple (pushed) values with the same name will be preserved by the sort */ 1517 1518 sequential_number = sequential_number + 1; 1519 sort_entry.sequence = sequential_number; /* picture assignment, converted to char */ 1520 1521 /* Add this entry to the sort_array passed to sort_items_$varying_char */ 1522 1523 sort_array.count = sort_array.count + 1; 1524 sort_array.name_ptr (sort_array.count) = addr (sort_entry.sort_field); 1525 1526 /* Bump sort_entry_ptr for the next entry, past end of this entry */ 1527 1528 sort_entry_ptr = addr (sort_entry.next_entry); 1529 1530 /* Reserve room for the output name */ 1531 1532 alloc_chars_len = alloc_chars_len + P_ptr -> node.name_len; 1533 if ^data_entrypoint_sw then alloc_chars_len = alloc_chars_len + P_ptr -> node.value_len; 1534 1535 end match_one; 1536 1537 return_code: proc (P_code); 1538 1539 /* Sets the value of the code argument and returns from the outer procedure */ 1540 /* options_var_sw and code_arg_index are global variables set by the entry points */ 1541 1542 dcl P_code fixed bin (35); /* INPUT: status code value */ 1543 1544 dcl based_fb35 fixed bin (35) based; 1545 dcl packed_sw bit (1) aligned; 1546 dcl arg_ptr ptr; 1547 dcl (arg_len, arg_scale, arg_size, arg_type, ndims) fixed bin; 1548 1549 if ^options_var_sw then do; 1550 A_code = P_code; 1551 go to RETURN; 1552 end; 1553 1554 call decode_descriptor_ (arg_list_ptr, code_arg_index, arg_type, packed_sw, ndims, arg_size, arg_scale); 1555 if arg_type = FIXED_BIN_TYPE then do; 1556 call cu_$arg_ptr_rel (code_arg_index, arg_ptr, arg_len, 0, arg_list_ptr); 1557 arg_ptr -> based_fb35 = P_code; 1558 end; 1559 1560 go to RETURN; 1561 1562 end return_code; 1563 1564 set_seg: proc (P_ptr); 1565 1566 /* Sets the default value seg to P_ptr, or to [hd]>[user name].value if P_ptr = null */ 1567 1568 dcl P_ptr ptr; /* INPUT: ptr to value seg */ 1569 1570 if P_ptr = null then do; 1571 default_seg_ptr = null; 1572 P_ptr = get_default_ptr (); 1573 end; 1574 else do; 1575 if P_ptr -> seg.banner ^= BANNER then call return_code (error_table_$not_seg_type); 1576 default_seg_ptr = P_ptr; 1577 end; 1578 1579 end set_seg; 1580 1581 set_value_arg: proc (P_arg_list_ptr, P_arg_index, P_value_info); 1582 1583 /* Converts ptr and length of string to value_arg argument */ 1584 1585 dcl P_arg_list_ptr ptr; /* INPUT: ptr to argument list */ 1586 dcl P_arg_index fixed bin; /* INPUT: which arg to set */ 1587 dcl 1 P_value_info aligned like value_info; /* INPUT: structure containing ptr and length */ 1588 1589 dcl value_string char (P_value_info.len) based (P_value_info.ptr); 1590 dcl alloc_value char (A_value_len) based (A_value_ptr); 1591 dcl alloc_data (A_data_size) fixed bin aligned based (A_data_ptr); /* for allocation */ 1592 1593 dcl packed_sw bit (1) aligned; 1594 dcl arg_ptr ptr; 1595 dcl (arg_len, arg_scale, arg_size, arg_type, ndims) fixed bin; 1596 dcl bit_size fixed bin (24); 1597 1598 if alloc_entrypoint_sw then do; /* value_$get_alloc */ 1599 A_value_len = P_value_info.len; 1600 if A_area_ptr ^= null then do; /* wants it returned */ 1601 1602 on area call return_code (error_table_$noalloc); 1603 1604 allocate alloc_value in (A_area_ptr -> based_area) set (A_value_ptr); 1605 1606 substr (alloc_value, 1, A_value_len) = substr (value_string, 1, A_value_len); 1607 end; 1608 1609 return; 1610 end; 1611 1612 if data_entrypoint_sw then do; /* value_$get_data, value_$set_data */ 1613 A_data_size = divide (P_value_info.len + 3, 4, 17, 0); 1614 if A_area_ptr ^= null then do; /* wants it returned */ 1615 1616 on area call return_code (error_table_$noalloc); 1617 1618 allocate alloc_data in (A_area_ptr -> based_area) set (A_data_ptr); 1619 1620 bit_size = A_data_size * 36; 1621 substr (A_data_ptr -> bits, 1, bit_size) = substr (P_value_info.ptr -> bits, 1, bit_size); 1622 end; 1623 1624 return; 1625 end; 1626 1627 call decode_descriptor_ (P_arg_list_ptr, P_arg_index, arg_type, packed_sw, ndims, arg_size, arg_scale); 1628 if ndims > 1 then call signal_error; 1629 1630 if arg_type = VARYING_CHAR_TYPE & arg_size = 0 then return; /* caller testing whether defined */ 1631 1632 call cu_$arg_ptr_rel (P_arg_index, arg_ptr, arg_len, code, P_arg_list_ptr); 1633 1634 if arg_type = VARYING_CHAR_TYPE then arg_ptr = addrel (arg_ptr, -1); /* point to length word */ 1635 1636 on conversion call return_code (error_table_$bad_conversion); 1637 1638 call assign_ (arg_ptr, arg_type * 2, (arg_size), /* to caller's argument */ 1639 P_value_info.ptr, CHAR_TYPE * 2, P_value_info.len); /* from value in node */ 1640 1641 end set_value_arg; 1642 1643 signal_error: proc; 1644 1645 /* Signals nonrestartable sub_error (a better one someday?) because of bad args in value_ call */ 1646 1647 do while ("1"b); 1648 signal sub_error; 1649 end; 1650 1651 end signal_error; 1652 1653 unlock_for_write: proc (P_ptr); 1654 1655 /* Unlock the value segment */ 1656 1657 dcl P_ptr ptr; /* INPUT: ptr to value seg */ 1658 1659 if P_ptr = null then return; 1660 if P_ptr -> seg.banner = PP_BANNER then return; 1661 1662 call set_lock_$unlock (P_ptr -> seg.lock, code); 1663 1664 call hcs_$set_bc_seg (P_ptr, fixed (P_ptr -> seg.next_free_offset, 18) * 36, code); 1665 1666 end unlock_for_write; 1667 1668 end value_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/02/86 1512.2 value_.pl1 >special_ldd>install>MR12.0-1175>value_.pl1 93 1 06/24/81 1743.9 value_structures.incl.pl1 >ldd>include>value_structures.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. A_area_ptr parameter pointer dcl 166 ref 370 376 382 438 450 581 738 1600 1604 1614 1618 A_code parameter fixed bin(35,0) dcl 172 set ref 271 279* 287 290* 312* 318 322* 370 376 388 390* 394* 399 401* 403 438 446* 521* 564* 581 738 753 810 1023* 1550* A_create_sw parameter bit(1) unaligned dcl 165 ref 753 765 A_data_ptr parameter pointer dcl 166 set ref 376 738 1618* 1621 A_data_size parameter fixed bin(18,0) dcl 169 set ref 376 738 1613* 1618 1620 A_dn parameter char unaligned dcl 1197 set ref 1195 1200* A_en parameter char unaligned dcl 1197 set ref 1195 1203* A_match_info_ptr parameter pointer dcl 167 ref 438 449 581 A_name parameter char unaligned dcl 163 set ref 271 287 318 370 376 738 810 1027 1028 A_new_data_ptr parameter pointer dcl 166 ref 643 657 738 810 A_new_data_size parameter fixed bin(18,0) dcl 169 ref 658 738 810 A_old_data_ptr parameter pointer dcl 166 ref 810 817 A_old_data_size parameter fixed bin(18,0) dcl 169 ref 810 818 A_path parameter char unaligned dcl 163 set ref 388 399* 753 757 762 A_region_size parameter fixed bin(19,0) dcl 170 ref 403 433 433 A_remote_area_ptr parameter pointer dcl 166 ref 403 411 415 425 425 A_seg_ptr parameter pointer dcl 166 set ref 271 287 318 370 376 403 409 413 418* 421 422 423 425 427 431 432 433 438 447 581 738 810 1025 A_seg_type parameter fixed bin(17,0) dcl 168 ref 403 409 413 420 A_switches parameter bit(36) dcl 164 ref 271 287 318 370 376 438 448 581 738 810 1026 A_value_len parameter fixed bin(21,0) dcl 171 set ref 370 1599* 1604 1604 1606 1606 1606 A_value_list_info_ptr parameter pointer dcl 167 set ref 438 563* 581 A_value_ptr parameter pointer dcl 166 set ref 370 1604* 1606 BANNER 000003 constant bit(36) initial unaligned dcl 135 ref 409 431 491 773 848 882 899 947 977 1153 1225 1335 1575 BIT_TYPE constant fixed bin(17,0) initial dcl 145 ref 1262 CHAR_TYPE constant fixed bin(17,0) initial dcl 146 ref 1274 1366 1377 1638 FIXED_BIN_TYPE constant fixed bin(17,0) initial dcl 147 ref 1555 HT_SIZE constant fixed bin(17,0) initial dcl 137 ref 1314 1315 1395 MAX_TRASH_COUNT constant fixed bin(17,0) initial dcl 133 ref 730 1082 PERMANENT constant fixed bin(17,0) initial dcl 139 ref 409 PERMANENT_SW constant bit(2) initial unaligned dcl 140 ref 543 PERPROCESS constant fixed bin(17,0) initial dcl 139 ref 413 420 PERPROCESS_SW constant bit(2) initial unaligned dcl 140 ref 542 PP_BANNER 000002 constant bit(36) initial unaligned dcl 136 ref 413 421 471 691 837 1061 1128 1225 1313 1335 1458 1660 PTR_TYPE constant fixed bin(17,0) initial dcl 148 ref 1253 P_alloc_info parameter structure level 1 dcl 1349 set ref 1342 P_arg_index parameter fixed bin(17,0) dcl 1347 in procedure "get_value_arg" set ref 1342 1359* 1362* P_arg_index parameter fixed bin(17,0) dcl 1586 in procedure "set_value_arg" set ref 1581 1627* 1632* P_arg_list_ptr parameter pointer dcl 1346 in procedure "get_value_arg" set ref 1342 1359* 1362* P_arg_list_ptr parameter pointer dcl 1585 in procedure "set_value_arg" set ref 1581 1627* 1632* P_arg_list_ptr parameter pointer dcl 1239 in procedure "get_options_var_args" set ref 1235 1252* 1256* 1261* 1265* 1270* 1278* P_change_count parameter fixed bin(17,0) dcl 1428 set ref 1423 1436* 1447* P_code parameter fixed bin(35,0) dcl 1542 ref 1537 1550 1557 P_en parameter char unaligned dcl 926 ref 922 930 932 933 933 935 P_name_info parameter structure level 1 dcl 1094 in procedure "find" set ref 1089 1100* 1105* P_name_info parameter structure level 1 dcl 1117 in procedure "find_in" ref 1112 P_name_len parameter fixed bin(21,0) dcl 830 ref 825 840 885 P_new_ptr parameter pointer dcl 1038 ref 1034 1040 1041 1042 1043 1044 1045 1046 1047 1048 P_node_ptrs parameter structure level 1 dcl 1096 in procedure "find" set ref 1089 1100* 1105* P_node_ptrs parameter structure level 1 dcl 1119 in procedure "find_in" set ref 1112 1157* P_node_ptrs parameter structure level 1 dcl 1056 in procedure "delete_node" set ref 1052 P_node_ptrs parameter structure level 1 dcl 831 in procedure "add_node" ref 825 P_old_ptr parameter pointer dcl 1038 ref 1034 1041 1042 1043 1045 1046 1047 1048 P_pp_ptr parameter pointer dcl 1093 in procedure "find" set ref 1089 1098 1100* P_pp_ptr parameter pointer dcl 1297 in procedure "get_ptrs" set ref 1290 1321* 1323* P_ptr parameter pointer dcl 1568 in procedure "set_seg" set ref 1564 1570 1572* 1575 1576 P_ptr parameter pointer dcl 1657 in procedure "unlock_for_write" set ref 1653 1659 1660 1662 1664* 1664 P_ptr parameter pointer dcl 941 in procedure "compact_trash" set ref 939 947 956 958 960 973 973 995 1006 1007 1008 1010 1012* P_ptr parameter pointer dcl 1427 in procedure "lock_for_read" ref 1423 1432 1436 1438 1447 P_ptr parameter pointer dcl 1116 in procedure "find_in" set ref 1112 1128 1130* 1136 1139 1143 1146 1148 1149 1149 1157* 1171 1174 1187 P_ptr parameter pointer dcl 1455 in procedure "lock_for_write" ref 1451 1457 1458 1463 1469 1469 1470 1470 P_ptr parameter pointer dcl 829 in procedure "add_node" ref 825 837 839 853 853 867 879 880 891 901 901 906 906 915 P_ptr parameter pointer dcl 1389 in procedure "init_seg" ref 1385 1394 1395 1396 1398 1398 1399 1399 P_ptr parameter pointer dcl 1408 in procedure "list_pp" ref 1404 1410 1412 P_ptr parameter pointer dcl 1480 in procedure "match_one" ref 1474 1490 1492 1492 1492 1497 1509 1510 1511 1512 1532 1533 P_seg_ptr parameter pointer dcl 1093 in procedure "find" set ref 1089 1103 1105* P_seg_ptr parameter pointer dcl 1296 in procedure "get_ptrs" set ref 1290 1326 1327* 1328 1335 1335 1338* P_value_info parameter structure level 1 dcl 1348 in procedure "get_value_arg" set ref 1342 P_value_info parameter structure level 1 dcl 1587 in procedure "set_value_arg" set ref 1581 P_value_info parameter structure level 1 dcl 1118 in procedure "find_in" set ref 1112 P_value_info parameter structure level 1 dcl 1095 in procedure "find" set ref 1089 1100* 1105* P_value_len parameter fixed bin(21,0) dcl 830 ref 825 841 886 R_BIT 0(32) based bit(1) level 2 packed unaligned dcl 195 ref 783 SUFFIX 000000 constant char(6) initial unaligned dcl 142 ref 932 933 933 SUFFIX_LEN constant fixed bin(17,0) initial dcl 143 ref 932 933 933 VARYING_CHAR_TYPE constant fixed bin(17,0) initial dcl 149 ref 1272 1367 1630 1634 WHITE constant char(2) initial unaligned dcl 151 ref 1132 1136 W_BIT 0(34) based bit(1) level 2 packed unaligned dcl 195 ref 784 addr builtin function dcl 266 ref 463 463 783 784 960 1027 1166 1398 1492 1492 1492 1492 1524 1528 addrel builtin function dcl 266 ref 538 1166 1281 1368 1492 1492 1492 1492 1634 alloc_chars_len 000105 automatic fixed bin(21,0) dcl 1-5 set ref 464* 478 514* 531 531 1532* 1532 1533* 1533 alloc_data based fixed bin(17,0) array dcl 1591 ref 1618 alloc_entrypoint_sw 000322 automatic bit(1) initial dcl 212 set ref 212* 372* 1598 alloc_info 000142 automatic structure level 1 dcl 108 set ref 660* 803* alloc_pair_count 000104 automatic fixed bin(17,0) dcl 1-4 set ref 529* 531 531 alloc_string based char unaligned dcl 1351 in procedure "get_value_arg" ref 1373 1381 alloc_string based char unaligned dcl 189 in procedure "value_" ref 636 726 alloc_value based char unaligned dcl 1590 set ref 1604 1606* any_other 000000 stack reference condition dcl 269 ref 1223 1228 area 000000 stack reference condition dcl 269 ref 843 1602 1616 area_ptr 000334 automatic pointer dcl 215 in procedure "value_" set ref 450* 451 451* 531 577 area_ptr 4 000142 automatic pointer level 2 in structure "alloc_info" dcl 108 in procedure "value_" set ref 631* 636 726 801* 1373 area_ptr 000100 automatic pointer dcl 833 in procedure "add_node" set ref 839* 845 874 area_ptr 000436 automatic pointer dcl 1059 in procedure "delete_node" set ref 1069* 1070 arg based char unaligned dcl 1241 ref 1285 arg_len 000104 automatic fixed bin(17,0) dcl 1595 in procedure "set_value_arg" set ref 1632* arg_len 000104 automatic fixed bin(17,0) dcl 1357 in procedure "get_value_arg" set ref 1362* 1366 arg_len 000502 automatic fixed bin(17,0) dcl 1249 in procedure "get_options_var_args" set ref 1256* 1265* 1278* 1285 arg_len 000104 automatic fixed bin(17,0) dcl 1547 in procedure "return_code" set ref 1556* arg_list_ptr 000160 automatic pointer dcl 178 set ref 341* 343* 351* 618* 620* 660* 677* 718* 796* 798* 803* 1554* 1556* arg_ptr 000500 automatic pointer dcl 1248 in procedure "get_options_var_args" set ref 1256* 1257 1258 1265* 1267 1278* 1280 1281 1284 1285 arg_ptr 000102 automatic pointer dcl 1546 in procedure "return_code" set ref 1556* 1557 arg_ptr 000102 automatic pointer dcl 1594 in procedure "set_value_arg" set ref 1632* 1634* 1634 1638* arg_ptr 000102 automatic pointer dcl 1356 in procedure "get_value_arg" set ref 1362* 1368* 1368 1369 1377* arg_scale 000503 automatic fixed bin(17,0) dcl 1249 in procedure "get_options_var_args" set ref 1252* 1261* 1270* arg_scale 000105 automatic fixed bin(17,0) dcl 1595 in procedure "set_value_arg" set ref 1627* arg_scale 000105 automatic fixed bin(17,0) dcl 1547 in procedure "return_code" set ref 1554* arg_scale 000105 automatic fixed bin(17,0) dcl 1357 in procedure "get_value_arg" set ref 1359* arg_size 000106 automatic fixed bin(17,0) dcl 1357 in procedure "get_value_arg" set ref 1359* 1377 arg_size 000504 automatic fixed bin(17,0) dcl 1249 in procedure "get_options_var_args" set ref 1252* 1261* 1267 1267 1270* arg_size 000106 automatic fixed bin(17,0) dcl 1547 in procedure "return_code" set ref 1554* arg_size 000106 automatic fixed bin(17,0) dcl 1595 in procedure "set_value_arg" set ref 1627* 1630 1638 arg_type 000107 automatic fixed bin(17,0) dcl 1595 in procedure "set_value_arg" set ref 1627* 1630 1634 1638 arg_type 000107 automatic fixed bin(17,0) dcl 1547 in procedure "return_code" set ref 1554* 1555 arg_type 000107 automatic fixed bin(17,0) dcl 1357 in procedure "get_value_arg" set ref 1359* 1366 1367 1377 arg_type 000505 automatic fixed bin(17,0) dcl 1249 in procedure "get_options_var_args" set ref 1252* 1253 1261* 1262 1270* 1272 1274 assign_ 000054 constant entry external dcl 241 ref 1377 1638 banner 1 based bit(36) level 3 in structure "seg" dcl 40 in procedure "value_" set ref 409 431* 471 691 773* 837 947 1061 1128 1225 1225 1335 1335 1458 1575 1660 banner 1 based bit(36) level 3 in structure "node" dcl 76 in procedure "value_" set ref 848* 882* 1041* banner 1 based bit(36) level 2 in structure "pp" dcl 55 in procedure "value_" set ref 413 421* 1313* banner based bit(36) level 2 in structure "old_node_format" dcl 81 in procedure "value_" ref 491 899 977 1041 1153 based_area based area(1024) dcl 191 ref 531 577 636 726 845 874 1070 1373 1604 1618 based_bit36 based bit(36) unaligned dcl 1242 ref 1267 based_fb35 based fixed bin(35,0) dcl 1544 set ref 1557* based_packed_ptr based pointer unaligned dcl 1243 ref 1257 based_ptr based pointer dcl 1244 ref 1258 based_varying_string based varying char(261120) dcl 1353 in procedure "get_value_arg" ref 1369 based_varying_string based varying char(261120) dcl 1245 in procedure "get_options_var_args" ref 1281 baseno builtin function dcl 266 ref 1144 begin_change_count 000460 automatic fixed bin(17,0) dcl 1125 in procedure "find_in" set ref 1130* 1171 1173 begin_change_count 000361 automatic fixed bin(17,0) dcl 219 in procedure "value_" set ref 480* 513 bit builtin function dcl 266 ref 891 990 bit_size 000111 automatic fixed bin(24,0) dcl 1596 set ref 1620* 1621 1621 bits based bit(99) dcl 193 set ref 1621* 1621 change_count 6 parameter fixed bin(17,0) level 2 in structure "P_value_info" dcl 1118 in procedure "find_in" set ref 1173* change_count 6 000112 automatic fixed bin(17,0) level 2 in structure "value_info" dcl 99 in procedure "value_" set ref 353 change_count 10 based fixed bin(35,0) level 3 in structure "seg" dcl 40 in procedure "value_" set ref 353 513 1171 1436 1447 1469 1469* 1470* 1470 chars based char level 2 dcl 1-17 set ref 546* 556* chars_index 000366 automatic fixed bin(21,0) dcl 220 set ref 534* 544 546 547* 547 554 556 557* 557 561 chars_len 2 based fixed bin(21,0) level 2 dcl 1-17 set ref 531* 546 556 561* 577 cleanup 000374 stack reference condition dcl 269 ref 298 330 457 635 779 954 code 000372 automatic fixed bin(35,0) dcl 221 in procedure "value_" set ref 459* 460* 565* 567* 575* 576* 764* 765 766* 767 767* 768* 769* 777* 779* 781* 782 782* 784* 788* 949* 950 951* 952 1218* 1256* 1265* 1278* 1309* 1310 1310* 1329 1331* 1362* 1438* 1439 1439 1439 1444* 1463* 1464 1464 1464 1464* 1632* 1662* 1664* code 000553 automatic fixed bin(35,0) dcl 1484 in procedure "match_one" set ref 1492* 1497* 1499 code_arg_index 000162 automatic fixed bin(17,0) dcl 179 set ref 340* 594* 604* 615* 795* 1554* 1556* conversion 000000 stack reference condition dcl 269 ref 1375 1636 count based fixed bin(17,0) level 2 dcl 119 set ref 464* 479 515* 520 529 1523* 1523 1524 cu_$arg_list_ptr 000056 constant entry external dcl 242 ref 341 618 796 cu_$arg_ptr_rel 000060 constant entry external dcl 243 ref 1256 1265 1278 1362 1556 1632 currentsize builtin function dcl 266 ref 888 901 906 989 1079 data_entrypoint_sw 000327 automatic bit(1) dcl 213 set ref 273* 289* 321* 345* 373* 378* 442* 501 549 585* 622* 641 692 748* 806* 821* 851 884 1163 1415 1533 1612 data_sw 4(01) based bit(1) level 4 packed unaligned dcl 76 set ref 501 692 851* 884* 1163 1415 decode_descriptor_ 000062 constant entry external dcl 244 ref 1252 1261 1270 1359 1554 1627 default_seg_ptr 000012 internal static pointer initial dcl 158 set ref 394 394* 1214 1218* 1225 1225 1231 1571* 1576* divide builtin function dcl 266 ref 551 1613 dn 000164 automatic char(168) unaligned dcl 202 in procedure "value_" set ref 394* 397* 399* 758* 759 760 766* 768* dn 000100 automatic char(168) unaligned dcl 1211 in procedure "get_default_ptr" set ref 1216* 1218* en 000152 automatic char(32) unaligned dcl 1212 in procedure "get_default_ptr" set ref 1216* 1218* en 000310 automatic char(32) unaligned dcl 203 in procedure "value_" set ref 394* 397* 399* 758* 759 760 766* 768* entry_len 000100 automatic fixed bin(17,0) dcl 928 set ref 930* 932 933 error_table_$action_not_performed 000014 external static fixed bin(35,0) dcl 223 set ref 670* error_table_$bad_conversion 000016 external static fixed bin(35,0) dcl 224 set ref 1375* 1636* error_table_$badcall 000020 external static fixed bin(35,0) dcl 225 set ref 1301* error_table_$boundviol 000022 external static fixed bin(35,0) dcl 226 set ref 889* error_table_$invalid_lock_reset 000024 external static fixed bin(35,0) dcl 227 ref 1439 1464 error_table_$locked_by_this_process 000026 external static fixed bin(35,0) dcl 228 ref 1439 1464 error_table_$lower_ring 000030 external static fixed bin(35,0) dcl 229 set ref 1391* 1460* error_table_$no_r_permission 000042 external static fixed bin(35,0) dcl 234 set ref 783* error_table_$no_w_permission 000044 external static fixed bin(35,0) dcl 235 set ref 784 1392* 1461* error_table_$noalloc 000032 external static fixed bin(35,0) dcl 230 set ref 382* 843* 1602* 1616* error_table_$noentry 000034 external static fixed bin(35,0) dcl 231 ref 765 error_table_$nomatch 000036 external static fixed bin(35,0) dcl 232 ref 521 error_table_$not_seg_type 000046 external static fixed bin(35,0) dcl 236 set ref 409* 413* 1335* 1575* error_table_$oldnamerr 000040 external static fixed bin(35,0) dcl 233 set ref 312 363* 703* error_table_$out_of_sequence 000050 external static fixed bin(35,0) dcl 237 set ref 411* 415* exclude_sw 3 based bit(1) array level 3 packed unaligned dcl 1-7 ref 1500 excluded_sw 000550 automatic bit(1) unaligned dcl 1482 set ref 1486* 1500* 1505 expand_pathname_ 000064 constant entry external dcl 245 ref 766 first_node_ptr 000464 automatic pointer dcl 1126 set ref 1143* 1144 1144 fixed builtin function dcl 266 ref 730 888 989 1006 1012 1012 1082 1136 1377 1399 1664 found_one_sw 000330 automatic bit(1) dcl 213 set ref 300* 304* 312 332* function_entrypoint_sw 000323 automatic bit(1) initial dcl 212 set ref 212* 275* 366 get_system_free_area_ 000066 constant entry external dcl 246 ref 427 451 631 801 1319 get_temp_segment_ 000070 constant entry external dcl 247 ref 459 460 949 1309 hash 6 parameter fixed bin(17,0) level 2 in structure "P_node_ptrs" dcl 1056 in procedure "delete_node" ref 1067 1077 hash 6 000150 automatic fixed bin(17,0) level 2 in structure "node_ptrs" dcl 113 in procedure "value_" set ref 483* 484 486* 1410* 1412* hash 6 parameter fixed bin(17,0) level 2 in structure "P_node_ptrs" dcl 831 in procedure "add_node" ref 853 853 867 915 hash 6 parameter fixed bin(17,0) level 2 in structure "P_node_ptrs" dcl 1119 in procedure "find_in" set ref 1140* hash_index 000461 automatic fixed bin(17,0) dcl 1125 set ref 1136* 1140 1143 1146 1148 1149 hash_str 000454 automatic char(8) unaligned dcl 1122 set ref 1133* 1134* 1136 hcs_$fs_get_mode 000072 constant entry external dcl 248 ref 781 hcs_$fs_get_path_name 000074 constant entry external dcl 249 ref 394 hcs_$initiate 000076 constant entry external dcl 250 ref 764 1218 hcs_$make_seg 000100 constant entry external dcl 251 ref 768 hcs_$set_bc_seg 000102 constant entry external dcl 252 ref 1664 hcs_$terminate_noname 000104 constant entry external dcl 253 ref 779 hcs_$truncate_seg 000106 constant entry external dcl 254 ref 951 1012 header based structure level 2 in structure "node" dcl 76 in procedure "value_" header based structure level 2 in structure "seg" dcl 40 in procedure "value_" set ref 958* 958 ht_size 2 based fixed bin(17,0) level 3 in structure "seg" dcl 40 in procedure "value_" set ref 483 963 1136 1395* ht_size 2 based fixed bin(17,0) level 2 in structure "pp" dcl 55 in procedure "value_" set ref 422 1314* 1410 i 000462 automatic fixed bin(17,0) dcl 1125 in procedure "find_in" set ref 1132* 1133 1133 i 000552 automatic fixed bin(17,0) dcl 1483 in procedure "match_one" set ref 1488* 1490 1492 1492 1492 1492 1492 1497 1500* i 000540 automatic fixed bin(17,0) dcl 1430 in procedure "lock_for_read" set ref 1434* i 000362 automatic fixed bin(17,0) dcl 219 in procedure "value_" set ref 422* 423* 536* 538 542 543 544 545 546 547 550 551 554 555 556 557* 1315* 1316* i 000113 automatic fixed bin(17,0) dcl 945 in procedure "compact_trash" set ref 963* 964 966 973* last 2 parameter pointer level 2 in structure "P_node_ptrs" dcl 1119 in procedure "find_in" set ref 1138* 1181* last 2 parameter pointer level 2 in structure "P_node_ptrs" dcl 1056 in procedure "delete_node" ref 1065 1065 1075 1075 last 2 000150 automatic pointer level 2 in structure "node_ptrs" dcl 113 in procedure "value_" set ref 487* 505* last 2 parameter pointer level 2 in structure "P_node_ptrs" dcl 831 in procedure "add_node" ref 865 865 913 913 last_node_ptr 000100 automatic pointer dcl 942 set ref 969* 987 987 991* 997 len 2 parameter fixed bin(21,0) level 2 in structure "P_value_info" dcl 1348 in procedure "get_value_arg" set ref 1381* len 2 000106 automatic fixed bin(21,0) level 2 in structure "name_info" dcl 95 in procedure "value_" set ref 720* 723 1028* 1030 1281* 1285* len 2 parameter fixed bin(21,0) level 2 in structure "P_value_info" dcl 1118 in procedure "find_in" set ref 1167* len 2 000142 automatic fixed bin(21,0) level 2 in structure "alloc_info" dcl 108 in procedure "value_" set ref 636 636 726 726 len 2 000112 automatic fixed bin(21,0) level 2 in structure "value_info" dcl 99 in procedure "value_" set ref 670 672 716* len 2 000122 automatic fixed bin(21,0) level 2 in structure "new_value_info" dcl 105 in procedure "value_" set ref 658* 692 695 720* 724 len 2 parameter fixed bin(21,0) level 2 in structure "P_name_info" dcl 1117 in procedure "find_in" ref 1132 1133 1134 1163 len 2 parameter fixed bin(21,0) level 2 in structure "P_alloc_info" dcl 1349 in procedure "get_value_arg" set ref 1366* 1369* 1371* 1373 1373 1377* 1381 len 2 parameter fixed bin(21,0) level 2 in structure "P_value_info" dcl 1587 in procedure "set_value_arg" set ref 1599 1606 1613 1638* len 2 000132 automatic fixed bin(21,0) level 2 in structure "old_value_info" dcl 106 in procedure "value_" set ref 670 672 672 672 672 818* length 2 based fixed bin(17,0) level 3 in structure "sort_entry" dcl 123 in procedure "value_" set ref 1512* length builtin function dcl 267 in procedure "value_" ref 930 1028 1132 1281 1285 1369 1381 1492 1492 1512 local_pp_sw 000331 automatic bit(1) dcl 213 set ref 691* 692 lock 6 based bit(36) level 3 dcl 40 set ref 1438 1463* 1662* locked_sw 000332 automatic bit(1) dcl 213 set ref 633* 638 646* 664* match_info based structure level 1 dcl 1-7 match_info_ptr 000100 automatic pointer dcl 1-3 set ref 449* 1488 1490 1492 1492 1492 1492 1492 1497 1500 match_star_name_ 000110 constant entry external dcl 255 ref 1497 matched_sw 000551 automatic bit(1) unaligned dcl 1482 set ref 1486* 1501* 1505 max_name_len 2 based fixed bin(21,0) level 2 dcl 1-7 ref 1490 1490 1492 1492 1492 1492 1492 1492 1492 1492 1492 1492 1497 1497 1500 1500 mod builtin function dcl 267 ref 1136 name 3 based char level 3 in structure "sort_entry" packed unaligned dcl 123 in procedure "value_" set ref 1511* name 4 based varying char array level 3 in structure "match_info" dcl 1-7 in procedure "value_" set ref 1490 1492 1492 1492 1492 1497 name 7 based varying char level 2 in structure "node" dcl 76 in procedure "value_" set ref 546 723* 1047* 1163 1490 1492 1492 1497 1511 name 5 based char level 2 in structure "old_node_format" dcl 81 in procedure "value_" ref 1047 name_array 3 based structure array level 2 dcl 1-7 name_count 1 based fixed bin(17,0) level 2 dcl 1-7 ref 1488 name_index 4 based fixed bin(21,0) array level 3 dcl 1-17 set ref 544* name_info 000106 automatic structure level 1 dcl 95 set ref 283* 301* 349* 356* 648* 666* name_len 3 based fixed bin(21,0) level 2 in structure "old_node_format" dcl 81 in procedure "value_" set ref 495* 901 1045 1047 1048 1157* name_len 5 based fixed bin(21,0) level 3 in structure "node" dcl 76 in procedure "value_" set ref 545 556 695 723 724 845* 874 885* 888 906 982* 982 984 989 1045* 1047 1048 1070 1079 1166 1492* 1511 1512 1512 1519 1528 1532 name_len 5 based fixed bin(21,0) array level 3 in structure "value_list_info" dcl 1-17 in procedure "value_" set ref 545* 546 547 name_ptr 1 based pointer array level 2 packed unaligned dcl 119 set ref 538 1524* name_str based char unaligned dcl 1121 ref 1132 1133 1134 1163 name_string based char unaligned dcl 185 ref 723 ndims 000110 automatic fixed bin(17,0) dcl 1595 in procedure "set_value_arg" set ref 1627* 1628 ndims 000110 automatic fixed bin(17,0) dcl 1357 in procedure "get_value_arg" set ref 1359* 1360 ndims 000110 automatic fixed bin(17,0) dcl 1547 in procedure "return_code" set ref 1554* ndims 000506 automatic fixed bin(17,0) dcl 1249 in procedure "get_options_var_args" set ref 1252* 1253 1261* 1262 1270* 1271 new_node_offset 000104 automatic bit(18) unaligned dcl 834 set ref 879* 880 888 913 915 new_node_ptr 000336 automatic pointer dcl 215 in procedure "value_" set ref 720* 723 724 new_node_ptr 000102 automatic pointer dcl 833 in procedure "add_node" set ref 845* 847 848 849 850 851 858 859 861 863 865 867 871 872 880* 881 882 883 884 885 886 888 895 896 900 905 911 918 new_value_info 000122 automatic structure level 1 dcl 105 set ref 660* new_value_string based char unaligned dcl 187 ref 695 724 next_entry based pointer level 2 dcl 123 set ref 1528 next_free_offset 11 based bit(18) level 3 dcl 40 set ref 730 879 891* 960* 961 1001* 1082 1398* 1399 1664 next_free_word 000112 automatic fixed bin(18,0) unsigned unaligned dcl 944 in procedure "compact_trash" set ref 989* 990 next_free_word 000105 automatic fixed bin(18,0) dcl 835 in procedure "add_node" set ref 888* 889 891 next_node_offset 000110 automatic bit(18) unaligned dcl 943 in procedure "compact_trash" set ref 971* 973 994* 995 next_node_offset 000456 automatic bit(18) unaligned dcl 1123 in procedure "find_in" set ref 1185* 1186 1187 next_offset 1 based bit(18) level 2 in structure "old_node_format" dcl 81 in procedure "value_" ref 900 1042 next_offset 2 based bit(18) level 3 in structure "node" dcl 76 in procedure "value_" set ref 506 896* 900* 905* 905 911* 913* 987* 994 997* 1042* 1075* 1075 1077 1185 next_ptr 3 based pointer level 3 in structure "node" packed unaligned dcl 76 in procedure "value_" set ref 859* 861* 861 863* 865* 872* 1043* 1065* 1065 1067 1183 1418 next_ptr 2 based pointer level 2 in structure "old_node_format" packed unaligned dcl 81 in procedure "value_" ref 1043 next_word_offset 000111 automatic bit(18) unaligned dcl 943 set ref 961* 966 968 987 989 990* 992 1001 1006 1012 1012 no_write_permission 000000 stack reference condition dcl 269 ref 1392 1461 node based structure level 1 dcl 76 set ref 845 874 888 906 984* 984 989 1070 1079 node_header based structure level 1 dcl 63 node_name_len 000367 automatic fixed bin(21,0) dcl 220 set ref 840* 845 845 node_offset 000321 automatic bit(18) unaligned dcl 211 set ref 506* 507 508 node_ptr 000340 automatic pointer dcl 215 in procedure "value_" set ref 540* 542 545 546 551 555 556 1509* 1511 1512 1519 1528 node_ptr based pointer level 2 in structure "sort_entry" dcl 123 in procedure "value_" set ref 540 1510* node_ptrs 000150 automatic structure level 1 dcl 113 set ref 283* 301* 307* 349* 356* 495* 648* 648* 666* 681* 720* node_region 110 based fixed bin(17,0) array level 2 dcl 40 set ref 960 1398 node_value_len 000370 automatic fixed bin(21,0) dcl 220 set ref 841* 845 845 not_in_write_bracket 000000 stack reference condition dcl 269 ref 1391 1460 null builtin function dcl 267 ref 353 382 394 411 415 423 425 451 455 466 471 487 489 507 575 576 577 630 636 643 690 709 713 726 730 745 769 777 800 819 853 856 863 865 869 893 913 969 987 1065 1075 1098 1103 1138 1144 1151 1176 1186 1214 1308 1316 1323 1326 1328 1338 1396 1412 1457 1570 1571 1600 1614 1659 offset_ht 13 based bit(18) array level 3 dcl 40 set ref 432* 484 486 774* 915* 964 966* 973 1077* 1146 1149 old_node_format based structure level 1 dcl 81 set ref 901 old_node_ptr 000102 automatic pointer dcl 942 in procedure "compact_trash" set ref 973* 977 977* 982 983 984 994* old_node_ptr 000466 automatic pointer dcl 1126 in procedure "find_in" set ref 1155* 1160* old_node_ptr 000342 automatic pointer dcl 215 in procedure "value_" set ref 493* 498* old_value_arg_index 000163 automatic fixed bin(17,0) dcl 179 set ref 593* 603* 614* 677* 718* old_value_info 000132 automatic structure level 1 dcl 106 set ref 803* old_value_string based char unaligned dcl 188 ref 672 options_var_sw 000157 automatic bit(1) dcl 177 set ref 273* 289* 320* 339* 379* 392* 407* 443* 616* 741* 755* 794* 813* 1549 packed_sw 000476 automatic bit(1) dcl 1247 in procedure "get_options_var_args" set ref 1252* 1257 1261* 1270* packed_sw 000100 automatic bit(1) dcl 1355 in procedure "get_value_arg" set ref 1359* 1377 packed_sw 000100 automatic bit(1) dcl 1593 in procedure "set_value_arg" set ref 1627* packed_sw 000100 automatic bit(1) dcl 1545 in procedure "return_code" set ref 1554* pair_count 1 based fixed bin(17,0) level 2 dcl 1-17 set ref 531* 536 546 556 577 pairs 3 based structure array level 2 dcl 1-17 path 000236 automatic char(168) unaligned dcl 202 set ref 759* 760* 762* 764* 766* pathname_ 000112 constant entry external dcl 256 ref 399 perprocess_seg_ptr 000010 internal static pointer initial dcl 156 set ref 1308 1309* 1312 1313 1314 1316 1319 1321 person_id 000100 automatic char(22) unaligned dcl 1198 set ref 1202* 1203 pointer builtin function dcl 267 ref 486 508 880 968 973 992 995 1149 1187 pop_sw 000324 automatic bit(1) initial dcl 212 set ref 212* 592* 660 679 703 pp based structure level 1 dcl 55 pp_ptr 000344 automatic pointer dcl 215 set ref 281* 283* 294* 301* 326* 347* 349* 453* 466 468* 626* 648* 666* 711 pp_sw 000457 automatic bit(1) unaligned dcl 1124 in procedure "find_in" set ref 1128* 1130 1142 1148 1169 1183 pp_sw 000516 automatic bit(1) unaligned dcl 1299 in procedure "get_ptrs" set ref 1303* 1307 1330 pp_sw 000434 automatic bit(1) unaligned dcl 1058 in procedure "delete_node" set ref 1061* 1063 pp_sw 4 based bit(1) level 4 in structure "node" packed unaligned dcl 76 in procedure "value_" set ref 542 692 850* pp_sw_arg defined bit(1) unaligned dcl 208 ref 1301 1303 ptr parameter pointer level 2 in structure "P_alloc_info" dcl 1349 in procedure "get_value_arg" set ref 1373* 1377* 1380 1381 ptr parameter pointer level 2 in structure "P_value_info" dcl 1587 in procedure "set_value_arg" set ref 1606 1621 1638* ptr parameter pointer level 2 in structure "P_value_info" dcl 1348 in procedure "get_value_arg" set ref 1380* ptr parameter pointer level 2 in structure "P_value_info" dcl 1118 in procedure "find_in" set ref 1166* ptr 000142 automatic pointer level 2 in structure "alloc_info" dcl 108 in procedure "value_" set ref 630* 636 636 726 726 745* 800* 819* ptr 000112 automatic pointer level 2 in structure "value_info" dcl 99 in procedure "value_" set ref 672 715* ptr 000122 automatic pointer level 2 in structure "new_value_info" dcl 105 in procedure "value_" set ref 657* 695 724 ptr parameter pointer level 2 in structure "P_name_info" dcl 1117 in procedure "find_in" ref 1132 1133 1134 1163 ptr 000132 automatic pointer level 2 in structure "old_value_info" dcl 106 in procedure "value_" set ref 672 817* ptr 000106 automatic pointer level 2 in structure "name_info" dcl 95 in procedure "value_" set ref 723 1027* 1280* 1284* ptr_ht 10 based pointer array level 2 packed unaligned dcl 55 set ref 423* 853 853* 867* 1067* 1143 1148 1316* 1412 push_sw 4(02) based bit(1) level 4 in structure "node" packed unaligned dcl 76 in procedure "value_" set ref 305 858* 871* 895* push_sw 000325 automatic bit(1) initial dcl 212 in procedure "value_" set ref 212* 305* 309 602* 688 856 869 893 regexp_sw 3(01) based bit(1) array level 3 packed unaligned dcl 1-7 ref 1492 region_size 3 based fixed bin(17,0) level 3 dcl 40 set ref 433* 1005 1006* 1006* 1007 1008* 1399* rel builtin function dcl 267 ref 896 960 1398 release_temp_segment_ 000114 constant entry external dcl 257 ref 565 567 575 576 954 1014 remote_area_ptr 4 based pointer level 2 in structure "pp" dcl 55 in procedure "value_" set ref 425* 427* 839 1069 1319* remote_area_ptr 4 based pointer level 3 in structure "seg" dcl 40 in procedure "value_" set ref 1396* rtrim builtin function dcl 267 ref 760 930 932 933 1028 1132 1136 1203 1285 salvaging_sw 7 based bit(1) level 3 dcl 40 set ref 956* 1010* 1432 saved_chars_len 000371 automatic fixed bin(21,0) dcl 220 set ref 478* 514 saved_region_size 000114 automatic fixed bin(17,0) dcl 945 set ref 1005* 1008 saved_sort_count 000363 automatic fixed bin(17,0) dcl 219 set ref 479* 515 search_file_ 000116 constant entry external dcl 258 ref 1492 seg based structure level 1 dcl 40 set ref 1007* 1007 seg_code 000373 automatic fixed bin(35,0) dcl 221 set ref 612* 710* 1329* seg_mode 000360 automatic fixed bin(5,0) dcl 218 set ref 781* 783 784 seg_mode_bits based structure level 1 packed unaligned dcl 195 seg_ptr 4 parameter pointer level 2 in structure "P_value_info" dcl 1118 in procedure "find_in" set ref 1174* 1176* seg_ptr 000346 automatic pointer dcl 215 in procedure "value_" set ref 281* 283* 294* 296* 298* 301* 314* 326* 328* 330* 347* 349* 447* 453* 471 471 471* 480* 483 484 486 486 495* 508 513 626* 638* 645* 648* 652* 663* 666* 709 709 730 730 730 730 730* 734* 764* 768* 769 771* 773 774 777 779* 781* 786* 1025* 1257* 1258* seg_ptr 4 000112 automatic pointer level 2 in structure "value_info" dcl 99 in procedure "value_" set ref 353 353 356* seg_sw 000517 automatic bit(1) unaligned dcl 1299 set ref 1304* 1325 seg_sw_arg defined bit(1) unaligned dcl 209 ref 710 1301 1304 segp 4 parameter pointer level 2 in structure "P_node_ptrs" dcl 1119 in procedure "find_in" set ref 1139* segp 4 parameter pointer level 2 in structure "P_node_ptrs" dcl 1056 in procedure "delete_node" set ref 1061 1067 1069 1077 1079 1079 1082 1082 1082 1082* segp 4 000150 automatic pointer level 2 in structure "node_ptrs" dcl 113 in procedure "value_" set ref 686 sequence based picture(6) level 3 packed unaligned dcl 123 set ref 1512 1519* sequential_number 000364 automatic fixed bin(17,0) dcl 219 set ref 464* 1518* 1518 1519 set_entrypoint_sw 000326 automatic bit(1) initial dcl 212 set ref 212* 624* set_lock_$lock 000120 constant entry external dcl 260 ref 1438 1463 set_lock_$unlock 000122 constant entry external dcl 261 ref 1662 sort_array based structure level 1 dcl 119 sort_array_ptr 000350 automatic pointer dcl 216 set ref 455* 459* 464 479 515 520 527* 529 538 565* 575 575* 1523 1523 1524 1524 sort_entries_ptr 000352 automatic pointer dcl 216 set ref 455* 460* 462 567* 576 576* sort_entry based structure level 1 dcl 123 set ref 463 sort_entry_ptr 000354 automatic pointer dcl 216 set ref 462* 463 463 538* 540 1510 1511 1512 1512 1519 1524 1528* 1528 sort_field 2 based structure level 2 dcl 123 set ref 463 1524 sort_field_offset 000365 automatic fixed bin(17,0) dcl 219 set ref 463* 538 sort_items_$varying_char 000124 constant entry external dcl 262 ref 527 sub_error 000000 stack reference condition dcl 269 ref 1648 substr builtin function dcl 267 set ref 546* 556* 672 672 933 1133 1267* 1267 1606* 1606 1621* 1621 switches 000320 automatic bit(36) unaligned dcl 207 in procedure "value_" set ref 448* 710 710 1026* 1266* 1267* 1301 1301 1301 1301 1303 1303 1304 1304 switches 4 based structure level 3 in structure "node" dcl 76 in procedure "value_" set ref 849* 883* 1044* sys_info$max_seg_size 000052 external static fixed bin(24,0) dcl 239 ref 889 1399 temp_node_ptr 000104 automatic pointer dcl 942 set ref 968* 977* 982 983 984 989 991 992* temp_ptr 000106 automatic pointer dcl 942 set ref 949* 951* 954* 958 959 960 961 963 964 966 968 992 1001 1005 1006 1007 1014* test_entrypoint_sw 000333 automatic bit(1) dcl 213 set ref 622* 668 705 749* 805* 821* this parameter pointer level 2 in structure "P_node_ptrs" dcl 1056 in procedure "delete_node" ref 1065 1067 1070 1075 1077 1079 this 000150 automatic pointer level 2 in structure "node_ptrs" dcl 113 in procedure "value_" set ref 305 486* 489 491 493 495* 495 495 498* 501 501* 505 506 507* 508* 692 692 692 695 713* 1412* 1412* 1415 1415* 1418 this parameter pointer level 2 in structure "P_node_ptrs" dcl 831 in procedure "add_node" ref 853 856 859 861 869 872 874 893 896 899 900 901 905 906 this parameter pointer level 2 in structure "P_node_ptrs" dcl 1119 in procedure "find_in" set ref 1138* 1148* 1149* 1151 1153 1155 1157* 1157 1157 1160* 1163 1163 1166 1167 1181 1183* 1183 1185 1186* 1187* trash_count 12 based fixed bin(17,0) level 3 dcl 40 set ref 730 730 901* 901 906* 906 959* 1079* 1079 1082 1082 type_switches 3 based bit(36) array level 3 dcl 1-17 set ref 542* 543* unspec builtin function dcl 267 set ref 432* 774* 849* 883* 1044* 1136 1266* user_info_ 000126 constant entry external dcl 263 ref 1202 user_info_$homedir 000130 constant entry external dcl 264 ref 1200 value based varying char level 2 in structure "node" dcl 76 in procedure "value_" set ref 556 695* 724* 1048* 1166 value based char level 2 in structure "old_node_format" dcl 81 in procedure "value_" ref 1048 value_index 6 based fixed bin(21,0) array level 3 dcl 1-17 set ref 550* 554* value_info 000112 automatic structure level 1 dcl 99 set ref 283* 301* 349* 351* 356* 648* 666* 677* 718* value_len 4 based fixed bin(21,0) level 2 in structure "old_node_format" dcl 81 in procedure "value_" set ref 495* 901 1046 1048 1157* value_len 6 based fixed bin(21,0) level 3 in structure "node" dcl 76 in procedure "value_" set ref 551 555 692 695 724 845* 874 886* 888 906 983* 983 984 989 1046* 1048 1070 1079 1167 1533 value_len 7 based fixed bin(21,0) array level 3 in structure "value_list_info" dcl 1-17 in procedure "value_" set ref 551* 555* 556 557 value_list_info based structure level 1 dcl 1-17 set ref 531 577 value_list_info_ptr 000102 automatic pointer dcl 1-3 set ref 455* 531* 533 536 542 543 544 545 546 546 547 550 551 554 555 556 556 557 561 563 577 577 value_list_info_version_1 constant fixed bin(17,0) initial dcl 1-27 ref 533 value_string based char unaligned dcl 1589 in procedure "set_value_arg" ref 1606 value_string based char unaligned dcl 186 in procedure "value_" ref 672 value_version_1 constant fixed bin(17,0) initial dcl 138 ref 847 881 1040 1312 1394 varying_sw 000477 automatic bit(1) dcl 1247 set ref 1272* 1275* 1279 version based fixed bin(17,0) level 3 in structure "node" dcl 76 in procedure "value_" set ref 847* 881* 1040* version based fixed bin(17,0) level 2 in structure "pp" dcl 55 in procedure "value_" set ref 1312* version based fixed bin(17,0) level 2 in structure "value_list_info" dcl 1-17 in procedure "value_" set ref 533* version based fixed bin(17,0) level 3 in structure "seg" dcl 40 in procedure "value_" set ref 1394* where_ptr 000356 automatic pointer dcl 216 set ref 686* 690 691 709* 711* 715 720* wordno builtin function dcl 267 ref 463 463 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. alloc_max_name_len automatic fixed bin(21,0) dcl 1-5 alloc_name_count automatic fixed bin(17,0) dcl 1-4 based_fb35 based fixed bin(35,0) dcl 1481 char8 based char(8) unaligned dcl 184 match_info_version_1 internal static fixed bin(17,0) initial dcl 1-27 number_picture automatic picture(6) unaligned dcl 205 NAMES DECLARED BY EXPLICIT CONTEXT. ADD_NODE 002632 constant label dcl 720 ref 688 DELETE 000316 constant label dcl 301 ref 309 333 FIND 005471 constant label dcl 1130 ref 1171 FOUND1 000506 constant label dcl 351 ref 356 GET 000477 constant label dcl 347 ref 386 GET_DATA 000675 constant label dcl 379 ref 374 INITIATE 006132 constant label dcl 1216 ref 1223 1225 LIST 001334 constant label dcl 443 ref 586 LIST_RETURN 002052 constant label dcl 565 ref 522 MATCH 010013 constant label dcl 1500 ref 1490 NOT_FOUND1 000550 constant label dcl 363 ref 358 RETURN 000557 constant label dcl 366 ref 1551 1560 SEARCH_SEG 001531 constant label dcl 480 ref 516 SET 002250 constant label dcl 624 ref 751 808 823 SET_RETURN 002700 constant label dcl 726 ref 683 696 TEST_FAIL 002444 constant label dcl 670 ref 672 705 VALUE_SET 002233 constant label dcl 616 ref 596 606 add_node 003763 constant entry internal dcl 825 ref 495 720 1157 add_suffix 004371 constant entry internal dcl 922 ref 764 766 compact_trash 004506 constant entry internal dcl 939 ref 730 1082 copy_args 005114 constant entry internal dcl 1019 ref 277 292 324 384 743 815 copy_old_format_node 005151 constant entry internal dcl 1034 ref 498 977 1160 defined 000146 constant entry external dcl 271 delete 000233 constant entry external dcl 287 delete_data 000363 constant entry external dcl 318 delete_node 005233 constant entry internal dcl 1052 ref 307 648 681 find 005361 constant entry internal dcl 1089 ref 283 301 349 648 666 find_in 005461 constant entry internal dcl 1112 ref 356 1100 1105 get 000451 constant entry external dcl 335 get_alloc 000607 constant entry external dcl 370 get_data 000644 constant entry external dcl 376 get_default_path 006023 constant entry internal dcl 1195 ref 397 758 1216 get_default_ptr 006121 constant entry internal dcl 1207 ref 1327 1572 get_options_var_args 006250 constant entry internal dcl 1235 ref 343 620 798 get_path 000717 constant entry external dcl 388 get_ptrs 006564 constant entry internal dcl 1290 ref 281 294 326 347 453 626 get_value_arg 007006 constant entry internal dcl 1342 ref 660 803 init_seg 007224 constant entry internal dcl 1385 in procedure "value_" ref 418 771 init_seg 001061 constant entry external dcl 403 list 001316 constant entry external dcl 438 list_cleanup 003654 constant entry internal dcl 573 ref 457 list_data_names 002135 constant entry external dcl 581 list_pp 007326 constant entry internal dcl 1404 ref 468 471 lock_for_read 007371 constant entry internal dcl 1423 ref 480 1130 lock_for_write 007455 constant entry internal dcl 1451 ref 296 328 645 663 match_one 007622 constant entry internal dcl 1474 ref 501 1415 pop 002156 constant entry external dcl 588 push 002176 constant entry external dcl 598 return_code 010120 constant entry internal dcl 1537 ref 361 363 382 401 409 411 412 413 415 416 436 654 670 703 710 736 767 769 777 782 783 788 843 889 1301 1310 1331 1335 1375 1391 1392 1444 1460 1461 1464 1575 1602 1616 1636 set 002216 constant entry external dcl 608 set_data 002763 constant entry external dcl 738 set_path 003026 constant entry external dcl 753 set_seg 010212 constant entry internal dcl 1564 ref 786 set_value_arg 010255 constant entry internal dcl 1581 ref 351 677 718 signal_error 010577 constant entry internal dcl 1643 ref 1030 1253 1262 1271 1274 1360 1628 test_and_set 003525 constant entry external dcl 790 test_and_set_data 003614 constant entry external dcl 810 unlock_for_write 010612 constant entry internal dcl 1653 ref 298 314 330 638 652 734 value_ 000130 constant entry external dcl 21 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 12314 12446 11177 12324 Length 13074 11177 132 412 1114 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME value_ 614 external procedure is an external procedure. on unit on line 298 70 on unit on unit on line 330 70 on unit on unit on line 457 88 on unit list_cleanup internal procedure shares stack frame of on unit on line 457. on unit on line 635 70 on unit on unit on line 779 70 on unit add_node 84 internal procedure enables or reverts conditions. on unit on line 843 70 on unit add_suffix 69 internal procedure uses returns(char(*)) or returns(bit(*)). compact_trash 106 internal procedure enables or reverts conditions. on unit on line 954 82 on unit copy_args internal procedure shares stack frame of external procedure value_. copy_old_format_node 66 internal procedure is called by several nonquick procedures. delete_node internal procedure shares stack frame of external procedure value_. find internal procedure shares stack frame of external procedure value_. find_in internal procedure shares stack frame of external procedure value_. get_default_path 79 internal procedure is called by several nonquick procedures. get_default_ptr 166 internal procedure enables or reverts conditions. on unit on line 1223 64 on unit get_options_var_args internal procedure shares stack frame of external procedure value_. get_ptrs internal procedure shares stack frame of external procedure value_. get_value_arg 99 internal procedure enables or reverts conditions. on unit on line 1375 70 on unit init_seg 76 internal procedure enables or reverts conditions. on unit on line 1391 70 on unit on unit on line 1392 70 on unit list_pp internal procedure shares stack frame of external procedure value_. lock_for_read internal procedure shares stack frame of external procedure value_. lock_for_write 86 internal procedure enables or reverts conditions. on unit on line 1460 70 on unit on unit on line 1461 70 on unit match_one internal procedure shares stack frame of external procedure value_. return_code 90 internal procedure is called by several nonquick procedures. set_seg internal procedure shares stack frame of external procedure value_. set_value_arg 105 internal procedure enables or reverts conditions. on unit on line 1602 70 on unit on unit on line 1616 70 on unit on unit on line 1636 70 on unit signal_error 70 internal procedure is called by several nonquick procedures. unlock_for_write 80 internal procedure is called by several nonquick procedures. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 perprocess_seg_ptr value_ 000012 default_seg_ptr value_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME add_node 000100 area_ptr add_node 000102 new_node_ptr add_node 000104 new_node_offset add_node 000105 next_free_word add_node add_suffix 000100 entry_len add_suffix compact_trash 000100 last_node_ptr compact_trash 000102 old_node_ptr compact_trash 000104 temp_node_ptr compact_trash 000106 temp_ptr compact_trash 000110 next_node_offset compact_trash 000111 next_word_offset compact_trash 000112 next_free_word compact_trash 000113 i compact_trash 000114 saved_region_size compact_trash get_default_path 000100 person_id get_default_path get_default_ptr 000100 dn get_default_ptr 000152 en get_default_ptr get_value_arg 000100 packed_sw get_value_arg 000102 arg_ptr get_value_arg 000104 arg_len get_value_arg 000105 arg_scale get_value_arg 000106 arg_size get_value_arg 000107 arg_type get_value_arg 000110 ndims get_value_arg return_code 000100 packed_sw return_code 000102 arg_ptr return_code 000104 arg_len return_code 000105 arg_scale return_code 000106 arg_size return_code 000107 arg_type return_code 000110 ndims return_code set_value_arg 000100 packed_sw set_value_arg 000102 arg_ptr set_value_arg 000104 arg_len set_value_arg 000105 arg_scale set_value_arg 000106 arg_size set_value_arg 000107 arg_type set_value_arg 000110 ndims set_value_arg 000111 bit_size set_value_arg value_ 000100 match_info_ptr value_ 000102 value_list_info_ptr value_ 000104 alloc_pair_count value_ 000105 alloc_chars_len value_ 000106 name_info value_ 000112 value_info value_ 000122 new_value_info value_ 000132 old_value_info value_ 000142 alloc_info value_ 000150 node_ptrs value_ 000157 options_var_sw value_ 000160 arg_list_ptr value_ 000162 code_arg_index value_ 000163 old_value_arg_index value_ 000164 dn value_ 000236 path value_ 000310 en value_ 000320 switches value_ 000321 node_offset value_ 000322 alloc_entrypoint_sw value_ 000323 function_entrypoint_sw value_ 000324 pop_sw value_ 000325 push_sw value_ 000326 set_entrypoint_sw value_ 000327 data_entrypoint_sw value_ 000330 found_one_sw value_ 000331 local_pp_sw value_ 000332 locked_sw value_ 000333 test_entrypoint_sw value_ 000334 area_ptr value_ 000336 new_node_ptr value_ 000340 node_ptr value_ 000342 old_node_ptr value_ 000344 pp_ptr value_ 000346 seg_ptr value_ 000350 sort_array_ptr value_ 000352 sort_entries_ptr value_ 000354 sort_entry_ptr value_ 000356 where_ptr value_ 000360 seg_mode value_ 000361 begin_change_count value_ 000362 i value_ 000363 saved_sort_count value_ 000364 sequential_number value_ 000365 sort_field_offset value_ 000366 chars_index value_ 000367 node_name_len value_ 000370 node_value_len value_ 000371 saved_chars_len value_ 000372 code value_ 000373 seg_code value_ 000434 pp_sw delete_node 000436 area_ptr delete_node 000454 hash_str find_in 000456 next_node_offset find_in 000457 pp_sw find_in 000460 begin_change_count find_in 000461 hash_index find_in 000462 i find_in 000464 first_node_ptr find_in 000466 old_node_ptr find_in 000476 packed_sw get_options_var_args 000477 varying_sw get_options_var_args 000500 arg_ptr get_options_var_args 000502 arg_len get_options_var_args 000503 arg_scale get_options_var_args 000504 arg_size get_options_var_args 000505 arg_type get_options_var_args 000506 ndims get_options_var_args 000516 pp_sw get_ptrs 000517 seg_sw get_ptrs 000540 i lock_for_read 000550 excluded_sw match_one 000551 matched_sw match_one 000552 i match_one 000553 code match_one THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp unpk_to_pk cat_realloc_chars call_ext_out_desc call_ext_out call_int_this_desc call_int_this call_int_other_desc call_int_other return_mac longbs_to_fx2 tra_ext_1 mdfx3 signal_op enable_op shorten_stack ext_entry ext_entry_desc int_entry int_entry_desc set_bits_eis return_chars_eis op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. assign_ cu_$arg_list_ptr cu_$arg_ptr_rel decode_descriptor_ expand_pathname_ get_system_free_area_ get_temp_segment_ hcs_$fs_get_mode hcs_$fs_get_path_name hcs_$initiate hcs_$make_seg hcs_$set_bc_seg hcs_$terminate_noname hcs_$truncate_seg match_star_name_ pathname_ release_temp_segment_ search_file_ set_lock_$lock set_lock_$unlock sort_items_$varying_char user_info_ user_info_$homedir THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$action_not_performed error_table_$bad_conversion error_table_$badcall error_table_$boundviol error_table_$invalid_lock_reset error_table_$locked_by_this_process error_table_$lower_ring error_table_$no_r_permission error_table_$no_w_permission error_table_$noalloc error_table_$noentry error_table_$nomatch error_table_$not_seg_type error_table_$oldnamerr error_table_$out_of_sequence sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 212 000120 21 000127 271 000140 273 000166 275 000170 277 000172 279 000173 281 000174 283 000176 285 000215 287 000226 289 000254 290 000256 292 000257 294 000260 296 000262 298 000270 300 000315 301 000316 304 000323 305 000325 307 000332 309 000334 310 000336 312 000337 314 000344 316 000352 318 000361 320 000404 321 000405 322 000407 324 000410 326 000411 328 000413 330 000421 332 000446 333 000447 335 000450 339 000461 340 000463 341 000465 343 000474 345 000476 347 000477 349 000501 351 000506 353 000522 356 000532 358 000537 361 000540 362 000547 363 000550 366 000557 368 000572 370 000601 372 000632 373 000634 374 000635 376 000636 378 000673 379 000675 382 000676 384 000711 386 000712 388 000713 390 000740 392 000741 394 000742 397 001001 399 001015 401 001045 403 001053 407 001074 409 001075 411 001115 412 001131 413 001141 415 001157 416 001173 418 001202 420 001211 421 001215 422 001221 423 001231 424 001237 425 001241 427 001254 428 001265 431 001266 432 001272 433 001275 436 001300 438 001307 442 001333 443 001334 446 001335 447 001336 448 001342 449 001344 450 001347 451 001352 453 001365 455 001367 457 001373 459 001411 460 001436 462 001463 463 001465 464 001477 466 001502 468 001506 471 001512 478 001525 479 001527 480 001531 483 001533 484 001543 486 001547 487 001552 489 001554 491 001560 493 001563 495 001565 498 001603 501 001613 505 001623 506 001625 507 001627 508 001633 509 001636 511 001637 513 001641 514 001645 515 001647 516 001651 520 001652 521 001654 522 001657 527 001660 529 001667 531 001671 533 001711 534 001713 536 001715 538 001725 540 001732 542 001734 543 001746 544 001753 545 001760 546 001762 547 002001 549 002003 550 002006 551 002007 552 002013 554 002014 555 002016 556 002020 557 002040 559 002041 561 002043 563 002047 564 002051 565 002052 567 002077 569 002124 581 002133 585 002152 586 002154 588 002155 592 002166 593 002170 594 002172 596 002174 598 002175 602 002206 603 002210 604 002212 606 002214 608 002215 612 002226 614 002227 615 002231 616 002233 618 002235 620 002244 622 002246 624 002250 626 002252 630 002254 631 002256 633 002265 635 002266 636 002302 638 002314 639 002326 641 002327 643 002331 645 002336 646 002344 648 002346 652 002355 654 002363 657 002372 658 002376 659 002401 660 002402 663 002422 664 002430 666 002432 668 002437 670 002441 672 002453 675 002463 677 002464 679 002476 681 002500 683 002502 686 002503 688 002505 690 002507 691 002513 692 002520 695 002535 696 002553 699 002554 703 002555 705 002566 709 002570 710 002577 711 002611 713 002613 715 002615 716 002617 718 002620 720 002632 723 002650 724 002662 726 002700 730 002711 734 002736 736 002744 738 002753 741 003012 743 003013 745 003014 748 003016 749 003020 751 003021 753 003022 755 003047 757 003050 758 003057 759 003073 760 003113 761 003153 762 003155 764 003160 765 003236 766 003251 767 003312 768 003323 769 003362 771 003374 773 003402 774 003405 777 003410 779 003422 781 003450 782 003463 783 003473 784 003505 786 003513 788 003515 790 003523 794 003535 795 003537 796 003541 798 003550 800 003552 801 003554 803 003563 805 003601 806 003603 808 003604 810 003605 813 003635 815 003636 817 003637 818 003643 819 003646 821 003650 823 003653 573 003654 575 003655 576 003707 577 003741 579 003761 825 003762 837 003770 839 003776 840 004000 841 004003 843 004005 845 004031 847 004055 848 004057 849 004061 850 004062 851 004064 853 004070 856 004103 858 004111 859 004114 860 004120 861 004121 863 004127 865 004132 867 004143 869 004145 871 004154 872 004156 873 004161 874 004162 875 004200 879 004201 880 004203 881 004205 882 004207 883 004211 884 004212 885 004217 886 004221 888 004223 889 004241 891 004252 893 004262 895 004271 896 004274 897 004301 899 004302 900 004306 901 004312 903 004324 905 004325 906 004331 909 004344 911 004345 913 004347 915 004361 918 004364 922 004370 930 004404 932 004420 933 004445 935 004476 939 004505 947 004513 949 004521 950 004544 951 004547 952 004563 954 004566 956 004627 958 004634 959 004640 960 004641 961 004644 963 004645 964 004656 966 004662 968 004664 969 004667 971 004671 973 004673 977 004706 982 004723 983 004727 984 004731 987 004747 989 004756 990 004777 991 005003 992 005004 994 005007 995 005012 997 005020 999 005022 1001 005024 1005 005027 1006 005031 1007 005037 1008 005045 1010 005047 1012 005050 1014 005067 1017 005113 1019 005114 1023 005115 1025 005116 1026 005122 1027 005124 1028 005126 1030 005142 1032 005147 1034 005150 1040 005156 1041 005162 1042 005166 1043 005171 1044 005173 1045 005174 1046 005176 1047 005200 1048 005210 1050 005232 1052 005233 1061 005235 1063 005243 1065 005244 1067 005256 1069 005263 1070 005265 1071 005303 1075 005304 1077 005316 1079 005323 1082 005340 1087 005360 1089 005361 1098 005363 1100 005367 1103 005417 1105 005424 1108 005453 1112 005461 1128 005463 1130 005471 1132 005504 1133 005523 1134 005531 1136 005534 1138 005556 1139 005562 1140 005565 1142 005566 1143 005570 1144 005574 1145 005610 1146 005611 1148 005623 1149 005634 1151 005644 1153 005651 1155 005655 1157 005657 1160 005675 1163 005706 1166 005727 1167 005736 1169 005743 1171 005745 1173 005752 1174 005755 1175 005756 1176 005757 1178 005761 1181 005767 1183 005771 1185 006000 1186 006004 1187 006010 1189 006014 1191 006015 1195 006022 1200 006043 1202 006054 1203 006065 1205 006116 1207 006120 1214 006126 1216 006132 1218 006147 1219 006213 1223 006214 1225 006233 1228 006242 1231 006243 1235 006250 1252 006252 1253 006277 1256 006311 1257 006333 1258 006345 1261 006350 1262 006376 1265 006410 1266 006432 1267 006433 1270 006440 1271 006466 1272 006476 1274 006504 1275 006512 1278 006513 1279 006535 1280 006537 1281 006541 1282 006545 1284 006546 1285 006550 1288 006563 1290 006564 1301 006566 1303 006611 1304 006613 1307 006615 1308 006617 1309 006624 1310 006646 1312 006656 1313 006661 1314 006664 1315 006666 1316 006675 1317 006702 1319 006704 1321 006714 1322 006720 1323 006721 1325 006724 1326 006726 1327 006733 1328 006741 1329 006746 1330 006750 1331 006753 1335 006761 1337 007000 1338 007001 1340 007004 1342 007005 1359 007013 1360 007036 1362 007046 1366 007067 1367 007077 1368 007101 1369 007104 1370 007110 1371 007111 1373 007115 1375 007130 1377 007154 1380 007212 1381 007216 1383 007222 1385 007223 1391 007231 1392 007255 1394 007301 1395 007305 1396 007310 1398 007312 1399 007317 1402 007324 1404 007326 1410 007330 1412 007341 1415 007352 1418 007362 1419 007366 1421 007370 1423 007371 1432 007373 1434 007377 1436 007405 1438 007412 1439 007430 1442 007440 1444 007442 1445 007450 1447 007451 1449 007453 1451 007454 1457 007462 1458 007467 1460 007474 1461 007520 1463 007544 1464 007565 1469 007604 1470 007615 1472 007621 1474 007622 1486 007624 1488 007626 1490 007637 1492 007664 1497 007746 1499 010010 1500 010013 1501 010027 1503 010031 1505 010033 1509 010040 1510 010044 1511 010045 1512 010056 1518 010061 1519 010062 1523 010072 1524 010073 1528 010076 1532 010110 1533 010112 1535 010116 1537 010117 1549 010125 1550 010130 1551 010133 1554 010136 1555 010160 1556 010163 1557 010204 1560 010207 1564 010212 1570 010214 1571 010220 1572 010223 1573 010231 1575 010232 1576 010246 1579 010253 1581 010254 1598 010262 1599 010265 1600 010272 1602 010276 1604 010322 1606 010336 1609 010345 1612 010346 1613 010350 1614 010356 1616 010362 1618 010406 1620 010416 1621 010421 1624 010427 1627 010430 1628 010453 1630 010463 1632 010470 1634 010511 1636 010517 1638 010543 1641 010575 1643 010576 1648 010604 1649 010607 1651 010610 1653 010611 1659 010617 1660 010624 1662 010631 1664 010642 1666 010665 ----------------------------------------------------------- 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