1 /* COLUMNS - Program to reformat a segment into columns.  Basically, lines are read from input segment one at a time,
   2    and pointers to the lines and lengths are placed in an array in a temporary segment.  The temporary segment holds
   3    one page's worth of line pointers.  Since tabs in the input segment cannot be just placed into the output
   4    segment, lines containing tabs are expanded (tabs replaced by spaces) and placed into another temporary segment.
   5    Thus the array holding a page may contain either a pointer to a line into the original segment or
   6    a line in the expanded segment.  In certain combinations of control arguments, it is not pssible to
   7    determine or calculate the actual length of the output page (npgn & (mn | full | fold)), so it is not possible
   8    to set up the output page array ahead of time.  In this case, the program goes through some heuristics to
   9    figure out what the minimum possible length of the output page will be, and tries to fit the lines into that.
  10    If they can't all fit, the page length is incremented by one and another try is made.  This is a very crude
  11    brute-force procedure that may take a lot of time if the segment is very long.  Fortunately, there's little use
  12    for specifying npgn with long segments, since pagination will hardly use up any more space.
  13    The undefined page length condition always occurs, regardless of arguments, when the last page of output is
  14    prepared, since the goal of the program is to minimize the vertical length of the last page (except when
  15    full_last_page is specified).  Thus the last page is treated as if npgn were specified (essentially).
  16 
  17    There are a practically unlimited number of combinations of control arguments vs. input segment formats,
  18    and this program tries to make sense out of all of them.  Some of the results can therefore be very wierd.
  19    Hopefully the program documentation is correct as far as it goes, but it doesn't describe in detail the results
  20    of all possible situations.  In such cases, you get what the program gives you, which is probably what you deserve.
  21    Any case of the program's failure to live up to the constraints in the documentation, however, can be considered
  22    a bug that ought to be fixed.
  23 
  24    Note that labels to which nonlocal gotos may transfer are in all CAPS.
  25 */
  26 /*  Modified 6/7/77 to handle indent not a multiple of 10 properly.
  27     Modified 7/7/77 to fix same bug when minimize specified.
  28 */
  29 
  30 columns: col: proc;
  31 
  32 dcl 1 control_args (18) static options (constant),
  33       2 long_name char(16) init ("line_length", "page_length", "indent", "fold", "number_columns", "column_width",
  34                "space", "truncate", "full", "minimize", "full_last_page", "no_pagination", "segment", "adjust", "margin",
  35                "blocks", "top_margin", "bottom_margin"),
  36       2 short_name char(4) init ("ll", "pl", "in", "fd", "nc", "cw", "sp", "tc", "fl", "mn", "flp", "npgn", "sm", "ad", "mg",
  37                "bk", "tmg", "bmg"),
  38       2 value_required bit(1) aligned init ((7)(1)"1"b, (7)(1)"0"b, "1"b, "0"b, "1"b, "1"b),/* set if arg requires value */
  39       2 min fixed bin init (1, 1, 0, 0, 1, 1, 0, (7)*, 0, *, 0, 0),                       /* minimum permissible value */
  40       2 max fixed bin init (136, 0, 135, 135, 136, 136, 135, (7)*, 0, *, 0, 0);           /* maximum permissible value */
  41 dcl value (18) fixed bin init ((7)-1, (7)*, -1, *, -1, -1);                               /* values of numeric arguments */
  42 dcl bit (18) bit(1) aligned init ((7)*, (7)(1)"0"b, *, "0"b, *, *);                       /* values of bit arguments */
  43 
  44 dcl (line_length  defined value(1),                         /* values of user-supplied control args. -1 indicates no value */
  45      page_length  defined value(2),
  46      indent       defined value(3),
  47      fold         defined value(4),
  48      n_columns    defined value(5),
  49      column_width defined value(6),
  50      space        defined value(7),
  51      margin       defined value(15),
  52      top_margin   defined value(17),
  53      bottom_margin defined value(18)) fixed bin;
  54 
  55 dcl (truncate     defined bit(8),                           /* values of user-defined switches, "0"b indicates no value */
  56      full         defined bit(9),
  57      minimize     defined bit(10),
  58      full_last_page     defined bit(11),
  59      npgn         defined bit(12),
  60      segment      defined bit(13),
  61      adjust       defined bit(14),
  62      blocks       defined bit(16)) bit(1) aligned;
  63 
  64 dcl ll fixed bin;                       /* line length of user_output */
  65 dcl real_line_length fixed bin;         /* line length of output, minus any indent. */
  66 dcl top_default_margin fixed bin;
  67 dcl bottom_default_margin fixed bin;
  68 
  69 /* variables that keep track of progress in page or segment */
  70 
  71 dcl max_line_length fixed bin defined   /* At first, maximum line length in segment.             */
  72           saving_info.max_line_length;  /* Later, if minimize|full, longest line in current column less then column_width. */
  73 dcl real_max_line_length fixed bin defined /* Real longest line in column (used only if minimize or full) */
  74           saving_info.real_max_line_length;
  75 dcl line_count fixed bin defined        /* line of column being put into output.  set by find_next_line */
  76           saving_info.line_count;
  77 dcl column_count fixed bin defined      /* column being worked on */
  78           saving_info.column_count;
  79 dcl line_loc fixed bin(21) defined       /* keeps track of where we are in input segment */
  80           saving_info.line_loc;
  81 dcl expanded_loc fixed bin(21) defined  /* keeps track of where we are in expanded segment */
  82           saving_info.expanded_loc;
  83 dcl min_line_length fixed bin defined   /* minimum length of line in current page used to form last page */
  84           saving_info.min_line_length;
  85 dcl input_line_count fixed bin defined  /* counts input lines for error message reporting */
  86           saving_info.input_line_count;
  87 dcl nchars fixed bin defined            /* printing length of current line to be inserted into column.  set by get_line */
  88           saving_info.nchars;
  89 dcl start fixed bin(21) defined         /* starting point of current line in input segment. */
  90           saving_info.start;            /* if <0, this points to location in expanded_seg */
  91 dcl top_of_column bit(1) aligned defined/* set if no line yet inserted into this new column */
  92           saving_info.top_of_column;
  93 dcl last_page_count fixed bin defined   /* line count for last page */
  94           saving_info.last_page_count;
  95 
  96 dcl make_final_pass bit(1) aligned;     /* set if a final pass of column will be necessary */
  97 dcl block_length fixed bin;             /* length of current block if "blocks" specified */
  98 dcl max_block_length fixed bin;         /* longest block in last page */
  99 dcl vertical_tab bit(1) aligned;        /* set when vertical tab in current line is not 1st in column. */
 100 
 101 /* global switches and variables more or less constant */
 102 
 103 dcl error_on_line_too_long bit(1) aligned init("0"b);       /* set when line length > column_width not allowed.
 104                                                                set when the user didn't specify full, truncate, or fold */
 105 dcl undefined_page bit(1) aligned init("0"b);               /* set when we don't know page length (npgn & (mn | fl | fold) */
 106 
 107 dcl seglength fixed bin(21);                                /* length of input segment in characters */
 108 dcl n_lines fixed bin(21) init (-1);                        /* when >= 0, set to number of lines in input segment */
 109 dcl max_line_count fixed bin;                               /* set to max no. permissible lines for npgn */
 110 
 111 /* other switches and variables set temporarily */
 112 
 113 dcl (i, j) fixed bin;
 114 dcl reset bit(1) aligned;               /* set by find_next_line when current block was cleared out of column */
 115 dcl last_page_flag bit(1) aligned;      /* set when last page is being re-done */
 116 dcl last_line_flag bit(1) aligned;      /* set by get_line when asked to get line after last */
 117 dcl last_page_length fixed bin;         /* number of input lines + folds on last page */
 118 dcl original_page_length fixed bin;     /* initial page length specified by user */
 119 dcl out_count fixed bin(21) init(1);    /* position in output segment */
 120 dcl char_count fixed bin(21);
 121 
 122 /* pointers to segments */
 123 
 124 dcl (inptr, outptr) ptr init (null);                        /* input segment, output segment (if any) */
 125 dcl (lines_ptr, last_lines_ptr, expanded_ptr) ptr init(null);         /* temporary segments in process dir */
 126 dcl output_buffer_ptr ptr init(null);                       /* output buffer, when output is to user_output */
 127 dcl page_ptr ptr;                                           /* pointer to the output page buffer */
 128 
 129 /* segments, lines, etc. */
 130 
 131 dcl seg char(seglength) based (inptr);                      /* input segment */
 132 dcl out char(1048575) based (outptr);                       /* output segment */
 133 dcl expanded_seg char(1048575) based (expanded_ptr);        /* segment in which expanded lines containing tabs are stored */
 134 
 135 /* The following structure specifies the contents of one page of output, or all the output if -npgn is specified.
 136   As each page is being formatted, the values of page.vertical_tab, page.start and page.nchars have the following meanings:
 137 
 138           vertical_tab = 1
 139                     means that this line began with a vertical tab character.
 140 
 141           start < 0, nchars < 0
 142                     -start = index of line in expanded_seg
 143                     -nchars = number of chars of line in expanded_seg to use, plus fold
 144 
 145           start < 0, nchars >^H_ 0
 146                     -start = index of line in expanded_seg
 147                     nchars = number of chars of line to use
 148 
 149           start = 0, nchars = 0
 150                     this position should be filled with spaces
 151 
 152           start = 0, nchars > 0
 153                     If full&minimize, nchars is number of chars of line that began in a previous column that
 154                     have to be carried over to this column, plus number of chars of this line
 155                     that were used in immediately preceding column.  We don't know the width of the current
 156                     column until all lines in column are processed.  After current column is processed,
 157                     this value is decreased by number of chars of line that were used
 158                     in previous column.   By the time the page is ready for output, nchars will have been set to -1.
 159 
 160           start = 0, nchars = -1
 161                     Put nothing in this column at all.  Any characters in this column were already
 162                     specified in nchars of previous column.  For printing, same as nchars=0 above.
 163                     During page formation it acts as a signal that an overflowed "full" line from a previous
 164                     column occupies this space.
 165 
 166           start > 0, nchars > 0
 167                     start = position of line in original seg
 168                     nchars = number of chars of line
 169 
 170           start > 0, nchars < 0
 171                     start = position of line in original seg
 172                     -nchars = number of chars of line plus fold
 173                                         */
 174 
 175 dcl 1 page (n_columns, page_length) based (page_ptr),       /* current page (output page buffer) */
 176      2 vertical_tab fixed bin(1),
 177      2 start fixed bin(21),
 178      2 nchars fixed bin;
 179 
 180 dcl 1 lines (n_columns, page_length) based (lines_ptr) like page;     /* for all but last page, this is output buffer */
 181 
 182 dcl 1 dummy_page(1) like page based;    /* used so that size(dummy_page) yields size of one element of page */
 183 
 184 dcl 1 last_page (last_page_length) based (lines_ptr) like page;       /* 1-dimensional overlay when we're on last page */
 185 
 186 dcl column_position(136) fixed bin      /* starting position of each column, minus indent.  If minimize, we don't know how */
 187                init (1, (135)*);        /* many columns or their column positions,  column_position(column_count+1) is
 188                                            initialized at each new column. If not minimize,
 189                                            this is initialized at beginning of program. */
 190 dcl previous_tab(136) fixed bin;        /* position of tab stop immediately preceeding column */
 191 dcl spaces_from_tab(136) fixed bin;     /* spaces away from previous tab stop for each column */
 192 
 193 dcl output_buffer char(1000) aligned based (output_buffer_ptr);       /* output line is assembled here if ^segment */
 194 dcl area area based (get_system_free_area_());                        /* area in which to allocate output_buffer */
 195 dcl indent_field char(18)varying;                           /* indent prefix for each line (tabs+spaces) */
 196 dcl out_line_ptr ptr;                                                 /* pointer to real output line after indent */
 197                                                             /* permanently set if ^segment to location in output_buffer */
 198 dcl 1 saving_info,                      /* variables to be saved when vertical_tab is encountered */
 199       2 line_count fixed bin,                     /* line no. of last line put into page */
 200       2 column_count fixed bin,                   /* column no. of last line put into page */
 201       2 line_loc fixed bin(21),                   /* input segment loc of line with VT */
 202       2 min_line_length fixed bin,
 203       2 max_line_length fixed bin,
 204       2 real_max_line_length fixed bin,
 205       2 input_line_count fixed bin,               /* input segment line count of line with VT */
 206       2 expanded_loc fixed bin(21),
 207       2 start fixed bin(21),
 208       2 last_page_count fixed bin,
 209       2 top_of_column bit(1) aligned,
 210       2 nchars fixed bin;
 211 dcl 1 saved_info like saving_info; /* saved values of above variables */
 212 
 213 /* Static constants */
 214 
 215 dcl (NL char(1) init("
 216 "),
 217      BS char(1) init ("^H"),
 218      BS_HT char(2) init ("^H  "),
 219      tab char(1) init ("      "),
 220      NL_HT_BS char(3) init ("
 221 ^H        "),
 222      VT char(1) init ("^K"),
 223      NP char(1) init ("^L") ) aligned static options(constant);
 224 
 225 /* System subroutines and variables */
 226 
 227 dcl com_err_ entry options (variable);
 228 dcl cu_$arg_count entry (fixed bin);
 229 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin(35));
 230 dcl expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin(35));
 231 dcl get_line_length_$switch entry (ptr, fixed bin(35)) returns (fixed bin);
 232 dcl get_system_free_area_ entry returns (ptr);
 233 dcl get_wdir_ entry returns (char(168) aligned);
 234 dcl hcs_$delentry_seg entry (ptr, fixed bin(35));
 235 dcl hcs_$initiate_count entry (char(*), char(*), char(*), fixed bin(24),
 236           fixed bin(2), ptr, fixed bin(35));
 237 dcl hcs_$make_seg entry (char(*), char(*), char(*), fixed bin(5), ptr, fixed bin(35));
 238 dcl hcs_$set_bc_seg entry (ptr, fixed bin(24), fixed bin(35));
 239 dcl hcs_$terminate_noname entry (ptr, fixed bin(35));
 240 dcl hcs_$truncate_seg entry (ptr, fixed bin, fixed bin(35));
 241 dcl ioa_$ioa_switch_nnl entry options (variable);
 242 dcl iox_$put_chars entry (ptr, ptr, fixed bin(21), fixed bin(35));
 243 dcl arg char(arglen) based(argptr);
 244 dcl dirname char(168) aligned;
 245 dcl ename char(32) aligned init ("");
 246 dcl arglen fixed bin;
 247 dcl argno fixed bin;
 248 dcl argptr ptr;
 249 dcl nargs fixed bin;
 250 dcl code fixed bin(35);
 251 dcl bc fixed bin(24);
 252 dcl null builtin;
 253 dcl max builtin;
 254 dcl min builtin;
 255 dcl cleanup condition;
 256 dcl conversion condition;
 257 dcl size condition;
 258 dcl error_table_$badopt external fixed bin(35);
 259 dcl error_table_$entlong external fixed bin(35);
 260 dcl error_table_$inconsistent external fixed bin(35);
 261 dcl error_table_$noarg external fixed bin(35);
 262 dcl error_table_$sameseg external fixed bin(35);
 263 dcl error_table_$zero_length_seg external fixed bin(35);
 264 dcl iox_$user_output external ptr;
 265 dcl iox_$error_output external ptr;
 266 dcl sys_info$max_seg_size fixed bin(18) external;
 267 dcl numeric_arg char(numeric_arglen) based (numeric_argptr);
 268 dcl numeric_argptr ptr;
 269 dcl numeric_arglen fixed bin;
 270 
 271 /*^L*/
 272 goto start_program;           /* debug */
 273 debug_on:entry;
 274  dcl debug bit(1) aligned static init("0"b);
 275  dcl (ioa_,ioa_$nnl) entry options(variable);     /*debug*/
 276  debug="1"b;
 277  return;  /*debug*/
 278 debug_off:entry;
 279  debug="0"b;
 280  return;  /*debug*/
 281 start_program:      /*debug*/
 282 
 283 /* START OF PROGRAM */
 284 
 285 ll = get_line_length_$switch (null, code);
 286 
 287 call cu_$arg_count (nargs);
 288 if nargs = 0 then do;
 289           call com_err_ (error_table_$noarg, "columns", "Usage is: columns path -args-, where args are");
 290           call ioa_$ioa_switch_nnl (iox_$error_output, "  ");
 291           nchars = 3;
 292           do i = 1 to hbound (control_args, 1);
 293                j = 17-verify(reverse(control_args(i).long_name), " ")
 294                  + 5 - verify(reverse(control_args(i).short_name), " ") + 4; /* length of this message */
 295                if control_args(i).value_required then j = j + 4;
 296                if nchars + j > ll - 10 then do;
 297                     call ioa_$ioa_switch_nnl (iox_$error_output, ",^/  ");
 298                     nchars = 3;
 299                     end;
 300                call ioa_$ioa_switch_nnl (iox_$error_output, "^v(, ^)^a^v( _^Hn^) (^a^v( _^Hn^))", bin(nchars^=3,1),
 301                     control_args(i).long_name, bin(control_args(i).value_required),
 302                     control_args(i).short_name, bin(control_args(i).value_required,1));
 303                nchars = nchars + j;
 304           end;
 305           call ioa_$ioa_switch_nnl (iox_$error_output, "^/");
 306 return:   return;
 307           end;
 308 
 309 on size goto ill_num;
 310 on conversion goto ill_num;
 311 
 312 /* process arguments now */
 313 
 314 do argno = 1 to nargs;
 315      call cu_$arg_ptr (argno, argptr, arglen, code);        /* get argument */
 316      if arglen ^= 0 then
 317           if substr (arg, 1, 1) = "-" & arglen > 1 then do;
 318                do i = 1 to hbound (control_args, 1);        /* if it begins with a "-", see which control_arg it is */
 319                     if substr (arg, 2) = control_args(i).long_name | substr (arg, 2) = control_args(i).short_name then
 320                          if control_args(i).value_required then do;
 321                               argno = argno + 1;
 322                               call cu_$arg_ptr (argno, numeric_argptr, numeric_arglen, code); /* value must follow arg */
 323                               if code ^= 0 then do;
 324                                    call com_err_ (code, "columns", "Value of ^a.", arg);
 325                                    return;
 326                                    end;
 327                               if value(i) ^= -1 then do;
 328 inconsistent:                      call com_err_ (error_table_$inconsistent, "columns", "Control argument ^a specified twice.", arg);
 329                                    return;
 330                                    end;
 331                               value(i) = bin (numeric_arg, 17, 0);
 332                               if value(i) < control_args(i).min |
 333                                  (control_args(i).max ^= 0 & value(i) > control_args(i).max) then do;
 334                                    call com_err_ (0, "columns",
 335                                         "The value ^a is outside the permissible range ^d<^H_^a^v(<^H_^d^).",
 336                                          numeric_arg,
 337                                         control_args(i).min, substr(arg,2), bin(control_args(i).max^=0,1),
 338                                         control_args(i).max);
 339                                    return;
 340                                    end;
 341                               goto next_arg;
 342                               end;
 343                          else do;      /* this argument is a binary switch, no value specified */
 344                               if bit(i) then goto inconsistent;
 345                               bit(i) = "1"b;
 346                               goto next_arg;
 347                               end;
 348                end;
 349                if i > hbound (control_args, 1) then do;     /* control argument not found */
 350 badopt:             code = error_table_$badopt;
 351 argerr:             call com_err_ (code, "columns", arg);
 352                     return;
 353                     end;
 354                end;
 355           else do; /* control argument did not begin with "-" or was only 1 char long */
 356                if substr (arg, 1, 1) = "-" then goto badopt;
 357                if ename ^= "" then do;
 358                     call com_err_ (0, "columns", "Segment name already specified.  What's ""^a""?", arg);
 359                     return;
 360                     end;
 361                call expand_path_ (argptr, arglen, addr(dirname), addr(ename), code);
 362                if code ^= 0 then goto argerr;
 363                end;
 364 next_arg:
 365 end;
 366 
 367 
 368 revert conversion;
 369 revert size;
 370 
 371 if ename = "" then do;
 372      call com_err_ (error_table_$noarg, "columns", "Pathname of segment.");
 373      return;
 374      end;
 375 
 376 on cleanup call cleaner;
 377 
 378 call hcs_$initiate_count ((dirname), (ename), "", bc, 0, inptr, code);
 379 if inptr = null then do;
 380 segerr:
 381      call com_err_ (code, "columns", "^a>^a", dirname, ename);
 382      goto clean;
 383      end;
 384 seglength = divide (bc, 9, 21, 0);
 385 if seglength = 0 then do;
 386      code = error_table_$zero_length_seg;
 387      goto segerr;
 388      end;
 389 
 390 if segment then do; /* make output segment if -segment was specified */
 391      i = index (ename, " ");
 392      if i = 0 | i > 29 then do;
 393           call com_err_ (error_table_$entlong, "columns", "^a.col", ename);
 394           goto clean;
 395           end;
 396      substr (ename, i, 4) = ".col";
 397      call hcs_$make_seg (get_wdir_(), (ename), "", 1010b, outptr, code);
 398      if outptr = null then do;
 399 outerr:   call com_err_ (code, "columns", "^a>^a", get_wdir_(), ename);
 400           goto clean;
 401           end;
 402      if outptr = inptr then do;
 403           code = error_table_$sameseg;
 404           goto outerr;
 405           end;
 406      end;
 407 
 408 /* make consistency tests */
 409 
 410 if (minimize & n_columns ^= -1) |
 411    (full & column_width = -1 & n_columns = -1) |
 412    (minimize & adjust) |
 413    (fold ^= -1 & (truncate | full)) |
 414    (truncate & full) |
 415    ((blocks | full_last_page) & npgn) |
 416    (margin ^= -1 & (top_margin ^= -1 | bottom_margin ^= -1)) |
 417    (page_length ^= -1 & npgn) then do;
 418           call com_err_ (error_table_$inconsistent, "columns");
 419           goto clean;
 420           end;
 421 
 422 /* establish defaults for arguments not specified */
 423 
 424 if line_length = -1 then
 425      if segment then line_length = 136;
 426                 else line_length = ll;
 427 
 428 if indent = -1 then indent = 0;
 429 
 430 real_line_length = line_length - indent;
 431 
 432 if real_line_length < 1 then do;
 433      call com_err_ (error_table_$inconsistent, "columns", "Indent not less than line length.");
 434      goto clean;
 435      end;
 436 
 437 if space = -1 then space = 1;
 438 
 439 expanded_loc = 0;
 440 input_line_count = 0;
 441 
 442 /* If minimize is specified, we have no idea of the column widths or number of columns.  We also don't know
 443    the number of lines in a column (page length) if npgn is specified. */
 444 
 445 if minimize then do;
 446      n_columns = 1;           /* Assume only one column at first.  This is increased as we find we have more room on page */
 447      if npgn then undefined_page = "1"b;     /* no_pagination means we don't know how long the first (and only) page is */
 448      if column_width = -1
 449      then column_width = real_line_length;                  /* if not specified, max column width is whole line */
 450      else if column_width > real_line_length then do;       /* if specified, must be less than line length */
 451           call com_err_ (0, "columns", "column_width is greater than line_length minus indent.");
 452           goto clean;
 453           end;
 454      if ^full & fold = -1 & ^truncate then error_on_line_too_long = "1"b;
 455      end;
 456 
 457 /* If minimize is not specified, the number of columns and their widths can be determined ahead of time, since
 458    it will be the same for every page. */
 459 
 460 else do;
 461      if n_columns = -1 then
 462           if column_width = -1 then do; /* if the user specified no column_width or n_columns, we have */
 463                char_count = 1;          /* to determine this from maximum line length in segment */
 464                n_lines= 0;
 465                nchars = 0;
 466                max_line_length = 0;
 467                do while (char_count <= seglength);
 468                     if substr(seg,char_count,1) = VT | substr(seg,char_count,1) = NP then char_count = char_count + 1;
 469                     i = search (substr (seg, char_count), NL_HT_BS); /* search for one of these 3 chars */
 470                     if i = 0 then do;                                             /* end of segment reached */
 471                          n_lines = n_lines + 1;                                   /* count one more line */
 472                          i = seglength - char_count + 1;
 473                          max_line_length = max (max_line_length, nchars + i);
 474                          if max_line_length > real_line_length then goto line_too_long;
 475                          end;
 476                     else if substr (seg, char_count+i-1, 1) = NL then do;                 /* newline found */
 477                               n_lines = n_lines + 1;
 478                               max_line_length = max (max_line_length, nchars + i - 1);
 479                               if max_line_length > real_line_length
 480                               then if fold = -1 & ^truncate then do;
 481 line_too_long:                     input_line_count = n_lines;
 482                                    goto line_longer_than_page_width;
 483                                    end;
 484                               else max_line_length = real_line_length;
 485                               nchars = 0;
 486                               end;
 487                          else if substr (seg, char_count+i-1, 1) = tab
 488                               then nchars = 10 * divide (nchars + i + 9, 10, 17, 0);      /* tab found */
 489                               else nchars = nchars + i - 2;                               /* backspace found */
 490                     char_count = char_count + i;
 491                end;
 492                if max_line_length = 0 then max_line_length = 1;
 493                n_columns = (real_line_length + space)/(max_line_length + space);
 494                column_width = max_line_length;
 495                end;
 496           else do; /* The column_width was specified.  We don't have to search segment but we need to calculate n_columns. */
 497                n_columns = (real_line_length + space)/(column_width + space);
 498                if n_columns = 0 then do;                    /* not enough room for even one column */
 499                     call com_err_ (0, "columns", "column_width specified is greater than line_length minus indent");
 500                     goto clean;
 501                     end;
 502                end;
 503      else if column_width = -1 then do;                     /* number_columns specified, but not column_width */
 504                column_width = (real_line_length + space)/n_columns - space;
 505                if column_width <= 0 then do;
 506                     call com_err_ (0, "columns", "The number of columns + space specified will not fit on the line length.");
 507                     goto clean;
 508                     end;
 509                end;
 510           else do;                                     /* n_columns specified and column_width specified. See if all fits. */
 511                if n_columns*(column_width + space) > (real_line_length + space) then do;
 512                     call com_err_ (0, "columns",
 513                          "The values of n_columns, column_width and space are inconsistent with line_length and indent.");
 514                     goto clean;
 515                     end;
 516                end;
 517      if adjust then                               /* if adjust specified, increase space between columns if possible */
 518           space = space + (real_line_length - (n_columns*(column_width + space) - space))/(n_columns - 1);
 519      if ^truncate & ^full & fold = -1             /* if the user didn't specify what to do with lines too long, */
 520           then error_on_line_too_long = "1"b;     /* all lines must fit into defined column_width */
 521      do i = 2 to n_columns;                       /* if ^minimize, we know starting positions of each column */
 522           column_position(i) = column_position(i-1) + column_width + space;
 523           previous_tab(i) = divide (column_position(i)+indent-1, 10, 17, 0)*10 + 1;       /* loc of preceeding tab stop */
 524           spaces_from_tab(i) = column_position(i) + indent - previous_tab(i);             /* spaces after that tab stop */
 525      end;
 526      column_position(i) = real_line_length + 1;   /* make n_columns'th + 1 column past end of page */
 527      max_line_length = column_width;
 528      if npgn
 529      then if full | fold ^= -1 then undefined_page = "1"b;
 530           else do;                                /* if npgn & ^full specified, determine page_length from number of lines */
 531             if n_lines < 0 then do;               /* count number of lines if we don't know it yet */
 532                char_count = 1;
 533                do n_lines = 0 by 1 while (char_count <= seglength);
 534                     i = index (substr (seg, char_count), NL);         /* count newlines */
 535                     if i = 0 then i = seglength - char_count + 1;
 536                     char_count = char_count + i;
 537                end;
 538                end;
 539             page_length = ceil (n_lines/n_columns);
 540             end;
 541      end;
 542 
 543 if fold >= column_width then do;
 544      call com_err_ (error_table_$inconsistent, "columns", "Fold not less than column width.");
 545      goto clean;
 546      end;
 547 
 548 top_default_margin, bottom_default_margin = 3;
 549 if npgn then do;
 550      bottom_default_margin = 0;
 551      if ^segment then top_default_margin = 0;
 552      end;
 553 if margin ^= -1
 554 then top_margin, bottom_margin = margin;
 555 else do;
 556      if top_margin = -1 then top_margin = top_default_margin;
 557      if bottom_margin = -1 then bottom_margin = bottom_default_margin;
 558      end;
 559 if segment then
 560      if top_margin < 3 then do;
 561           call com_err_ (0, "columns", "Top margin may not be less than 3 for segment output.");
 562           goto clean;
 563           end;
 564      else top_margin = top_margin - 3;
 565 
 566 if ^segment then do;                              /* if output is to user_output, set up an output buffer */
 567      allocate output_buffer in(area) set (output_buffer_ptr);
 568      out_line_ptr = output_buffer_ptr;
 569      end;
 570 
 571 if indent ^= 0 then do;                                               /* if indent specified, set up indent string */
 572      indent_field = copy (tab, divide (indent,10,17,0));              /* indent string consists of tabs */
 573      indent_field = indent_field || copy (" ", mod(indent,10));       /* plus spaces */
 574      if ^segment then do;               /* if terminal output, put indent string permanently in output buffer */
 575           substr (output_buffer, 1, length(indent_field)) = indent_field;
 576           out_line_ptr = addr (substr (output_buffer, length(indent_field)+1)); /* adjust starting point of output line */
 577           end;
 578      end;
 579 else indent_field = "";
 580 
 581 begin;    /* The stupid compiler thinks size is a condition, which it is--sometimes */
 582      dcl size builtin;
 583      if page_length ^= -1 then if size(page) > sys_info$max_seg_size then goto too_big;
 584 end;
 585 
 586 if page_length = -1 & ^npgn then page_length = 60;
 587 
 588 call create_temp_seg (lines_ptr);       /* create temporary segment containing page buffer */
 589 
 590 original_page_length = page_length;
 591 
 592 begin;
 593      dcl size builtin;
 594      if undefined_page then max_line_count = sys_info$max_seg_size / size(dummy_page);
 595 end;
 596 
 597 page_ptr = lines_ptr;                   /* above page buffer is used for all pages */
 598 last_page_flag = "0"b;                  /* we're not on last page */
 599 line_loc = 1;
 600 
 601 if debug then do;
 602  do i = 1 to hbound(control_args,1);                                            /*debug*/
 603   if value_required(i) then call ioa_$nnl ("^a=^d,",short_name(i),value(i));    /*debug*/
 604  end;                                                                           /*debug*/
 605  call ioa_("^/* input_line_count vertical_tab start, nchars (column_no, line_no):");      /*debug*/
 606 end;                                                                            /*debug*/
 607 
 608 call make_pages;              /* Now make every page */
 609 /*^L*/
 610 /* When input segment is exhausted, a nonlocal goto from find_next_line brings us here.  We have a partially completed page
 611    in page buffer.  This page, being the last page, must be reformatted so that its vertical length is minimized.
 612    To accomplish this, we calculate the minimum possible length of the last page based on the number
 613    input lines it contains, the column widths, and block lengths.  Then we try to make the page as before, except
 614    this time, if there is no room on the page to fit all the lines, we increase the page length by 1 and try again,
 615    rather than start a new page.  At most we'll have to try original_page_length - min_page_length times.
 616    We can make the best estimate of the page length when minimize is not specified, since in that case we
 617    already know the column widths.  However, there is still the difficulty of obtaining the exact
 618    number when "full" is specified. */
 619 
 620 END_OF_INPUT_SEGMENT:
 621 
 622 if full_last_page then goto END_OF_LAST_PAGE;
 623 if ^minimize & column_count = n_columns & line_count = page_length then goto END_OF_LAST_PAGE; /* last page just finished */
 624 
 625 last_page_length = (column_count-1)*page_length + line_count; /* input lines + folds on last page */
 626 block_length, max_block_length = 0;
 627 
 628 if minimize then do; /* if minimize specified, minimum number of lines on page is based on shortest line length */
 629      min_line_length = real_line_length;          /* first find shortest line on this page */
 630      do i = 1 to last_page_length;
 631           if last_page(i).start ^= 0 then do;     /* also look for longest block if "blocks" specified */
 632                if blocks then if last_page(i).vertical_tab = 1 then do;
 633                     if block_length <= original_page_length then max_block_length = max (max_block_length, block_length);
 634                     block_length = 1;
 635                     end;
 636                else block_length = block_length + 1;
 637           if last_page(i).nchars > 0
 638                then min_line_length = min(min_line_length, last_page(i).nchars);
 639                end;
 640      end;
 641 
 642      /* if "minimize" is specified, start with the minimum page length equal to the number of lines required
 643         to contain all the input lines assuming each line was as short as the shortest line. */
 644 
 645      page_length = ceil (last_page_length/divide (real_line_length+space, min_line_length+space, 17, 0));
 646      end;
 647 
 648 else do;  /* if "minimize" not specified, we can come close to determining the exact number of slots required */
 649      line_count = 0;
 650      if undefined_page
 651      then j = last_page_length;
 652      else j = page_length * n_columns;
 653      do i = 1 to j; /* count number of "slots" required for last page */
 654           if last_page(i).start ^= 0 then do; /* also count longest block */
 655                if blocks then if last_page(i).vertical_tab = 1 then do;
 656                     if block_length <= original_page_length then max_block_length = max (max_block_length, block_length);
 657                     block_length = 1;
 658                     end;
 659                else block_length = block_length + 1;
 660                line_count = line_count + 1;
 661                end;
 662           else if last_page(i).nchars ^= 0
 663                then line_count = line_count + 1;
 664      end;
 665      page_length = ceil (line_count/n_columns);
 666      end;
 667 
 668 /* Ready to reformat the last page, based on the estimated page_length */
 669 
 670 if blocks then page_length = max (page_length, max_block_length, block_length); /* page cannot be smaller than max block */
 671 if undefined_page then original_page_length = last_page_length;
 672 call create_temp_seg (last_lines_ptr);
 673 undefined_page = "0"b;
 674 page_ptr = last_lines_ptr;    /* switch to another output buffer */
 675 
 676 /* In the process of making the last page, we don't need to go back to the original input segment to find the
 677    lines, since most of the work was already done and the lines are sitting in the old output buffer.
 678    The last_page flag is used to tell get_line (and make_pages) that the lines can be obtained from the old buffer */
 679 
 680 last_page_flag = "1"b;
 681 if debug then call ioa_ ("last_page_length=^d,initial page_length=^d", last_page_length,page_length);
 682 
 683 do page_length = page_length by 1 to original_page_length;
 684      last_page_count = 0;
 685      call make_pages;
 686 NOT_ENOUGH_ROOM_ON_LAST_PAGE: /* come here when all lines couldn't be used up */
 687      if debug then call ioa_ ("Page length ^d didn't work.", page_length);
 688 end;
 689 
 690 /* If we got here, it means that it took more than original_page_length lines to fit the last page.
 691    This should be impossible, since by virtue of having reached the label "END_OF_INPUT_SEGMENT" above,
 692    we've already decided that original_page_length is big enough.
 693    This error might occur if the representation of lines in the output buffer was incorrect or read improperly by get_line.
 694 */
 695 call ioa_ ("Software error 1.  Please notify maintenance personnel."); /* debug */
 696 return;   /*debug*/
 697 
 698 /* We come here when last page fits */
 699 
 700 END_OF_LAST_PAGE:
 701      call output_page (column_count);   /* output the last page */
 702      if segment then do;
 703           call hcs_$set_bc_seg (outptr, (out_count - 1)*9, code);     /* set output segment bitcount */
 704           call hcs_$truncate_seg (outptr, divide (out_count + 2, 4, 17), code); /* truncate output segment */
 705           end;
 706 clean:
 707      call cleaner;
 708      return;
 709 
 710 /* ERROR RETURNS */
 711 
 712 non_canonical: call com_err_ (0, "columns", "Line ^d in input segment has consecutive backspaces.", input_line_count);
 713                call cleaner;
 714                return;
 715 
 716 too_big:       call com_err_ (0, "columns", "The output page is too large.  Decrease page_length.");
 717                call cleaner;
 718                return;
 719 
 720 abort_line_too_long:
 721                call com_err_ (0, "columns", "Line ^d in input segment is longer than column_width of ^d.",
 722                                         input_line_count, column_width);
 723                call cleaner;
 724                return;
 725 
 726 line_longer_than_page_width:
 727                call com_err_ (0, "columns", "Line ^d in segment is longer than line_length of ^d.",
 728                     input_line_count, real_line_length);
 729                call cleaner;
 730                return;
 731 
 732 ill_num:       call com_err_ (0, "columns", "Illegal numeric value of ^a. ^a", arg, numeric_arg);
 733                return;
 734 /*^L*/
 735 /* *********** GET_LINE ************* */
 736 
 737 /* Procedure to get the next input line from the input segment.
 738    If the line has no tabs, the values of the global variables "start" and "nchars" are set to the
 739    starting location in the input segment, and the number of printing positions occupied by the current line.
 740    If the line has tabs, the tabs are expanded into spaces and the expanded line is appended to the
 741    temporary segment "expanded_seg".  The value of start, in this case, is the position of the line in the
 742    expanded segment, and it is set negative to indicate that. */
 743 
 744 get_line: proc;
 745 
 746 dcl bs_flag bit(1) aligned;
 747 dcl expand bit(1) aligned;
 748 dcl line char(line_end) based (line_ptr);         /* line currently being worked on */
 749 dcl line_ptr ptr;
 750 dcl line_end fixed bin;
 751 dcl (i, j) fixed bin;
 752 dcl char_loc fixed bin;
 753 dcl bit builtin;
 754 
 755 
 756 if last_page_flag then do;    /* if we're on last page, just get line from old output buffer */
 757      do last_page_count = last_page_count+1 by 1 to last_page_length while (last_page(last_page_count).start = 0);
 758      end;
 759      if last_page_count > last_page_length then do;     /* done with last page */
 760           last_line_flag = "1"b;
 761           return;
 762           end;
 763      nchars = last_page(last_page_count).nchars;
 764      start = last_page(last_page_count).start;
 765      vertical_tab = bit(last_page(last_page_count).vertical_tab);
 766      end;
 767 
 768 else do;  /* not on last page, get from input segment */
 769      input_line_count = input_line_count + 1;
 770      if substr (seg, line_loc, 1) = NP then line_loc = line_loc + 1;
 771      if line_loc > seglength then do; /* nonlocal goto at end of input */
 772           last_line_flag = "1"b;
 773           return;
 774           end;
 775      start = line_loc;
 776      line_end = index (substr (seg, line_loc), NL); /* search for end of line */
 777      if line_end = 0 then line_end = seglength - line_loc + 1;
 778                      else line_end = line_end - 1;
 779 
 780      /* line_end now is the number of actual chars in line, not counting newline */
 781 
 782      line_ptr = addr (substr (seg, line_loc));
 783      vertical_tab = substr (line, 1, 1) = VT;
 784      if vertical_tab then do;
 785           start = start + 1;
 786           line_end = line_end - 1;
 787           if npgn then vertical_tab = "0"b;       /* ignore vertical tabs for npgn option */
 788           end;
 789      line_loc = start + line_end + 1;
 790      i = search (line, BS_HT);                    /* search for a tab or backspace in line */
 791      if i = 0 then do;                            /* if neither, this is a simple case */
 792           nchars = line_end;
 793           end;
 794      else do;
 795           i = search (line, tab);                 /* search for a tab */
 796           if i ^= 0 then do;                      /* the line had a tab, expand it */
 797                if expanded_loc = 0 then do;       /* create expanded seg if not already exists */
 798                     call create_temp_seg (expanded_ptr);
 799                     expanded_loc = 1;
 800                     end;
 801                     start = -expanded_loc;        /* make start negative to indicate expanded seg */
 802                expand = "1"b;
 803                end;
 804           else expand = "0"b;
 805 
 806           nchars = 0;
 807           char_loc = 1;
 808           bs_flag = "0"b;
 809 
 810           do while (char_loc <= line_end);        /* determine number of printing positions in line */
 811                i = search (substr (line, char_loc), BS_HT); /* find tab or backspace */
 812                if i ^= 0 then
 813                     if substr (line, char_loc + i - 1, 1) = BS then if bs_flag & i=1
 814                                                                            then goto non_canonical; /* two backspaces */
 815                                                                            else bs_flag = "1"b;
 816                                                                       else bs_flag = "0"b;
 817                if expand then do;            /* if we have to expand, put all characters of current line up to the tab or */
 818                     if i = 0                 /* backspace (but not including the tab) into expanded_seg */
 819                     then j = line_end - char_loc + 1;
 820                     else if bs_flag
 821                          then j = i;
 822                          else j = i - 1;
 823                     substr (expanded_seg, expanded_loc, j) = substr (line, char_loc, j);
 824                     expanded_loc = expanded_loc + j;
 825                     end;
 826                if i = 0 then do;
 827                     nchars = nchars + line_end - char_loc + 1;
 828                     char_loc = line_end + 1;
 829                     end;
 830                else do;
 831                     nchars = nchars + i - 1;                               /* add number of chars up to backspace or tab */
 832                     char_loc = char_loc + i;
 833                     if bs_flag
 834                     then nchars = nchars - 1;                              /* subtract for backspace */
 835                     else do;
 836                          j = 10 - mod (nchars, 10);                        /* we've got a tab */
 837                          nchars = nchars + j;
 838                          substr (expanded_seg, expanded_loc, j) = "";      /* replace with spaces */
 839                          expanded_loc = expanded_loc + j;
 840                          end;
 841                     end;
 842                end; /* end of loop determining number of positions on line */
 843           end; /* end of else clause */
 844      end;
 845 
 846 if nchars > column_width then if error_on_line_too_long then goto abort_line_too_long; /* nonlocal error return */
 847 
 848 if vertical_tab then do;
 849      saved_info = saving_info;
 850      block_length = 1;
 851      end;
 852 else if blocks then block_length = block_length + 1;
 853 
 854 end; /* end of get_line */
 855 
 856 /*^L*/
 857 /* *********** MAKE_PAGES ************ */
 858 
 859 /* This subroutine makes pages of output.  It calls get_line to set nchars and start.
 860    and to get lines from the input buffer, and put_line to
 861    put lines into the output buffer, until get_line by itself does a nonlocal goto back to the main program.
 862    It is the job of this subroutine to figure out how many characters of each line obtained from get_line are to
 863    be placed in the output buffer by put_line.  When the last_page flag is set, this subroutine returns to its
 864    caller if it has to start a new page.  That's because we don't want to output the last page unless every remaining line
 865    fits.
 866 */
 867 
 868 make_pages: proc;
 869 
 870 dcl increment fixed bin;
 871 dcl line char(increment+1) based (line_ptr);
 872 dcl line_ptr ptr;                                           /* points to current line  */
 873 dcl real_nchars fixed bin;
 874 
 875 column_count = 0; /* This causes find_next_line to initialize page */
 876 
 877 /* If "full" is specified, we insert lines in the current column one at a time.  A line that must extend into subsequent
 878    column gets special treatment depending on whether we're trying to minimize. */
 879 
 880 if full then do while ("1"b);
 881      call get_line;                     /* get next line from input segment */
 882      call find_next_line;               /* get next free space in current page */
 883      if nchars > real_line_length then goto line_longer_than_page_width;
 884      call put_line (column_count, line_count, start, nchars); /* specify that whole line goes in current column */
 885      real_max_line_length = max (real_max_line_length, nchars);
 886      if nchars <= column_width
 887      then max_line_length = max (max_line_length, nchars); /* update if line does not overflow */
 888      if ^undefined_page then
 889           if column_width < nchars /* does this line extend past end of column? */
 890           then if minimize then do; /* If we're minimizing, we don't know the width of the current column yet. */
 891                     page(column_count+1, line_count).nchars = nchars + 1; /* put value of nchars into this line of */
 892                     make_final_pass = "1"b;                 /* next column (plus one for at least one space after it) */
 893                     end;  /* When we get to end of this column, find_next_line will modify this nchars by the number
 894                               of chars in this column (+space), thereby indicating the number of chars remaining
 895                               from this line that will overflow into other columns. */
 896                else do; /* If we're not minimizing, we know the lengths of each column so we can mark this line position */
 897                     i = 1;    /* in subsequent columns as occupied. */
 898                     do nchars = nchars-(column_width+space) by -(column_width+space) to 0;
 899                          page(column_count+i, line_count).nchars = -1;
 900                          i = i + 1;
 901                     end;
 902                     end;
 903      end;
 904 
 905 /* If "fold" is specified, we don't have to worry about column_count+1.  All lines go into current
 906    column, with possible indent for overflowing lines. */
 907 
 908 if fold ^= -1 then do while ("1"b);
 909      call get_line;           /* get next line from input segment */
 910      call find_next_line;
 911 reset_it:
 912      if nchars < 0 then real_nchars = -nchars + fold;
 913                    else real_nchars = nchars;
 914      call put_line (column_count, line_count, start, min(nchars, column_width)); /* put up to column_width chars on line */
 915      if minimize then do;
 916           max_line_length = max (max_line_length, min (real_nchars, column_width));
 917           real_max_line_length = max_line_length;
 918           end;
 919      if nchars > column_width then do; /* line must be continued on subsequent lines */
 920           vertical_tab = "0"b;
 921           increment = column_width;
 922           do char_count = column_width+1 by column_width-fold to nchars;
 923                /* We have to increment start by increment for subsequent parts of this input line.  The problem is that
 924                   the line may contain backspaces, so that if we really want start to point to the proper character
 925                   we have to determine the actual position of the character corresponding to the increment'th printing
 926                   position after the start'th character */
 927                if start > 0 then line_ptr = addr (substr (seg, start));         /* get pointer to real line */
 928                             else line_ptr = addr (substr (expanded_seg, -start));
 929                if index (line, BS) = 0  /* any backspaces within increment+1 characters? */
 930                then start = start + sign(start)*increment;  /* no, just add increment */
 931                else do;
 932                     j = 0;              /* it's necessary to count backspaces */
 933                     do i = 1 by 1 while (j <= increment);
 934                          if substr (line, i, 1) = BS then j = j - 1;
 935                                                             else j = j + 1;
 936                     end;
 937                     start = start + sign(start)*(i-2);      /* add 2 for every backspace */
 938                     end;
 939                increment = column_width - fold;
 940                reset = "0"b;
 941                call find_next_line;
 942                if reset then goto reset_it; /* new column was started, current line aborted */
 943                call put_line (column_count, line_count, start, -min (column_width - fold, nchars + 1 - char_count));
 944                if minimize then max_line_length = max (max_line_length, min (column_width-fold,nchars+1-char_count) + fold);
 945           end;
 946           end;
 947      end;
 948 
 949 
 950 /* If trunc specified, put first column_width chars of each line into each column position and discard the rest, if any */
 951 
 952 if ^full & fold = -1 then do while ("1"b);
 953      call get_line;
 954      call find_next_line;
 955      call put_line (column_count, line_count, start, min (nchars, column_width));
 956      if minimize then do;
 957           max_line_length = max (max_line_length, min (nchars, column_width));
 958           real_max_line_length = max_line_length;
 959           end;
 960      end;
 961 
 962 end;
 963 /*^L*/
 964 /* ************* FIND_NEXT_LINE *********** */
 965 
 966 /* This subroutine finds the next unused slot in a column.  If it gets to the end of a column,
 967    it goes to the top of the next column.  If it gets to the end of the last column, it calls output_page
 968    and starts a new page.  When the end of a column is reached, it may be necessary to make a final
 969    pass of the column to take care of overflowing "full" lines.  Also, if the end of the column
 970    is not the last line on the page, the column can possibly be moved further to the left.  Keep in mind that
 971    this subroutine is always called after get_line.  This means that the current values of start, nchars, vertical_tab,
 972    and block_length, etc. represent the state of the input file for the next line to be inserted into the page.
 973    If these values are modified, as in the case when blocks is specified and the current block has to
 974    be "cleaned out" of the current column and restarted, get_line will not be called again until one more
 975    line is inserted into the page.
 976       A new page may also be sarted when, after possible moving of current column over as far to
 977    the left as possible (for minimize), the rightmost character of the column extends past the right margin.
 978    However, the rightmost character of the column may also extend past the margin anytime full is specified.
 979 */
 980 
 981 find_next_line: proc;
 982   dcl (i, k, l) fixed bin;
 983   dcl j fixed bin(21);
 984   dcl vt_flag bit(1) aligned;
 985   dcl line_length fixed bin;
 986   dcl overflow fixed bin;
 987   dcl bit builtin;
 988   dcl flag bit(1) aligned;
 989   dcl saved_max_line_length fixed bin;
 990 
 991   if column_count = 0 then do;          /* initialize for first page */
 992           last_line_flag = "0"b;
 993 new_page: column_count = 1;
 994           block_length = 1;
 995           line_count = 0;
 996           if minimize then do;
 997                n_columns = 1;
 998                if ^undefined_page then page(1,*),page(2,*) = 0;
 999                min_line_length = real_line_length;
