COMPILATION LISTING OF SEGMENT dfm_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: ACTC Technologies Inc. Compiled on: 10/21/92 1021.9 mdt Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 4* * * 5* * Copyright, (C) Honeywell Bull Inc., 1989 * 6* * * 7* * Copyright, (C) Honeywell Information Systems Inc., 1986 * 8* * * 9* *********************************************************** */ 10 11 12 13 /****^ HISTORY COMMENTS: 14* 1) change(86-08-21,Fakoury), approve(86-08-21,MCR7515), 15* audit(87-01-07,Farley), install(87-01-08,MR12.0-1263): 16* Originally coded 0782 by Rick Fakoury for MR12. 17* 2) change(87-01-13,Fakoury), approve(87-01-13,MCR7515), 18* audit(87-01-14,Martinson), install(87-01-14,MR12.0-1278): 19* PBF to correct -deckfile short name to -df from -dkf. 20* 3) change(89-02-06,Fakoury), approve(90-10-03,MCR8147), 21* audit(90-10-03,Parisek), install(90-10-25,MR12.4-1049): 22* to to allow tape copy without using a deck file or list seg. 23* 4) change(89-06-01,Fakoury), approve(90-10-03,MCR8147), 24* audit(90-10-03,Parisek), install(90-10-25,MR12.4-1049): 25* to to insert a space in the copy tape attach description for TR21325 26* to increase the size of att_desc from 64 to 181 for TR21336. 27* 5) change(90-10-30,Fakoury), approve(90-11-28,MCR8219), 28* audit(90-11-28,Schroth), install(90-11-28,MR12.4-1051): 29* PBF correct to previous installation: changed to call dfm_util_$make_key 30* after call to get_cata for catalog record. 31* END HISTORY COMMENTS */ 32 33 /* format: style4,ifthenstmt,ifthen,ind3,ll125,lineconind1 */ 34 dfm_: proc (); 35 36 return; /* not a valid entry */ 37 38 39 40 /* AUTOMATIC */ 41 42 dcl N fixed bin; 43 dcl X fixed bin; 44 dcl al fixed bin (21); 45 dcl all_diskettes bit (1); 46 dcl alp ptr; 47 dcl ap ptr; 48 dcl c_att_desc char (181); 49 dcl code fixed bin (35); 50 dcl decks_tb_deleted (10) char (24) varying; 51 dcl deck_tb_patched char (24) varying; 52 dcl deckfile_path char (168); 53 dcl diskettes_tb_read (hbound (valid_diskettes, 1)) char (8) varying; 54 dcl diskette_type char (4); 55 dcl dkf_dir (3) char (168); 56 dcl dkf_entry (3) char (32); 57 dcl dkf_path (3) char (168); 58 dcl dkf_path_idx fixed bin; 59 dcl dl_patch bit (1); 60 dcl dwg_num_tab char (2); 61 dcl eof bit (1); 62 dcl err bit (1); 63 dcl lsf_dir char (168); 64 dcl lsf_entry char (32); 65 dcl i fixed bin; 66 dcl j fixed bin; 67 dcl list_all_keys bit (1); 68 dcl mca bit (1); 69 dcl mca_err bit (72); 70 dcl mca_id char (4); 71 dcl ml fixed bin (21); 72 dcl n_diskettes_tb_read fixed bin; 73 dcl nargs fixed bin; 74 dcl npatches fixed bin; 75 dcl ndecks_tb_deleted fixed bin; 76 dcl of_dir char (168); 77 dcl of_entry char (32); 78 dcl of_path char (168); 79 dcl output_mode_specified bit (1); 80 dcl patch_length fixed bin; 81 dcl patch_ptr ptr; 82 dcl patch_word char (84) varying; 83 dcl pname char (72) varying; 84 dcl prod_num_tab char (2); 85 dcl query_info_ptr ptr; 86 dcl query_message char (256); 87 dcl rl fixed bin (21); 88 dcl sci_ptr ptr; 89 dcl tdec fixed bin (35); 90 dcl term bit (1); 91 dcl user_entry char (8) varying; 92 dcl user_reply char (256) varying; 93 dcl vfile_open_mode fixed bin; 94 dcl xofn char (2); 95 dcl yes_sw bit (1); 96 97 98 /* BASED */ 99 100 dcl add_pic pic "999999" based; 101 dcl arg char (al) based (ap); 102 dcl bin_arg fixed bin (35) based (ap); 103 dcl bit_arg bit (al) based (ap); 104 dcl 1 df_keys based (dfm_data.dfkp) aligned, /* template for deckfile catalog keys */ 105 2 n_entries fixed bin, /* number of catalog entries */ 106 2 key (1 refer (df_keys.n_entries)) char (24); /* entry search keys */ 107 108 dcl free_area area based (get_system_free_area_ ()); 109 110 dcl ptr_arg ptr based (ap); 111 112 113 /* BUILTINS */ 114 115 dcl addr builtin; 116 dcl before builtin; 117 dcl bin builtin; 118 dcl char builtin; 119 dcl clock builtin; 120 dcl convert builtin; 121 dcl index builtin; 122 dcl hbound builtin; 123 dcl lbound builtin; 124 dcl length builtin; 125 dcl ltrim builtin; 126 dcl null builtin; 127 dcl rtrim builtin; 128 dcl search builtin; 129 dcl string builtin; 130 dcl substr builtin; 131 dcl translate builtin; 132 dcl unspec builtin; 133 134 135 /* CONDITIONS */ 136 137 dcl cleanup condition; 138 139 140 /* CONSTANTS */ 141 142 dcl deckfile char (16) int static options (constant) init (">tandd_deck_file"); 143 dcl false bit (1) int static options (constant) init ("0"b); 144 dcl minargs fixed bin int static options (constant) init (3); 145 dcl nl_sw bit (1) aligned int static options (constant) init ("0"b); 146 dcl pad_sw bit (1) aligned int static options (constant) init ("0"b); 147 dcl print bit (1) int static options (constant) init ("0"b); 148 dcl system_dir char (21) int static options (constant) init 149 (">system_library_tandd"); 150 dcl true bit (1) int static options (constant) init ("1"b); 151 dcl wrapup bit (1) int static options (constant) init ("1"b); 152 153 154 /* EXTERNAL ENTRIES */ 155 156 dcl command_query_ entry () options (variable); 157 dcl command_query_$yes_no entry () options (variable); 158 dcl cu_$arg_count entry (fixed bin, fixed bin (35)); 159 dcl cu_$arg_list_ptr entry (ptr); 160 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); 161 dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); 162 dcl date_time_ entry (fixed bin (52), char (*)); 163 dcl date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) var); 164 dcl dfm_util_$ck_applic entry (ptr) returns (bit (1)); 165 dcl dfm_util_$copy_eof entry (ptr); 166 dcl dfm_util_$delete_deck entry (ptr, char (24) var, fixed bin (35)); 167 dcl dfm_util_$detach_file entry (ptr, ptr); 168 dcl dfm_util_$find_dkend entry (ptr, char (24) var, ptr, fixed bin, fixed bin (35)); 169 dcl dfm_util_$find_file entry (ptr, char (*), char (*)); 170 dcl dfm_util_$find_key entry (ptr, ptr, char (24) var, ptr, fixed bin (35)); 171 dcl dfm_util_$get_cata entry (ptr, ptr, char (24) var, ptr, ptr, fixed bin (35)); 172 dcl dfm_util_$insert_deck entry (ptr, ptr, ptr, fixed bin (21), char (24) varying); 173 dcl dfm_util_$make_key entry (ptr); 174 dcl dfm_util_$mca_attach entry (ptr, char (4)); 175 dcl dfm_util_$mca_detach entry (ptr); 176 dcl dfm_util_$merge_files entry (ptr, ptr, ptr); 177 dcl dfm_util_$mount_diskette entry (ptr, char (8) var, ptr) returns (bit (1)); 178 dcl dfm_util_$open_file entry (ptr, char (64), char (181), fixed bin (17), ptr); 179 dcl dfm_util_$print_list entry (ptr, ptr, char (24) varying); 180 dcl dfm_util_$read_deck entry (ptr, bit (1), bit (1)); 181 dcl dfm_util_$read_diskette entry (ptr, char (*), ptr, fixed bin (21), bit (72), fixed bin (35)); 182 dcl dfm_util_$update_list entry (ptr, fixed bin (2)); 183 dcl dfm_util_$valid_diskette entry (ptr, char (8) varying) returns (bit (1)); 184 dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); 185 dcl get_system_free_area_ entry () returns (ptr); 186 dcl get_wdir_ entry returns (char (168)); 187 dcl hcs_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35)); 188 dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned); 189 dcl ioa_$rsnnl entry () options (variable); 190 dcl mca_$read_data entry (fixed bin, ptr, fixed bin (21), fixed bin (21), bit (72), fixed bin (35)); 191 dcl ssu_$arg_count entry (ptr, fixed bin); 192 dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); 193 dcl ssu_$abort_line entry () options (variable); 194 dcl ssu_$abort_subsystem entry () options (variable); 195 dcl ssu_$get_info_ptr entry (ptr) returns (ptr); 196 dcl ssu_$get_temp_segment entry (ptr, char (*), ptr); 197 dcl ssu_$get_subsystem_and_request_name entry (ptr) returns (char (72) var); 198 dcl ssu_$print_message entry () options (variable); 199 dcl ssu_$release_temp_segment entry (ptr, ptr); 200 dcl sub_err_ entry () options (variable); 201 202 203 /* EXTERNAL STATIC */ 204 205 dcl error_table_$bad_arg fixed bin (35) ext static; 206 dcl error_table_$noarg fixed bin (35) ext static; 207 dcl error_table_$segnamedup fixed bin (35) ext static; 208 dcl error_table_$too_many_names fixed bin (35) ext static; 209 dcl iox_$user_output ext ptr; 210 211 /* PARAMETERS */ 212 213 dcl P_dfm_infop ptr parameter; 214 dcl P_sci_ptr ptr parameter; 215 216 217 218 219 /* clean_up - general clean up rountine */ 220 221 clean_up: entry (P_sci_ptr, P_dfm_infop); 222 223 call setup_part1; 224 call wrap_up; 225 226 return; 227 228 229 230 231 232 233 /* This procedure is a general purpose complainer. If ABORT is true, then 234* ssu_$abort_line is called. ssu_$print_message is called otherwise. */ 235 236 /* calling sequence: dfm_$complain (dfm_datap, abort, code, ioa_control_string, arg1...argn) */ 237 238 complain: entry options (variable); 239 240 241 dcl ecode fixed bin (35); 242 dcl message char (256); 243 dcl ABORT bit (1); 244 245 246 message = ""; 247 ml = 0; 248 249 call cu_$arg_count (nargs, code); 250 if nargs < minargs then 251 call sub_err_ (code, "dfm_$complain", ACTION_CANT_RESTART, null, 0, ""); 252 253 do i = 1 to minargs; 254 call cu_$arg_ptr (i, ap, al, code); 255 if code ^= 0 then 256 call sub_err_ (code, "dfm_$complain", ACTION_CANT_RESTART, 257 null, 0, "encountered while attempting to get ^[dfm_datap^;abort^;code^] arg.", i); 258 259 else if i = 1 then dfm_datap = ptr_arg; 260 else if i = 2 then ABORT = bit_arg; 261 else if i = 3 then ecode = bin_arg; 262 end; 263 264 sci_ptr = dfm_data.sci_ptr; 265 266 if nargs > minargs then do; 267 call cu_$arg_list_ptr (alp); 268 call ioa_$general_rs (alp, 4, 5, message, ml, pad_sw, nl_sw); 269 end; 270 271 272 if ABORT then do; 273 dfm_infop = dfm_data.infop; 274 call wrap_up; /* free the stuff I MAY have allocated */ 275 276 call ssu_$abort_line (sci_ptr, ecode, "^a", substr (message, 1, ml)); /* BYE! */ 277 end; 278 else call ssu_$print_message (sci_ptr, ecode, "^a", substr (message, 1, ml)); 279 return; 280 281 282 283 284 /* delete_deck - entry to delete a deck a deckfile */ 285 286 delete_deck: entry (P_sci_ptr, P_dfm_infop); 287 288 289 call setup_part1; 290 call setup_part2; 291 dd = true; 292 ndecks_tb_deleted = 0; 293 294 on cleanup call wrap_up; 295 296 call ssu_$arg_count (sci_ptr, nargs); 297 298 if nargs > 0 then do i = 1 to nargs; 299 call ssu_$arg_ptr (sci_ptr, i, ap, al); 300 301 if arg = "-deckfile" | arg = "-df" then do; /* user will specify path */ 302 i = i + 1; 303 call ssu_$arg_ptr (sci_ptr, i, ap, al); 304 if al = 0 then 305 call complain (dfm_datap, wrapup, error_table_$bad_arg, 306 "obtaining ""-deckfile"" specification.", ""); 307 else deckfile_path = arg; 308 end; 309 310 else if arg = "-brief" | arg = "-bf" then dfm_data.bf_sw = true; /* user doesn't want unnecessary nessages */ 311 312 else do; 313 ndecks_tb_deleted = ndecks_tb_deleted + 1; 314 if ndecks_tb_deleted > hbound (decks_tb_deleted, 1) then 315 call complain (dfm_datap, wrapup, error_table_$too_many_names, 316 "only ^d decks maybe deleted", hbound (decks_tb_deleted, 1)); 317 decks_tb_deleted (ndecks_tb_deleted) = arg; 318 end; 319 end; 320 321 if ndecks_tb_deleted = 0 then do; 322 call complain (dfm_datap, print, error_table_$noarg, 323 "No key given to specify the deck to be deleted.", ""); 324 325 query_message = "Enter a key or partial key for the deck to be deleted."; 326 query_info.explanation_len = length (rtrim (query_message)); 327 query_info.explanation_ptr = addr (query_message); 328 call command_query_ (query_info_ptr, user_reply, pname, 329 "Enter: "); 330 331 ndecks_tb_deleted = 1; 332 decks_tb_deleted (ndecks_tb_deleted) = user_reply; 333 end; 334 335 if ndecks_tb_deleted > 0 then do; 336 337 call ssu_$get_temp_segment (sci_ptr, "catalog keys", dfm_data.dfkp); /* get temp seg for catalog keys */ 338 call ssu_$get_temp_segment (sci_ptr, "catalog list", dfm_data.lcatp); /* get temp seg for list catalog */ 339 dfm_data.liocb_ptr = iox_$user_output; 340 dfm_data.terminal_out = true; 341 dfm_data.deckfile_sw = true; /* deckfile is required */ 342 343 call get_files; 344 do i = 1 to ndecks_tb_deleted; 345 call dfm_util_$find_key (dfm_datap, dfm_data.fiocb_ptr, 346 decks_tb_deleted (i), dfm_data.dfkp, code); 347 if code ^= 0 then 348 call complain (dfm_datap, wrapup, code, 349 "attempting to find keys for ^a", decks_tb_deleted (i)); 350 351 term = false; 352 if df_keys.n_entries > 1 then do j = 1 to df_keys.n_entries while (^term); 353 call command_query_$yes_no (yes_sw, 0, pname, "^d ^2s entries matched the key given", 354 "key given matched ^d entries. ^/Entry ^d is ^a - Is this the deck to be deleted?", 355 df_keys.n_entries, j, df_keys.key (j)); 356 if yes_sw then do; 357 term = true; 358 j = j - 1; /* adjust to correct value */ 359 end; 360 end; 361 362 else j = 1; 363 364 if j <= df_keys.n_entries then do; 365 decks_tb_deleted (i) = df_keys.key (j); 366 call dfm_util_$delete_deck (dfm_datap, decks_tb_deleted (i), code); 367 if code ^= 0 then 368 call complain (dfm_datap, wrapup, code, 369 "attempting to delete deck ^a", decks_tb_deleted (i)); 370 dfm_data.list_key = "ls." || rtrim (decks_tb_deleted (i)); 371 call dfm_util_$print_list (dfm_datap, dfm_data.fiocb_ptr, dfm_data.list_key); 372 end; 373 end; 374 end; 375 376 377 call wrap_up; 378 379 return; 380 381 382 383 /* list - entry to generate a list file or display on the user terminal 384* all or portion of the list information in a deckfile */ 385 386 387 list: entry (P_sci_ptr, P_dfm_infop); 388 389 call setup_part1; 390 call setup_part2; 391 392 dfm_data.list = true; 393 list_all_keys = false; 394 output_mode_specified = false; 395 396 on cleanup call wrap_up; 397 398 call ssu_$arg_count (sci_ptr, nargs); 399 400 if nargs > 0 then do i = 1 to nargs; 401 call ssu_$arg_ptr (sci_ptr, i, ap, al); 402 403 if arg = "-all" | arg = "-a" then list_all_keys = true; 404 405 else if arg = "-brief" | arg = "-bf" then 406 dfm_data.bf_sw = true; /* user doesn't want unnecessary nessages */ 407 408 else if arg = "-deckfile" | arg = "-df" then do; /* user will specify path */ 409 i = i + 1; 410 call ssu_$arg_ptr (sci_ptr, i, ap, al); 411 if al = 0 then 412 call complain (dfm_datap, wrapup, error_table_$bad_arg, 413 "obtaining ""-deckfile"" specification.", ""); 414 else deckfile_path = arg; 415 end; 416 417 else if arg = "-file_out" | arg = "-fo" then do; 418 dfm_data.terminal_out = false; 419 output_mode_specified = true; 420 end; 421 422 else if arg = "-term_out" | arg = "-to" then 423 dfm_data.terminal_out, output_mode_specified = true; 424 425 else if dfm_data.list_key = "" then dfm_data.list_key = arg; 426 else call complain (dfm_datap, wrapup, error_table_$bad_arg, 427 "More than one list key specified.", ""); 428 end; 429 430 if ^list_all_keys & dfm_data.list_key = "" then do; 431 call complain (dfm_datap, print, error_table_$noarg, 432 "Insufficient number of args supplied.", ""); 433 434 query_message = "Enter a key for the file to be listed or all to create a complete deckfile.list."; 435 query_info.explanation_len = length (rtrim (query_message)); 436 query_info.explanation_ptr = addr (query_message); 437 call command_query_ (query_info_ptr, user_reply, pname, 438 "Enter: "); 439 440 if user_reply = "-all" 441 | user_reply = "-a" then list_all_keys = true; 442 else dfm_data.list_key = user_reply; 443 end; 444 445 if ^output_mode_specified & dfm_data.list_key ^= "" then do; 446 dfm_data.terminal_out = true; 447 dfm_data.page_no = 0; 448 end; 449 450 dfm_data.deckfile_sw = true; /* deckfile is required */ 451 452 call get_files; 453 call ssu_$get_temp_segment (sci_ptr, "catalog keys", dfm_data.lcatp); /* get temp seg for catalog keys */ 454 lcata.n_entries = 0; /* initially set to 0 entries */ 455 if dfm_data.terminal_out then dfm_data.liocb_ptr = iox_$user_output; 456 if list_all_keys then do i = lbound (list_types, 1) to hbound (list_types, 1); 457 dfm_data.list_key = list_types (i); 458 call dfm_util_$find_key (dfm_datap, dfm_data.fiocb_ptr, dfm_data.list_key, dfm_data.lcatp, code); 459 if code ^= 0 then dfm_data.list_key = ""; 460 if dfm_data.list_key ^= "" then 461 call dfm_util_$print_list (dfm_datap, dfm_data.fiocb_ptr, dfm_data.list_key); 462 end; 463 464 else if dfm_data.list_key ^= "" then do; 465 if index (dfm_data.list_key, "ls.") ^= 1 then dfm_data.list_key = "ls." || dfm_data.list_key; 466 call dfm_util_$find_key (dfm_datap, dfm_data.fiocb_ptr, dfm_data.list_key, dfm_data.lcatp, code); 467 if code ^= 0 then 468 call complain (dfm_datap, wrapup, code, 469 "attempting to find keys for ^a", dfm_data.list_key); 470 471 if lcata.n_entries > 1 then do j = 1 to lcata.n_entries while (^term); 472 call command_query_$yes_no (yes_sw, 0, pname, "^d^2s entries matched the key given", 473 "key given matched ^d entries.^/ Entry ^d is ^a - Is this the file to be listed?", 474 lcata.n_entries, j, lcata.key (j)); 475 if yes_sw then do; 476 term = true; 477 dfm_data.list_key = lcata.key (j); 478 end; 479 else dfm_data.list_key = ""; 480 end; 481 482 if dfm_data.list_key = "" then 483 call complain (dfm_datap, wrapup, 0, 484 "There are no files to be listed", ""); 485 else call dfm_util_$print_list (dfm_datap, dfm_data.fiocb_ptr, dfm_data.list_key); 486 end; 487 488 call wrap_up; 489 490 return; 491 492 493 494 495 /* list_diskettes - entry to list valid diskette types used in the 496* load_from_diskette entry */ 497 498 list_diskette_types: entry (P_sci_ptr, P_dfm_infop); 499 500 dcl out_str char (hbound (valid_diskettes, 1) * 5) varying; 501 502 call setup_part1; 503 504 on cleanup call wrap_up; 505 506 out_str = ""; 507 do i = 1 to hbound (valid_diskettes, 1); 508 out_str = out_str || substr (valid_diskettes (i), 1, 3) || " "; 509 end; 510 call complain (dfm_datap, print, 0, "^/^a^/", out_str); 511 dfm_data.finished = true; 512 dfm_info.flags.request_active = false; 513 return; 514 515 516 517 518 /* load_from_diskette - entry to read MCA diskettes into a deckfile */ 519 520 load_from_diskette: entry (P_sci_ptr, P_dfm_infop); 521 522 call setup_part1; 523 call setup_part2; 524 dfm_data.lfd = true; 525 dir_ptr = null; 526 527 on cleanup begin; 528 if dir_ptr ^= null then free directory in (free_area); 529 call wrap_up; 530 end; 531 532 all_diskettes = false; 533 mca = false; 534 call ssu_$arg_count (sci_ptr, nargs); 535 if nargs > 0 then do i = 1 to nargs; 536 call ssu_$arg_ptr (sci_ptr, i, ap, al); 537 538 if arg = "-mca" then do; 539 i = i + 1; 540 call ssu_$arg_ptr (sci_ptr, i, ap, al); 541 if al ^= 1 then 542 call complain (dfm_datap, wrapup, 0, 543 "arg following -mca arg incorrect", ""); 544 else if search (arg, "abcd") = 0 then 545 call complain (dfm_datap, wrapup, 0, 546 "arg following -mca arg incorrect", ""); 547 else mca = true; 548 mca_id = "mca" || arg; 549 end; 550 551 else if arg = "-brief" 552 | arg = "-bf" then dfm_data.bf_sw = true; /* user doesn't want unnecessary nessages */ 553 554 else if arg = "-deckfile" 555 | arg = "-df" then do; /* user will specify path */ 556 i = i + 1; 557 call ssu_$arg_ptr (sci_ptr, i, ap, al); 558 if al = 0 then 559 call complain (dfm_datap, wrapup, error_table_$bad_arg, 560 "obtaining ""-deckfile"" specification.", ""); 561 else deckfile_path = arg; 562 end; 563 564 else if arg = "-all" | arg = "-a" then all_diskettes = true; 565 566 else if dfm_util_$valid_diskette (dfm_datap, (arg)) then do; 567 n_diskettes_tb_read = n_diskettes_tb_read + 1; 568 diskettes_tb_read (n_diskettes_tb_read) = arg; 569 end; 570 else call complain (dfm_datap, wrapup, 0, "Invalid arg ^a", arg); 571 end; 572 573 if n_diskettes_tb_read = 0 & ^all_diskettes then do; 574 call complain (dfm_datap, print, error_table_$noarg, 575 "A diskette to be read must be specified", ""); 576 577 query_message = "Enter a diskette name, or -all for all diskettes"; 578 query_info.explanation_len = length (rtrim (query_message)); 579 query_info.explanation_ptr = addr (query_message); 580 call command_query_ (query_info_ptr, user_reply, pname, 581 "Enter: "); 582 583 if user_reply = "-all" 584 | user_reply = "-a" then all_diskettes = true; 585 586 else do; 587 user_entry = substr (user_reply, 1, 8); 588 if dfm_util_$valid_diskette (dfm_datap, user_entry) then do; 589 n_diskettes_tb_read = 1; 590 diskettes_tb_read (n_diskettes_tb_read) = user_entry; 591 end; 592 593 else call complain (dfm_datap, wrapup, 0, 594 "Invalid diskette name, use list_diskette_types (ldt) request to obtain valid types", ""); 595 end; 596 end; 597 598 599 if ^mca then do; 600 query_message = "Enter the mca (a-d) of the mca to be used"; 601 query_info.explanation_len = length (rtrim (query_message)); 602 query_info.explanation_ptr = addr (query_message); 603 call command_query_ (query_info_ptr, user_reply, pname, 604 " Enter MCA to be used "); 605 if search (user_reply, "abcd") = 0 then 606 call complain (dfm_datap, wrapup, 0, "invalid mca id entered", ""); 607 else mca = true; 608 mca_id = "mca" || rtrim (user_reply); 609 end; 610 611 612 if all_diskettes then do; 613 n_diskettes_tb_read = hbound (valid_diskettes, 1); 614 diskettes_tb_read = valid_diskettes; 615 end; 616 617 if n_diskettes_tb_read < 1 then 618 call complain (dfm_datap, wrapup, 0, "no diskette type entered", ""); 619 620 call ssu_$get_temp_segment (sci_ptr, "catalog keys", dfm_data.lcatp); /* get temp seg for list catalog */ 621 622 call ssu_$get_temp_segment (sci_ptr, "diskette catalog", dfm_data.dcatp); /* get temp seg for diskette catalog */ 623 624 call ssu_$get_temp_segment (sci_ptr, "mca catalog", dfm_data.mcatp); /* get temp seg for mca catalog */ 625 626 call ssu_$get_temp_segment (sci_ptr, "mca data read buffer", dfm_data.mca_wksp); /* get temp seg for reading mca data */ 627 628 629 630 /* attach and open needed files */ 631 632 dfm_data.deckfile_sw = true; /* deckfile is required */ 633 call get_files; 634 call dfm_util_$mca_attach (dfm_datap, mca_id); 635 636 637 638 639 /* main processing loop */ 640 641 642 call dfm_util_$get_cata (dfm_datap, dfm_data.fiocb_ptr, 643 "cata.nio.mca", dfm_data.mcatp, dfm_data.mksp, code); 644 if code ^= 0 then 645 call complain (dfm_datap, wrapup, code, "can't get mca catalog", ""); 646 647 do i = 1 to n_diskettes_tb_read; 648 unspec (dcata) = "0"b; 649 650 remount: 651 if dfm_util_$mount_diskette (dfm_datap, 652 translate (diskettes_tb_read (i), uc, lc), dfm_data.mca_wksp) then 653 call dfm_util_$read_diskette (dfm_datap, "HDR", 654 dfm_data.mca_wksp, rl, mca_err, code); 655 656 else do; 657 call complain (dfm_datap, print, code, pname, 658 "Operator unable to mount diskette ^a", diskettes_tb_read (i)); 659 query_message = "Problems encountered mounting the diskette. Enter: - (a)bort, (s)kip or (r)etry? "; 660 query_info.explanation_len = length (rtrim (query_message)); 661 query_info.explanation_ptr = addr (query_message); 662 call command_query_ (query_info_ptr, user_reply, pname, 663 "Enter: - (a)bort, (s)kip or (r)etry? "); 664 if user_reply = "r" | user_reply = "retry" then goto remount; 665 if user_reply = "s" | user_reply = "skip" then goto next_disk; 666 else goto exit_lfd; 667 end; 668 669 header_ptr = dfm_data.mca_wksp; 670 if mca_status.maj | mca_sub.data_p | code ^= 0 671 | substr (translate (header.unique_id, lc, uc), 1, 3) ^= substr (diskettes_tb_read (i), 1, 3) 672 | substr (header.title, 1, 4) ^= "UTIL" then do; 673 if substr (translate (header.unique_id, lc, uc), 1, 3) ^= substr (diskettes_tb_read (i), 1, 3) then do; 674 call complain (dfm_datap, print, pname, 675 "Diskette ^a mounted - instead of ^a? ", header.unique_id, diskettes_tb_read (i)); 676 query_message = "Wrong diskette mounted. Enter: - (a)bort, (s)kip or (r)etry? "; 677 query_info.explanation_len = length (rtrim (query_message)); 678 query_info.explanation_ptr = addr (query_message); 679 call command_query_ (query_info_ptr, user_reply, pname, 680 "Enter: - (a)bort, (s)kip or (r)etry? "); 681 if user_reply = "r" | user_reply = "retry" then goto remount; 682 if user_reply = "s" | user_reply = "skip" then goto next_disk; 683 else goto exit_lfd; 684 end; 685 686 next_disk: if i < n_diskettes_tb_read then do; 687 call command_query_$yes_no (yes_sw, code, pname, 688 "Unable to read the HEADER - want to continue", 689 "Unable to read the ^a - read the next diskette?", "HEADER"); 690 if yes_sw then goto next_diskette; 691 else goto exit_lfd; 692 end; 693 else call complain (dfm_datap, wrapup, code, 694 "reading ^a HEADER", (diskettes_tb_read (i))); 695 end; 696 697 call complain (dfm_datap, print, 0, 698 "Mounted diskette ^a on drive ^d", header.unique_id, dfm_data.disk_num); 699 N = bin (substr (header.x_of_n, 1, 9), 9); 700 X = bin (substr (header.x_of_n, 10, 9), 9); 701 unspec (xofn) = header.x_of_n; 702 dir_number = 0; 703 substr (unspec (dir_number), 21, 16) = header.dir_size.msb || header.dir_size.lsb; 704 dir_number = dir_number / 16; 705 dfm_data.edit_date = header.date_changed; 706 diskette_type = header.equip_type; 707 dwg_num_tab = substr (header.disk_dwg_num, 11); 708 prod_num_tab = substr (header.unique_id, 7); 709 dfm_data.current_disk_name = rtrim (header.unique_id); 710 current_filename = rtrim ("HDR." || header.unique_id || prod_num_tab || "00"); 711 712 if i = 1 then call add_name ("mca.diskettes.rev." || prod_num_tab); 713 call dfm_util_$get_cata (dfm_datap, dfm_data.fiocb_ptr, 714 "cata.nio." || rtrim (header.unique_id), dfm_data.dcatp, dfm_data.dksp, code); 715 if code ^= 0 then 716 call complain (dfm_datap, wrapup, code, 717 "can't get ^a catalog", header.unique_id); 718 call file_deck (dfm_data.mca_wksp, rl); 719 call dfm_util_$read_diskette (dfm_datap, "DIRECTORY", 720 dfm_data.mca_wksp, rl, mca_err, code); 721 722 if mca_status.maj | mca_sub.data_p | code ^= 0 then do; 723 if i < n_diskettes_tb_read then do; 724 call command_query_$yes_no (yes_sw, code, pname, 725 "Unable to read DIRECTORY file. Want to continue?", 726 "Unable to read ^a file. Read the next diskette?", "DIRECTORY"); 727 if yes_sw then goto next_diskette; 728 else goto exit_lfd; 729 end; 730 else call complain (dfm_datap, wrapup, code, 731 "reading ^a DIRECTORY", diskettes_tb_read (i)); 732 end; 733 734 dir_ptr = dfm_data.mca_wksp; 735 alloc directory in (free_area) set (dir_ptr); 736 directory = dfm_data.mca_wksp -> directory; 737 current_filename = rtrim (diskette_type || ".DIRECTRY" || prod_num_tab || "00"); 738 call file_deck (dfm_data.mca_wksp, rl); 739 740 do j = 1 to dir_number; 741 dire_ptr = addr (directory.array (j)); 742 if (dire.path_name = ".DPSFILE" & j < dir_number) 743 | dire.deleted then goto next_file; 744 call dfm_util_$read_diskette (dfm_datap, "P=" || dire.path_name, 745 dfm_data.mca_wksp, rl, mca_err, code); 746 if mca_status.maj | code ^= 0 then do; 747 if j < dir_number then do; 748 call command_query_$yes_no (yes_sw, code, pname, 749 "Unable to read last file. Want to continue?", 750 "Unable to read file ^a. Read the next file?", dire.path_name); 751 if yes_sw then goto next_file; 752 end; 753 else do; 754 free directory in (free_area); 755 dir_ptr = null; 756 call complain (dfm_datap, wrapup, code, 757 "unable to read file ^a", dire.path_name); 758 end; 759 end; 760 current_filename = rtrim (dire.path_name || prod_num_tab || dwg_num_tab); 761 call file_deck (dfm_data.mca_wksp, rl); 762 next_file: end; 763 free directory in (free_area); 764 dir_ptr = null; 765 current_filename = rtrim ("cata." || dfm_data.current_disk_name); 766 rl = dcata.n_entries * 24 + 4; 767 call file_deck (dfm_data.dcatp, rl); 768 next_diskette: 769 dfm_data.hdr_sw = true; /* force a new header */ 770 end; 771 dfm_data.current_filename = rtrim ("cata.mca"); 772 rl = mcata.n_entries * 24 + 4; 773 call file_deck (dfm_data.mcatp, rl); 774 775 call dfm_util_$insert_deck (dfm_datap, dfm_data.fiocb_ptr, dfm_data.lcatp, 776 length (unspec (lcata)), "ls.cata." || dfm_data.ls_type || ".list"); 777 call dfm_util_$print_list (dfm_datap, dfm_data.fiocb_ptr, 778 "ls.cata." || dfm_data.ls_type || ".list"); 779 780 exit_lfd: 781 call wrap_up; 782 783 return; 784 785 786 787 788 /* load_from_tape - entry to read an ifad or fnp tape into a deckfile */ 789 790 load_from_tape: entry (P_sci_ptr, P_dfm_infop); 791 792 call setup_part1; 793 call setup_part2; 794 dfm_data.lft = true; 795 796 on cleanup call wrap_up; 797 798 call ssu_$arg_count (sci_ptr, nargs); 799 800 if nargs > 0 then do j = 1 to nargs; 801 call ssu_$arg_ptr (sci_ptr, j, ap, al); 802 if index (arg, "-") ^= 1 then do; /* must be tape name */ 803 dfm_data.t_att_desc = "tape_nstd_ " || arg; /* start attach description */ 804 805 if tdec = 6250 | tdec = 1600 | tdec = 800 | tdec = 556 | tdec = 200 then 806 dfm_data.t_att_desc = rtrim (dfm_data.t_att_desc) || " -density " || ltrim (char (tdec)); 807 808 tape_name = before (arg, ","); /* If comma, use stuff before */ 809 dfm_data.l_att_desc = "vfile_ " || tape_name; /* start listing attach description */ 810 end; 811 812 else if arg = "-brief" | arg = "-bf" then dfm_data.bf_sw = true; /* user doesn't want unnecessary nessages */ 813 else if arg = "-firmware" | arg = "-fw" then do; 814 dfm_data.firmware_sw = true; /* user just wants firmware loaded */ 815 dfm_data.attach_copy, dfm_data.deckfile_sw = false; 816 end; 817 818 else if arg = "-copy" | arg = "-cp" then do; /* user wantsd to make copy of ifad tape */ 819 j = j + 1; 820 call ssu_$arg_ptr (sci_ptr, j, ap, al); 821 if al = 0 then 822 call complain (dfm_datap, wrapup, code, 823 "obtaining ""-copy"" tape reel specification.", ""); 824 c_att_desc = "tape_nstd_ " || arg; /* generate initial copy attach description */ 825 826 if tdec = 6250 | tdec = 1600 | tdec = 800 | tdec = 556 | tdec = 200 then 827 c_att_desc = rtrim (c_att_desc) || " -density " || ltrim (char (tdec)); 828 dfm_data.attach_copy = true; /* set flag */ 829 dfm_data.firmware_sw = false; 830 end; 831 832 else if arg = "-deckfile" | arg = "-df" then do; /* user will specify path */ 833 j = j + 1; 834 call ssu_$arg_ptr (sci_ptr, j, ap, al); 835 if al = 0 then 836 call complain (dfm_datap, wrapup, error_table_$bad_arg, 837 "obtaining ""-deckfile"" specification.", ""); 838 else deckfile_path = arg; 839 dfm_data.deckfile_sw = true; 840 end; 841 842 else if arg = "-density" | arg = "-den" then do; /* next arg must be density value */ 843 j = j + 1; 844 call ssu_$arg_ptr (sci_ptr, j, ap, al); 845 if al = 0 then 846 call complain (dfm_datap, wrapup, code, 847 "obtaining ""-density"" specification.", ""); 848 tdec = cv_dec_check_ (arg, code); 849 if code ^= 0 then go to bad_arg; 850 if tdec = 6250 | tdec = 1600 | tdec = 800 | tdec = 556 | tdec = 200 then do; 851 if dfm_data.attach_copy then do; /* if setting density on copy tape */ 852 c_att_desc = rtrim (c_att_desc) || " -density " || ltrim (char (tdec)); 853 cd_sw = true; /* set indicator */ 854 end; 855 if dfm_data.tape_name ^= "" then 856 dfm_data.t_att_desc = rtrim (dfm_data.t_att_desc) || " -density " || ltrim (char (tdec)); 857 end; 858 else go to bad_arg; /* make him get it right */ 859 end; 860 861 else if arg = "-patches" then 862 dfm_data.allow_0_cksum = true; /* user wants to allow firmware decks with a 0 checksum */ 863 864 else if arg = "-track" | arg = "-tk" then do; /* next arg must be 7 or 9 */ 865 j = j + 1; 866 call ssu_$arg_ptr (sci_ptr, j, ap, al); /* get track arg */ 867 if al = 0 then /* error */ 868 call complain (dfm_datap, wrapup, code, 869 "obtaining ""-track"" specification.", ""); 870 tdec = cv_dec_check_ (arg, code); /* convert to dec. for check */ 871 if code ^= 0 then go to bad_arg; /* must be numeric */ 872 if tdec ^= 7 & tdec ^= 9 then go to bad_arg; /* and only 7 or 9 */ 873 if dfm_data.attach_copy then /* if track specification of copy tape */ 874 c_att_desc = rtrim (c_att_desc) || " -track " || arg; /* insert leading blank */ 875 else dfm_data.t_att_desc = rtrim (dfm_data.t_att_desc) || " -track " || arg; 876 end; 877 878 else do; 879 bad_arg: call complain (dfm_datap, wrapup, error_table_$bad_arg, "^a", arg); 880 end; 881 end; 882 883 if ^dfm_data.attach_copy /* if ^copy */ 884 & ^dfm_data.deckfile_sw /* & ^deckfile */ 885 & ^dfm_data.firmware_sw /* & ^firmware only */ 886 then dfm_data.deckfile_sw = true; /* default is to use the deckfile */ 887 888 if ^dfm_data.firmware_sw & dfm_data.deckfile_sw /* if ^firmware & deckfile */ 889 then dfm_data.firmware_sw = true; /* default is to create firmware segs */ 890 891 if dfm_data.tape_name = "" then do; 892 call complain (dfm_datap, print, error_table_$noarg, 893 "A tape name must be supplied", ""); 894 895 query_message = "Enter the name of the tape, ifad or 6670bdt, to be mounted."; 896 query_info.explanation_len = length (rtrim (query_message)); 897 query_info.explanation_ptr = addr (query_message); 898 call command_query_ (query_info_ptr, user_reply, pname, 899 "Enter : "); 900 901 dfm_data.t_att_desc = "tape_nstd_ " || user_reply; /* start attach description */ 902 tape_name = before (user_reply, ","); /* If comma, use stuff before */ 903 dfm_data.l_att_desc = "vfile_ " || dfm_data.tape_name; /* start listing attach description */ 904 end; 905 906 if dfm_data.tape_name = "" then 907 call complain (dfm_datap, wrapup, code, 908 "^/Usage:^-load_from_tape reel_id {-control_args}", ""); 909 910 911 call ssu_$get_temp_segment (sci_ptr, "tape buffer", dfm_data.bptr); /* get temp segs for tape buffer */ 912 call ssu_$get_temp_segment (sci_ptr, "catalog buffer", dfm_data.catp); /* get temp segs for catalog buffer */ 913 call ssu_$get_temp_segment (sci_ptr, "catalog keys", dfm_data.lcatp); /* get temp seg for catalog keys */ 914 915 call get_files; /* attach and open needed files */ 916 917 call add_name (dfm_data.tape_name); 918 919 920 do while (^dfm_data.eot); /* read tape until 2 eofs */ 921 call dfm_util_$read_deck (dfm_datap, eof, err); /* read in next object deck */ 922 if err | (eof & one_eof) | dfm_data.eot then do; /* if error condition or 2 eofs */ 923 dfm_data.eot = true; /* thats all there is to do */ 924 925 if dfm_data.attach_copy then 926 call dfm_util_$copy_eof (dfm_datap); /* if we are copying tape,write out 2nd eof */ 927 928 if dfm_data.fnp_tape & ^err & ^dfm_data.list then do; /* write out fnp catalog record */ 929 dfm_data.current_key = "cata." || rtrim (dfm_data.cat_key); /* form completed key */ 930 call dfm_util_$insert_deck (dfm_datap, dfm_data.fiocb_ptr, dfm_data.catp, 931 length (unspec (cata)), dfm_data.current_key); /* and write catalog to deck file */ 932 call dfm_util_$update_list (dfm_datap, cata_list_type); /* add catalog record to listing file */ 933 end; 934 end; 935 else if eof then do; /* if eof */ 936 one_eof = true; /* set flag */ 937 if dfm_data.attach_copy then /* if we are copying tape */ 938 if ^dfm_data.copy_at_eof then /* and copy tape is not already at end of file */ 939 call dfm_util_$copy_eof (dfm_datap); /* go write eof on copy tape */ 940 941 if dfm_data.cat_build 942 & ^dfm_data.fnp_tape then do; /* if we were building catalog */ 943 dfm_data.cat_build, dfm_data.first_deck = false; /* reset flags */ 944 if index (dfm_data.cat_key, "itr.") ^= 0 then do; /* if building itr catalog */ 945 if id_blk.type = "itr" | id_blk.type = "mdr" then do; /* last entry must be firmware */ 946 call complain (dfm_datap, print, 0, "Last object deck on itr file is not firmware", ""); 947 call complain (dfm_datap, wrapup, 0, "Last object card image is:^/""^a""", dfm_data.obj_card); 948 end; 949 else do; /* no errors form catalog name */ 950 do i = cata.n_entries to 1 by -1 while (index (cata.key (i), ".") > 4); 951 end; /* find first firmware deck */ 952 cata.n_entries = cata.n_entries + 1; 953 dfm_data.cat_key = rtrim (dfm_data.cat_key) 954 || substr (cata.key (i + 1), 8, 6) || "." || substr (cata.key (i + 1), 20, 2); 955 end; 956 end; 957 dfm_data.current_key = "cata." || rtrim (dfm_data.cat_key); /* set current key */ 958 call dfm_util_$insert_deck (dfm_datap, dfm_data.fiocb_ptr, 959 dfm_data.catp, length (unspec (cata)), dfm_data.current_key); /* and write catalog to deck file */ 960 call dfm_util_$update_list (dfm_datap, cata_list_type); /* add catalog record to listing file */ 961 end; 962 end; 963 964 else do; 965 one_eof = false; /* reset eof flag if set */ 966 if dfm_data.list then /* if just producing listing, take all decks */ 967 call dfm_util_$update_list (dfm_datap, data_list_type); /* go add entry to listing file */ 968 969 else if dfm_data.fnp_tape /* no applicability check for fnp decks */ 970 | (dfm_util_$ck_applic (dfm_datap) /* check for Multics applicibilty */ 971 & dfm_data.deckfile_sw) then 972 call file_deck (dfm_data.bptr, dfm_data.dlen * 4); /* just loading firmware, don't insert deck into deckfile */ 973 974 end; 975 end; 976 977 call dfm_util_$insert_deck (dfm_datap, dfm_data.fiocb_ptr, dfm_data.lcatp, 978 length (unspec (lcata)), "ls.cata." || dfm_data.ls_type || ".list"); 979 980 call dfm_util_$print_list (dfm_datap, dfm_data.fiocb_ptr, "ls.cata." || dfm_data.ls_type || ".list"); 981 call wrap_up; 982 return; 983 984 985 986 987 /* merge_deckfiles - entry to merge two or more tandd_deck_files */ 988 989 merge_deckfiles: entry (P_sci_ptr, P_dfm_infop); 990 991 call setup_part1; 992 call setup_part2; 993 dfm_data.mdf = true; 994 995 call ssu_$arg_count (sci_ptr, nargs); 996 dkf_path_idx = 1; /* point to first path */ 997 998 do i = 1 to nargs; 999 call ssu_$arg_ptr (sci_ptr, i, ap, al); 1000 1001 if arg = "-brief" 1002 | arg = "-bf" then dfm_data.bf_sw = true; /* user doesn't want unnecessary nessages */ 1003 1004 else if arg = "-output_file" 1005 | arg = "-of" then do; 1006 i = i + 1; 1007 call ssu_$arg_ptr (sci_ptr, i, ap, al); 1008 if al = 0 then 1009 call complain (dfm_datap, wrapup, code, "obtaining ""-output_file"" specification.", ""); 1010 else of_path = arg; 1011 end; 1012 1013 else if dkf_path_idx > hbound (dkf_path, 1) then 1014 call complain (dfm_datap, wrapup, error_table_$bad_arg, 1015 "More than ^d deck files to be merged", hbound (dkf_path, 1)); 1016 1017 else do; 1018 dkf_path (dkf_path_idx) = arg; 1019 dkf_path_idx = dkf_path_idx + 1; 1020 end; 1021 end; 1022 1023 if dkf_path (1) = "" then do; 1024 call complain (dfm_datap, print, error_table_$noarg, 1025 "At least one input deckfile path is required", ""); 1026 1027 query_message = "Input deckfile path may be either a path or -working_dir or -system"; 1028 query_info.explanation_len = length (rtrim (query_message)); 1029 query_info.explanation_ptr = addr (query_message); 1030 call command_query_ (query_info_ptr, user_reply, pname, 1031 "Enter : "); 1032 1033 dkf_path (1) = user_reply; 1034 end; 1035 1036 1037 if of_path = "" & dfm_info.deckfile_dir = "" then do; 1038 call complain (dfm_datap, print, error_table_$noarg, 1039 "An output deckfile path is required", ""); 1040 1041 query_message = "Output deckfile path may be either a path or -working_dir or -system"; 1042 query_info.explanation_len = length (rtrim (query_message)); 1043 query_info.explanation_ptr = addr (query_message); 1044 call command_query_ (query_info_ptr, user_reply, pname, 1045 "Enter : "); 1046 1047 of_path = user_reply; 1048 end; 1049 1050 if dkf_path (1) = "" | of_path = "" then 1051 call complain (dfm_datap, wrapup, error_table_$noarg, 1052 "Both an input and output deckfile path are required", ""); 1053 1054 do i = lbound (dkf_path, 1) to hbound (dkf_path, 1); 1055 if dkf_path (i) = "-working_dir" 1056 | dkf_path (i) = "-wd" then 1057 dkf_path (i) = rtrim (dir) || deckfile; 1058 1059 else if dkf_path (i) = "-system" 1060 | dkf_path (i) = "-sys" then 1061 dkf_path (i) = system_dir || deckfile; 1062 1063 if of_path = "-working_dir" 1064 | of_path = "-wd" then 1065 of_path = rtrim (dir) || ">" || deckfile; 1066 1067 else if of_path = "-system" 1068 | of_path = "-sys" then 1069 of_path = system_dir || ">" || deckfile; 1070 1071 if of_path = dkf_path (i) then dkf_path (i) = ""; 1072 end; 1073 1074 call get_files; 1075 1076 call ssu_$get_temp_segment (sci_ptr, "temp data buffer", dfm_data.bptr); /* get temp segs for data buffer */ 1077 call ssu_$get_temp_segment (sci_ptr, "list catalog", dfm_data.lcatp); /* get temp segs for list catalog */ 1078 1079 do i = lbound (dfm_data.dkf_iocbp, 1) to hbound (dfm_data.dkf_iocbp, 1); 1080 if dfm_data.dkf_iocbp (i) ^= null & dfm_data.of_iocbp ^= null then 1081 call dfm_util_$merge_files (dfm_datap, dfm_data.dkf_iocbp (i), dfm_data.of_iocbp); 1082 end; 1083 1084 do i = lbound (list_types, 1) to hbound (list_types, 1); 1085 dfm_data.list_key = list_types (i); 1086 call dfm_util_$find_key (dfm_datap, dfm_data.of_iocbp, dfm_data.list_key, dfm_data.lcatp, code); 1087 if code ^= 0 then dfm_data.list_key = ""; 1088 if dfm_data.list_key ^= "" then call dfm_util_$print_list (dfm_datap, dfm_data.of_iocbp, dfm_data.list_key); 1089 end; 1090 1091 call wrap_up; 1092 return; 1093 1094 1095 1096 /* patch_deck - entry to add/delete a hex or octal patch card(s) into a deck 1097* in a deckfile and if it is a firmware deck create a firmware segment */ 1098 1099 patch_deck: entry (P_sci_ptr, P_dfm_infop); 1100 1101 call setup_part1; 1102 call setup_part2; 1103 dfm_data.pd = true; 1104 dl_patch = false; 1105 1106 on cleanup call wrap_up; 1107 1108 call ssu_$arg_count (sci_ptr, nargs); 1109 if nargs > 0 then do i = 1 to nargs; 1110 call ssu_$arg_ptr (sci_ptr, i, ap, al); 1111 1112 if arg = "-brief" 1113 | arg = "-bf" then dfm_data.bf_sw = true; /* user doesn't want unnecessary nessages */ 1114 1115 else if arg = "-deckfile" | arg = "-df" then do; 1116 i = i + 1; 1117 call ssu_$arg_ptr (sci_ptr, i, ap, al); 1118 if al = 0 then 1119 call complain (dfm_datap, wrapup, code, "obtaining ""-deckfile"" specification.", ""); 1120 else deckfile_path = arg; 1121 end; 1122 1123 else if arg = "-delete" | arg = "-dl" then dl_patch = true; 1124 1125 else if deck_tb_patched = "" then deck_tb_patched = arg; 1126 1127 else call complain (dfm_datap, wrapup, error_table_$bad_arg, "only one deck may be patched"); 1128 end; 1129 1130 if deck_tb_patched = "" then do; 1131 call complain (dfm_datap, print, error_table_$noarg, 1132 "A search key for deck to be patched is required", ""); 1133 1134 query_message = "Enter a key or partial key to specify the deck to be patched."; 1135 query_info.explanation_len = length (rtrim (query_message)); 1136 query_info.explanation_ptr = addr (query_message); 1137 call command_query_ (query_info_ptr, user_reply, pname, 1138 "Enter : "); 1139 1140 deck_tb_patched = user_reply; 1141 1142 end; 1143 1144 1145 call ssu_$get_temp_segment (sci_ptr, "temp buffer", dfm_data.bptr); /* get temp seg for temp buffer */ 1146 call ssu_$get_temp_segment (sci_ptr, "catalog keys", dfm_data.dfkp); /* get temp seg for deckfile keys */ 1147 call ssu_$get_temp_segment (sci_ptr, "list catalog", dfm_data.lcatp); /* get temp segs for list catalog */ 1148 1149 df_keys.n_entries = 0; /* initialy set to 0 entries */ 1150 lcata.n_entries = 0; 1151 1152 dfm_data.deckfile_sw = true; /* deckfile is required */ 1153 1154 call get_files; 1155 1156 call dfm_util_$get_cata (dfm_datap, dfm_data.fiocb_ptr, "ls.cata.ifad.list", dfm_data.lcatp, dfm_data.lksp, code); 1157 if code ^= 0 then 1158 call complain (dfm_datap, wrapup, code, "can't get list catalog", ""); 1159 1160 call dfm_util_$find_key (dfm_datap, dfm_data.fiocb_ptr, 1161 deck_tb_patched, dfm_data.dfkp, code); 1162 if code ^= 0 then 1163 call complain (dfm_datap, wrapup, code, "attempting to find keys for ^a", deck_tb_patched); 1164 1165 term = false; 1166 1167 if df_keys.n_entries > 1 then do j = 1 to df_keys.n_entries while (^term); 1168 call command_query_$yes_no (yes_sw, 0, pname, "^d^2s entries matched the key given", 1169 "key given matched ^d entries.^/ Entry ^d is ^a - Is this the deck to be patched?", 1170 df_keys.n_entries, j, df_keys.key (j)); 1171 1172 if yes_sw then do; 1173 term = true; 1174 j = j - 1; /* adjust to correct value */ 1175 end; 1176 end; 1177 1178 else j = 1; 1179 1180 if j > df_keys.n_entries & ^term then 1181 call complain (dfm_datap, wrapup, 0, "There is no file to be patched", ""); 1182 deck_tb_patched = df_keys.key (j); 1183 1184 term = false; 1185 if ^dl_patch then 1186 do i = lbound (dfm_data.opatches, 1) to hbound (dfm_data.opatches, 1) while (^term); 1187 1188 query_message = "Patch type may either be delete, chex, rhex or octal."; 1189 query_info.explanation_len = length (rtrim (query_message)); 1190 query_info.explanation_ptr = addr (query_message); 1191 call command_query_ (query_info_ptr, user_reply, pname, "Enter patch type: "); 1192 1193 if user_reply = "delete" 1194 | user_reply = "dl" then dl_patch, term = true; 1195 1196 else if user_reply = "octal" 1197 | user_reply = "mask" then do; 1198 ascii_cardp = addr (dfm_data.opatches (i)); 1199 o_patch = " "; 1200 o_patch.type = user_reply; 1201 1202 query_message = "Enter the octal address of this patch."; 1203 query_info.explanation_len = length (rtrim (query_message)); 1204 query_info.explanation_ptr = addr (query_message); 1205 call command_query_ (query_info_ptr, user_reply, pname, 1206 "Enter beginning address: "); 1207 o_patch.add = user_reply; 1208 1209 query_message = "Enter the patches. Consecutive locations maybe separated by a (,) up to 10 patches"; 1210 query_info.explanation_len = length (rtrim (query_message)); 1211 query_info.explanation_ptr = addr (query_message); 1212 call command_query_ (query_info_ptr, user_reply, pname, "Enter patch data: "); 1213 o_patch.p_fld = user_reply; 1214 call ioa_$rsnnl ("^6a ^5a^[60a^;^3x^57a^]^12x", 1215 patch_word, patch_length, convert (add_pic, o_patch.add), 1216 o_patch.type, (o_patch.type = "mask"), o_patch.p_fld); 1217 call command_query_$yes_no (yes_sw, 0, pname, 1218 "Is this patch correct", "Patch entered: ^/^a^/Is this correct? ", 1219 patch_word); 1220 if yes_sw then string (opatches (i)) = patch_word; 1221 else i = i - 1; 1222 call command_query_$yes_no (yes_sw, 0, pname, 1223 "MORE PATCHES?", "Are there anymore patches?"); 1224 if ^yes_sw then term = true; 1225 patch_ptr = addr (dfm_data.opatches); 1226 npatches = i; 1227 end; 1228 1229 1230 else if user_reply = "chex" 1231 | user_reply = "rhex" then do; 1232 ascii_cardp = addr (dfm_data.hpatches (i)); 1233 h_patch = " "; 1234 h_patch.type = user_reply; 1235 query_message = "Enter the hex address of this patch."; 1236 query_info.explanation_len = length (rtrim (query_message)); 1237 query_info.explanation_ptr = addr (query_message); 1238 call command_query_ (query_info_ptr, user_reply, pname, "Enter address: "); 1239 h_patch.add = "0000"; 1240 substr (h_patch.add, 5 - length (user_reply)) = user_reply; 1241 1242 query_message = "Enter the hex patch for this location."; 1243 query_info.explanation_len = length (rtrim (query_message)); 1244 query_info.explanation_ptr = addr (query_message); 1245 call command_query_ (query_info_ptr, user_reply, pname, "Enter patch data: "); 1246 h_patch.inst = "0000"; 1247 substr (h_patch.inst, 5 - length (user_reply)) = user_reply; 1248 call ioa_$rsnnl ("^4a ^4a^5x^4a^61x", patch_word, patch_length, 1249 h_patch.add, h_patch.type, h_patch.inst); 1250 call command_query_$yes_no (yes_sw, 0, pname, 1251 "Is this patch correct", "Patch entered ^/^a^/Is this correct? ", 1252 patch_word); 1253 if yes_sw then string (dfm_data.hpatches (i)) = patch_word; 1254 else i = i - 1; 1255 call command_query_$yes_no (yes_sw, 0, pname, 1256 "MORE PATCHES?", "Are there anymore patches?"); 1257 if ^yes_sw then term = true; 1258 patch_ptr = addr (dfm_data.hpatches); 1259 npatches = i; 1260 end; 1261 end; 1262 1263 if dl_patch then npatches = 0; 1264 1265 call dfm_util_$find_dkend (dfm_datap, deck_tb_patched, patch_ptr, npatches, code); 1266 if code ^= 0 then 1267 call complain (dfm_datap, wrapup, code, "attempting to patch file ^a", deck_tb_patched); 1268 1269 call dfm_util_$insert_deck (dfm_datap, dfm_data.fiocb_ptr, 1270 dfm_data.lcatp, length (unspec (lcata)), "ls.cata.ifad.list"); 1271 1272 call dfm_util_$detach_file (dfm_datap, dfm_data.liocb_ptr); 1273 dfm_data.liocb_ptr = iox_$user_output; 1274 dfm_data.terminal_out = true; 1275 1276 dfm_data.list_key = "ls." || rtrim (deck_tb_patched); 1277 1278 call dfm_util_$find_key (dfm_datap, dfm_data.fiocb_ptr, dfm_data.list_key, dfm_data.lcatp, code); 1279 if code ^= 0 then 1280 call complain (dfm_datap, wrapup, code, "attempting to find keys for ^a", dfm_data.list_key); 1281 1282 call dfm_util_$print_list (dfm_datap, dfm_data.fiocb_ptr, rtrim (lcata.key (1))); 1283 1284 call wrap_up; 1285 return; 1286 1287 1288 1289 1290 /* pi_handler - entry called by ssu_'s pi handler */ 1291 1292 pi_handler: entry (P_sci_ptr); 1293 1294 sci_ptr = P_sci_ptr; 1295 dfm_infop = ssu_$get_info_ptr (sci_ptr); 1296 dfm_datap = dfm_info.dfm_data_ptr; 1297 call wrap_up; 1298 return; 1299 1300 1301 1302 1303 1304 /* quit - entry to quit the request loop and exit the ssu envirnoment */ 1305 1306 quit: entry (P_sci_ptr, P_dfm_infop); 1307 1308 call setup_part1; 1309 1310 call wrap_up; 1311 call ssu_$abort_subsystem (sci_ptr); 1312 return; 1313 1314 1315 1316 1317 1318 1319 /* add name - int proc to add a name onto the current deckfile of list file */ 1320 1321 add_name: proc (aname); 1322 1323 dcl aname char (*); 1324 1325 1326 if dfm_data.deckfile_sw then do; 1327 call hcs_$chname_file (dkf_dir (1), dkf_entry (1), "", rtrim (aname) || ".deckfile", code); 1328 if code ^= 0 & code ^= error_table_$segnamedup then 1329 call complain (dfm_datap, wrapup, code, "adding name ^a^/^-to ^a>^a", 1330 rtrim (aname) || ".deckfile", dfm_data.dir, dfm_data.entry); 1331 1332 if ^dfm_data.bf_sw & code = 0 then 1333 call complain (dfm_datap, print, 0, "added name ^a^/^-to ^a>^a", 1334 rtrim (aname) || ".deckfile", dfm_data.dir, dfm_data.entry); 1335 1336 call hcs_$chname_file (lsf_dir, lsf_entry, "", rtrim (aname) || ".list", code); 1337 if code ^= 0 & code ^= error_table_$segnamedup then 1338 call complain (dfm_datap, wrapup, code, "adding name ^a^/^-to ^a>^a", 1339 rtrim (aname) || ".list", lsf_dir, lsf_entry); 1340 1341 if ^dfm_data.bf_sw & code = 0 then 1342 call complain (dfm_datap, print, 0, "added name ^a^/^-to ^a>^a", 1343 rtrim (aname) || ".list", lsf_dir, lsf_entry); 1344 end; 1345 end add_name; 1346 1347 1348 1349 /* file_deck - internal proc to file a deck into a deckfile */ 1350 1351 file_deck: proc (fptr, dlen); 1352 1353 dcl dlen fixed bin (21); 1354 dcl fptr ptr; 1355 1356 if dfm_data.lft 1357 & cata.n_entries = 0 then do; 1358 call dfm_util_$get_cata (dfm_datap, dfm_data.fiocb_ptr, "cata." || rtrim (dfm_data.cat_key), 1359 dfm_data.catp, dfm_data.cksp, code); 1360 if code ^= 0 then call complain (dfm_datap, wrapup, code, 1361 "Attempting to do a get catalog for cata.^a", rtrim (dfm_data.cat_key)); 1362 end; 1363 1364 call dfm_util_$make_key (dfm_datap); /* produce insertion key */ 1365 1366 call dfm_util_$insert_deck (dfm_datap, dfm_data.fiocb_ptr, 1367 fptr, dlen, dfm_data.current_key); /* copy current deck into deckfile */ 1368 1369 call dfm_util_$update_list (dfm_datap, data_list_type); /* add current deck entry to listing file */ 1370 1371 end file_deck; 1372 1373 1374 1375 1376 /* get_files internal proc to attach & open files depending on the operation performed. */ 1377 1378 get_files: proc (); 1379 1380 1381 /* attach and open tandd_deck_file */ 1382 1383 if dfm_data.deckfile_sw then do; 1384 if deckfile_path ^= "" then do; 1385 if deckfile_path = "-working_dir" 1386 | deckfile_path = "-wd" then 1387 deckfile_path = rtrim (dir) || deckfile; 1388 1389 else if deckfile_path = "-system" 1390 | deckfile_path = "-sys" then 1391 deckfile_path = system_dir || deckfile; 1392 1393 call expand_pathname_ (deckfile_path, dkf_dir (1), dkf_entry (1), code); 1394 if code ^= 0 then call complain (dfm_datap, wrapup, code, 1395 "encountered while expanding path ^a", deckfile_path); 1396 end; 1397 else if dfm_info.deckfile_dir ^= "" then do; 1398 dkf_dir (1) = dfm_info.deckfile_dir; 1399 dkf_entry (1) = dfm_info.deckfile_entry; 1400 end; 1401 else do; 1402 dkf_dir (1) = dfm_data.dir; 1403 dkf_entry (1) = "tandd_deck_file"; 1404 end; 1405 1406 1407 call dfm_util_$find_file (dfm_datap, dkf_dir (1), dkf_entry (1)); 1408 1409 dfm_data.dir = dkf_dir (1); 1410 dfm_data.entry = dkf_entry (1); 1411 1412 if dfm_data.list then vfile_open_mode = Keyed_sequential_input; 1413 else vfile_open_mode = Keyed_sequential_update; 1414 call dfm_util_$open_file (dfm_datap, "dk_file_sw", 1415 "vfile_ " || rtrim (dkf_dir (1)) || ">" || rtrim (dkf_entry (1)), vfile_open_mode, dfm_data.fiocb_ptr); 1416 1417 end; 1418 1419 1420 /* attach and open tandd_deck_files for merging */ 1421 1422 else if dfm_data.mdf then do; 1423 do i = lbound (dkf_path, 1) to hbound (dkf_path, 1) while (dkf_path (i) ^= ""); 1424 call expand_pathname_ ((dkf_path (i)), dkf_dir (i), dkf_entry (i), code); 1425 if code ^= 0 then call complain (dfm_datap, wrapup, code, 1426 "encountered while expanding path ^a", dkf_path (i)); 1427 1428 if dkf_path (i) ^= "" then do; 1429 call dfm_util_$open_file (dfm_datap, "dkf_sw" || ltrim (char (i)), 1430 "vfile_ " || rtrim (dkf_dir (i)) || ">" || rtrim (dkf_entry (i)), 1431 Keyed_sequential_input, dfm_data.dkf_iocbp (i)); 1432 end; 1433 end; 1434 1435 if of_path ^= "" then do; 1436 call expand_pathname_ (of_path, of_dir, of_entry, code); 1437 if code ^= 0 then call complain (dfm_datap, wrapup, code, 1438 "encountered while expanding path ^a", of_path); 1439 end; 1440 1441 else if dfm_info.deckfile_dir ^= "" then do; 1442 of_dir = dfm_info.deckfile_dir; 1443 of_entry = dfm_info.deckfile_entry; 1444 end; 1445 1446 else do; 1447 of_dir = dfm_data.dir; 1448 of_entry = "tandd_deck_file"; 1449 end; 1450 1451 1452 call dfm_util_$find_file (dfm_datap, of_dir, of_entry); 1453 1454 dfm_data.dir = of_dir; 1455 dfm_data.entry = of_entry; 1456 1457 call dfm_util_$open_file (dfm_datap, "of_sw", 1458 "vfile_ " || rtrim (of_dir) || ">" || of_entry, 1459 Keyed_sequential_update, dfm_data.of_iocbp); 1460 end; 1461 1462 1463 /* attach and open copy tape using the "tape_nstd_" io module */ 1464 1465 if dfm_data.attach_copy then do; /* only attach copy if indicated */ 1466 call dfm_util_$open_file (dfm_datap, "copy_sw", 1467 rtrim (c_att_desc) || " -write", Sequential_output, dfm_data.ciocb_ptr); 1468 end; 1469 1470 1471 /* attach and open listing file */ 1472 1473 1474 if (dfm_data.deckfile_sw | dfm_data.mdf) 1475 & ^dfm_data.terminal_out then do; 1476 1477 if of_dir ^= "" then lsf_dir = of_dir; 1478 else if dkf_dir (1) ^= "" then lsf_dir = dkf_dir (1); 1479 else if dfm_info.deckfile_dir ^= "" then lsf_dir = dfm_info.deckfile_dir; 1480 else lsf_dir = dfm_data.dir; 1481 lsf_entry = "deckfile.list"; 1482 1483 call dfm_util_$find_file (dfm_datap, lsf_dir, lsf_entry); 1484 1485 if ^dfm_data.mdf & ^dfm_data.list then 1486 call dfm_util_$open_file (dfm_datap, "list_sw", 1487 rtrim ("vfile_ " || rtrim (lsf_dir) || ">" || rtrim (lsf_entry) || " -extend"), 1488 Stream_input_output, dfm_data.liocb_ptr); 1489 1490 else if dfm_data.mdf | dfm_data.list then 1491 call dfm_util_$open_file (dfm_datap, "list_sw", 1492 rtrim ("vfile_ " || rtrim (lsf_dir) || ">" || rtrim (lsf_entry)), Stream_output, dfm_data.liocb_ptr); 1493 1494 end; 1495 1496 /* attach and open tape using the "tape_nstd_" io module */ 1497 1498 if dfm_data.lft then 1499 call dfm_util_$open_file (dfm_datap, "tape_sw", dfm_data.t_att_desc, Sequential_input, dfm_data.tiocb_ptr); 1500 1501 1502 1503 end get_files; 1504 1505 1506 1507 1508 /* setup_part1 - internal proc to set variables required by all entries */ 1509 1510 setup_part1: proc; 1511 1512 sci_ptr = P_sci_ptr; 1513 dfm_infop = P_dfm_infop; 1514 dfm_datap = dfm_info.dfm_data_ptr; 1515 dfm_data.infop = dfm_infop; 1516 dfm_data.sci_ptr = sci_ptr; 1517 pname = ssu_$get_subsystem_and_request_name (sci_ptr); 1518 end; 1519 1520 1521 1522 /* setup_part2 - internal proc to initialize variables required by some entries */ 1523 1524 setup_part2: proc; 1525 1526 1527 dfm_info.flags.request_active = true; 1528 call date_time_ (clock (), dfm_data.time_string); /* Convert date and time. */ 1529 dfm_data.gtime_string = date_time_$format ("^yc^my^dm", clock (), "system_zone", "system_lang"); 1530 dfm_data.dir = get_wdir_ (); /* Get working directory. */ 1531 1532 dfm_data.bptr = null; 1533 dfm_data.catp = null; 1534 dfm_data.ciocb_ptr = null; 1535 dfm_data.dcatp = null; 1536 dfm_data.dfkp = null; 1537 1538 do i = lbound (dfm_data.dkf_iocbp, 1) to hbound (dfm_data.dkf_iocbp, 1); 1539 dfm_data.dkf_iocbp (i) = null; 1540 end; 1541 1542 dfm_data.fiocb_ptr = null; 1543 dfm_data.hbuff_p = null; 1544 dfm_data.lbuff_p = null; 1545 dfm_data.lcatp = null; 1546 dfm_data.liocb_ptr = null; 1547 dfm_data.mca_wksp = null; 1548 dfm_data.mcatp = null; 1549 dfm_data.of_iocbp = null; 1550 dfm_data.tiocb_ptr = null; 1551 1552 dfm_data.dd = false; 1553 dfm_data.allow_0_cksum = false; 1554 dfm_data.attach_copy = false; 1555 dfm_data.cat_build = false; 1556 dfm_data.cd_sw = false; 1557 dfm_data.copy_at_eof = false; 1558 dfm_data.deckfile_sw = false; 1559 dfm_data.finished = false; 1560 dfm_data.eot = false; 1561 dfm_data.first_deck = false; 1562 dfm_data.first_write = false; 1563 dfm_data.firmware_sw = false; 1564 dfm_data.fnp_tape = false; 1565 dfm_data.hdr_sw = true; 1566 dfm_data.lfd = false; 1567 dfm_data.lft = false; 1568 dfm_data.list = false; 1569 dfm_data.one_eof = false; 1570 dfm_data.mdf = false; 1571 term = false; 1572 dfm_data.terminal_out = false; 1573 1574 deck_tb_patched = ""; 1575 deckfile_path = ""; 1576 dfm_data.current_key = ""; 1577 dfm_data.cat_key = ""; 1578 dfm_data.list_key = ""; 1579 dfm_data.tape_name = ""; 1580 dfm_data.crec = 0; 1581 dfm_data.denno = 0; 1582 dfm_data.fnp_key = 0; 1583 n_diskettes_tb_read = 0; 1584 dfm_data.cfile = 1; /* set first file number */ 1585 dfm_data.pfile = 1; /* set first file number */ 1586 dfm_data.page_no = dfm_info.page_number; /* and the page number */ 1587 dkf_dir = ""; 1588 dkf_entry = ""; 1589 dkf_dir = ""; 1590 dkf_entry = ""; 1591 dkf_path = ""; 1592 of_dir = ""; 1593 of_entry = ""; 1594 of_path = ""; 1595 1596 query_info_ptr = addr (query_info); 1597 query_info.yes_or_no_sw = false; 1598 query_info.version = query_info_version_6; 1599 query_info.suppress_name_sw = false; 1600 query_info.suppress_spacing = false; 1601 query_info.cp_escape_control = "11"b; 1602 query_info.literal_sw = false; 1603 query_info.prompt_after_explanation = true; 1604 query_info.padding = false; 1605 query_info.status_code = 0; 1606 query_info.question_iocbp, query_info.answer_iocbp = null (); 1607 query_info.repeat_time = 0; 1608 1609 end; 1610 1611 1612 1613 /* wrap_up - int proc to perform request clean up */ 1614 1615 wrap_up: proc (); 1616 if ^dfm_info.flags.request_active then return; 1617 dfm_info.page_number = dfm_data.page_no; /* save page number if needed later */ 1618 if dfm_data.liocb_ptr ^= null & ^dfm_data.terminal_out then 1619 call dfm_util_$detach_file (dfm_datap, dfm_data.liocb_ptr); 1620 dfm_data.liocb_ptr = null; 1621 1622 if dfm_data.ciocb_ptr ^= null then 1623 call dfm_util_$detach_file (dfm_datap, dfm_data.ciocb_ptr); 1624 dfm_data.ciocb_ptr = null; 1625 1626 do i = lbound (dfm_data.dkf_iocbp, 1) to hbound (dfm_data.dkf_iocbp, 1); 1627 if dfm_data.dkf_iocbp (i) ^= null then 1628 call dfm_util_$detach_file (dfm_datap, dfm_data.dkf_iocbp (i)); 1629 dfm_data.dkf_iocbp (i) = null; 1630 end; 1631 1632 if dfm_data.fiocb_ptr ^= null then 1633 call dfm_util_$detach_file (dfm_datap, dfm_data.fiocb_ptr); 1634 dfm_data.fiocb_ptr = null; 1635 1636 if dfm_data.of_iocbp ^= null then 1637 call dfm_util_$detach_file (dfm_datap, dfm_data.of_iocbp); 1638 dfm_data.of_iocbp = null; 1639 1640 if dfm_data.tiocb_ptr ^= null then 1641 call dfm_util_$detach_file (dfm_datap, dfm_data.tiocb_ptr); 1642 dfm_data.tiocb_ptr = null; 1643 1644 if dfm_data.lbuff_p ^= null then 1645 free dfm_data.lbuff_p -> lbuff in (free_area); 1646 dfm_data.lbuff_p = null; 1647 1648 if dfm_data.hbuff_p ^= null then 1649 free dfm_data.hbuff_p -> hbuff in (free_area); 1650 dfm_data.hbuff_p = null; 1651 1652 if dfm_data.m_attached then do; 1653 if ^mca_status.maj & mca_sub.data_p then 1654 call mca_$read_data (dfm_data.mca_ioi_idx, dfm_data.mca_wksp, 1655 max_words_to_rd, rl, "0"b, 0); 1656 call dfm_util_$mca_detach (dfm_datap); 1657 end; 1658 1659 if dfm_data.bptr ^= null then 1660 call ssu_$release_temp_segment (sci_ptr, dfm_data.bptr); 1661 dfm_data.bptr = null; 1662 1663 if dfm_data.catp ^= null then 1664 call ssu_$release_temp_segment (sci_ptr, dfm_data.catp); 1665 dfm_data.catp = null; 1666 1667 if dfm_data.dcatp ^= null then 1668 call ssu_$release_temp_segment (sci_ptr, dfm_data.dcatp); 1669 dfm_data.dcatp = null; 1670 1671 if dfm_data.dfkp ^= null then 1672 call ssu_$release_temp_segment (sci_ptr, dfm_data.dfkp); 1673 dfm_data.dfkp = null; 1674 1675 if dfm_data.mca_wksp ^= null then 1676 call ssu_$release_temp_segment (sci_ptr, dfm_data.mca_wksp); 1677 dfm_data.mca_wksp = null; 1678 1679 if dfm_data.lcatp ^= null then 1680 call ssu_$release_temp_segment (sci_ptr, dfm_data.lcatp); 1681 dfm_data.lcatp = null; 1682 1683 if dfm_data.mcatp ^= null then 1684 call ssu_$release_temp_segment (sci_ptr, dfm_data.mcatp); 1685 dfm_data.mcatp = null; 1686 1687 dfm_data.finished = true; 1688 dfm_info.flags.request_active = false; 1689 1690 end; 1691 1692 1693 1694 1695 1696 1 1 /* BEGIN INCLUDE FILE dfm_info.incl.pl1 * * * * * * * * * * * * * * * * */ 1 2 1 3 1 4 /****^ HISTORY COMMENTS: 1 5* 1) change(86-08-21,Fakoury), approve(86-08-21,MCR7515), 1 6* audit(87-01-07,Farley), install(87-01-08,MR12.0-1263): 1 7* Originally coded 0782 by Rick Fakoury for MR12. 1 8* END HISTORY COMMENTS */ 1 9 1 10 1 11 1 12 1 13 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 1 14 /* */ 1 15 /* This include file is used by deckfile_manager to pass information */ 1 16 /* about a particular invocation of the command to the utility routines. */ 1 17 /* */ 1 18 /* Originally code by R. Fakoury 06/82. */ 1 19 /* */ 1 20 /* * * * * * * * * * * * * * * * * * * * * * * * * */ 1 21 1 22 1 23 /* format: style4,ifthenstmt,ifthen,ind3,ll125,lineconind1 */ 1 24 1 25 dcl 1 dfm_info aligned based (dfm_infop), 1 26 2 version char (8), /* version of this structure */ 1 27 2 dfm_data_ptr ptr, /* ptr to the dfm_data structure for this invocation */ 1 28 2 info_dir char (168) unal, /* ssu info segs dir */ 1 29 2 flags, 1 30 3 request_active bit (1) unal, /* current request active */ 1 31 3 force_quit bit (1) unal, /* OK to quit or abort without query */ 1 32 3 pad bit (34) unal, /* spares */ 1 33 2 page_number fixed bin, /* for listings */ 1 34 2 deckfile_dir char (168) unal, /* location of the deckfile - if inputted with dfm -dkf arg */ 1 35 2 deckfile_entry char (32) unal; /* entry name of the deckfile - if inputted with dfm -dkf arg */ 1 36 1 37 dcl dfm_infop ptr; 1 38 1 39 dcl dfm_info_version_1 char (8) init ("dfmi_001") int static options (constant); 1 40 1 41 /* END OF: dfm_info.incl.pl1 * * * * * * * * * * * * * * * * */ 1697 1698 2 1 /* START OF: dfm_data.incl.pl1 * * * * * * * * * * * * * * * * * * * * * * * */ 2 2 2 3 2 4 /****^ HISTORY COMMENTS: 2 5* 1) change(86-08-21,Fakoury), approve(86-08-21,MCR7515), 2 6* audit(87-01-07,Farley), install(87-01-08,MR12.0-1263): 2 7* Originally coded 0782 dfm_data.by Rick Fakoury for MR12. 2 8* 2) change(88-06-10,Fakoury), approve(90-10-03,MCR8147), 2 9* audit(90-10-03,Parisek), install(90-10-25,MR12.4-1049): 2 10* Modified to add new diskettes to valid diskettes. 2 11* 3) change(89-02-06,Fakoury), approve(90-10-03,MCR8147), 2 12* audit(90-10-03,Parisek), install(90-10-25,MR12.4-1049): 2 13* to to increase the size of att_desc from 64 to 181 for TR21336. 2 14* END HISTORY COMMENTS */ 2 15 2 16 2 17 /* format: style4,ifthenstmt,ifthen,ind3,ll125,lineconind1 */ 2 18 2 19 2 20 2 21 dcl dfm_datap ptr; 2 22 2 23 dcl 1 dfm_data based (dfm_datap), 2 24 2 allow_0_cksum bit (1), 2 25 2 ascii_card char (80) aligned, 2 26 2 attach_copy bit (1), 2 27 2 bf_sw bit (1), /* flag to suppress informative messages */ 2 28 2 bptr ptr, /* data buffer ptr */ 2 29 2 catp ptr, /* catalog ptr */ 2 30 2 cat_build bit (1), 2 31 2 cat_key char (24), /* catalog key */ 2 32 2 cd_sw bit (1), /* user set copy tape density */ 2 33 2 cfile fixed bin, /* copy file number */ 2 34 2 ciocb_ptr ptr, /* copy iocb ptr */ 2 35 2 cksp ptr, /* cata key string ptr */ 2 36 2 copy_at_eof bit (1), /* copy tape at eot */ 2 37 2 cptr ptr, /* card ptr */ 2 38 2 crec fixed bin, /* record number */ 2 39 2 current_disk_name char (8), 2 40 2 current_filename char (20) varying, 2 41 2 current_key char (24) varying, 2 42 2 dcatp ptr, /* diskette catalog ptr */ 2 43 2 dd bit (1), /* delete deck flag */ 2 44 2 deckfile_sw bit (1), 2 45 2 denno fixed bin, /* tape density number */ 2 46 2 dfkp ptr, 2 47 2 dkf_iocbp (3) ptr, 2 48 2 dir char (168), 2 49 2 disk_num fixed bin, 2 50 2 dksp ptr, /* diskette key string ptr */ 2 51 2 dlen fixed bin (21), /* data move length */ 2 52 2 dtype char (4), /* deck type */ 2 53 2 edit_date char (6), 2 54 2 eot bit (1), /* end of tape flag */ 2 55 2 entry char (32), 2 56 2 fiocb_ptr ptr, /* deck file iocb ptr */ 2 57 2 finished bit (1), /* request active */ 2 58 2 firmware_sw bit (1), /* just loading firmware */ 2 59 2 first_deck bit (1), 2 60 2 first_write bit (1), 2 61 2 fnp_key fixed bin, 2 62 2 fnp_tape bit (1), 2 63 2 fnp_type char (4), 2 64 2 gtime_string char (6), /* GCOS time format */ 2 65 2 hbuff_p ptr, /* pointer to a header buffer */ 2 66 2 hdr_sw bit (1), /* listing header required */ 2 67 2 hpatches (10) like h_patch aligned, /* hex patches */ 2 68 2 id_buf char (18) aligned, /* buffer to hold current ident block image */ 2 69 2 infop ptr, /* backward ptr to dfm_info structure */ 2 70 2 l_att_desc char (181), /* listing file attach description */ 2 71 2 lbuff_p ptr, /* ptr to a line buffer */ 2 72 2 lcatp ptr, /* listing catalog ptr */ 2 73 2 lksp ptr, /* listing key string pointer */ 2 74 2 lfd bit (1), /* load from diskette flag */ 2 75 2 lft bit (1), /* load from tape flag */ 2 76 2 lib bit (1), /* mpc library */ 2 77 2 lib_type char (6), 2 78 2 liocb_ptr ptr, /* listing iocb ptr */ 2 79 2 list bit (1), /* creating a listing */ 2 80 2 list_key char (24) varying, 2 81 2 ls_type char (10) varying, /* list type fnp, ifad, mca */ 2 82 2 m_attached bit (1), /* mca attached */ 2 83 2 mca_ioi_idx fixed bin, 2 84 2 mca_wksp ptr, /* ptr to the mca workspace */ 2 85 2 mcatp ptr, /* mca catalog ptr */ 2 86 2 mdf bit (1), /* merge deckfile request active */ 2 87 2 mksp ptr, /* mca key string ptr */ 2 88 2 obj_card char (80) aligned, /* buffer to hold current object card image */ 2 89 2 of_iocbp ptr, /* deckfile iocb ptr for merge deckfile */ 2 90 2 one_eof bit (1), 2 91 2 opatches (10) like o_patch aligned, /* octal patches */ 2 92 2 page_no fixed bin, 2 93 2 pd bit (1), /* patch deck active */ 2 94 2 pfile fixed bin, /* file number */ 2 95 2 sci_ptr ptr, /* save here for use by the utilities */ 2 96 2 sstype char (5), /* subsytem type */ 2 97 2 statp ptr, /* status ptr */ 2 98 2 sub_ptr ptr, /* substatus ptr */ 2 99 2 t_att_desc char (181), /* tape attach description */ 2 100 2 tape_name char (16), 2 101 2 terminal_out bit (1), /* output listing on terminal */ 2 102 2 tiocb_ptr ptr, /* tape iocb ptr */ 2 103 2 time_string char (24); /* Current date and time */ 2 104 2 105 2 106 2 107 /* CONSTANTS */ 2 108 2 109 dcl cata_list_type fixed bin (2) int static options (constant) init (2); 2 110 2 111 dcl data_list_type fixed bin (2) int static options (constant) init (1); 2 112 2 113 dcl lc char (26) int static options (constant) init 2 114 ("abcdefghijklmnopqrstuvwxyz"); 2 115 2 116 dcl list_types (3) char (17) int static options (constant) init 2 117 ("ls.cata.fnp.list", "ls.cata.ifad.list", "ls.cata.mca.list"); 2 118 2 119 dcl max_words_to_rd fixed bin (21) int static options (constant) init (16 * 1024); 2 120 dcl uc char (26) int static options (constant) init 2 121 ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); 2 122 2 123 dcl valid_diskettes (14) char (5) static options (constant) init 2 124 ("con..", "fip..", "hsh..", "idpm.", "imu..", "mhlp.", "ndi..", 2 125 "psa..", "psi..", "pt1..", "pt2..", "sel..", "urd..", "urp.."); 2 126 2 127 2 128 /* STRUCTURES and BASED VARIABLES */ 2 129 2 130 dcl 1 cata based (dfm_data.catp) aligned, /* template for itr or mdr catalog */ 2 131 2 n_entries fixed bin, /* number of catalog entries */ 2 132 2 key (1 refer (cata.n_entries)) char (24); /* entry search keys */ 2 133 2 134 dcl 1 dcata based (dfm_data.dcatp) aligned, /* template for a diskette catalog */ 2 135 2 n_entries fixed bin, /* number of catalog entries */ 2 136 2 key (1 refer (dcata.n_entries)) char (24); /* entry search keys */ 2 137 2 138 dcl hbuff (4) char (300) based (dfm_data.hbuff_p); 2 139 2 140 dcl lbuff char (300) based (dfm_data.lbuff_p); 2 141 2 142 2 143 2 144 dcl 1 lcata based (dfm_data.lcatp) aligned, /* template for a list catalog */ 2 145 2 n_entries fixed bin, /* number of catalog entries */ 2 146 2 key (1 refer (lcata.n_entries)) char (24); /* entry search keys */ 2 147 2 148 dcl 1 mcata based (dfm_data.mcatp) aligned, /* template for a MCA catalog */ 2 149 2 n_entries fixed bin, /* number of catalog entries */ 2 150 2 key (1 refer (mcata.n_entries)) char (24); /* entry search keys */ 2 151 2 152 dcl cata_key_string char (cata.n_entries * 24) based (dfm_data.cksp); 2 153 2 154 dcl dcata_key_string char (dcata.n_entries * 24) based (dfm_data.dksp); 2 155 2 156 dcl lcata_key_string char (lcata.n_entries * 24) based (dfm_data.lksp); 2 157 2 158 dcl mcata_key_string char (mcata.n_entries * 24) based (dfm_data.mksp); 2 159 2 160 dcl ascii_cardp ptr; 2 161 2 162 dcl 1 h_patch based (ascii_cardp) aligned, /* template for hex patch card */ 2 163 (2 add char (4), /* (c1) hex patch address */ 2 164 2 blk1 char (2), 2 165 2 type char (4), /* (c7) = "c" for cs, "r" for r/w mem hex */ 2 166 2 blk2 char (5), 2 167 2 inst char (4), /* (c16) 2 - 4 hex digit instructions */ 2 168 2 blk3 char (23), 2 169 2 prg_id char (12), /* (c43) should equal word 2 of deck id block */ 2 170 2 blk4 char (5), 2 171 2 dtime char (6), /* (c60) date time of patch */ 2 172 2 blk5 char (1), 2 173 2 rev char (6), /* (c67) revision of dkend */ 2 174 2 lbl char (4), /* (c73) = deck edit name */ 2 175 2 blk6 char (4)) unaligned; /* complete card format */ 2 176 2 177 dcl 1 id_blk based (addr (dfm_data.id_buf)) aligned, /* template for ident block */ 2 178 (2 ident char (6), /* module identification */ 2 179 2 revision, 2 180 3 rev_dot char (4), /* char string "rev." */ 2 181 3 rev char (2), /* alpa-numeric revision */ 2 182 2 type_code, 2 183 3 pad char (3), 2 184 3 type char (3)) unaligned; /* module type (itr, mdr or firmware) */ 2 185 2 186 dcl 1 mca_status based (dfm_data.statp), 2 187 2 pad bit (2) unal, 2 188 2 maj bit (4) unal, 2 189 2 sub bit (4) unal, 2 190 2 pad2 bit (62) unal; 2 191 2 192 dcl 1 mca_sub based (dfm_data.sub_ptr) unal, 2 193 2 data_p bit (1) unal, 2 194 2 mbz bit (3) unal, 2 195 2 term_state bit (2) unal; 2 196 2 197 dcl 1 o_patch based (ascii_cardp) aligned, /* template for octal patch card */ 2 198 (2 add char (6), /* (c1) patch address */ 2 199 2 blk1 char (1), 2 200 2 type char (5), /* (c8) = "octal" | "mask " */ 2 201 2 blk2 char (3), 2 202 2 p_fld char (51), /* (c16) variable fieled (patch data) */ 2 203 2 dtime char (6), /* (c67) date of patch */ 2 204 2 label char (6), /* (c73) dk label */ 2 205 2 blk3 char (2)) unaligned; /* to finish off card */ 2 206 2 207 2 208 3 1 /* include file for info structure used with record_status control order 3 2* created by M. Asherman 1/6/76 */ 3 3 /* modified 6/15/77 to support stationary type records */ 3 4 3 5 dcl rs_info_ptr ptr; 3 6 dcl 1 rs_info based (rs_info_ptr) aligned, 3 7 2 version fixed, /* must be set to 1 or 2 (Input) */ 3 8 2 flags aligned, 3 9 3 lock_sw bit (1) unal, /* Input -- if ="1"b try to lock record */ 3 10 3 unlock_sw bit (1) unal, /* Input -- if ="1"b try to unlock record */ 3 11 3 create_sw bit (1) unal, /* Input--if set creat new record */ 3 12 3 locate_sw bit (1) unal, /* Input--if set causes current rec to be 3 13* located outside the index by descrip, or created without key */ 3 14 3 inc_ref_count bit (1) unal, /* Input--bump reference count of record, if stationary */ 3 15 3 dec_ref_count bit (1) unal, /* Input--decrement ref count if this flag set and record stationary */ 3 16 3 locate_pos_sw bit (1) unal, /* Input--if set the record_length is taken 3 17* as an input argument specifying the absolute logical record positioni to which both the current and next positions will be set */ 3 18 3 mbz1 bit (29) unal, /* must be set to "0"b, reserved for future use */ 3 19 2 record_length fixed (21), /* length in bytes, Input if create_sw set */ 3 20 2 max_rec_len fixed (21), /* max length of contained record 3 21* Input if create_sw is set--overrides min_block_size in effect */ 3 22 2 record_ptr ptr, /* points to first byte of record--will be word aligned */ 3 23 2 descriptor fixed (35), /* Input if locate_sw set and create_sw="0"b */ 3 24 2 ref_count fixed (34), /* Output--should match number of keys on this record-- = -1 if non-stationary record */ 3 25 2 time_last_modified fixed (71), /* Output */ 3 26 2 modifier fixed (35), /* Output--also Input when locking */ 3 27 2 block_ptr ptr unal, /* Output */ 3 28 2 last_image_modifier 3 29 fixed (35), 3 30 2 mbz2 fixed; 3 31 3 32 dcl 1 rs_desc based (addr (rs_info.descriptor)), 3 33 /* record block descriptor structure */ 3 34 2 comp_num fixed (17) unal, /* msf component number */ 3 35 2 offset bit (18) unal; /* word offset of record block */ 3 36 3 37 dcl 1 seq_desc based (addr (rs_info.descriptor)), 3 38 /* for sequential files */ 3 39 2 bitno bit (6) unal, 3 40 2 comp_num fixed (11) unal, /* msf component number */ 3 41 2 wordno bit (18) unal; /* word offset */ 3 42 3 43 dcl rs_info_version_1 static internal fixed init (1); 3 44 dcl rs_info_version_2 static internal fixed init (2); 3 45 2 209 2 210 2 211 2 212 /* END OF: dfm_data.incl.pl1 * * * * * * * * * * * * * * * * * * * * * * * */ 1699 1700 4 1 /* Begin include file ..... iox_modes.incl.pl1 */ 4 2 4 3 /* Written by C. D. Tavares, 03/17/75 */ 4 4 /* Updated 10/31/77 by CDT to include short iox mode strings */ 4 5 4 6 dcl iox_modes (13) char (24) int static options (constant) aligned initial 4 7 ("stream_input", "stream_output", "stream_input_output", 4 8 "sequential_input", "sequential_output", "sequential_input_output", "sequential_update", 4 9 "keyed_sequential_input", "keyed_sequential_output", "keyed_sequential_update", 4 10 "direct_input", "direct_output", "direct_update"); 4 11 4 12 dcl short_iox_modes (13) char (4) int static options (constant) aligned initial 4 13 ("si", "so", "sio", "sqi", "sqo", "sqio", "squ", "ksqi", "ksqo", "ksqu", "di", "do", "du"); 4 14 4 15 dcl (Stream_input initial (1), 4 16 Stream_output initial (2), 4 17 Stream_input_output initial (3), 4 18 Sequential_input initial (4), 4 19 Sequential_output initial (5), 4 20 Sequential_input_output initial (6), 4 21 Sequential_update initial (7), 4 22 Keyed_sequential_input initial (8), 4 23 Keyed_sequential_output initial (9), 4 24 Keyed_sequential_update initial (10), 4 25 Direct_input initial (11), 4 26 Direct_output initial (12), 4 27 Direct_update initial (13)) fixed bin int static options (constant); 4 28 4 29 /* End include file ..... iox_modes.incl.pl1 */ 1701 1702 5 1 /* Begin mca_diskette.incl.pl1 */ 5 2 5 3 5 4 5 5 /****^ HISTORY COMMENTS: 5 6* 1) change(86-03-19,Fawcett), approve(86-03-19,MCR7374), 5 7* audit(86-04-28,Lippard), install(86-09-16,MR12.0-1159): 5 8* Created for users to view the contents of the MCA diskettes 5 9* END HISTORY COMMENTS */ 5 10 5 11 dcl header_ptr ptr; 5 12 5 13 5 14 dcl 1 header based (header_ptr), 5 15 2 copyright char (55), 5 16 2 title char (8), 5 17 2 unique_id char (8), 5 18 2 date_created char (6), 5 19 2 date_changed char (6), 5 20 2 space_adr bit (18) unal, 5 21 2 space_x bit (18) unal, 5 22 2 space_size bit (18) unal, 5 23 2 dir_adr bit (18) unal, 5 24 2 dir_x bit (18) unal, 5 25 2 dir_size like two_byte, 5 26 2 config_name char (8), 5 27 2 config_count fixed bin (9) unal unsigned, 5 28 2 disk_type fixed bin (9) unal unsigned, 5 29 2 val fixed bin (9) unal unsigned, 5 30 2 equip_type char (4), 5 31 2 ipi_num char (12), 5 32 2 disk_dwg_num char (12), 5 33 2 prod_num_tab char (3), 5 34 2 x_of_n bit (18) unal; 5 35 5 36 dcl dir_ptr ptr; 5 37 dcl dire_ptr ptr; 5 38 dcl dir_number fixed bin; 5 39 5 40 dcl 1 directory based (dir_ptr), 5 41 2 array (dir_number) like dire; 5 42 5 43 dcl two_byte_ptr ptr; 5 44 5 45 dcl 1 two_byte based (two_byte_ptr) unal, 5 46 2 pad1 bit (1) unal, 5 47 2 lsb bit (8) unal, 5 48 2 pad2 bit (1) unal, 5 49 2 msb bit (8) unal; 5 50 5 51 5 52 5 53 dcl 1 dire based (dire_ptr), 5 54 2 path_name char (8), 5 55 2 sector_address like two_byte, 5 56 2 file_size like two_byte, 5 57 2 rfu like two_byte, 5 58 2 attributes bit (8) unal, 5 59 2 deleted bit (1) unal, 5 60 2 rfu1 char (1); 5 61 5 62 dcl file_ptr ptr; 5 63 dcl file_size fixed bin (21); 5 64 dcl 1 hex_file based (file_ptr), 5 65 2 hex_data (file_size) like two_byte; 5 66 5 67 5 68 5 69 5 70 5 71 5 72 5 73 /* End mca_diskette.incl.pl1 */ 1704 6 1 /* BEGIN INCLUDE FILE query_info.incl.pl1 TAC June 1, 1973 */ 6 2 /* Renamed to query_info.incl.pl1 and cp_escape_control added, 08/10/78 WOS */ 6 3 /* version number changed to 4, 08/10/78 WOS */ 6 4 /* Version 5 adds explanation_(ptr len) 05/08/81 S. Herbst */ 6 5 /* Version 6 adds literal_sw, prompt_after_explanation switch 12/15/82 S. Herbst */ 6 6 6 7 dcl 1 query_info aligned, /* argument structure for command_query_ call */ 6 8 2 version fixed bin, /* version of this structure - must be set, see below */ 6 9 2 switches aligned, /* various bit switch values */ 6 10 3 yes_or_no_sw bit (1) unaligned init ("0"b), /* not a yes-or-no question, by default */ 6 11 3 suppress_name_sw bit (1) unaligned init ("0"b), /* do not suppress command name */ 6 12 3 cp_escape_control bit (2) unaligned init ("00"b), /* obey static default value */ 6 13 /* "01" -> invalid, "10" -> don't allow, "11" -> allow */ 6 14 3 suppress_spacing bit (1) unaligned init ("0"b), /* whether to print extra spacing */ 6 15 3 literal_sw bit (1) unaligned init ("0"b), /* ON => do not strip leading/trailing white space */ 6 16 3 prompt_after_explanation bit (1) unaligned init ("0"b), /* ON => repeat question after explanation */ 6 17 3 padding bit (29) unaligned init (""b), /* pads it out to t word */ 6 18 2 status_code fixed bin (35) init (0), /* query not prompted by any error, by default */ 6 19 2 query_code fixed bin (35) init (0), /* currently has no meaning */ 6 20 6 21 /* Limit of data defined for version 2 */ 6 22 6 23 2 question_iocbp ptr init (null ()), /* IO switch to write question */ 6 24 2 answer_iocbp ptr init (null ()), /* IO switch to read answer */ 6 25 2 repeat_time fixed bin (71) init (0), /* repeat question every N seconds if no answer */ 6 26 /* minimum of 30 seconds required for repeat */ 6 27 /* otherwise, no repeat will occur */ 6 28 /* Limit of data defined for version 4 */ 6 29 6 30 2 explanation_ptr ptr init (null ()), /* explanation of question to be printed if */ 6 31 2 explanation_len fixed bin (21) init (0); /* user answers "?" (disabled if ptr=null or len=0) */ 6 32 6 33 dcl query_info_version_3 fixed bin int static options (constant) init (3); 6 34 dcl query_info_version_4 fixed bin int static options (constant) init (4); 6 35 dcl query_info_version_5 fixed bin int static options (constant) init (5); 6 36 dcl query_info_version_6 fixed bin int static options (constant) init (6); /* the current version number */ 6 37 6 38 /* END INCLUDE FILE query_info.incl.pl1 */ 1705 1706 7 1 /* BEGIN INCLUDE FILE sub_err_flags.incl.pl1 BIM 11/81 */ 7 2 /* format: style3 */ 7 3 7 4 /* These constants are to be used for the flags argument of sub_err_ */ 7 5 /* They are just "string (condition_info_header.action_flags)" */ 7 6 7 7 declare ( 7 8 ACTION_CAN_RESTART init (""b), 7 9 ACTION_CANT_RESTART init ("1"b), 7 10 ACTION_DEFAULT_RESTART 7 11 init ("01"b), 7 12 ACTION_QUIET_RESTART 7 13 init ("001"b), 7 14 ACTION_SUPPORT_SIGNAL 7 15 init ("0001"b) 7 16 ) bit (36) aligned internal static options (constant); 7 17 7 18 /* End include file */ 1707 1708 1709 1710 end dfm_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/21/92 1021.6 dfm_.pl1 >spec>install>1031>dfm_.pl1 1697 1 01/08/87 1244.2 dfm_info.incl.pl1 >ldd>include>dfm_info.incl.pl1 1699 2 10/25/90 1013.9 dfm_data.incl.pl1 >ldd>include>dfm_data.incl.pl1 2-209 3 07/19/79 1647.0 rs_info.incl.pl1 >ldd>include>rs_info.incl.pl1 1701 4 02/02/78 1329.7 iox_modes.incl.pl1 >ldd>include>iox_modes.incl.pl1 1703 5 09/18/86 1417.5 mca_diskette.incl.pl1 >ldd>include>mca_diskette.incl.pl1 1705 6 03/11/83 1304.3 query_info.incl.pl1 >ldd>include>query_info.incl.pl1 1707 7 04/16/82 1058.1 sub_err_flags.incl.pl1 >ldd>include>sub_err_flags.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. ABORT 001647 automatic bit(1) packed unaligned dcl 243 set ref 260* 272 ACTION_CANT_RESTART 000056 constant bit(36) initial dcl 7-7 set ref 250* 255* Keyed_sequential_input 000244 constant fixed bin(17,0) initial dcl 4-15 set ref 1412 1429* Keyed_sequential_update 000213 constant fixed bin(17,0) initial dcl 4-15 set ref 1413 1457* N 000100 automatic fixed bin(17,0) dcl 42 set ref 699* P_dfm_infop parameter pointer dcl 213 ref 221 286 387 498 520 790 989 1099 1306 1513 P_sci_ptr parameter pointer dcl 214 ref 221 286 387 498 520 790 989 1099 1292 1294 1306 1512 Sequential_input 000232 constant fixed bin(17,0) initial dcl 4-15 set ref 1498* Sequential_output 000233 constant fixed bin(17,0) initial dcl 4-15 set ref 1466* Stream_input_output 000245 constant fixed bin(17,0) initial dcl 4-15 set ref 1485* Stream_output 000234 constant fixed bin(17,0) initial dcl 4-15 set ref 1490* X 000101 automatic fixed bin(17,0) dcl 43 set ref 700* add based char(6) level 2 in structure "o_patch" packed packed unaligned dcl 2-197 in procedure "dfm_" set ref 1207* 1214 1214 add based char(4) level 2 in structure "h_patch" packed packed unaligned dcl 2-162 in procedure "dfm_" set ref 1239* 1240* 1248* add_pic based picture(6) packed unaligned dcl 100 ref 1214 1214 addr builtin function dcl 115 ref 327 436 579 602 661 678 741 897 945 945 1029 1043 1136 1190 1198 1204 1211 1225 1232 1237 1244 1258 1596 al 000102 automatic fixed bin(21,0) dcl 44 set ref 254* 260 299* 301 301 303* 304 307 310 310 317 401* 403 403 405 405 408 408 410* 411 414 417 417 422 422 425 536* 538 540* 541 544 548 551 551 554 554 557* 558 561 564 564 566 568 570 570 801* 802 803 808 812 812 813 813 818 818 820* 821 824 832 832 834* 835 838 842 842 844* 845 848 848 861 864 864 866* 867 870 870 873 875 879 879 999* 1001 1001 1004 1004 1007* 1008 1010 1018 1110* 1112 1112 1115 1115 1117* 1118 1120 1123 1123 1125 all_diskettes 000103 automatic bit(1) packed unaligned dcl 45 set ref 532* 564* 573 583* 612 allow_0_cksum based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 861* 1553* alp 000104 automatic pointer dcl 46 set ref 267* 268* aname parameter char packed unaligned dcl 1323 ref 1321 1327 1328 1332 1336 1337 1341 answer_iocbp 6 001666 automatic pointer initial level 2 dcl 6-7 set ref 6-7* 1606* ap 000106 automatic pointer dcl 47 set ref 254* 259 260 261 299* 301 301 303* 307 310 310 317 401* 403 403 405 405 408 408 410* 414 417 417 422 422 425 536* 538 540* 544 548 551 551 554 554 557* 561 564 564 566 568 570 801* 802 803 808 812 812 813 813 818 818 820* 824 832 832 834* 838 842 842 844* 848 861 864 864 866* 870 873 875 879 999* 1001 1001 1004 1004 1007* 1010 1018 1110* 1112 1112 1115 1115 1117* 1120 1123 1123 1125 arg based char packed unaligned dcl 101 set ref 301 301 307 310 310 317 403 403 405 405 408 408 414 417 417 422 422 425 538 544 548 551 551 554 554 561 564 564 566 568 570* 802 803 808 812 812 813 813 818 818 824 832 832 838 842 842 848* 861 864 864 870* 873 875 879* 1001 1001 1004 1004 1010 1018 1112 1112 1115 1115 1120 1123 1123 1125 array based structure array level 2 packed packed unaligned dcl 5-40 set ref 741 ascii_cardp 001654 automatic pointer dcl 2-160 set ref 1198* 1199 1200 1207 1213 1214 1214 1214 1214 1214 1232* 1233 1234 1239 1240 1246 1247 1248 1248 1248 attach_copy 25 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 815* 828* 851 873 883 925 937 1465 1554* before builtin function dcl 116 ref 808 902 bf_sw 25(01) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 310* 405* 551* 812* 1001* 1112* 1332 1341 bin builtin function dcl 117 ref 699 700 bin_arg based fixed bin(35,0) dcl 102 ref 261 bit_arg based bit packed unaligned dcl 103 ref 260 bptr 26 based pointer level 2 dcl 2-23 set ref 911* 969* 1076* 1145* 1532* 1659 1659* 1661* c_att_desc 000110 automatic char(181) packed unaligned dcl 48 set ref 824* 826* 826 852* 852 873* 873 1466 cat_build 32 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 941 943* 1555* cat_key 32(09) based char(24) level 2 packed packed unaligned dcl 2-23 set ref 929 944 953* 953 957 1358 1360 1360 1577* cata based structure level 1 dcl 2-130 set ref 930 930 958 958 cata_list_type 000234 constant fixed bin(2,0) initial dcl 2-109 set ref 932* 960* catp 30 based pointer level 2 dcl 2-23 set ref 912* 930* 930 930 950 950 952 952 953 953 958* 958 958 1356 1358* 1533* 1663 1663* 1665* cd_sw 40(09) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 853* 1556* cfile 41 based fixed bin(17,0) level 2 dcl 2-23 set ref 1584* char builtin function dcl 118 ref 805 826 852 855 1429 ciocb_ptr 42 based pointer level 2 dcl 2-23 set ref 1466* 1534* 1622 1622* 1624* cksp 44 based pointer level 2 dcl 2-23 set ref 1358* cleanup 001540 stack reference condition dcl 137 ref 294 396 504 527 796 1106 clock builtin function dcl 119 ref 1528 1528 1529 1529 code 000166 automatic fixed bin(35,0) dcl 49 set ref 249* 250* 254* 255 255* 345* 347 347* 366* 367 367* 458* 459 466* 467 467* 642* 644 644* 650* 657* 670 687* 693* 713* 715 715* 719* 722 724* 730* 744* 746 748* 756* 821* 845* 848* 849 867* 870* 871 906* 1008* 1086* 1087 1118* 1156* 1157 1157* 1160* 1162 1162* 1265* 1266 1266* 1278* 1279 1279* 1327* 1328 1328 1328* 1332 1336* 1337 1337 1337* 1341 1358* 1360 1360* 1393* 1394 1394* 1424* 1425 1425* 1436* 1437 1437* command_query_ 000010 constant entry external dcl 156 ref 328 437 580 603 662 679 898 1030 1044 1137 1191 1205 1212 1238 1245 command_query_$yes_no 000012 constant entry external dcl 157 ref 353 472 687 724 748 1168 1217 1222 1250 1255 convert builtin function dcl 120 ref 1214 1214 copy_at_eof 46 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 937 1557* cp_escape_control 1(02) 001666 automatic bit(2) initial level 3 packed packed unaligned dcl 6-7 set ref 6-7* 1601* crec 52 based fixed bin(17,0) level 2 dcl 2-23 set ref 1580* cu_$arg_count 000014 constant entry external dcl 158 ref 249 cu_$arg_list_ptr 000016 constant entry external dcl 159 ref 267 cu_$arg_ptr 000020 constant entry external dcl 160 ref 254 current_disk_name 53 based char(8) level 2 packed packed unaligned dcl 2-23 set ref 709* 765 current_filename 55 based varying char(20) level 2 dcl 2-23 set ref 710* 737* 760* 765* 771* current_key 63 based varying char(24) level 2 dcl 2-23 set ref 929* 930* 957* 958* 1366* 1576* cv_dec_check_ 000022 constant entry external dcl 161 ref 848 870 data_list_type 000243 constant fixed bin(2,0) initial dcl 2-111 set ref 966* 1369* data_p based bit(1) level 2 packed packed unaligned dcl 2-192 ref 670 722 1653 date_changed 23(09) based char(6) level 2 packed packed unaligned dcl 5-14 ref 705 date_time_ 000024 constant entry external dcl 162 ref 1528 date_time_$format 000026 constant entry external dcl 163 ref 1529 dcata based structure level 1 dcl 2-134 set ref 648* dcatp 72 based pointer level 2 dcl 2-23 set ref 622* 648 713* 766 767* 1535* 1667 1667* 1669* dd 74 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 291* 1552* deck_tb_patched 000275 automatic varying char(24) dcl 51 set ref 1125 1125* 1130 1140* 1160* 1162* 1182* 1265* 1266* 1276 1574* deckfile 000065 constant char(16) initial packed unaligned dcl 142 ref 1055 1059 1063 1067 1385 1389 deckfile_dir 60 based char(168) level 2 packed packed unaligned dcl 1-25 ref 1037 1397 1398 1441 1442 1479 1479 deckfile_entry 132 based char(32) level 2 packed packed unaligned dcl 1-25 ref 1399 1443 deckfile_path 000304 automatic char(168) packed unaligned dcl 52 set ref 307* 414* 561* 838* 1120* 1384 1385 1385 1385* 1389 1389 1389* 1393* 1394* 1575* deckfile_sw 74(01) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 341* 450* 632* 815* 839* 883 883* 888 969 1152* 1326 1383 1474 1558* decks_tb_deleted 000167 automatic varying char(24) array dcl 50 set ref 314 314 314 317* 332* 345* 347* 365* 366* 367* 370 deleted 3(26) based bit(1) level 2 packed packed unaligned dcl 5-53 ref 742 denno 75 based fixed bin(17,0) level 2 dcl 2-23 set ref 1581* df_keys based structure level 1 dcl 104 dfkp 76 based pointer level 2 dcl 2-23 set ref 337* 345* 352 352 353 353 364 365 1146* 1149 1160* 1167 1167 1168 1168 1180 1182 1536* 1671 1671* 1673* dfm_data based structure level 1 unaligned dcl 2-23 dfm_data_ptr 2 based pointer level 2 dcl 1-25 ref 1296 1514 dfm_datap 001652 automatic pointer dcl 2-21 set ref 259* 264 273 291 304* 310 314* 322* 337 338 339 340 341 345* 345 345 347* 352 352 353 353 364 365 366* 367* 370 371* 371 371 392 405 411* 418 422 425 425 426* 430 431* 442 445 446 447 450 453 454 455 455 457 458* 458 458 458 459 460 460* 460 460 464 465 465 465 466* 466 466 466 467* 467 471 471 472 472 477 477 479 482 482* 485* 485 485 510* 511 524 541* 544* 551 558* 566* 570* 574* 588* 593* 605* 617* 620 622 624 626 632 634* 642* 642 642 642 644* 648 650* 650 650* 650 657* 669 670 670 674* 693* 697* 697 705 709 710 713* 713 713 713 715* 718 719* 719 722 722 730* 734 736 737 738 744* 744 746 756* 760 761 765 765 766 767 768 771 772 773 775* 775 775 775 775 775 777* 777 777 794 803 805 805 808 809 809 812 814 815 815 821* 828 829 835* 839 845* 851 853 855 855 855 861 867* 873 875 875 879* 883 883 883 883 888 888 888 891 892* 901 902 903 903 906 906* 911 912 913 917 920 921* 922 922 923 925 925* 928 928 929 929 930* 930 930 930 930 930 932* 936 937 937 937* 941 941 943 943 944 945 945 946* 947* 947 950 950 952 952 953 953 953 953 957 957 958* 958 958 958 958 958 960* 965 966 966* 969 969* 969 969 969 977* 977 977 977 977 977 980* 980 980 993 1001 1008* 1013* 1024* 1038* 1050* 1055 1063 1076 1077 1079 1079 1080 1080 1080* 1080 1080 1085 1086* 1086 1086 1086 1087 1088 1088* 1088 1088 1103 1112 1118* 1127* 1131* 1145 1146 1147 1149 1150 1152 1156* 1156 1156 1156 1157* 1160* 1160 1160 1162* 1167 1167 1168 1168 1180 1180* 1182 1185 1185 1198 1220 1225 1232 1253 1258 1265* 1266* 1269* 1269 1269 1269 1269 1272* 1272 1273 1274 1276 1278* 1278 1278 1278 1279* 1279 1282* 1282 1282 1282 1296* 1326 1328* 1328 1328 1332 1332* 1332 1332 1337* 1341 1341* 1356 1356 1358* 1358 1358 1358 1358 1360* 1360 1360 1364* 1366* 1366 1366 1369* 1383 1385 1394* 1402 1407* 1409 1410 1412 1414* 1414 1422 1425* 1429* 1429 1437* 1447 1452* 1454 1455 1457* 1457 1465 1466* 1466 1474 1474 1474 1480 1483* 1485 1485 1485* 1485 1490 1490 1490* 1490 1498 1498* 1498 1498 1514* 1515 1516 1528 1529 1530 1532 1533 1534 1535 1536 1538 1538 1539 1542 1543 1544 1545 1546 1547 1548 1549 1550 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1572 1576 1577 1578 1579 1580 1581 1582 1584 1585 1586 1617 1618 1618 1618* 1618 1620 1622 1622* 1622 1624 1626 1626 1627 1627* 1627 1629 1632 1632* 1632 1634 1636 1636* 1636 1638 1640 1640* 1640 1642 1644 1644 1646 1648 1648 1650 1652 1653 1653 1653 1653 1656* 1659 1659 1661 1663 1663 1665 1667 1667 1669 1671 1671 1673 1675 1675 1677 1679 1679 1681 1683 1683 1685 1687 dfm_info based structure level 1 dcl 1-25 dfm_infop 001650 automatic pointer dcl 1-37 set ref 273* 512 1037 1295* 1296 1397 1398 1399 1441 1442 1443 1479 1479 1513* 1514 1515 1527 1586 1616 1617 1688 dfm_util_$ck_applic 000030 constant entry external dcl 164 ref 969 dfm_util_$copy_eof 000032 constant entry external dcl 165 ref 925 937 dfm_util_$delete_deck 000034 constant entry external dcl 166 ref 366 dfm_util_$detach_file 000036 constant entry external dcl 167 ref 1272 1618 1622 1627 1632 1636 1640 dfm_util_$find_dkend 000040 constant entry external dcl 168 ref 1265 dfm_util_$find_file 000042 constant entry external dcl 169 ref 1407 1452 1483 dfm_util_$find_key 000044 constant entry external dcl 170 ref 345 458 466 1086 1160 1278 dfm_util_$get_cata 000046 constant entry external dcl 171 ref 642 713 1156 1358 dfm_util_$insert_deck 000050 constant entry external dcl 172 ref 775 930 958 977 1269 1366 dfm_util_$make_key 000052 constant entry external dcl 173 ref 1364 dfm_util_$mca_attach 000054 constant entry external dcl 174 ref 634 dfm_util_$mca_detach 000056 constant entry external dcl 175 ref 1656 dfm_util_$merge_files 000060 constant entry external dcl 176 ref 1080 dfm_util_$mount_diskette 000062 constant entry external dcl 177 ref 650 dfm_util_$open_file 000064 constant entry external dcl 178 ref 1414 1429 1457 1466 1485 1490 1498 dfm_util_$print_list 000066 constant entry external dcl 179 ref 371 460 485 777 980 1088 1282 dfm_util_$read_deck 000070 constant entry external dcl 180 ref 921 dfm_util_$read_diskette 000072 constant entry external dcl 181 ref 650 719 744 dfm_util_$update_list 000074 constant entry external dcl 182 ref 932 960 966 1369 dfm_util_$valid_diskette 000076 constant entry external dcl 183 ref 566 588 dir 106 based char(168) level 2 packed packed unaligned dcl 2-23 set ref 1055 1063 1328* 1332* 1385 1402 1409* 1447 1454* 1480 1530* dir_number 001664 automatic fixed bin(17,0) dcl 5-38 set ref 528 702* 703 704* 704 735 736 740 742 747 754 763 dir_ptr 001660 automatic pointer dcl 5-36 set ref 525* 528 528 734* 735* 736 741 754 755* 763 764* dir_size 27(09) based structure level 2 packed packed unaligned dcl 5-14 dire based structure level 1 packed packed unaligned dcl 5-53 dire_ptr 001662 automatic pointer dcl 5-37 set ref 741* 742 742 744 748 756 760 directory based structure level 1 packed packed unaligned dcl 5-40 set ref 528 735 736* 736 754 763 disk_dwg_num 36(18) based char(12) level 2 packed packed unaligned dcl 5-14 ref 707 disk_num 160 based fixed bin(17,0) level 2 dcl 2-23 set ref 697* diskette_type 000356 automatic char(4) packed unaligned dcl 54 set ref 706* 737 diskettes_tb_read 000356 automatic varying char(8) array dcl 53 set ref 568* 590* 614* 650 650 657* 670 673 674* 693 730* dkf_dir 000357 automatic char(168) array packed unaligned dcl 55 set ref 1327* 1393* 1398* 1402* 1407* 1409 1414 1424* 1429 1478 1478 1587* 1589* dkf_entry 000555 automatic char(32) array packed unaligned dcl 56 set ref 1327* 1393* 1399* 1403* 1407* 1410 1414 1424* 1429 1588* 1590* dkf_iocbp 100 based pointer array level 2 dcl 2-23 set ref 1079 1079 1080 1080* 1429* 1538 1538 1539* 1626 1626 1627 1627* 1629* dkf_path 000605 automatic char(168) array packed unaligned dcl 57 set ref 1013 1013 1013 1018* 1023 1033* 1050 1054 1054 1055 1055 1055* 1059 1059 1059* 1071 1071* 1423 1423 1423 1424 1425* 1428 1591* dkf_path_idx 001003 automatic fixed bin(17,0) dcl 58 set ref 996* 1013 1018 1019* 1019 dksp 162 based pointer level 2 dcl 2-23 set ref 713* dl_patch 001004 automatic bit(1) packed unaligned dcl 59 set ref 1104* 1123* 1185 1193* 1263 dlen parameter fixed bin(21,0) dcl 1353 in procedure "file_deck" set ref 1351 1366* dlen 164 based fixed bin(21,0) level 2 in structure "dfm_data" dcl 2-23 in procedure "dfm_" ref 969 dwg_num_tab 001005 automatic char(2) packed unaligned dcl 60 set ref 707* 760 ecode 001546 automatic fixed bin(35,0) dcl 241 set ref 261* 276* 278* edit_date 166 based char(6) level 2 packed packed unaligned dcl 2-23 set ref 705* entry 167(27) based char(32) level 2 packed packed unaligned dcl 2-23 set ref 1328* 1332* 1410* 1455* eof 001006 automatic bit(1) packed unaligned dcl 61 set ref 921* 922 935 eot 167(18) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 920 922 923* 1560* equip_type 32(18) based char(4) level 2 packed packed unaligned dcl 5-14 ref 706 err 001007 automatic bit(1) packed unaligned dcl 62 set ref 921* 922 928 error_table_$bad_arg 000142 external static fixed bin(35,0) dcl 205 set ref 304* 411* 426* 558* 835* 879* 1013* 1127* error_table_$noarg 000144 external static fixed bin(35,0) dcl 206 set ref 322* 431* 574* 892* 1024* 1038* 1050* 1131* error_table_$segnamedup 000146 external static fixed bin(35,0) dcl 207 ref 1328 1337 error_table_$too_many_names 000150 external static fixed bin(35,0) dcl 208 set ref 314* expand_pathname_ 000100 constant entry external dcl 184 ref 1393 1424 1436 explanation_len 14 001666 automatic fixed bin(21,0) initial level 2 dcl 6-7 set ref 326* 435* 578* 601* 660* 677* 896* 1028* 1042* 1135* 1189* 1203* 1210* 1236* 1243* 6-7* explanation_ptr 12 001666 automatic pointer initial level 2 dcl 6-7 set ref 327* 436* 579* 602* 661* 678* 897* 1029* 1043* 1136* 1190* 1204* 1211* 1237* 1244* 6-7* false constant bit(1) initial packed unaligned dcl 143 ref 351 393 394 418 512 532 533 815 829 943 965 1104 1165 1184 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1566 1567 1568 1569 1570 1571 1572 1597 1599 1600 1602 1604 1688 finished 202 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 511* 1559* 1687* fiocb_ptr 200 based pointer level 2 dcl 2-23 set ref 345* 371* 458* 460* 466* 485* 642* 713* 775* 777* 930* 958* 977* 980* 1156* 1160* 1269* 1278* 1282* 1358* 1366* 1414* 1542* 1632 1632* 1634* firmware_sw 202(01) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 814* 829* 883 888 888* 1563* first_deck 202(02) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 943* 1561* first_write 202(03) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 1562* flags 56 based structure level 2 dcl 1-25 fnp_key 203 based fixed bin(17,0) level 2 dcl 2-23 set ref 1582* fnp_tape 204 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 928 941 969 1564* fptr parameter pointer dcl 1354 set ref 1351 1366* free_area based area(1024) dcl 108 ref 528 735 754 763 1644 1648 get_system_free_area_ 000102 constant entry external dcl 185 ref 528 735 754 763 1644 1648 get_wdir_ 000104 constant entry external dcl 186 ref 1530 gtime_string 205(09) based char(6) level 2 packed packed unaligned dcl 2-23 set ref 1529* h_patch based structure level 1 dcl 2-162 set ref 1233* hbound builtin function dcl 122 ref 53 314 314 314 456 500 507 613 1013 1013 1013 1054 1079 1084 1185 1423 1538 1626 hbuff based char(300) array packed unaligned dcl 2-138 ref 1648 hbuff_p 210 based pointer level 2 dcl 2-23 set ref 1543* 1648 1648 1650* hcs_$chname_file 000106 constant entry external dcl 187 ref 1327 1336 hdr_sw 212 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 768* 1565* header based structure level 1 packed packed unaligned dcl 5-14 header_ptr 001656 automatic pointer dcl 5-11 set ref 669* 670 670 673 674 697 699 700 701 703 703 705 706 707 708 709 710 713 715 hpatches 213 based structure array level 2 dcl 2-23 set ref 1232 1253* 1258 i 001072 automatic fixed bin(17,0) dcl 65 set ref 253* 254* 255* 259 260 261* 298* 299* 302* 302 303* 344* 345 347 365 366 367 370* 400* 401* 409* 409 410* 456* 457* 507* 508* 535* 536* 539* 539 540* 556* 556 557* 647* 650 650 657 670 673 674 686 693 712 723 730* 950* 950* 953 953 998* 999* 1006* 1006 1007* 1054* 1055 1055 1055 1059 1059 1059 1071 1071* 1079* 1080 1080* 1084* 1085* 1109* 1110* 1116* 1116 1117* 1185* 1198 1220 1221* 1221 1226 1232 1253 1254* 1254 1259* 1423* 1423* 1424 1424 1424 1425 1428 1429 1429 1429 1429* 1538* 1539* 1626* 1627 1627 1629* id_blk based structure level 1 dcl 2-177 id_buf 523 based char(18) level 2 dcl 2-23 set ref 945 945 index builtin function dcl 121 ref 465 802 944 950 infop 530 based pointer level 2 dcl 2-23 set ref 273 1515* inst 3(27) based char(4) level 2 packed packed unaligned dcl 2-162 set ref 1246* 1247* 1248* ioa_$general_rs 000110 constant entry external dcl 188 ref 268 ioa_$rsnnl 000112 constant entry external dcl 189 ref 1214 1248 iox_$user_output 000152 external static pointer dcl 209 ref 339 455 1273 j 001073 automatic fixed bin(17,0) dcl 66 set ref 352* 353* 353 358* 358* 362* 364 365 471* 472* 472 477* 740* 741 742 747* 800* 801* 819* 819 820* 833* 833 834* 843* 843 844* 865* 865 866* 1167* 1168* 1168 1174* 1174* 1178* 1180 1182 key 1 based char(24) array level 2 in structure "lcata" dcl 2-144 in procedure "dfm_" set ref 472* 477 1282 1282 key 1 based char(24) array level 2 in structure "df_keys" dcl 104 in procedure "dfm_" set ref 353* 365 1168* 1182 key 1 based char(24) array level 2 in structure "cata" dcl 2-130 in procedure "dfm_" ref 950 953 953 l_att_desc 532 based char(181) level 2 packed packed unaligned dcl 2-23 set ref 809* 903* lbound builtin function dcl 123 ref 456 1054 1079 1084 1185 1423 1538 1626 lbuff based char(300) packed unaligned dcl 2-140 ref 1644 lbuff_p 610 based pointer level 2 dcl 2-23 set ref 1544* 1644 1644 1646* lc 000047 constant char(26) initial packed unaligned dcl 2-113 ref 650 650 670 673 lcata based structure level 1 dcl 2-144 set ref 775 775 977 977 1269 1269 lcatp 612 based pointer level 2 dcl 2-23 set ref 338* 453* 454 458* 466* 471 471 472 472 477 620* 775* 775 775 913* 977* 977 977 1077* 1086* 1147* 1150 1156* 1269* 1269 1269 1278* 1282 1282 1545* 1679 1679* 1681* length builtin function dcl 124 ref 326 435 578 601 660 677 775 775 896 930 930 958 958 977 977 1028 1042 1135 1189 1203 1210 1236 1240 1243 1247 1269 1269 lfd 616 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 524* 1566* lft 616(01) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 794* 1356 1498 1567* liocb_ptr 620 based pointer level 2 dcl 2-23 set ref 339* 455* 1272* 1273* 1485* 1490* 1546* 1618 1618* 1620* list 622 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 392* 928 966 1412 1485 1490 1568* list_all_keys 001074 automatic bit(1) packed unaligned dcl 67 set ref 393* 403* 430 440* 456 list_key 623 based varying char(24) level 2 dcl 2-23 set ref 370* 371* 425 425* 430 442* 445 457* 458* 459* 460 460* 464 465 465* 465 466* 467* 477* 479* 482 485* 1085* 1086* 1087* 1088 1088* 1276* 1278* 1279* 1578* list_types 000032 constant char(17) initial array packed unaligned dcl 2-116 ref 456 456 457 1084 1084 1085 literal_sw 1(05) 001666 automatic bit(1) initial level 3 packed packed unaligned dcl 6-7 set ref 6-7* 1602* lksp 614 based pointer level 2 dcl 2-23 set ref 1156* ls_type 632 based varying char(10) level 2 dcl 2-23 ref 775 777 977 980 lsb 27(10) based bit(8) level 3 packed packed unaligned dcl 5-14 ref 703 lsf_dir 001010 automatic char(168) packed unaligned dcl 63 set ref 1336* 1337* 1341* 1477* 1478* 1479* 1480* 1483* 1485 1485 1490 1490 lsf_entry 001062 automatic char(32) packed unaligned dcl 64 set ref 1336* 1337* 1341* 1481* 1483* 1485 1485 1490 1490 ltrim builtin function dcl 125 ref 805 826 852 855 1429 m_attached 636 based bit(1) level 2 packed packed unaligned dcl 2-23 ref 1652 maj 0(02) based bit(4) level 2 packed packed unaligned dcl 2-186 ref 670 722 746 1653 max_words_to_rd 000031 constant fixed bin(21,0) initial dcl 2-119 set ref 1653* mca 001075 automatic bit(1) packed unaligned dcl 68 set ref 533* 547* 599 607* mca_$read_data 000114 constant entry external dcl 190 ref 1653 mca_err 001076 automatic bit(72) packed unaligned dcl 69 set ref 650* 719* 744* mca_id 001100 automatic char(4) packed unaligned dcl 70 set ref 548* 608* 634* mca_ioi_idx 637 based fixed bin(17,0) level 2 dcl 2-23 set ref 1653* mca_status based structure level 1 packed packed unaligned dcl 2-186 mca_sub based structure level 1 packed packed unaligned dcl 2-192 mca_wksp 640 based pointer level 2 dcl 2-23 set ref 626* 650* 650* 669 718* 719* 734 736 738* 744* 761* 1547* 1653* 1675 1675* 1677* mcata based structure level 1 dcl 2-148 mcatp 642 based pointer level 2 dcl 2-23 set ref 624* 642* 772 773* 1548* 1683 1683* 1685* mdf 644 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 993* 1422 1474 1485 1490 1570* message 001547 automatic char(256) packed unaligned dcl 242 set ref 246* 268* 276 276 278 278 minargs constant fixed bin(17,0) initial dcl 144 ref 250 253 266 mksp 646 based pointer level 2 dcl 2-23 set ref 642* ml 001101 automatic fixed bin(21,0) dcl 71 set ref 247* 268* 276 276 278 278 msb 27(19) based bit(8) level 3 packed packed unaligned dcl 5-14 ref 703 n_diskettes_tb_read 001102 automatic fixed bin(17,0) dcl 72 set ref 567* 567 568 573 589* 590 613* 617 647 686 723 1583* n_entries based fixed bin(17,0) level 2 in structure "cata" dcl 2-130 in procedure "dfm_" set ref 930 930 950 952* 952 958 958 1356 n_entries based fixed bin(17,0) level 2 in structure "mcata" dcl 2-148 in procedure "dfm_" ref 772 n_entries based fixed bin(17,0) level 2 in structure "dcata" dcl 2-134 in procedure "dfm_" set ref 648 766 n_entries based fixed bin(17,0) level 2 in structure "df_keys" dcl 104 in procedure "dfm_" set ref 352 352 353* 364 1149* 1167 1167 1168* 1180 n_entries based fixed bin(17,0) level 2 in structure "lcata" dcl 2-144 in procedure "dfm_" set ref 454* 471 471 472* 775 775 977 977 1150* 1269 1269 nargs 001103 automatic fixed bin(17,0) dcl 73 set ref 249* 250 266 296* 298 298 398* 400 400 534* 535 535 798* 800 800 995* 998 1108* 1109 1109 ndecks_tb_deleted 001105 automatic fixed bin(17,0) dcl 75 set ref 292* 313* 313 314 317 321 331* 332 335 344 nl_sw 000231 constant bit(1) initial dcl 145 set ref 268* npatches 001104 automatic fixed bin(17,0) dcl 74 set ref 1226* 1259* 1263* 1265* null builtin function dcl 126 ref 250 250 255 255 525 755 764 1080 1080 6-7 6-7 6-7 528 1532 1533 1534 1535 1536 1539 1542 1543 1544 1545 1546 1547 1548 1549 1550 1606 1618 1620 1622 1624 1627 1629 1632 1634 1636 1638 1640 1642 1644 1646 1648 1650 1659 1661 1663 1665 1667 1669 1671 1673 1675 1677 1679 1681 1683 1685 o_patch based structure level 1 dcl 2-197 set ref 1199* obj_card 650 based char(80) level 2 dcl 2-23 set ref 947* of_dir 001106 automatic char(168) packed unaligned dcl 76 set ref 1436* 1442* 1447* 1452* 1454 1457 1477 1477 1592* of_entry 001160 automatic char(32) packed unaligned dcl 77 set ref 1436* 1443* 1448* 1452* 1455 1457 1593* of_iocbp 674 based pointer level 2 dcl 2-23 set ref 1080 1080* 1086* 1088* 1457* 1549* 1636 1636* 1638* of_path 001170 automatic char(168) packed unaligned dcl 78 set ref 1010* 1037 1047* 1050 1063 1063 1063* 1067 1067 1067* 1071 1435 1436* 1437* 1594* one_eof 676 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 922 936* 965* 1569* opatches 677 based structure array level 2 dcl 2-23 set ref 1185 1185 1198 1220* 1225 out_str 001650 automatic varying char dcl 500 set ref 506* 508* 508 510* output_mode_specified 001242 automatic bit(1) packed unaligned dcl 79 set ref 394* 419* 422* 445 p_fld 3(27) based char(51) level 2 packed packed unaligned dcl 2-197 set ref 1213* 1214* pad_sw 000231 constant bit(1) initial dcl 146 set ref 268* padding 1(07) 001666 automatic bit(29) initial level 3 packed packed unaligned dcl 6-7 set ref 6-7* 1604* page_no 1207 based fixed bin(17,0) level 2 dcl 2-23 set ref 447* 1586* 1617 page_number 57 based fixed bin(17,0) level 2 dcl 1-25 set ref 1586 1617* patch_length 001243 automatic fixed bin(17,0) dcl 80 set ref 1214* 1248* patch_ptr 001244 automatic pointer dcl 81 set ref 1225* 1258* 1265* patch_word 001246 automatic varying char(84) dcl 82 set ref 1214* 1217* 1220 1248* 1250* 1253 path_name based char(8) level 2 packed packed unaligned dcl 5-53 set ref 742 744 748* 756* 760 pd 1210 based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 1103* pfile 1211 based fixed bin(17,0) level 2 dcl 2-23 set ref 1585* pname 001274 automatic varying char(72) dcl 83 set ref 328* 353* 437* 472* 580* 603* 657* 662* 674* 679* 687* 724* 748* 898* 1030* 1044* 1137* 1168* 1191* 1205* 1212* 1217* 1222* 1238* 1245* 1250* 1255* 1517* print 000231 constant bit(1) initial packed unaligned dcl 147 set ref 322* 431* 510* 574* 657* 674* 697* 892* 946* 1024* 1038* 1131* 1332* 1341* prod_num_tab 001317 automatic char(2) packed unaligned dcl 84 set ref 708* 710 712 737 760 prompt_after_explanation 1(06) 001666 automatic bit(1) initial level 3 packed packed unaligned dcl 6-7 set ref 6-7* 1603* ptr_arg based pointer dcl 110 ref 259 query_code 3 001666 automatic fixed bin(35,0) initial level 2 dcl 6-7 set ref 6-7* query_info 001666 automatic structure level 1 dcl 6-7 set ref 1596 query_info_ptr 001320 automatic pointer dcl 85 set ref 328* 437* 580* 603* 662* 679* 898* 1030* 1044* 1137* 1191* 1205* 1212* 1238* 1245* 1596* query_info_version_6 constant fixed bin(17,0) initial dcl 6-36 ref 1598 query_message 001322 automatic char(256) packed unaligned dcl 86 set ref 325* 326 327 434* 435 436 577* 578 579 600* 601 602 659* 660 661 676* 677 678 895* 896 897 1027* 1028 1029 1041* 1042 1043 1134* 1135 1136 1188* 1189 1190 1202* 1203 1204 1209* 1210 1211 1235* 1236 1237 1242* 1243 1244 question_iocbp 4 001666 automatic pointer initial level 2 dcl 6-7 set ref 6-7* 1606* repeat_time 10 001666 automatic fixed bin(71,0) initial level 2 dcl 6-7 set ref 6-7* 1607* request_active 56 based bit(1) level 3 packed packed unaligned dcl 1-25 set ref 512* 1527* 1616 1688* rl 001422 automatic fixed bin(21,0) dcl 87 set ref 650* 718* 719* 738* 744* 761* 766* 767* 772* 773* 1653* rtrim builtin function dcl 127 ref 326 370 435 578 601 608 660 677 709 710 713 737 760 765 771 805 826 852 855 873 875 896 929 953 957 1028 1042 1055 1063 1135 1189 1203 1210 1236 1243 1276 1282 1282 1327 1328 1332 1336 1337 1341 1358 1360 1360 1385 1414 1414 1429 1429 1457 1466 1485 1485 1485 1485 1485 1485 1490 1490 1490 1490 1490 1490 sci_ptr 001424 automatic pointer dcl 88 in procedure "dfm_" set ref 264* 276* 278* 296* 299* 303* 337* 338* 398* 401* 410* 453* 534* 536* 540* 557* 620* 622* 624* 626* 798* 801* 820* 834* 844* 866* 911* 912* 913* 995* 999* 1007* 1076* 1077* 1108* 1110* 1117* 1145* 1146* 1147* 1294* 1295* 1311* 1512* 1516 1517* 1659* 1663* 1667* 1671* 1675* 1679* 1683* sci_ptr 1212 based pointer level 2 in structure "dfm_data" dcl 2-23 in procedure "dfm_" set ref 264 1516* search builtin function dcl 128 ref 544 605 ssu_$abort_line 000122 constant entry external dcl 193 ref 276 ssu_$abort_subsystem 000124 constant entry external dcl 194 ref 1311 ssu_$arg_count 000116 constant entry external dcl 191 ref 296 398 534 798 995 1108 ssu_$arg_ptr 000120 constant entry external dcl 192 ref 299 303 401 410 536 540 557 801 820 834 844 866 999 1007 1110 1117 ssu_$get_info_ptr 000126 constant entry external dcl 195 ref 1295 ssu_$get_subsystem_and_request_name 000132 constant entry external dcl 197 ref 1517 ssu_$get_temp_segment 000130 constant entry external dcl 196 ref 337 338 453 620 622 624 626 911 912 913 1076 1077 1145 1146 1147 ssu_$print_message 000134 constant entry external dcl 198 ref 278 ssu_$release_temp_segment 000136 constant entry external dcl 199 ref 1659 1663 1667 1671 1675 1679 1683 statp 1216 based pointer level 2 dcl 2-23 ref 670 722 746 1653 status_code 2 001666 automatic fixed bin(35,0) initial level 2 dcl 6-7 set ref 6-7* 1605* string builtin function dcl 129 set ref 1220* 1253* sub_err_ 000140 constant entry external dcl 200 ref 250 255 sub_ptr 1220 based pointer level 2 dcl 2-23 ref 670 722 1653 substr builtin function dcl 130 set ref 276 276 278 278 508 587 670 670 670 673 673 699 700 703* 707 708 953 953 1240* 1247* suppress_name_sw 1(01) 001666 automatic bit(1) initial level 3 packed packed unaligned dcl 6-7 set ref 6-7* 1599* suppress_spacing 1(04) 001666 automatic bit(1) initial level 3 packed packed unaligned dcl 6-7 set ref 6-7* 1600* switches 1 001666 automatic structure level 2 dcl 6-7 system_dir 000057 constant char(21) initial packed unaligned dcl 148 ref 1059 1067 1389 t_att_desc 1222 based char(181) level 2 packed packed unaligned dcl 2-23 set ref 803* 805* 805 855* 855 875* 875 901* 1498* tape_name 1277(09) based char(16) level 2 packed packed unaligned dcl 2-23 set ref 808* 809 855 891 902* 903 906 917* 1579* tdec 001426 automatic fixed bin(35,0) dcl 89 set ref 805 805 805 805 805 805 826 826 826 826 826 826 848* 850 850 850 850 850 852 855 870* 872 872 term 001427 automatic bit(1) packed unaligned dcl 90 set ref 351* 352 357* 471 476* 1165* 1167 1173* 1180 1184* 1185 1193* 1224* 1257* 1571* terminal_out 1303(09) based bit(1) level 2 packed packed unaligned dcl 2-23 set ref 340* 418* 422* 446* 455 1274* 1474 1572* 1618 time_string 1306 based char(24) level 2 packed packed unaligned dcl 2-23 set ref 1528* tiocb_ptr 1304 based pointer level 2 dcl 2-23 set ref 1498* 1550* 1640 1640* 1642* title 15(27) based char(8) level 2 packed packed unaligned dcl 5-14 ref 670 translate builtin function dcl 131 ref 650 650 670 673 true 000056 constant bit(1) initial packed unaligned dcl 150 ref 291 310 340 341 357 392 403 405 419 422 440 446 450 476 511 524 547 551 564 583 607 632 768 794 812 814 828 839 853 861 883 888 923 936 993 1001 1103 1112 1123 1152 1173 1193 1224 1257 1274 1527 1565 1603 1687 two_byte based structure level 1 packed packed unaligned dcl 5-45 type 1(27) based char(5) level 2 in structure "o_patch" packed packed unaligned dcl 2-197 in procedure "dfm_" set ref 1200* 1214* 1214 type 3(27) based char(3) level 3 in structure "id_blk" packed packed unaligned dcl 2-177 in procedure "dfm_" ref 945 945 type 1(18) based char(4) level 2 in structure "h_patch" packed packed unaligned dcl 2-162 in procedure "dfm_" set ref 1234* 1248* type_code 3 based structure level 2 packed packed unaligned dcl 2-177 uc 000022 constant char(26) initial packed unaligned dcl 2-120 ref 650 650 670 673 unique_id 17(27) based char(8) level 2 packed packed unaligned dcl 5-14 set ref 670 673 674* 697* 708 709 710 713 715* unspec builtin function dcl 132 set ref 648* 701* 703 775 775 930 930 958 958 977 977 1269 1269 user_entry 001430 automatic varying char(8) dcl 91 set ref 587* 588* 590 user_reply 001433 automatic varying char(256) dcl 92 set ref 328* 332 437* 440 440 442 580* 583 583 587 603* 605 608 662* 664 664 665 665 679* 681 681 682 682 898* 901 902 1030* 1033 1044* 1047 1137* 1140 1191* 1193 1193 1196 1196 1200 1205* 1207 1212* 1213 1230 1230 1234 1238* 1240 1240 1245* 1247 1247 valid_diskettes 000000 constant char(5) initial array packed unaligned dcl 2-123 ref 53 500 507 508 613 614 version 001666 automatic fixed bin(17,0) level 2 dcl 6-7 set ref 1598* vfile_open_mode 001534 automatic fixed bin(17,0) dcl 93 set ref 1412* 1413* 1414* wrapup 000056 constant bit(1) initial packed unaligned dcl 151 set ref 304* 314* 347* 367* 411* 426* 467* 482* 541* 544* 558* 570* 593* 605* 617* 644* 693* 715* 730* 756* 821* 835* 845* 867* 879* 906* 947* 1008* 1013* 1050* 1118* 1127* 1157* 1162* 1180* 1266* 1279* 1328* 1337* 1360* 1394* 1425* 1437* x_of_n 42(09) based bit(18) level 2 packed packed unaligned dcl 5-14 ref 699 700 701 xofn 001535 automatic char(2) packed unaligned dcl 94 set ref 701* yes_or_no_sw 1 001666 automatic bit(1) initial level 3 packed packed unaligned dcl 6-7 set ref 6-7* 1597* yes_sw 001536 automatic bit(1) packed unaligned dcl 95 set ref 353* 356 472* 475 687* 690 724* 727 748* 751 1168* 1172 1217* 1220 1222* 1224 1250* 1253 1255* 1257 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ACTION_CAN_RESTART internal static bit(36) initial dcl 7-7 ACTION_DEFAULT_RESTART internal static bit(36) initial dcl 7-7 ACTION_QUIET_RESTART internal static bit(36) initial dcl 7-7 ACTION_SUPPORT_SIGNAL internal static bit(36) initial dcl 7-7 Direct_input internal static fixed bin(17,0) initial dcl 4-15 Direct_output internal static fixed bin(17,0) initial dcl 4-15 Direct_update internal static fixed bin(17,0) initial dcl 4-15 Keyed_sequential_output internal static fixed bin(17,0) initial dcl 4-15 Sequential_input_output internal static fixed bin(17,0) initial dcl 4-15 Sequential_update internal static fixed bin(17,0) initial dcl 4-15 Stream_input internal static fixed bin(17,0) initial dcl 4-15 cata_key_string based char packed unaligned dcl 2-152 dcata_key_string based char packed unaligned dcl 2-154 dfm_info_version_1 internal static char(8) initial packed unaligned dcl 1-39 file_ptr automatic pointer dcl 5-62 file_size automatic fixed bin(21,0) dcl 5-63 hex_file based structure level 1 packed packed unaligned dcl 5-64 iox_modes internal static char(24) initial array dcl 4-6 lcata_key_string based char packed unaligned dcl 2-156 mcata_key_string based char packed unaligned dcl 2-158 query_info_version_3 internal static fixed bin(17,0) initial dcl 6-33 query_info_version_4 internal static fixed bin(17,0) initial dcl 6-34 query_info_version_5 internal static fixed bin(17,0) initial dcl 6-35 rs_desc based structure level 1 packed packed unaligned dcl 3-32 rs_info based structure level 1 dcl 3-6 rs_info_ptr automatic pointer dcl 3-5 rs_info_version_1 internal static fixed bin(17,0) initial dcl 3-43 rs_info_version_2 internal static fixed bin(17,0) initial dcl 3-44 seq_desc based structure level 1 packed packed unaligned dcl 3-37 short_iox_modes internal static char(4) initial array dcl 4-12 two_byte_ptr automatic pointer dcl 5-43 NAMES DECLARED BY EXPLICIT CONTEXT. add_name 020462 constant entry internal dcl 1321 ref 712 917 bad_arg 013036 constant label dcl 879 ref 849 850 871 872 clean_up 002406 constant entry external dcl 221 complain 002423 constant entry external dcl 238 ref 304 314 322 347 367 411 426 431 467 482 510 541 544 558 570 574 593 605 617 644 657 674 693 697 715 730 756 821 835 845 867 879 892 906 946 947 1008 1013 1024 1038 1050 1118 1127 1131 1157 1162 1180 1266 1279 1328 1332 1337 1341 1360 1394 1425 1437 delete_deck 003045 constant entry external dcl 286 dfm_ 002373 constant entry external dcl 34 exit_lfd 011434 constant label dcl 780 ref 666 683 691 728 file_deck 021266 constant entry internal dcl 1351 ref 718 738 761 767 773 969 get_files 021473 constant entry internal dcl 1378 ref 343 452 633 915 1074 1154 list 004140 constant entry external dcl 387 list_diskette_types 005325 constant entry external dcl 498 load_from_diskette 005473 constant entry external dcl 520 load_from_tape 011444 constant entry external dcl 790 merge_deckfiles 014425 constant entry external dcl 989 next_disk 007651 constant label dcl 686 ref 665 682 next_diskette 011244 constant label dcl 768 ref 690 727 next_file 011160 constant label dcl 762 ref 742 751 patch_deck 015610 constant entry external dcl 1099 pi_handler 020400 constant entry external dcl 1292 quit 020435 constant entry external dcl 1306 remount 007172 constant label dcl 650 ref 664 681 setup_part1 023255 constant entry internal dcl 1510 ref 223 289 389 502 522 792 991 1101 1308 setup_part2 023306 constant entry internal dcl 1524 ref 290 390 523 793 992 1102 wrap_up 023717 constant entry internal dcl 1615 ref 224 274 294 377 396 488 504 529 780 796 981 1091 1106 1284 1297 1310 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 26240 26414 25325 26250 Length 27166 25325 154 536 712 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME dfm_ 1596 external procedure is an external procedure. on unit on line 294 64 on unit on unit on line 396 64 on unit on unit on line 504 64 on unit on unit on line 527 70 on unit on unit on line 796 64 on unit on unit on line 1106 64 on unit add_name internal procedure shares stack frame of external procedure dfm_. file_deck internal procedure shares stack frame of external procedure dfm_. get_files internal procedure shares stack frame of external procedure dfm_. setup_part1 internal procedure shares stack frame of external procedure dfm_. setup_part2 internal procedure shares stack frame of external procedure dfm_. wrap_up 88 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME dfm_ 000100 N dfm_ 000101 X dfm_ 000102 al dfm_ 000103 all_diskettes dfm_ 000104 alp dfm_ 000106 ap dfm_ 000110 c_att_desc dfm_ 000166 code dfm_ 000167 decks_tb_deleted dfm_ 000275 deck_tb_patched dfm_ 000304 deckfile_path dfm_ 000356 diskette_type dfm_ 000356 diskettes_tb_read dfm_ 000357 dkf_dir dfm_ 000555 dkf_entry dfm_ 000605 dkf_path dfm_ 001003 dkf_path_idx dfm_ 001004 dl_patch dfm_ 001005 dwg_num_tab dfm_ 001006 eof dfm_ 001007 err dfm_ 001010 lsf_dir dfm_ 001062 lsf_entry dfm_ 001072 i dfm_ 001073 j dfm_ 001074 list_all_keys dfm_ 001075 mca dfm_ 001076 mca_err dfm_ 001100 mca_id dfm_ 001101 ml dfm_ 001102 n_diskettes_tb_read dfm_ 001103 nargs dfm_ 001104 npatches dfm_ 001105 ndecks_tb_deleted dfm_ 001106 of_dir dfm_ 001160 of_entry dfm_ 001170 of_path dfm_ 001242 output_mode_specified dfm_ 001243 patch_length dfm_ 001244 patch_ptr dfm_ 001246 patch_word dfm_ 001274 pname dfm_ 001317 prod_num_tab dfm_ 001320 query_info_ptr dfm_ 001322 query_message dfm_ 001422 rl dfm_ 001424 sci_ptr dfm_ 001426 tdec dfm_ 001427 term dfm_ 001430 user_entry dfm_ 001433 user_reply dfm_ 001534 vfile_open_mode dfm_ 001535 xofn dfm_ 001536 yes_sw dfm_ 001546 ecode dfm_ 001547 message dfm_ 001647 ABORT dfm_ 001650 dfm_infop dfm_ 001650 out_str dfm_ 001652 dfm_datap dfm_ 001654 ascii_cardp dfm_ 001656 header_ptr dfm_ 001660 dir_ptr dfm_ 001662 dire_ptr dfm_ 001664 dir_number dfm_ 001666 query_info dfm_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as alloc_char_temp cat_realloc_chars call_ext_in_desc call_ext_out_desc call_ext_out call_int_this call_int_other return_mac alloc_auto_adj bound_ck_signal enable_op shorten_stack ext_entry int_entry trunc_fx2 set_chars_eis index_chars_eis any_to_any_truncate_divide_fx1 op_alloc_ op_freen_ clock_mac THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. command_query_ command_query_$yes_no cu_$arg_count cu_$arg_list_ptr cu_$arg_ptr cv_dec_check_ date_time_ date_time_$format dfm_util_$ck_applic dfm_util_$copy_eof dfm_util_$delete_deck dfm_util_$detach_file dfm_util_$find_dkend dfm_util_$find_file dfm_util_$find_key dfm_util_$get_cata dfm_util_$insert_deck dfm_util_$make_key dfm_util_$mca_attach dfm_util_$mca_detach dfm_util_$merge_files dfm_util_$mount_diskette dfm_util_$open_file dfm_util_$print_list dfm_util_$read_deck dfm_util_$read_diskette dfm_util_$update_list dfm_util_$valid_diskette expand_pathname_ get_system_free_area_ get_wdir_ hcs_$chname_file ioa_$general_rs ioa_$rsnnl mca_$read_data ssu_$abort_line ssu_$abort_subsystem ssu_$arg_count ssu_$arg_ptr ssu_$get_info_ptr ssu_$get_subsystem_and_request_name ssu_$get_temp_segment ssu_$print_message ssu_$release_temp_segment sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_arg error_table_$noarg error_table_$segnamedup error_table_$too_many_names iox_$user_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 53 002315 500 002323 6 7 002333 510 002363 657 002366 34 002372 36 002401 221 002402 223 002414 224 002415 226 002421 238 002422 246 002431 247 002434 249 002435 250 002446 253 002517 254 002527 255 002544 259 002624 260 002633 261 002644 262 002650 264 002652 266 002655 267 002660 268 002667 272 002732 273 002734 274 002737 276 002743 277 003001 278 003003 279 003041 286 003043 289 003053 290 003054 291 003055 292 003060 294 003061 296 003103 298 003114 299 003125 301 003142 302 003154 303 003155 304 003172 307 003231 308 003235 310 003236 313 003252 314 003253 317 003314 319 003331 321 003333 322 003335 325 003371 326 003374 327 003406 328 003410 331 003443 332 003445 335 003460 337 003462 338 003510 339 003535 340 003542 341 003544 343 003546 344 003547 345 003557 347 003600 351 003637 352 003640 353 003655 356 003736 357 003741 358 003743 360 003745 362 003750 364 003752 365 003756 366 003774 367 004007 370 004046 371 004113 373 004127 377 004131 379 004135 387 004136 389 004146 390 004147 392 004150 393 004153 394 004154 396 004155 398 004177 400 004210 401 004221 403 004236 405 004253 408 004267 409 004277 410 004300 411 004315 414 004354 415 004360 417 004361 418 004371 419 004374 420 004376 422 004377 425 004415 426 004434 428 004470 430 004472 431 004502 434 004536 435 004541 436 004553 437 004555 440 004605 442 004622 445 004633 446 004643 447 004645 450 004646 452 004651 453 004652 454 004700 455 004702 456 004711 457 004721 458 004731 459 004750 460 004754 462 004775 464 005000 465 005005 466 005036 467 005056 471 005114 472 005131 475 005212 476 005215 477 005217 478 005233 479 005234 480 005236 482 005240 485 005303 488 005316 490 005322 498 005323 502 005333 504 005334 506 005356 507 005357 508 005365 509 005423 510 005426 511 005462 512 005465 513 005470 520 005471 522 005501 523 005502 524 005503 525 005506 527 005510 528 005524 529 005546 530 005553 532 005554 533 005555 534 005556 535 005567 536 005577 538 005614 539 005622 540 005623 541 005640 544 005700 547 005750 548 005752 549 005770 551 005772 554 006006 556 006016 557 006017 558 006034 561 006073 562 006077 564 006100 566 006113 567 006141 568 006142 569 006160 570 006161 571 006223 573 006225 574 006231 577 006265 578 006270 579 006302 580 006304 583 006334 587 006351 588 006356 589 006374 590 006376 591 006407 593 006410 599 006444 600 006446 601 006451 602 006463 603 006465 605 006515 607 006565 608 006567 609 006616 612 006617 613 006621 614 006623 617 006655 620 006714 622 006742 624 006771 626 007017 632 007046 633 007051 634 007052 642 007063 644 007112 647 007147 648 007157 650 007172 656 007276 657 007277 659 007341 660 007344 661 007356 662 007360 664 007410 665 007422 666 007434 669 007435 670 007440 673 007507 674 007513 676 007555 677 007560 678 007572 679 007574 681 007624 682 007636 683 007650 686 007651 687 007654 690 007721 691 007724 693 007725 695 007774 697 007775 699 010041 700 010050 701 010056 702 010061 703 010062 704 010077 705 010106 706 010112 707 010115 708 010121 709 010125 710 010141 712 010204 713 010221 715 010276 718 010337 719 010350 722 010411 723 010431 724 010434 727 010503 728 010506 730 010507 734 010550 735 010553 736 010572 737 010602 738 010645 740 010656 741 010665 742 010671 744 010706 746 010751 747 010764 748 010767 751 011031 752 011034 754 011035 755 011052 756 011054 760 011107 761 011147 762 011160 763 011162 764 011177 765 011201 766 011230 767 011234 768 011244 770 011247 771 011251 772 011272 773 011276 775 011306 777 011365 780 011434 783 011441 790 011442 792 011452 793 011453 794 011454 796 011457 798 011501 800 011512 801 011523 802 011540 803 011554 805 011572 808 011672 809 011704 810 011717 812 011721 813 011735 814 011745 815 011750 816 011762 818 011763 819 011773 820 011774 821 012011 824 012046 826 012064 828 012164 829 012170 830 012172 832 012173 833 012203 834 012204 835 012221 838 012260 839 012264 840 012267 842 012270 843 012300 844 012301 845 012316 848 012353 849 012376 850 012400 851 012413 852 012417 853 012503 855 012506 857 012576 859 012577 861 012600 864 012607 865 012617 866 012620 867 012635 870 012672 871 012715 872 012717 873 012724 875 012772 876 013034 879 013036 881 013074 883 013076 888 013112 891 013122 892 013126 895 013162 896 013165 897 013177 898 013201 901 013231 902 013247 903 013261 904 013274 906 013275 911 013334 912 013362 913 013411 915 013437 917 013440 920 013453 921 013460 922 013473 923 013510 925 013513 928 013525 929 013536 930 013570 932 013615 934 013626 935 013627 936 013632 937 013634 941 013650 943 013657 944 013671 945 013702 946 013713 947 013747 948 014004 950 014005 951 014031 952 014034 953 014036 955 014116 957 014117 958 014152 960 014177 962 014210 965 014211 966 014212 969 014226 975 014267 977 014270 980 014346 981 014415 982 014422 989 014423 991 014433 992 014434 993 014435 995 014440 996 014451 998 014453 999 014463 1001 014500 1004 014516 1006 014526 1007 014527 1008 014544 1010 014602 1011 014606 1013 014607 1018 014651 1019 014657 1021 014660 1023 014662 1024 014666 1027 014722 1028 014725 1029 014737 1030 014741 1033 014771 1037 014775 1038 015006 1041 015042 1042 015045 1043 015057 1044 015061 1047 015111 1050 015115 1054 015161 1055 015167 1059 015234 1063 015262 1067 015334 1071 015365 1072 015400 1074 015402 1076 015403 1077 015432 1079 015457 1080 015465 1082 015514 1084 015516 1085 015523 1086 015533 1087 015552 1088 015556 1089 015577 1091 015601 1092 015605 1099 015606 1101 015616 1102 015617 1103 015620 1104 015623 1106 015624 1108 015646 1109 015657 1110 015667 1112 015704 1115 015722 1116 015732 1117 015733 1118 015750 1120 016006 1121 016012 1123 016013 1125 016026 1127 016044 1128 016074 1130 016076 1131 016103 1134 016137 1135 016142 1136 016154 1137 016156 1140 016206 1145 016216 1146 016244 1147 016272 1149 016317 1150 016321 1152 016322 1154 016324 1156 016325 1157 016354 1160 016411 1162 016431 1165 016466 1167 016467 1168 016503 1172 016564 1173 016567 1174 016571 1176 016573 1178 016576 1180 016600 1182 016642 1184 016655 1185 016656 1188 016667 1189 016672 1190 016704 1191 016706 1193 016736 1196 016754 1198 016766 1199 016773 1200 017020 1202 017024 1203 017027 1204 017041 1205 017043 1207 017073 1209 017100 1210 017103 1211 017115 1212 017117 1213 017152 1214 017157 1217 017257 1220 017323 1221 017337 1222 017341 1224 017404 1225 017411 1226 017414 1227 017416 1230 017417 1232 017431 1233 017436 1234 017477 1235 017503 1236 017506 1237 017520 1238 017522 1239 017555 1240 017557 1242 017574 1243 017577 1244 017611 1245 017613 1246 017646 1247 017652 1248 017666 1250 017730 1253 017774 1254 020010 1255 020012 1257 020055 1258 020062 1259 020065 1261 020067 1263 020071 1265 020074 1266 020113 1269 020150 1272 020202 1273 020214 1274 020221 1276 020223 1278 020256 1279 020275 1282 020333 1284 020370 1285 020374 1292 020375 1294 020406 1295 020412 1296 020423 1297 020426 1298 020432 1306 020433 1308 020443 1310 020444 1311 020450 1312 020461 1321 020462 1326 020473 1327 020477 1328 020560 1332 020665 1336 020773 1337 021056 1341 021160 1344 021264 1345 021265 1351 021266 1356 021270 1358 021276 1360 021351 1362 021430 1364 021431 1366 021440 1369 021461 1371 021472 1378 021473 1383 021474 1384 021500 1385 021504 1389 021543 1393 021567 1394 021615 1396 021652 1397 021653 1398 021660 1399 021663 1400 021666 1402 021667 1403 021672 1407 021675 1409 021716 1410 021722 1412 021725 1413 021732 1414 021734 1417 022040 1422 022042 1423 022044 1424 022057 1425 022112 1428 022151 1429 022160 1432 022342 1433 022343 1435 022345 1436 022351 1437 022375 1439 022432 1441 022433 1442 022440 1443 022443 1444 022446 1447 022447 1448 022453 1452 022456 1454 022477 1455 022503 1457 022506 1460 022577 1465 022600 1466 022604 1468 022654 1474 022655 1477 022666 1478 022676 1479 022706 1480 022717 1481 022722 1483 022725 1485 022746 1490 023102 1494 023225 1498 023226 1503 023254 1510 023255 1512 023256 1513 023262 1514 023265 1515 023267 1516 023271 1517 023274 1518 023305 1524 023306 1527 023307 1528 023312 1529 023332 1530 023406 1532 023415 1533 023420 1534 023422 1535 023424 1536 023426 1538 023430 1539 023435 1540 023442 1542 023444 1543 023447 1544 023451 1545 023453 1546 023455 1547 023457 1548 023461 1549 023463 1550 023465 1552 023467 1553 023472 1554 023473 1555 023474 1556 023475 1557 023477 1558 023500 1559 023502 1560 023504 1561 023506 1562 023510 1563 023512 1564 023514 1565 023516 1566 023520 1567 023522 1568 023524 1569 023525 1570 023526 1571 023527 1572 023530 1574 023532 1575 023533 1576 023536 1577 023537 1578 023542 1579 023543 1580 023546 1581 023547 1582 023550 1583 023551 1584 023552 1585 023554 1586 023555 1587 023560 1588 023574 1589 023610 1590 023624 1591 023640 1592 023654 1593 023657 1594 023662 1596 023665 1597 023667 1598 023671 1599 023673 1600 023675 1601 023677 1602 023701 1603 023703 1604 023705 1605 023707 1606 023710 1607 023713 1609 023715 1615 023716 1616 023724 1617 023731 1618 023734 1620 023753 1622 023757 1624 023774 1626 024000 1627 024006 1629 024027 1630 024036 1632 024040 1634 024056 1636 024062 1638 024077 1640 024103 1642 024120 1644 024124 1646 024143 1648 024147 1650 024166 1652 024172 1653 024175 1656 024235 1659 024245 1661 024264 1663 024270 1665 024305 1667 024311 1669 024326 1671 024332 1673 024347 1675 024353 1677 024370 1679 024374 1681 024411 1683 024415 1685 024432 1687 024436 1688 024441 1690 024444 ----------------------------------------------------------- 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