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 %page;
 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 %page;
 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 %page;
 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: <key> ");
 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 %page;
 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: <the key or -all.> ");
 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 %page;
 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 %page;
 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: <diskette name>");
 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 %page;
 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 %page;
 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 <tape_name>: ");
 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 %page;
 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 <input deckfile path>: ");
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 <output deckfile path>: ");
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 %page;
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 <key of deck to be patched>: ");
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 %page;
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 %page;
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 %page;
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 %page;
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 %page;
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 %page;
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 %page;
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 %page;
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 %page;
1694 
1695 
1696 
1697 %include dfm_info;
1698 %page;
1699 %include dfm_data;
1700 %page;
1701 %include iox_modes;
1702 %page;
1703 %include mca_diskette;
1704 %page;
1705 %include query_info;
1706 %page;
1707 %include sub_err_flags;
1708 
1709 
1710    end dfm_;