1 /* ***********************************************************
   2    *                                                         *
   3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   4    *                                                         *
   5    *********************************************************** */
   6 /* format: off */
   7 %skip(3);
   8 /*   This is the main level procedure called by ssu_ to implement the
   9      linus display request. Description and usage follows.
  10 
  11      Description: This request takes far too many control arguments to
  12      list here (currently it accepts 55). See the info segment for details
  13      on the accepted control arguments and usage.
  14 
  15      Usage:
  16 
  17      Both parameters are passed to this request by ssu_.
  18 
  19 
  20      Known Bugs:
  21 
  22      Other Problems:
  23 
  24      History:
  25 
  26      Written - Al Dupuis - August 1983
  27 
  28 */
  29 %page;
  30 linus_display: proc (sci_ptr_parm, lcb_ptr_parm);
  31 %skip(3);
  32 dcl sci_ptr_parm ptr parm;  /* ptr to the subsystem control info structure */
  33 dcl lcb_ptr_parm ptr parm;  /* ptr to the linus control block info structure */
  34 %skip(3);
  35 /*
  36           Mainline Processing Overview.
  37 
  38           (1) Make sure the format options are up to date and that there is
  39               data to create a report from.
  40 
  41           (2) Have the subroutine linus_display_process_args fill in the
  42               default control args and update the defaults with arguments
  43               supplied on the request line.
  44 
  45           (3) Delete existing report and table if appropriate, start new ones
  46               if appropriate, possibly sort the table, setup for multi-pass
  47               mode if appropriate.
  48 
  49           (4) Setup any output file, output switch, or the video system
  50               depending on what control arguments were given.
  51 
  52           (5) Print, scroll, or page the report.
  53 
  54           (6) Perform termination as instructed by the control args.
  55 
  56 */
  57 %page;
  58           arguments_have_been_processed = OFF;
  59           cleanup_signalled = OFF;
  60 %skip(1);
  61           on cleanup begin;
  62                cleanup_signalled = ON;
  63                call terminate;
  64           end;
  65 %skip(1);
  66           call initialize;
  67           call linus_display_process_args (sci_ptr, lcb_ptr, work_area_ptr,
  68                table_ip, addr (display_arg_results));
  69           arguments_have_been_processed = ON;
  70           call fill_in_the_defaults;
  71 %skip(1);
  72           call setup_io_switches;
  73 %skip(1);
  74           if display_arg_results.scroll_flag
  75           then call scroll_the_report;
  76           else if display_arg_results.pages_flag
  77                then call page_the_report;
  78                else call print_report;
  79 %skip(1);
  80           call terminate;
  81 %skip(1);
  82           return;
  83 %page;
  84 begin_new_report: proc;
  85 %skip(1);
  86           if display_arg_results.flags.keep_report_flag
  87           | display_arg_results.flags.scroll_flag
  88           then report_control_info.flags.permanent_report = ON;
  89           else report_control_info.flags.permanent_report = OFF;
  90 %skip(1);
  91           if display_arg_results.time_flag
  92           then time1 = vclock;
  93 %skip(1);
  94           call linus_fr_new_report (lcb_ptr, code);
  95           if display_arg_results.time_flag
  96           then do;
  97                time2 = vclock;
  98                report_control_info.report_setup_time = time2 - time1;
  99                call ioa_$ioa_switch (iox_$error_output,
 100                     "Time used to setup the report was ^10.5f seconds.",
 101                     report_control_info.report_setup_time / 1000000);
 102           end;
 103 %skip(1);
 104           if code ^= 0
 105           then call ssu_$abort_line (sci_ptr, code);
 106 %skip(1);
 107           report_control_info.flags.report_has_been_started = ON;
 108           report_control_info.flags.report_is_formatted = OFF;
 109           report_control_info.flags.report_has_just_been_completed = OFF;
 110           report_control_info.report_identifier
 111                = report_control_info.options_identifier;
 112           report_control_info.no_of_formatted_pages = 0;
 113           report_control_info.report_formatting_time = 0;
 114           report_control_info.report_display_time = 0;
 115           report_control_info.ssu_evaluate_active_string_time = 0;
 116 %skip(1);
 117           return;
 118 %skip(1);
 119      end begin_new_report;
 120 %page;
 121 begin_new_retrieval: proc;
 122 %skip(1);
 123           if display_arg_results.keep_retrieval_flag
 124           | display_arg_results.sort_flag
 125           then report_control_info.permanent_table = ON;
 126           else report_control_info.permanent_table = OFF;
 127 %skip(3);
 128           time1 = vclock;
 129           call linus_table$new_table (lcb_ptr,
 130                (report_control_info.temp_dir_name),
 131                (report_control_info.permanent_table), code);
 132           time2 = vclock;
 133           report_control_info.table_loading_time = time2 - time1;
 134 %skip(1);
 135           if code ^= 0
 136           then call ssu_$abort_line (sci_ptr, code);
 137 %skip(1);
 138           report_control_info.flags.table_has_been_started = ON;
 139           report_control_info.flags.table_is_full = OFF;
 140           report_control_info.flags.table_has_just_been_loaded = OFF;
 141           report_control_info.retrieval_identifier
 142                = table_info.retrieval_identifier;
 143           report_control_info.no_of_rows_retrieved = table_info.row_count;
 144 %skip(1);
 145           return;
 146 %skip(1);
 147      end begin_new_retrieval;
 148 %page;
 149 delete_report: proc;
 150 %skip(1);
 151           if display_arg_results.time_flag
 152           then time1 = vclock;
 153 %skip(1);
 154           call linus_fr_delete_report (lcb_ptr, code);
 155           if display_arg_results.time_flag
 156           then do;
 157                time2 = vclock;
 158                report_control_info.report_deletion_time = time2 - time1;
 159                call ioa_$ioa_switch (iox_$error_output,
 160                     "Time used to delete the report was ^10.5f seconds.",
 161                     report_control_info.report_deletion_time / 1000000);
 162           end;
 163 %skip(1);
 164           if code ^= 0
 165           then if cleanup_signalled
 166                then call ssu_$print_message (sci_ptr, code);
 167                else call ssu_$abort_line (sci_ptr, code);
 168           else;
 169 %skip(1);
 170           report_control_info.flags.report_has_been_started = OFF;
 171 %skip(1);
 172           return;
 173 %skip(1);
 174      end delete_report;
 175 %page;
 176 delete_table: proc;
 177 %skip(1);
 178           if display_arg_results.time_flag
 179           then time1 = vclock;
 180 %skip(1);
 181           call linus_table$delete_table (lcb_ptr, code);
 182           if display_arg_results.time_flag
 183           then do;
 184                time2 = vclock;
 185                report_control_info.table_deletion_time = time2 - time1;
 186                call ioa_$ioa_switch (iox_$error_output,
 187                     "Time used to delete the table was ^10.5f seconds.",
 188                     report_control_info.table_deletion_time / 1000000);
 189           end;
 190 %skip(1);
 191           if code ^= 0
 192           then if cleanup_signalled
 193                then call ssu_$print_message (sci_ptr, code);
 194                else call ssu_$abort_line (sci_ptr, code);
 195           else;
 196 %skip(1);
 197           report_control_info.flags.table_has_been_started = OFF;
 198 %skip(1);
 199           return;
 200 %skip(1);
 201      end delete_table;
 202 %page;
 203 fill_in_the_defaults: proc;
 204 %skip(1);
 205 /*
 206           Delete the old table and old report if a new retrieval or report
 207           has been requested and it wasn't deleted on our last termination.
 208           The user may have asked for an existing table or report to be
 209           used when it isn't possible. Examples of this are: when there isn't
 210           an existing table; when invocations of the print, report, etc.
 211           requests have occured since we were last active; when there isn't
 212           an existing report; when the user has invoked the sfo request;
 213           etc. If this has happened then it is treated as if the user asked
 214           for a new report/table.
 215 */
 216 %skip(3);
 217           if ^display_arg_results.new_retrieval_flag
 218           then do;
 219                if report_control_info.retrieval_identifier
 220                ^= table_info.retrieval_identifier
 221                | ^report_control_info.flags.table_has_been_started
 222                then do;
 223                     if display_arg_results.long_flag
 224                     then call ssu_$print_message (sci_ptr, 0,
 225                          "Warning: A new retrieval will be started.");
 226                     display_arg_results.new_retrieval_flag = ON;
 227                end;
 228                else;
 229           end;
 230           else;
 231 %skip(1);
 232           if display_arg_results.new_retrieval_flag
 233           & report_control_info.flags.table_has_been_started
 234           then call delete_table;
 235 %skip(1);
 236           if ^display_arg_results.new_report_flag
 237           then do;
 238                if report_control_info.report_identifier
 239                ^= report_control_info.options_identifier
 240                | ^report_control_info.flags.report_has_been_started
 241                | display_arg_results.new_retrieval_flag
 242                then do;
 243                     if display_arg_results.long_flag
 244                     then call ssu_$print_message (sci_ptr, 0,
 245                          "Warning: A new report will be started.");
 246                     display_arg_results.new_report_flag = ON;
 247                end;
 248                else;
 249           end;
 250           else;
 251 %skip(1);
 252           if display_arg_results.new_report_flag
 253           & report_control_info.flags.report_has_been_started
 254           then call delete_report;
 255 %skip(1);
 256 /*
 257 
 258           Check for a new temp dir supplied by the user for placing the
 259           retrieved data table and formatted report.  We only allow a new
 260           temp_dir when we're about to create a new table and report, because
 261           the ptrs to the rows and formatted pages of existing reports and
 262           tables would be invalid.
 263 
 264 */
 265 %skip(1);
 266           if display_arg_results.temp_dir_flag
 267           then do;
 268                allocate status_branch in (work_area) set (status_ptr);
 269                call expand_pathname_ (display_arg_results.temp_dir_pathname,
 270                     directory_name, entry_name, code);
 271                if code ^= 0
 272                then call ssu_$abort_line (sci_ptr, code,
 273                     "^/While trying to expand the temp dir ^a.",
 274                     display_arg_results.temp_dir_pathname);
 275                call hcs_$status_long (directory_name, entry_name, 1,
 276                     status_ptr, null (), code);
 277                if code ^= 0 & code ^= error_table_$no_s_permission
 278                then call ssu_$abort_line (sci_ptr, code,
 279                     "^/While trying to determine the unique id of ^a.",
 280                     display_arg_results.temp_dir_pathname);
 281                if display_arg_results.new_report_flag
 282                & display_arg_results.new_retrieval_flag
 283                then do;
 284                     report_control_info.temp_dir_name
 285                          = display_arg_results.temp_dir_pathname;
 286                     report_control_info.temp_dir_unique_id
 287                          = status_branch.long.uid;
 288                end;
 289                else if report_control_info.temp_dir_unique_id = status_branch.long.uid
 290                     then;
 291                     else do;
 292                          if display_arg_results.long_flag
 293                          then call ssu_$print_message (sci_ptr, 0,
 294                               "Warning: The temp_dir ^a won't be used.",
 295                               rtrim (display_arg_results.temp_dir_pathname));
 296                          display_arg_results.temp_dir_flag = OFF;
 297                     end;
 298           end;
 299           else;
 300 %page;
 301 /*
 302           Check for multiple pass mode.
 303 */
 304 %skip(1);
 305           if display_arg_results.flags.passes_flag
 306           then if ^display_arg_results.flags.new_report_flag
 307                then call ssu_$abort_line (sci_ptr, error_table_$inconsistent,
 308                     "^/The control argument -passes can only be used with a new report.");
 309                else do;
 310                     report_control_info.flags.multi_pass_mode = ON;
 311                     report_control_info.number_of_passes = display_arg_results.number_of_passes;
 312                end;
 313           else report_control_info.flags.multi_pass_mode = OFF;
 314 /*
 315           Begin a new retrieval and report if appropriate.
 316 */
 317 %skip(1);
 318           if display_arg_results.new_retrieval_flag
 319           then call begin_new_retrieval;
 320 %skip(1);
 321           if display_arg_results.new_report_flag
 322           then call begin_new_report;
 323 %skip(1);
 324 /*
 325           Sort the table if instructed.
 326 */
 327 %skip(1);
 328           if display_arg_results.sort_flag
 329           then do;
 330                if ^report_control_info.flags.table_is_full
 331                then call load_the_entire_table;
 332                if display_arg_results.time_flag
 333                then time1 = vclock;
 334                call linus_table$sort (lcb_ptr,
 335                     display_arg_results.sort_information_ptr, code);
 336                if display_arg_results.time_flag
 337                then do;
 338                     time2 = vclock;
 339                     report_control_info.table_sorting_time = time2 - time1;
 340                     call ioa_$ioa_switch (iox_$error_output,
 341                          "Time used to sort the table was ^10.5f seconds.",
 342                          report_control_info.table_sorting_time / 1000000);
 343                end;
 344                if code ^= 0
 345                then call ssu_$abort_line (sci_ptr, code);
 346           end;
 347 %skip(1);
 348           return;
 349 %skip(1);
 350      end fill_in_the_defaults;
 351 %page;
 352 format_page: proc;
 353 %skip(3);
 354           if display_arg_results.time_flag
 355           then time1 = vclock;
 356           call linus_fr_build_page (lcb_ptr, page_ip, code);
 357           if display_arg_results.time_flag
 358           then do;
 359                time2 = vclock;
 360                report_control_info.report_formatting_time
 361                     = report_control_info.report_formatting_time + (time2 - time1);
 362           end;
 363           if code ^= 0
 364           then call ssu_$abort_line (sci_ptr, code);
 365 %skip(1);
 366           if report_control_info.flags.report_has_just_been_completed
 367           then do;
 368                report_control_info.flags.report_has_just_been_completed = OFF;
 369                if display_arg_results.time_flag
 370                then call ioa_$ioa_switch (iox_$error_output,
 371                     "Time used to format the report was ^10.5f seconds."
 372                     || "^/(ssu_$evaluate_active_string used ^10.5f seconds of this time.)",
 373                     report_control_info.report_formatting_time / 1000000,
 374                     report_control_info.ssu_evaluate_active_string_time / 1000000);
 375                else;
 376           end;
 377 %skip(1);
 378           if report_control_info.flags.table_has_just_been_loaded
 379           then do;
 380                report_control_info.flags.table_has_just_been_loaded = OFF;
 381                if display_arg_results.time_flag
 382                then call ioa_$ioa_switch (iox_$error_output,
 383                     "Time used to load the table was ^10.5f seconds.",
 384                     report_control_info.table_loading_time / 1000000);
 385                else;
 386           end;
 387 %skip(1);
 388           call format_page_or_get_page_extra_processing (report_control_info.no_of_formatted_pages);
 389 %skip(1);
 390           return;
 391 %skip(1);
 392      end format_page;
 393 %page;
 394 format_page_or_get_page_extra_processing: proc (
 395 
 396           fpgpep_page_number_parm /* input: number of page just got or formatted */
 397                                             );
 398 dcl fpgpep_page_number_parm fixed bin (21) parm;
 399 %skip(3);
 400           if fpgpep_page_number_parm = 1
 401           then first_page_of_the_report = ON;
 402           else first_page_of_the_report = OFF;
 403 %skip(1);
 404           if report_control_info.report_is_formatted
 405           & report_control_info.no_of_formatted_pages = fpgpep_page_number_parm
 406           then last_page_of_the_report = ON;
 407           else last_page_of_the_report = OFF;
 408 %skip(1);
 409           if page_info.page_overstrike_info_ptr ^= null ()
 410           then do;
 411                terminal_dependency = ON;
 412                page_overstrike_ip = page_info.page_overstrike_info_ptr;
 413           end;
 414           else terminal_dependency = OFF;
 415 %skip(1);
 416           return;
 417 %skip(1);
 418      end format_page_or_get_page_extra_processing;
 419 %page;
 420 get_page: proc (target_page_parm);
 421 %skip(1);
 422 dcl target_page_parm fixed bin (21) parm;
 423 %skip(3);
 424           call linus_fr_get_page (lcb_ptr, target_page_parm, page_ip, code);
 425           if code ^= 0
 426           then call ssu_$abort_line (sci_ptr, code,
 427                "While trying to get page ^d.", target_page_parm);
 428 %skip(1);
 429           call format_page_or_get_page_extra_processing (target_page_parm);
 430 %skip(1);
 431           return;
 432 %skip(1);
 433      end get_page;
 434 %page;
 435 initialize: proc;
 436 %skip(1);
 437           sci_ptr = sci_ptr_parm;
 438           lcb_ptr = lcb_ptr_parm;
 439 %skip(1);
 440           /* Make sure that there is data to create a report from, and that
 441              the information on the columns is available. */
 442 %skip(1);
 443           call linus_table$translate_query (lcb_ptr, table_ip, code);
 444           if code ^= 0
 445           then call ssu_$abort_line (sci_ptr, code);
 446 %skip(1);
 447           /* Make sure that the options are in sync with the current table. */
 448 %skip(1);
 449           call linus_options$initialize (lcb_ptr, code);
 450           if code ^= 0
 451           then call ssu_$abort_line (sci_ptr, code);
 452 %skip(1);
 453           /* Automatic versions of a few odds and sodds we will need. */
 454 %skip(1);
 455           report_cip = lcb.report_control_info_ptr;
 456           work_area_ptr = report_control_info.display_work_area_ptr;
 457           call release_area_ (work_area_ptr);
 458           work_area_ptr = report_control_info.display_work_area_ptr;
 459           video_has_been_set_up = OFF;
 460 %skip(1);
 461           return;
 462 %skip(1);
 463      end initialize;
 464 %page;
 465 load_the_entire_table: proc;
 466 %skip(3);
 467           if display_arg_results.time_flag
 468           then time1 = vclock;
 469 %skip(1);
 470           call linus_table$load_table (lcb_ptr, code);
 471           if display_arg_results.time_flag
 472           then do;
 473                time2 = vclock;
 474                report_control_info.table_loading_time
 475                     = report_control_info.table_loading_time + (time2 - time1);
 476                call ioa_$ioa_switch (iox_$error_output,
 477                     "Time used to load the table was ^10.5f seconds.",
 478                     report_control_info.table_loading_time / 1000000);
 479           end;
 480           if code ^= 0
 481           then if code = mrds_error_$tuple_not_found
 482                then;
 483                else call ssu_$abort_line (sci_ptr, code);
 484           else;
 485 %skip(1);
 486           report_control_info.flags.table_is_full = ON;
 487           report_control_info.no_of_rows_retrieved = table_info.row_count;
 488 %skip(1);
 489           return;
 490 %skip(1);
 491      end load_the_entire_table;
 492 %page;
 493 page_the_report: proc;
 494 %skip(1);
 495 dcl ptr_current_page_number fixed bin (21);
 496 dcl ptr_specified_pages_as_a_string bit (NUMBER_OF_ALLOWED_SPECIFIED_PAGES) based (ptr_specified_pages_as_a_string_ptr);
 497 dcl ptr_specified_pages_as_a_string_ptr ptr;
 498 dcl ptr_still_paging bit (1) aligned;
 499 %skip(3);
 500           if ^report_control_info.report_is_paginated
 501           then do;
 502                call print_report;
 503                return;
 504           end;
 505 %skip(1);
 506           report_control_info.report_display_time = 0;
 507           ptr_specified_pages_as_a_string_ptr = addr (display_arg_results.specified_pages (1));
 508           ptr_current_page_number = 1;
 509           ptr_still_paging = ON;
 510 %skip(1);
 511           do while (ptr_still_paging);
 512 %skip(1);
 513                if ptr_current_page_number > report_control_info.no_of_formatted_pages
 514                then call format_page;
 515                else if display_arg_results.specified_pages (ptr_current_page_number)
 516                     then call get_page (ptr_current_page_number);
 517                     else;
 518 %skip(1);
 519                if display_arg_results.specified_pages (ptr_current_page_number)
 520                then call print_page;
 521 %skip(1);
 522                if ^display_arg_results.last_page_flag
 523                then if index (substr (ptr_specified_pages_as_a_string, ptr_current_page_number + 1), ON) = 0
 524                     then ptr_still_paging = OFF;
 525                     else ptr_current_page_number = ptr_current_page_number + 1;
 526                else ptr_current_page_number = ptr_current_page_number + 1;
 527 %skip(1);
 528                if report_control_info.report_is_formatted
 529                & ptr_current_page_number > report_control_info.no_of_formatted_pages
 530                then ptr_still_paging = OFF;
 531 %skip(1);
 532           end;
 533 %page;
 534           if display_arg_results.last_page_flag
 535           then if ^display_arg_results.specified_pages (report_control_info.no_of_formatted_pages)
 536                then do;
 537                     if ^display_arg_results.new_report_flag
 538                     then call get_page (report_control_info.no_of_formatted_pages);
 539                     else;
 540                     call print_page;
 541                end;
 542                else;
 543           else;
 544 %skip(1);
 545           if display_arg_results.flags.time_flag
 546           then call ioa_$ioa_switch (iox_$error_output,
 547                "Time used to display the report was ^10.5f seconds.",
 548                report_control_info.report_display_time / 1000000);
 549 %skip(1);
 550           return;
 551 %skip(1);
 552      end page_the_report;
 553 %page;
 554 print_page: proc;
 555 %skip(1);
 556 dcl pp_chunk_of_line char (pp_number_of_chars) based (pp_chunk_of_line_ptr);
 557 dcl pp_chunk_of_line_ptr ptr;
 558 dcl pp_code fixed bin (35);
 559 dcl pp_ioa_string char (4);
 560 dcl pp_left_margin fixed bin;
 561 dcl pp_loop fixed bin;
 562 dcl pp_loop_limit fixed bin;
 563 dcl pp_number_of_chars fixed bin;
 564 dcl pp_overstrike_index fixed bin;
 565 dcl pp_right_margin fixed bin;
 566 %skip(3);
 567           if display_arg_results.time_flag
 568           then time1 = vclock;
 569 %skip(1);
 570           if ^display_arg_results.output_file_flag
 571           then if report_control_info.report_is_paginated
 572                | first_page_of_the_report
 573                then call ioa_$ioa_switch_nnl (
 574                     report_control_info.display_iocb_ptr, "^3/");
 575                else;
 576           else;
 577 %skip(1);
 578           if ^display_arg_results.character_positions_flag & ^terminal_dependency
 579           then do;
 580                call iox_$put_chars (report_control_info.display_iocb_ptr,
 581                     page_info.page_ptr, page_info.total_characters, pp_code);
 582                if pp_code ^= 0
 583                then call ssu_$abort_line (sci_ptr, pp_code);
 584           end;
 585           else do;
 586                if display_arg_results.character_positions_flag
 587                then do;
 588                     pp_right_margin = display_arg_results.right_margin_position;
 589                     pp_left_margin = display_arg_results.left_margin_position;
 590                     if pp_left_margin < 1
 591                     then pp_left_margin = 1;
 592                     if pp_right_margin >= page_info.width
 593                     then pp_right_margin = page_info.width - 1;
 594                end;
 595                else do;
 596                     pp_right_margin = page_info.width - 1;
 597                     pp_left_margin = 1;
 598                end;
 599                pp_number_of_chars = pp_right_margin - pp_left_margin + 1;
 600                if pp_number_of_chars ^> 0
 601                then call ssu_$abort_line (sci_ptr, linus_error_$bad_report_display,
 602                     "The specified character positions result in no characters being printed.");
 603                pp_loop_limit = page_info.length - 1;
 604                do pp_loop = 1 to pp_loop_limit;
 605                     pp_overstrike_index = ((pp_loop - 1) * page_info.width) + pp_left_margin;
 606                     pp_chunk_of_line_ptr = addr (page_defined_as_chars (pp_overstrike_index));
 607                     if terminal_dependency
 608                     & index (substr (page_overstrike_info_redefined.bit_map, pp_overstrike_index, pp_number_of_chars), ON) ^= 0
 609                     then call make_terminal_dependent_string;
 610                     call ioa_$ioa_switch (report_control_info.display_iocb_ptr,
 611                          "^a", pp_chunk_of_line);
 612                     if terminal_dependency
 613                     then pp_number_of_chars = pp_right_margin - pp_left_margin + 1;
 614                end;
 615                pp_overstrike_index = (pp_loop_limit * page_info.width) + pp_left_margin;
 616                pp_chunk_of_line_ptr = addr (page_defined_as_chars (pp_overstrike_index));
 617                if report_control_info.report_is_paginated | last_page_of_the_report
 618                then pp_ioa_string = "^a^|";
 619                else pp_ioa_string = "^a^/";
 620                if terminal_dependency
 621                & index (substr (page_overstrike_info_redefined.bit_map, pp_overstrike_index, pp_number_of_chars), ON) ^= 0
 622                then call make_terminal_dependent_string;
 623                call ioa_$ioa_switch_nnl (report_control_info.display_iocb_ptr,
 624                     pp_ioa_string, pp_chunk_of_line);
 625           end;
 626 %skip(1);
 627           if display_arg_results.time_flag
 628           then do;
 629                time2 = vclock;
 630                report_control_info.report_display_time
 631                     = report_control_info.report_display_time + (time2 - time1);
 632           end;
 633 %skip(1);
 634           return;
 635 %page;
 636 make_terminal_dependent_string: proc;
 637 %skip(1);
 638 dcl mtds_loop fixed bin;
 639 dcl mtds_overstrike_index fixed bin;
 640 %skip(3);
 641           spare_string = "";
 642           mtds_overstrike_index = pp_overstrike_index;
 643           do mtds_loop = 1 to pp_number_of_chars;
 644                spare_string = spare_string || substr (pp_chunk_of_line, mtds_loop, 1);
 645                if page_overstrike_info.bit_map (mtds_overstrike_index)
 646                then spare_string = spare_string
 647                     || BACKSPACE || page_overstrike_info.chars (mtds_overstrike_index);
 648                mtds_overstrike_index = mtds_overstrike_index + 1;
 649           end;
 650 %skip(1);
 651           pp_number_of_chars = length (spare_string);
 652           pp_chunk_of_line_ptr = addrel (addr (spare_string), 1);
 653 %skip(1);
 654           return;
 655 %skip(1);
 656      end make_terminal_dependent_string;
 657 %skip(1);
 658      end print_page;
 659 %page;
 660 print_report: proc;
 661 %skip(1);
 662 dcl pr_loop fixed bin (21);
 663 dcl pr_loop_limit fixed bin (21);
 664 %skip(3);
 665           report_control_info.report_display_time = 0;
 666 %skip(1);
 667           if report_control_info.no_of_formatted_pages ^= 0
 668           then do;
 669                pr_loop_limit = report_control_info.no_of_formatted_pages;
 670                do pr_loop = 1 to pr_loop_limit;
 671                     call get_page (pr_loop);
 672                     call print_page;
 673                end;
 674           end;
 675 %skip(1);
 676           do while (^report_control_info.flags.report_is_formatted);
 677                call format_page;
 678                call print_page;
 679           end;
 680 %skip(1);
 681           if display_arg_results.flags.time_flag
 682           then call ioa_$ioa_switch (iox_$error_output,
 683                "Time used to display the report was ^10.5f seconds.",
 684                report_control_info.report_display_time / 1000000);
 685 %skip(1);
 686           return;
 687 %skip(1);
 688      end print_report;
 689 %page;
 690 scroll_the_report: proc;
 691 %skip(1);
 692 dcl str_still_looking_for_the_page bit (1) aligned;
 693 %skip(1);
 694           scroll_ip = display_arg_results.scroll_info_ptr;
 695 %skip(1);
 696           on display_buffer_empty begin;
 697                if scroll_info.target_page_number <= report_control_info.no_of_formatted_pages
 698                then call get_page (scroll_info.target_page_number);
 699                else call format_page;
 700                scroll_info.page_info_pointer = page_ip;
 701           end;
 702 %skip(1);
 703           do while (ON);
 704                if scroll_info.flags.goto_line_number_pending
 705                then call find_line_within_page;
 706                else call find_page;
 707                scroll_info.page_info_pointer = page_ip;
 708                call linus_display_scroll$continue (scroll_ip, code);
 709                if code ^= 0
 710                then if code = error_table_$end_of_info
 711                     then return;
 712                     else call ssu_$abort_line (sci_ptr, code);
 713                else;
 714           end;
 715 %skip(1);
 716           return;
 717 %page;
 718 check_for_end_of_report: proc;
 719 %skip(3);
 720           scroll_info.flags.on_the_last_page = OFF;
 721 %skip(1);
 722           if report_control_info.flags.report_is_formatted
 723           then if scroll_info.target_page_number > report_control_info.no_of_formatted_pages
 724                then do;
 725                     scroll_info.target_page_number = report_control_info.no_of_formatted_pages;
 726                     scroll_info.flags.on_the_last_page = ON;
 727                end;
 728                else;
 729           else;
 730 %skip(1);
 731           return;
 732 %skip(1);
 733      end check_for_end_of_report;
 734 %page;
 735 find_line_within_page: proc;
 736 %skip(1);
 737 dcl flwp_beginning_line_number fixed bin (35);
 738 dcl flwp_ending_line_number fixed bin (35);
 739 dcl flwp_line_number_is_beyond_end_of_report bit (1) aligned;
 740 dcl flwp_still_looking_for_the_line bit (1) aligned;
 741 %skip(1);
 742           scroll_info.flags.goto_line_number_pending = OFF;
 743           flwp_still_looking_for_the_line = ON;
 744           flwp_line_number_is_beyond_end_of_report = OFF;
 745           scroll_info.target_page_number = 1;
 746           flwp_beginning_line_number = 1;
 747 %skip(1);
 748           do while (flwp_still_looking_for_the_line);
 749                if scroll_info.target_page_number
 750                <= report_control_info.no_of_formatted_pages
 751                then call get_page (scroll_info.target_page_number);
 752                else call format_page;
 753 %skip(1);
 754                flwp_ending_line_number = flwp_beginning_line_number + page_info.length - 1;
 755                if report_control_info.flags.report_is_formatted
 756                then if scroll_info.target_page_number
 757                     = report_control_info.no_of_formatted_pages
 758                     then do;
 759                          scroll_info.flags.on_the_last_page = ON;
 760                          if scroll_info.target_line_number > flwp_ending_line_number
 761                          then flwp_line_number_is_beyond_end_of_report = ON;
 762                     end;
 763                     else;
 764                else;
 765 %skip(1);
 766                if (scroll_info.target_line_number >= flwp_beginning_line_number
 767                & scroll_info.target_line_number <= flwp_ending_line_number)
 768                | (flwp_line_number_is_beyond_end_of_report)
 769                then flwp_still_looking_for_the_line = OFF;
 770                else flwp_beginning_line_number = flwp_ending_line_number + 1;
 771 %skip(1);
 772                if ^flwp_still_looking_for_the_line
 773                then do;
 774                     if flwp_line_number_is_beyond_end_of_report
 775                     then scroll_info.target_line_number
 776                          = (flwp_ending_line_number - flwp_beginning_line_number)
 777                          - scroll_info.vertical_scroll_distance + 1;
 778                     else scroll_info.target_line_number
 779                          = scroll_info.target_line_number - flwp_beginning_line_number + 1;
 780                end;
 781                else scroll_info.target_page_number
 782                     = scroll_info.target_page_number + 1;
 783           end;
 784 %skip(1);
 785           return;
 786 %skip(1);
 787      end find_line_within_page;
 788 %page;
 789 find_page: proc;
 790 %skip(3);
 791           call check_for_end_of_report;
 792           if scroll_info.target_page_number <= report_control_info.no_of_formatted_pages
 793           then call get_page (scroll_info.target_page_number);
 794           else do;
 795                str_still_looking_for_the_page = ON;
 796                do while (str_still_looking_for_the_page);
 797                     call format_page;
 798                     call check_for_end_of_report;
 799                     if scroll_info.target_page_number = report_control_info.no_of_formatted_pages
 800                     then str_still_looking_for_the_page = OFF;
 801                end;
 802           end;
 803 %skip(1);
 804           return;
 805 %skip(1);
 806      end find_page;
 807 %skip(1);
 808      end scroll_the_report;
 809 %page;
 810 setup_io_switches: proc;
 811 %skip(3);
 812           if display_arg_results.output_file_flag
 813           then call setup_output_file;
 814           else if display_arg_results.scroll_flag
 815                then do;
 816                     call linus_display_scroll$start (sci_ptr, report_cip,
 817                          addr (display_arg_results), work_area_ptr);
 818                     video_has_been_set_up = ON;
 819                end;
 820                else if display_arg_results.output_switch_flag
 821                     then call setup_output_switch;
 822                     else report_control_info.display_iocb_ptr
 823                          = iox_$user_output;
 824 %skip(1);
 825           return;
 826 %page;
 827 setup_output_file: proc;
 828 %skip(3);
 829           switch_name = unique_chars_ ("0"b) || ".linus_display";
 830           if display_arg_results.truncate_flag
 831           then attach_description = "vfile_ "
 832                || rtrim (display_arg_results.output_file_directory_name)
 833                || ">" || rtrim (display_arg_results.output_file_entry_name);
 834           else attach_description = "vfile_ "
 835                || rtrim (display_arg_results.output_file_directory_name)
 836                || ">" || rtrim (display_arg_results.output_file_entry_name)
 837                || " -extend";
 838 %skip(1);
 839           call iox_$attach_name (switch_name, iocb_ptr, attach_description,
 840                null (), code);
 841           if code ^= 0
 842           then call ssu_$abort_line (sci_ptr, code,
 843                "While trying to attach file ^a in dir ^a.",
 844                rtrim (display_arg_results.output_file_entry_name),
 845                rtrim (display_arg_results.output_file_directory_name));
 846 %skip(1);
 847           call iox_$open (iocb_ptr, Stream_output, "0"b, code);
 848           if code ^= 0
 849           then call ssu_$abort_line (sci_ptr, code,
 850                "While trying to open file ^a in dir ^a.",
 851                rtrim (display_arg_results.output_file_entry_name),
 852                rtrim (display_arg_results.output_file_directory_name));
 853 %skip(1);
 854           report_control_info.display_iocb_ptr = iocb_ptr;
 855 %skip(1);
 856           return;
 857 %skip(1);
 858      end setup_output_file;
 859 %page;
 860 setup_output_switch: proc;
 861 %skip(3);
 862           call iox_$look_iocb (display_arg_results.output_switch_name,
 863                report_control_info.display_iocb_ptr, code);
 864           if code = error_table_$no_iocb
 865           then call ssu_$abort_line (sci_ptr, linus_error_$bad_report_display,
 866                BAD_OUTPUT_SWITCH_MESSAGE);
 867 %skip(1);
 868           if report_control_info.display_iocb_ptr -> iocb.attach_descrip_ptr = null ()
 869           | report_control_info.display_iocb_ptr -> iocb.open_descrip_ptr = null ()
 870           then call ssu_$abort_line (sci_ptr, linus_error_$bad_report_display,
 871                BAD_OUTPUT_SWITCH_MESSAGE);
 872 %skip(1);
 873           return;
 874 %skip(1);
 875      end setup_output_switch;
 876 %skip(1);
 877      end setup_io_switches;
 878 %page;
 879 terminate: proc;
 880 %skip(3);
 881           if ^arguments_have_been_processed
 882           then return;
 883 %skip(1);
 884           /* Delete the table and report if instructed to do so. */
 885 %skip(1);
 886           if ^display_arg_results.keep_retrieval_flag
 887           & report_control_info.flags.table_has_been_started
 888           then call delete_table;
 889 %skip(1);
 890           if ^display_arg_results.keep_report_flag
 891           & report_control_info.flags.report_has_been_started
 892           then call delete_report;
 893 %skip(1);
 894           /* If we were writing the report to a file clean up. */
 895 %skip(1);
 896           if display_arg_results.output_file_flag
 897           & (report_control_info.display_iocb_ptr ^= iox_$user_output
 898           & report_control_info.display_iocb_ptr ^= null ())
 899           then do;
 900                iocb_ptr = report_control_info.display_iocb_ptr;
 901                call iox_$close (iocb_ptr, code);
 902                call iox_$detach_iocb (iocb_ptr, code);
 903                call iox_$destroy_iocb (iocb_ptr, code);
 904                if cleanup_signalled & report_control_info.no_of_formatted_pages > 0
 905                then call ssu_$print_message (sci_ptr, 0,
 906                     "The partial report is contained in ^/^a.",
 907                     rtrim (display_arg_results.output_file_directory_name)
 908                     || ">" || rtrim (display_arg_results.output_file_entry_name));
 909                else;
 910           end;
 911           else;
 912 %skip(1);
 913           if display_arg_results.scroll_flag & video_has_been_set_up
 914           then call linus_display_scroll$stop (display_arg_results.scroll_info_ptr);
 915 %skip(1);
 916           return;
 917 %skip(1);
 918      end terminate;
 919 %page;
 920 dcl BACKSPACE char (1) static int options (constant) init ("^H");
 921 dcl BAD_OUTPUT_SWITCH_MESSAGE char (69) static int options (constant) init (
 922 "^/When -output_switch is used the switch must be opened and attached.");
 923 dcl OFF bit (1) aligned static int options (constant) init ("0"b);
 924 dcl ON bit (1) aligned static int options (constant) init ("1"b);
 925 %page;
 926 dcl addr builtin;
 927 dcl addrel builtin;
 928 dcl arguments_have_been_processed bit (1) aligned;
 929 dcl attach_description char (256);
 930 %skip(1);
 931 dcl cleanup condition;
 932 dcl cleanup_signalled bit (1) aligned;
 933 dcl code fixed bin (35);
 934 %skip(1);
 935 dcl directory_name char (168);
 936 dcl display_buffer_empty condition;
 937 %skip(1);
 938 dcl entry_name char (32);
 939 dcl error_table_$end_of_info fixed bin(35) ext static;
 940 dcl error_table_$inconsistent fixed bin(35) ext static;
 941 dcl error_table_$no_iocb fixed bin(35) ext static;
 942 dcl error_table_$no_s_permission fixed bin(35) ext static;
 943 dcl expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35));
 944 %skip(1);
 945 dcl first_page_of_the_report bit (1) aligned;
 946 dcl fixed builtin;
 947 %skip(1);
 948 dcl hcs_$status_long entry (char(*), char(*), fixed bin(1), ptr, ptr, fixed bin(35));
 949 %skip(1);
 950 dcl index builtin;
 951 dcl ioa_$ioa_switch entry() options(variable);
 952 dcl ioa_$ioa_switch_nnl entry() options(variable);
 953 dcl iocb_ptr ptr;
 954 %skip(1);
 955 dcl last_page_of_the_report bit (1) aligned;
 956 dcl length builtin;
 957 dcl linus_display_process_args entry (ptr, ptr, ptr, ptr, ptr);
 958 dcl linus_display_scroll$continue entry (ptr, fixed bin(35));
 959 dcl linus_display_scroll$start entry (ptr, ptr, ptr, ptr);
 960 dcl linus_display_scroll$stop entry (ptr);
 961 dcl linus_error_$bad_report_display fixed bin(35) ext static;
 962 dcl linus_fr_build_page entry (ptr, ptr, fixed bin(35));
 963 dcl linus_fr_delete_report entry (ptr, fixed bin(35));
 964 dcl linus_fr_get_page entry (ptr, fixed bin (21), ptr, fixed bin (35));
 965 dcl linus_fr_new_report entry (ptr, fixed bin(35));
 966 dcl linus_options$initialize entry (ptr, fixed bin(35));
 967 dcl linus_table$delete_table entry (ptr, fixed bin(35));
 968 dcl linus_table$translate_query entry (ptr, ptr, fixed bin(35));
 969 dcl linus_table$load_table entry (ptr, fixed bin(35));
 970 dcl linus_table$new_table entry (ptr, char(168) var, bit (1) aligned, fixed bin(35));
 971 dcl linus_table$sort entry (ptr, ptr, fixed bin(35));
 972 %skip(1);
 973 dcl mrds_error_$tuple_not_found fixed bin(35) ext static;
 974 %skip(1);
 975 dcl null builtin;
 976 %skip(1);
 977 dcl rel builtin;
 978 dcl release_area_ entry (ptr);
 979 dcl rtrim builtin;
 980 %skip(1);
 981 dcl sci_ptr ptr;
 982 dcl spare_string char (MAXIMUM_OPTION_VALUE_LENGTH) varying;
 983 dcl ssu_$abort_line entry() options(variable);
 984 dcl ssu_$print_message entry() options(variable);
 985 dcl substr builtin;
 986 dcl switch_name char (42);
 987 dcl sys_info$max_seg_size fixed bin(35) ext static;
 988 %skip(1);
 989 dcl terminal_dependency bit (1) aligned;
 990 dcl time1 float bin (63);
 991 dcl time2 float bin (63);
 992 %skip(1);
 993 dcl unique_chars_ entry (bit(*)) returns(char(15));
 994 %skip(1);
 995 dcl vclock builtin;
 996 dcl video_has_been_set_up bit (1) aligned;
 997 %skip(1);
 998 dcl work_area area (sys_info$max_seg_size) based (work_area_ptr);
 999 dcl work_area_ptr ptr;
1000 %page;
1001 %include arg_descriptor;
1002 %page;
1003 %include arg_list;
1004 %page;
1005 %include iocb;
1006 %page;
1007 %include iox_dcls;
1008 %page;
1009 %include iox_modes;
1010 %page;
1011 %include linus_display_arg_list;
1012 %page;
1013 %include linus_lcb;
1014 %page;
1015 %include linus_options_extents;
1016 %page;
1017 %include linus_page_info;
1018 %page;
1019 %include linus_report_info;
1020 %page;
1021 %include linus_scroll_info;
1022 %page;
1023 %include linus_sort_info;
1024 %page;
1025 %include linus_table_info;
1026 %page;
1027 %include status_structures;
1028      end linus_display;