1000                end;
1001           saved_info.max_line_length, max_line_length = 1;
1002           real_max_line_length = 1;
1003           make_final_pass = "0"b;
1004           top_of_column = "1"b;
1005           saved_info = saving_info;
1006           if ^minimize & ^undefined_page then page = 0;     /* zero out next page */
1007           end;
1008 
1009   /* If the page length is undefined, just increment line_count and continue in same column.
1010      If the page length is defined, we do the same except if a new column should be started.
1011      A new column is started if:
1012           We get to the bottom of the current column. (line_count = page_length)
1013           Vertical tab is encountered and blocks not specified and we're not already at top of column.
1014           Blocks specified and current line does not have vertical tab but current block can be made to fit
1015                in one column, (or block didn't start the column).
1016           Full and not minimize is specified, and current line overflows right margin.  In this case
1017                the whole column is abandoned, the page is output up to previous column, and the current
1018                column as far as formed is made the first column of a new page.
1019   */
1020 
1021 loop:
1022 
1023   if last_line_flag then goto new_column;
1024 
1025   if undefined_page then do;
1026         if line_count = max_line_count then goto too_big;
1027         end;
1028   else do;
1029        if vertical_tab then if ^blocks then if ^saved_info.top_of_column then goto new_column;
1030        if line_count = page_length then do;       /* bottom of column */
1031           if blocks then                          /* blocks specified */
1032                if ^vertical_tab then do;          /* but line has no vertical tab */
1033                     if saved_info.top_of_column then        /* and current block began current column, */
1034                          if block_length <= page_length then do; /* and so far block < page_length, was at top of column */
1035                               if last_page_flag   /* then scan ahead in input to see if current block can */
1036                               then j = last_page_count; /* be made to fit in one page_length */
1037                               else j = line_loc;
1038                               vt_flag = (substr(seg,j,1)=VT) | (j>seglength);
1039 
1040                               /* find next vertical tab in input segment */
1041 
1042                               if debug then call ioa_ ("Block length so far=^d, begin searching at line_loc=^d.", block_length, line_loc);
1043                               do block_length = block_length to page_length by 1 while (^vt_flag);
1044                                    if last_page_flag then do;
1045                                         j = j + 1;
1046                                         if j > last_page_length
1047                                         then vt_flag = "1"b;
1048                                         else vt_flag = bit (last_page(j).vertical_tab);
1049                                         end;
1050                                    else do;
1051                                         line_length = index (substr (seg, j), NL);
1052                                         if line_length = 0 then line_length = seglength - j + 1;
1053                                         j = j + line_length;
1054                                         if j > seglength
1055                                         then vt_flag = "1"b;
1056                                         else vt_flag = substr (seg, j, 1) = VT;
1057                                         end;
1058                               end;
1059                               if debug then call ioa_ ("Vertical tab ^v(not ^)encountered.", bin(^vt_flag)); /* debug */
1060                               if ^vt_flag then goto new_column; /* block won't fit in one column, don't don't move it */
1061                               end;
1062                          else goto new_column; /* block already bigger than one column, leave it where it is */
1063 
1064                     /* Current block, which was started in current column, either didn't start column or
1065                        can be made to fit totally in one column (if given the chance).
1066                        It must be cleared out of the current column, and saving_info must be reset so that the next line
1067                        put into the top of the next column is the first line of the current block.  Subsequent call to
1068                        get_line will retrieve the second line of the block, etc. */
1069 
1070                     if saved_info.column_count = column_count
1071                     then i = saved_info.line_count + 1; /* start at line after last of previous block */
1072                     else do;                      /* but only in current column */
1073                          i = 1;
1074                          saved_info.column_count = column_count; /* do this so we don't go back to previous column */
1075                          end;
1076                     if debug then call ioa_ ("     column cleared out from ^d to ^d", i, line_count);
1077                     do i = i to line_count;
1078                          if page(column_count,i).start ^= 0
1079                          then do;
1080                               if minimize then j = column_count + 1;
1081                                           else j = n_columns;
1082                               do j = column_count to j;
1083                                    page(j,i) = 0;
1084                               end;
1085                               end;
1086                     end;
1087                     saving_info = saved_info;     /* restore status of variables to values when block started */
1088                     block_length = 1;             /* specify that current block has 1 line so far */
1089                     reset = "1"b;                 /* needed to signal reset for truncate mode */
1090                     saved_info.top_of_column = "1"b; /* say that block began at top of column */
1091                     saved_info.line_count = 1;       /* this block starts new column */
1092                     vertical_tab = "1"b;             /* and that current line has a vertical tab in it, which it does */
1093                     if top_of_column then goto last_scan; /* nothing left in this column, just go to next column */
1094                     end;                /* end of "blocks" */
1095 
1096 new_column:
1097 
1098           /* Come here when it is decided to start a new column, whether or not current column has
1099              been filled. */
1100 
1101           if full & line_count < page_length & ^minimize
1102           then do i = line_count + 1 to page_length; /* didn't get to bottom of column, clear out rest of column */
1103                          page (column_count, i) = 0;
1104                     end;
1105           saved_max_line_length = max_line_length;
1106 
1107           /* If minimizing, partially filled column can possibly be moved over further to the left
1108              than was originally thought (as determined from maximum length of non-overflowing lines
1109              of previous column), because all lines of previous column up to current line_count
1110              might be shorter than that. */
1111 
1112           if minimize & line_count < page_length & column_count > 1 then do; /* didn't get to bottom of col */
1113                /* try moving column over to left */
1114                if full then make_final_pass = "1"b; /* set since we haven't gotten to the bottom of the column */
1115                k = 0; /* set to rightmost position of all previous columns that is before column_position-1 */
1116                do i = 1 to line_count;
1117                     do j = column_count - 1 by -1 to 1 while (page(j,i).start = 0);
1118                     end;
1119                     if j >= 1 then do;
1120                          l = page (j,i).nchars;
1121                          if l < 0 then l = fold - l;
1122                          l = l + column_position(j); /* position+1 of rightmost char of this line */
1123                          if l <= column_position(column_count) - space & l > k then do; /* if line ends before */
1124                               k = l;    /* column_position-space, and it is longer than previous longest line, save it */
1125                               if j = column_count - 1
1126                               then flag = "1"b; /* this max line came from immediately preceeding column */
1127                               else flag = "0"b; /* max line was in some col before that */
1128                               end;
1129                          end;
1130                end;
1131                /* When we get here, we know that k cannot be zero, because at least one line in previous
1132                   column(s) must have ended before current column position - space.  If it didn't, there would
1133                   would not have been any lines in the current column to start with. */
1134                if k < column_position(column_count) - 1 then do;
1135                     if flag then if k+space <= column_position(column_count)
1136                                  then k = k + space;
1137                                  else k = k + 1;
1138                     else k = k + 1;
1139                     j = column_position(column_count) - k; /* k is new starting pos of column */
1140                     if j > 0 then if full then if make_final_pass then do;
1141                          do i = 1 to page_length;
1142                               if page(column_count,i).start = 0 then /* add amount of carry-overs from overflowed lines */
1143                                    if page(column_count,i).nchars ^= 0 then
1144                                         page(column_count,i).nchars = page(column_count,i).nchars + j;
1145                          end;
1146                          end;
1147                     if k + max_line_length + space < column_position(column_count) /* adjust max_line_length so that */
1148                     then max_line_length = column_position(column_count) - k - space; /* next column is no closer to left */
1149                     else max_line_length = max_line_length + j; /* than current column originally was */
1150                     if debug then call ioa_ ("^3-column(^d) moved to ^d", column_count, k);
1151                     column_position (column_count) = k;     /* set new position of current column */
1152                     previous_tab(column_count) = divide (k - 1, 10, 17, 0)*10 + 1;
1153                     spaces_from_tab (column_count) = k - previous_tab(column_count);
1154                     end;
1155                end;
1156 
1157           /* At this point, column is moved over to left as far as possible (if minimize).  Now determine whether it will
1158              fit within the right margin.  If it doesn't, start a new page using current column as first column,
1159              and following column (containing overflow information for minimize) as second.
1160           */
1161 
1162           if (full | minimize) & column_position(column_count) + real_max_line_length > real_line_length + 1 then do;
1163                if last_page_flag then goto NOT_ENOUGH_ROOM_ON_LAST_PAGE;
1164                if debug then call ioa_ ("Page being output to column ^d. Column ^d moved to position 1.", column_count-1,column_count);
1165                call output_page (column_count - 1);         /* output current page up to previous column */
1166                line_count = 0;
1167                do k = 1 to page_length; /* make current and following column the first two columns of new page */
1168                     if page(column_count, k).start ^= 0 then do;
1169                          line_count = line_count + 1;
1170                          page (1, line_count) = page (column_count, k);
1171                          if minimize then page (2, line_count) = page (column_count+1, k);
1172                          end;
1173                end;
1174                do k = line_count + 1 to page_length;        /* zero out rest of unused slots in first 2 columns */
1175                     page (1, k) = 0;
1176                     if minimize then page (2, k) = 0;
1177                end;
1178                column_count = 1;
1179                max_line_length = saved_max_line_length;
1180                saved_info.column_count = 1;                 /* change column data in saved_info for this block */
1181                end;
1182 
1183 last_scan:if make_final_pass then do;                       /* one last pass of column necessary */
1184                do i = 1 to page_length;
1185                     if page(column_count+1, i).nchars ^= 0  /* did this line overflow into next column? */
1186                     then do;
1187                          overflow = page(column_count + 1, i).nchars - max_line_length - space;
1188                          if overflow = 0
1189                          then overflow = -1;
1190                          else if overflow < 0 then overflow = 0;
1191                          page(column_count+1, i).nchars = overflow;
1192                          end;
1193                     if page(column_count, i).start = 0 then  /* is this line an overflow from previous column? */
1194                        if page(column_count, i).nchars ^= 0 then do;
1195                          page(column_count+1, i).nchars = max (page(column_count, i).nchars - max_line_length - space, 0);
1196                          page(column_count, i).nchars = -1;  /* mark this column blank and carry over excess to next */
1197                          end;
1198                end;
1199                end;
1200 
1201           if last_line_flag
1202           then if last_page_flag then goto END_OF_LAST_PAGE;
1203                                  else goto END_OF_INPUT_SEGMENT; /* no more lines left */
1204           column_count = column_count + 1;                  /* advance to next column */
1205           if minimize then do;                              /* if minimize, calculate position of next column */
1206                column_position(column_count) = column_position(column_count-1) + space + max_line_length;
1207                previous_tab(column_count) = divide (column_position(column_count) + indent - 1, 10, 17, 0) * 10 + 1;
1208                spaces_from_tab(column_count) = column_position(column_count) + indent - previous_tab(column_count);
1209                if debug then call ioa_ ("max_line_length=^d^-^-column(^d)=^d",max_line_length,column_count,column_position(column_count));
1210                end;
1211           else if column_count > n_columns then do;
1212                if last_page_flag then goto NOT_ENOUGH_ROOM_ON_LAST_PAGE;
1213                call output_page (column_count - 1);
1214                goto new_page;
1215                end;
1216 
1217           saved_info.top_of_column = "1"b;
1218           top_of_column = "1"b;
1219           line_count = 0;               /* go to top of next column */
1220           saved_info.max_line_length, max_line_length = 1;
1221           real_max_line_length = 1;
1222           if minimize then do;
1223                n_columns = column_count;
1224                page(column_count+1, *) = 0;       /* zero out the following column */
1225                make_final_pass = "0"b;
1226                end;
1227           end;      /* end of "line_count = page_length" 3rd page preceeding */
1228        end;         /* end of else clause for "undefined_page" */
1229 
1230   /* If current line won't fit in column within right margin, and it's not minimize, we must output
1231      page up to previous column and move lines in this column to column 1 of next page.  We know that
1232      all lines preceeding the current line in this column did fit on the page. */
1233 
1234 
1235   if full & ^minimize & column_position(column_count) + nchars > real_line_length + 1 then do;
1236           if column_count ^= 1 then call output_page(column_count-1); /* output up to previous column */
1237           do k = 1 to line_count; /* move lines in column to column 1 */
1238                if k = 1 then line_count = 0;
1239                if page(column_count, k).start ^= 0 then do;
1240                     line_count = line_count + 1;
1241                     page (1, line_count) = page (column_count, k);
1242                     end;
1243                end;
1244           do k = line_count + 1 to page_length;   /* clear out rest of column 1 */
1245                page (1, k) = 0;
1246           end;
1247           do k = 2 to n_columns;                  /* then clear out rest of page */
1248                page (k, *) = 0;
1249           end;
1250           column_count = 1;
1251           saved_info.column_count = 1;
1252           end;
1253   line_count = line_count + 1;          /* go to next slot */
1254   if full then if column_count ^= 1 then if page(column_count, line_count).nchars ^= 0 then do; /* slot not empty */
1255                if minimize then make_final_pass = "1"b;
1256                if debug then call ioa_ ("******^3d,^3d (^d,^d)", page(column_count, line_count).start, page(column_count,line_count).nchars, column_count, line_count);
1257                goto loop;
1258                end;
1259 end;
1260 
1261 /*^L*/
1262 /* ********* CREATE_TEMP_SEG *********** */
1263 
1264 /* procedure to create a temporary segment in process directory */
1265 
1266 create_temp_seg: proc (ptr);
1267      dcl ptr ptr;
1268      dcl unique_chars_ entry (bit(*)) returns (char(15));
1269 
1270      /* unique_chars makes this command recursive */
1271 
1272      call hcs_$make_seg ("", unique_chars_ (""b) || ".columns", "", 1010b, ptr, code);
1273      if ptr = null then do;
1274           call com_err_ (code, "columns", "Temporary segment in [pd].");
1275           goto return;
1276           end;
1277 
1278 end;
1279 
1280 /* *************** CLEANER ************** */
1281 
1282 /* procedure that cleans up in case of release or at end of job */
1283 
1284 cleaner: proc;
1285      dcl ptr ptr;
1286 
1287      do ptr = lines_ptr, last_lines_ptr, expanded_ptr;
1288           if ptr ^= null then call hcs_$delentry_seg (ptr, code);
1289      end;
1290 
1291      if output_buffer_ptr ^= null then free output_buffer;
1292 
1293      do ptr = inptr, outptr;
1294           if ptr ^= null then call hcs_$terminate_noname (ptr, code);
1295      end;
1296 end;
1297 
1298 /* ************** PUT_LINE ************ */
1299 
1300 /* procedure to put a line into the output page */
1301 
1302 /* This procedure merely transfers the values of "start" and "nchars" to the output buffer. */
1303 
1304 put_line: proc (column_no, line_no, start, nchars);
1305  dcl (column_no, line_no, nchars) fixed bin;
1306  dcl start fixed bin(21);
1307 
1308  min_line_length = max (min (min_line_length, nchars), 1);
1309 top_of_column = "0"b;
1310  page(column_no, line_no).start = start;
1311  page(column_no, line_no).nchars = nchars;
1312  page(column_no, line_no).vertical_tab = bin(vertical_tab);
1313  if debug then call ioa_("*^2d ^1b ^3d,^3d (^d,^d)",input_line_count*bin(^last_page_flag)+last_page_count*bin(last_page_flag), vertical_tab, start, nchars, column_no, line_no);
1314 end;
1315 /*^L*/
1316 /***************** OUTPUT_PAGE ************** */
1317 
1318 /* Subroutine to output the page buffer.  If output is to segment, the lines are moved to the output segment.
1319    If output is to terminal, the lines are printed on the terminal.  Each output line is formed, one
1320    at a time, across the page, by concatenating the nth line in each column, from left to right. */
1321 
1322 output_page: proc (n_columns);
1323   dcl n_columns fixed bin;                                  /* number of columns in page buffer to output */
1324   dcl out_line char(1000) based (out_line_ptr);   /* output line is formed here */
1325   dcl line char(1000) based (line_ptr);                     /* input line corresponding to current column slot */
1326   dcl line_ptr ptr;                                         /* points to expanded_seg or input segment */
1327   dcl out_line_count fixed bin;                             /* position in out_line */
1328   dcl line_count fixed bin;                                 /* line number in current column being accessed */
1329   dcl col_count fixed bin;                                  /* column being accessed */
1330   dcl position fixed bin;                                   /* horizontal printing position in output line */
1331   dcl i fixed bin;
1332   dcl ntabs fixed bin;
1333   dcl char_count fixed bin;                                 /* count of printing positions used by current line */
1334   dcl nchars fixed bin;                                     /* number of printing positions to output from current slot */
1335   dcl nspaces fixed bin;                                    /* number of blanks required to get to next column */
1336   dcl start fixed bin(21);                                  /* index of line for this slot in input seg or expanded_seg */
1337 
1338 if debug then do;
1339               do i = 1 to n_columns;    /*debug*/
1340                     call ioa_$nnl("   ___^a^a^a^3d_   ",BS,BS,BS,column_position(i));     /*debug*/
1341               end;  /*debug*/
1342               call ioa_();    /*debug*/
1343               do i = 1 to page_length;  /*debug*/
1344                     do j = 1 to n_columns;        /*debug*/
1345                     call ioa_$nnl(" ^3d ^3d  ",page(j,i).start,page(j,i).nchars);         /*debug*/
1346                     end;      /*debug*/
1347                     call ioa_ ("");     /*debug*/
1348               end;  /*debug*/
1349               end;  /*debug*/
1350                     /*debug*/
1351  /* first output a form-feed if not the first page */
1352 
1353 if segment & out_count ^= 1 then do;
1354      substr (out, out_count, 1) = NP;
1355      out_count = out_count + 1;
1356      end;
1357 if ^segment then do i = 1 to top_margin;
1358      call iox_$put_chars (iox_$user_output, addr(NL), 1, code);
1359      end;
1360 
1361  /* start with the first line in each column and go down the page to the bottom */
1362 
1363 do line_count = 1 to page_length;
1364      if segment then do;
1365           if indent ^= 0 then do;                           /* if indent specified, insert indent characters */
1366                substr (out, out_count, length(indent_field)) = indent_field;
1367                out_count = out_count + length(indent_field);
1368                end;
1369           out_line_ptr = addr(substr(out, out_count));      /* obtain pointer to position of output line in output segment */
1370           end;
1371      position = indent + 1;                       /* start at priting position after indent */
1372      out_line_count = 1;
1373 
1374      do col_count = 1 to n_columns;               /* step through the current line in each column */
1375         nchars = page(col_count, line_count).nchars;                /* number of printing positions to use */
1376         if nchars ^= 0 then do;
1377           nspaces = column_position(col_count) + indent - position;   /* number of spaces required to get to this column */
1378           if nspaces > 0 then do;
1379                if previous_tab(col_count) > position then do; /* previous tab past current position? */
1380                     ntabs = divide (previous_tab(col_count) - position - 1, 10, 17, 0) + 1; /* number of tabs to insert */
1381                     nspaces = ntabs + spaces_from_tab(col_count); /* no. of spaces + tabs to insert */
1382                     substr (out_line, out_line_count, nspaces) = substr ((13)"  ", 1, ntabs); /* insert tabs + fill of spaces */
1383                     end;
1384                else substr (out_line, out_line_count, nspaces) = "";  /* fill up with spaces */
1385                out_line_count = out_line_count + nspaces;
1386                position = column_position(col_count) + indent;
1387                end;
1388           start = page(col_count, line_count).start;                  /* get starting position of line for his slot */
1389           if start^=0 & nspaces<0 then do;        /*debug*/
1390                call ioa_ ("Software error. Extra line in array at ^2d,^2d. Please contact maintenance personnel.", col_count, line_count);  /*debug*/
1391                end;           /*debug*/
1392           if start < 0
1393           then line_ptr = addr (substr (expanded_seg, -start));
1394           else if start > 0 then line_ptr = addr (substr (seg, start));
1395                             else goto do_nothing;                     /* slot is empty */
1396           if nchars < 0 then do;                                      /* we must first indent for a folded line */
1397                substr (out_line, out_line_count, fold) = "";          /* insert spaces for fold */
1398                out_line_count = out_line_count + fold;
1399                position = position + fold;
1400                nchars = -nchars;                                      /* make this positive */
1401                end;
1402           if index (substr (line, 1, nchars+1), BS) = 0 then do;  /* check for backspaces within nchars+1 chars */
1403                substr (out_line, out_line_count, nchars) = substr (line, 1, nchars); /* no backspaces, just move line */
1404                out_line_count = out_line_count + nchars;
1405                end;
1406           else do;                                                    /* there were backspaces, find real no. of chars */
1407                char_count = 0;
1408                do i = 1 by 1 while (char_count <= nchars);
1409                     if substr (line, i, 1) = BS then char_count = char_count - 1;
1410                                                        else char_count = char_count + 1;
1411                end;
1412                i = i - 2;
1413                substr (out_line, out_line_count, i) = substr (line, 1, i);
1414                out_line_count = out_line_count + i;
1415                end;
1416           position = position + nchars;
1417           end;
1418 do_nothing:
1419      end;
1420      substr (out_line, out_line_count, 1) = NL;   /* all done with line */
1421      if ^segment then call iox_$put_chars (iox_$user_output, output_buffer_ptr, length(indent_field)+out_line_count, code);
1422                  else out_count = out_count + out_line_count;
1423 end;
1424 
1425 if ^segment then do; /* add bottom margin if output to terminal */
1426      i = bottom_margin;
1427      if ^npgn then i = i + original_page_length - page_length; /* and space to bottom of page if not npgn */
1428      do i = 1 to i;
1429           call iox_$put_chars (iox_$user_output, addr(NL), 1, code);
1430      end;
1431      end;
1432 else do;
1433      if mod(page_length+3+top_margin, 66) < 3 /* in 1st or 2nd line of page? */
1434      then do; /* if so, add an extra NP char or next NP will only space 1 or 2 lines */
1435           substr (out_line, out_count, 1) = NP;
1436           out_count = out_count + 1;
1437           end;
1438      end;
1439 end;
1440 
1441 end;