1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) BULL HN Information Systems Inc., 1990   *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Bull Inc., 1988                *
   6         *                                                         *
   7         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   8         *                                                         *
   9         * Copyright (c) 1978 by Massachusetts Institute of        *
  10         * Technology and Honeywell Information Systems, Inc.      *
  11         *                                                         *
  12         * Copyright (c) 1972 by Massachusetts Institute of        *
  13         * Technology and Honeywell Information Systems, Inc.      *
  14         *                                                         *
  15         *********************************************************** */
  16 
  17 
  18 /****^  HISTORY COMMENTS:
  19   1) change(71-01-01,VanVleck), approve(), audit(), install():
  20       Written by THVV, date unknown (above date is made up).
  21   2) change(71-01-01,Vinograd), approve(), audit(), install():
  22       Modified by D. Vinograd to add subroutine entry (date unknown).
  23   3) change(78-11-01,Spector), approve(), audit(), install():
  24       Modified by David Spector:
  25       1. Bug which could cause a fatal process error fixed.
  26       2. Subroutine entry made to call clean_up when done.
  27       3. Bug in which final lines not terminated by NL, VT, or FF were deleted
  28          fixed.
  29       4. Bug in which final lines consisting only of NL, VT, or FF ("null
  30          lines") were deleted fixed.
  31       5. Command made to check for error when setting bit count of the output
  32          segment.
  33       6. Truncation of output segment now done in right place and with right
  34          count.
  35       7. Precision of several char length calculations corrected to 21 bits.
  36       8. Command made to check for write access to output segment.
  37       9. Bug in which allocated "bead" not freed upon certain errors fixed.
  38       10. Command made to use expand_pathname_ instead of expand_path_.
  39   4) change(80-03-26,Herbst), approve(), audit(), install():
  40       Modified by S. Herbst to leave zero-length seg alone.
  41   5) change(81-04-01,Wallman), approve(), audit(), install():
  42       Modified by E. Wallman to enforce range of printing chars.
  43   6) change(84-01-01,Lippard), approve(85-12-30,MCR7322),
  44      audit(86-01-15,KFleming), install(86-01-20,MR12.0-1006):
  45       Modified by Jim Lippard to:
  46       1. allow input tab length specification
  47       2. refuse to canonicalize object segments and archives
  48       3. not delete nonprinting characters
  49       4. terminate zero-length segments
  50       5. query if input segment is to be overwritten
  51       6. add the name "-ev" to "-every"
  52       7. optimize processing of non-overstruck data (speedup from
  53          Calgary's modified canonicalize by Tom Oke)
  54   7) change(86-02-11,Lippard), approve(86-02-11,PBF7322),
  55      audit(86-02-11,Dickson), install(86-02-17,MR12.0-1018):
  56       Modified to determine if a character is a nonprinting character
  57       correctly.
  58   8) change(86-03-06,Lippard), approve(86-03-14,MCR7371),
  59      audit(86-04-22,Dickson), install(86-04-22,MR12.0-1042):
  60       Modified to calculate the increment of col correctly.
  61   9) change(86-08-21,Lippard), approve(86-09-08,MCR7537),
  62      audit(86-09-30,Dickson), install(86-10-07,MR12.0-1178):
  63       Modified to properly strip white space off the ends of lines which
  64       contain no other characters.
  65  10) change(88-05-26,TLNguyen), approve(88-05-26,MCR7879),
  66      audit(88-10-04,RBarstad), install(90-04-12,MR12.4-1004):
  67      SCP6348: allow MSF in canon.
  68  11) change(90-03-02,LZimmerman), approve(90-03-02,MCR8158),
  69      audit(90-03-07,Kallstrom), install(90-04-12,MR12.4-1004):
  70      Correct unwarranted termination of input segment. (canonicalize_,
  71      canonicalize_tabs_)
  72                                                    END HISTORY COMMENTS */
  73 
  74 /* format: style4 */
  75 
  76 canonicalize:
  77 canon:
  78      proc;
  79 
  80 /* CANONICALIZE - fix file up to be canonical form. take out tabs too. (option to put in again) */
  81 
  82 /* Syntax as a command: canon path1 {path2} {-control_args}             */
  83 
  84 
  85 /* automatic variables */
  86 dcl  Access_ptr ptr;                                        /* access pointer */
  87                                                             /* the structure defined below is needed for both special cases: */
  88                                                             /* SSF canonicalize MSF (expanded); MSF canonicalize SSF (shrunk) */
  89                                                             /* Warning: the access structure defined below must be the same as */
  90                                                             /* the access structure defined in the access_.pl1 program */
  91                                                             /* access.set can be:  0 = NO, 1 = ACL_ADDED, or 2 = ACL_REPLACED */
  92                                                             /* access.type can be SEGMENT, DIRECTORY, or MSF */
  93                                                             /* access.old_mode to be reset when ACL_REPLACED */
  94                                                             /* directory path whose access was changed */
  95                                                             /* entryname whose access was changed */
  96 dcl  1 Access aligned based (Access_ptr),
  97        2 version char (8),
  98        2 set fixed bin,
  99        2 type fixed bin (2),
 100        2 old_mode bit (36),
 101        2 dir char (168) unaligned,
 102        2 ent char char (32) unaligned;
 103 
 104 dcl  Arg_len fixed bin;                                     /* length of an input argument */
 105 dcl  Arg_numb fixed bin;                                    /* counter */
 106 dcl  Arg_ptr ptr;                                           /* pointer to an input argument. */
 107 dcl  Arg_count fixed bin;                                   /* counter */
 108 
 109 dcl  Area_ptr ptr;
 110 dcl  Bead_ptr ptr;
 111 dcl  Bead_storage (1024) fixed bin;
 112 dcl  Bead_storage_size fixed bin;
 113 dcl  Beg_line fixed bin (21);                               /* location of the beginning of the next line */
 114 dcl  Bitc fixed bin (24);                                   /* bit count of an input segment */
 115 dcl  Cantab_flag bit (1) aligned;
 116 dcl  Chars_in_line fixed bin (21);                          /* counter */
 117 dcl  Chars_to_remove fixed bin (21);                        /* counter */
 118 dcl  Charx fixed bin;                                       /* counter */
 119 dcl  Col fixed bin;                                         /* column position in input scan */
 120 dcl  Create_temp_msf_flag bit (1) aligned;
 121 dcl  Desired_access bit (36);
 122 dcl  Dn char (168);                                         /* directory name of an input segment. */
 123 dcl  Do_not_create_temp_msf_flag bit (1) aligned;
 124 dcl  Ec fixed bin (35);                                     /* error code */
 125 dcl  En char (32);                                          /* entryname of an input segment */
 126 dcl  Eof_flag bit (1) aligned;                              /* set when end of file of an input segment reaches. */
 127 dcl  Eqln char (32);                                        /* equal entryname of an output segment.  Got from calling expand_pathname_, given an output segment pathname. */
 128 dcl  Everytab fixed bin;
 129 dcl  Fs_util_type char (32);                                /* determine the type of a specified entry */
 130 dcl  Have_infile_flag bit (1) aligned;                      /* set if an input segment is specified */
 131 dcl  Have_outfile_flag bit (1) aligned;                     /* set if an output segment is specified */
 132 dcl  Ii fixed bin (21);                                     /* counter */
 133 dcl  In_everytab fixed bin;
 134 dcl  In_nstops fixed bin;
 135 dcl  In_msf_comp_bitc fixed bin (24);                       /* bit count of a component of an input MSF */
 136                                                             /* the number of components in an input MSF */
 137 dcl  In_msf_total_original_comps fixed bin (24);
 138 dcl  Input_msf_comp_index fixed bin;                        /* the number of components in an input MSF */
 139 dcl  Input_msf_comp_ptr ptr;                                /* pointer to a component of an input msf */
 140 dcl  Input_msf_fcb_ptr ptr;                                 /* pointer to the FCB for an input MSF */
 141 dcl  In_stops (40) fixed bin;
 142 dcl  In_stopx fixed bin;
 143 dcl  Jj fixed bin (21);                                     /* counter */
 144 dcl  Kk fixed bin (21);                                     /* counter */
 145 dcl  Lth fixed bin (21);                                    /* line length */
 146 dcl  Mm fixed bin;                                          /* counter */
 147 dcl  Nch fixed bin (21);                                    /* population of Beads */
 148 dcl  Next_pos fixed bin;                                    /* number of positions output */
 149 dcl  Nonexistent_outfile_flag bit (1) aligned;
 150 dcl  Nstops fixed bin;
 151 dcl  Obuf_ptr ptr;                                          /* ptr to output buffer temp */
 152 dcl  Out_seg_ptr ptr;                                       /* ptr to an Outc segment. */
 153 dcl  Outc_ptr ptr;                                          /* ptr to Outc which holds a line of canonical characters */
 154 dcl  Out_dname char (168);                                  /* a directory name contains a specified Outc file (path2) */
 155 dcl  Out_ename char (32);                                   /*  an entryname of a specified Outc file (path2) */
 156 dcl  Outc_len fixed bin (21);                               /* the length of Outc which holds a line of canonical chars */
 157 dcl  Output_segment_length_in_words fixed bin (19);
 158 dcl  Overwrite_exist_path_flag bit (1);
 159 dcl  Ox fixed bin (21);                                     /* output line index */
 160 dcl  Spaces_to_go fixed bin;                                /* counter */
 161 dcl  Second_temp_seg_ptr ptr;
 162 dcl  Specified_infile_type fixed bin (2);
 163 dcl  Specified_temp_file_flag bit (1) aligned;              /* set when -temp_file PATH is specified */
 164 dcl  Seg_ptr ptr;                                           /* ptr to an input segment. */
 165 dcl  Stops (40) fixed bin;
 166 dcl  Stopx fixed bin;                                       /* counter */
 167 dcl  Subroutine_call_flag bit (1) aligned;
 168 dcl  Tab_flag bit (1) aligned;                              /* set if insert tabs. */
 169 dcl  Target_tabstop fixed bin;
 170 dcl  Temp_msf_comp_bitc fixed bin (24);                     /* bit count of an component of an output MSF */
 171 dcl  Temp_msf_fcb_ptr ptr;                                  /* pointer to the FCB for an output MSF */
 172 dcl  Temp_ptr ptr;
 173 dcl  Temp_dn char (168);                                    /* directory name contains a temp file */
 174 dcl  Temp_en char (32);                                     /* temp file */
 175 dcl  Temp_seg_len fixed bin (21);                           /* the length of a temp seg */
 176 dcl  Temp_seg_len_in_chars fixed bin (21);                  /* the length of a temp seg in characters */
 177 dcl  Temp_seg_ptr ptr;                                      /* points to a temp seg */
 178 dcl  Temp_msf_total_components fixed bin (24);              /* the number of components in a temp MSF */
 179 dcl  Temp_msf_comp_index fixed bin;
 180 dcl  Temp_msf_comp_ptr ptr;                                 /* pointer to an component of an output MSF. */
 181 dcl  This_tabstop fixed bin;
 182 
 183 /* based */
 184 
 185 dcl  Arg char (Arg_len) based (Arg_ptr);                    /* temp storage for for each input argument on the command line. */
 186 
 187 dcl  Bcs char (Lth) based (Seg_ptr) aligned;                /* holds the contents of the input file in NONcanonical form */
 188 
 189 /* Temp storage for a char string in line. It has a char position and char value fields */
 190 dcl  1 Bead (Bead_storage_size) based (Bead_ptr) aligned,
 191        2 loc fixed bin (26) unal,
 192        2 char char (1) unal;
 193 
 194 dcl  Obuf char (512) based (Obuf_ptr);                      /* holds up to 512 chars of path1 in NONcanonical form */
 195                                                             /* temporary segment holds the contents of path1 in CANONICAL form */
 196 
 197 dcl  Outc char (Outc_len) based (Outc_ptr);                 /* holds the contents of one line of characters in CANONICAL form */
 198 
 199 dcl  Second_temp_seg char (Temp_seg_len_in_chars) based (Second_temp_seg_ptr);
 200 
 201 dcl  Temp_seg char (Temp_seg_len_in_chars) based (Temp_seg_ptr);
 202 
 203 dcl  System_area area based (Area_ptr);
 204 
 205 dcl  Word_array (Output_segment_length_in_words) bit (36) based;
 206                                                             /* an array of an output segment in words. */
 207 
 208 /* builtin */
 209 dcl  (
 210      addr,
 211      copy,
 212      divide,
 213      hbound,
 214      index,
 215      max,
 216      min,
 217      null,
 218      rank,
 219      reverse,
 220      rtrim,
 221      search,
 222      substr,
 223      unspec,
 224      verify
 225      ) builtin;
 226 
 227 /* condition */
 228 dcl  (cleanup, record_quota_overflow) condition;
 229 
 230 /* external entries */
 231 dcl  absolute_pathname_ entry (char (*), char (*), fixed bin (35));
 232 dcl  access_$reset entry (ptr, fixed bin (35));
 233 dcl  access_$set_temporarily entry (char (*), char (*), fixed bin (2), bit (*), ptr, fixed bin (35));
 234 dcl  active_fnc_err_ entry options (variable);
 235 dcl  archive_$next_component entry (ptr, fixed bin (24), ptr, fixed bin (24), char (*), fixed bin (35));
 236 dcl  com_err_ entry options (variable);
 237 dcl  com_err_$suppress_name entry options (variable);
 238 dcl  command_query_$yes_no entry () options (variable);
 239 dcl  cu_$arg_count entry (fixed bin, fixed bin (35));
 240 dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
 241 dcl  cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin);
 242 dcl  delete_$path entry (char (*), char (*), bit (6), char (*), fixed bin (35));
 243 dcl  dm_error_$file_in_use fixed bin (35) external;
 244 dcl  (
 245      error_table_$active_function,
 246      error_table_$archive_pathname,
 247      error_table_$bad_arg,
 248      error_table_$badopt,
 249      error_table_$dirseg,
 250      error_table_$empty_file,
 251      error_table_$rqover,
 252      error_table_$noarg,
 253      error_table_$noentry,
 254      error_table_$no_m_permission,
 255      error_table_$no_r_permission,
 256      error_table_$no_w_permission,
 257      error_table_$not_seg_type,
 258      error_table_$zero_length_seg
 259      ) fixed bin (35) external;
 260 
 261 dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
 262 dcl  fs_util_$get_type entry (char (*), char (*), char (*), fixed bin (35));
 263 dcl  get_equal_name_ entry (char (*), char (*), char (*), fixed bin (35));
 264 dcl  get_group_id_ entry returns (char (32) aligned);
 265 dcl  get_pdir_ entry returns (char (168));
 266 dcl  get_system_free_area_ entry () returns (ptr);
 267 dcl  get_temp_segment_ entry (char (*), ptr, fixed bin (35));
 268 dcl  hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35));
 269 dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
 270 dcl  hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35));
 271 dcl  initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
 272 dcl  initiate_file_$create entry (char (*), char (*), bit (*), ptr, bit (1) aligned, fixed bin (24), fixed bin (35));
 273 dcl  msf_manager_$adjust entry (ptr, fixed bin, fixed bin (24), bit (3), fixed bin (35));
 274 dcl  msf_manager_$close entry (ptr);
 275 dcl  msf_manager_$msf_get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
 276 dcl  msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35));
 277 dcl  object_info_$brief entry (ptr, fixed bin (24), ptr, fixed bin (35));
 278 dcl  pathname_ entry (char (*), char (*)) returns (char (168));
 279 dcl  release_temp_segment_ entry (char (*), ptr, fixed bin (35));
 280 dcl  terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35));
 281 dcl  unique_chars_ entry (bit (*)) returns (char (15));
 282 
 283 /* like attribute */
 284 dcl  1 oi aligned like object_info;
 285 
 286 /* static constants */
 287 dcl  ACL_REPLACED fixed bin (2) int static options (constant) init (2);
 288 
 289 dcl  HT char (1) int static options (constant) init ("      ");
 290 dcl  NLVTFF char (3) int static options (constant) init ("^K^L
 291 ");
 292 dcl  SP char (1) int static options (constant) init (" ");
 293 dcl  BS char (1) int static options (constant) init ("^H");
 294 dcl  CR char (1) int static options (constant) init ("^M");
 295 dcl  SPBSCRHT char (4) int static options (constant) init (" ^H^M     ");
 296 dcl  HTSP char (2) int static options (constant) init ("     ");
 297 dcl  BSCR char (2) int static options (constant) init ("^H^M");
 298 
 299 dcl  COMPONENT_ZERO fixed bin int static options (constant) init (0);
 300 
 301 dcl  DIRECTORY fixed bin (2) int static options (constant) init (2);
 302 dcl  MSF fixed bin (2) int static options (constant) init (3);
 303 dcl  SEGMENT fixed bin (2) int static options (constant) init (1);
 304 
 305 dcl  FALSE bit (1) int static options (constant) init ("0"b);
 306 dcl  TRUE bit (1) int static options (constant) init ("1"b);
 307 
 308 dcl  PRECISION_FIXED_BIN_17 fixed bin int static options (constant) init (17);
 309 dcl  PRECISION_FIXED_BIN_19 fixed bin int static options (constant) init (19);
 310 dcl  PRECISION_FIXED_BIN_21 fixed bin int static options (constant) init (21);
 311 
 312 dcl  SWITCHES bit (6) int static options (constant) init ("100111"b);
 313 dcl  THREE_BIT_SWITCH bit (3) int static options (constant) init ("111"b);
 314 
 315 dcl  ME char (12) int static options (constant) init ("canonicalize");
 316 
 317 /* -------------------------------------------------------------------------- */
 318 %page;
 319 /* begin canonicalize main program */
 320 
 321           call initialization;
 322 
 323           call parsing_input_arguments;
 324           if Ec ^= 0 then return;
 325 
 326           if ^Have_infile_flag then do;                     /* forget path1 */
 327                call com_err_$suppress_name ((0), ME, "Usage: ^a path1 {path2} {-control_args}", ME);
 328                return;
 329           end;
 330                                                             /* prepare access values for later reference */
 331           if ^Have_outfile_flag then
 332                Desired_access = RW_ACCESS;                  /* when wanted to overwrite the original input file (segment or MSF) */
 333           else Desired_access = R_ACCESS;                   /* otherwise, only "read" access is needed */
 334 
 335           on cleanup begin;
 336                call clean_up;
 337                call term_segs;
 338           end;
 339 
 340 
 341 /* mainly proceeds canonicalization of an input file whose type is either a Segment or a Multisegment_file */
 342           call get_temp_segment_ (ME, Outc_ptr, Ec);        /* points to a temp storage Outc which holds one line of canincal chars */
 343           if Ec ^= 0 then do;
 344                call com_err_ (Ec, ME, "Cannot get temp segment.");
 345                return;
 346           end;
 347 
 348           if ^Specified_temp_file_flag then do;             /* by default, create a temp seg in the process directory */
 349                                                             /* points to a temp storage Temp_seg which holds a segment size of canonical chars */
 350                call get_temp_segment_ (ME, Temp_seg_ptr, Ec);
 351                if Ec ^= 0 then do;
 352                     call com_err_ (Ec, ME, "Cannot get temp segment.");
 353                     return;
 354                end;
 355           end;
 356           else do;                                          /* -temp_file PATH was specified */
 357                call hcs_$make_seg (Temp_dn, Temp_en, "", RW_ACCESS_BIN, Temp_seg_ptr, Ec);
 358                if Ec ^= 0 then do;
 359                     call com_err_ (Ec, ME, "^a", pathname_ (Temp_dn, Temp_en));
 360                     return;
 361                end;
 362           end;
 363 
 364 /* determine the entry type of an input file path1 and its length in bits */
 365           call hcs_$status_minf (Dn, En, 1, Specified_infile_type, Bitc, Ec);
 366           if Ec ^= 0 then do;
 367                call com_err_ (Ec, ME, "^a", pathname_ (Dn, En));
 368                call release_temp_segment_ (ME, Outc_ptr, (0));
 369                call release_temp_segment_ (ME, Temp_seg_ptr, (0));
 370                return;
 371           end;
 372 
 373           if Specified_infile_type = SEGMENT then
 374                call canon_segment;
 375 
 376           else if Specified_infile_type = DIRECTORY then
 377                call canon_msf;
 378 
 379           else do;
 380                call com_err_ (error_table_$not_seg_type, ME, "^a", pathname_ (Dn, En));
 381                call release_temp_segment_ (ME, Outc_ptr, (0));
 382                call release_temp_segment_ (ME, Temp_seg_ptr, (0));
 383                return;
 384           end;
 385 
 386           call clean_up;
 387           call term_segs;
 388 
 389 
 390           return;                                           /* complete canonicalize main program */
 391 
 392 /* --------------------------------------------------------------------------- */
 393 %page;
 394 parsing_input_arguments: proc;
 395 
 396 /* evaluate each input argument specified on the command level.              */
 397 
 398 /* begin parsing_input_arguments procedure */
 399 
 400           Ec = 0;
 401 
 402           call cu_$arg_count (Arg_count, Ec);
 403           if Ec ^= 0 then do;
 404                if Ec = error_table_$active_function then call active_fnc_err_ (Ec, ME);
 405                else call com_err_ (Ec, ME);
 406                return;
 407           end;
 408 
 409           do Arg_numb = 1 to Arg_count;
 410                call cu_$arg_ptr (Arg_numb, Arg_ptr, Arg_len, Ec);
 411                if Ec ^= 0 then do;
 412                     call com_err_ (Ec, ME);
 413                     return;
 414                end;
 415 
 416                if index (Arg, "-") = 1 then do;
 417                     if Arg = "-output_tabs" | Arg = "-otabs" then do;
 418                          Tab_flag = TRUE;
 419 
 420                          Arg_numb = Arg_numb + 1;
 421                          if Arg_numb > Arg_count then do;
 422                               Ec = error_table_$noarg;
 423                               call com_err_ (Ec, ME);
 424                               return;
 425                          end;
 426 
 427                          call continue_parsing_arguments;
 428                          if Ec ^= 0 then return;
 429                     end;
 430                     else if Arg = "-no_output_tabs" | Arg = "-notabs" then Tab_flag = FALSE;
 431                     else if Arg = "-input_tabs" | Arg = "-itabs" then do;
 432                          Arg_numb = Arg_numb + 1;
 433                          if Arg_numb > Arg_count then do;
 434                               Ec = error_table_$noarg;
 435                               call com_err_ (Ec, ME);
 436                               return;
 437                          end;
 438 
 439                          call continue_parsing_arguments;
 440                          if Ec ^= 0 then return;
 441                     end;
 442                     else if Arg = "-force" | Arg = "-fc" then Overwrite_exist_path_flag = TRUE;
 443                     else if Arg = "-no_force" | Arg = "-nfc" then Overwrite_exist_path_flag = FALSE;
 444                     else if Arg = "-temp_file" | Arg = "-tf" then do;
 445                          Specified_temp_file_flag = TRUE;
 446 
 447                          if Arg_numb = Arg_count then do;   /* -temp_file */
 448                               Ec = -1;
 449                               call com_err_ (0, ME, "Missing PATH argument for ^a.", Arg);
 450                               return;
 451                          end;
 452                          else do;                           /* -temp_file PATH */
 453                               Arg_numb = Arg_numb + 1;
 454                               call cu_$arg_ptr (Arg_numb, Arg_ptr, Arg_len, Ec);
 455                               if Ec ^= 0 then do;
 456                                    call com_err_ (Ec, ME, "Cannot get PATH argument for -temp_file.");
 457                                    return;
 458                               end;
 459 
 460                               if index (Arg, "-") = 1 then do;
 461                                                             /* -temp_file -bad_input_argument */
 462                                    Ec = error_table_$badopt;
 463                                    call com_err_ (Ec, ME, "^a.  Missing PATH argument for -temp_file.", Arg);
 464                                    return;
 465                               end;
 466 
 467                               call expand_pathname_ (Arg, Temp_dn, Temp_en, Ec);
 468                               if Ec ^= 0 then do;
 469                                    call com_err_ (Ec, ME, "Cannot expand the given PATH argument ^a for -temp_file.", Arg);
 470                                    return;
 471                               end;
 472                                                             /* since  the equal convention is allowed to specify a temp file similar to the input file */
 473                               call get_equal_name_ (En, Temp_en, Temp_en, Ec);
 474 
 475                               if Ec ^= 0 then do;
 476                                    call com_err_ (Ec, ME, "Cannot get an equal name similar to the original input file name ^a", pathname_ (Dn, En));
 477                                    return;
 478                               end;
 479                          end;
 480                     end;
 481                     else do;
 482                          Ec = error_table_$badopt;
 483                          call com_err_ (Ec, ME, "^a", Arg);
 484                          return;
 485                     end;
 486                end;
 487                else if ^Have_infile_flag then do;
 488                     call expand_pathname_ (Arg, Dn, En, Ec);
 489                     if Ec ^= 0 then do;
 490                          call com_err_ (Ec, ME, "Cannot expand the given input path1 ^a", Arg);
 491                          return;
 492                     end;
 493                     Have_infile_flag = TRUE;
 494                end;
 495                else if ^Have_outfile_flag then do;
 496                     Have_outfile_flag = TRUE;
 497                     call expand_pathname_ (Arg, Out_dname, Eqln, Ec);
 498                     if Ec ^= 0 then do;                     /* name for output seg */
 499                          call com_err_ (Ec, ME, "Cannot expand the specified output path2 ^a", Arg);
 500                          return;
 501                     end;
 502 
 503                     call get_equal_name_ (En, Eqln, Out_ename, Ec);
 504                     if Ec ^= 0 then do;
 505                          call com_err_ (Ec, ME, "Cannot get an equal name similar to the original file name ^a", pathname_ (Dn, En));
 506                          return;
 507                     end;
 508                end;
 509                else do;
 510                     Ec = error_table_$bad_arg;
 511                     call com_err_$suppress_name (Ec, ME, "Usage: ^a path1 {path2} {-control_args}", ME);
 512                     return;
 513                end;
 514           end;
 515 
 516           return;                                           /* return from parsing_input_arguments procedure to canonicalize main program */
 517 
 518 /* --------------------------------------------------------------------------- */
 519 %page;
 520 continue_parsing_arguments: proc;
 521 
 522                call cu_$arg_ptr (Arg_numb, Arg_ptr, Arg_len, Ec);
 523                if Ec ^= 0 then do;
 524                     call com_err_ (Ec, ME, "^a", Arg);
 525                     return;
 526                end;
 527 
 528                if Arg = "-every" | Arg = "-ev" then do;
 529                     Arg_numb = Arg_numb + 1;
 530                     if Arg_numb > Arg_count then do;
 531                          Ec = error_table_$noarg;
 532                          call com_err_ (Ec, ME, "Missing value for ^a", Arg);
 533                          return;
 534                     end;
 535 
 536                     call cu_$arg_ptr (Arg_numb, Arg_ptr, Arg_len, Ec);
 537                     if Ec ^= 0 then do;
 538                          call com_err_ (Ec, ME);
 539                          return;
 540                     end;
 541 
 542                     if Tab_flag then Everytab = cv_dec_check_ (Arg, Ec);
 543                     else In_everytab = cv_dec_check_ (Arg, Ec);
 544 
 545                     if Ec ^= 0 then do;
 546                          Ec = error_table_$bad_arg;
 547                          call com_err_ (Ec, ME, "^a", Arg);
 548                          return;
 549                     end;
 550                end;
 551                else do;
 552                     if Tab_flag then call grab_tabs (Stops, Nstops);
 553                     else call grab_tabs (In_stops, In_nstops);
 554 
 555                     if Ec ^= 0 then return;
 556                end;
 557 
 558                return;                                      /* return to parsing_input_arguments procedure */
 559 
 560           end continue_parsing_arguments;
 561 
 562 /* --------------------------------------------------------------------------- */
 563 %page;
 564 grab_tabs: proc (p_stops, p_nstop);
 565 
 566 
 567 dcl  p_nstop fixed bin,                                     /* number of stops set */
 568      p_stops (*) fixed bin;                                 /* array of set tab stops */
 569 
 570 /* begin grab_tabs procedure */
 571 
 572                Ec = 0;
 573                Kk = 1;
 574                do while (Kk < Arg_len);
 575                     Jj = index (substr (Arg, Kk), ",");
 576                     if Jj = 0 then Jj = Arg_len - Kk + 2;
 577 
 578                     Mm = cv_dec_check_ (substr (Arg, Kk, Jj - 1), Ec);
 579                     if Ec ^= 0 then do;
 580                          Ec = error_table_$bad_arg;
 581                          call com_err_ (Ec, ME, "^a", substr (Arg, Kk, Jj - 1));
 582                          return;
 583                     end;
 584 
 585                     p_nstop = p_nstop + 1;
 586                     if p_nstop > hbound (p_stops, 1) - 1 then do;
 587                          Ec = -1;                           /* indicates error */
 588                          call com_err_ (0, ME, "Too many ^[output^;input^] tabstops: ^d - max is ^d", Tab_flag, Mm, hbound (p_stops, 1) - 1);
 589                          return;                            /* we blew it */
 590                     end;
 591 
 592                     p_stops (p_nstop) = Mm;
 593                     Kk = Kk + Jj;
 594                end;
 595 
 596                return;                                      /* return to parsing_input_arguments. */
 597 
 598           end grab_tabs;
 599 
 600 /* --------------------------------------------------------------------------- */
 601 %page;
 602      end parsing_input_arguments;
 603 
 604 /* --------------------------------------------------------------------------- */
 605 %page;
 606 canonicalize_tabs_:
 607      entry (p_input_ptr, p_input_len, p_output_ptr, p_output_len, p_tab_flag, p_code);
 608 
 609 dcl  p_tab_flag bit (1);                                    /* input parameter */
 610 
 611 /* begin canonicalize_tabs_ external entry */
 612 
 613           call initialization;
 614 
 615           Tab_flag = p_tab_flag;
 616           if Tab_flag then Everytab = 10;
 617 
 618           goto NON_MSF_COMMON;
 619 
 620 /* ----------------------------------------------------------------------- */
 621 
 622 canonicalize_:
 623      entry (p_input_ptr, p_input_len, p_output_ptr, p_output_len, p_code);
 624 
 625 dcl  p_code fixed bin (35);
 626 dcl  p_input_ptr ptr;
 627 dcl  p_input_len fixed bin (21);
 628 dcl  p_output_ptr ptr;
 629 dcl  p_output_len fixed bin (21);
 630 
 631 /* begin canonicalize_ entry */
 632 
 633           call initialization;
 634 
 635 NON_MSF_COMMON:
 636           p_code = 0;
 637                                                             /* prepare canonicalization of the given input file whose type is segment */
 638           Seg_ptr = p_input_ptr;
 639           Lth = p_input_len;
 640 
 641           if Lth = 0 then do;                               /* the given input file is empty */
 642                p_code = error_table_$zero_length_seg;
 643                return;
 644           end;
 645 
 646           on cleanup call clean_up;
 647 
 648           call get_temp_segment_ (ME, Outc_ptr, p_code);    /* each line of the input file is canonicalized and then a line of */
 649                                                             /* canonical characters are stored in a temp segment pointed by Outc_ptr pointer */
 650           if p_code ^= 0 then return;
 651 
 652 /* the entire input file is canonicalized and then the entire canonical */
 653 /* characters are stored in a temp segment pointed by Temp_seg_ptr pointer */
 654           call get_temp_segment_ (ME, Temp_seg_ptr, p_code);
 655           if p_code ^= 0 then return;
 656                                                             /* do not create a temp MSF when canonicalization of an input file */
 657                                                             /* causes a temp segment reach its max seg size while canonicalization is in progress */
 658           Do_not_create_temp_msf_flag = TRUE;
 659 
 660           call do_canon;                                    /* convert the contents of the input SSF into a canonical form */
 661 
 662           if Ec ^= 0 then p_code = Ec;
 663           else do;
 664                p_output_ptr -> Temp_seg = Temp_seg;         /* copy Temp_seg into a specified output file whose type is segment */
 665                p_output_len = Temp_seg_len_in_chars;        /* update the length of the output file */
 666           end;
 667 
 668 Seg_ptr = null;
 669 
 670           call clean_up;
 671 
 672           return;                                           /* complete either canonicalize_tabs_ or canonicalize_ */
 673 
 674 /* --------------------------------------------------------------------------- */
 675 %page;
 676 validate_access: proc (p_dir, p_ename, p_type, p_desired_access, p_overwritten_flag);
 677 
 678 /* validate the access modes of the directory input parameter.  If that      */
 679 /* directory doesn't have a "modify" mode then canon reports an error.       */
 680 /* Otherwise, an appropriate queried message will be printed when an user    */
 681 /* wanted to overwrite an input path1 or a specified existent output path2,  */
 682 /* but he either did not have a "write" access mode to it or has a           */
 683 /* sufficient access (rew or rw) to it.                                      */
 684 /* For the case of unsufficient access, if he answers yes to the question,   */
 685 /* a "write" mode is TEMPORARILY set on it.  Otherwise, canon returns to the */
 686 /* command level.                                                            */
 687 
 688 /* in/out parameters */
 689 dcl  p_desired_access bit (*);                              /* input */
 690 dcl  (p_dir, p_ename) char (*);                             /* input */
 691 dcl  p_type char (*);                                       /* input */
 692 dcl  p_overwritten_flag bit (1);                            /* input/output */
 693 
 694 /* local */
 695 dcl  full_pathname char (168);
 696 dcl  grand_dn char (168);
 697 dcl  mode fixed bin (5);
 698 dcl  msf_directory_pathname char (168);
 699 dcl  parents_dn char (32);
 700 dcl  ring fixed bin;
 701 dcl  user_id char (32);
 702 
 703 /* begin validate_access procedure */
 704 
 705           Ec = 0;
 706           full_pathname = " ";
 707           grand_dn = " ";
 708           mode = 0;
 709           msf_directory_pathname = " ";
 710           parents_dn = " ";
 711           ring = -1;                                        /* indicates that a default value of the validation level of the calling process is used */
 712           user_id = " ";
 713 
 714           on cleanup call clean_up;
 715 
 716           call absolute_pathname_ (p_dir, full_pathname, Ec);
 717           if Ec ^= 0 then do;
 718                call com_err_ (Ec, ME, "Cannot get the absolute pathname of the directory ^a", p_dir);
 719                return;
 720           end;
 721           call expand_pathname_ (full_pathname, grand_dn, parents_dn, Ec);
 722           if Ec ^= 0 then do;
 723                call com_err_ (Ec, ME, "Cannot expand the directory ^a", full_pathname);
 724                return;
 725           end;
 726 
 727           user_id = get_group_id_ ();
 728           call hcs_$get_user_effmode (grand_dn, parents_dn, user_id, ring, mode, Ec);
 729           if Ec ^= 0 then do;
 730                call com_err_ (Ec, ME, "Cannot get the user effective mode of directory ^a", pathname_ (grand_dn, parents_dn));
 731                return;
 732           end;
 733 
 734           if (mode ^= M_ACCESS_BIN) & (mode ^= SM_ACCESS_BIN) & (mode ^= SMA_ACCESS_BIN) then do;
 735                Ec = error_table_$no_m_permission;
 736                call com_err_ (Ec, ME, "^a", pathname_ (grand_dn, parents_dn));
 737                return;
 738           end;
 739 
 740           if p_type = FS_OBJECT_TYPE_SEGMENT then do;
 741                call command_query_$yes_no (p_overwritten_flag, (0), ME, "", "Do you want to update the protected file ^a?", pathname_ (p_dir, p_ename));
 742                if ^p_overwritten_flag then return;
 743 
 744                call access_$set_temporarily (p_dir, p_ename, SEGMENT, p_desired_access, Access_ptr, Ec);
 745                if Ec ^= 0 then do;
 746                     call com_err_ (Ec, ME, "Cannot set ""write"" access mode on ^a", pathname_ (p_dir, p_ename));
 747                     return;
 748                end;
 749           end;
 750 
 751           if p_type = FS_OBJECT_TYPE_MSF then do;
 752                msf_directory_pathname = pathname_ (p_dir, p_ename);
 753                call hcs_$get_user_effmode (msf_directory_pathname, "0", user_id, ring, mode, Ec);
 754                if Ec ^= 0 then do;
 755                     call com_err_ (Ec, ME, "Cannot get effective access mode of component 0 for MSF ^a", pathname_ (p_dir, p_ename));
 756                     return;
 757                end;
 758 
 759                if (mode = N_ACCESS_BIN) | (mode = E_ACCESS_BIN) | (mode = W_ACCESS_BIN) then do;
 760                     Ec = error_table_$no_r_permission;
 761                     call com_err_ (Ec, ME, "^a", pathname_ (p_dir, p_ename));
 762                     return;
 763                end;
 764 
 765                else if (mode = R_ACCESS_BIN) | (mode = RE_ACCESS_BIN) then do;
 766                     call command_query_$yes_no (p_overwritten_flag, (0), ME, "", "Do you want to update the protected file ^a?",
 767                          pathname_ (p_dir, p_ename));
 768                     if ^p_overwritten_flag then return;
 769                                                             /* add a "write" access mode temporarily on a "read" only MSF */
 770                     call access_$set_temporarily (p_dir, p_ename, MSF, p_desired_access, Access_ptr, Ec);
 771                     if Ec ^= 0 then do;
 772                          call com_err_ (Ec, ME, "Cannot set ""write"" access  mode on ^a", pathname_ (p_dir, p_ename));
 773                          return;
 774                     end;
 775                end;
 776                                                             /* ask for overwritten a specified existent MSF after finding that */
 777                                                             /* it has a sufficient ACL (either RW_ACCESS_BIN or REW_ACCESS_BIN */
 778                else call command_query_$yes_no (p_overwritten_flag, (0), ME, "", "Do you want to overwrite ^a?", pathname_ (p_dir, p_ename));
 779           end;
 780 
 781           return;
 782 
 783      end validate_access;
 784 
 785 /* --------------------------------------------------------------------------- */
 786 %page;
 787 canon_msf: proc;
 788 
 789 /* given an input file whose type is MSF, an user's request was wanted to   */
 790 /* convert its NONCANONICAL characters into a CANONICAL form.               */
 791 /* The canonical data can be put either back into that input file if wanted */
 792 /* to overwrite it (e.g. canon infile_MSF) or into a specified  output      */
 793 /* file (e.g. canon infile_MSF existent_or_nonexistent_outfile).  Note      */
 794 /* that a specified output file can be ALREADY existed in an user's working */
 795 /* working directory or NOT existed yet.                                    */
 796 /*                                                                          */
 797 /* If an output path2 is specified and is not existed yet in the current    */
 798 /* working directory, it will be created in one of the following methods:   */
 799 /*    (a) by calling initiate_file_$create when canonicalization of the     */
 800 /*        input MSF gives canonical characters which are stored in the      */
 801 /*        Temp_seg and Temp_seg length has NEVER reached its max segment    */
 802 /*        length.                                                           */
 803 /*    (b) by creating a temporary MSF when canonicalization of the input    */
 804 /*        MSF gives canonical characters which are stored in the Temp_seg   */
 805 /*        and Temp_seg length has reached its maximum segment length        */
 806 /*        AT LEAST ONCE while canonicalization is in progress.  This causes */
 807 /*        a temp MSF to be created to copy Temp_seg's contents into an      */
 808 /*        appropriate component of the temp MSF in order to continue        */
 809 /*        canonicalization of the remaining components of the input MSF.    */
 810 /*                                                                          */
 811 /* There are two cases for processing canonicalization of the original      */
 812 /* inut file whose entry type is Multissegment file (MSF):                  */
 813 /*    Case 1: MSF canonicalize MSF (unchanged: type is unchanged)           */
 814 /*           Canonicalization of an input file, whose type is MSF, gives    */
 815 /*           canonical characters to be stored in an output file.           */
 816 /*           The length of the canonical output file is GREATER than the    */
 817 /*           max length of a segment.  So its type is MSF which is the same */
 818 /*           type as the type of the noncanonical input file path1.         */
 819 /*                                                                          */
 820 /*    Case 2: MSF canonicalize SSF (shrink: type changed from MSF to SSF)   */
 821 /*            Canonicalization of an input file path1, whose type is MSF,   */
 822 /*            gives canonical characters to be stored in an output file.    */
 823 /*            The length of the canonical output file is LESS or EQUAL than */
 824 /*            the max length of a segment.  So the type of the canonical    */
 825 /*            output file is SSF which is different type with the           */
 826 /*            noncanonical input file path1 whose type is MSF.              */
 827 /*                                                                          */
 828 
 829 
 830 /* begin canon_msf procedure */
 831 
 832           In_msf_total_original_comps = Bitc;               /* save the total components of the input path1 MSF for later reference */
 833 
 834           on cleanup call clean_up;
 835 
 836           if Bitc = 0 then do;                              /* the input path1 is a directory type which is not allowed for canon. */
 837                call com_err_ (error_table_$dirseg, ME, "Cannot canonicalize a directory.  ^a", pathname_ (Dn, En));
 838                return;
 839           end;
 840                                                             /* make sure that acceptable path1 type is either segment or Multisegment-file. */
 841           call get_specified_file_type (Dn, En, Fs_util_type);
 842           if Ec ^= 0 then return;
 843 
 844           if ^Have_outfile_flag then do;                    /* only an input path1 is specified */
 845                call validate_access (Dn, En, Fs_util_type, RW_ACCESS, Overwrite_exist_path_flag);
 846                if Ec ^= 0 then return;
 847 
 848                if ^Overwrite_exist_path_flag then return;   /* did not want to overwrite the input path2 MSF */
 849           end;
 850           else do;                                          /* an output file path2 is specified */
 851                call initiate_specified_output_file;
 852                if Ec ^= 0 then return;
 853                                                             /* the specified output file path2 exists and do not want to overwrite it */
 854                if ^Nonexistent_outfile_flag & ^Overwrite_exist_path_flag then return;
 855           end;
 856 
 857 /* open the specified input path1 whose type is MSF */
 858           call msf_manager_$open (Dn, En, Input_msf_fcb_ptr, Ec);
 859           if Ec ^= 0 then do;
 860                call com_err_ (Ec, ME, "Cannot open MSF input file.   ^a", pathname_ (Dn, En));
 861                return;
 862           end;
 863                                                             /* for each component of input path1 MSF, call do_canon to convert */
 864                                                             /* its noncanonical data into a canonical data which stored in Temp_seg */
 865           do Input_msf_comp_index = COMPONENT_ZERO to (In_msf_total_original_comps - 1);
 866                                                             /* get a specified component of the input file path1 whose type is MSF */
 867                call msf_manager_$msf_get_ptr (Input_msf_fcb_ptr, Input_msf_comp_index, FALSE, Input_msf_comp_ptr, In_msf_comp_bitc, Ec);
 868                if Ec ^= 0 then do;                          /* the input MSF and the temp MSF will be closed in the clean_up internal proc */
 869                     if Seg_ptr ^= null then                 /* sp points to a specified component of the input file (MSF) path1 */
 870                          Seg_ptr = null;                    /* do not call terminate_file_ to terminate the current component of the input MSF */
 871                     call com_err_ (Ec, ME, "Cannot get component ^d of input MSF ^a.", Input_msf_comp_index, pathname_ (Dn, En));
 872                     return;
 873                end;
 874 
 875                Seg_ptr = Input_msf_comp_ptr;                /* prepare for converting a particular component's contents into a canonical form */
 876                                                             /* calculate the length of that component in characters */
 877                Lth = divide (In_msf_comp_bitc + (BITS_PER_CHAR - 1), BITS_PER_CHAR, PRECISION_FIXED_BIN_21, 0);
 878 
 879                if Lth = 0 then do;
 880                     Seg_ptr = null;                         /* do not call terminate_file_ to terminate the current component of an input MSF */
 881                     Ec = error_table_$empty_file;
 882                     call com_err_ (Ec, ME, "The component ^d of the input MSF ^a is empty.", Input_msf_comp_index, rtrim (pathname_ (Dn, En)));
 883                     return;
 884                end;
 885 
 886                call do_canon;                               /* perform canonicalization of a specified component of the input MSF */
 887 
 888                if Ec ^= 0 then do;                          /* the input MSF path1 and temp MSF will be closed in the clean_up int.proc */
 889                     Seg_ptr = null;                         /* do not call terminate_file_ to terminate the current component of an input MSF */
 890                     return;
 891                end;
 892 
 893                Eof_flag = FALSE;                            /* prepare to convert the next component's contents of the input MSF into a canonical form */
 894           end;                                              /* complete read in components of the input path1 MSF */
 895 
 896           if ^Create_temp_msf_flag then do;                 /* case: MSF canonicalize SSF SHRUNK */
 897                if ^Have_outfile_flag then do;               /* wanted to overwrite the input path1 MSF */
 898                     call copy_temp_seg_into_msf (Dn, En, Input_msf_fcb_ptr, COMPONENT_ZERO, Input_msf_comp_ptr, In_msf_comp_bitc,
 899                          Temp_msf_total_components);
 900                     if Ec ^= 0 then return;
 901 
 902                     call msf_manager_$adjust (Input_msf_fcb_ptr, COMPONENT_ZERO, In_msf_comp_bitc, THREE_BIT_SWITCH, Ec);
 903                     if Ec ^= 0 then do;                     /* the input MSF path1 will be closed in the clean_up internal proc. */
 904                          Seg_ptr = null;                    /* do not call terminate_file_ to terminate the current component of an input MSF */
 905                          call com_err_ (Ec, ME, "Cannot adjust component ^d of MSF  ^a", COMPONENT_ZERO, rtrim (pathname_ (Dn, En)));
 906                          return;
 907                     end;
 908                end;                                         /* only the input path1 was specified */
 909                else do;                                     /* output path2 was specified */
 910                     if Out_seg_ptr ^= null then             /* the specified output path2 exists and its type is SSF */
 911                                                             /* put the contents of Temp_seg into a specified existent output path2 SSF */
 912                          call copy_temp_seg_into_segment;
 913 
 914                     else if Nonexistent_outfile_flag then do;
 915                                                             /* output path2 was specified and did not exist yet since Out_seg_ptr value is null */
 916                                                             /* so, creates and initiates the specified nonexistent output path2 */
 917                          call initiate_file_$create (Out_dname, Out_ename, RW_ACCESS, Out_seg_ptr, Nonexistent_outfile_flag, Bitc, Ec);
 918                          if Ec ^= 0 then do;                /* will close the input MSF path1 in the clean_up internal proc. */
 919                               Seg_ptr = null;               /* do not call terminate_file_ to terminate the current component of an input MSF */
 920                               call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
 921                               return;
 922                          end;
 923                                                             /* copy the contents of Temp_seg into a newly created segment */
 924                          call copy_temp_seg_into_segment;
 925                     end;                                    /* output path2 was specified and did not exist yet */
 926 
 927                     else if Fs_util_type = FS_OBJECT_TYPE_MSF then do;
 928                                                             /* copy Temp_seg into the specified output path2 whose type is MSF */
 929                          call copy_temp_seg_into_spec_pth2_MSF;
 930                          if Ec ^= 0 then do;                /* will close the input MSF path1 in the clean_up internal proc. */
 931                               Seg_ptr = null;               /* do not call terminate_file_ to terminate the current component of an input MSF */
 932                               return;
 933                          end;
 934                     end;                                    /* copy Temp_seg into a specified existent path2 whose type is MSF */
 935                end;                                         /* copy Temp_seg into a specified path2 whose type is either SSF or MSF */
 936           end;                                              /* case: MSF canonicalize SSF SHRUNK */
 937           else do;                                          /* case: MSF canonicalize MSF UNCHANGED */
 938                if Temp_seg_len_in_chars > 0 then do;
 939                     call temp_seg_to_temp_msf;              /* copy Temp_seg into a the next created component of a temp MSF */
 940                     if Ec ^= 0 then return;                 /* will close the input MSF path1 in the clean_up; temp MSF is already closed */
 941                end;
 942 
 943                if ^Have_outfile_flag then do;               /* only the input MSF path1 was specified */
 944                     call temp_msf_to_infile_or_outfile (Dn, En);
 945                     if Ec ^= 0 then return;
 946                end;
 947                else do;
 948                                                             /* open the specified output file path2 */
 949                     call msf_manager_$open (Out_dname, Out_ename, Input_msf_fcb_ptr, Ec);
 950                     if Ec ^= 0 then do;
 951                          if Ec ^= error_table_$noentry then do;
 952                               call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
 953                               return;
 954                          end;
 955                          else Ec = 0;                       /* no problem.  It will be created soon by the call to msf_manager_$msf_get_ptr */
 956                     end;
 957                                                             /* copy temp MSF into the specified output file */
 958                     call temp_msf_to_infile_or_outfile (Out_dname, Out_ename);
 959                     if Ec ^= 0 then return;
 960 
 961                     if Out_seg_ptr ^= null then Out_seg_ptr = null; /* points to a specified output SSF path2.  Do not call terminate_file_ */
 962                end;                                         /* output file path2 was specified */
 963           end;                                              /* case: MSF canonicalize MSF UNCHANGED */
 964 
 965           return;
 966 
 967      end canon_msf;
 968 
 969 /* ------------------------------------------------------------------------ */
 970 %page;
 971 canon_segment: proc;
 972 
 973 /* given an input file whose type is Segment, an user's request was to      */
 974 /* convert its NONCANICAL characters into a CANONICAL form.                 */
 975 /* Canonical chars can be put either back into that input file if wanted    */
 976 /* to overwrite it (e.g. canon infile_MSF) or into a specified  output      */
 977 /* file (e.g. canon infile_MSF existent_or_nonexistent_outfile).  Note      */
 978 /* that a specified output file can be ALREADY existed in an user's working */
 979 /* working directory or NOT existed yet.                                    */
 980 /*                                                                          */
 981 /* If an output path2 is specified and is not existed yet in the current    */
 982 /* working directory, it will be created in one of the following methods:   */
 983 /*    (a) by calling initiate_file_$create when canonicalization of the     */
 984 /*        input SSF gives canonical characters which are stored in the      */
 985 /*        Temp_seg and Temp_seg length has NEVER reached its max segment    */
 986 /*        length.                                                           */
 987 /*    (b) by creating a temporary MSF when canonicalization of the input    */
 988 /*        SSF gives canonical characters which are stored in the Temp_seg   */
 989 /*        and Temp_seg length has reached its maximum segment length        */
 990 /*        AT LEAST ONCE while canonicalization is in progress.  This causes */
 991 /*        a temp MSF to be created to copy Temp_seg's contents into an      */
 992 /*        appropriate component of the temp MSF in order to continue        */
 993 /*        canonicalization of the remaining components of the input SSF.    */
 994 /*                                                                          */
 995 /* There are two cases for processing canonicalization of a specified input */
 996 /* file whose type is segment (SSF).                                        */
 997 /*                                                                          */
 998 /* Case 1: SSF canonicalize SSF (type is unchanged)                         */
 999 /*         Canonicalization of input file path1, whose type is SSF, gives   */
1000 /*         canonical characters to be stored in an output file.             */
1001 /*         Because the length of the canonical output file is LESS or EQUAL */
1002 /*         the maximum length of a segment, so the type of the output file  */
1003 /*         is SSF which is the same type as the noncanical input file path1 */
1004 /*                                                                          */
1005 /* Case 2: SSF canonicalize MSF (expanded: type is changed from SSF to MSF) */
1006 /*         Canonicalization of input file path1, whose type is SSF, gives   */
1007 /*         canonical characters to be stored in an output file.             */
1008 /*         Because the max length of canonical output file is GREATER than  */
1009 /*         the max length of a segment, so the type of the canonical output */
1010 /*         file is MSF which is different type with the noncanonical input  */
1011 /*         file path1 whose type is SSF.                                    */
1012 /*                                                                          */
1013 
1014 /* begin canon_segment procedure */
1015 
1016           on cleanup call clean_up;
1017 
1018           if Bitc = 0 then do;                              /* the input path1 whose type is SSF is empty */
1019                call com_err_ (error_table_$zero_length_seg, ME, "^a", pathname_ (Dn, En));
1020                return;
1021           end;
1022                                                             /* initiate the input path1 SSF */
1023           call initiate_file_ (Dn, En, Desired_access, Seg_ptr, Bitc, Ec);
1024           if Ec ^= 0 then do;
1025                if Ec = error_table_$no_w_permission then do;/* do not treat as an error until digging in details */
1026                     Fs_util_type = FS_OBJECT_TYPE_SEGMENT;
1027                     call validate_access (Dn, En, Fs_util_type, Desired_access, Overwrite_exist_path_flag);
1028                     if Ec ^= 0 then return;
1029                     if ^Overwrite_exist_path_flag then return;
1030                                                             /* must reinitiate again to get Seg_ptr pointer pointing to an input SSF path1 */
1031                     call initiate_file_ (Dn, En, Desired_access, Seg_ptr, Bitc, (0));
1032                end;
1033                else do;
1034                     call com_err_ (Ec, ME, "^a", pathname_ (Dn, En));
1035                     return;
1036                end;
1037           end;                                              /* an error occured while initiating the input path1 */
1038                                                             /* assume had no problem with initiation.  Ask for overwritting the input path1 */
1039           if ^Have_outfile_flag & ^Overwrite_exist_path_flag then do;
1040                call command_query_$yes_no (Overwrite_exist_path_flag, (0), ME, "", "Do you want to overwrite ^a?", pathname_ (Dn, En));
1041                if ^Overwrite_exist_path_flag then return;
1042                                                             /* at this point, users want to overwrite the input path1 SSF */
1043                Fs_util_type = FS_OBJECT_TYPE_SEGMENT;       /* mark for later reference for the case: SSF canonicalize MSF (expanded) */
1044           end;
1045 
1046           call archive_$next_component (Seg_ptr, Bitc, (null ()), (0), (""), Ec);
1047           if Ec = 0 then do;
1048                Ec = error_table_$archive_pathname;
1049                call com_err_ (Ec, ME, "The specified path is an archive. ^a", pathname_ (Dn, En));
1050                return;
1051           end;
1052 
1053           oi.version_number = object_info_version_2;
1054           call object_info_$brief (Seg_ptr, Bitc, addr (oi), Ec);
1055           if Ec = 0 then do;
1056                Ec = error_table_$bad_arg;
1057                call com_err_ (Ec, ME, "The specified path is an object segment. ^a", pathname_ (Dn, En));
1058                return;
1059           end;
1060                                                             /* calculate the length of input path1 SSF in characters */
1061           Lth = divide (Bitc + (BITS_PER_CHAR - 1), BITS_PER_CHAR, PRECISION_FIXED_BIN_21, 0);
1062 
1063           if Have_outfile_flag then do;                     /* output path2 is specified */
1064                call initiate_specified_output_file;
1065                if Ec ^= 0 then return;
1066                                                             /* the specified output file path2 exists and do not want to overwrite it */
1067                if ^Nonexistent_outfile_flag & ^Overwrite_exist_path_flag then return;
1068           end;
1069           else Out_seg_ptr = Seg_ptr;                       /* Out_seg_ptr points to an input file path1 SSF because wanted to overwrite it */
1070 
1071 
1072           call do_canon;                                    /* convert the contents of the input SSF into a canonical form */
1073           if Ec ^= 0 then return;
1074 
1075           if ^Create_temp_msf_flag then do;                 /* case: SSF canonicalize SSF (canonical chars are stored in a temp seg) */
1076                if Out_seg_ptr ^= null then
1077                                                             /* copy Temp_seg into either the input file (SSF) path1, or */
1078                                                             /* the specified existent output file (SSF) path2 */
1079                     call copy_temp_seg_into_segment;
1080 
1081                else if Nonexistent_outfile_flag then do;    /* the specified output file path2 did not exist */
1082                     call initiate_file_$create (Out_dname, Out_ename, RW_ACCESS, Out_seg_ptr, Nonexistent_outfile_flag, Bitc, Ec);
1083                     if Ec ^= 0 then do;
1084                          call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
1085                          return;
1086                     end;
1087 
1088                     call copy_temp_seg_into_segment;        /* copy Temp_seg contents into the newly created output file (SSF) path2 */
1089                end;
1090 
1091                else do;                                     /* the specified existent output path2 is a Multisegment-file (MSF) */
1092                     call copy_temp_seg_into_spec_pth2_MSF;
1093                     if Ec ^= 0 then return;
1094                end;                                         /* the specified existent output path2 is a Multisegment-file (MSF) */
1095                                                             /* terminate the input path1 SSF pointed by Seg_ptr pointer by call terminate_file_ */
1096                call terminate_file_ (Seg_ptr, (0), TERM_FILE_TERM, (0));
1097           end;                                              /* case: SSF canonicialize SSF */
1098           else do;                                          /* case: SSF canonicalize MSF */
1099                if Temp_seg_len_in_chars > 0 then do;        /* Temp_seg contains canonical characters */
1100                     call temp_seg_to_temp_msf;              /* copy the contents of Temp_seg into a proper component of a temp MSF */
1101                     if Ec ^= 0 then return;
1102                end;
1103 
1104                if ^Have_outfile_flag then do;               /* for overwritten an input path1 SSF */
1105                     call msf_manager_$open (Dn, En, Input_msf_fcb_ptr, Ec);
1106                     if Ec ^= 0 then do;                     /* will close temp MSF in the clean_up internal proc. */
1107                          call com_err_ (Ec, ME, "^a", pathname_ (Dn, En));
1108                          return;
1109                     end;
1110                                                             /* copy the contents of temp msf into the input path1 SSF which converted to MSF */
1111                     call temp_msf_to_infile_or_outfile (Dn, En);
1112                     if Ec ^= 0 then return;
1113 
1114                     Seg_ptr = null;                         /* don't call terminate_file_ because the input SSF path1 has converted to MSF */
1115                end;
1116                else do;                                     /* a output path2 was specified */
1117                                                             /* open either a specified existent output path2 whose type either SSF or MSF */
1118                                                             /* or a specified nonexistent output file path2 */
1119                     call msf_manager_$open (Out_dname, Out_ename, Input_msf_fcb_ptr, Ec);
1120                     if Ec ^= 0 then do;
1121                          if Ec ^= error_table_$noentry then do; /* will close the temp MSF in the clean_up internal procedure */
1122                               call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
1123                               return;
1124                          end;
1125                          else Ec = 0;                       /* OK for specifying a nonexistent output file path2 */
1126                                                             /* it will be created when msf_manager_$msf_get_ptr is called */
1127                     end;
1128                                                             /* copy the contents of temp MSF into a specified output file path2 */
1129                     call temp_msf_to_infile_or_outfile (Out_dname, Out_ename);
1130                     if Ec ^= 0 then do;
1131                          if Nonexistent_outfile_flag then
1132                               call delete_$path (Out_dname, Out_ename, SWITCHES, ME, (0));
1133                          return;
1134                     end;
1135                                                             /* call terminate_file_ to terminate the input SSF path1 after */
1136                                                             /* copying the contents of temp MSF into a specified output file path2 */
1137                     call terminate_file_ (Seg_ptr, (0), TERM_FILE_TERM, (0));
1138                end;
1139           end;                                              /*  case: SSF CANONICALIZE MSF EXPANDED */
1140 
1141           return;
1142 
1143      end canon_segment;
1144 
1145 /* --------------------------------------------------------------------------- */
1146 %page;
1147 clean_up: proc;
1148 
1149 /* begin clean_up procedure */
1150 
1151           if Access_ptr ^= null then do;                    /* a write access mode has been temporarily added to a read only file */
1152                if Create_temp_msf_flag then do;             /* a temp MSF has been created earlier */
1153 
1154                     if Fs_util_type = FS_OBJECT_TYPE_SEGMENT then do;
1155                                                             /* must take care the ACL of the converted MSF whose original type is SSF */
1156                          Access.type = MSF;                 /* reinitialize to 3 to indicate that the new entry type is MSF */
1157                          Access.set = ACL_REPLACED;         /* prepare to replace the current ACL with its original ACL */
1158                          Access.old_mode = R_ACCESS;        /* restore its origial access mode */
1159                          call access_$reset (Access_ptr, (0)); /* replace the current ACL with the original ACL */
1160                     end;                                    /* the original type of the converted path2 MSF was SSF */
1161 
1162                     if Fs_util_type = FS_OBJECT_TYPE_MSF then /* the original entry type was MSF */
1163                          call access_$reset (Access_ptr, (0)); /* remove the "write" access mode that temporarily added earlier */
1164                end;                                         /* a temp MSF was created */
1165                else if Fs_util_type ^= " " then do;         /* a temp MSF has NEVER been created and the entry type is SSF or MSF */
1166                     if Fs_util_type = FS_OBJECT_TYPE_MSF then
1167                                                             /* the original type of the converted path2 SSF was MSF */
1168                          Access.type = SEGMENT;             /* update the entry type which is SSF */
1169 
1170                     call access_$reset (Access_ptr, (0));   /* remove the "write" access mode that temporarily added earlier */
1171                end;
1172           end;                                              /* a "write" access mode has been temporarily added to a "read" only in/out file */
1173 
1174           if Input_msf_fcb_ptr ^= null then do;
1175                call msf_manager_$close (Input_msf_fcb_ptr);
1176                if Seg_ptr ^= null then Seg_ptr = null;      /* double check since sp pointed to a specified component of an input MSF path1 */
1177                                                             /* or to the convert input MSF path1 whose original type was SSF */
1178           end;
1179 
1180           if Temp_msf_fcb_ptr ^= null then do;
1181                call msf_manager_$close (Temp_msf_fcb_ptr);
1182                if Out_seg_ptr ^= null then Out_seg_ptr = null; /* double check since Out_seg_ptr pointed to the converted output MSF path2 whose original type is SSF */
1183           end;
1184 
1185           if Temp_ptr ^= null then free Temp_ptr -> Bead;
1186 
1187           if Outc_ptr ^= null then
1188                call release_temp_segment_ (ME, Outc_ptr, (0));
1189 
1190           if Temp_seg_ptr ^= null then do;
1191                if ^Specified_temp_file_flag then
1192                     call release_temp_segment_ (ME, Temp_seg_ptr, (0));
1193                else do;
1194                     Temp_seg_ptr = null;
1195                     call delete_$path (Temp_dn, Temp_en, SWITCHES, ME, (0));
1196                end;
1197           end;
1198 
1199           if Second_temp_seg_ptr ^= null then
1200                call release_temp_segment_ (ME, Second_temp_seg_ptr, (0));
1201 
1202           return;
1203 
1204      end clean_up;
1205 
1206 /***************************************************************************/
1207 /*  This is part of the clean_up procedure that is not required if the
1208     call has come thru canonicalize_ or canonicalize_tabs_.                */
1209 
1210 term_segs:
1211      proc;
1212 
1213           if Out_seg_ptr = Seg_ptr then Out_seg_ptr = null; /* Out_seg_ptr also pointed to source since wanted to overwrite the input file path1 */
1214 
1215           if Seg_ptr ^= null then
1216                call terminate_file_ (Seg_ptr, (0), TERM_FILE_TERM, (0));
1217 
1218           if Out_seg_ptr ^= null then
1219                call terminate_file_ (Out_seg_ptr, (0), TERM_FILE_TERM, (0));
1220 
1221 end term_segs;
1222 /****************************************************************************/
1223 
1224 /* -------------------------------------------------------------------------- */
1225 %page;
1226 copy_temp_seg_into_msf: proc (p_dn, p_en, p_fcb_ptr, p_comp_index, p_comp_ptr, p_comp_bitc, p_temp_msf_total_components);
1227 
1228 /* put the contents of Temp_seg which contains canonical characters into     */
1229 /* either an appropriate component of the temp MSF or component 0 of a       */
1230 /* specified output path2 whose type is MSF.                                 */
1231 
1232 /* parameters */
1233 dcl  (p_dn, p_en) char (*);
1234 dcl  (p_comp_ptr, p_fcb_ptr) ptr;
1235 dcl  p_comp_index fixed bin;
1236 dcl  (p_comp_bitc, p_temp_msf_total_components) fixed bin (24);
1237 
1238 /* begin copy_temp_seg_into_msf procedure */
1239 
1240           Ec = 0;
1241 
1242           on cleanup call clean_up;
1243 
1244           on record_quota_overflow begin;
1245                Ec = error_table_$rqover;
1246                call msf_manager_$close (p_fcb_ptr);
1247                revert record_quota_overflow;
1248                goto temp_seg_to_msf_ERROR_RETURN;
1249           end;
1250                                                             /* want to create a specified component if it doesn't exist yet */
1251           call msf_manager_$msf_get_ptr (p_fcb_ptr, p_comp_index, TRUE, p_comp_ptr, p_comp_bitc, Ec);
1252           if Ec ^= 0 then do;
1253                call msf_manager_$close (p_fcb_ptr);
1254 
1255                if Fs_util_type = FS_OBJECT_TYPE_MSF then
1256                     call com_err_ (Ec, ME, "Cannot get component ^d of specified output MSF ^a", p_comp_index, pathname_ (p_dn, p_en));
1257                else call com_err_ (Ec, ME, "Cannot get component ^d of temp MSF ^a", p_comp_index, pathname_ (p_dn, p_en));
1258 
1259                return;
1260           end;
1261 
1262           p_comp_ptr -> Temp_seg = Temp_seg;                /* copy the contents of Temp_seg into into a specified component */
1263 
1264           if (p_comp_index = 0) & (p_temp_msf_total_components = 0) then
1265                                                             /* case of a specified path2 is nonexistent and a temp MSF has been created */
1266                p_temp_msf_total_components = 1;             /* update the total number of components in a temp MSF */
1267 
1268 /* calculate the bitc count of that component */
1269           p_comp_bitc = Temp_seg_len_in_chars * BITS_PER_CHAR;
1270 
1271 temp_seg_to_msf_ERROR_RETURN:
1272 
1273           return;
1274 
1275      end copy_temp_seg_into_msf;
1276 
1277 /* --------------------------------------------------------------------------- */
1278 %page;
1279 copy_temp_seg_into_spec_pth2_MSF: proc;
1280 
1281 /* copy the contents of Temp_seg into the component 0 of a specified output  */
1282 /* path2 whose type is MSF.                                                  */
1283 
1284 /* begin copy_temp_seg_into_spec_pth2_MSF procedure */
1285 /* get File control Block pointer */
1286           call msf_manager_$open (Out_dname, Out_ename, Temp_msf_fcb_ptr, Ec);
1287           if Ec ^= 0 then do;
1288                call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
1289                return;
1290           end;
1291                                                             /* copy Temp_seg into the component 0 of the specified output path2 MSF */
1292           call copy_temp_seg_into_msf (Out_dname, Out_ename, Temp_msf_fcb_ptr, Temp_msf_comp_index, Temp_msf_comp_ptr,
1293                Temp_msf_comp_bitc, Temp_msf_total_components);
1294           if Ec ^= 0 then return;
1295                                                             /* sets the bit count, truncates, and terminates its component 0 */
1296           call msf_manager_$adjust (Temp_msf_fcb_ptr, (Temp_msf_comp_index), Temp_msf_comp_bitc, THREE_BIT_SWITCH, Ec);
1297           if Ec ^= 0 then do;
1298                call msf_manager_$close (Temp_msf_fcb_ptr);
1299                call com_err_ (Ec, ME, "Cannot adjust component ^d of MSF ^a", Temp_msf_comp_index, pathname_ (Out_dname, Out_ename));
1300                return;
1301           end;
1302 
1303           return;
1304 
1305      end copy_temp_seg_into_spec_pth2_MSF;
1306 
1307 /* --------------------------------------------------------------------------- */
1308 %page;
1309 copy_temp_seg_into_segment: proc;
1310 
1311 /* when canonicalization of an input SSF is finished and Temp_seg length has */
1312 /* not reached the system defined max length yet, CHARS_PER_SEGMENT,         */
1313 /* copy_temp_seg_into_segment copies the contents of Temp_seg into one       */
1314 /* of the following files:                                                   */
1315 /*    (a) the specified output path2.  Note that if it did not exist, it     */
1316 /*        was created by calling initiate_file_$create earlier.              */
1317 /*    (b) the original input path1.                                          */
1318 
1319 
1320 dcl  output_segment_length_in_bits fixed bin (24);
1321 
1322 /* begin copy_temp_seg_into_segment procedure */
1323 
1324           output_segment_length_in_bits = 0;
1325 
1326           on cleanup call clean_up;
1327 
1328           on record_quota_overflow begin;
1329                Ec = error_table_$rqover;
1330                revert record_quota_overflow;
1331                goto temp_seg_to_segment_ERROR_RETURN;
1332           end;
1333 
1334           Output_segment_length_in_words = divide (Temp_seg_len_in_chars + (CHARS_PER_WORD - 1), CHARS_PER_WORD, PRECISION_FIXED_BIN_19, 0);
1335           call terminate_file_ (Out_seg_ptr, (Output_segment_length_in_words), TERM_FILE_TRUNC, Ec);
1336           if Ec ^= 0 then do;
1337                if Out_seg_ptr = Seg_ptr then
1338                     call com_err_ (Ec, ME, "^a", pathname_ (Dn, En));
1339                else call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
1340                return;
1341           end;
1342                                                             /* Clear last word used */
1343           Out_seg_ptr -> Word_array (Output_segment_length_in_words) = FALSE;
1344 
1345           Out_seg_ptr -> Temp_seg = Temp_seg;               /* copy canonical data into either input path1 or a specified output path2 */
1346 
1347           output_segment_length_in_bits = Temp_seg_len_in_chars * BITS_PER_CHAR;
1348           call terminate_file_ (Out_seg_ptr, (output_segment_length_in_bits), TERM_FILE_BC, Ec);
1349           if Ec ^= 0 then do;
1350                if Out_seg_ptr = Seg_ptr then
1351                     call com_err_ (Ec, ME, "^a", pathname_ (Dn, En));
1352                else call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
1353                return;
1354           end;
1355 
1356 temp_seg_to_segment_ERROR_RETURN:
1357           call terminate_file_ (Out_seg_ptr, (0), TERM_FILE_TERM, Ec);
1358 
1359           return;
1360 
1361      end copy_temp_seg_into_segment;
1362 
1363 /* -------------------------------------------------------------------------- */
1364 %page;
1365 do_canon: procedure;
1366 
1367 /* Each line of either the input segment or the specified component of the  */
1368 /* input MSF is read in.  Scan each character in that line to find out      */
1369 /* whether it is a normal character or a specified character.  For standard */
1370 /* characters, no convertion to canonical form is made, just copied them    */
1371 /* into Outc.  However, for special characters such as Backspace (BS), SP,  */
1372 /* Carriage return (CR), Horizontal tab (HT), ect., special processing is   */
1373 /* required to convertion them into standard (canonical) form before storing */
1374 /* in Outc.  So, continue to proceed the input line until a slew character  */
1375 /* is found.  Then copy the Outc which contains a line of characters in     */
1376 /* standard (canonical) form into the Temp_seg.  At this point, canon       */
1377 /* checks the length of Temp_seg in order to decide what actions will be    */
1378 /* taken next if tem_seg length reaches the maximum segment length.         */
1379 /* (a) Assume that the max segment length has not been reached.  Read in the */
1380 /*     next input line.  Repeat canonicalization of that line.  do_canon    */
1381 /*     terminates the convertion after the last line of the input segment   */
1382 /*     or of a specified component of the input MSF has been converted into */
1383 /*     a canonical form.                                                    */
1384 /* (b) Assume that the max segment length has been reached while            */
1385 /*     canonicalization is in progress.  A temporarly MSF is created in     */
1386 /*     either the process directory with a unique name (by default) or      */
1387 /*     in a specified directory (-temp_file was specified).  Copy Temp_seg  */
1388 /*     which is now full into a specified component of the newly created    */
1389 /*     temp MSF.  Then clear out the Temp_seg before continuing to put the  */
1390 /*     remaining contents of Outc (which is left over) into Temp_seg.       */
1391 /*     do_canon terminates the canonicalization of the input file after     */
1392 /*     the last line of the input file has been converted.                  */
1393 /*                                                                          */
1394 /* A "slew" character is a line-terminator (NL, VT, or FF).                 */
1395 
1396 dcl  available_pos_for_insertion fixed bin (21);
1397 dcl  next_char_pos fixed bin (21);
1398 dcl  remaining_pos_for_insertion fixed bin (21);
1399 dcl  slew_index fixed binary (21);
1400 dcl  slew_present_flag bit (1);
1401 
1402 %page;
1403 /* begin do_canon procedure */
1404 
1405           Ec = 0;
1406           available_pos_for_insertion = 0;
1407           remaining_pos_for_insertion = 0;
1408           Obuf_ptr = null;
1409           Beg_line = 1;                                     /* beginning line position */
1410 
1411           on cleanup call clean_up;
1412 
1413           Bead_storage_size = hbound (Bead_storage, 1);
1414 
1415           Bead_ptr = addr (Bead_storage);
1416           Area_ptr = get_system_free_area_ ();
1417 
1418           do while (^Eof_flag);                             /* scan each existing line of the input (segment or MSF component). */
1419                Outc_len, Ox = 0;                            /* clear out Outc which contains a line of caninical chars before continuing */
1420                                                             /* to convert the next input line into canonical form and store them in Outc */
1421                Nch = 0;                                     /* no chars seen */
1422                Obuf_ptr = addr (substr (Bcs, Beg_line, 1)); /* locate begin of line */
1423 
1424                Chars_in_line = search (substr (Bcs, Beg_line), NLVTFF);
1425                                                             /* find end of line */
1426                if Chars_in_line = 0 then do;                /* no more NL or other slew chars remain in input */
1427                     slew_present_flag = FALSE;
1428                     Chars_in_line = Lth - Beg_line + 2;
1429                                                             /* include a mythical slew char in count */
1430                end;
1431                else slew_present_flag = TRUE;               /* NL or other slew char found in input */
1432 
1433                Beg_line = Beg_line + Chars_in_line;         /* up to begin of next line */
1434                if Beg_line > Lth then Eof_flag = TRUE;
1435 
1436                slew_index = Chars_in_line;
1437 
1438 /* Remove trailing SPBSCRHTs. */
1439                Chars_to_remove = verify (reverse (substr (Obuf_ptr -> Bcs, 1, Chars_in_line - 1)), SPBSCRHT);
1440                if Chars_to_remove = 0 then Chars_to_remove = Chars_in_line;
1441 
1442                Chars_in_line = Chars_in_line - Chars_to_remove + 1;
1443 
1444                Col, Jj, In_stopx, Stopx, Next_pos = 1;
1445                if search (substr (Obuf_ptr -> Bcs, 1, Chars_in_line - 1), BSCR) ^= 0 then do; /* special processing necessary */
1446                     do while (Jj <= Chars_in_line - 1);     /* .. simulating a typewriter */
1447                          if substr (Obuf, Jj, 1) = BS then do;
1448                               Ii = verify (substr (Obuf, Jj, Chars_in_line - Jj), BS) - 1;
1449                               Jj = Jj + Ii;
1450                               Col = max (Col - Ii, 1);      /* don't backspace off end */
1451                          end;
1452                          else if substr (Obuf, Jj, 1) = CR then do;
1453                               Col = 1;
1454                               Jj = Jj + 1;
1455                          end;
1456                          else if substr (Obuf, Jj, 1) = HT then do;
1457                               Ii = verify (substr (Obuf, Jj, Chars_in_line - Jj), HT) - 1;
1458                               if In_nstops > 0 then do;
1459                                    if Col >= In_stops (In_nstops) then Col = Col + Ii;
1460                                    else do;
1461                                         do In_stopx = In_stopx to In_nstops + 1
1462                                              while (Col >= In_stops (In_stopx));
1463                                         end;
1464                                         if In_stopx + Ii > In_nstops then
1465                                              Col = In_stops (min (In_stopx + Ii - 1, In_nstops)) + In_stopx + Ii - 1 - In_nstops;
1466                                         else Col = In_stops (In_stopx + Ii - 1);
1467                                    end;
1468                               end;
1469                               else Col = In_everytab * (divide (Col - 1, In_everytab, PRECISION_FIXED_BIN_17, 0) + Ii) + 1;
1470 
1471                               Jj = Jj + Ii;
1472                          end;
1473                          else if substr (Obuf, Jj, 1) = SP then do;
1474                               Ii = verify (substr (Obuf, Jj, Chars_in_line - Jj), SP) - 1;
1475                               Jj = Jj + Ii;
1476                               Col = Col + Ii;
1477                          end;
1478                          else do;                           /* printing char */
1479                               Nch = Nch + 1;                /* allocate */
1480                               if Nch > Bead_storage_size then do; /* make sure don't blow array */
1481                                    Mm = Bead_storage_size;
1482                                    Bead_storage_size = 2 * Bead_storage_size;
1483 
1484                                    allocate Bead set (Temp_ptr) in (System_area);
1485 
1486                                    Bead_storage_size = Mm;
1487                                    Temp_ptr -> Bead = Bead;
1488                                    if Bead_ptr ^= addr (Bead_storage) then free Bead;
1489 
1490                                    Bead_ptr = Temp_ptr;
1491                                    Bead_storage_size = 2 * Bead_storage_size;
1492                               end;
1493                               Bead (Nch).char = substr (Obuf, Jj, 1);
1494                               Bead (Nch).loc = Col;         /* note (aparent) position */
1495 
1496                               if (rank (substr (Obuf, Jj, 1)) >= rank (" ") & rank (substr (Obuf, Jj, 1)) <= rank ("~")) then Col = Col + 1;
1497 
1498                               Jj = Jj + 1;
1499                          end;
1500                     end;                                    /* looping termination */
1501 
1502                     call sort;                              /* all chars done. sort array */
1503 
1504                     Next_pos = 1;                           /* next output pos */
1505                     do Charx = 1 to Nch;                    /* now put out the chars in right order */
1506                          if Charx > 1 then do;
1507                               if unspec (Bead (Charx)) = unspec (Bead (Charx - 1))
1508                               then goto do_canon_SKIP;
1509                          end;
1510                                                             /* Canonical form says no duplicate in same pos */
1511                          Spaces_to_go = Bead (Charx).loc - Next_pos;
1512                                                             /* number of spaces to put */
1513                          if Spaces_to_go > 0 then do;       /* if space needed */
1514                               if Tab_flag & Spaces_to_go > 1 then do; /* inserting tabs? */
1515                                    if Nstops > 0 then do;
1516                                         do Stopx = 1 to Nstops while (Next_pos >= Stops (Stopx));
1517                                         end;
1518 
1519                                         Cantab_flag = (Stopx <= Nstops);
1520                                         do while (Cantab_flag & (Bead (Charx).loc >= Stops (Stopx)));
1521                                              call output (HT);
1522                                              Next_pos = Stops (Stopx);
1523                                              Spaces_to_go = Bead (Charx).loc - Next_pos;
1524                                                             /* Recalculate spaces needed. */
1525                                              if Stopx >= Nstops then Cantab_flag = FALSE;
1526                                              else if Stops (Stopx + 1) > Bead (Charx).loc then Cantab_flag = FALSE;
1527                                              else Stopx = Stopx + 1;
1528                                         end;
1529                                    end;
1530                                    else do;                 /* -every case */
1531                                         Target_tabstop = Everytab * divide (Bead (Charx).loc - 1, Everytab, PRECISION_FIXED_BIN_17, 0) + 1;
1532 
1533                                         do while (Next_pos < Target_tabstop);
1534                                              call output (HT);
1535 
1536                                              This_tabstop = Everytab * divide (Next_pos - 1 + Everytab, Everytab, PRECISION_FIXED_BIN_17, 0) + 1;
1537                                              Next_pos = This_tabstop;
1538                                              Spaces_to_go = Bead (Charx).loc - Next_pos;
1539                                                             /* Recalculate spaces needed */
1540                                         end;
1541                                    end;
1542                               end;
1543 
1544                               do Ii = 1 to Spaces_to_go;    /* put out blanks */
1545                                    call output (SP);
1546                               end;
1547                          end;
1548 
1549 /* We consider nonprinting characters to not take up space for the purposes of
1550    calculating tabs and so forth, but we don't actually want to separate them
1551    by backspaces. */
1552                          if Spaces_to_go < 0 & (rank (Bead (Charx).char) >= rank (" ") & rank (Bead (Charx).char) <= rank ("~"))
1553                          then call output ((BS));           /* never more than one */
1554 
1555                          call output (Bead (Charx).char);   /* type char out */
1556 
1557                          Next_pos = Bead (Charx).loc + 1;   /* next column */
1558 do_canon_SKIP:
1559                     end;
1560                end;                                         /* typewriter simulation */
1561                else do;                                     /* just take the whole line */
1562                     Nch = 1;                                /* non_zero to start copy */
1563 
1564                     if ^Tab_flag then do;                   /* process case with space fill */
1565                          do while (Nch ^= 0);
1566                               Nch = index (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), HT); /* find HT */
1567                               if Nch = 0 then
1568                                    Ii = Chars_in_line - Jj;
1569                               else Ii = Nch - 1;            /* omit the tab in copy */
1570                               if Ii > 0 then do;
1571                                    Outc_len = Outc_len + Ii;
1572                                    substr (Outc, Ox + 1, Ii) = substr (Obuf_ptr -> Bcs, Jj, Ii);
1573 
1574                                    do Kk = Jj to (Jj + Ii - 1);
1575                                         if (rank (substr (Obuf_ptr -> Bcs, Kk, 1)) >= rank (" ") & rank (substr (Obuf_ptr -> Bcs, Kk, 1)) <= rank ("~"))
1576                                         then Col = Col + 1;
1577                                    end;
1578 
1579                                    Ox = Ox + Ii;
1580                                    Jj = Jj + Ii;
1581                               end;
1582 
1583                               if Nch ^= 0 then do;          /* fill spaces */
1584                                    Ii = verify (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), HT) - 1; /* take out multiples */
1585 
1586                                    Next_pos = Col;
1587                                    if In_nstops > 0 then do;
1588                                         if Col >= In_stops (In_nstops) then Spaces_to_go = Ii;
1589                                         else do;
1590                                              do In_stopx = In_stopx to In_nstops + 1
1591                                                   while (Col >= In_stops (In_stopx));
1592                                              end;
1593 
1594                                              if In_stopx + Ii > In_nstops
1595                                              then Spaces_to_go = In_stops (min (In_stopx + Ii - 1, In_nstops)) + In_stopx + Ii - 1 - In_nstops - Col;
1596                                              else Spaces_to_go = In_stops (In_stopx + Ii - 1) - Next_pos;
1597                                         end;
1598                                    end;
1599                                    else Spaces_to_go = In_everytab * (divide (Col - 1, In_everytab, PRECISION_FIXED_BIN_17, 0) + Ii) + 1 - Next_pos; /* number of spaces to fill in */
1600 
1601                                    Outc_len = Outc_len + Spaces_to_go;
1602                                    substr (Outc, Ox + 1, Spaces_to_go) = copy (SP, Spaces_to_go);
1603                                    Ox = Ox + Spaces_to_go;
1604                                    Col = Col + Spaces_to_go;
1605                                    Jj = Jj + Ii;            /* add source space for the tab */
1606                               end;
1607                          end;
1608                     end;
1609 
1610 %page;
1611 /* Process Case with Tab Fill */
1612                     else do;
1613                          do while (Jj <= Chars_in_line - 1);
1614 
1615 /* Clip spacing before section */
1616                               do while (search (substr (Obuf_ptr -> Bcs, Jj, 1), HTSP) ^= 0);
1617                                    if substr (Obuf_ptr -> Bcs, Jj, 1) = SP then do;
1618                                         Ii = verify (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), SP) - 1;
1619                                         Col = Col + Ii;
1620                                         Jj = Jj + Ii;
1621                                    end;
1622                                    else do;
1623                                         Ii = verify (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), HT) - 1;
1624 
1625                                         if In_nstops > 0 then do;
1626                                              if Col >= In_stops (In_nstops) then
1627                                                   Col = Col + Ii;
1628                                              else do;
1629                                                   do In_stopx = In_stopx to In_nstops + 1
1630                                                        while (Col >= In_stops (In_stopx));
1631                                                   end;
1632                                                   if In_stopx + Ii > In_nstops then
1633                                                        Col = In_stops (min (In_stopx + Ii - 1, In_nstops)) + In_stopx + Ii - 1 - In_nstops;
1634                                                   else Col = In_stops (In_stopx + Ii - 1);
1635                                              end;
1636                                         end;
1637                                         else Col = In_everytab * (divide (Col - 1, In_everytab, PRECISION_FIXED_BIN_17, 0) + Ii) + 1;
1638 
1639                                         Jj = Jj + Ii;
1640                                    end;
1641                               end;
1642 
1643 /* At this point initial white space has been clipped, Col = column after the
1644    white space, and Next_pos = last column printed + 1.  Now section through
1645    the tabulation. */
1646                               Spaces_to_go = Col - Next_pos;/* number of spaces to put */
1647                               if Spaces_to_go > 0 then do;  /* if space needed */
1648                                    if (Tab_flag) & (Spaces_to_go > 1) then do; /* inserting tabs? */
1649                                         if Nstops > 0 then do;
1650                                              if Next_pos > Stops (Nstops)
1651                                              then goto omit_simple_spaces; /* beyond reach */
1652                                                             /* Start from last tabstop for scan */
1653                                              do Stopx = Stopx to Nstops + 1
1654                                                   while (Next_pos >= Stops (Stopx));
1655                                              end;
1656 
1657                                              do Ii = Stopx to Nstops + 1
1658                                                   while (Col >= Stops (Ii));
1659                                              end;           /* find terminator */
1660 
1661                                              Ii = Ii - Stopx; /* number of tabs involved */
1662                                              if Ii < 1 then goto omit_simple_spaces; /* no tabs involved */
1663 
1664                                              Spaces_to_go = Col - Stops (Ii + Stopx - 1); /* spaces after last tab */
1665                                         end;
1666                                         else do;            /* -every */
1667                                                             /* tabstop number */
1668                                              Target_tabstop = divide (Col - 1, Everytab, PRECISION_FIXED_BIN_17, 0);
1669                                                             /* number of tabs to do */
1670                                              Ii = Target_tabstop - divide (Next_pos - 1, Everytab, PRECISION_FIXED_BIN_17, 0);
1671                                              if Ii < 1 then goto omit_simple_spaces; /* no tabbing involved */
1672                                              Spaces_to_go = Col - (Target_tabstop * Everytab + 1); /* spaces left after */
1673                                         end;
1674 
1675                                         if Ii > 0 then do;
1676                                              Outc_len = Outc_len + Ii;
1677                                              substr (Outc, Ox + 1, Ii) = copy (HT, Ii);
1678                                              Ox = Ox + Ii;  /* Output Horizontal tabs */
1679                                         end;
1680                                    end;
1681 
1682 omit_simple_spaces:
1683                                    if Spaces_to_go > 0 then do;
1684                                         Outc_len = Outc_len + Spaces_to_go;
1685                                         substr (Outc, Ox + 1, Spaces_to_go) = copy (SP, Spaces_to_go);
1686                                         Ox = Ox + Spaces_to_go;
1687                                    end;
1688                               end;
1689 
1690 /* Take out a string of text, to next gap. */
1691                               Ii = search (substr (Obuf_ptr -> Bcs, Jj, Chars_in_line - Jj), HTSP) - 1;
1692                               if Ii < 1 then
1693                                    Ii = Chars_in_line - Jj;
1694 
1695                               Outc_len = Outc_len + Ii;
1696                               substr (Outc, Ox + 1, Ii) = substr (Obuf_ptr -> Bcs, Jj, Ii); /* output string */
1697                               Ox = Ox + Ii;
1698                               do Kk = Jj to (Jj + Ii - 1);
1699                                    if (rank (substr (Obuf_ptr -> Bcs, Kk, 1)) >= rank (" ") & rank (substr (Obuf_ptr -> Bcs, Kk, 1)) <= rank ("~")) then
1700                                         Col = Col + 1;
1701                               end;
1702 
1703                               Jj = Jj + Ii;
1704                               Next_pos = Col;
1705                          end;                               /* end of parse loop */
1706                     end;
1707                end;
1708 
1709                if slew_present_flag then
1710                                                             /* finally, append the slew char to the Outc which contains a line of CANONINCAL chars */
1711                     call output (substr (Obuf, slew_index, 1));
1712 
1713 /* check the boundary of temp seg after adding an entire line of canonincal chars to it */
1714                if (Temp_seg_len_in_chars + Outc_len) < CHARS_PER_SEGMENT then do;
1715                                                             /* copy the entire line of canonical chars (stored in Outc) into the Temp_seg */
1716                     next_char_pos = Temp_seg_len_in_chars + 1;
1717                     Temp_seg_len_in_chars = Temp_seg_len_in_chars + Outc_len;
1718                     substr (Temp_seg, next_char_pos, Outc_len) = Outc;
1719                end;
1720                else do;                                     /* case of reaching the maximum length of Temp_seg */
1721                                                             /* calculate the number of spaces left in temp seg, then filled up temp seg */
1722                     available_pos_for_insertion = CHARS_PER_SEGMENT - Temp_seg_len_in_chars;
1723                     next_char_pos = Temp_seg_len_in_chars + 1;
1724                     Temp_seg_len_in_chars = Temp_seg_len_in_chars + available_pos_for_insertion;
1725                     substr (Temp_seg, next_char_pos, available_pos_for_insertion) = substr (Outc, 1, available_pos_for_insertion);
1726 
1727                     if Do_not_create_temp_msf_flag then do;
1728                                                             /* the canonicalize_tab_ and canonincal_ entries don't want to expand path1 SSF into MSF */
1729                          Ec = error_table_$rqover;
1730                          return;
1731                     end;
1732                                                             /* temp seg containing canonical characters is full */
1733                     if ^Create_temp_msf_flag then do;
1734                          Create_temp_msf_flag = TRUE;
1735 
1736                          if ^Specified_temp_file_flag then do; /* by default: prepare to create a temp MSF in the process directory with an unique name */
1737                               Temp_dn = get_pdir_ ();
1738                               Temp_en = unique_chars_ (FALSE);
1739                          end;
1740                          else do;                           /* a temp segment ws created ealier by hcs_$make_seg when -tf was given */
1741                                                             /* this specified temp segment will be converted to a temp MSF very soon. */
1742                                                             /* So, canon must get another temp seg for continuing canonicalization. */
1743                               call get_temp_segment_ (ME, Second_temp_seg_ptr, Ec);
1744                               if Ec ^= 0 then do;
1745                                    call com_err_ (Ec, ME, "Cannot get temp segment.");
1746                                    return;
1747                               end;
1748                                                             /* copy the specified temp segment's contents into another temp segment */
1749                               Second_temp_seg_ptr -> Second_temp_seg = Temp_seg_ptr -> Temp_seg;
1750                                                             /* assign Temp_seg_ptr points to another temp segment */
1751                                                             /* such that the remaining canonical chars will be stored in the second temp seg */
1752                                                             /* and the specified temp segment in a specified directory will be */
1753                                                             /* converted into a temp MSF by calling msf_manager_$msf_get_ptr soon */
1754                                                             /* in the call to copy_temp_seg_into_msf internal procedure */
1755                               Temp_seg_ptr = Second_temp_seg_ptr;
1756 
1757                               Second_temp_seg_ptr = null;   /* no need */
1758                          end;
1759                                                             /* open temp MSF.  Wants a pointer that points to the FCB of the temp MSF */
1760                          call msf_manager_$open (Temp_dn, Temp_en, Temp_msf_fcb_ptr, Ec);
1761                          if Ec ^= 0 then do;
1762                               if Ec ^= error_table_$noentry then do;
1763                                    call com_err_ (Ec, ME, "^a", pathname_ (Temp_dn, Temp_en));
1764                                    return;
1765                               end;
1766                               else Ec = 0;                  /* OK for temp MSF not found.  It will be created in copy_temp_seg_into_msf */
1767                          end;
1768                     end;
1769                                                             /* prepare to request a component greater than 0 */
1770                     if Temp_msf_total_components > 0 then do;
1771                          Temp_msf_comp_index = Temp_msf_total_components;
1772                          Temp_msf_total_components = Temp_msf_total_components + 1;
1773                     end;
1774 
1775 /* copy tem_seg into an appropriate component of a newly created temp MSF */
1776                     call copy_temp_seg_into_msf (Temp_dn, Temp_en, Temp_msf_fcb_ptr, Temp_msf_comp_index,
1777                          Temp_msf_comp_ptr, Temp_msf_comp_bitc, Temp_msf_total_components);
1778                     if Ec ^= 0 then return;
1779 
1780                     Temp_seg_len_in_chars = 0;              /* clear out Temp_seg  to indicate it is now empty. */
1781                                                             /* Is any char left in the Outc after filled up tem_seg? */
1782                     remaining_pos_for_insertion = Outc_len - available_pos_for_insertion;
1783                     if remaining_pos_for_insertion > 0 then do;
1784                                                             /* copy left over canonical characters from the Outc into Temp_seg */
1785                          Temp_seg_len_in_chars = remaining_pos_for_insertion;
1786                          substr (Temp_seg, 1, remaining_pos_for_insertion) = substr (Outc, available_pos_for_insertion + 1, remaining_pos_for_insertion);
1787                     end;
1788                end;                                         /* case of reaching the boundary of Temp_seg */
1789           end;                                              /* end of do while (^Eof_flag) */
1790 
1791           return;                                           /* return from do_canon procedure */
1792 
1793 /* --------------------------------------------------------------------------- */
1794 %page;
1795 output:   proc (p_slew_char);
1796 
1797 /* append a slew character (NL, VT, or FF) to Outc which contains a line    */
1798 /* of canonical (standard) characters.                                      */
1799 
1800 dcl  p_slew_char char (1);                                  /* input parameter */
1801 
1802 /* begin output procedure which is called by do_canon procedure */
1803 
1804                Outc_len, Ox = Ox + 1;                       /* update canonical line length.  Also update output line index */
1805                substr (Outc, Ox, 1) = p_slew_char;          /* append a slew character to a line of canonical character */
1806 
1807                return;                                      /* return to do_canon procedure */
1808 
1809           end output;
1810 
1811 /* -------------------------------------------------------------------------- */
1812 %page;
1813 sort:     proc;
1814 
1815 /* Sort characters in Bead array of record.  Bead contains characters */
1816 /* and corresponding character positions in the current line.  Nch is */
1817 /* the actual upper bound of the array.                               */
1818 
1819 dcl  d fixed bin;
1820 dcl  i fixed bin;
1821 dcl  swaps fixed bin;
1822 dcl  temp bit (36) aligned;
1823 
1824 /* begin sort procedure */
1825 
1826                d = Nch;                                     /* get the actual max array index */
1827 
1828 sort_pass:
1829                swaps = 0;                                   /* prepare to sort characters in alphabetic order */
1830 
1831                d = divide (d + 1, 2, 17, 0);                /* split the entire portion into two equal array portions */
1832 
1833                do i = 1 to Nch - d;                         /* loop through the upper portion */
1834                                                             /* compare each character in the upper portion with each character in the lower portion, respectively */
1835                     if unspec (Bead (i)) > unspec (Bead (i + d)) then do;
1836                          swaps = swaps + 1;
1837                          temp = unspec (Bead (i));
1838                          unspec (Bead (i)) = unspec (Bead (i + d));
1839                          unspec (Bead (i + d)) = temp;
1840                     end;
1841                end;
1842 
1843                if d > 1 then goto sort_pass;                /* continue to split the upper array portion based on upper array portion's update max index */
1844 
1845                if swaps > 0 then goto sort_pass;
1846 
1847                return;                                      /* return to do_canon procedure */
1848 
1849           end sort;
1850 
1851 /* --------------------------------------------------------------------------- */
1852 %page;
1853      end do_canon;
1854 
1855 /* --------------------------------------------------------------------------- */
1856 %page;
1857 get_specified_file_type: proc (p_dn, p_en, p_fs_util_type);
1858 
1859 /* get the entry type of a specified file by calling fs_util_$get_type.      */
1860 /* Only accept canonicalization of either a single Segment file (SSF) or     */
1861 /* a Multisegment_file (MSF).                                                */
1862 
1863 /* parameters */
1864 dcl  (p_dn, p_en) char (*);                                 /* input */
1865 dcl  p_fs_util_type char (32);                              /* in/out */
1866 
1867 /* begin get_specified_file_type procedure */
1868 
1869           Ec = 0;
1870 
1871           call fs_util_$get_type (p_dn, p_en, p_fs_util_type, Ec);
1872           if Ec ^= 0 then do;
1873                call com_err_ (Ec, ME, "^a", pathname_ (p_dn, p_en));
1874                return;
1875           end;
1876 
1877           if p_fs_util_type = FS_OBJECT_TYPE_DIRECTORY then do;
1878                Ec = error_table_$dirseg;
1879                call com_err_ (Ec, ME, "^a", pathname_ (p_dn, p_en));
1880           end;
1881 
1882           if p_fs_util_type = FS_OBJECT_TYPE_DM_FILE then do;
1883                Ec = dm_error_$file_in_use;
1884                call com_err_ (Ec, ME, "^a", pathname_ (p_dn, p_en));
1885           end;
1886 
1887           return;
1888 
1889      end get_specified_file_type;
1890 
1891 /* ------------------------------------------------------------------------ */
1892 %page;
1893 initialization: proc;
1894 
1895 /* initializes all automatic variables.  They are grouped together        */
1896 /* depending on their data types.  For each group, their appearance       */
1897 /* is based on alphabetic order.  This purpose is used to speed up canon. */
1898 
1899 /* begin initialization procedure */
1900 
1901           Access_ptr,
1902                Input_msf_comp_ptr,
1903                Input_msf_fcb_ptr,
1904                Outc_ptr,
1905                Out_seg_ptr,
1906                Second_temp_seg_ptr,
1907                Seg_ptr,
1908                Temp_msf_comp_ptr,
1909                Temp_msf_fcb_ptr,
1910                Temp_ptr,
1911                Temp_seg_ptr = null;
1912 
1913           Bitc,
1914                Ec,
1915                Everytab,
1916                Input_msf_comp_index,
1917                In_msf_comp_bitc,
1918                In_msf_total_original_comps,
1919                In_nstops,
1920                In_stops (*),
1921                Mm,
1922                Nstops,
1923                Specified_infile_type,
1924                Stops (*),
1925                Temp_msf_comp_bitc,
1926                Temp_msf_comp_index,
1927                Temp_msf_total_components,
1928                Temp_seg_len,
1929                Temp_seg_len_in_chars = 0;
1930 
1931           Dn,
1932                En,
1933                Fs_util_type,
1934                Out_dname,
1935                Out_ename,
1936                Temp_dn,
1937                Temp_en = " ";
1938 
1939           Create_temp_msf_flag,
1940                Do_not_create_temp_msf_flag,
1941                Eof_flag,
1942                Have_infile_flag,
1943                Have_outfile_flag,
1944                Overwrite_exist_path_flag,
1945                Nonexistent_outfile_flag,
1946                Specified_temp_file_flag,
1947                Subroutine_call_flag,
1948                Tab_flag = FALSE;
1949 
1950           Desired_access = (36)"0"b;
1951 
1952           In_everytab = 10;                                 /* by default */
1953 
1954           return;
1955 
1956      end initialization;
1957 
1958 /* --------------------------------------------------------------------------- */
1959 %page;
1960 initiate_specified_output_file: proc;
1961 
1962 /* initiate the specified output file path2.  If suceeds initiatation, ask   */
1963 /* for overwritten the specified existent output path2.                      */
1964 
1965 /* begin initiate_specified_output_file procedure */
1966 
1967           Ec = 0;
1968 
1969           call initiate_file_ (Out_dname, Out_ename, RW_ACCESS, Out_seg_ptr, Bitc, Ec);
1970           if Ec ^= 0 then do;
1971                if Ec = error_table_$noentry then do;        /* it's OK for a specified NONEXISTENT output path2.  Will make it exist later on */
1972                                                             /* depending on either case MSF canonicalize MSF or MSF canonicalize SSF */
1973                     Ec = 0;
1974                     Nonexistent_outfile_flag = TRUE;        /* mark that the specified output path2 does not exist. */
1975                end;
1976 
1977                else if Ec = error_table_$no_w_permission then do;
1978                                                             /* do not treat as an error until digging in details */
1979                     Fs_util_type = FS_OBJECT_TYPE_SEGMENT;
1980                     call validate_access (Out_dname, Out_ename, Fs_util_type, RW_ACCESS, Overwrite_exist_path_flag);
1981                     if Ec ^= 0 then return;
1982                     if ^Overwrite_exist_path_flag then return;
1983                                                             /* must reinitiate again to get its pointer value, Out_seg_ptr */
1984                     call initiate_file_ (Out_dname, Out_ename, RW_ACCESS, Out_seg_ptr, Bitc, Ec);
1985                     if Ec ^= 0 then do;
1986                          call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
1987                          return;
1988                     end;
1989                end;
1990 
1991                else if Ec = error_table_$dirseg then do;    /* the specified output path2 EXISTS and its type is either directory or MSF */
1992                                                             /* do not treat as an error until digging in details */
1993                     call get_specified_file_type (Out_dname, Out_ename, Fs_util_type);
1994                     if Ec ^= 0 then return;
1995 
1996                     call validate_access (Out_dname, Out_ename, Fs_util_type, RW_ACCESS, Overwrite_exist_path_flag);
1997                     if Ec ^= 0 then return;
1998                     if ^Overwrite_exist_path_flag then return;
1999                end;                                         /* the specified path2 exists and its type is either directory or MSF */
2000                else do;
2001                     call com_err_ (Ec, ME, "^a", pathname_ (Out_dname, Out_ename));
2002                     return;
2003                end;
2004           end;                                              /* an error occured while initiating the specified output path2 */
2005 
2006           if ^Overwrite_exist_path_flag & ^Nonexistent_outfile_flag then do;
2007                                                             /* assume had no problem when initiated the specified EXISTENT output path2 */
2008                call command_query_$yes_no (Overwrite_exist_path_flag, (0), ME, "", "Do you want to overwrite ^a?", pathname_ (Out_dname, Out_ename));
2009                if ^Overwrite_exist_path_flag then return;
2010 
2011                Fs_util_type = FS_OBJECT_TYPE_SEGMENT;
2012           end;
2013 
2014           return;
2015 
2016      end initiate_specified_output_file;
2017 
2018 /* --------------------------------------------------------------------------- */
2019 %page;
2020 temp_seg_to_temp_msf: proc;
2021 
2022 /* copies the contents of Temp_seg into the next component of the temp MSF.  */
2023 /* This is done by calling the internal procedure named                      */
2024 /* copy_temp_seg_into_msf.  Then calls msf_manager_$adjust to set          */
2025 /* the bit count, truncate, and terminate that component.                    */
2026 
2027 /* begin temp_seg_to_temp_msf procedure */
2028 
2029           if Temp_msf_total_components > 0 then do;         /* prepare to create another component in the temp MSF */
2030                Temp_msf_comp_index = Temp_msf_total_components;
2031                Temp_msf_total_components = Temp_msf_total_components + 1;
2032           end;
2033                                                             /* copy the contents of Temp_seg into a specified component of a temp. MSF */
2034           call copy_temp_seg_into_msf (Temp_dn, Temp_en, Temp_msf_fcb_ptr, Temp_msf_comp_index, Temp_msf_comp_ptr,
2035                Temp_msf_comp_bitc, Temp_msf_total_components);
2036           if Ec ^= 0 then do;                               /* close temp MSF */
2037                call msf_manager_$close (Temp_msf_fcb_ptr);
2038                return;
2039           end;
2040                                                             /* sets the bit count, truncates and terminates the components of the temp. MSF */
2041           call msf_manager_$adjust (Temp_msf_fcb_ptr, Temp_msf_comp_index, Temp_msf_comp_bitc, THREE_BIT_SWITCH, Ec);
2042           if Ec ^= 0 then do;                               /* close temp MSF */
2043                call msf_manager_$close (Temp_msf_fcb_ptr);
2044                call com_err_ (Ec, ME, "Cannot adjust component ^d of MSF ^a", Temp_msf_comp_index, pathname_ (Temp_dn, Temp_en));
2045                return;
2046           end;
2047 
2048           return;
2049 
2050      end temp_seg_to_temp_msf;
2051 
2052 /* --------------------------------------------------------------------------- */
2053 %page;
2054 temp_msf_to_infile_or_outfile: proc (p_dirname, p_enname);
2055 
2056 /* copy each component of a temp MSF into the corresponding component of     */
2057 /* either the input file path1 or a specified output file path2.             */
2058 /* If path2 was specified and does not exist, the call to                    */
2059 /* msf_manager_$msf_get_ptr will create it as a MSF.                         */
2060 
2061 /* input parameters */
2062 dcl  p_dirname char (*);
2063 dcl  p_enname char (*);
2064 
2065 /* begin temp_msf_to_infile_or_outfile procedure */
2066 
2067           Ec = 0;
2068 
2069           on record_quota_overflow begin;
2070                Ec = error_table_$rqover;
2071                call msf_manager_$close (Input_msf_fcb_ptr);
2072                call msf_manager_$close (Temp_msf_fcb_ptr);
2073                revert record_quota_overflow;
2074                goto temp_msf_ERROR_RETURN;
2075           end;
2076 
2077           Temp_seg_len = Temp_seg_len_in_chars;             /* save the current length of Temp_seg */
2078 
2079           Temp_seg_len_in_chars = CHARS_PER_SEGMENT;        /* prepare to copy full components (whose length has reached the max */
2080                                                             /* component length) of a temp MSF */
2081 
2082           do Temp_msf_comp_index = COMPONENT_ZERO to (Temp_msf_total_components - 1);
2083                                                             /* prepare to create a specified component */
2084                Input_msf_comp_index = Temp_msf_comp_index;
2085                                                             /* create a specified component if it does not exist yet */
2086                call msf_manager_$msf_get_ptr (Input_msf_fcb_ptr, Input_msf_comp_index, TRUE, Input_msf_comp_ptr, In_msf_comp_bitc, Ec);
2087 
2088                if Ec ^= 0 then do;
2089                     call msf_manager_$close (Input_msf_fcb_ptr);
2090                     call msf_manager_$close (Temp_msf_fcb_ptr);
2091                     call com_err_ (Ec, ME, "Cannot get component ^d of MSF ^a", Input_msf_comp_index, pathname_ (p_dirname, p_enname));
2092                     return;
2093                end;
2094                                                             /* get a specified component of the temp MSF */
2095                call msf_manager_$msf_get_ptr (Temp_msf_fcb_ptr, Temp_msf_comp_index, FALSE, Temp_msf_comp_ptr, Temp_msf_comp_bitc, Ec);
2096                if Ec ^= 0 then do;
2097                     call com_err_ (Ec, ME, "Cannot get component ^d of MSF ^a.", Input_msf_comp_index, pathname_ (Temp_dn, Temp_en));
2098                     call msf_manager_$close (Input_msf_fcb_ptr);
2099                     call msf_manager_$close (Temp_msf_fcb_ptr);
2100                     return;
2101                end;
2102                                                             /* have the last component of the temp MSF been reached */
2103                if Temp_msf_comp_index = (Temp_msf_total_components - 1) then
2104                                                             /* prepare to copy the last component of the temp MSF */
2105                     Temp_seg_len_in_chars = Temp_seg_len;
2106 
2107 /* copy the contents of each component of temp MSF into the corresponding */
2108 /* component of either input file path1 or a specified output file path2 */
2109                Input_msf_comp_ptr -> Temp_seg = Temp_msf_comp_ptr -> Temp_seg;
2110           end;                                              /* complete copied one by one component */
2111                                                             /* sets bit count, truncates, and terminates the components of that file */
2112           call msf_manager_$adjust (Input_msf_fcb_ptr, Input_msf_comp_index, Temp_msf_comp_bitc, THREE_BIT_SWITCH, Ec);
2113           if Ec ^= 0 then do;
2114                call msf_manager_$close (Input_msf_fcb_ptr);
2115                call msf_manager_$close (Temp_msf_fcb_ptr);
2116                call com_err_ (Ec, ME, "Cannot adjust component ^d of MSF ^a.", Input_msf_comp_index, pathname_ (p_dirname, p_enname));
2117                return;
2118           end;
2119 
2120 temp_msf_ERROR_RETURN:
2121           return;
2122 
2123      end temp_msf_to_infile_or_outfile;
2124 
2125 /* --------------------------------------------------------------------------- */
2126 %page;
2127 %include access_mode_values;
2128 %page;
2129 %include object_info;
2130 %page;
2131 %include system_constants;
2132 %page;
2133 %include terminate_file;
2134 %page;
2135 %include copy_flags;
2136 %page;
2137 %include suffix_info;
2138 
2139      end canonicalize;